From 871968cac1b3ca7f4f401abf305e5ed9c5cf26d3 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Thu, 24 Apr 2008 05:49:09 +0000 Subject: [PATCH] Tom Tromey : New file. --- lisp/progmodes/bug-reference.el | 136 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 136 insertions(+) create mode 100644 lisp/progmodes/bug-reference.el diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el new file mode 100644 index 00000000000..cec9ea31cdd --- /dev/null +++ b/lisp/progmodes/bug-reference.el @@ -0,0 +1,136 @@ +;; bug-reference.el --- buttonize bug references + +;; Copyright (C) 2008 Free Software Foundation, Inc. + +;; Author: Tom Tromey +;; 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))))) + +;; arch-tag: b138abce-e5c3-475e-bd58-7afba40387ea +;;; bug-reference.el ends here -- 2.11.4.GIT