1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-15 10:30:25 -08:00

Reimplement the `fill-flowed' function to respect space stuffing

* lisp/mail/flow-fill.el (fill-flowed): Reimplement the function
to respect space-stuffing (bug#17190).

* test/lisp/mail/flow-fill-tests.el
(fill-flow-tests-fill-flowed-stuffed): New test.
(fill-flow-tests-fill-flowed-decode): Rename the test so that it
actually runs.
This commit is contained in:
Lars Ingebrigtsen 2019-08-15 18:00:08 -07:00
parent 1ee0192b79
commit ab8a96977f
2 changed files with 58 additions and 50 deletions

View file

@ -120,55 +120,49 @@ If BUFFER is nil, default to the current buffer.
If DELETE-SPACE, delete RFC2646 spaces padding at the end of
lines."
(with-current-buffer (or buffer (current-buffer))
(goto-char (point-min))
;; Remove space stuffing.
(while (re-search-forward "^\\( \\|>+ $\\)" nil t)
(delete-char -1)
(forward-line 1))
(goto-char (point-min))
(while (re-search-forward " $" nil t)
(when (save-excursion
(beginning-of-line)
(looking-at "^\\(>*\\)\\( ?\\)"))
(let ((quote (match-string 1))
sig)
(if (string= quote "")
(setq quote nil))
(when (and quote (string= (match-string 2) ""))
(save-excursion
;; insert SP after quote for pleasant reading of quoted lines
(beginning-of-line)
(when (> (skip-chars-forward ">") 0)
(insert " "))))
;; XXX slightly buggy handling of "-- "
(while (and (save-excursion
(ignore-errors (backward-char 3))
(setq sig (looking-at "-- "))
(looking-at "[^-][^-] "))
(save-excursion
(unless (eobp)
(forward-char 1)
(looking-at (format "^\\(%s\\)\\([^>\n\r]\\)"
(or quote " ?"))))))
(save-excursion
(replace-match (if (string= (match-string 2) " ")
"" "\\2")))
(backward-delete-char -1)
(when delete-space
(delete-char -1))
(end-of-line))
(unless sig
(condition-case nil
(let ((fill-prefix (when quote (concat quote " ")))
(fill-column (eval fill-flowed-display-column))
adaptive-fill-mode)
(fill-region (point-at-bol)
(min (1+ (point-at-eol))
(point-max))
'left 'nosqueeze))
(error
(forward-line 1)
nil))))))))
(let ((fill-column (eval fill-flowed-display-column)))
(goto-char (point-min))
(while (not (eobp))
(cond
((and (looking-at "^>+")
(eq (char-before (line-end-position)) ?\s))
(let ((prefix (match-string 0)))
;; Insert a space character after the quote signs for more
;; pleasant reading of quoted lines.
(goto-char (match-end 0))
(unless (looking-at " ")
(insert " "))
(end-of-line)
(when (and (not (eobp))
(save-excursion
(forward-line 1)
(looking-at (format "\\(%s ?\\)[^>]" prefix))))
;; Delete the newline and the quote at the start of the
;; next line.
(delete-region (point) (match-end 1))
(ignore-errors
(let ((fill-prefix (concat prefix " "))
adaptive-fill-mode)
(fill-region (line-beginning-position)
(line-end-position)
'left 'nosqueeze))))))
(t
;; Delete the newline.
(when (eq (following-char) ?\s)
(delete-char 1))
;; Hack: Don't do the flowing on the signature line.
(when (and (not (looking-at "-- $"))
(eq (char-before (line-end-position)) ?\s))
(end-of-line)
(when delete-space
(delete-char -1))
(delete-char 1)
(ignore-errors
(let ((fill-prefix ""))
(fill-region (line-beginning-position)
(line-end-position)
'left 'nosqueeze))))))
(forward-line 1)))))
(make-obsolete-variable 'fill-flowed-encode-tests nil "27.1")
(defvar fill-flowed-encode-tests)

View file

@ -24,7 +24,7 @@
(require 'ert)
(require 'flow-fill)
(ert-deftest fill-flow-tests-fill-flowed-encode ()
(ert-deftest fill-flow-tests-fill-flowed-decode ()
(let ((input
(concat
"> Thou villainous ill-breeding spongy dizzy-eyed \n"
@ -53,6 +53,7 @@
(with-temp-buffer
(insert input)
(fill-flowed)
(message "foo")
(should (equal (buffer-string) output)))))
(ert-deftest fill-flow-tests-fill-flowed-encode ()
@ -88,5 +89,18 @@
(fill-flowed-encode)
(should (equal (buffer-string) output)))))
(ert-deftest fill-flow-tests-fill-flowed-stuffed ()
(let ((input
(concat
" > From space-stuffed with a \n"
"continuation.\n"))
(output
"> From space-stuffed with a continuation.\n")
(fill-flowed-display-column 69))
(with-temp-buffer
(insert input)
(fill-flowed)
(should (equal (buffer-string) output)))))
(provide 'flow-fill-tests)
;;; flow-fill-tests.el ends here