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