Patch: bug-reference.el

[Tom Tromey]

A while ago I wrote some code (the misnamed "changelog-url.el") to
buttonize bug references in ChangeLog files.  RMS asked me to clean it
up and submit it for inclusion; I'm finally doing it.

This adds two minor modes for buttonizing bug references.  A bug
reference is some text in a buffer that refers to a bug report in a
bug database.  For instance, "PR libgcj/33326" is a real example from
libgcj's ChangeLog.

With this mode, the PR text is turned into a button; when clicked it
opens the corresponding URL.  The URLs are computed using a
user-provided format string.

There is also a bug-reference-prog-mode which limits its overlays to
strings and comments.

Like my recent goto-addr patch, this relies on jit-lock-register to
make it perform acceptably well.

Tom

2008-01-07  Tom Tromey  <address@hidden>

        * progmodes/bug-reference.el: New file.

Index: lisp/progmodes/bug-reference.el
===================================================================
RCS file: lisp/progmodes/bug-reference.el
diff -N lisp/progmodes/bug-reference.el
--- /dev/null   1 Jan 1970 00:00:00 -0000
+++ lisp/progmodes/bug-reference.el     7 Jan 2008 03:28:42 -0000
@@ -0,0 +1,135 @@
+;; bug-reference.el --- buttonize bug references
+
+;; Copyright (C) 2008 Free Software Foundation, Inc.
+
+;; Author: Tom Tromey <address@hidden>
+;; Created: 21 Mar 2007
+;; Keywords: tools
+
+;; This file is part of GNU Emacs.
+
+;; 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 3, 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
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; 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.
+
+;;; Commentary:
+
+;; This file provides minor modes for putting clickable overlays on
+;; references to bugs.  A bug reference is text like "PR foo/29292";
+;; this is mapped to a URL using a user-supplied format.
+
+;; Two minor modes are provided.  One works on any text in the buffer;
+;; the other operates only on comments and strings.
+
+(defvar bug-reference-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map [mouse-1] 'bug-reference-push-button)
+    (define-key map (kbd "C-c RET") 'bug-reference-push-button)
+    map)
+  "Keymap used by bug reference buttons.")
+
+;; E.g., "http://gcc.gnu.org/PR%s";
+(defvar bug-reference-url-format nil
+  "Format used to turn a bug number into a URL.
+The bug number is supplied as a string, so this should have a single %s.
+There is no default setting for this, it must be set per file.")
+
+(defconst bug-reference-bug-regexp
+  "\\(?:[Bb]ug #\\|PR [a-z-+]+/\\)\\([0-9]+\\)"
+  "Regular expression which matches bug references.")
+
+(defun bug-reference-set-overlay-properties ()
+  "Set properties of bug reference overlays."
+  (put 'bug-reference 'evaporate t)
+  (put 'bug-reference 'face 'link)
+  (put 'bug-reference 'mouse-face 'highlight)
+  (put 'bug-reference 'help-echo "mouse-1, C-c RET: visit this bug")
+  (put 'bug-reference 'keymap bug-reference-map)
+  (put 'bug-reference 'follow-link t))
+
+(bug-reference-set-overlay-properties)
+
+(defun bug-reference-unfontify (start end)
+  "Remove bug reference overlays from region."
+  (dolist (o (overlays-in start end))
+    (when (eq (overlay-get o 'category) 'bug-reference)
+      (delete-overlay o))))
+
+(defun bug-reference-fontify (start end)
+  "Apply bug reference overlays to region."
+  (save-excursion
+    (let ((beg-line (progn (goto-char start) (line-beginning-position)))
+         (end-line (progn (goto-char end) (line-end-position))))
+      ;; Remove old overlays.
+      (bug-reference-unfontify beg-line end-line)
+      (goto-char beg-line)
+      (while (and (< (point) end-line)
+                 (re-search-forward bug-reference-bug-regexp end-line 'move))
+       (when (or (not bug-reference-prog-mode)
+                 ;; This tests for both comment and string syntax.
+                 (nth 8 (syntax-ppss)))
+         (let ((overlay (make-overlay (match-beginning 0) (match-end 0)
+                                      nil t nil)))
+           (overlay-put overlay 'category 'bug-reference)
+           (overlay-put overlay 'bug-reference-url
+                        (format bug-reference-url-format
+                                (match-string-no-properties 1)))))))))
+
+;; Taken from button.el.
+(defun bug-reference-push-button (&optional pos use-mouse-action)
+  "Open URL corresponding to the bug reference at POS."
+  (interactive
+   (list (if (integerp last-command-event) (point) last-command-event)))
+  (if (and (not (integerp pos)) (eventp pos))
+      ;; POS is a mouse event; switch to the proper window/buffer
+      (let ((posn (event-start pos)))
+       (with-current-buffer (window-buffer (posn-window posn))
+         (bug-reference-push-button (posn-point posn) t)))
+    ;; POS is just normal position.
+    (dolist (o (overlays-at pos))
+      ;; It should only be possible to have one URL overlay.
+      (let ((url (overlay-get o 'bug-reference-url)))
+       (when url
+         (browse-url url))))))
+
+;;;###autoload
+(define-minor-mode bug-reference-mode
+  "Minor mode to buttonize bugzilla references in the current buffer.
+Requires `bug-reference-url-format' to be set in the buffer."
+  nil
+  ""
+  nil
+  (if bug-reference-mode
+      (when bug-reference-url-format
+       (jit-lock-register #'bug-reference-fontify))
+    (jit-lock-unregister #'bug-reference-fontify)
+    (save-restriction
+      (widen)
+      (bug-reference-unfontify (point-min) (point-max)))))
+
+;;;###autoload
+(define-minor-mode bug-reference-prog-mode
+  "Like `bug-reference-mode', but only buttonize in comments and strings."
+  nil
+  ""
+  nil
+  (if bug-reference-prog-mode
+      (when bug-reference-url-format
+       (jit-lock-register #'bug-reference-fontify))
+    (jit-lock-unregister #'bug-reference-fontify)
+    (save-restriction
+      (widen)
+      (bug-reference-unfontify (point-min) (point-max)))))
+
+;;; bug-reference.el ends here