X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/a6b750299b8e9c2f9342aa192004d16ea7333881..83821f496144e59633860e288189f943ba958b74:/packages/debbugs/debbugs-gnu.el

diff --git a/packages/debbugs/debbugs-gnu.el b/packages/debbugs/debbugs-gnu.el
index 392934800..316a654d1 100644
--- a/packages/debbugs/debbugs-gnu.el
+++ b/packages/debbugs/debbugs-gnu.el
@@ -148,6 +148,7 @@
 (autoload 'diff-goto-source "diff-mode")
 (autoload 'diff-hunk-file-names "diff-mode")
 (autoload 'gnus-article-mime-handles "gnus-art")
+(autoload 'gnus-fetch-field "gnus-util")
 (autoload 'gnus-read-ephemeral-emacs-bug-group "gnus-group")
 (autoload 'gnus-summary-article-header "gnus-sum")
 (autoload 'gnus-summary-select-article "gnus-sum")
@@ -276,7 +277,7 @@ If this is 'rmail, use Rmail instead."
   "Face for reports that are pending.")
 
 (defface debbugs-gnu-stale '((t (:foreground "orange")))
-  "Face for reports that have not been touched for a week.")
+  "Face for reports that have not been touched for two weeks.")
 
 (defface debbugs-gnu-done '((t (:foreground "DarkGrey")))
   "Face for closed bug reports.")
@@ -578,8 +579,10 @@ marked as \"client-side filter\"."
      ;; Otherwise, we retrieve the bugs from the server.
      (t (apply 'debbugs-get-bugs args)))))
 
-(defun debbugs-gnu-show-reports ()
-  "Show bug reports."
+(defun debbugs-gnu-show-reports (&optional offline)
+  "Show bug reports.
+If OFFLINE is non-nil, the query is not sent to the server.  Bugs
+are taken from the cache instead."
   (let ((inhibit-read-only t)
 	(buffer-name "*Emacs Bugs*"))
     ;; The tabulated mode sets several local variables.  We must get
@@ -591,8 +594,16 @@ marked as \"client-side filter\"."
 
     ;; Print bug reports.
     (dolist (status
-	     (apply 'debbugs-get-status
-		    (debbugs-gnu-get-bugs debbugs-gnu-local-query)))
+	     (let ((debbugs-cache-expiry (if offline nil debbugs-cache-expiry))
+		   ids)
+	       (apply 'debbugs-get-status
+		      (if offline
+			  (progn
+			    (maphash (lambda (key _elem)
+				       (push key ids))
+				     debbugs-cache-data)
+			    (sort ids '<))
+			(debbugs-gnu-get-bugs debbugs-gnu-local-query)))))
       (let* ((id (cdr (assq 'id status)))
 	     (words
 	      (mapconcat
@@ -1224,6 +1235,9 @@ MERGED is the list of bugs merged with this one."
 	   (re-search-forward "#\\([0-9]+\\)" nil t)))
      (string-to-number (match-string 1)))))
 
+(defvar debbugs-gnu-send-mail-function nil
+  "A function to send control messages from debbugs.")
+
 (defun debbugs-gnu-send-control-message (message &optional reverse)
   "Send a control message for the current bug report.
 You can set the severity or add a tag, or close the report.  If
@@ -1243,6 +1257,7 @@ removed instead."
 	    "owner" "noowner"
 	    "invalid"
 	    "reassign"
+	    "retitle"
 	    "patch" "wontfix" "moreinfo" "unreproducible" "fixed" "notabug"
 	    "pending" "help" "security" "confirmed"
 	    "usertag")
@@ -1274,6 +1289,7 @@ removed instead."
       (insert "To: control@debbugs.gnu.org\n"
 	      "From: " (message-make-from) "\n"
 	      (format "Subject: control message for bug #%d\n" id)
+	      mail-header-separator
 	      "\n"
 	      (cond
 	       ((member message '("unarchive" "unmerge" "reopen" "noowner"))
@@ -1295,6 +1311,8 @@ removed instead."
 		  " ")))
 	       ((equal message "owner")
 		(format "owner %d !\n" id))
+	       ((equal message "retitle")
+		(format "retitle %d %s\n" id (read-string "New title: ")))
 	       ((equal message "reassign")
 		(format "reassign %d %s\n" id (read-string "Package(s): ")))
 	       ((equal message "close")
@@ -1322,7 +1340,7 @@ removed instead."
 		(format "tags %d%s %s\n"
 			id (if reverse " -" "")
 			message))))
-      (funcall send-mail-function)
+      (funcall (or debbugs-gnu-send-mail-function send-mail-function))
       (remhash id debbugs-cache-data)
       (message-goto-body)
       (message "Control message sent:\n%s"
@@ -1458,7 +1476,7 @@ If given a prefix, patch in the branch directory instead."
     ;; buffer.  Determine which.
     (gnus-with-article-buffer
       (dolist (handle (mapcar 'cdr (gnus-article-mime-handles)))
-	(when (string-match "diff\\|patch" (mm-handle-media-type handle))
+	(when (string-match "diff\\|patch\\|plain" (mm-handle-media-type handle))
 	  (push (cons (mm-handle-encoding handle)
 		      (mm-handle-buffer handle))
 		patch-buffers))))
@@ -1467,11 +1485,11 @@ If given a prefix, patch in the branch directory instead."
       (article-decode-charset)
       (push (cons nil gnus-article-buffer) patch-buffers))
     (dolist (elem patch-buffers)
-      (with-temp-buffer
+      (with-current-buffer (generate-new-buffer "*debbugs input patch*")
 	(insert-buffer-substring (cdr elem))
 	(cond ((eq (car elem) 'base64)
 	       (base64-decode-region (point-min) (point-max)))
-	      ((eq (car elem) 'qp)
+	      ((eq (car elem) 'quoted-printable)
 	       (quoted-printable-decode-region (point-min) (point-max))))
 	(debbugs-gnu-fix-patch dir)
 	(call-process-region (point-min) (point-max)
@@ -1556,18 +1574,48 @@ If given a prefix, patch in the branch directory instead."
     (message "%s is a contributor %d times" string found)
     found))
 
+(defvar debbugs-gnu-patch-subject nil)
+
 (defun debbugs-gnu-insert-changelog ()
   "Add a ChangeLog from a recently applied patch from a third party."
   (interactive)
-  (let (from subject)
+  (let (from subject patch-subject changelog)
     (gnus-with-article-buffer
       (widen)
       (goto-char (point-min))
       (setq from (mail-extract-address-components (gnus-fetch-field "from"))
-	    subject (gnus-fetch-field "subject")))
+	    subject (gnus-fetch-field "subject"))
+      ;; If it's a patch formatted the right way, extract that data.
+      (dolist (handle (mapcar 'cdr (gnus-article-mime-handles)))
+	(when (string-match "diff\\|patch\\|plain"
+			    (mm-handle-media-type handle))
+	  (with-temp-buffer
+	    (insert-buffer-substring (mm-handle-buffer handle))
+	    (cond ((eq (mm-handle-encoding handle) 'base64)
+		   (base64-decode-region (point-min) (point-max)))
+		  ((eq (mm-handle-encoding handle) 'quoted-printable)
+		   (quoted-printable-decode-region (point-min) (point-max))))
+	    (setq patch-subject
+		  (or (gnus-fetch-field "subject") patch-subject))
+	    (goto-char (point-min))
+	    (when (re-search-forward "^[*] " nil t)
+	      (let ((start (match-beginning 0)))
+		(while (and (not (eobp))
+			    (not (looking-at "---")))
+		  (forward-line 1))
+		(setq changelog (buffer-substring
+				 start (line-end-position 0)))))))))
     (let ((add-log-full-name (car from))
 	  (add-log-mailing-address (cadr from)))
       (add-change-log-entry-other-window)
+      (when patch-subject
+	(setq-local debbugs-gnu-patch-subject patch-subject))
+      (when changelog
+	(delete-region (line-beginning-position) (point-max))
+	(save-restriction
+	  (narrow-to-region (point) (point))
+	  (insert changelog)
+	  (indent-region (point-min) (point-max))))
       (let ((point (point)))
 	(when (string-match "\\(bug#[0-9]+\\)" subject)
 	  (insert " (" (match-string 1 subject) ")."))
@@ -1583,7 +1631,9 @@ If given a prefix, patch in the branch directory instead."
 			  (cadr from))))))
 	  (goto-char (point-max))
 	  (end-of-line)
-	  (insert "  (tiny change"))
+	  (when changelog
+	    (insert "\n\n"))
+	  (insert "  Copyright-paperwork-exempt: yes"))
 	(goto-char point)))))
 
 (defvar debbugs-gnu-lisp-mode-map
@@ -1626,28 +1676,45 @@ If given a prefix, patch in the branch directory instead."
   "Prepare checking in the current changes."
   (interactive)
   (save-some-buffers t)
-   (when (get-buffer "*vc-dir*")
-     (kill-buffer (get-buffer "*vc-dir*")))
-   (let ((trunk (expand-file-name debbugs-gnu-trunk-directory)))
-     (if (equal (cl-subseq default-directory 0 (length trunk))
-		trunk)
-	 (vc-dir debbugs-gnu-trunk-directory)
-       (vc-dir debbugs-gnu-branch-directory)))
-   (goto-char (point-min))
-   (while (not (search-forward "edited" nil t))
-     (sit-for 0.01))
-   (beginning-of-line)
-   (while (search-forward "edited" nil t)
-     (vc-dir-mark)
-     (beginning-of-line))
-   (vc-diff nil)
-   (vc-next-action nil)
-   (log-edit-insert-changelog t)
-   (delete-other-windows)
-   (split-window)
-   (other-window 1)
-   (switch-to-buffer "*vc-diff*")
-   (other-window 1))
+  (when (get-buffer "*vc-dir*")
+    (kill-buffer (get-buffer "*vc-dir*")))
+  (let ((patch-subject debbugs-gnu-patch-subject))
+    (let ((trunk (expand-file-name debbugs-gnu-trunk-directory)))
+      (if (equal (cl-subseq default-directory 0 (length trunk))
+		 trunk)
+	  (vc-dir debbugs-gnu-trunk-directory)
+	(vc-dir debbugs-gnu-branch-directory)))
+    (goto-char (point-min))
+    (while (not (search-forward "edited" nil t))
+      (sit-for 0.01))
+    (beginning-of-line)
+    (while (search-forward "edited" nil t)
+      (vc-dir-mark)
+      (beginning-of-line))
+    (vc-diff nil)
+    (vc-next-action nil)
+    (delete-region (point-min) (point-max))
+    (log-edit-insert-changelog t)
+    (delete-other-windows)
+    (split-window)
+    (other-window 1)
+    (switch-to-buffer "*vc-diff*")
+    (other-window 1)
+    (when patch-subject
+      (insert "Summary: "
+	      (replace-regexp-in-string "^ *\\[PATCH\\] *" "" patch-subject)
+	      "\n"))))
+
+(defun debbugs-gnu-save-cache ()
+  "Save the bugs cache to a file."
+  (interactive)
+  (unless debbugs-cache-data
+    (error "No data to cache"))
+  (unless (file-exists-p "~/.emacs.d/debbugs-cache")
+    (make-directory "~/.emacs.d/debbugs-cache" t))
+  (let ((coding-system-for-write 'utf-8))
+    (with-temp-file "~/.emacs.d/debbugs-cache/list"
+      (prin1 debbugs-cache-data (current-buffer)))))
 
 (provide 'debbugs-gnu)