code.delx.au - gnu-emacs/blob - lisp/goto-addr.el

   1 ;;; goto-addr.el --- click to browse URL or to send to e-mail address
   2 ;; Copyright (C) 1995 Free Software Foundation, Inc.
   3
   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
   8
   9 ;; This file is part of GNU Emacs.
  10
  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)
  14 ;; any later version.
  15
  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.
  20
  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.
  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 [S-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 ;;
  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:
  42 ;;
  43 ;; (setq goto-address-mail-method 'goto-address-send-using-mhe)
  44 ;;
  45 ;; To rebind, for example, the mouse click method to [mouse-2] in
  46 ;; mh-show-mode, add the following (instead of the first add-hook example
  47 ;; above) to your .emacs file:
  48 ;;
  49 ;; (defun my-goto-address ()
  50 ;;   (goto-address)
  51 ;;   (local-unset-key [S-mouse-2])
  52 ;;   (local-set-key [mouse-2] 'goto-address-at-mouse))
  53 ;;
  54 ;; (add-hook 'mh-show-mode-hook 'my-goto-address)
  55 ;;
  56 ;; [mouse-2] is not the default mouse binding because I use goto-address in
  57 ;; some editable buffers, where [mouse-2] means mouse-yank-at-click, as well
  58 ;; as in some modes where [mouse-2] is bound to other useful functions.
  59
  60 ;; BUG REPORTS
  61 ;;
  62 ;; Please send bug reports to me at ericding@mit.edu.
  63
  64 ;; Known bugs/features:
  65 ;; * goto-address-mail-regexp only catches foo@bar.org style addressing,
  66 ;;   not stuff like X.400 addresses, etc.
  67 ;; * regexp also catches Message-Id line, since it is in the format of
  68 ;;   an Internet e-mail address (like Compuserve addresses)
  69 ;; * If show buffer is fontified after goto-address-fontify is run
  70 ;;   (say, using font-lock-fontify-buffer), then font-lock face will
  71 ;;   override goto-address faces.
  72
  73 ;;; Code:
  74
  75 (require 'browse-url)
  76
  77 ;;; I don't expect users to want fontify'ing without highlighting.
  78 (defvar goto-address-fontify-p t
  79   "*If t, URL's and e-mail addresses in buffer are fontified.
  80 But only if `goto-address-highlight-p' is also non-nil.")
  81
  82 (defvar goto-address-highlight-p t
  83   "*If t, URL's and e-mail addresses in buffer are highlighted.")
  84
  85 (defvar goto-address-fontify-maximum-size 30000
  86   "*Maximum size of file in which to fontify and/or highlight URL's.")
  87
  88 (defvar goto-address-mail-regexp
  89   "[-a-zA-Z0-9._]+@\\([-a-zA-z0-9_]+\\.\\)+[a-zA-Z0-9]+"
  90   "A regular expression probably matching an e-mail address.")
  91
  92 (defvar goto-address-url-regexp
  93   (concat "\\b\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|"
  94           "telnet\\|wais\\):\\(//[-a-zA-Z0-9_.]+:"
  95           "[0-9]*\\)?[-a-zA-Z0-9_=?#$@~`%&*+|\\/.,]*"
  96           "[-a-zA-Z0-9_=#$@~`%&*+|\\/]")
  97   "A regular expression probably matching a URL.")
  98
  99 (defvar goto-address-mail-method
 100   'goto-address-send-using-mail
 101   "*Function to compose mail.
 102 Two pre-made functions are `goto-address-send-using-mail' (sendmail);
 103 and `goto-address-send-using-mhe' (MH-E).")
 104
 105 (defun goto-address-fontify ()
 106   "Fontify the URL's and e-mail addresses in the current buffer.
 107 This function implements `goto-address-highlight-p'
 108 and `goto-address-fontify-p'."
 109   (save-excursion
 110     (let ((inhibit-read-only t)
 111           (inhibit-point-motion-hooks t)
 112           (modified (buffer-modified-p)))
 113       (goto-char (point-min))
 114       (if (< (- (point-max) (point)) goto-address-fontify-maximum-size)
 115           (progn
 116             (while (re-search-forward goto-address-url-regexp nil t)
 117               (progn
 118                 (goto-char (match-end 0))
 119                 (and goto-address-fontify-p
 120                      (put-text-property (match-beginning 0) (match-end 0)
 121                                         'face 'bold))
 122                 (put-text-property (match-beginning 0) (match-end 0)
 123                                    'mouse-face 'highlight)))
 124             (goto-char (point-min))
 125             (while (re-search-forward goto-address-mail-regexp nil t)
 126               (progn
 127                 (goto-char (match-end 0))
 128                 (and goto-address-fontify-p
 129                      (put-text-property (match-beginning 0) (match-end 0)
 130                                         'face 'italic))
 131                 (put-text-property (match-beginning 0) (match-end 0)
 132                                'mouse-face 'secondary-selection)))))
 133       (and (buffer-modified-p)
 134            (not modified)
 135            (set-buffer-modified-p nil)))))
 136
 137 ;;; code to find and goto addresses; much of this has been blatantly
 138 ;;; snarfed from browse-url.el
 139
 140 (defun goto-address-at-mouse (event)
 141   "Send to the e-mail address or load the URL clicked with the mouse.
 142 Send mail to address at position of mouse click.  See documentation for
 143 `goto-address-find-address-at-point'.  If no address is found
 144 there, then load the URL at or before the position of the mouse click."
 145   (interactive "e")
 146   (save-excursion
 147     (let ((posn (event-start event)))
 148       (set-buffer (window-buffer (posn-window posn)))
 149       (goto-char (posn-point posn))
 150       (let ((address
 151              (save-excursion (goto-address-find-address-at-point))))
 152         (if (string-equal address "")
 153             (let ((url (browse-url-url-at-point)))
 154               (if (string-equal url "")
 155                   (error "No e-mail address or URL found")
 156                 (funcall browse-url-browser-function url)))
 157           (funcall goto-address-mail-method address))))))
 158
 159 (defun goto-address-at-point ()
 160   "Send to the e-mail address or load the URL at point.
 161 Send mail to address at point.  See documentation for
 162 `goto-address-find-address-at-point'.  If no address is found
 163 there, then load the URL at or before point."
 164   (interactive)
 165   (save-excursion
 166     (let ((address (save-excursion (goto-address-find-address-at-point))))
 167       (if (string-equal address "")
 168           (let ((url (browse-url-url-at-point)))
 169             (if (string-equal url "")
 170                 (error "No e-mail address or URL found")
 171               (funcall browse-url-browser-function url)))
 172         (funcall goto-address-mail-method address)))))
 173
 174 (defun goto-address-find-address-at-point ()
 175   "Find e-mail address around or before point.
 176 Then search backwards to beginning of line for the start of an e-mail
 177 address.  If no e-mail address found, return the empty string."
 178   (let ((bol (save-excursion (beginning-of-line) (point))))
 179     (re-search-backward "[^-_A-z0-9.@]" bol 'lim)
 180     (if (or (looking-at goto-address-mail-regexp)  ; already at start
 181             (let ((eol (save-excursion (end-of-line) (point))))
 182               (and (re-search-forward goto-address-mail-regexp eol 'lim)
 183                    (goto-char (match-beginning 0)))))
 184         (buffer-substring (match-beginning 0) (match-end 0))
 185       "")))
 186
 187 (defun goto-address-send-using-mhe (to)
 188   (mh-find-path)
 189   (let ((cc (mh-read-address "Cc: "))
 190         (subject (read-string "Subject: "))
 191         (config (current-window-configuration)))
 192     (delete-other-windows)
 193     (mh-send-sub to cc subject config)))
 194
 195 (defun goto-address-send-using-mail (to)
 196   (mail-other-window nil to)
 197   (and (goto-char (point-min))
 198        (end-of-line 2)))
 199
 200 ;;;###autoload
 201 (defun goto-address ()
 202   "Sets up goto-address functionality in the current buffer.
 203 Allows user to use mouse/keyboard command to click to go to a URL
 204 or to send e-mail.
 205 By default, goto-address binds to S-mouse-2 and C-c RET.
 206
 207 Also fontifies the buffer appropriately (see `goto-address-fontify-p' and
 208 `goto-address-highlight-p' for more information)."
 209   (interactive)
 210   (local-set-key [S-mouse-2] 'goto-address-at-mouse)
 211   (local-set-key "\C-c\r" 'goto-address-at-point)
 212   (if goto-address-highlight-p
 213       (goto-address-fontify)))
 214
 215 (provide 'goto-addr)
 216
 217 ;;; goto-addr.el ends here.