src/ChangeLog: Fix typos.
[emacs.git] / lisp / progmodes / bug-reference.el
blobd0cc5541b8af1464925bad746c6866483bc01b0e
1 ;; bug-reference.el --- buttonize bug references
3 ;; Copyright (C) 2008, 2009, 2010 Free Software Foundation, Inc.
5 ;; Author: Tom Tromey <tromey@redhat.com>
6 ;; Created: 21 Mar 2007
7 ;; Keywords: tools
9 ;; This file is part of GNU Emacs.
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.
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.
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/>.
24 ;;; Commentary:
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.
30 ;; Two minor modes are provided. One works on any text in the buffer;
31 ;; the other operates only on comments and strings.
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.")
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.")
46 ;;;###autoload
47 (put 'bug-reference-url-format 'safe-local-variable 'stringp)
49 (defconst bug-reference-bug-regexp
50 "\\(?:[Bb]ug ?#\\|PR [a-z-+]+/\\)\\([0-9]+\\)"
51 "Regular expression which matches bug references.")
53 (defun bug-reference-set-overlay-properties ()
54 "Set properties of bug reference overlays."
55 (put 'bug-reference 'evaporate t)
56 (put 'bug-reference 'face 'link)
57 (put 'bug-reference 'mouse-face 'highlight)
58 (put 'bug-reference 'help-echo "mouse-1, C-c RET: visit this bug")
59 (put 'bug-reference 'keymap bug-reference-map)
60 (put 'bug-reference 'follow-link t))
62 (bug-reference-set-overlay-properties)
64 (defun bug-reference-unfontify (start end)
65 "Remove bug reference overlays from region."
66 (dolist (o (overlays-in start end))
67 (when (eq (overlay-get o 'category) 'bug-reference)
68 (delete-overlay o))))
70 (defvar bug-reference-prog-mode)
72 (defun bug-reference-fontify (start end)
73 "Apply bug reference overlays to region."
74 (save-excursion
75 (let ((beg-line (progn (goto-char start) (line-beginning-position)))
76 (end-line (progn (goto-char end) (line-end-position))))
77 ;; Remove old overlays.
78 (bug-reference-unfontify beg-line end-line)
79 (goto-char beg-line)
80 (while (and (< (point) end-line)
81 (re-search-forward bug-reference-bug-regexp end-line 'move))
82 (when (or (not bug-reference-prog-mode)
83 ;; This tests for both comment and string syntax.
84 (nth 8 (syntax-ppss)))
85 (let ((overlay (make-overlay (match-beginning 0) (match-end 0)
86 nil t nil)))
87 (overlay-put overlay 'category 'bug-reference)
88 ;; Don't put a link if format is undefined
89 (when bug-reference-url-format
90 (overlay-put overlay 'bug-reference-url
91 (format bug-reference-url-format
92 (match-string-no-properties 1))))))))))
94 ;; Taken from button.el.
95 (defun bug-reference-push-button (&optional pos use-mouse-action)
96 "Open URL corresponding to the bug reference at POS."
97 (interactive
98 (list (if (integerp last-command-event) (point) last-command-event)))
99 (if (and (not (integerp pos)) (eventp pos))
100 ;; POS is a mouse event; switch to the proper window/buffer
101 (let ((posn (event-start pos)))
102 (with-current-buffer (window-buffer (posn-window posn))
103 (bug-reference-push-button (posn-point posn) t)))
104 ;; POS is just normal position.
105 (dolist (o (overlays-at pos))
106 ;; It should only be possible to have one URL overlay.
107 (let ((url (overlay-get o 'bug-reference-url)))
108 (when url
109 (browse-url url))))))
111 ;;;###autoload
112 (define-minor-mode bug-reference-mode
113 "Minor mode to buttonize bugzilla references in the current buffer."
117 (if bug-reference-mode
118 (jit-lock-register #'bug-reference-fontify)
119 (jit-lock-unregister #'bug-reference-fontify)
120 (save-restriction
121 (widen)
122 (bug-reference-unfontify (point-min) (point-max)))))
124 ;;;###autoload
125 (define-minor-mode bug-reference-prog-mode
126 "Like `bug-reference-mode', but only buttonize in comments and strings."
130 (if bug-reference-prog-mode
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)))))
137 ;; arch-tag: b138abce-e5c3-475e-bd58-7afba40387ea
138 ;;; bug-reference.el ends here