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-2016 Free Software Foundation, Inc.
   4
   5 ;; Author: Michael Albinus <michael.albinus@gmx.de>
   6 ;; Keywords: comm, hypermedia, maint
   7 ;; Package: debbugs
   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 a minor mode for browsing bug URLs with
  27 ;; `debbugs-gnu-bugs' or `debbugs-org-bugs'.
  28
  29 ;;; Code:
  30
  31 (defcustom debbugs-browse-function 'debbugs-gnu-bugs
  32   "The debbugs function used for showing bugs.
  33 This can be either `debbugs-gnu-bugs' or `debbugs-org-bugs'."
  34   :group 'debbugs-gnu
  35   :type '(choice (const debbugs-gnu-bugs)
  36                  (const debbugs-org-bugs))
  37   :version "25.1")
  38
  39 (defun debbugs-browse-url (url &optional _new-window)
  40   (when (and (stringp url)
  41              (string-match
  42               (format
  43                "^%s\\(%s\\)?\\([[:digit:]]+\\)$"
  44                (regexp-quote "http://debbugs.gnu.org/")
  45                (regexp-quote "cgi/bugreport.cgi?bug="))
  46               url))
  47     (funcall debbugs-browse-function (string-to-number (match-string 2 url)))
  48     ;; Return t for add-function mechanery.
  49     t))
  50
  51 ;;;###autoload
  52 (define-minor-mode debbugs-browse-mode
  53   "Browse GNU Debbugs bug URLs with debbugs-gnu or debbugs-org.
  54 With a prefix argument ARG, enable Debbugs Browse mode if ARG is
  55 positive, and disable it otherwise.  If called from Lisp, enable
  56 the mode if ARG is omitted or nil.
  57 The customer option `debbugs-browse-function' controls, which of
  58 the two packages is used for showing bugs."
  59   nil
  60   ""
  61   nil
  62   (if debbugs-browse-mode
  63       (add-function
  64        :before-until (local 'browse-url-browser-function) 'debbugs-browse-url)
  65     (remove-function (local 'browse-url-browser-function) 'debbugs-browse-url)))
  66
  67 (provide 'debbugs-browse)
  68 ;;; debbugs-browse.el ends here