mail: Add a quoting command.

* mail.el (durand-quote-messag): Add a command to conveniently quote
mails, and store in the kill-ring.  And bind it to various modes where
this might be used.

1 files changed, 88 insertions, 0 deletions

diff --git a/mail.el b/mail.el
index 44ae645..c624cd6 100644
--- a/mail.el
+++ b/mail.el
@@ -121,3 +121,91 @@
   (setq fill-column 70))
 
 (add-hook 'message-mode-hook #'durand-set-fill-column)
+
+;;; Quote a message
+
+(defun durand-quote-message ()
+  "Quote the current message body, and add some meta-data.
+Actually this only saves the quote text in the `kill-ring', and
+does not modify the buffer directly."
+  (interactive
+   nil gnus-summary-mode gnus-article-mode message-mode)
+  (cond
+   ((apply #'provided-mode-derived-p
+           major-mode (command-modes #'durand-quote-message)))
+   ((user-error
+     (concat
+      "The command only works in the following modes: "
+      (mapconcat
+       (lambda (obj) (format "%S" obj))
+       (command-modes #'durand-quote-message)
+       " ")))))
+  (cond
+   ((derived-mode-p 'gnus-summary-mode)
+    (set-buffer gnus-article-buffer)))
+  (let* ((date
+          (save-match-data
+            (save-restriction
+              (mail-narrow-to-head)
+              (mail-fetch-field "Date"))))
+         (date
+          (format-time-string
+           "%a, %e %b %Y %H:%M:%S %z"
+           (encode-time (parse-time-string date))
+           (current-time-zone)))
+         (author
+          (save-match-data
+            (save-restriction
+              (mail-narrow-to-head)
+              (mail-fetch-field "From"))))
+         (author-name
+          (save-match-data
+            (cond
+             ((string-match
+               (rx "\"" (group (1+ anychar)) "\" <")
+               author)
+              (car (split-string (match-string 1 author))))
+             ((string-match
+               (rx (group (1+ (not (any space "<")))) " <")
+               author)
+              (match-string 1 author))
+             ((string-match
+               (rx "<" (group (1+ (not (any "<>")))) ">")
+               author)
+              (match-string 1 author))
+             (author))))
+         (body
+          (save-match-data
+            (save-restriction
+              (widen)
+              (article-goto-body)
+              (buffer-substring-no-properties
+               (point) (point-max))))))
+    (kill-new
+     (format
+      ">>>>> Le %s, %s a dit:\n\n%s"
+      date author
+      (mapconcat
+       (lambda (line)
+         (cond
+          ;; paranoia
+          ((not (stringp line)) (format "%S" line))
+          ((string-match-p
+            (rx bos
+                (zero-or-more space)
+                (or
+                 (seq
+                  (1+ (not (any ">")))
+                  "> ")
+                 (1+ (literal ">"))
+                 eos))
+            line)
+           line)
+          ((concat "    " author-name "> " line))))
+       (split-string body (string #xa))
+       (string #xa))))
+    (message "Quoted the mail.  To use it just yank it.")))
+
+(define-key message-mode-map (vector 3 ?q) #'durand-quote-message)
+(define-key gnus-summary-mode-map (vector 3 ?q) #'durand-quote-message)
+(define-key gnus-article-mode-map (vector 3 ?q) #'durand-quote-message)