Mercurial > emacs

comparison lisp/net/goto-addr.el @ 88155:d7ddb3e565de

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
sync with trunk
author Henrik Enberg <henrik.enberg@telia.com>
date Mon, 16 Jan 2006 00:03:54 +0000
parents 0d8b17d428b5
children
comparison
equal deleted inserted replaced
88154:8ce476d3ba36 88155:d7ddb3e565de
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, 2002, 2003, 2004,
4 ;; 2005 Free Software Foundation, Inc.
4 5
5 ;; Author: Eric Ding <ericding@alum.mit.edu> 6 ;; Author: Eric Ding <ericding@alum.mit.edu>
6 ;; Maintainer: FSF 7 ;; Maintainer: FSF
7 ;; Created: 15 Aug 1995 8 ;; Created: 15 Aug 1995
8 ;; Keywords: mh-e, www, mouse, mail 9 ;; Keywords: mh-e, www, mouse, mail
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details. 21 ;; GNU General Public License for more details.
21 22
22 ;; You should have received a copy of the GNU General Public License 23 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the 24 ;; along with GNU Emacs; see the file COPYING. If not, write to the
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 25 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
25 ;; Boston, MA 02111-1307, USA. 26 ;; Boston, MA 02110-1301, USA.
26 27
27 ;;; Commentary: 28 ;;; Commentary:
28 29
29 ;; This package allows you to click or hit a key sequence while on a 30 ;; This package allows you to click or hit a key sequence while on a
30 ;; URL or e-mail address, and either load the URL into a browser of 31 ;; URL or e-mail address, and either load the URL into a browser of
44 ;; another mouse click to the function, add the following to your .emacs 45 ;; another mouse click to the function, add the following to your .emacs
45 ;; (for example): 46 ;; (for example):
46 ;; 47 ;;
47 ;; (setq goto-address-highlight-keymap 48 ;; (setq goto-address-highlight-keymap
48 ;; (let ((m (make-sparse-keymap))) 49 ;; (let ((m (make-sparse-keymap)))
49 ;; (define-key m [S-mouse-2] 'goto-address-at-mouse) 50 ;; (define-key m [S-mouse-2] 'goto-address-at-point)
50 ;; m)) 51 ;; m))
51 ;; 52 ;;
52 53
53 ;; Known bugs/features: 54 ;; Known bugs/features:
54 ;; * goto-address-mail-regexp only catches foo@bar.org style addressing, 55 ;; * goto-address-mail-regexp only catches foo@bar.org style addressing,
91 "*Non-nil means URLs and e-mail addresses in buffer are highlighted." 92 "*Non-nil means URLs and e-mail addresses in buffer are highlighted."
92 :type 'boolean 93 :type 'boolean
93 :group 'goto-address) 94 :group 'goto-address)
94 95
95 (defcustom goto-address-fontify-maximum-size 30000 96 (defcustom goto-address-fontify-maximum-size 30000
96 "*Maximum size of file in which to fontify and/or highlight URLs." 97 "*Maximum size of file in which to fontify and/or highlight URLs.
97 :type 'integer 98 A value of t means there is no limit--fontify regardless of the size."
99 :type '(choice (integer :tag "Maximum size") (const :tag "No limit" t))
98 :group 'goto-address) 100 :group 'goto-address)
99 101
100 (defvar goto-address-mail-regexp 102 (defvar goto-address-mail-regexp
101 ;; Actually pretty much any char could appear in the username part. -stef 103 ;; Actually pretty much any char could appear in the username part. -stef
102 "[-a-zA-Z0-9._+]+@\\([-a-zA-z0-9_]+\\.\\)+[a-zA-Z0-9]+" 104 "[-a-zA-Z0-9=._+]+@\\([-a-zA-z0-9_]+\\.\\)+[a-zA-Z0-9]+"
103 "A regular expression probably matching an e-mail address.") 105 "A regular expression probably matching an e-mail address.")
104 106
105 (defvar goto-address-url-regexp 107 (defvar goto-address-url-regexp
106 (concat "\\<\\(" 108 (concat
107 (mapconcat 'identity 109 "\\<\\("
108 (delete "mailto:" (copy-sequence thing-at-point-uri-schemes)) 110 (mapconcat 'identity
109 "\\|") 111 (delete "mailto:"
110 "\\)" 112 ;; Remove `data:', as it's not terribly useful to follow
111 thing-at-point-url-path-regexp) 113 ;; those. Leaving them causes `use Data::Dumper;' to be
114 ;; fontified oddly in Perl files.
115 (delete "data:"
116 (copy-sequence thing-at-point-uri-schemes)))
117 "\\|")
118 "\\)"
119 thing-at-point-url-path-regexp)
112 ;; (concat "\\b\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|" 120 ;; (concat "\\b\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|"
113 ;; "telnet\\|wais\\):\\(//[-a-zA-Z0-9_.]+:" 121 ;; "telnet\\|wais\\):\\(//[-a-zA-Z0-9_.]+:"
114 ;; "[0-9]*\\)?[-a-zA-Z0-9_=?#$@~`%&*+|\\/.,]*" 122 ;; "[0-9]*\\)?[-a-zA-Z0-9_=?#$@~`%&*+|\\/.,]*"
115 ;; "[-a-zA-Z0-9_=#$@~`%&*+|\\/]") 123 ;; "[-a-zA-Z0-9_=#$@~`%&*+|\\/]")
116 "A regular expression probably matching a URL.") 124 "A regular expression probably matching a URL.")
117 125
118 (defvar goto-address-highlight-keymap 126 (defvar goto-address-highlight-keymap
119 (let ((m (make-sparse-keymap))) 127 (let ((m (make-sparse-keymap)))
120 (if (featurep 'xemacs) 128 (define-key m (if (featurep 'xemacs) (kbd "<button2>") (kbd "<mouse-2>"))
121 (define-key m (kbd "<button2>") 'goto-address-at-mouse) 129 'goto-address-at-point)
122 (define-key m (kbd "<mouse-2>") 'goto-address-at-mouse))
123 (define-key m (kbd "C-c RET") 'goto-address-at-point) 130 (define-key m (kbd "C-c RET") 'goto-address-at-point)
124 m) 131 m)
125 "keymap to hold goto-addr's mouse key defs under highlighted URLs.") 132 "Keymap to hold goto-addr's mouse key defs under highlighted URLs.")
126 133
127 (defcustom goto-address-url-face 'bold 134 (defcustom goto-address-url-face 'bold
128 "Face to use for URLs." 135 "Face to use for URLs."
129 :type 'face 136 :type 'face
130 :group 'goto-address) 137 :group 'goto-address)
153 (if (overlay-get overlay 'goto-address) 160 (if (overlay-get overlay 'goto-address)
154 (delete-overlay overlay))) 161 (delete-overlay overlay)))
155 (save-excursion 162 (save-excursion
156 (let ((inhibit-point-motion-hooks t)) 163 (let ((inhibit-point-motion-hooks t))
157 (goto-char (point-min)) 164 (goto-char (point-min))
158 (if (< (- (point-max) (point)) goto-address-fontify-maximum-size) 165 (if (or (eq t goto-address-fontify-maximum-size)
166 (< (- (point-max) (point)) goto-address-fontify-maximum-size))
159 (progn 167 (progn
160 (while (re-search-forward goto-address-url-regexp nil t) 168 (while (re-search-forward goto-address-url-regexp nil t)
161 (let* ((s (match-beginning 0)) 169 (let* ((s (match-beginning 0))
162 (e (match-end 0)) 170 (e (match-end 0))
163 (this-overlay (make-overlay s e))) 171 (this-overlay (make-overlay s e)))
164 (and goto-address-fontify-p 172 (and goto-address-fontify-p
165 (overlay-put this-overlay 'face goto-address-url-face)) 173 (overlay-put this-overlay 'face goto-address-url-face))
174 (overlay-put this-overlay 'evaporate t)
166 (overlay-put this-overlay 175 (overlay-put this-overlay
167 'mouse-face goto-address-url-mouse-face) 176 'mouse-face goto-address-url-mouse-face)
168 (overlay-put this-overlay 177 (overlay-put this-overlay 'follow-link t)
169 'help-echo "mouse-2: follow URL") 178 (overlay-put this-overlay
179 'help-echo "mouse-2, C-c RET: follow URL")
170 (overlay-put this-overlay 180 (overlay-put this-overlay
171 'keymap goto-address-highlight-keymap) 181 'keymap goto-address-highlight-keymap)
172 (overlay-put this-overlay 'goto-address t))) 182 (overlay-put this-overlay 'goto-address t)))
173 (goto-char (point-min)) 183 (goto-char (point-min))
174 (while (re-search-forward goto-address-mail-regexp nil t) 184 (while (re-search-forward goto-address-mail-regexp nil t)
175 (let* ((s (match-beginning 0)) 185 (let* ((s (match-beginning 0))
176 (e (match-end 0)) 186 (e (match-end 0))
177 (this-overlay (make-overlay s e))) 187 (this-overlay (make-overlay s e)))
178 (and goto-address-fontify-p 188 (and goto-address-fontify-p
179 (overlay-put this-overlay 'face goto-address-mail-face)) 189 (overlay-put this-overlay 'face goto-address-mail-face))
190 (overlay-put this-overlay 'evaporate t)
180 (overlay-put this-overlay 'mouse-face 191 (overlay-put this-overlay 'mouse-face
181 goto-address-mail-mouse-face) 192 goto-address-mail-mouse-face)
182 (overlay-put this-overlay 193 (overlay-put this-overlay 'follow-link t)
183 'help-echo "mouse-2: mail this address") 194 (overlay-put this-overlay
195 'help-echo "mouse-2, C-c RET: mail this address")
184 (overlay-put this-overlay 196 (overlay-put this-overlay
185 'keymap goto-address-highlight-keymap) 197 'keymap goto-address-highlight-keymap)
186 (overlay-put this-overlay 'goto-address t)))))))) 198 (overlay-put this-overlay 'goto-address t))))))))
187 199
188 ;; code to find and goto addresses; much of this has been blatantly 200 ;; code to find and goto addresses; much of this has been blatantly
189 ;; snarfed from browse-url.el 201 ;; snarfed from browse-url.el
190 202
191 ;;;###autoload 203 ;;;###autoload
192 (defun goto-address-at-mouse (event) 204 (define-obsolete-function-alias
193 "Send to the e-mail address or load the URL clicked with the mouse. 205 'goto-address-at-mouse 'goto-address-at-point "22.1")
194 Send mail to address at position of mouse click. See documentation for
195 `goto-address-find-address-at-point'. If no address is found
196 there, then load the URL at or before the position of the mouse click."
197 (interactive "e")
198 (save-excursion
199 (mouse-set-point event)
200 (goto-address-at-point)))
201 206
202 ;;;###autoload 207 ;;;###autoload
203 (defun goto-address-at-point () 208 (defun goto-address-at-point (&optional event)
204 "Send to the e-mail address or load the URL at point. 209 "Send to the e-mail address or load the URL at point.
205 Send mail to address at point. See documentation for 210 Send mail to address at point. See documentation for
206 `goto-address-find-address-at-point'. If no address is found 211 `goto-address-find-address-at-point'. If no address is found
207 there, then load the URL at or before point." 212 there, then load the URL at or before point."
208 (interactive) 213 (interactive (list last-input-event))
209 (save-excursion 214 (save-excursion
215 (if event (posn-set-point (event-end event)))
210 (let ((address (save-excursion (goto-address-find-address-at-point)))) 216 (let ((address (save-excursion (goto-address-find-address-at-point))))
211 (if (and address 217 (if (and address
212 (save-excursion 218 (save-excursion
213 (goto-char (previous-single-char-property-change 219 (goto-char (previous-single-char-property-change
214 (point) 'goto-address nil 220 (point) 'goto-address nil
234 ;;;###autoload 240 ;;;###autoload
235 (defun goto-address () 241 (defun goto-address ()
236 "Sets up goto-address functionality in the current buffer. 242 "Sets up goto-address functionality in the current buffer.
237 Allows user to use mouse/keyboard command to click to go to a URL 243 Allows user to use mouse/keyboard command to click to go to a URL
238 or to send e-mail. 244 or to send e-mail.
239 By default, goto-address binds to mouse-2 and C-c RET. 245 By default, goto-address binds `goto-address-at-point' to mouse-2 and C-c RET
246 only on URLs and e-mail addresses.
240 247
241 Also fontifies the buffer appropriately (see `goto-address-fontify-p' and 248 Also fontifies the buffer appropriately (see `goto-address-fontify-p' and
242 `goto-address-highlight-p' for more information)." 249 `goto-address-highlight-p' for more information)."
243 (interactive) 250 (interactive)
244 (if goto-address-highlight-p 251 (if goto-address-highlight-p
245 (goto-address-fontify))) 252 (goto-address-fontify)))
246 253
247 (provide 'goto-addr) 254 (provide 'goto-addr)
248 255
256 ;; arch-tag: ca47c505-5661-425d-a471-62bc6e75cf0a
249 ;;; goto-addr.el ends here 257 ;;; goto-addr.el ends here