X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/4300eaeea7120e40693a8873d98b40272035c2a8..6fb71ddf56ab0a4feda3936e243efb525a006f17:/packages/debbugs/debbugs-org.el diff --git a/packages/debbugs/debbugs-org.el b/packages/debbugs/debbugs-org.el index a95672d5a..c413d111f 100644 --- a/packages/debbugs/debbugs-org.el +++ b/packages/debbugs/debbugs-org.el @@ -1,4 +1,4 @@ -;;; debbugs-org.el --- Org-mode interface for the GNU bug tracker +;;; debbugs-org.el --- Org-mode interface for the GNU bug tracker -*- lexical-binding:t -*- ;; Copyright (C) 2013-2016 Free Software Foundation, Inc. @@ -100,7 +100,7 @@ (require 'debbugs-gnu) (require 'org) -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) ;; Buffer-local variables. (defvar debbugs-gnu-local-query) @@ -109,7 +109,7 @@ (defconst debbugs-org-severity-priority (let ((priority ?A)) (mapcar - (lambda (x) (prog1 (cons x (char-to-string priority)) (incf priority))) + (lambda (x) (prog1 (cons x (char-to-string priority)) (cl-incf priority))) debbugs-gnu-all-severities)) "Mapping of debbugs severities to TODO priorities.") @@ -134,119 +134,28 @@ This could be a temporary buffer, or a buffer linked with a file.") Search arguments are requested interactively. The \"search phrase\" is used for full text search in the bugs database. Further key-value pairs are requested until an empty key is -returned." +returned. If a key cannot be queried by a SOAP request, it is +marked as \"client-side filter\"." (interactive) + (cl-letf (((symbol-function 'debbugs-gnu-show-reports) + #'debbugs-org-show-reports)) + (call-interactively 'debbugs-gnu-search))) - (unwind-protect - ;; Check for the phrase. - (let ((phrase (read-string debbugs-gnu-phrase-prompt)) - key val1 severities packages) - - (add-to-list 'debbugs-gnu-current-query (cons 'phrase phrase)) - - ;; The other queries. - (catch :finished - (while t - (setq key (completing-read - "Enter attribute: " - '("severity" "package" "tags" "submitter" "author" - "subject" "status") - nil t)) - (cond - ;; Server-side queries. - ((equal key "severity") - (setq - severities - (completing-read-multiple - "Enter severities: " debbugs-gnu-all-severities nil t - (mapconcat 'identity debbugs-gnu-default-severities ",")))) - - ((equal key "package") - (setq - packages - (completing-read-multiple - "Enter packages: " debbugs-gnu-all-packages nil t - (mapconcat 'identity debbugs-gnu-default-packages ",")))) - - ((member key '("tags" "subject")) - (setq val1 (read-string (format "Enter %s: " key))) - (when (not (zerop (length val1))) - (add-to-list - 'debbugs-gnu-current-query (cons (intern key) val1)))) - - ((member key '("submitter" "author")) - (when (equal key "author") (setq key "@author")) - (setq val1 (read-string "Enter email address: ")) - (when (not (zerop (length val1))) - (add-to-list - 'debbugs-gnu-current-query (cons (intern key) val1)))) - - ((equal key "status") - (setq - val1 - (completing-read "Enter status: " '("done" "forwarded" "open"))) - (when (not (zerop (length val1))) - (add-to-list - 'debbugs-gnu-current-query (cons (intern key) val1)))) - - ;; The End. - (t (throw :finished nil))))) - - ;; Do the search. - (debbugs-org severities packages)))) +;;;###autoload +(defun debbugs-org-patches () + "List the bug reports that have been marked as containing a patch." + (interactive) + (cl-letf (((symbol-function 'debbugs-gnu-show-reports) + #'debbugs-org-show-reports)) + (call-interactively 'debbugs-gnu-patches))) ;;;###autoload -(defun debbugs-org (severities &optional packages archivedp suppress tags) +(defun debbugs-org () "List all outstanding bugs." - (interactive - (let (severities archivedp) - (list - (setq severities - (completing-read-multiple - "Severities: " debbugs-gnu-all-severities nil t - (mapconcat 'identity debbugs-gnu-default-severities ","))) - ;; The next parameters are asked only when there is a prefix. - (if current-prefix-arg - (completing-read-multiple - "Packages: " debbugs-gnu-all-packages nil t - (mapconcat 'identity debbugs-gnu-default-packages ",")) - debbugs-gnu-default-packages) - (when current-prefix-arg - (setq archivedp (y-or-n-p "Show archived bugs?"))) - (when (and current-prefix-arg (not archivedp)) - (y-or-n-p "Suppress unwanted bugs?")) - ;; This one must be asked for severity "tagged". - (when (member "tagged" severities) - (split-string (read-string "User tag(s): ") "," t))))) - - ;; Initialize variables. - (when (and (file-exists-p debbugs-gnu-persistency-file) - (not debbugs-gnu-local-tags)) - (with-temp-buffer - (insert-file-contents debbugs-gnu-persistency-file) - (eval (read (current-buffer))))) - - ;; Add queries. - (dolist (severity (if (consp severities) severities (list severities))) - (when (not (zerop (length severity))) - (add-to-list 'debbugs-gnu-current-query (cons 'severity severity)))) - (dolist (package (if (consp packages) packages (list packages))) - (when (not (zerop (length package))) - (add-to-list 'debbugs-gnu-current-query (cons 'package package)))) - (when archivedp - (add-to-list 'debbugs-gnu-current-query '(archive . "1"))) - (when suppress - (add-to-list 'debbugs-gnu-current-query '(status . "open")) - (add-to-list 'debbugs-gnu-current-query '(status . "forwarded"))) - (dolist (tag (if (consp tags) tags (list tags))) - (when (not (zerop (length tag))) - (add-to-list 'debbugs-gnu-current-query (cons 'tag tag)))) - - ;; Show result. - (debbugs-org-show-reports) - - ;; Reset query. - (setq debbugs-gnu-current-query nil)) + (interactive) + (cl-letf (((symbol-function 'debbugs-gnu-show-reports) + #'debbugs-org-show-reports)) + (call-interactively 'debbugs-gnu))) (defun debbugs-org-show-reports () "Show bug reports as retrieved via `debbugs-gnu-current-query'." @@ -288,10 +197,10 @@ returned." ;; Handle tags. (when (string-match "^\\([0-9.]+\\); \\(.+\\)$" subject) - (let ((x (match-string 1 subject))) (pushnew x tags :test #'equal)) + (let ((x (match-string 1 subject))) (cl-pushnew x tags :test #'equal)) (setq subject (match-string 2 subject))) (when archived - (pushnew "ARCHIVE" tags :test #'equal)) + (cl-pushnew "ARCHIVE" tags :test #'equal)) (setq tags (mapcar ;; Replace all invalid TAG characters by "_". @@ -405,19 +314,15 @@ the corresponding buffer (e.g. by closing Emacs)." (debbugs-org-regenerate-status)) ;;;###autoload -(defun debbugs-org-bugs (&rest bugs) +(defun debbugs-org-bugs () "List all BUGS, a list of bug numbers." - (interactive - (mapcar 'string-to-number - (completing-read-multiple "Bug numbers: " nil 'natnump))) - (dolist (elt bugs) - (unless (natnump elt) (signal 'wrong-type-argument (list 'natnump elt)))) - (add-to-list 'debbugs-gnu-current-query (cons 'bugs bugs)) - (debbugs-org nil)) + (interactive) + (cl-letf (((symbol-function 'debbugs-gnu-show-reports) + #'debbugs-org-show-reports)) + (call-interactively 'debbugs-gnu-bugs))) ;; TODO -;; - Refactor it in order to avoid code duplication with debbugs-gnu.el. ;; - Make headline customizable. ;; - Sort according to different TODO properties.