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

diff --git a/packages/debbugs/debbugs-gnu.el b/packages/debbugs/debbugs-gnu.el
index 753ac16c5..97c67e4b3 100644
--- a/packages/debbugs/debbugs-gnu.el
+++ b/packages/debbugs/debbugs-gnu.el
@@ -1,20 +1,21 @@
 ;;; debbugs-gnu.el --- interface for the GNU bug tracker
 
-;; Copyright (C) 2011, 2012 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2015 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
+;;         Michael Albinus <michael.albinus@gmx.org>
 ;; Keywords: comm, hypermedia, maint
 ;; Package: debbugs
-;; Version: 0.3
+;; Version: 0.6
 
-;; This file is part of GNU Emacs.
+;; This file is not part of GNU Emacs.
 
-;; GNU Emacs is free software: you can redistribute it and/or modify
+;; This program is free software: you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
 ;; the Free Software Foundation, either version 3 of the License, or
 ;; (at your option) any later version.
 
-;; GNU Emacs is distributed in the hope that it will be useful,
+;; This program is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 ;; GNU General Public License for more details.
@@ -34,6 +35,8 @@
 ;;
 ;;   (autoload 'debbugs-gnu "debbugs-gnu" "" 'interactive)
 ;;   (autoload 'debbugs-gnu-search "debbugs-gnu" "" 'interactive)
+;;   (autoload 'debbugs-gnu-usertags "debbugs-gnu" "" 'interactive)
+;;   (autoload 'debbugs-gnu-bugs "debbugs-gnu" "" 'interactive)
 
 ;; The bug tracker is called interactively by
 ;;
@@ -50,8 +53,8 @@
 ;; function will ask for user tags (a comma separated list), and shows
 ;; just the bugs which are tagged with them.  In general, user tags
 ;; shall be strings denoting to subprojects of the package, like
-;; "cedet" or "tramp" of the package "emacs.  If no user tag is given,
-;; locally tagged bugs are shown.
+;; "cedet" or "tramp" of the package "emacs".  If no user tag is
+;; 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, "emacs" is
@@ -89,6 +92,8 @@
 ;;   RET: Show corresponding messages in Gnus
 ;;   "C": Send a control message
 ;;   "t": Mark the bug locally as tagged
+;;   "b": Show bugs this bug is blocked by
+;;   "B": Show bugs this bug is blocking
 ;;   "d": Show bug attributes
 
 ;; Furthermore, you could apply the global actions
@@ -108,14 +113,38 @@
 ;; happens as expected for the respective column; sorting in the Title
 ;; column is depending on whether you are the owner of a bug.
 
