view lisp/progmodes/bug-reference.el @ 99602:c94ec53df9d8

* net/ange-ftp.el (ange-ftp-multi-msgs, ange-ftp-good-msgs) (ange-ftp-try-passive-mode, ange-ftp-data-buffer-name) (ange-ftp-account-hashtable, ange-ftp-ls-cache-lsargs) (ange-ftp-ls-cache-file, ange-ftp-ls-cache-res, ange-ftp-get-user) (ange-ftp-ftp-name-component, ange-ftp-kill-ftp-process) (ange-ftp-quote-string, ange-ftp-process-handle-line) (ange-ftp-start-process, ange-ftp-send-cmd, ange-ftp-add-dumb-unix-host) (ange-ftp-before-parse-ls-hook, ange-ftp-after-parse-ls-hook) (ange-ftp-ls, ange-ftp-add-dl-dir, ange-ftp-get-file-entry) (ange-ftp-set-binary-mode, ange-ftp-set-ascii-mode, ange-ftp-get-pwd) (ange-ftp-file-name-as-directory-alist, ange-ftp-reread-dir) (ange-ftp-vms-filename-regexp, ange-ftp-bs2000-fix-name-regexp-reverse) (ange-ftp-bs2000-fix-name-regexp): Fix typos in docstrings. (ange-ftp-name-format, ange-ftp-gateway-fatal-msgs) (ange-ftp-xfer-size-msgs, ange-ftp-tmp-name-template) (ange-ftp-netrc-filename, ange-ftp-disable-netrc-security-check) (ange-ftp-default-user, ange-ftp-default-password) (ange-ftp-default-account, ange-ftp-netrc-default-password) (ange-ftp-netrc-default-account, ange-ftp-dumb-unix-host-regexp) (ange-ftp-binary-file-name-regexp, ange-ftp-gateway-host) (ange-ftp-gateway-prompt-pattern, ange-ftp-smart-gateway-port) (ange-ftp-send-hash, ange-ftp-binary-hash-mark-size) (ange-ftp-ascii-hash-mark-size, ange-ftp-process-verbose) (ange-ftp-ftp-program-name, ange-ftp-gateway-ftp-program-name) (ange-ftp-ftp-program-args, ange-ftp-nslookup-program) (ange-ftp-make-backup-files, ange-ftp-retry-time) (ange-ftp-bs2000-special-prefix): Remove * from defcustom docstrings. (ange-ftp-skip-msgs, ange-ftp-potential-error-msgs) (ange-ftp-gateway-tmp-name-template) (ange-ftp-generate-anonymous-password, ange-ftp-local-host-regexp) (ange-ftp-gateway-program-interactive, ange-ftp-smart-gateway) (ange-ftp-raw-login): Remove * from defcustom docstrings; fix typos. (ange-ftp-fatal-msgs): Remove * from defcustom docstring; doc fix. (ange-ftp-gateway-program): Remove * from docstring and reflow. (ange-ftp-hash-entry-exists-p, ange-ftp-hash-table-keys) (ange-ftp-raw-send-cmd, ange-ftp-get-files, ange-ftp-canonize-filename) (ange-ftp-file-name-as-directory, ange-ftp-directory-file-name): (ange-ftp-copy-files-async, ange-ftp-rename-remote-to-remote): (ange-ftp-rename-local-to-remote): Doc fixes. (ange-ftp-set-xfer-size, ange-ftp-call-cont, ange-ftp-process-filter): Use `when', `unless'. (ange-ftp-set-passwd): Rename arg PASSWD to PASSWORD. (ange-ftp-process-handle-hash): Rename arg STR to STRING. (ange-ftp-nslookup-host): Rename arg HOST to HOSTNAME. (ange-ftp-smart-login): Rename arg PASS to PASSWORD. (ange-ftp-normal-login): Rename arg PASS to PASSWORD. Fix typo. (ange-ftp-process-sentinel): Use `when'. Fix typo. (ange-ftp-gwp-start): Use `let', not `let*'; use `when'. Fix typo. (ange-ftp-fix-name-func-alist, ange-ftp-fix-dir-name-func-alist) (ange-ftp-parse-list-func-alist, ange-ftp-add-file-entry-alist) (ange-ftp-delete-file-entry-alist): Fix typos and reflow docstring. (ange-ftp-dumb-unix-host, ange-ftp-binary-file) (ange-ftp-directory-files, ange-ftp-file-modtime, ange-ftp-vms-host) (ange-ftp-mts-host, ange-ftp-cms-host, ange-ftp-bs2000-host) (ange-ftp-bs2000-posix-host): Use `string-match-p' instead of `(save-match-data (string-match ...))'. (ange-ftp-use-gateway-p, ange-ftp-use-smart-gateway-p) (ange-ftp-file-name-directory, ange-ftp-file-name-nondirectory): Use `string-match-p' instead of `(save-match-data (string-match ...))'. Doc fixes.
author Juanma Barranquero <lekktu@gmail.com>
date Sun, 16 Nov 2008 05:50:23 +0000
parents 7734d90cd461
children a9dc0e7c3f2b
line wrap: on
line source

;; bug-reference.el --- buttonize bug references

;; Copyright (C) 2008 Free Software Foundation, Inc.

;; Author: Tom Tromey <tromey@redhat.com>
;; 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 of the License, 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.  If not, see <http://www.gnu.org/licenses/>.

;;; 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 [down-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.")

;;;###autoload
(put 'bug-reference-url-format 'safe-local-variable 'stringp)

(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))))

(defvar bug-reference-prog-mode)

(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