Patch: goto-address minor modes

Patch: goto-address minor modes

[Tom Tromey]

I like goto-address, but it can be pretty slow on a very large
ChangeLog.  Recently I saw Stefan's note about glasses mode, and
jit-lock-register... exactly what I needed to fix this.

This patch adds two new minor modes: goto-address-mode and
goto-address-prog-mode (name inspired by flyspell).  These modes use
jit-lock to apply overlays that buttonize URLs and email addresses.
The "prog" mode only adds an overlay when the matched text appears in
a string or comment.

Tom

2008-01-06  Tom Tromey  <tromey@redhat.com>

	* net/goto-addr.el (goto-address-unfontify): New function.
	(goto-address-fontify): Use it.  Respect goto-address-prog-mode.
	(goto-address-fontify-region): New function.
	(goto-address-mode): Likewise.
	(goto-address-prog-mode): Likewise.

Index: lisp/net/goto-addr.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/net/goto-addr.el,v
retrieving revision 1.30
diff -u -r1.30 goto-addr.el
--- lisp/net/goto-addr.el	26 Jul 2007 05:27:18 -0000	1.30
+++ lisp/net/goto-addr.el	6 Jan 2008 16:55:12 -0000
@@ -1,7 +1,7 @@
 ;;; 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.
+;;   2005, 2006, 2007, 2008 Free Software Foundation, Inc.
 
 ;; Author: Eric Ding <ericding@alum.mit.edu>
 ;; Maintainer: FSF
@@ -151,51 +151,73 @@
   :type 'face
   :group 'goto-address)
 
+(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))))
+
 (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)))
