X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/12c74386d92efbff9ead54c15959556e59c72f15..937640a621a4ce2e5e56eaecca37a2a28a584318:/lisp/net/goto-addr.el diff --git a/lisp/net/goto-addr.el b/lisp/net/goto-addr.el index 2a11f3dfa1..428da8cbe8 100644 --- a/lisp/net/goto-addr.el +++ b/lisp/net/goto-addr.el @@ -1,6 +1,6 @@ ;;; goto-addr.el --- click to browse URL or to send to e-mail address -;; Copyright (C) 1995, 2000 Free Software Foundation, Inc. +;; Copyright (C) 1995, 2000, 2001 Free Software Foundation, Inc. ;; Author: Eric Ding ;; Maintainer: FSF @@ -50,22 +50,29 @@ ;; m)) ;; -;; BUG REPORTS -;; -;; Please send bug reports to me at ericding@mit.edu. - ;; Known bugs/features: ;; * goto-address-mail-regexp only catches foo@bar.org 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 show buffer is fontified after goto-address-fontify is run -;; (say, using font-lock-fontify-buffer), then font-lock face will +;; * 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 'browse-url) +(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." @@ -73,58 +80,68 @@ :group 'hypermedia) -;;; I don't expect users to want fontify'ing without highlighting. +;; I don't expect users to want fontify'ing without highlighting. (defcustom goto-address-fontify-p t - "*If t, URLs and e-mail addresses in buffer are fontified. + "*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 - "*If t, URLs and e-mail addresses in buffer are highlighted." + "*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 + "*Maximum size of file in which to fontify and/or highlight URLs. +A value of t means there is no limit--fontify regardless of the size." + :type '(choice (integer :tag "Maximum size") (const :tag "No limit" t)) :group 'goto-address) (defvar goto-address-mail-regexp - "[-a-zA-Z0-9._]+@\\([-a-zA-z0-9_]+\\.\\)+[a-zA-Z0-9]+" + ;; 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 - (concat "\\b\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|" - "telnet\\|wais\\):\\(//[-a-zA-Z0-9_.]+:" - "[0-9]*\\)?[-a-zA-Z0-9_=?#$@~`%&*+|\\/.,]*" - "[-a-zA-Z0-9_=#$@~`%&*+|\\/]") + (concat "\\<\\(" + (mapconcat 'identity + (delete "mailto:" (copy-sequence thing-at-point-uri-schemes)) + "\\|") + "\\)" + thing-at-point-url-path-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))) - (define-key m [mouse-2] 'goto-address-at-mouse) - (define-key m "\C-c\r" 'goto-address-at-point) + (if (featurep 'xemacs) + (define-key m (kbd "") 'goto-address-at-mouse) + (define-key m (kbd "") '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." + "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." + "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." + "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." + "Face to use for e-mail addresses when the mouse is on them." :type 'face :group 'goto-address) @@ -132,12 +149,15 @@ But only if `goto-address-highlight-p' is also non-nil." "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-read-only t) - (inhibit-point-motion-hooks t) - (modified (buffer-modified-p))) + (let ((inhibit-point-motion-hooks t)) (goto-char (point-min)) - (if (< (- (point-max) (point)) goto-address-fontify-maximum-size) + (if (or (eq t goto-address-fontify-maximum-size) + (< (- (point-max) (point)) goto-address-fontify-maximum-size)) (progn (while (re-search-forward goto-address-url-regexp nil t) (let* ((s (match-beginning 0)) @@ -148,9 +168,10 @@ and `goto-address-fontify-p'." (overlay-put this-overlay 'mouse-face goto-address-url-mouse-face) (overlay-put this-overlay - 'help-echo "mouse-2: follow URL") + 'help-echo "mouse-2, C-c RET: follow URL") (overlay-put this-overlay - 'keymap goto-address-highlight-keymap))) + '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)) @@ -161,15 +182,13 @@ and `goto-address-fontify-p'." (overlay-put this-overlay 'mouse-face goto-address-mail-mouse-face) (overlay-put this-overlay - 'help-echo "mouse-2: follow URL") + 'help-echo "mouse-2, C-c RET: mail this address") (overlay-put this-overlay - 'keymap goto-address-highlight-keymap))))) - (and (buffer-modified-p) - (not modified) - (set-buffer-modified-p nil))))) + '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 +;; code to find and goto addresses; much of this has been blatantly +;; snarfed from browse-url.el ;;;###autoload (defun goto-address-at-mouse (event) @@ -179,17 +198,8 @@ Send mail to address at position of mouse click. See documentation for there, then load the URL at or before the position of the mouse click." (interactive "e") (save-excursion - (let ((posn (event-start event))) - (set-buffer (window-buffer (posn-window posn))) - (goto-char (posn-point posn)) - (let ((address - (save-excursion (goto-address-find-address-at-point)))) - (if (string-equal address "") - (let ((url (browse-url-url-at-point))) - (if (string-equal url "") - (error "No e-mail address or URL found") - (browse-url url))) - (compose-mail address)))))) + (mouse-set-point event) + (goto-address-at-point))) ;;;###autoload (defun goto-address-at-point () @@ -200,25 +210,28 @@ there, then load the URL at or before point." (interactive) (save-excursion (let ((address (save-excursion (goto-address-find-address-at-point)))) - (if (string-equal address "") - (let ((url (browse-url-url-at-point))) - (if (string-equal url "") - (error "No e-mail address or URL found") - (browse-url url))) - (compose-mail address))))) + (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 the empty string." - (let ((bol (save-excursion (beginning-of-line) (point)))) - (re-search-backward "[^-_A-z0-9.@]" bol 'lim) - (if (or (looking-at goto-address-mail-regexp) ; already at start - (let ((eol (save-excursion (end-of-line) (point)))) - (and (re-search-forward goto-address-mail-regexp eol 'lim) - (goto-char (match-beginning 0))))) - (buffer-substring (match-beginning 0) (match-end 0)) - "")))m +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 () @@ -235,4 +248,5 @@ Also fontifies the buffer appropriately (see `goto-address-fontify-p' and (provide 'goto-addr) -;;; goto-addr.el ends here. +;;; arch-tag: ca47c505-5661-425d-a471-62bc6e75cf0a +;;; goto-addr.el ends here