(menu-bar-help-extra-packages): Use goto-address-mode instead of goto-address.
[bpt/emacs.git] / lisp / net / goto-addr.el
CommitLineData
8749abea
GM
1;;; goto-addr.el --- click to browse URL or to send to e-mail address
2
5fd6d89f 3;; Copyright (C) 1995, 2000, 2001, 2002, 2003, 2004,
ae940284 4;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
8749abea 5
cf6936a4 6;; Author: Eric Ding <ericding@alum.mit.edu>
12c74386 7;; Maintainer: FSF
8749abea
GM
8;; Created: 15 Aug 1995
9;; Keywords: mh-e, www, mouse, mail
10
11;; This file is part of GNU Emacs.
12
874a927a 13;; GNU Emacs is free software: you can redistribute it and/or modify
8749abea 14;; it under the terms of the GNU General Public License as published by
874a927a
GM
15;; the Free Software Foundation, either version 3 of the License, or
16;; (at your option) any later version.
8749abea
GM
17
18;; GNU Emacs is distributed in the hope that it will be useful,
19;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21;; GNU General Public License for more details.
22
23;; You should have received a copy of the GNU General Public License
874a927a 24;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
8749abea
GM
25
26;;; Commentary:
27
28;; This package allows you to click or hit a key sequence while on a
29;; URL or e-mail address, and either load the URL into a browser of
30;; your choice using the browse-url package, or if it's an e-mail
31;; address, to send an e-mail to that address. By default, we bind to
32;; the [mouse-2] and the [C-c return] key sequences.
33
34;; INSTALLATION
35;;
36;; To use goto-address in a particular mode (for example, while
37;; reading mail in mh-e), add something like this in your .emacs file:
38;;
39;; (add-hook 'mh-show-mode-hook 'goto-address)
40;;
28223a7e 41;; The mouse click method is bound to [mouse-2] on highlighted URLs or
8749abea
GM
42;; e-mail addresses only; it functions normally everywhere else. To bind
43;; another mouse click to the function, add the following to your .emacs
44;; (for example):
45;;
46;; (setq goto-address-highlight-keymap
47;; (let ((m (make-sparse-keymap)))
9fd6c528 48;; (define-key m [S-mouse-2] 'goto-address-at-point)
8749abea
GM
49;; m))
50;;
51
8749abea
GM
52;; Known bugs/features:
53;; * goto-address-mail-regexp only catches foo@bar.org style addressing,
54;; not stuff like X.400 addresses, etc.
55;; * regexp also catches Message-Id line, since it is in the format of
56;; an Internet e-mail address (like Compuserve addresses)
51107a70
DL
57;; * If the buffer is fontified after goto-address-fontify is run
58;; (say, using font-lock-fontify-buffer), then font-lock faces will
8749abea
GM
59;; override goto-address faces.
60
61;;; Code:
62
f79538c9
DL
63(require 'thingatpt)
64(autoload 'browse-url-url-at-point "browse-url")
8749abea 65
67ac0f7a
GM
66;; XEmacs needs the following definitions.
67(unless (fboundp 'overlays-in)
68 (require 'overlay))
69(unless (fboundp 'line-beginning-position)
70 (defalias 'line-beginning-position 'point-at-bol))
71(unless (fboundp 'line-end-position)
72 (defalias 'line-end-position 'point-at-eol))
73(unless (fboundp 'match-string-no-properties)
74 (defalias 'match-string-no-properties 'match-string))
75
8749abea
GM
76(defgroup goto-address nil
77 "Click to browse URL or to send to e-mail address."
78 :group 'mouse
79 :group 'hypermedia)
80
81
d8754ce5 82;; I don't expect users to want fontify'ing without highlighting.
8749abea 83(defcustom goto-address-fontify-p t
f79538c9 84 "*Non-nil means URLs and e-mail addresses in buffer are fontified.
8749abea
GM
85But only if `goto-address-highlight-p' is also non-nil."
86 :type 'boolean
87 :group 'goto-address)
88
89(defcustom goto-address-highlight-p t
f79538c9 90 "*Non-nil means URLs and e-mail addresses in buffer are highlighted."
8749abea
GM
91 :type 'boolean
92 :group 'goto-address)
93
94(defcustom goto-address-fontify-maximum-size 30000
3e61755b
RS
95 "*Maximum size of file in which to fontify and/or highlight URLs.
96A value of t means there is no limit--fontify regardless of the size."
97 :type '(choice (integer :tag "Maximum size") (const :tag "No limit" t))
8749abea
GM
98 :group 'goto-address)
99
100(defvar goto-address-mail-regexp
138399e6 101 ;; Actually pretty much any char could appear in the username part. -stef
02b6dbd8 102 "[-a-zA-Z0-9=._+]+@\\([-a-zA-z0-9_]+\\.\\)+[a-zA-Z0-9]+"
8749abea
GM
103 "A regular expression probably matching an e-mail address.")
104
019f8c1e 105(defvar goto-address-url-regexp
98945794
EZ
106 (concat
107 "\\<\\("
108 (mapconcat 'identity
109 (delete "mailto:"
110 ;; Remove `data:', as it's not terribly useful to follow
111 ;; those. Leaving them causes `use Data::Dumper;' to be
112 ;; fontified oddly in Perl files.
113 (delete "data:"
114 (copy-sequence thing-at-point-uri-schemes)))
115 "\\|")
116 "\\)"
117 thing-at-point-url-path-regexp)
d8754ce5
GM
118 ;; (concat "\\b\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|"
119 ;; "telnet\\|wais\\):\\(//[-a-zA-Z0-9_.]+:"
120 ;; "[0-9]*\\)?[-a-zA-Z0-9_=?#$@~`%&*+|\\/.,]*"
121 ;; "[-a-zA-Z0-9_=#$@~`%&*+|\\/]")
8749abea
GM
122 "A regular expression probably matching a URL.")
123
124(defvar goto-address-highlight-keymap
125 (let ((m (make-sparse-keymap)))
9fd6c528 126 (define-key m (if (featurep 'xemacs) (kbd "<button2>") (kbd "<mouse-2>"))
64981116 127 'goto-address-at-point)
67ac0f7a 128 (define-key m (kbd "C-c RET") 'goto-address-at-point)
8749abea 129 m)
79c4a646 130 "Keymap to hold goto-addr's mouse key defs under highlighted URLs.")
8749abea
GM
131
132(defcustom goto-address-url-face 'bold
f79538c9 133 "Face to use for URLs."
8749abea
GM
134 :type 'face
135 :group 'goto-address)
136
137(defcustom goto-address-url-mouse-face 'highlight
f79538c9 138 "Face to use for URLs when the mouse is on them."
8749abea
GM
139 :type 'face
140 :group 'goto-address)
141
142(defcustom goto-address-mail-face 'italic
f79538c9 143 "Face to use for e-mail addresses."
8749abea
GM
144 :type 'face
145 :group 'goto-address)
146
147(defcustom goto-address-mail-mouse-face 'secondary-selection
f79538c9 148 "Face to use for e-mail addresses when the mouse is on them."
8749abea
GM
149 :type 'face
150 :group 'goto-address)
151
2cbee4c5
GM
152(defun goto-address-unfontify (start end)
153 "Remove `goto-address' fontification from the given region."
154 (dolist (overlay (overlays-in start end))
155 (if (overlay-get overlay 'goto-address)
156 (delete-overlay overlay))))
157
8b026efe
GM
158(defvar goto-address-prog-mode)
159
8749abea 160(defun goto-address-fontify ()
28223a7e 161 "Fontify the URLs and e-mail addresses in the current buffer.
8749abea
GM
162This function implements `goto-address-highlight-p'
163and `goto-address-fontify-p'."
51107a70 164 ;; Clean up from any previous go.
2cbee4c5 165 (goto-address-unfontify (point-min) (point-max))
8749abea 166 (save-excursion
51107a70 167 (let ((inhibit-point-motion-hooks t))
8749abea 168 (goto-char (point-min))
2cbee4c5
GM
169 (when (or (eq t goto-address-fontify-maximum-size)
170 (< (- (point-max) (point)) goto-address-fontify-maximum-size))
171 (while (re-search-forward goto-address-url-regexp nil t)
172 (let* ((s (match-beginning 0))
173 (e (match-end 0))
174 this-overlay)
175 (when (or (not goto-address-prog-mode)
176 ;; This tests for both comment and string
177 ;; syntax.
178 (nth 8 (syntax-ppss)))
179 (setq this-overlay (make-overlay s e))
180 (and goto-address-fontify-p
181 (overlay-put this-overlay 'face goto-address-url-face))
182 (overlay-put this-overlay 'evaporate t)
183 (overlay-put this-overlay
184 'mouse-face goto-address-url-mouse-face)
185 (overlay-put this-overlay 'follow-link t)
186 (overlay-put this-overlay
187 'help-echo "mouse-2, C-c RET: follow URL")
188 (overlay-put this-overlay
189 'keymap goto-address-highlight-keymap)
190 (overlay-put this-overlay 'goto-address t))))
191 (goto-char (point-min))
192 (while (re-search-forward goto-address-mail-regexp nil t)
193 (let* ((s (match-beginning 0))
194 (e (match-end 0))
195 this-overlay)
196 (when (or (not goto-address-prog-mode)
197 ;; This tests for both comment and string
198 ;; syntax.
199 (nth 8 (syntax-ppss)))
200 (setq this-overlay (make-overlay s e))
201 (and goto-address-fontify-p
202 (overlay-put this-overlay 'face goto-address-mail-face))
203 (overlay-put this-overlay 'evaporate t)
204 (overlay-put this-overlay 'mouse-face
205 goto-address-mail-mouse-face)
206 (overlay-put this-overlay 'follow-link t)
207 (overlay-put this-overlay
208 'help-echo "mouse-2, C-c RET: mail this address")
209 (overlay-put this-overlay
210 'keymap goto-address-highlight-keymap)
211 (overlay-put this-overlay 'goto-address t))))))))
212
213(defun goto-address-fontify-region (start end)
214 "Fontify URLs and e-mail addresses in the given region."
215 (save-excursion
216 (save-restriction
217 (let ((beg-line (progn (goto-char start) (line-beginning-position)))
218 (end-line (progn (goto-char end) (line-end-position))))
219 (narrow-to-region beg-line end-line)
220 (goto-address-fontify)))))
8749abea 221
d8754ce5
GM
222;; code to find and goto addresses; much of this has been blatantly
223;; snarfed from browse-url.el
8749abea
GM
224
225;;;###autoload
9fd6c528
SM
226(define-obsolete-function-alias
227 'goto-address-at-mouse 'goto-address-at-point "22.1")
8749abea
GM
228
229;;;###autoload
9fd6c528 230(defun goto-address-at-point (&optional event)
8749abea
GM
231 "Send to the e-mail address or load the URL at point.
232Send mail to address at point. See documentation for
233`goto-address-find-address-at-point'. If no address is found
234there, then load the URL at or before point."
9fd6c528 235 (interactive (list last-input-event))
8749abea 236 (save-excursion
43fb082d 237 (if event (posn-set-point (event-end event)))
8749abea 238 (let ((address (save-excursion (goto-address-find-address-at-point))))
a1506d29 239 (if (and address
1c66d9fb
GM
240 (save-excursion
241 (goto-char (previous-single-char-property-change
242 (point) 'goto-address nil
243 (line-beginning-position)))
244 (not (looking-at goto-address-url-regexp))))
f79538c9
DL
245 (compose-mail address)
246 (let ((url (browse-url-url-at-point)))
247 (if url
248 (browse-url url)
249 (error "No e-mail address or URL found")))))))
8749abea
GM
250
251(defun goto-address-find-address-at-point ()
252 "Find e-mail address around or before point.
253Then search backwards to beginning of line for the start of an e-mail
f79538c9
DL
254address. If no e-mail address found, return nil."
255 (re-search-backward "[^-_A-z0-9.@]" (line-beginning-position) 'lim)
256 (if (or (looking-at goto-address-mail-regexp) ; already at start
257 (and (re-search-forward goto-address-mail-regexp
258 (line-end-position) 'lim)
259 (goto-char (match-beginning 0))))
260 (match-string-no-properties 0)))
8749abea
GM
261
262;;;###autoload
263(defun goto-address ()
264 "Sets up goto-address functionality in the current buffer.
265Allows user to use mouse/keyboard command to click to go to a URL
266or to send e-mail.
79c4a646
JL
267By default, goto-address binds `goto-address-at-point' to mouse-2 and C-c RET
268only on URLs and e-mail addresses.
8749abea
GM
269
270Also fontifies the buffer appropriately (see `goto-address-fontify-p' and
271`goto-address-highlight-p' for more information)."
272 (interactive)
8749abea
GM
273 (if goto-address-highlight-p
274 (goto-address-fontify)))
0d61de90 275;;;###autoload(put 'goto-address 'safe-local-eval-function t)
8749abea 276
2cbee4c5
GM
277;;;###autoload
278(define-minor-mode goto-address-mode
279 "Minor mode to buttonize URLs and e-mail addresses in the current buffer."
280 nil
281 ""
282 nil
283 (if goto-address-mode
284 (jit-lock-register #'goto-address-fontify-region)
285 (jit-lock-unregister #'goto-address-fontify-region)
286 (save-restriction
287 (widen)
288 (goto-address-unfontify (point-min) (point-max)))))
289
290;;;###autoload
291(define-minor-mode goto-address-prog-mode
292 "Turn on `goto-address-mode', but only in comments and strings."
293 nil
294 ""
295 nil
296 (if goto-address-prog-mode
297 (jit-lock-register #'goto-address-fontify-region)
298 (jit-lock-unregister #'goto-address-fontify-region)
299 (save-restriction
300 (widen)
301 (goto-address-unfontify (point-min) (point-max)))))
302
8749abea
GM
303(provide 'goto-addr)
304
9fd6c528 305;; arch-tag: ca47c505-5661-425d-a471-62bc6e75cf0a
55535639 306;;; goto-addr.el ends here