]> code.delx.au - gnu-emacs/blobdiff - lisp/net/goto-addr.el
; Fix breakage from previous commit
[gnu-emacs] / lisp / net / goto-addr.el
index 775041903ff97ac4fc6bdefaad46ba7b64e2f1d9..bc3c403e2f2701a858aae89eb88d6389ff269c40 100644 (file)
@@ -1,19 +1,18 @@
 ;;; goto-addr.el --- click to browse URL or to send to e-mail address
 
-;; Copyright (C) 1995, 2000, 2001, 2002, 2003, 2004,
-;;   2005, 2006, 2007 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 2000-2016 Free Software Foundation, Inc.
 
 ;; Author: Eric Ding <ericding@alum.mit.edu>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
 ;; 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
+;; 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.
+;; the Free Software Foundation, either version 3 of the License, 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
@@ -21,9 +20,7 @@
 ;; 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
@@ -36,7 +33,7 @@
 ;; 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:
+;; reading mail in mh-e), add this to your init file:
 ;;
 ;; (add-hook 'mh-show-mode-hook 'goto-address)
 ;;
 (defgroup goto-address nil
   "Click to browse URL or to send to e-mail address."
   :group 'mouse
-  :group 'hypermedia)
+  :group 'comm)
 
 
 ;; 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.
+  "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."
+  "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.
+  "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)
@@ -131,7 +128,7 @@ A value of t means there is no limit--fontify regardless of the size."
     m)
   "Keymap to hold goto-addr's mouse key defs under highlighted URLs.")
 
-(defcustom goto-address-url-face 'bold
+(defcustom goto-address-url-face 'link
   "Face to use for URLs."
   :type 'face
   :group 'goto-address)
@@ -151,51 +148,74 @@ A value of t means there is no limit--fontify regardless of the size."
   :type 'face
   :group 'goto-address)
 
-(defun goto-address-fontify ()
+(defun goto-address-unfontify (start end)
+  "Remove `goto-address' fontification from the given region."
+  (dolist (overlay (overlays-in start end))
+    (if (overlay-get overlay 'goto-address)
+       (delete-overlay overlay))))
+
+(defvar goto-address-prog-mode)
+
+(defun goto-address-fontify (&optional start end)
   "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)))
+  (goto-address-unfontify (or start (point-min)) (or end (point-max)))
   (save-excursion
     (let ((inhibit-point-motion-hooks t))
-      (goto-char (point-min))
-      (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))
-                     (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 'evaporate t)
-               (overlay-put this-overlay
-                             'mouse-face goto-address-url-mouse-face)
-               (overlay-put this-overlay 'follow-link t)
-               (overlay-put this-overlay
-                            'help-echo "mouse-2, C-c RET: 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 'evaporate t)
-                (overlay-put this-overlay 'mouse-face
-                             goto-address-mail-mouse-face)
-               (overlay-put this-overlay 'follow-link t)
-               (overlay-put this-overlay
-                            'help-echo "mouse-2, C-c RET: mail this address")
-                (overlay-put this-overlay
-                             'keymap goto-address-highlight-keymap)
-               (overlay-put this-overlay 'goto-address t))))))))
+      (goto-char (or start (point-min)))
+      (when (or (eq t goto-address-fontify-maximum-size)
+               (< (- (or end (point-max)) (point))
+                   goto-address-fontify-maximum-size))
+       (while (re-search-forward goto-address-url-regexp end t)
+         (let* ((s (match-beginning 0))
+                (e (match-end 0))
+                this-overlay)
+           (when (or (not goto-address-prog-mode)
+                     ;; This tests for both comment and string
+                     ;; syntax.
+                     (nth 8 (syntax-ppss)))
+             (setq this-overlay (make-overlay s e))
+             (and goto-address-fontify-p
+                  (overlay-put this-overlay 'face goto-address-url-face))
+             (overlay-put this-overlay 'evaporate t)
+             (overlay-put this-overlay
+                          'mouse-face goto-address-url-mouse-face)
+             (overlay-put this-overlay 'follow-link t)
+             (overlay-put this-overlay
+                          'help-echo "mouse-2, C-c RET: follow URL")
+             (overlay-put this-overlay
+                          'keymap goto-address-highlight-keymap)
+             (overlay-put this-overlay 'goto-address t))))
+       (goto-char (or start (point-min)))
+       (while (re-search-forward goto-address-mail-regexp end t)
+         (let* ((s (match-beginning 0))
+                (e (match-end 0))
+                this-overlay)
+           (when (or (not goto-address-prog-mode)
+                     ;; This tests for both comment and string
+                     ;; syntax.
+                     (nth 8 (syntax-ppss)))
+             (setq this-overlay (make-overlay s e))
+             (and goto-address-fontify-p
+                  (overlay-put this-overlay 'face goto-address-mail-face))
+             (overlay-put this-overlay 'evaporate t)
+             (overlay-put this-overlay 'mouse-face
+                          goto-address-mail-mouse-face)
+             (overlay-put this-overlay 'follow-link t)
+             (overlay-put this-overlay
+                          'help-echo "mouse-2, C-c RET: mail this address")
+             (overlay-put this-overlay
+                          'keymap goto-address-highlight-keymap)
+             (overlay-put this-overlay 'goto-address t))))))))
+
+(defun goto-address-fontify-region (start end)
+  "Fontify URLs and e-mail addresses in the given region."
+  (save-excursion
+    (let ((beg-line (progn (goto-char start) (line-beginning-position)))
+          (end-line (progn (goto-char end) (line-end-position))))
+      (goto-address-fontify beg-line end-line))))
 
 ;; code to find and goto addresses; much of this has been blatantly
 ;; snarfed from browse-url.el
@@ -252,7 +272,35 @@ Also fontifies the buffer appropriately (see `goto-address-fontify-p' and
       (goto-address-fontify)))
 ;;;###autoload(put 'goto-address 'safe-local-eval-function t)
 
+;;;###autoload
+(define-minor-mode goto-address-mode
+  "Minor mode to buttonize URLs and e-mail addresses in the current buffer.
+With a prefix argument ARG, enable the mode if ARG is positive,
+and disable it otherwise.  If called from Lisp, enable the mode
+if ARG is omitted or nil."
+  nil
+  ""
+  nil
+  (if goto-address-mode
+      (jit-lock-register #'goto-address-fontify-region)
+    (jit-lock-unregister #'goto-address-fontify-region)
+    (save-restriction
+      (widen)
+      (goto-address-unfontify (point-min) (point-max)))))
+
+;;;###autoload
+(define-minor-mode goto-address-prog-mode
+  "Like `goto-address-mode', but only for comments and strings."
+  nil
+  ""
+  nil
+  (if goto-address-prog-mode
+      (jit-lock-register #'goto-address-fontify-region)
+    (jit-lock-unregister #'goto-address-fontify-region)
+    (save-restriction
+      (widen)
+      (goto-address-unfontify (point-min) (point-max)))))
+
 (provide 'goto-addr)
 
-;; arch-tag: ca47c505-5661-425d-a471-62bc6e75cf0a
 ;;; goto-addr.el ends here