lisp/progmodes/bug-reference.el

   1 ;; bug-reference.el --- buttonize bug references
   2
   3 ;; Copyright (C) 2008 Free Software Foundation, Inc.
   4
   5 ;; Author: Tom Tromey <tromey@redhat.com>
   6 ;; Created: 21 Mar 2007
   7 ;; Keywords: tools
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 3, or (at your option)
  14 ;; any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  24 ;; Boston, MA 02110-1301, USA.
  25
  26 ;;; Commentary:
  27
  28 ;; This file provides minor modes for putting clickable overlays on
  29 ;; references to bugs.  A bug reference is text like "PR foo/29292";
  30 ;; this is mapped to a URL using a user-supplied format.
  31
  32 ;; Two minor modes are provided.  One works on any text in the buffer;
  33 ;; the other operates only on comments and strings.
  34
  35 (defvar bug-reference-map
  36   (let ((map (make-sparse-keymap)))
  37     (define-key map [mouse-1] 'bug-reference-push-button)
  38     (define-key map (kbd "C-c RET") 'bug-reference-push-button)
  39     map)
  40   "Keymap used by bug reference buttons.")
  41
  42 ;; E.g., "http://gcc.gnu.org/PR%s"
  43 (defvar bug-reference-url-format nil
  44   "Format used to turn a bug number into a URL.
  45 The bug number is supplied as a string, so this should have a single %s.
  46 There is no default setting for this, it must be set per file.")
  47
  48 (defconst bug-reference-bug-regexp
  49   "\\(?:[Bb]ug #\\|PR [a-z-+]+/\\)\\([0-9]+\\)"
  50   "Regular expression which matches bug references.")
  51
  52 (defun bug-reference-set-overlay-properties ()
  53   "Set properties of bug reference overlays."
  54   (put 'bug-reference 'evaporate t)
  55   (put 'bug-reference 'face 'link)
  56   (put 'bug-reference 'mouse-face 'highlight)
  57   (put 'bug-reference 'help-echo "mouse-1, C-c RET: visit this bug")
  58   (put 'bug-reference 'keymap bug-reference-map)
  59   (put 'bug-reference 'follow-link t))
  60
  61 (bug-reference-set-overlay-properties)
  62
  63 (defun bug-reference-unfontify (start end)
  64   "Remove bug reference overlays from region."
  65   (dolist (o (overlays-in start end))
  66     (when (eq (overlay-get o 'category) 'bug-reference)
  67       (delete-overlay o))))
  68
  69 (defvar bug-reference-prog-mode)
  70
  71 (defun bug-reference-fontify (start end)
  72   "Apply bug reference overlays to region."
  73   (save-excursion
  74     (let ((beg-line (progn (goto-char start) (line-beginning-position)))
  75           (end-line (progn (goto-char end) (line-end-position))))
  76       ;; Remove old overlays.
  77       (bug-reference-unfontify beg-line end-line)
  78       (goto-char beg-line)
  79       (while (and (< (point) end-line)
  80                   (re-search-forward bug-reference-bug-regexp end-line 'move))
  81         (when (or (not bug-reference-prog-mode)
  82                   ;; This tests for both comment and string syntax.
  83                   (nth 8 (syntax-ppss)))
  84           (let ((overlay (make-overlay (match-beginning 0) (match-end 0)
  85                                        nil t nil)))
  86             (overlay-put overlay 'category 'bug-reference)
  87             (overlay-put overlay 'bug-reference-url
  88                          (format bug-reference-url-format
  89                                  (match-string-no-properties 1)))))))))
  90
  91 ;; Taken from button.el.
  92 (defun bug-reference-push-button (&optional pos use-mouse-action)
  93   "Open URL corresponding to the bug reference at POS."
  94   (interactive
  95    (list (if (integerp last-command-event) (point) last-command-event)))
  96   (if (and (not (integerp pos)) (eventp pos))
  97       ;; POS is a mouse event; switch to the proper window/buffer
  98       (let ((posn (event-start pos)))
  99         (with-current-buffer (window-buffer (posn-window posn))
 100           (bug-reference-push-button (posn-point posn) t)))
 101     ;; POS is just normal position.
 102     (dolist (o (overlays-at pos))
 103       ;; It should only be possible to have one URL overlay.
 104       (let ((url (overlay-get o 'bug-reference-url)))
 105         (when url
 106           (browse-url url))))))
 107
 108 ;;;###autoload
 109 (define-minor-mode bug-reference-mode
 110   "Minor mode to buttonize bugzilla references in the current buffer.
 111 Requires `bug-reference-url-format' to be set in the buffer."
 112   nil
 113   ""
 114   nil
 115   (if bug-reference-mode
 116       (when bug-reference-url-format
 117         (jit-lock-register #'bug-reference-fontify))
 118     (jit-lock-unregister #'bug-reference-fontify)
 119     (save-restriction
 120       (widen)
 121       (bug-reference-unfontify (point-min) (point-max)))))
 122
 123 ;;;###autoload
 124 (define-minor-mode bug-reference-prog-mode
 125   "Like `bug-reference-mode', but only buttonize in comments and strings."
 126   nil
 127   ""
 128   nil
 129   (if bug-reference-prog-mode
 130       (when bug-reference-url-format
 131         (jit-lock-register #'bug-reference-fontify))
 132     (jit-lock-unregister #'bug-reference-fontify)
 133     (save-restriction
 134       (widen)
 135       (bug-reference-unfontify (point-min) (point-max)))))
 136
 137 ;; arch-tag: b138abce-e5c3-475e-bd58-7afba40387ea
 138 ;;; bug-reference.el ends here