X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/0a29a07b6f6d135b65b9180b084750a99de6bbd6..23a624ca1d40fa9cefd7229ac6152b79278a6517:/packages/debbugs/debbugs-org.el

diff --git a/packages/debbugs/debbugs-org.el b/packages/debbugs/debbugs-org.el
index efb8dd407..d49219ff1 100644
--- a/packages/debbugs/debbugs-org.el
+++ b/packages/debbugs/debbugs-org.el
@@ -1,11 +1,11 @@
 ;;; debbugs-org.el --- Org-mode interface for the GNU bug tracker
 
-;; Copyright (C) 2013 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2015 Free Software Foundation, Inc.
 
 ;; Author: Michael Albinus <michael.albinus@gmx.org>
 ;; Keywords: comm, hypermedia, maint, outlines
 ;; Package: debbugs
-;; Version: 0.5
+;; Version: 0.6
 
 ;; This file is not part of GNU Emacs.
 
@@ -54,8 +54,9 @@
 ;; given, locally tagged bugs are shown.
 
 ;; If a prefix is given to the command, more search parameters are
-;; asked for, like packages (also a comma separated list, "org-mode" is
-;; the default), or whether archived bugs shall be shown.
+;; asked for, like packages (also a comma separated list, "emacs" is
+;; the default), whether archived bugs shall be shown, and whether
+;; closed bugs shall be shown.
 
 ;; Another command is
 ;;
@@ -124,9 +125,19 @@
 ;; We do not add the bug numbers list to the elisp:link, because this
 ;; would be much too long.  Instead, this variable shall keep the bug
 ;; numbers.
-(defvar debbugs-org-ids nil
+(defvar-local debbugs-org-ids nil
   "The list of bug ids to be shown following the elisp link.")
 
+(defvar debbugs-org-show-buffer-name "*Org Bugs*"
+  "The buffer name we present the bug reports.
+This could be a temporary buffer, or a buffer linked with a file.")
+
+(defvar debbugs-org-mode) ;; Silence compiler.
+(defun debbugs-org-show-buffer-name ()
+  "The buffer name we present the bug reports.
+This could be a temporary buffer, or a buffer linked with a file."
+  (if debbugs-org-mode (buffer-name) debbugs-org-show-buffer-name))
+
 ;;;###autoload
 (defun debbugs-org-search ()
   "Search for bugs interactively.
@@ -137,11 +148,10 @@ returned."
   (interactive)
 
   (unwind-protect
-      (let ((date-format "\\([[:digit:]]\\{4\\}\\)-\\([[:digit:]]\\{1,2\\}\\)-\\([[:digit:]]\\{1,2\\}\\)")
-	    key val1 val2 phrase severities packages archivedp)
+      ;; Check for the phrase.
+      (let ((phrase (read-string debbugs-gnu-phrase-prompt))
+            key val1 severities packages)
 
-	;; Check for the phrase.
-	(setq phrase (read-string debbugs-gnu-phrase-prompt))
 	(add-to-list 'debbugs-gnu-current-query (cons 'phrase phrase))
 
 	;; The other queries.
@@ -199,7 +209,7 @@ returned."
     (setq debbugs-gnu-current-query nil)))
 
 ;;;###autoload
-(defun debbugs-org (severities &optional packages archivedp tags)
+(defun debbugs-org (severities &optional packages archivedp suppress tags)
   "List all outstanding bugs."
   (interactive
    (let (severities archivedp)
@@ -216,6 +226,8 @@ returned."
 	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)))))
@@ -236,45 +248,49 @@ returned."
       (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))))
 
