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 of the License, or
  14 ;; (at your option) 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.  If not, see <http://www.gnu.org/licenses/>.
  23
  24 ;;; Commentary:
  25
  26 ;; This file provides minor modes for putting clickable overlays on
  27 ;; references to bugs.  A bug reference is text like "PR foo/29292";
  28 ;; this is mapped to a URL using a user-supplied format.
  29
  30 ;; Two minor modes are provided.  One works on any text in the buffer;
  31 ;; the other operates only on comments and strings.
  32
  33 (defvar bug-reference-map
  34   (let ((map (make-sparse-keymap)))
  35     (define-key map [mouse-1] 'bug-reference-push-button)
  36     (define-key map (kbd "C-c RET") 'bug-reference-push-button)
  37     map)
  38   "Keymap used by bug reference buttons.")
  39
  40 ;; E.g., "http://gcc.gnu.org/PR%s"
  41 (defvar bug-reference-url-format nil
  42   "Format used to turn a bug number into a URL.
  43 The bug number is supplied as a string, so this should have a single %s.
  44 There is no default setting for this, it must be set per file.")
  45
  46 (defconst bug-reference-bug-regexp
  47   "\\(?:[Bb]ug #\\|PR [a-z-+]+/\\)\\([0-9]+\\)"
  48   "Regular expression which matches bug references.")
  49
  50 (defun bug-reference-set-overlay-properties ()
  51   "Set properties of bug reference overlays."
  52   (put 'bug-reference 'evaporate t)
  53   (put 'bug-reference 'face 'link)
  54   (put 'bug-reference 'mouse-face 'highlight)
  55   (put 'bug-reference 'help-echo "mouse-1, C-c RET: visit this bug")
  56   (put 'bug-reference 'keymap bug-reference-map)
  57   (put 'bug-reference 'follow-link t))
  58
  59 (bug-reference-set-overlay-properties)
  60
  61 (defun bug-reference-unfontify (start end)
  62   "Remove bug reference overlays from region."
  63   (dolist (o (overlays-in start end))
  64     (when (eq (overlay-get o 'category) 'bug-reference)
  65       (delete-overlay o))))
  66
  67 (defvar bug-reference-prog-mode)
  68
  69 (defun bug-reference-fontify (start end)
  70   "Apply bug reference overlays to region."
  71   (save-excursion
  72     (let ((beg-line (progn (goto-char start) (line-beginning-position)))
  73           (end-line (progn (goto-char end) (line-end-position))))
  74       ;; Remove old overlays.
  75       (bug-reference-unfontify beg-line end-line)
  76       (goto-char beg-line)
  77       (while (and (< (point) end-line)
  78                   (re-search-forward bug-reference-bug-regexp end-line 'move))
  79         (when (or (not bug-reference-prog-mode)
  80                   ;; This tests for both comment and string syntax.
  81                   (nth 8 (syntax-ppss)))
  82           (let ((overlay (make-overlay (match-beginning 0) (match-end 0)
  83                                        nil t nil)))
  84             (overlay-put overlay 'category 'bug-reference)
  85             (overlay-put overlay 'bug-reference-url
  86                          (format bug-reference-url-format
  87                                  (match-string-no-properties 1)))))))))
  88
  89 ;; Taken from button.el.
  90 (defun bug-reference-push-button (&optional pos use-mouse-action)
  91   "Open URL corresponding to the bug reference at POS."
  92   (interactive
  93    (list (if (integerp last-command-event) (point) last-command-event)))
  94   (if (and (not (integerp pos)) (eventp pos))
  95       ;; POS is a mouse event; switch to the proper window/buffer
  96       (let ((posn (event-start pos)))
  97         (with-current-buffer (window-buffer (posn-window posn))
  98           (bug-reference-push-button (posn-point posn) t)))
  99     ;; POS is just normal position.
 100     (dolist (o (overlays-at pos))
 101       ;; It should only be possible to have one URL overlay.
 102       (let ((url (overlay-get o 'bug-reference-url)))
 103         (when url
 104           (browse-url url))))))
 105
 106 ;;;###autoload
 107 (define-minor-mode bug-reference-mode
 108   "Minor mode to buttonize bugzilla references in the current buffer.
 109 Requires `bug-reference-url-format' to be set in the buffer."
 110   nil
 111   ""
 112   nil
 113   (if bug-reference-mode
 114       (when bug-reference-url-format
 115         (jit-lock-register #'bug-reference-fontify))
 116     (jit-lock-unregister #'bug-reference-fontify)
 117     (save-restriction
 118       (widen)
 119       (bug-reference-unfontify (point-min) (point-max)))))
 120
 121 ;;;###autoload
 122 (define-minor-mode bug-reference-prog-mode
 123   "Like `bug-reference-mode', but only buttonize in comments and strings."
 124   nil
 125   ""
 126   nil
 127   (if bug-reference-prog-mode
 128       (when bug-reference-url-format
 129         (jit-lock-register #'bug-reference-fontify))
 130     (jit-lock-unregister #'bug-reference-fontify)
 131     (save-restriction
 132       (widen)
 133       (bug-reference-unfontify (point-min) (point-max)))))
 134
 135 ;; arch-tag: b138abce-e5c3-475e-bd58-7afba40387ea
 136 ;;; bug-reference.el ends here