lisp/progmodes/bug-reference.el

   1 ;; bug-reference.el --- buttonize bug references
   2
   3 ;; Copyright (C) 2008-2011 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-2] '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 This can also be a function designator; it is called without arguments
  45  and should return a string.
  46 It can use `match-string' to get parts matched against
  47 `bug-reference-bug-regexp', specifically:
  48  1. issue kind (bug, patch, rfe &c)
  49  2. issue number.
  50
  51 There is no default setting for this, it must be set per file.
  52 If you set it to a symbol in the file Local Variables section,
  53 you need to add a `bug-reference-url-format' property to it:
  54 \(put 'my-bug-reference-url-format 'bug-reference-url-format t)
  55 so that it is considered safe, see `enable-local-variables'.")
  56
  57 ;;;###autoload
  58 (put 'bug-reference-url-format 'safe-local-variable
  59      (lambda (s)
  60        (or (stringp s)
  61            (and (symbolp s)
  62                 (get s 'bug-reference-url-format)))))
  63
  64 (defconst bug-reference-bug-regexp
  65   "\\([Bb]ug ?#\\|[Pp]atch ?#\\|RFE ?#\\|PR [a-z-+]+/\\)\\([0-9]+\\)"
  66   "Regular expression which matches bug references.")
  67
  68 (defun bug-reference-set-overlay-properties ()
  69   "Set properties of bug reference overlays."
  70   (put 'bug-reference 'evaporate t)
  71   (put 'bug-reference 'face 'link)
  72   (put 'bug-reference 'mouse-face 'highlight)
  73   (put 'bug-reference 'help-echo "mouse-1, C-c RET: visit this bug")
  74   (put 'bug-reference 'keymap bug-reference-map)
  75   (put 'bug-reference 'follow-link t))
  76
  77 (bug-reference-set-overlay-properties)
  78
  79 (defun bug-reference-unfontify (start end)
  80   "Remove bug reference overlays from region."
  81   (dolist (o (overlays-in start end))
  82     (when (eq (overlay-get o 'category) 'bug-reference)
  83       (delete-overlay o))))
  84
  85 (defvar bug-reference-prog-mode)
  86
  87 (defun bug-reference-fontify (start end)
  88   "Apply bug reference overlays to region."
  89   (save-excursion
  90     (let ((beg-line (progn (goto-char start) (line-beginning-position)))
  91           (end-line (progn (goto-char end) (line-end-position))))
  92       ;; Remove old overlays.
  93       (bug-reference-unfontify beg-line end-line)
  94       (goto-char beg-line)
  95       (while (and (< (point) end-line)
  96                   (re-search-forward bug-reference-bug-regexp end-line 'move))
  97         (when (or (not bug-reference-prog-mode)
  98                   ;; This tests for both comment and string syntax.
  99                   (nth 8 (syntax-ppss)))
 100           (let ((overlay (make-overlay (match-beginning 0) (match-end 0)
 101                                        nil t nil)))
 102             (overlay-put overlay 'category 'bug-reference)
 103             ;; Don't put a link if format is undefined
 104             (when bug-reference-url-format
 105               (overlay-put overlay 'bug-reference-url
 106                            (if (stringp bug-reference-url-format)
 107                                (format bug-reference-url-format
 108                                        (match-string-no-properties 2))
 109                              (funcall bug-reference-url-format))))))))))
 110
 111 ;; Taken from button.el.
 112 (defun bug-reference-push-button (&optional pos _use-mouse-action)
 113   "Open URL corresponding to the bug reference at POS."
 114   (interactive
 115    (list (if (integerp last-command-event) (point) last-command-event)))
 116   (if (and (not (integerp pos)) (eventp pos))
 117       ;; POS is a mouse event; switch to the proper window/buffer
 118       (let ((posn (event-start pos)))
 119         (with-current-buffer (window-buffer (posn-window posn))
 120           (bug-reference-push-button (posn-point posn) t)))
 121     ;; POS is just normal position.
 122     (dolist (o (overlays-at pos))
 123       ;; It should only be possible to have one URL overlay.
 124       (let ((url (overlay-get o 'bug-reference-url)))
 125         (when url
 126           (browse-url url))))))
 127
 128 ;;;###autoload
 129 (define-minor-mode bug-reference-mode
 130   "Minor mode to buttonize bugzilla references in the current buffer."
 131   nil
 132   ""
 133   nil
 134   (if bug-reference-mode
 135       (jit-lock-register #'bug-reference-fontify)
 136     (jit-lock-unregister #'bug-reference-fontify)
 137     (save-restriction
 138       (widen)
 139       (bug-reference-unfontify (point-min) (point-max)))))
 140
 141 ;;;###autoload
 142 (define-minor-mode bug-reference-prog-mode
 143   "Like `bug-reference-mode', but only buttonize in comments and strings."
 144   nil
 145   ""
 146   nil
 147   (if bug-reference-prog-mode
 148       (jit-lock-register #'bug-reference-fontify)
 149     (jit-lock-unregister #'bug-reference-fontify)
 150     (save-restriction
 151       (widen)
 152       (bug-reference-unfontify (point-min) (point-max)))))
 153
 154 ;;; bug-reference.el ends here