1 ;;; goto-addr.el --- click to browse URL or to send to e-mail address
2 ;; Copyright (C) 1995 Free Software Foundation, Inc.
4 ;; Author: Eric Ding <ericding@mit.edu>
5 ;; Maintainer: Eric Ding <ericding@mit.edu>
6 ;; Created: 15 Aug 1995
7 ;; Keywords: mh-e, www, mouse, mail
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software; you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to
23 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
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.
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:
38 ;; (add-hook 'mh-show-mode-hook 'goto-address)
40 ;; By default, goto-address now sends using `mail' instead of `mh-send'.
41 ;; To use mh-e to send mail, add the following to your .emacs file:
43 ;; (setq goto-address-mail-method 'goto-address-send-using-mhe)
45 ;; The mouse click method is bound to [mouse-2] on highlighted URL's or
46 ;; e-mail addresses only; it functions normally everywhere else. To bind
47 ;; another mouse click to the function, add the following to your .emacs
50 ;; (setq goto-address-highlight-keymap
51 ;; (let ((m (make-sparse-keymap)))
52 ;; (define-key m [S-mouse-2] 'goto-address-at-mouse)
58 ;; Please send bug reports to me at ericding@mit.edu.
60 ;; Known bugs/features:
61 ;; * goto-address-mail-regexp only catches foo@bar.org style addressing,
62 ;; not stuff like X.400 addresses, etc.
63 ;; * regexp also catches Message-Id line, since it is in the format of
64 ;; an Internet e-mail address (like Compuserve addresses)
65 ;; * If show buffer is fontified after goto-address-fontify is run
66 ;; (say, using font-lock-fontify-buffer), then font-lock face will
67 ;; override goto-address faces.
73 ;;; I don't expect users to want fontify'ing without highlighting.
74 (defvar goto-address-fontify-p t
75 "*If t, URL's and e-mail addresses in buffer are fontified.
76 But only if `goto-address-highlight-p' is also non-nil.")
78 (defvar goto-address-highlight-p t
79 "*If t, URL's and e-mail addresses in buffer are highlighted.")
81 (defvar goto-address-fontify-maximum-size 30000
82 "*Maximum size of file in which to fontify and/or highlight URL's.")
84 (defvar goto-address-mail-regexp
85 "[-a-zA-Z0-9._]+@\\([-a-zA-z0-9_]+\\.\\)+[a-zA-Z0-9]+"
86 "A regular expression probably matching an e-mail address.")
88 (defvar goto-address-url-regexp
89 (concat "\\b\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|"
90 "telnet\\|wais\\):\\(//[-a-zA-Z0-9_.]+:"
91 "[0-9]*\\)?[-a-zA-Z0-9_=?#$@~`%&*+|\\/.,]*"
92 "[-a-zA-Z0-9_=#$@~`%&*+|\\/]")
93 "A regular expression probably matching a URL.")
95 (defvar goto-address-mail-method
96 'goto-address-send-using-mail
97 "*Function to compose mail.
98 Two pre-made functions are `goto-address-send-using-mail' (sendmail);
99 and `goto-address-send-using-mhe' (MH-E).")
101 (defvar goto-address-highlight-keymap
102 (let ((m (make-sparse-keymap)))
103 (define-key m [mouse-2] 'goto-address-at-mouse)
105 "keymap to hold goto-addr's mouse key defs under highlighted URLs.")
107 (defun goto-address-fontify ()
108 "Fontify the URL's and e-mail addresses in the current buffer.
109 This function implements `goto-address-highlight-p'
110 and `goto-address-fontify-p'."
112 (let ((inhibit-read-only t)
113 (inhibit-point-motion-hooks t)
114 (modified (buffer-modified-p)))
115 (goto-char (point-min))
116 (if (< (- (point-max) (point)) goto-address-fontify-maximum-size)
118 (while (re-search-forward goto-address-url-regexp nil t)
119 (let ((s (match-beginning 0))
122 (and goto-address-fontify-p
123 (put-text-property s e 'face 'bold))
124 (put-text-property s e 'mouse-face 'highlight)
126 s e 'local-map goto-address-highlight-keymap)))
127 (goto-char (point-min))
128 (while (re-search-forward goto-address-mail-regexp nil t)
129 (let ((s (match-beginning 0))
131 (goto-char (match-end 0))
132 (and goto-address-fontify-p
133 (put-text-property (match-beginning 0) (match-end 0)
135 (put-text-property (match-beginning 0) (match-end 0)
136 'mouse-face 'secondary-selection)
138 s e 'local-map goto-address-highlight-keymap)))))
139 (and (buffer-modified-p)
141 (set-buffer-modified-p nil)))))
143 ;;; code to find and goto addresses; much of this has been blatantly
144 ;;; snarfed from browse-url.el
146 (defun goto-address-at-mouse (event)
147 "Send to the e-mail address or load the URL clicked with the mouse.
148 Send mail to address at position of mouse click. See documentation for
149 `goto-address-find-address-at-point'. If no address is found
150 there, then load the URL at or before the position of the mouse click."
153 (let ((posn (event-start event)))
154 (set-buffer (window-buffer (posn-window posn)))
155 (goto-char (posn-point posn))
157 (save-excursion (goto-address-find-address-at-point))))
158 (if (string-equal address "")
159 (let ((url (browse-url-url-at-point)))
160 (if (string-equal url "")
161 (error "No e-mail address or URL found")
162 (funcall browse-url-browser-function url)))
163 (funcall goto-address-mail-method address))))))
165 (defun goto-address-at-point ()
166 "Send to the e-mail address or load the URL at point.
167 Send mail to address at point. See documentation for
168 `goto-address-find-address-at-point'. If no address is found
169 there, then load the URL at or before point."
172 (let ((address (save-excursion (goto-address-find-address-at-point))))
173 (if (string-equal address "")
174 (let ((url (browse-url-url-at-point)))
175 (if (string-equal url "")
176 (error "No e-mail address or URL found")
177 (funcall browse-url-browser-function url)))
178 (funcall goto-address-mail-method address)))))
180 (defun goto-address-find-address-at-point ()
181 "Find e-mail address around or before point.
182 Then search backwards to beginning of line for the start of an e-mail
183 address. If no e-mail address found, return the empty string."
184 (let ((bol (save-excursion (beginning-of-line) (point))))
185 (re-search-backward "[^-_A-z0-9.@]" bol 'lim)
186 (if (or (looking-at goto-address-mail-regexp) ; already at start
187 (let ((eol (save-excursion (end-of-line) (point))))
188 (and (re-search-forward goto-address-mail-regexp eol 'lim)
189 (goto-char (match-beginning 0)))))
190 (buffer-substring (match-beginning 0) (match-end 0))
193 (defun goto-address-send-using-mhe (to)
195 (let ((cc (mh-read-address "Cc: "))
196 (subject (read-string "Subject: "))
197 (config (current-window-configuration)))
198 (delete-other-windows)
199 (mh-send-sub to cc subject config)))
201 (defun goto-address-send-using-mail (to)
202 (mail-other-window nil to)
203 (and (goto-char (point-min))
207 (defun goto-address ()
208 "Sets up goto-address functionality in the current buffer.
209 Allows user to use mouse/keyboard command to click to go to a URL
211 By default, goto-address binds to mouse-2 and C-c RET.
213 Also fontifies the buffer appropriately (see `goto-address-fontify-p' and
214 `goto-address-highlight-p' for more information)."
216 (local-set-key "\C-c\r" 'goto-address-at-point)
217 (if goto-address-highlight-p
218 (goto-address-fontify)))
222 ;;; goto-addr.el ends here.