X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Friece-url.el;h=c502328baa6263ffbf42ce029eba8c05a41414f7;hb=10e7ff663eee9d7e2038a3180f2dbb8eb02e36d5;hp=105098d2d9a40d1483711bf7c641171e85173a52;hpb=0bf5872c5bdee5416703521dc629fc4511d3c550;p=riece diff --git a/lisp/riece-url.el b/lisp/riece-url.el index 105098d..c502328 100644 --- a/lisp/riece-url.el +++ b/lisp/riece-url.el @@ -22,47 +22,123 @@ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. +;;; Commentary: + +;; To use, add the following line to your ~/.riece/init.el: +;; (add-to-list 'riece-addons 'riece-url) + ;;; Code: +(require 'riece-options) +(require 'riece-menu) ;riece-menu-items + +(autoload 'browse-url "browse-url") (defvar browse-url-browser-function) (defgroup riece-url nil "URL Browsing in IRC buffer." - :group 'riece-vars) + :group 'riece) -(defcustom riece-url-regexp "\\b\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\):\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?[-a-zA-Z0-9_=?#$@~`%&*+|\\/.,]*[-a-zA-Z0-9_=#$@~`%&*+|\\/]" +(defcustom riece-url-regexp "\\b\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\):\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?[-a-zA-Z0-9_=?#$@~`%&*+|\\/.,;]*[-a-zA-Z0-9_=#$@~`%&*+|\\/;]" "Regular expression that matches URLs." :group 'riece-url :type 'regexp) +(defcustom riece-url-regexp-alist nil + "An alist mapping regexp to URL. +For example: + (setq riece-url-regexp-alist + '((\"\\\\bBug#\\\\([0-9]+\\\\)\\\\b\" . + \"http://bugs.debian.org/\\\\1\"))) + +This maps a string \"Bug#12345\" to a URL +\"http://bugs.debian.org/12345\"." + :type 'alist + :group 'riece-url) + (defvar riece-urls nil "A list of URL which appears in Riece buffers.") +(defvar riece-url-enabled nil) + +(defconst riece-url-description + "Collect URL in IRC buffers") + (autoload 'widget-convert-button "wid-edit") -(defun riece-url-add-buttons (start end) - (save-excursion - (goto-char start) - (while (re-search-forward riece-url-regexp end t) - (let ((url (match-string 0))) - (widget-convert-button - 'url-link (match-beginning 0) (match-end 0) url) - (unless (member url riece-urls) - (setq riece-urls (cons url riece-urls))))))) +(defun riece-url-replace-match (string) + (let ((match-data (match-data)) + (index 0) + number + replacement) + (while (string-match "\\\\[&1-9\\\\]" string index) + (if (eq (aref string (1+ (match-beginning 0))) ?&) + (setq number 0) + (unless (eq (aref string (1+ (match-beginning 0))) ?\\) + (setq number (string-to-number (substring (match-string 0 string) + 1))))) + (if number + (setq replacement + (buffer-substring (nth (* number 2) match-data) + (nth (1+ (* number 2)) match-data))) + (setq replacement "\\")) + (setq string (concat (substring string 0 (match-beginning 0)) + replacement + (substring string (match-end 0))) + index (+ index (length replacement)))) + string)) + +(defun riece-url-scan-region (start end) + (let ((alist (cons (cons riece-url-regexp "\\&") + riece-url-regexp-alist))) + (while alist + (save-excursion + (goto-char start) + (while (re-search-forward (car (car alist)) end t) + (let ((url (save-match-data + (riece-url-replace-match (cdr (car alist)))))) + (if (memq 'riece-highlight riece-addons) + (widget-convert-button + 'url-link (match-beginning 0) (match-end 0) url)) + (unless (member url riece-urls) + (setq riece-urls (cons url riece-urls)))))) + (setq alist (cdr alist))))) (defun riece-command-browse-url (&optional url) (interactive - (list (completing-read "Open URL:" (mapcar #'list riece-urls)))) + (list (completing-read "Open URL: " (mapcar #'list riece-urls)))) (browse-url url)) +(defun riece-url-create-menu (menu) + (mapcar (lambda (url) + (vector url (list 'browse-url url))) + riece-urls)) + (defvar riece-dialogue-mode-map) (defun riece-url-requires () - '(riece-highlight)) + (append (if (memq 'riece-highlight riece-addons) + '(riece-highlight)) + (if (memq 'riece-menu riece-addons) + '(riece-menu)))) (defun riece-url-insinuate () - (add-hook 'riece-after-insert-functions 'riece-url-add-buttons) - (define-key riece-dialogue-mode-map "U" 'riece-command-browse-url)) + (add-hook 'riece-after-insert-functions 'riece-url-scan-region) + (if (memq 'riece-menu riece-addons) + (add-hook 'riece-command-mode-hook + (lambda () + (easy-menu-add-item + nil (list (car riece-menu-items)) + '("Open URL..." :filter riece-url-create-menu))) + t))) + +(defun riece-url-enable () + (define-key riece-dialogue-mode-map "U" 'riece-command-browse-url) + (setq riece-url-enabled t)) + +(defun riece-url-disable () + (define-key riece-dialogue-mode-map "U" nil) + (setq riece-url-enabled nil)) (provide 'riece-url)