view lisp/net/goto-addr.el @ 45470:adebb58b0c5e

(x_write_glyphs): Clear phys_cursor_on_p if current phys_cursor's hpos is overwritten. This is still not completely correct, as it doesn't really make sense to use hpos at all to get the cursor glyph (as that is relative to the width of the characters on the line, which may have changed during the update).

;;; goto-addr.el --- click to browse URL or to send to e-mail address

;; Copyright (C) 1995, 2000, 2001 Free Software Foundation, Inc.

;; Author: Eric Ding <[e-mail]>
;; Maintainer: FSF
;; Created: 15 Aug 1995
;; Keywords: mh-e, www, mouse, mail

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; This package allows you to click or hit a key sequence while on a
;; URL or e-mail address, and either load the URL into a browser of
;; your choice using the browse-url package, or if it's an e-mail
;; address, to send an e-mail to that address.  By default, we bind to
;; the [mouse-2] and the [C-c return] key sequences.

;; INSTALLATION
;;
;; To use goto-address in a particular mode (for example, while
;; reading mail in mh-e), add something like this in your .emacs file:
;;
;; (add-hook 'mh-show-mode-hook 'goto-address)
;;
;; The mouse click method is bound to [mouse-2] on highlighted URLs or
;; e-mail addresses only; it functions normally everywhere else.  To bind
;; another mouse click to the function, add the following to your .emacs
;; (for example):
;;
;; (setq goto-address-highlight-keymap
;;   (let ((m (make-sparse-keymap)))
;;     (define-key m [S-mouse-2] 'goto-address-at-mouse)
;;     m))
;;

;; Known bugs/features:
;; * goto-address-mail-regexp only catches [e-mail] style addressing,
;;   not stuff like X.400 addresses, etc.
;; * regexp also catches Message-Id line, since it is in the format of
;;   an Internet e-mail address (like Compuserve addresses)
;; * If the buffer is fontified after goto-address-fontify is run
;;   (say, using font-lock-fontify-buffer), then font-lock faces will
;;   override goto-address faces.

;;; Code:

(require 'thingatpt)
(autoload 'browse-url-url-at-point "browse-url")

;; XEmacs needs the following definitions.
(unless (fboundp 'overlays-in)
  (require 'overlay))
(unless (fboundp 'line-beginning-position)
  (defalias 'line-beginning-position 'point-at-bol))
(unless (fboundp 'line-end-position)
  (defalias 'line-end-position 'point-at-eol))
(unless (fboundp 'match-string-no-properties)
  (defalias 'match-string-no-properties 'match-string))

(defgroup goto-address nil
  "Click to browse URL or to send to e-mail address."
  :group 'mouse
  :group 'hypermedia)


;; I don't expect users to want fontify'ing without highlighting.
(defcustom goto-address-fontify-p t
  "*Non-nil means URLs and e-mail addresses in buffer are fontified.
But only if `goto-address-highlight-p' is also non-nil."
  :type 'boolean
  :group 'goto-address)

(defcustom goto-address-highlight-p t
  "*Non-nil means URLs and e-mail addresses in buffer are highlighted."
  :type 'boolean
  :group 'goto-address)

(defcustom goto-address-fontify-maximum-size 30000
  "*Maximum size of file in which to fontify and/or highlight URLs."
  :type 'integer
  :group 'goto-address)

(defvar goto-address-mail-regexp
  ;; Actually pretty much any char could appear in the username part.  -stef
  "[-a-zA-Z0-9._+]+@\\([-a-zA-z0-9_]+\\.\\)+[a-zA-Z0-9]+"
  "A regular expression probably matching an e-mail address.")

(defvar goto-address-url-regexp thing-at-point-url-regexp
  ;; (concat "\\b\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|"
  ;; 	  "telnet\\|wais\\):\\(//[-a-zA-Z0-9_.]+:"
  ;; 	  "[0-9]*\\)?[-a-zA-Z0-9_=?#$@~`%&*+|\\/.,]*"
  ;; 	  "[-a-zA-Z0-9_=#$@~`%&*+|\\/]")
  "A regular expression probably matching a URL.")

(defvar goto-address-highlight-keymap
  (let ((m (make-sparse-keymap)))
    (if (featurep 'xemacs)
	(define-key m (kbd "<button2>") 'goto-address-at-mouse)
      (define-key m (kbd "<mouse-2>") 'goto-address-at-mouse))
    (define-key m (kbd "C-c RET") 'goto-address-at-point)
    m)
  "keymap to hold goto-addr's mouse key defs under highlighted URLs.")

(defcustom goto-address-url-face 'bold
  "Face to use for URLs."
  :type 'face
  :group 'goto-address)

(defcustom goto-address-url-mouse-face 'highlight
  "Face to use for URLs when the mouse is on them."
  :type 'face
  :group 'goto-address)

(defcustom goto-address-mail-face 'italic
  "Face to use for e-mail addresses."
  :type 'face
  :group 'goto-address)

(defcustom goto-address-mail-mouse-face 'secondary-selection
  "Face to use for e-mail addresses when the mouse is on them."
  :type 'face
  :group 'goto-address)

(defun goto-address-fontify ()
  "Fontify the URLs and e-mail addresses in the current buffer.
This function implements `goto-address-highlight-p'
and `goto-address-fontify-p'."
  ;; Clean up from any previous go.
  (dolist (overlay (overlays-in (point-min) (point-max)))
    (if (overlay-get overlay 'goto-address)
	(delete-overlay overlay)))
  (save-excursion
    (let ((inhibit-point-motion-hooks t))
      (goto-char (point-min))
      (if (< (- (point-max) (point)) goto-address-fontify-maximum-size)
	  (progn
	    (while (re-search-forward goto-address-url-regexp nil t)
              (let* ((s (match-beginning 0))
                     (e (match-end 0))
                     (this-overlay (make-overlay s e)))
		(and goto-address-fontify-p
                     (overlay-put this-overlay 'face goto-address-url-face))
		(overlay-put this-overlay
                             'mouse-face goto-address-url-mouse-face)
		(overlay-put this-overlay
			     'help-echo "mouse-2: follow URL")
		(overlay-put this-overlay
                             'keymap goto-address-highlight-keymap)
		(overlay-put this-overlay 'goto-address t)))
	    (goto-char (point-min))
	    (while (re-search-forward goto-address-mail-regexp nil t)
              (let* ((s (match-beginning 0))
                     (e (match-end 0))
                     (this-overlay (make-overlay s e)))
		(and goto-address-fontify-p
                     (overlay-put this-overlay 'face goto-address-mail-face))
                (overlay-put this-overlay 'mouse-face
                             goto-address-mail-mouse-face)
		(overlay-put this-overlay
			     'help-echo "mouse-2: mail this address")
                (overlay-put this-overlay
                             'keymap goto-address-highlight-keymap)
		(overlay-put this-overlay 'goto-address t))))))))

;; code to find and goto addresses; much of this has been blatantly
;; snarfed from browse-url.el

;;;###autoload
(defun goto-address-at-mouse (event)
  "Send to the e-mail address or load the URL clicked with the mouse.
Send mail to address at position of mouse click.  See documentation for
`goto-address-find-address-at-point'.  If no address is found
there, then load the URL at or before the position of the mouse click."
  (interactive "e")
  (save-excursion
    (mouse-set-point event)
    (goto-address-at-point)))

;;;###autoload
(defun goto-address-at-point ()
  "Send to the e-mail address or load the URL at point.
Send mail to address at point.  See documentation for
`goto-address-find-address-at-point'.  If no address is found
there, then load the URL at or before point."
  (interactive)
  (save-excursion
    (let ((address (save-excursion (goto-address-find-address-at-point))))
      (if (and address 
	       (save-excursion
		 (goto-char (previous-single-char-property-change
			     (point) 'goto-address nil
			     (line-beginning-position)))
		 (not (looking-at goto-address-url-regexp))))
	  (compose-mail address)
	(let ((url (browse-url-url-at-point)))
	  (if url
	      (browse-url url)
	    (error "No e-mail address or URL found")))))))

(defun goto-address-find-address-at-point ()
  "Find e-mail address around or before point.
Then search backwards to beginning of line for the start of an e-mail
address.  If no e-mail address found, return nil."
  (re-search-backward "[^-_A-z0-9.@]" (line-beginning-position) 'lim)
  (if (or (looking-at goto-address-mail-regexp)	; already at start
	  (and (re-search-forward goto-address-mail-regexp
				  (line-end-position) 'lim)
	       (goto-char (match-beginning 0))))
      (match-string-no-properties 0)))

;;;###autoload
(defun goto-address ()
  "Sets up goto-address functionality in the current buffer.
Allows user to use mouse/keyboard command to click to go to a URL
or to send e-mail.
By default, goto-address binds to mouse-2 and C-c RET.

Also fontifies the buffer appropriately (see `goto-address-fontify-p' and
`goto-address-highlight-p' for more information)."
  (interactive)
  (if goto-address-highlight-p
      (goto-address-fontify)))

(provide 'goto-addr)

;;; goto-addr.el ends here