+;; Another approach for listing bugs is calling the command
+;;
+;;   M-x debbugs-gnu-usertags
+
+;; This command shows you all existing user tags for the packages
+;; defined in `debbugs-gnu-default-packages'.  A prefix for the
+;; command allows you to use other packe names, or an arbitrary string
+;; for a user who has tagged bugs.  The command returns the list of
+;; existing user tags for the given user(s) or package name(s),
+;; respectively.  Applying RET on a user tag, all bugs tagged with
+;; this user tag are shown.
+
+;; Unfortunately, it is not possible with the SOAP interface to show
+;; all users who have tagged bugs.  This list can be retrieved via
+;; <http://debbugs.gnu.org/cgi/pkgindex.cgi?indexon=users>.
+
+;; Finally, if you simply want to list some bugs with known bug
+;; numbers, call the command
+;;
+;;   M-x debbugs-gnu-bugs
+
+;; The bug numbers to be shown shall be entered as comma separated list.
+
 ;;; Code:
 
 (require 'debbugs)
 (require 'widget)
+(require 'wid-edit)
 (require 'tabulated-list)
+(require 'add-log)
 (eval-when-compile (require 'cl))
 
-(autoload 'widget-convert "wid-edit.el")
 (autoload 'gnus-read-ephemeral-emacs-bug-group "gnus-group")
 (autoload 'mail-header-subject "nnheader")
 (autoload 'gnus-summary-article-header "gnus-sum")
@@ -146,18 +175,31 @@
 (defcustom debbugs-gnu-default-packages '("emacs")
   "*The list of packages to be searched for."
   ;; <http://debbugs.gnu.org/Packages.html>
+  ;; <http://debbugs.gnu.org/cgi/pkgindex.cgi>
   :group 'debbugs-gnu
-  :type '(set (const "automake")
+  :type '(set (const "auctex")
+	      (const "automake")
+	      (const "cc-mode")
 	      (const "coreutils")
+	      (const "cppi")
 	      (const "debbugs.gnu.org")
+	      (const "diffutils")
 	      (const "emacs")
 	      (const "emacs-xwidgets")
 	      (const "fm")
 	      (const "gnus")
+	      (const "grep")
 	      (const "guile")
+	      (const "guix")
+	      (const "gzip")
+	      (const "idutils")
 	      (const "libtool")
+	      (const "mh-e")
+	      (const "org-mode")
+	      (const "parted")
+	      (const "vc-dwim")
 	      (const "woodchuck"))
-  :version "24.1")
+  :version "24.4")
 
 (defconst debbugs-gnu-all-packages
   (mapcar 'cadr (cdr (get 'debbugs-gnu-default-packages 'custom-type)))
@@ -203,7 +245,6 @@ suppressed bugs is toggled by `debbugs-gnu-toggle-suppress'."
 (defvar debbugs-gnu-widget-map
   (let ((map (make-sparse-keymap)))
     (define-key map "\r" 'widget-button-press)
-    (define-key map [mouse-1] 'widget-button-press)
     (define-key map [mouse-2] 'widget-button-press)
     map))
 
@@ -324,8 +365,8 @@ marked as \"client-side filter\"."
 	       val1
 	       (completing-read "Enter status: " '("done" "forwarded" "open")))
 	      (when (not (zerop (length val1)))
-	    (add-to-list
-	     'debbugs-gnu-current-query (cons (intern key) val1))))
+		(add-to-list
+		 'debbugs-gnu-current-query (cons (intern key) val1))))
 
 	     ;; Client-side filters.
 	     ((member key '("date" "log_modified" "last_modified"
@@ -390,7 +431,7 @@ marked as \"client-side filter\"."
 
 ;;;###autoload
 (defun debbugs-gnu (severities &optional packages archivedp suppress tags)
-  "List all outstanding Emacs bugs."
+  "List all outstanding bugs."
   (interactive
    (let (severities archivedp)
      (list
@@ -429,6 +470,9 @@ marked as \"client-side filter\"."
       (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))))
@@ -491,6 +535,7 @@ marked as \"client-side filter\"."
 (defun debbugs-gnu-get-bugs (query)
   "Retrieve bugs numbers from debbugs.gnu.org according search criteria."
   (let* ((debbugs-port "gnu.org")
+	 (bugs (assoc 'bugs query))
 	 (tags (assoc 'tag query))
 	 (local-tags (and (member '(severity . "tagged") query) (not tags)))
 	 (phrase (assoc 'phrase query))
@@ -519,6 +564,8 @@ marked as \"client-side filter\"."
 
     (sort
      (cond
+      ;; If the query is just a list of bug numbers, we return them.
+      (bugs (cdr bugs))
       ;; If the query contains the pseudo-severity "tagged", we return
       ;; just the local tagged bugs.
       (local-tags (copy-sequence debbugs-gnu-local-tags))
@@ -528,7 +575,9 @@ marked as \"client-side filter\"."
 	(lambda (x) (cdr (assoc "id" x)))
 	(apply 'debbugs-search-est args)))
       ;; User tags.
-      (tags (apply 'debbugs-get-usertag args))
+      (tags
+       (setq args (mapcar (lambda (x) (if (eq x :package) :user x)) args))
+       (apply 'debbugs-get-usertag args))
       ;; Otherwise, we retrieve the bugs from the server.
       (t (apply 'debbugs-get-bugs args)))
      ;; Sort function.
@@ -537,8 +586,6 @@ marked as \"client-side filter\"."
 (defvar debbugs-gnu-current-widget nil)
 (defvar debbugs-gnu-current-limit nil)
 
-(defvar widget-mouse-face)
-
 (defun debbugs-gnu-show-reports (widget)
   "Show bug reports as given in WIDGET property :bug-ids."
   ;; The tabulated mode sets several local variables.  We must get rid
@@ -684,13 +731,14 @@ Used instead of `tabulated-list-print-entry'."
 	       (memq (cdr (assq 'id list-id)) debbugs-gnu-current-limit))
 	   ;; Filter suppressed bugs.
 	   (or (not (widget-get debbugs-gnu-current-widget :suppress))
-	       (not (catch :suppress
-		      (dolist (check debbugs-gnu-default-suppress-bugs)
-			(when
-			    (string-match
-			     (cdr check)
-			     (or (cdr (assq (car check) list-id)) ""))
-			  (throw :suppress t))))))
+	       (and (not (memq (cdr (assq 'id list-id)) debbugs-gnu-local-tags))
+		    (not (catch :suppress
+			   (dolist (check debbugs-gnu-default-suppress-bugs)
+			     (when
+				 (string-match
+				  (cdr check)
+				  (or (cdr (assq (car check) list-id)) ""))
+			       (throw :suppress t)))))))
 	   ;; Filter search list.
 	   (not (catch :suppress
 		  (dolist (check
@@ -745,6 +793,8 @@ Used instead of `tabulated-list-print-entry'."
     (define-key map "x" 'debbugs-gnu-toggle-suppress)
     (define-key map "/" 'debbugs-gnu-narrow-to-status)
     (define-key map "w" 'debbugs-gnu-widen)
+    (define-key map "b" 'debbugs-gnu-show-blocked-by-reports)
+    (define-key map "B" 'debbugs-gnu-show-blocking-reports)
     (define-key map "C" 'debbugs-gnu-send-control-message)
     map))
 
@@ -880,29 +930,49 @@ The following commands are available:
     (when id
       (debbugs-gnu-goto id))))
 
+(defun debbugs-gnu-show-blocked-by-reports ()
+  "Display all bug reports this report is blocked by."
+  (interactive)
+  (let ((id (debbugs-gnu-current-id))
+	(status (debbugs-gnu-current-status)))
+    (if (null (cdr (assq 'blockedby status)))
+	(message "Bug %d is not blocked by any other bug" id)
+      (apply 'debbugs-gnu-bugs (cdr (assq 'blockedby status))))))
+
+(defun debbugs-gnu-show-blocking-reports ()
+  "Display all bug reports this report is blocking."
+  (interactive)
+  (let ((id (debbugs-gnu-current-id))
+	(status (debbugs-gnu-current-status)))
+    (if (null (cdr (assq 'blocks status)))
+	(message "Bug %d is not blocking any other bug" id)
+      (apply 'debbugs-gnu-bugs (cdr (assq 'blocks status))))))
+
 (defun debbugs-gnu-narrow-to-status (string &optional status-only)
   "Only display the bugs matching STRING.
 If STATUS-ONLY (the prefix), ignore matches in the From and
 Subject fields."
-  (interactive "sNarrow to: \np")
+  (interactive "sNarrow to: \nP")
   (let ((id (debbugs-gnu-current-id t))
 	(inhibit-read-only t)
 	status)
     (setq debbugs-gnu-current-limit nil)
-    (goto-char (point-min))
-    (while (not (eobp))
-      (setq status (debbugs-gnu-current-status))
-      (if (and (not (member string (assq 'keywords status)))
-	       (not (member string (assq 'severity status)))
-	       (or status-only
-		   (not (string-match string (cdr (assq 'originator status)))))
-	       (or status-only
-		   (not (string-match string (cdr (assq 'subject status))))))
-	  (delete-region (point) (progn (forward-line 1) (point)))
-	(push (cdr (assq 'id status)) debbugs-gnu-current-limit)
-	(forward-line 1)))
-    (when id
-      (debbugs-gnu-goto id))))
+    (if (equal string "")
+	(debbugs-gnu-toggle-suppress)
+      (goto-char (point-min))
+      (while (not (eobp))
+	(setq status (debbugs-gnu-current-status))
+	(if (and (not (member string (assq 'keywords status)))
+		 (not (member string (assq 'severity status)))
+		 (or status-only
+		     (not (string-match string (cdr (assq 'originator status)))))
+		 (or status-only
+		     (not (string-match string (cdr (assq 'subject status))))))
+	    (delete-region (point) (progn (forward-line 1) (point)))
+	  (push (cdr (assq 'id status)) debbugs-gnu-current-limit)
+	  (forward-line 1)))
+      (when id
+	(debbugs-gnu-goto id)))))
 
 (defun debbugs-gnu-goto (id)
   "Go to the line displaying bug ID."
@@ -912,7 +982,9 @@ Subject fields."
     (forward-line 1)))
 
 (defun debbugs-gnu-toggle-tag ()
-  "Toggle tag of the report in the current line."
+  "Toggle the local tag of the report in the current line.
+If a report is tagged locally, it is presumed to be of little
+interest to you."
   (interactive)
   (save-excursion
     (beginning-of-line)
@@ -925,9 +997,22 @@ Subject fields."
 	(add-to-list 'debbugs-gnu-local-tags id)
 	(put-text-property
 	 (+ (point) (- 5 (length (number-to-string id)))) (+ (point) 5)
-	 'face 'debbugs-gnu-tagged))))
+	 'face 'debbugs-gnu-tagged))
+      (debbugs-gnu--update-tag-face id)))
   (debbugs-gnu-dump-persistency-file))
 
+(defun debbugs-gnu--update-tag-face (id)
+  (dolist (entry tabulated-list-entries)
+    (when (equal (cdr (assq 'id (car entry))) id)
+      (aset (cadr entry) 0
+	    (propertize
+	     (format "%5d" id)
+	     'face
+	     ;; Mark tagged bugs.
+	     (if (memq id debbugs-gnu-local-tags)
+		 'debbugs-gnu-tagged
+	       'default))))))
+
 (defun debbugs-gnu-toggle-suppress ()
   "Suppress bugs marked in `debbugs-gnu-suppress-bugs'."
   (interactive)
@@ -985,6 +1070,7 @@ Subject fields."
 (defvar debbugs-gnu-summary-mode-map
   (let ((map (make-sparse-keymap)))
     (define-key map "C" 'debbugs-gnu-send-control-message)
+    (define-key map [(meta m)] 'debbugs-gnu-apply-patch)
     map))
 
 (defvar gnus-posting-styles)
@@ -1040,8 +1126,9 @@ removed instead."
 	  "Control message: "
 	  '("serious" "important" "normal" "minor" "wishlist"
 	    "done" "donenotabug" "donewontfix" "doneunreproducible"
-	    "unarchive" "reopen" "close"
+	    "unarchive" "unmerge" "reopen" "close"
 	    "merge" "forcemerge"
+	    "block" "unblock"
 	    "owner" "noowner"
 	    "invalid"
 	    "reassign"
@@ -1070,18 +1157,31 @@ removed instead."
 	       (format "%s.%s"
 		       (match-string 1 emacs-version)
 		       (match-string 2 emacs-version)))
-	      (t emacs-version))))))
+	      (t emacs-version)))))
+	 (status (debbugs-gnu-current-status)))
     (with-temp-buffer
       (insert "To: control@debbugs.gnu.org\n"
 	      "From: " (message-make-from) "\n"
 	      (format "Subject: control message for bug #%d\n" id)
 	      "\n"
 	      (cond
-	       ((member message '("unarchive" "reopen" "noowner"))
+	       ((member message '("unarchive" "unmerge" "reopen" "noowner"))
 		(format "%s %d\n" message id))
 	       ((member message '("merge" "forcemerge"))
 		(format "%s %d %s\n" message id
 			(read-string "Merge with bug #: ")))
+	       ((member message '("block" "unblock"))
+		(format
+		 "%s %d by %s\n" message id
+		 (mapconcat
+		  'identity
+		  (completing-read-multiple
+		   (format "%s with bug(s) #: " (capitalize message))
+		   (if (equal message "unblock")
+		       (mapcar 'number-to-string
+			       (cdr (assq 'blockedby status))))
+		   nil (and (equal message "unblock") status))
+		  " ")))
 	       ((equal message "owner")
 		(format "owner %d !\n" id))
 	       ((equal message "reassign")
@@ -1113,6 +1213,284 @@ removed instead."
 			message))))
       (funcall send-mail-function))))
 
+(defvar debbugs-gnu-usertags-mode-map
+  (let ((map (make-sparse-keymap)))
+    (set-keymap-parent map tabulated-list-mode-map)
+    (define-key map "\r" 'debbugs-gnu-select-usertag)
+    (define-key map [mouse-1] 'debbugs-gnu-select-usertag)
+    (define-key map [mouse-2] 'debbugs-gnu-select-usertag)
+    map))
+
+(define-derived-mode debbugs-gnu-usertags-mode tabulated-list-mode "Usertags"
+  "Major mode for listing user tags.
+
+All normal editing commands are switched off.
+\\<debbugs-gnu-usertags-mode-map>
+
+The following commands are available:
+
+\\{debbugs-gnu-usertags-mode-map}"
+  (buffer-disable-undo)
+  (setq truncate-lines t)
+  (setq buffer-read-only t))
+
+;;;###autoload
+(defun debbugs-gnu-usertags (&rest users)
+  "List all user tags for USERS, which is \(\"emacs\"\) by default."
+  (interactive
+   (if current-prefix-arg
+       (completing-read-multiple
+	"Package name(s) or email address: "
+	(append debbugs-gnu-all-packages (list user-mail-address)) nil nil
+	(mapconcat 'identity debbugs-gnu-default-packages ","))
+     debbugs-gnu-default-packages))
+
+  (unwind-protect
+      (let ((inhibit-read-only t)
+	    (debbugs-port "gnu.org")
+	    (buffer-name "*Emacs User Tags*")
+	    (user-tab-length
+	     (1+ (apply 'max (length "User") (mapcar 'length users)))))
+
+	;; 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)))))
+
+	;; Create buffer.
+	(when (get-buffer buffer-name)
+	  (kill-buffer buffer-name))
+	(pop-to-buffer (get-buffer-create buffer-name))
+	(debbugs-gnu-usertags-mode)
+	(setq tabulated-list-format `[("User" ,user-tab-length t)
+				      ("Tag"  10 t)])
+	(setq tabulated-list-sort-key (cons "User" nil))
+	;(setq tabulated-list-printer 'debbugs-gnu-print-entry)
+	(erase-buffer)
+
+	;; Retrieve user tags.
+	(dolist (user users)
+	  (dolist (tag (sort (debbugs-get-usertag :user user) 'string<))
+	    (add-to-list
+	     'tabulated-list-entries
+	     ;; `tabulated-list-id' is the parameter list for `debbugs-gnu'.
+	     `((("tagged") (,user) nil nil (,tag))
+	       ,(vector (propertize user 'mouse-face widget-mouse-face)
+			(propertize tag 'mouse-face widget-mouse-face)))
+	     'append)))
+
+	;; Add local tags.
+	(when debbugs-gnu-local-tags
+	  (add-to-list
+	     'tabulated-list-entries
+	     `((("tagged"))
+	       ,(vector "" (propertize "(local tags)"
+				       'mouse-face widget-mouse-face)))))
+
+	;; Show them.
+	(tabulated-list-init-header)
+	(tabulated-list-print)
+
+	(set-buffer-modified-p nil)
+	(goto-char (point-min)))))
+
+(defun debbugs-gnu-select-usertag ()
+  "Select the user tag on the current line."
+  (interactive)
+  ;; We open the bug reports.
+  (let ((args (get-text-property (line-beginning-position) 'tabulated-list-id)))
+    (when args (apply 'debbugs-gnu args))))
+
+;;;###autoload
+(defun debbugs-gnu-bugs (&rest 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-gnu nil))
+
+(defvar debbugs-gnu-trunk-directory "~/src/emacs/trunk/"
+  "The directory where the main source tree lives.")
+
+(defvar debbugs-gnu-branch-directory "~/src/emacs/emacs-24/"
+  "The directory where the previous source tree lives.")
+
+(defun debbugs-gnu-apply-patch (&optional branch)
+  "Apply the patch from the current message.
+If given a prefix, patch in the branch directory instead."
+  (interactive "P")
+  (add-hook 'emacs-lisp-mode-hook 'debbugs-gnu-lisp-mode)
+  (add-hook 'diff-mode-hook 'debbugs-gnu-diff-mode)
+  (add-hook 'change-log-mode-hook 'debbugs-gnu-change-mode)
+  (let ((rej "/tmp/debbugs-gnu.rej")
+	(output-buffer (get-buffer-create "*debbugs patch*"))
+	(dir (if branch
+		 debbugs-gnu-branch-directory
+	       debbugs-gnu-trunk-directory))
+	(patch-buffers nil))
+    (when (file-exists-p rej)
+      (delete-file rej))
+    (with-current-buffer output-buffer
+      (erase-buffer))
+    (gnus-summary-select-article nil t)
+    ;; The patches are either in MIME attachements or the main article
+    ;; 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))
+	  (push (mm-handle-buffer handle) patch-buffers))))
+    (unless patch-buffers
+      (gnus-summary-show-article 'raw)
+      (article-decode-charset)
+      (push (current-buffer) patch-buffers))
+    (dolist (buffer patch-buffers)
+      (with-current-buffer buffer
+	(call-process-region (point-min) (point-max)
+			     "patch" nil output-buffer nil
+			     "-r" rej "--no-backup-if-mismatch"
+			     "-l" "-f"
+			     "-d" (expand-file-name dir)
+			     "-p1")))
+    (set-buffer output-buffer)
+    (when (file-exists-p rej)
+      (goto-char (point-max))
+      (insert-file-contents-literally rej))
+    (goto-char (point-max))
+    (save-some-buffers t)
+    (require 'compile)
+    (mapcar 'kill-process compilation-in-progress)
+    (compile (format "cd %s; make -k" (expand-file-name "lisp" dir)))
+    (vc-dir dir)
+    (vc-dir-hide-up-to-date)
+    (goto-char (point-min))
+    (sit-for 1)
+    (vc-diff)
+    ;; All these commands are asynchronous, so just wait a bit.  This
+    ;; should be done properly a different way.
+    (sit-for 2)
+    ;; We've now done everything, so arrange the windows we need to see.
+    (delete-other-windows)
+    (switch-to-buffer output-buffer)
+    (split-window)
+    (split-window)
+    (other-window 1)
+    (switch-to-buffer "*compilation*")
+    (goto-char (point-max))
+    (other-window 1)
+    (switch-to-buffer "*vc-diff*")
+    (goto-char (point-min))))
+
+(defun debbugs-gnu-find-contributor (string)
+  "Search through ChangeLogs to find contributors."
+  (interactive "sContributor match: ")
+  (let ((found 0)
+	(match (concat "^[0-9].*" string)))
+    (dolist (file (directory-files-recursively
+		   debbugs-gnu-trunk-directory "ChangeLog\\(.[0-9]+\\)?$"))
+      (with-temp-buffer
+	(when (file-exists-p file)
+	  (insert-file-contents file))
+	(goto-char (point-min))
+	(while (and (re-search-forward match nil t)
+		    (not (looking-at ".*tiny change")))
+	  (cl-incf found))))
+    (message "%s is a contributor %d times" string found)
+    found))
+
+(defun debbugs-gnu-insert-changelog ()
+  "Add a ChangeLog from a recently applied patch from a third party."
+  (interactive)
+  (let (from subject)
+    (gnus-with-article-buffer
+      (widen)
+      (goto-char (point-min))
+      (setq from (mail-extract-address-components (gnus-fetch-field "from"))
+	    subject (gnus-fetch-field "subject")))
+    (let ((add-log-full-name (car from))
+	  (add-log-mailing-address (cadr from)))
+      (add-change-log-entry-other-window)
+      (let ((point (point)))
+	(when (string-match "\\(bug#[0-9]+\\)" subject)
+	  (insert " (" (match-string 1 subject) ")."))
+	(when (zerop (debbugs-gnu-find-contributor
+		      (let ((bits (split-string (car from))))
+			(cond
+			 ((>= (length bits) 2)
+			  (format "%s.*%s" (car bits) (car (last bits))))
+			 ((= (length bits) 1)
+			  (car bits))
+			 ;; Fall back on the email address.
+			 (t
+			  (cadr from))))))
+	  (goto-char (point-min))
+	  (end-of-line)
+	  (insert "  (tiny change"))
+	(goto-char point)))))
+
+(defvar debbugs-gnu-lisp-mode-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map [(meta m)] 'debbugs-gnu-insert-changelog)
+    map))
+
+(define-minor-mode debbugs-gnu-lisp-mode
+  "Minor mode for providing a debbugs interface in Lisp buffers.
+\\{debbugs-gnu-lisp-mode-map}"
+  :lighter " Debbugs" :keymap debbugs-gnu-lisp-mode-map)
+
+(defvar debbugs-gnu-diff-mode-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map [(meta m)] 'debbugs-gnu-diff-select)
+    map))
+
+(define-minor-mode debbugs-gnu-diff-mode
+  "Minor mode for providing a debbugs interface in diff buffers.
+\\{debbugs-gnu-diff-mode-map}"
+  :lighter " Debbugs" :keymap debbugs-gnu-diff-mode-map)
+
+(defun debbugs-gnu-diff-select ()
+  "Select the diff under point."
+  (interactive)
+  (delete-other-windows)
+  (diff-goto-source))
+
+(defvar debbugs-gnu-change-mode-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map [(meta m)] 'debbugs-gnu-change-checkin)
+    map))
+
+(define-minor-mode debbugs-gnu-change-mode
+  "Minor mode for providing a debbugs interface in ChangeLog buffers.
+\\{debbugs-gnu-change-mode-map}"
+  :lighter " Debbugs" :keymap debbugs-gnu-change-mode-map)
+
+(defun debbugs-gnu-change-checkin ()
+  "Prepare checking in the current changes."
+  (interactive)
+  (save-some-buffers t)
+   (when (get-buffer "*vc-dir*")
+     (kill-buffer (get-buffer "*vc-dir*")))
+   (vc-dir debbugs-gnu-trunk-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))
+
 (provide 'debbugs-gnu)
 
 ;;; TODO: