debbugs.el 3.5 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192
  1. (cl-defun wi-debbugs-gnu-list (&optional (mail-address user-mail-address)
  2. (not-suppress nil))
  3. "List bugs on debbugs.gnu.org from USER-MAIL-ADDRESS.
  4. With NOT-SUPPRESS non-nil argument include archived bugs."
  5. (interactive)
  6. (let ((debbugs-gnu-current-query `((submitter . ,mail-address))))
  7. (if (or current-prefix-arg not-suppress)
  8. (debbugs-gnu nil nil nil nil)
  9. (debbugs-gnu nil nil nil t))))
  10. (defun wi-debbugs-get-url (bug-number)
  11. "Get a debbugs url according to `BUG-NUMBER'"
  12. (interactive "sBug number: ")
  13. (kill-new (concat "https://debbugs.gnu.org/cgi/bugreport.cgi?bug="
  14. bug-number)))
  15. (defun wi-debbugs-gnu-apply-patch (&optional branch)
  16. "Apply the patch from the current message.
  17. If given a prefix, patch in the branch directory instead."
  18. (interactive "P")
  19. (add-hook 'emacs-lisp-mode-hook 'debbugs-gnu-lisp-mode)
  20. (add-hook 'diff-mode-hook 'debbugs-gnu-diff-mode)
  21. (add-hook 'change-log-mode-hook 'debbugs-gnu-change-mode)
  22. (debbugs-gnu-init-current-directory branch)
  23. (let ((rej (expand-file-name "debbugs-gnu.rej" temporary-file-directory))
  24. (output-buffer (get-buffer-create "*debbugs patch*"))
  25. (patch-buffers nil))
  26. (when (file-exists-p rej)
  27. (delete-file rej))
  28. (with-current-buffer output-buffer
  29. (erase-buffer))
  30. (gnus-summary-select-article nil t)
  31. ;; The patches are either in MIME attachements or the main article
  32. ;; buffer. Determine which.
  33. (with-current-buffer gnus-article-buffer
  34. (dolist (handle (mapcar 'cdr (gnus-article-mime-handles)))
  35. (when
  36. (string-match "diff\\|patch\\|plain" (mm-handle-media-type handle))
  37. (push (cons (mm-handle-encoding handle)
  38. (mm-handle-buffer handle))
  39. patch-buffers))))
  40. (unless patch-buffers
  41. (gnus-summary-show-article 'raw)
  42. (article-decode-charset)
  43. (push (cons nil gnus-article-buffer) patch-buffers))
  44. (dolist (elem patch-buffers)
  45. (with-current-buffer (generate-new-buffer "*debbugs input patch*")
  46. (insert-buffer-substring (cdr elem))
  47. (cond ((eq (car elem) 'base64)
  48. (base64-decode-region (point-min) (point-max)))
  49. ((eq (car elem) 'quoted-printable)
  50. (quoted-printable-decode-region (point-min) (point-max))))
  51. (debbugs-gnu-fix-patch debbugs-gnu-current-directory)
  52. (call-process-region (point-min) (point-max)
  53. "patch" nil output-buffer nil
  54. "-r" rej "--no-backup-if-mismatch"
  55. "-l" "-f"
  56. "-d" (expand-file-name
  57. debbugs-gnu-current-directory)
  58. "-p1")))
  59. (set-buffer output-buffer)
  60. (when (file-exists-p rej)
  61. (goto-char (point-max))
  62. (insert-file-contents-literally rej))
  63. (goto-char (point-max))
  64. (save-some-buffers t)
  65. (wi-compile-guix (expand-file-name debbugs-gnu-current-directory))
  66. (vc-dir debbugs-gnu-current-directory)
  67. (vc-dir-hide-up-to-date)
  68. (goto-char (point-min))
  69. (sit-for 1)
  70. (vc-diff)
  71. ;; All these commands are asynchronous, so just wait a bit. This
  72. ;; should be done properly a different way.
  73. (sit-for 2)
  74. ;; We've now done everything, so arrange the windows we need to see.
  75. (delete-other-windows)
  76. (switch-to-buffer output-buffer)
  77. (split-window)
  78. (split-window)
  79. (other-window 1)
  80. (switch-to-buffer "*compilation*")
  81. (goto-char (point-max))
  82. (other-window 1)
  83. (switch-to-buffer "*vc-diff*")
  84. (goto-char (point-min))))
  85. ;; Set defaults for debbugs-gnu commands
  86. (with-eval-after-load 'debbugs-gnu
  87. (setq debbugs-gnu-default-packages (list "guix" "guix-patches")))