Mercurial > emacs

comparison lisp/net/goto-addr.el @ 90180:62afea0771d8

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Revision: miles@gnu.org--gnu-2005/emacs--unicode--0--patch-51 Merge from emacs--cvs-trunk--0 Patches applied: * emacs--cvs-trunk--0 (patch 289-301) - Update from CVS - Merge from gnus--rel--5.10 * gnus--rel--5.10 (patch 68) - Update from CVS
author Miles Bader <miles@gnu.org>
date Thu, 12 May 2005 03:41:19 +0000
parents 95879cc1ed20 ae455ff58429
children f9a65d7ebd29
comparison
equal deleted inserted replaced
90179:b745036dab36 90180:62afea0771d8
1 ;;; goto-addr.el --- click to browse URL or to send to e-mail address 1 ;;; goto-addr.el --- click to browse URL or to send to e-mail address
2 2
3 ;; Copyright (C) 1995, 2000, 2001 Free Software Foundation, Inc. 3 ;; Copyright (C) 1995, 2000, 2001, 2005 Free Software Foundation, Inc.
4 4
5 ;; Author: Eric Ding <ericding@alum.mit.edu> 5 ;; Author: Eric Ding <ericding@alum.mit.edu>
6 ;; Maintainer: FSF 6 ;; Maintainer: FSF
7 ;; Created: 15 Aug 1995 7 ;; Created: 15 Aug 1995
8 ;; Keywords: mh-e, www, mouse, mail 8 ;; Keywords: mh-e, www, mouse, mail
44 ;; another mouse click to the function, add the following to your .emacs 44 ;; another mouse click to the function, add the following to your .emacs
45 ;; (for example): 45 ;; (for example):
46 ;; 46 ;;
47 ;; (setq goto-address-highlight-keymap 47 ;; (setq goto-address-highlight-keymap
48 ;; (let ((m (make-sparse-keymap))) 48 ;; (let ((m (make-sparse-keymap)))
49 ;; (define-key m [S-mouse-2] 'goto-address-at-mouse) 49 ;; (define-key m [S-mouse-2] 'goto-address-at-point)
50 ;; m)) 50 ;; m))
51 ;; 51 ;;
52 52
53 ;; Known bugs/features: 53 ;; Known bugs/features:
54 ;; * goto-address-mail-regexp only catches foo@bar.org style addressing, 54 ;; * goto-address-mail-regexp only catches foo@bar.org style addressing,
116 ;; "[-a-zA-Z0-9_=#$@~`%&*+|\\/]") 116 ;; "[-a-zA-Z0-9_=#$@~`%&*+|\\/]")
117 "A regular expression probably matching a URL.") 117 "A regular expression probably matching a URL.")
118 118
119 (defvar goto-address-highlight-keymap 119 (defvar goto-address-highlight-keymap
120 (let ((m (make-sparse-keymap))) 120 (let ((m (make-sparse-keymap)))
121 (if (featurep 'xemacs) 121 (define-key m (if (featurep 'xemacs) (kbd "<button2>") (kbd "<mouse-2>"))
122 (define-key m (kbd "<button2>") 'goto-address-at-mouse) 122 'goto-address-at-point)
123 (define-key m (kbd "<mouse-2>") 'goto-address-at-mouse))
124 (define-key m (kbd "C-c RET") 'goto-address-at-point) 123 (define-key m (kbd "C-c RET") 'goto-address-at-point)
125 m) 124 m)
126 "keymap to hold goto-addr's mouse key defs under highlighted URLs.") 125 "keymap to hold goto-addr's mouse key defs under highlighted URLs.")
127 126
128 (defcustom goto-address-url-face 'bold 127 (defcustom goto-address-url-face 'bold
163 (let* ((s (match-beginning 0)) 162 (let* ((s (match-beginning 0))
164 (e (match-end 0)) 163 (e (match-end 0))
165 (this-overlay (make-overlay s e))) 164 (this-overlay (make-overlay s e)))
166 (and goto-address-fontify-p 165 (and goto-address-fontify-p
167 (overlay-put this-overlay 'face goto-address-url-face)) 166 (overlay-put this-overlay 'face goto-address-url-face))
167 (overlay-put this-overlay 'evaporate t)
168 (overlay-put this-overlay 168 (overlay-put this-overlay
169 'mouse-face goto-address-url-mouse-face) 169 'mouse-face goto-address-url-mouse-face)
170 (overlay-put this-overlay 170 (overlay-put this-overlay
171 'help-echo "mouse-2, C-c RET: follow URL") 171 'help-echo "mouse-2, C-c RET: follow URL")
172 (overlay-put this-overlay 172 (overlay-put this-overlay
177 (let* ((s (match-beginning 0)) 177 (let* ((s (match-beginning 0))
178 (e (match-end 0)) 178 (e (match-end 0))
179 (this-overlay (make-overlay s e))) 179 (this-overlay (make-overlay s e)))
180 (and goto-address-fontify-p 180 (and goto-address-fontify-p
181 (overlay-put this-overlay 'face goto-address-mail-face)) 181 (overlay-put this-overlay 'face goto-address-mail-face))
182 (overlay-put this-overlay 'evaporate t)
182 (overlay-put this-overlay 'mouse-face 183 (overlay-put this-overlay 'mouse-face
183 goto-address-mail-mouse-face) 184 goto-address-mail-mouse-face)
184 (overlay-put this-overlay 185 (overlay-put this-overlay
185 'help-echo "mouse-2, C-c RET: mail this address") 186 'help-echo "mouse-2, C-c RET: mail this address")
186 (overlay-put this-overlay 187 (overlay-put this-overlay
189 190
190 ;; code to find and goto addresses; much of this has been blatantly 191 ;; code to find and goto addresses; much of this has been blatantly
191 ;; snarfed from browse-url.el 192 ;; snarfed from browse-url.el
192 193
193 ;;;###autoload 194 ;;;###autoload
194 (defun goto-address-at-mouse (event) 195 (define-obsolete-function-alias
195 "Send to the e-mail address or load the URL clicked with the mouse. 196 'goto-address-at-mouse 'goto-address-at-point "22.1")
196 Send mail to address at position of mouse click. See documentation for
197 `goto-address-find-address-at-point'. If no address is found
198 there, then load the URL at or before the position of the mouse click."
199 (interactive "e")
200 (save-excursion
201 (mouse-set-point event)
202 (goto-address-at-point)))
203 197
204 ;;;###autoload 198 ;;;###autoload
205 (defun goto-address-at-point () 199 (defun goto-address-at-point (&optional event)
206 "Send to the e-mail address or load the URL at point. 200 "Send to the e-mail address or load the URL at point.
207 Send mail to address at point. See documentation for 201 Send mail to address at point. See documentation for
208 `goto-address-find-address-at-point'. If no address is found 202 `goto-address-find-address-at-point'. If no address is found
209 there, then load the URL at or before point." 203 there, then load the URL at or before point."
210 (interactive) 204 (interactive (list last-input-event))
211 (save-excursion 205 (save-excursion
206 (if event (mouse-set-point event))
212 (let ((address (save-excursion (goto-address-find-address-at-point)))) 207 (let ((address (save-excursion (goto-address-find-address-at-point))))
213 (if (and address 208 (if (and address
214 (save-excursion 209 (save-excursion
215 (goto-char (previous-single-char-property-change 210 (goto-char (previous-single-char-property-change
216 (point) 'goto-address nil 211 (point) 'goto-address nil
246 (if goto-address-highlight-p 241 (if goto-address-highlight-p
247 (goto-address-fontify))) 242 (goto-address-fontify)))
248 243
249 (provide 'goto-addr) 244 (provide 'goto-addr)
250 245
251 ;;; arch-tag: ca47c505-5661-425d-a471-62bc6e75cf0a 246 ;; arch-tag: ca47c505-5661-425d-a471-62bc6e75cf0a
252 ;;; goto-addr.el ends here 247 ;;; goto-addr.el ends here