From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Tom Tromey Newsgroups: gmane.emacs.devel Subject: Patch: goto-address minor modes Date: Sun, 06 Jan 2008 09:33:05 -0700 Message-ID: Reply-To: tromey@redhat.com NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=us-ascii X-Trace: ger.gmane.org 1199639405 20058 80.91.229.12 (6 Jan 2008 17:10:05 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Sun, 6 Jan 2008 17:10:05 +0000 (UTC) To: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Sun Jan 06 18:10:26 2008 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([199.232.76.165]) by lo.gmane.org with esmtp (Exim 4.50) id 1JBZ0r-0007Hn-KS for ged-emacs-devel@m.gmane.org; Sun, 06 Jan 2008 18:10:18 +0100 Original-Received: from localhost ([127.0.0.1] helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1JBZ0U-0004xR-Mm for ged-emacs-devel@m.gmane.org; Sun, 06 Jan 2008 12:09:54 -0500 Original-Received: from mailman by lists.gnu.org with tmda-scanned (Exim 4.43) id 1JBYum-0008D4-9n for emacs-devel@gnu.org; Sun, 06 Jan 2008 12:04:00 -0500 Original-Received: from exim by lists.gnu.org with spam-scanned (Exim 4.43) id 1JBYuk-0008Bh-Ow for emacs-devel@gnu.org; Sun, 06 Jan 2008 12:03:59 -0500 Original-Received: from [199.232.76.173] (helo=monty-python.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1JBYuk-0008BY-IW for emacs-devel@gnu.org; Sun, 06 Jan 2008 12:03:58 -0500 Original-Received: from mx1.redhat.com ([66.187.233.31]) by monty-python.gnu.org with esmtp (Exim 4.60) (envelope-from ) id 1JBYuk-0006jY-0B for emacs-devel@gnu.org; Sun, 06 Jan 2008 12:03:58 -0500 Original-Received: from int-mx1.corp.redhat.com (int-mx1.corp.redhat.com [172.16.52.254]) by mx1.redhat.com (8.13.8/8.13.8) with ESMTP id m06H3vGS030134 for ; Sun, 6 Jan 2008 12:03:57 -0500 Original-Received: from pobox.corp.redhat.com (pobox.corp.redhat.com [10.11.255.20]) by int-mx1.corp.redhat.com (8.13.1/8.13.1) with ESMTP id m06H3vwP026605 for ; Sun, 6 Jan 2008 12:03:57 -0500 Original-Received: from opsy.redhat.com (ton.yyz.redhat.com [10.15.16.15]) by pobox.corp.redhat.com (8.13.1/8.13.1) with ESMTP id m06H3u9O006212; Sun, 6 Jan 2008 12:03:56 -0500 Original-Received: by opsy.redhat.com (Postfix, from userid 500) id C3C9C508021; Sun, 6 Jan 2008 09:33:05 -0700 (MST) X-Attribution: Tom User-Agent: Gnus/5.11 (Gnus v5.11) Emacs/22.0.990 (gnu/linux) X-Scanned-By: MIMEDefang 2.58 on 172.16.52.254 X-detected-kernel: by monty-python.gnu.org: Linux 2.6 (newer, 3) X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.5 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:86346 Archived-At: 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 * 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 ;; 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