code.delx.au - gnu-emacs-elpa/blob - packages/debbugs/debbugs-browse.el

   1 ;; debbugs-browse.el --- browse bug URLs with debbugs-gnu or debbugs-org
   2
   3 ;; Copyright (C) 2015 Free Software Foundation, Inc.
   4
   5 ;; Author: Michael Albinus <michael.albinus@gmx.de>
   6 ;; Keywords: comm, hypermedia, maint
   7 ;; Package: debbugs
   8 ;; Version: 0.8
   9
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software: you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation, either version 3 of the License, or
  15 ;; (at your option) any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  24
  25 ;;; Commentary:
  26
  27 ;; This file provides a minor mode for browsing bug URLs with
  28 ;; `debbugs-gnu-bugs' or `debbugs-org-bugs'.
  29
  30 ;;; Code:
  31
  32 (defcustom debbugs-browse-function 'debbugs-gnu-bugs
  33   "The debbugs function used for showing bugs.
  34 This can be either `debbugs-gnu-bugs' or `debbugs-org-bugs'."
  35   :group 'debbugs-gnu
  36   :type '(choice (const debbugs-gnu-bugs)
  37                  (const debbugs-org-bugs))
  38   :version "25.1")
  39
  40 (defun debbugs-browse-url (url &optional _new-window)
  41   (when (and (stringp url)
  42              (string-match
  43               (format
  44                "^%s\\(%s\\)?\\([[:digit:]]+\\)$"
  45                (regexp-quote "http://debbugs.gnu.org/")
  46                (regexp-quote "cgi/bugreport.cgi?bug="))
  47               url))
  48     (funcall debbugs-browse-function (string-to-number (match-string 2 url)))
  49     ;; Return t for add-function mechanery.
  50     t))
  51
  52 ;;;###autoload
  53 (define-minor-mode debbugs-browse-mode
  54   "Browse GNU Debbugs bug URLs with debbugs-gnu or debbugs-org.
  55 With a prefix argument ARG, enable Debbugs Browse mode if ARG is
  56 positive, and disable it otherwise.  If called from Lisp, enable
  57 the mode if ARG is omitted or nil.
  58 The customer option `debbugs-browse-function' controls, which of
  59 the two packages is used for showing bugs."
  60   nil
  61   ""
  62   nil
  63   (if debbugs-browse-mode
  64       (add-function
  65        :before-until (local 'browse-url-browser-function) 'debbugs-browse-url)
  66     (remove-function (local 'browse-url-browser-function) 'debbugs-browse-url)))
  67
  68 (provide 'debbugs-browse)
  69 ;;; debbugs-browse.el ends here