X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/a69315a1b93c31a8d6bd5a8329d7cb101e71e706..8d36235ff612aada0a47406c62ed7fc8ada33920:/lisp/goto-addr.el diff --git a/lisp/goto-addr.el b/lisp/goto-addr.el index f338cdcf10..4c40232df4 100644 --- a/lisp/goto-addr.el +++ b/lisp/goto-addr.el @@ -1,6 +1,8 @@ ;;; goto-addr.el --- click to browse URL or to send to e-mail address + ;; Copyright (C) 1995 Free Software Foundation, Inc. +;; Author: Eric Ding ;; Maintainer: Eric Ding ;; Created: 15 Aug 1995 ;; Keywords: mh-e, www, mouse, mail @@ -18,8 +20,9 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to -;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. ;;; Commentary: @@ -27,43 +30,30 @@ ;; URL or e-mail address, and either load the URL into a browser of ;; your choice using the browse-url package, or if it's an e-mail ;; address, to send an e-mail to that address. By default, we bind to -;; the [S-mouse-1] and the [C-c return] key sequences. -;; -;; You will also need the browse-url.el package to use goto-address. -;; You can find it at . +;; the [mouse-2] and the [C-c return] key sequences. ;; INSTALLATION ;; -;; To install goto-address, put goto-addr.el somewhere in -;; your load-path and add the following to your .emacs file: -;; -;; (autoload 'goto-address "goto-addr" -;; "Set up buffer to click to browse URL or to send to e-mail address" t) -;; -;; To use it in a particular mode (for example, while reading mail in -;; mh-e), add something like this in your .emacs file: +;; To use goto-address in a particular mode (for example, while +;; reading mail in mh-e), add something like this in your .emacs file: ;; ;; (add-hook 'mh-show-mode-hook 'goto-address) ;; ;; By default, goto-address now sends using `mail' instead of `mh-send'. ;; To use mh-e to send mail, add the following to your .emacs file: ;; -;; (setq goto-address-mail-method 'goto-address-send-using-mhe) +;; (setq goto-address-mail-method 'goto-address-send-using-mh-e) ;; -;; To rebind, for example, the mouse click method to [mouse-2] in -;; mh-show-mode, add the following (instead of the first add-hook example -;; above) to your .emacs file: +;; The mouse click method is bound to [mouse-2] on highlighted URL's or +;; e-mail addresses only; it functions normally everywhere else. To bind +;; another mouse click to the function, add the following to your .emacs +;; (for example): ;; -;; (defun my-goto-address () -;; (goto-address) -;; (local-unset-key [S-mouse-1]) -;; (local-set-key [mouse-2] 'goto-address-at-mouse)) +;; (setq goto-address-highlight-keymap +;; (let ((m (make-sparse-keymap))) +;; (define-key m [S-mouse-2] 'goto-address-at-mouse) +;; m)) ;; -;; (add-hook 'mh-show-mode-hook 'my-goto-address) -;; -;; [mouse-2] is not the default mouse binding because I use goto-address in -;; some editable buffers, where [mouse-2] means mouse-yank-at-click, as well -;; as in some modes where [mouse-2] is bound to other useful functions. ;; BUG REPORTS ;; @@ -78,17 +68,20 @@ ;; (say, using font-lock-fontify-buffer), then font-lock face will ;; override goto-address faces. -;;; Change log: - ;;; Code: (require 'browse-url) +;;; I don't expect users to want fontify'ing without highlighting. (defvar goto-address-fontify-p t - "*If t, URL's and e-mail address in buffer are fontified.") + "*If t, URL's and e-mail addresses in buffer are fontified. +But only if `goto-address-highlight-p' is also non-nil.") + +(defvar goto-address-highlight-p t + "*If t, URL's and e-mail addresses in buffer are highlighted.") (defvar goto-address-fontify-maximum-size 30000 - "*Maximum size of file in which to fontify URL's.") + "*Maximum size of file in which to fontify and/or highlight URL's.") (defvar goto-address-mail-regexp "[-a-zA-Z0-9._]+@\\([-a-zA-z0-9_]+\\.\\)+[a-zA-Z0-9]+" @@ -105,52 +98,62 @@ 'goto-address-send-using-mail "*Function to compose mail. Two pre-made functions are `goto-address-send-using-mail' (sendmail); -and `goto-address-send-using-mhe' (MH-E).") +and `goto-address-send-using-mh-e' (MH-E).") + +(defvar goto-address-highlight-keymap + (let ((m (make-sparse-keymap))) + (define-key m [mouse-2] 'goto-address-at-mouse) + m) + "keymap to hold goto-addr's mouse key defs under highlighted URLs.") + +(defvar goto-address-url-face 'bold + "*Face to use for URLs.") + +(defvar goto-address-url-mouse-face 'highlight + "*Face to use for URLs when the mouse is on them.") + +(defvar goto-address-mail-face 'italic + "*Face to use for e-mail addresses.") + +(defvar goto-address-mail-mouse-face 'secondary-selection + "*Face to use for e-mail addresses when the mouse is on them.") (defun goto-address-fontify () - "Fontify the URL's and e-mail addresses in the current buffer." + "Fontify the URL's and e-mail addresses in the current buffer. +This function implements `goto-address-highlight-p' +and `goto-address-fontify-p'." (save-excursion (let ((inhibit-read-only t) + (inhibit-point-motion-hooks t) (modified (buffer-modified-p))) (goto-char (point-min)) (if (< (- (point-max) (point)) goto-address-fontify-maximum-size) (progn (while (re-search-forward goto-address-url-regexp nil t) - ;; if text is invisible, we ignore it - (and (goto-address-skip-invisible (match-beginning 0)) - (progn - (goto-char (match-end 0)) - (put-text-property (match-beginning 0) (match-end 0) - 'face 'bold) - (put-text-property (match-beginning 0) (match-end 0) - 'mouse-face 'highlight)))) + (let ((s (match-beginning 0)) + (e (match-end 0))) + (and goto-address-fontify-p + (put-text-property s e 'face goto-address-url-face)) + (put-text-property s e 'mouse-face goto-address-url-mouse-face) + (put-text-property + s e 'local-map goto-address-highlight-keymap))) (goto-char (point-min)) (while (re-search-forward goto-address-mail-regexp nil t) - ;; if text is invisible, we ignore it - (and (goto-address-skip-invisible (match-beginning 0)) - (progn - (goto-char (match-end 0)) - (put-text-property (match-beginning 0) (match-end 0) - 'face 'italic) - (put-text-property (match-beginning 0) (match-end 0) - 'mouse-face 'secondary-selection)))))) + (let ((s (match-beginning 0)) + (e (match-end 0))) + (and goto-address-fontify-p + (put-text-property s e 'face goto-address-mail-face)) + (put-text-property s e 'mouse-face goto-address-mail-mouse-face) + (put-text-property + s e 'local-map goto-address-highlight-keymap))))) (and (buffer-modified-p) (not modified) (set-buffer-modified-p nil))))) -(defun goto-address-skip-invisible (char) - "If char is not invisible, then return t. Otherwise, move forward in buffer -until a non-invisible char is found, goto that position, and return nil." - (if (get-text-property char 'invisible) - (let ((char (1+ char))) - (while (get-text-property char 'invisible) - (setq char (1+ char)) - (goto-char char))) - t)) - ;;; code to find and goto addresses; much of this has been blatantly ;;; snarfed from browse-url.el +;;;###autoload (defun goto-address-at-mouse (event) "Send to the e-mail address or load the URL clicked with the mouse. Send mail to address at position of mouse click. See documentation for @@ -170,6 +173,7 @@ there, then load the URL at or before the position of the mouse click." (funcall browse-url-browser-function url))) (funcall goto-address-mail-method address)))))) +;;;###autoload (defun goto-address-at-point () "Send to the e-mail address or load the URL at point. Send mail to address at point. See documentation for @@ -198,7 +202,8 @@ address. If no e-mail address found, return the empty string." (buffer-substring (match-beginning 0) (match-end 0)) ""))) -(defun goto-address-send-using-mhe (to) +(defun goto-address-send-using-mh-e (to) + (require 'mh-comp) (mh-find-path) (let ((cc (mh-read-address "Cc: ")) (subject (read-string "Subject: ")) @@ -206,16 +211,25 @@ address. If no e-mail address found, return the empty string." (delete-other-windows) (mh-send-sub to cc subject config))) +(fset 'goto-address-send-using-mhe 'goto-address-send-using-mh-e) + (defun goto-address-send-using-mail (to) (mail-other-window nil to) (and (goto-char (point-min)) (end-of-line 2))) +;;;###autoload (defun goto-address () + "Sets up goto-address functionality in the current buffer. +Allows user to use mouse/keyboard command to click to go to a URL +or to send e-mail. +By default, goto-address binds to mouse-2 and C-c RET. + +Also fontifies the buffer appropriately (see `goto-address-fontify-p' and +`goto-address-highlight-p' for more information)." (interactive) - (local-set-key [S-mouse-1] 'goto-address-at-mouse) (local-set-key "\C-c\r" 'goto-address-at-point) - (if goto-address-fontify-p + (if goto-address-highlight-p (goto-address-fontify))) (provide 'goto-addr)