1;;; goto-addr.el --- click to browse URL or to send to e-mail address 2 3;; Copyright (C) 1995, 2000, 2001, 2002, 2003, 2004, 4;; 2005, 2006, 2007 Free Software Foundation, Inc. 5 6;; Author: Eric Ding <ericding@alum.mit.edu> 7;; Maintainer: FSF 8;; Created: 15 Aug 1995 9;; Keywords: mh-e, www, mouse, mail 10 11;; This file is part of GNU Emacs. 12 13;; GNU Emacs is free software; you can redistribute it and/or modify 14;; it under the terms of the GNU General Public License as published by 15;; the Free Software Foundation; either version 2, or (at your option) 16;; any later version. 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 24;; along with GNU Emacs; see the file COPYING. If not, write to the 25;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 26;; Boston, MA 02110-1301, USA. 27 28;;; Commentary: 29 30;; This package allows you to click or hit a key sequence while on a 31;; URL or e-mail address, and either load the URL into a browser of 32;; your choice using the browse-url package, or if it's an e-mail 33;; address, to send an e-mail to that address. By default, we bind to 34;; the [mouse-2] and the [C-c return] key sequences. 35 36;; INSTALLATION 37;; 38;; To use goto-address in a particular mode (for example, while 39;; reading mail in mh-e), add something like this in your .emacs file: 40;; 41;; (add-hook 'mh-show-mode-hook 'goto-address) 42;; 43;; The mouse click method is bound to [mouse-2] on highlighted URLs or 44;; e-mail addresses only; it functions normally everywhere else. To bind 45;; another mouse click to the function, add the following to your .emacs 46;; (for example): 47;; 48;; (setq goto-address-highlight-keymap 49;; (let ((m (make-sparse-keymap))) 50;; (define-key m [S-mouse-2] 'goto-address-at-point) 51;; m)) 52;; 53 54;; Known bugs/features: 55;; * goto-address-mail-regexp only catches foo@bar.org style addressing, 56;; not stuff like X.400 addresses, etc. 57;; * regexp also catches Message-Id line, since it is in the format of 58;; an Internet e-mail address (like Compuserve addresses) 59;; * If the buffer is fontified after goto-address-fontify is run 60;; (say, using font-lock-fontify-buffer), then font-lock faces will 61;; override goto-address faces. 62 63;;; Code: 64 65(require 'thingatpt) 66(autoload 'browse-url-url-at-point "browse-url") 67 68;; XEmacs needs the following definitions. 69(unless (fboundp 'overlays-in) 70 (require 'overlay)) 71(unless (fboundp 'line-beginning-position) 72 (defalias 'line-beginning-position 'point-at-bol)) 73(unless (fboundp 'line-end-position) 74 (defalias 'line-end-position 'point-at-eol)) 75(unless (fboundp 'match-string-no-properties) 76 (defalias 'match-string-no-properties 'match-string)) 77 78(defgroup goto-address nil 79 "Click to browse URL or to send to e-mail address." 80 :group 'mouse 81 :group 'hypermedia) 82 83 84;; I don't expect users to want fontify'ing without highlighting. 85(defcustom goto-address-fontify-p t 86 "*Non-nil means URLs and e-mail addresses in buffer are fontified. 87But only if `goto-address-highlight-p' is also non-nil." 88 :type 'boolean 89 :group 'goto-address) 90 91(defcustom goto-address-highlight-p t 92 "*Non-nil means URLs and e-mail addresses in buffer are highlighted." 93 :type 'boolean 94 :group 'goto-address) 95 96(defcustom goto-address-fontify-maximum-size 30000 97 "*Maximum size of file in which to fontify and/or highlight URLs. 98A 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)) 100 :group 'goto-address) 101 102(defvar goto-address-mail-regexp 103 ;; Actually pretty much any char could appear in the username part. -stef 104 "[-a-zA-Z0-9=._+]+@\\([-a-zA-z0-9_]+\\.\\)+[a-zA-Z0-9]+" 105 "A regular expression probably matching an e-mail address.") 106 107(defvar goto-address-url-regexp 108 (concat 109 "\\<\\(" 110 (mapconcat 'identity 111 (delete "mailto:" 112 ;; Remove `data:', as it's not terribly useful to follow 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) 120 ;; (concat "\\b\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|" 121 ;; "telnet\\|wais\\):\\(//[-a-zA-Z0-9_.]+:" 122 ;; "[0-9]*\\)?[-a-zA-Z0-9_=?#$@~`%&*+|\\/.,]*" 123 ;; "[-a-zA-Z0-9_=#$@~`%&*+|\\/]") 124 "A regular expression probably matching a URL.") 125 126(defvar goto-address-highlight-keymap 127 (let ((m (make-sparse-keymap))) 128 (define-key m (if (featurep 'xemacs) (kbd "<button2>") (kbd "<mouse-2>")) 129 'goto-address-at-point) 130 (define-key m (kbd "C-c RET") 'goto-address-at-point) 131 m) 132 "Keymap to hold goto-addr's mouse key defs under highlighted URLs.") 133 134(defcustom goto-address-url-face 'bold 135 "Face to use for URLs." 136 :type 'face 137 :group 'goto-address) 138 139(defcustom goto-address-url-mouse-face 'highlight 140 "Face to use for URLs when the mouse is on them." 141 :type 'face 142 :group 'goto-address) 143 144(defcustom goto-address-mail-face 'italic 145 "Face to use for e-mail addresses." 146 :type 'face 147 :group 'goto-address) 148 149(defcustom goto-address-mail-mouse-face 'secondary-selection 150 "Face to use for e-mail addresses when the mouse is on them." 151 :type 'face 152 :group 'goto-address) 153 154(defun goto-address-fontify () 155 "Fontify the URLs and e-mail addresses in the current buffer. 156This function implements `goto-address-highlight-p' 157and `goto-address-fontify-p'." 158 ;; Clean up from any previous go. 159 (dolist (overlay (overlays-in (point-min) (point-max))) 160 (if (overlay-get overlay 'goto-address) 161 (delete-overlay overlay))) 162 (save-excursion 163 (let ((inhibit-point-motion-hooks t)) 164 (goto-char (point-min)) 165 (if (or (eq t goto-address-fontify-maximum-size) 166 (< (- (point-max) (point)) goto-address-fontify-maximum-size)) 167 (progn 168 (while (re-search-forward goto-address-url-regexp nil t) 169 (let* ((s (match-beginning 0)) 170 (e (match-end 0)) 171 (this-overlay (make-overlay s e))) 172 (and goto-address-fontify-p 173 (overlay-put this-overlay 'face goto-address-url-face)) 174 (overlay-put this-overlay 'evaporate t) 175 (overlay-put this-overlay 176 'mouse-face goto-address-url-mouse-face) 177 (overlay-put this-overlay 'follow-link t) 178 (overlay-put this-overlay 179 'help-echo "mouse-2, C-c RET: follow URL") 180 (overlay-put this-overlay 181 'keymap goto-address-highlight-keymap) 182 (overlay-put this-overlay 'goto-address t))) 183 (goto-char (point-min)) 184 (while (re-search-forward goto-address-mail-regexp nil t) 185 (let* ((s (match-beginning 0)) 186 (e (match-end 0)) 187 (this-overlay (make-overlay s e))) 188 (and goto-address-fontify-p 189 (overlay-put this-overlay 'face goto-address-mail-face)) 190 (overlay-put this-overlay 'evaporate t) 191 (overlay-put this-overlay 'mouse-face 192 goto-address-mail-mouse-face) 193 (overlay-put this-overlay 'follow-link t) 194 (overlay-put this-overlay 195 'help-echo "mouse-2, C-c RET: mail this address") 196 (overlay-put this-overlay 197 'keymap goto-address-highlight-keymap) 198 (overlay-put this-overlay 'goto-address t)))))))) 199 200;; code to find and goto addresses; much of this has been blatantly 201;; snarfed from browse-url.el 202 203;;;###autoload 204(define-obsolete-function-alias 205 'goto-address-at-mouse 'goto-address-at-point "22.1") 206 207;;;###autoload 208(defun goto-address-at-point (&optional event) 209 "Send to the e-mail address or load the URL at point. 210Send mail to address at point. See documentation for 211`goto-address-find-address-at-point'. If no address is found 212there, then load the URL at or before point." 213 (interactive (list last-input-event)) 214 (save-excursion 215 (if event (posn-set-point (event-end event))) 216 (let ((address (save-excursion (goto-address-find-address-at-point)))) 217 (if (and address 218 (save-excursion 219 (goto-char (previous-single-char-property-change 220 (point) 'goto-address nil 221 (line-beginning-position))) 222 (not (looking-at goto-address-url-regexp)))) 223 (compose-mail address) 224 (let ((url (browse-url-url-at-point))) 225 (if url 226 (browse-url url) 227 (error "No e-mail address or URL found"))))))) 228 229(defun goto-address-find-address-at-point () 230 "Find e-mail address around or before point. 231Then search backwards to beginning of line for the start of an e-mail 232address. If no e-mail address found, return nil." 233 (re-search-backward "[^-_A-z0-9.@]" (line-beginning-position) 'lim) 234 (if (or (looking-at goto-address-mail-regexp) ; already at start 235 (and (re-search-forward goto-address-mail-regexp 236 (line-end-position) 'lim) 237 (goto-char (match-beginning 0)))) 238 (match-string-no-properties 0))) 239 240;;;###autoload 241(defun goto-address () 242 "Sets up goto-address functionality in the current buffer. 243Allows user to use mouse/keyboard command to click to go to a URL 244or to send e-mail. 245By default, goto-address binds `goto-address-at-point' to mouse-2 and C-c RET 246only on URLs and e-mail addresses. 247 248Also fontifies the buffer appropriately (see `goto-address-fontify-p' and 249`goto-address-highlight-p' for more information)." 250 (interactive) 251 (if goto-address-highlight-p 252 (goto-address-fontify))) 253;;;###autoload(put 'goto-address 'safe-local-eval-function t) 254 255(provide 'goto-addr) 256 257;; arch-tag: ca47c505-5661-425d-a471-62bc6e75cf0a 258;;; goto-addr.el ends here 259