-  (with-current-buffer (get-buffer-create "*Org Bugs*")
-    (erase-buffer))
+    (unwind-protect
+	(with-current-buffer (get-buffer-create (debbugs-org-show-buffer-name))
+	  (erase-buffer)
 
-  (unwind-protect
-      (let ((hits debbugs-gnu-default-hits-per-page))
-	(setq debbugs-org-ids (debbugs-gnu-get-bugs debbugs-gnu-current-query))
-
-	(when (> (length debbugs-org-ids) hits)
-	  (let ((cursor-in-echo-area nil))
-	    (setq hits
-		  (string-to-number
-		   (read-string
-		    (format
-		     "How many reports (available %d, default %d): "
-		     (length debbugs-org-ids) hits)
-		    nil
-		    nil
-		    (number-to-string hits))))))
-
-	(debbugs-org-show-next-reports hits))
-
-    ;; Reset query.
-    (setq debbugs-gnu-current-query nil)))
+	  (let ((hits debbugs-gnu-default-hits-per-page))
+	    (setq debbugs-org-ids
+		  (debbugs-gnu-get-bugs debbugs-gnu-current-query))
+
+	    (when (> (length debbugs-org-ids) hits)
+	      (let ((cursor-in-echo-area nil))
+		(setq hits
+		      (string-to-number
+		       (read-string
+			(format
+			 "How many reports (available %d, default %d): "
+			 (length debbugs-org-ids) hits)
+			nil
+			nil
+			(number-to-string hits))))))
+
+	    (debbugs-org-show-next-reports hits)))
+
+      ;; Reset query.
+      (setq debbugs-gnu-current-query nil)))
 
 (defun debbugs-org-show-reports (bug-numbers)
   "Show bug reports as given in BUG-NUMBERS."
-  (pop-to-buffer (get-buffer-create "*Org Bugs*"))
-  (org-mode)
-  (debbugs-org-mode 1)
-  ;; FIXME: Does not show any effect.
-  (set (make-local-variable 'org-priority-faces) debbugs-org-priority-faces)
+  (pop-to-buffer (get-buffer-create (debbugs-org-show-buffer-name)))
+  ;; Local variable `debbugs-org-ids' must survive.
+  (let ((doi debbugs-org-ids))
+    (org-mode)
+    (debbugs-org-mode 1)
+    (setq debbugs-org-ids doi))
 
   (let ((inhibit-read-only t)
 	(debbugs-port "gnu.org"))
-
     (dolist (status
 	     (sort
 	      (apply 'debbugs-get-status bug-numbers)
@@ -303,10 +319,10 @@ returned."
 
 	;; Handle tags.
 	(when (string-match "^\\([0-9.]+\\); \\(.+\\)$" subject)
-	  (add-to-list 'tags (match-string 1 subject))
+	  (let ((x (match-string 1 subject))) (pushnew x tags :test #'equal))
 	  (setq subject (match-string 2 subject)))
 	(when archived
-	  (add-to-list 'tags "ARCHIVE"))
+          (pushnew "ARCHIVE" tags :test #'equal))
 	(setq tags
 	      (mapcar
 	       ;; Replace all invalid TAG characters by "_".
@@ -329,7 +345,7 @@ returned."
 
 	;; Properties.
 	(insert "  :PROPERTIES:\n")
-	(insert (format "  :DEBGUGS_ID: %s\n" id))
+	(insert (format "  :DEBBUGS_ID: %s\n" id))
 	(when merged
 	  (insert
 	   (format
@@ -353,29 +369,60 @@ returned."
 	    (seconds-to-time last-modified))))
 
 	;; Add text properties.
-	(add-text-properties beg (point) `(tabulated-list-id ,status))))
-
+	(add-text-properties beg (point) `(tabulated-list-id ,status))))))
+
+(defun debbugs-org-regenerate-status ()
+  "Regenerate the `tabulated-list-id' text property.
+This property is used when following the [Messages] link, so you
+need to regenerate it when opening an .org file after you killed
+the corresponding buffer (e.g. by closing Emacs)."
+  (save-excursion
     (goto-char (point-min))
-    (org-overview)
-    (set-buffer-modified-p nil)))
+    (while (re-search-forward ":DEBBUGS_ID:[ \t]*\\([0-9]+\\)" nil t)
+      (let* ((bugnum (string-to-number (match-string 1)))
+	     (mw (org-entry-get (point) "MERGEDWIDTH"))
+	     (tli (list (cons 'id bugnum)
+			(cons 'bug_num bugnum)
+			(cons 'mergedwidth (if mw (string-to-number mw)))))
+	    (beg (org-back-to-heading t))
+	    (end (org-end-of-subtree t)))
+	(add-text-properties beg end `(tabulated-list-id ,tli))))))
 
 (defun debbugs-org-show-next-reports (hits)
   "Show next HITS of bug reports."
-  (with-current-buffer (get-buffer-create "*Org Bugs*")
+  (with-current-buffer (get-buffer-create (debbugs-org-show-buffer-name))
     (save-excursion
       (goto-char (point-max))
-      (forward-line -1)
-      (delete-region (point) (point-max))
+      (when (re-search-backward
+	     "^* COMMENT \\[\\[elisp:(debbugs-org-show-next-reports" nil t)
+	(forward-line -1)
+	(delete-region (point) (point-max)))
       (debbugs-org-show-reports
        (butlast debbugs-org-ids (- (length debbugs-org-ids) hits)))
       (setq debbugs-org-ids
 	    (last debbugs-org-ids (- (length debbugs-org-ids) hits)))
+      (goto-char (point-max))
       (when debbugs-org-ids
-	(goto-char (point-max))
 	(insert
 	 (format
-	  "* [[elisp:(debbugs-org-show-next-reports %s)][Next bugs]]\n"
-	  hits))))))
+	  "* COMMENT [[elisp:(debbugs-org-show-next-reports %s)][Next bugs]]\n\n"
+	  hits)))
+      (insert "* COMMENT Local " "Variables\n")
+      (when debbugs-org-ids
+	(insert "#+NAME: init\n"
+		"#+BEGIN_SRC elisp\n"
+		(format "(setq debbugs-org-ids '%s)\n" debbugs-org-ids)
+		"#+END_SRC\n\n"))
+      (insert "# Local " "Variables:\n"
+	      "# mode: org\n"
+	      "# eval: (debbugs-org-mode 1)\n")
+      (when debbugs-org-ids
+	(insert (format "# eval: (%s \"init\")\n"
+			(if (macrop 'org-sbe) "org-sbe" "sbe"))))
+      (insert "# End:\n")
+      (goto-char (point-min))
+      (org-overview)
+      (set-buffer-modified-p nil))))
 
 (defconst debbugs-org-mode-map
   (let ((map (make-sparse-keymap)))
@@ -388,11 +435,14 @@ returned."
 ;; Make byte-compiler quiet.
 (defvar gnus-posting-styles)
 
+;;;###autoload
 (define-minor-mode debbugs-org-mode
   "Minor mode for providing a debbugs interface in org-mode buffers.
 
 \\{debbugs-org-mode-map}"
   :lighter " Debbugs" :keymap debbugs-org-mode-map
+  ;; FIXME: Does not show any effect.
+  (set (make-local-variable 'org-priority-faces) debbugs-org-priority-faces)
   (set (make-local-variable 'gnus-posting-styles)
        `((".*"
 	  (eval
@@ -405,7 +455,8 @@ returned."
 		      ("[0-9]+@debbugs.*" "quiet@debbugs.gnu.org")))
 	       ;; `gnus-posting-styles' is eval'ed after
 	       ;; `message-simplify-subject'.  So we cannot use m-s-s.
-	       (setq subject ,debbugs-gnu-subject))))))))
+	       (setq subject ,debbugs-gnu-subject)))))))
+  (debbugs-org-regenerate-status))
 
 ;;;###autoload
 (defun debbugs-org-bugs (&rest bugs)