+  (goto-address-unfontify (point-min) (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))))))))
+      (when (or (eq t goto-address-fontify-maximum-size)
+		(< (- (point-max) (point)) goto-address-fontify-maximum-size))
+	(while (re-search-forward goto-address-url-regexp nil 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 (point-min))
+	(while (re-search-forward goto-address-mail-regexp nil 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
+    (save-restriction
+      (let ((beg-line (progn (goto-char start) (line-beginning-position)))
+	    (end-line (progn (goto-char end) (line-end-position))))
+	(narrow-to-region beg-line end-line)
+	(goto-address-fontify)))))
 
 ;; code to find and goto addresses; much of this has been blatantly
 ;; snarfed from browse-url.el
@@ -252,6 +274,32 @@
       (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."
+  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
+  "Turn on `goto-address-mode', but only in 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

Re: Patch: goto-address minor modes

[Tom Tromey]

>>>>> "rms" == Richard Stallman <rms@gnu.org> writes:

>     This patch adds two new minor modes: goto-address-mode and
>     goto-address-prog-mode (name inspired by flyspell).  These modes use
>     jit-lock to apply overlays that buttonize URLs and email addresses.

rms> If your goal is to change the implementation, why change the user
rms> interface at the same time?

I didn't want to change the old code in case someone was relying on
it.  It still works as it used to.

The new interface is what makes it work in an incremental way.  I
chose to implement it as minor modes because that seemed easy and
conventional.

If you'd rather I implement it in some other way, let me know how, and
I will make the changes.

Tom

Re: Patch: goto-address minor modes

[Richard Stallman]

    This patch adds two new minor modes: goto-address-mode and
    goto-address-prog-mode (name inspired by flyspell).  These modes use
    jit-lock to apply overlays that buttonize URLs and email addresses.

If your goal is to change the implementation, why change the user
interface at the same time?

Re: Patch: goto-address minor modes

[Richard Stallman]

    I didn't want to change the old code in case someone was relying on
    it.  It still works as it used to.

I see.

Ok.

Re: Patch: goto-address minor modes

[Reiner Steib]

On Mon, Jan 07 2008, Tom Tromey wrote:

>>>>>> "rms" == Richard Stallman <rms@gnu.org> writes:
>
>>     This patch adds two new minor modes: goto-address-mode and
>>     goto-address-prog-mode (name inspired by flyspell).  These modes use
>>     jit-lock to apply overlays that buttonize URLs and email addresses.
>
> rms> If your goal is to change the implementation, why change the user
> rms> interface at the same time?
>
> I didn't want to change the old code in case someone was relying on
> it.  It still works as it used to.
>
> The new interface is what makes it work in an incremental way.  I
> chose to implement it as minor modes because that seemed easy and
> conventional.
>
> If you'd rather I implement it in some other way, let me know how, and
> I will make the changes.

On Tue, Jan 08 2008, Richard Stallman wrote:

>     I didn't want to change the old code in case someone was relying on
>     it.  It still works as it used to.
>
> I see.
>
> Ok.

AFAICS, Tom's patch hasn't been installed.  Is there any objection or
has it just been forgotten?

Bye, Reiner.
-- 
       ,,,
      (o o)
---ooO-(_)-Ooo---  |  PGP key available  |  http://rsteib.home.pages.de/

Re: Patch: goto-address minor modes

[Juri Linkov]

goto-address-mode is now a minor mode like bug-reference-mode.
bug-reference-mode uses the `link' face to highlight links,
but goto-address-mode still uses `bold'.  The following patch
changes address urls to be highlighted in the `link' face.
Also it takes a new minor mode into use in several places:

Index: lisp/net/goto-addr.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/net/goto-addr.el,v
retrieving revision 1.35
diff -u -r1.35 goto-addr.el
--- lisp/net/goto-addr.el	5 Jan 2009 03:22:44 -0000	1.35
+++ lisp/net/goto-addr.el	14 Jan 2009 00:21:07 -0000
@@ -129,7 +129,7 @@
     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)

Index: etc/MORE.STUFF
===================================================================
RCS file: /sources/emacs/emacs/etc/MORE.STUFF,v
retrieving revision 1.73
diff -u -r1.73 MORE.STUFF
--- etc/MORE.STUFF	8 Jan 2009 05:11:57 -0000	1.73
+++ etc/MORE.STUFF	14 Jan 2009 00:21:35 -0000
@@ -270,7 +270,7 @@
 Local Variables:
 mode: text
 mode: view
-eval: (goto-address)
+mode: goto-address
 End:
 
 This file is part of GNU Emacs.

Index: lisp/help.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/help.el,v
retrieving revision 1.345
diff -u -r1.345 help.el
--- lisp/help.el	5 Jan 2009 03:19:17 -0000	1.345
+++ lisp/help.el	14 Jan 2009 00:23:37 -0000
@@ -294,7 +294,7 @@
 
 (defun view-help-file (file &optional dir)
   (view-file (expand-file-name file (or dir data-directory)))
-  (goto-address)
+  (goto-address-mode t)
   (goto-char (point-min)))
 
 (defun describe-distribution ()

Index: lisp/menu-bar.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/menu-bar.el,v
retrieving revision 1.349
diff -u -r1.349 menu-bar.el
--- lisp/menu-bar.el	13 Jan 2009 13:58:13 -0000	1.349
+++ lisp/menu-bar.el	14 Jan 2009 00:23:54 -0000
@@ -1492,7 +1492,7 @@
   (let (enable-local-variables)
     (view-file (expand-file-name "MORE.STUFF"
 				 data-directory))
-    (goto-address)))
+    (goto-address-mode t)))
 (define-key menu-bar-help-menu [sep2]
   '("--"))
 (define-key menu-bar-help-menu [external-packages]

-- 
Juri Linkov
http://www.jurta.org/emacs/

Re: Patch: goto-address minor modes

[Chong Yidong]

Juri Linkov <juri@jurta.org> writes:

> goto-address-mode is now a minor mode like bug-reference-mode.
> bug-reference-mode uses the `link' face to highlight links,
> but goto-address-mode still uses `bold'.  The following patch
> changes address urls to be highlighted in the `link' face.
> Also it takes a new minor mode into use in several places:

Please go ahead and check this in.

Re: Patch: goto-address minor modes

[Dan Nicolaescu]

Juri Linkov <juri@jurta.org> writes:

  > goto-address-mode is now a minor mode like bug-reference-mode.
  > bug-reference-mode uses the `link' face to highlight links,
  > but goto-address-mode still uses `bold'.  The following patch
  > changes address urls to be highlighted in the `link' face.
  > Also it takes a new minor mode into use in several places:
  > 
  > Index: lisp/net/goto-addr.el
  > ===================================================================
  > RCS file: /sources/emacs/emacs/lisp/net/goto-addr.el,v
  > retrieving revision 1.35
  > diff -u -r1.35 goto-addr.el
  > --- lisp/net/goto-addr.el	5 Jan 2009 03:22:44 -0000	1.35
  > +++ lisp/net/goto-addr.el	14 Jan 2009 00:21:07 -0000
  > @@ -129,7 +129,7 @@
  >      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

This is nice!
Shouldn't the links in the *Help* buffers also use the `link' face?

Re: Patch: goto-address minor modes

[Lennart Borgman]

On Wed, Jan 14, 2009 at 7:11 AM, Dan Nicolaescu <dann@ics.uci.edu> wrote:
> This is nice!
> Shouldn't the links in the *Help* buffers also use the `link' face?

Should not all faced used for links be derived from the `link' face?

Re: Patch: goto-address minor modes

[Juri Linkov]

>> This is nice!
>> Shouldn't the links in the *Help* buffers also use the `link' face?
>
> Should not all faced used for links be derived from the `link' face?

This was already discussed, and the consensus was that in the buffers
without much highlighting like in the *Help* buffer where only the
default foreground color is displayed, using other colors is
distracting.

-- 
Juri Linkov
http://www.jurta.org/emacs/

Re: Patch: goto-address minor modes

[Dan Nicolaescu]

Lennart Borgman <lennart.borgman@gmail.com> writes:

  > On Wed, Jan 14, 2009 at 7:11 AM, Dan Nicolaescu <dann@ics.uci.edu> wrote:
  > > This is nice!
  > > Shouldn't the links in the *Help* buffers also use the `link' face?
  > 
  > Should not all faced used for links be derived from the `link' face?

IMHO they should.  Consistency is very important.

Re: Patch: goto-address minor modes

[Lennart Borgman]

On Wed, Jan 14, 2009 at 4:30 PM, Dan Nicolaescu <dann@ics.uci.edu> wrote:
> Lennart Borgman <lennart.borgman@gmail.com> writes:
>
>  > On Wed, Jan 14, 2009 at 7:11 AM, Dan Nicolaescu <dann@ics.uci.edu> wrote:
>  > > This is nice!
>  > > Shouldn't the links in the *Help* buffers also use the `link' face?
>  >
>  > Should not all faced used for links be derived from the `link' face?
>
> IMHO they should.  Consistency is very important.

I also think consistency is very important - escpecially in the GUI.

My bad memory seems to tell me that we discussed this before the
release of Emacs 22 and that we did not want to discuss it more then.
However I see no big reason not to do the change now.

Re: Patch: goto-address minor modes

[Juri Linkov]

>   > > This is nice!
>   > > Shouldn't the links in the *Help* buffers also use the `link' face?
>   >
>   > Should not all faced used for links be derived from the `link' face?
>
> IMHO they should.  Consistency is very important.

I agree that they should, but highlighting in the *Help* buffer
is too sensitive matter to change now.

-- 
Juri Linkov
http://www.jurta.org/emacs/

Re: Patch: goto-address minor modes

[Stefan Monnier]

>> > > This is nice!
>> > > Shouldn't the links in the *Help* buffers also use the `link' face?
>> >
>> > Should not all faced used for links be derived from the `link' face?
>> 
>> IMHO they should.  Consistency is very important.

> I agree that they should, but highlighting in the *Help* buffer
> is too sensitive matter to change now.

Those help xrefs use `button's with a face `button'.
Maybe they should be changed to use a face that inherits from `link' but
overrides `link's foreground color.


        Stefan

Re: Patch: goto-address minor modes

[Juri Linkov]

>>> > > This is nice!
>>> > > Shouldn't the links in the *Help* buffers also use the `link' face?
>>> >
>>> > Should not all faced used for links be derived from the `link' face?
>>>
>>> IMHO they should.  Consistency is very important.
>
>> I agree that they should, but highlighting in the *Help* buffer
>> is too sensitive matter to change now.
>
> Those help xrefs use `button's with a face `button'.
> Maybe they should be changed to use a face that inherits from `link' but
> overrides `link's foreground color.

I have a doubt if this doesn't change the visual appearance.
In the future we could try using the `link' and `link-visited' faces
directly when the functionality for remembering visited links
will be implemented for the *Help* buffer.

-- 
Juri Linkov
http://www.jurta.org/emacs/

Re: Patch: goto-address minor modes

[Lennart Borgman]

On Wed, Jan 14, 2009 at 11:01 PM, Stefan Monnier
<monnier@iro.umontreal.ca> wrote:
>>> > > This is nice!
>>> > > Shouldn't the links in the *Help* buffers also use the `link' face?
>>> >
>>> > Should not all faced used for links be derived from the `link' face?
>>>
>>> IMHO they should.  Consistency is very important.
>
>> I agree that they should, but highlighting in the *Help* buffer
>> is too sensitive matter to change now.
>
> Those help xrefs use `button's with a face `button'.
> Maybe they should be changed to use a face that inherits from `link' but
> overrides `link's foreground color.

Shouldn't button face inherit from link face too?