From: Tom Tromey <tromey@redhat.com>
To: emacs-devel@gnu.org
Subject: Patch: goto-address minor modes
Date: Sun, 06 Jan 2008 09:33:05 -0700 [thread overview]
Message-ID: <m3fxxavrr2.fsf@fleche.redhat.com> (raw)
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
next reply other threads:[~2008-01-06 16:33 UTC|newest]
Thread overview: 16+ messages / expand[flat|nested] mbox.gz Atom feed top
2008-01-06 16:33 Tom Tromey [this message]
2008-01-07 17:14 ` Patch: goto-address minor modes Richard Stallman
2008-01-07 16:59 ` Tom Tromey
2008-01-08 19:07 ` Richard Stallman
2008-03-22 17:47 ` Reiner Steib
2009-01-14 0:27 ` Juri Linkov
2009-01-14 3:25 ` Chong Yidong
2009-01-14 6:11 ` Dan Nicolaescu
2009-01-14 8:33 ` Lennart Borgman
2009-01-14 10:27 ` Juri Linkov
2009-01-14 15:30 ` Dan Nicolaescu
2009-01-14 20:11 ` Lennart Borgman
2009-01-14 21:21 ` Juri Linkov
2009-01-14 22:01 ` Stefan Monnier
2009-01-14 23:55 ` Juri Linkov
2009-01-15 0:25 ` Lennart Borgman
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=m3fxxavrr2.fsf@fleche.redhat.com \
--to=tromey@redhat.com \
--cc=emacs-devel@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.