message-fix-quote-alignment.el

message-fix-quote-alignment.el

(defcustom message-quote-alignment-peek-distance 3
  "Number of lines to check above and below the current line to
apply the `message-fix-quote-alignment' function"
  :type 'integer
  :group 'message)

(defun message-fix-quote-alignment (&optional check-surrounding)
  "Align quotation marks in message, considering possible spaces or
tabs between them.

With prefix argument CHECK-SURROUNDING, checks for at least one
empty line within the `message-quote-alignment-peek-distance'
lines above and below.

So the following

>>> >> text
>> continues
>>> >> here

is fixed to

>>> >>
>>> >> text
>>> >> continues
>>> >> here
>>> >>

or to

>>> >>
>>> >> text continues here
>>> >>

... but only if there are empty lines. So the quoted mail headers
are not mixed up with quoted text.
"
  (interactive "P")
  (with-undo-amalgamate
    (unwind-protect
        (let* ((prev-quote-pattern (when (looking-at "^\\(>[ \t]*\\)+")
                                     (match-string 0)))
               (prev-quote-level (if prev-quote-pattern
                                     (length (replace-regexp-in-string "[^>]" "" prev-quote-pattern))
                                   0)))
          (save-excursion
            (goto-char (point-min))
            (forward-line 1)
            (while (not (eobp))
              (let* ((current-line (buffer-substring-no-properties (line-beginning-position) (line-end-position)))
                     (current-quote-pattern (if (string-match "^\\(>[ \t]*\\)+" current-line)
						(match-string 0 current-line)
                                              ""))
                     (current-quote-level (if current-quote-pattern
                                              (length (replace-regexp-in-string "[^>]" "" current-quote-pattern))
                                            0))
                     (line-above-empty nil)
                     (line-below-empty nil))
                (if (> (abs (- current-quote-level prev-quote-level)) 1)
                    (progn
                      ;; Check for at least one empty line above within the limit.
                      (save-excursion
                        (dotimes (_ message-quote-alignment-peek-distance)
                          (forward-line -1)
                          (when (looking-at "^\\(>[ \t]*\\)*$")
                            (setq line-above-empty t))))
                      ;; Check for at least one empty line below within the limit.
                      (save-excursion
                        (dotimes (_ message-quote-alignment-peek-distance)
                          (forward-line 1)
                          (when (looking-at "^\\(>[ \t]*\\)*$")
                            (setq line-below-empty t))))
                      ;; Adjust the current line.
                      (let ((new-line (concat prev-quote-pattern
                                              (replace-regexp-in-string "^\\(>[ \t]*\\)+" "" current-line))))
                        (delete-region (line-beginning-position) (line-end-position))
                        (insert new-line)
                        ;; Apply fill-paragraph if required.
                        (when (and check-surrounding line-above-empty line-below-empty)
                          (fill-paragraph nil t))))
                  ;; Update prev-quote-pattern and prev-quote-level if no adjustment is made.
                  (setq prev-quote-pattern current-quote-pattern
                        prev-quote-level current-quote-level))
                (forward-line 1))))))))

(define-key message-mode-map (kbd "C-c C-f q") #'message-fix-quote-alignment)