`org-fill-paragraph' handles region

* lisp/org.el (org-fill-element): New function.
(org-fill-paragraph): Use new function.  Also handle region, when
called interactively.

* testing/lisp/test-org.el (test-org/fill-element): Renamed from
  test-org/fill-paragraph.  Update tests.

Reported-by: Oskar Kvist <oskar.kvist@gmail.com>
<http://permalink.gmane.org/gmane.emacs.orgmode/113542>
This commit is contained in:
Nicolas Goaziou 2017-05-22 15:01:25 +02:00
parent 78a8078d64
commit c2f4eec5dc
3 changed files with 174 additions and 138 deletions

View File

@ -298,6 +298,7 @@ When a Dired buffer is opened next to the Org document being edited,
the prompt for file to attach can start in the Dired buffer's
directory if `dired-dwim-target' in non-nil.
*** ~org-fill-paragraph~ can now fill a whole region
*** More specific anniversary descriptions
Anniversary descriptions (used in the agenda view, for instance)

View File

@ -22999,7 +22999,8 @@ matches in paragraphs or comments, use it."
(declare-function message-goto-body "message" ())
(defvar message-cite-prefix-regexp) ; From message.el
(defun org-fill-paragraph (&optional justify)
(defun org-fill-element (&optional justify)
"Fill element at point, when applicable.
This function only applies to comment blocks, comments, example
@ -23014,126 +23015,160 @@ width for filling.
For convenience, when point is at a plain list, an item or
a footnote definition, try to fill the first paragraph within."
(interactive)
(if (and (derived-mode-p 'message-mode)
(or (not (message-in-body-p))
(save-excursion (move-beginning-of-line 1)
(looking-at message-cite-prefix-regexp))))
;; First ensure filling is correct in message-mode.
(let ((fill-paragraph-function
(cl-cadadr (assq 'fill-paragraph-function org-fb-vars)))
(fill-prefix (cl-cadadr (assq 'fill-prefix org-fb-vars)))
(paragraph-start (cl-cadadr (assq 'paragraph-start org-fb-vars)))
(paragraph-separate
(cl-cadadr (assq 'paragraph-separate org-fb-vars))))
(fill-paragraph nil))
(with-syntax-table org-mode-transpose-word-syntax-table
;; Move to end of line in order to get the first paragraph
;; within a plain list or a footnote definition.
(let ((element (save-excursion
(end-of-line)
(or (ignore-errors (org-element-at-point))
(user-error "An element cannot be parsed line %d"
(line-number-at-pos (point)))))))
;; First check if point is in a blank line at the beginning of
;; the buffer. In that case, ignore filling.
(cl-case (org-element-type element)
;; Use major mode filling function is src blocks.
(src-block (org-babel-do-key-sequence-in-edit-buffer (kbd "M-q")))
;; Align Org tables, leave table.el tables as-is.
(table-row (org-table-align) t)
(table
(when (eq (org-element-property :type element) 'org)
(with-syntax-table org-mode-transpose-word-syntax-table
;; Move to end of line in order to get the first paragraph within
;; a plain list or a footnote definition.
(let ((element (save-excursion (end-of-line) (org-element-at-point))))
;; First check if point is in a blank line at the beginning of
;; the buffer. In that case, ignore filling.
(cl-case (org-element-type element)
;; Use major mode filling function is src blocks.
(src-block (org-babel-do-key-sequence-in-edit-buffer (kbd "M-q")))
;; Align Org tables, leave table.el tables as-is.
(table-row (org-table-align) t)
(table
(when (eq (org-element-property :type element) 'org)
(save-excursion
(goto-char (org-element-property :post-affiliated element))
(org-table-align)))
t)
(paragraph
;; Paragraphs may contain `line-break' type objects.
(let ((beg (max (point-min)
(org-element-property :contents-begin element)))
(end (min (point-max)
(org-element-property :contents-end element))))
;; Do nothing if point is at an affiliated keyword.
(if (< (line-end-position) beg) t
(when (derived-mode-p 'message-mode)
;; In `message-mode', do not fill following citation
;; in current paragraph nor text before message body.
(let ((body-start (save-excursion (message-goto-body))))
(when body-start (setq beg (max body-start beg))))
(when (save-excursion
(re-search-forward
(concat "^" message-cite-prefix-regexp) end t))
(setq end (match-beginning 0))))
;; Fill paragraph, taking line breaks into account.
(save-excursion
(goto-char (org-element-property :post-affiliated element))
(org-table-align)))
t)
(paragraph
;; Paragraphs may contain `line-break' type objects.
(let ((beg (max (point-min)
(org-element-property :contents-begin element)))
(end (min (point-max)
(org-element-property :contents-end element))))
;; Do nothing if point is at an affiliated keyword.
(if (< (line-end-position) beg) t
(when (derived-mode-p 'message-mode)
;; In `message-mode', do not fill following citation
;; in current paragraph nor text before message body.
(let ((body-start (save-excursion (message-goto-body))))
(when body-start (setq beg (max body-start beg))))
(when (save-excursion
(re-search-forward
(concat "^" message-cite-prefix-regexp) end t))
(setq end (match-beginning 0))))
;; Fill paragraph, taking line breaks into account.
(save-excursion
(goto-char beg)
(let ((cuts (list beg)))
(while (re-search-forward "\\\\\\\\[ \t]*\n" end t)
(when (eq 'line-break
(org-element-type
(save-excursion (backward-char)
(org-element-context))))
(push (point) cuts)))
(dolist (c (delq end cuts))
(fill-region-as-paragraph c end justify)
(setq end c))))
t)))
;; Contents of `comment-block' type elements should be
;; filled as plain text, but only if point is within block
;; markers.
(comment-block
(let* ((case-fold-search t)
(beg (save-excursion
(goto-char (org-element-property :begin element))
(re-search-forward "^[ \t]*#\\+begin_comment" nil t)
(forward-line)
(point)))
(end (save-excursion
(goto-char (org-element-property :end element))
(re-search-backward "^[ \t]*#\\+end_comment" nil t)
(line-beginning-position))))
(if (or (< (point) beg) (> (point) end)) t
(fill-region-as-paragraph
(save-excursion (end-of-line)
(re-search-backward "^[ \t]*$" beg 'move)
(line-beginning-position))
(save-excursion (beginning-of-line)
(re-search-forward "^[ \t]*$" end 'move)
(line-beginning-position))
justify))))
;; Fill comments.
(comment
(let ((begin (org-element-property :post-affiliated element))
(end (org-element-property :end element)))
(when (and (>= (point) begin) (<= (point) end))
(let ((begin (save-excursion
(end-of-line)
(if (re-search-backward "^[ \t]*#[ \t]*$" begin t)
(progn (forward-line) (point))
begin)))
(end (save-excursion
(goto-char beg)
(let ((cuts (list beg)))
(while (re-search-forward "\\\\\\\\[ \t]*\n" end t)
(when (eq 'line-break
(org-element-type
(save-excursion (backward-char)
(org-element-context))))
(push (point) cuts)))
(dolist (c (delq end cuts))
(fill-region-as-paragraph c end justify)
(setq end c))))
t)))
;; Contents of `comment-block' type elements should be
;; filled as plain text, but only if point is within block
;; markers.
(comment-block
(let* ((case-fold-search t)
(beg (save-excursion
(goto-char (org-element-property :begin element))
(re-search-forward "^[ \t]*#\\+begin_comment" nil t)
(forward-line)
(point)))
(end (save-excursion
(goto-char (org-element-property :end element))
(re-search-backward "^[ \t]*#\\+end_comment" nil t)
(line-beginning-position))))
(if (or (< (point) beg) (> (point) end)) t
(fill-region-as-paragraph
(save-excursion (end-of-line)
(re-search-backward "^[ \t]*$" beg 'move)
(line-beginning-position))
(save-excursion (beginning-of-line)
(re-search-forward "^[ \t]*$" end 'move)
(line-beginning-position))
justify))))
;; Fill comments.
(comment
(let ((begin (org-element-property :post-affiliated element))
(end (org-element-property :end element)))
(when (and (>= (point) begin) (<= (point) end))
(let ((begin (save-excursion
(end-of-line)
(if (re-search-forward "^[ \t]*#[ \t]*$" end 'move)
(1- (line-beginning-position))
(skip-chars-backward " \r\t\n")
(line-end-position)))))
;; Do not fill comments when at a blank line.
(when (> end begin)
(let ((fill-prefix
(save-excursion
(beginning-of-line)
(looking-at "[ \t]*#")
(let ((comment-prefix (match-string 0)))
(goto-char (match-end 0))
(if (looking-at adaptive-fill-regexp)
(concat comment-prefix (match-string 0))
(concat comment-prefix " "))))))
(save-excursion
(fill-region-as-paragraph begin end justify))))))
t))
;; Ignore every other element.
(otherwise t))))))
(if (re-search-backward "^[ \t]*#[ \t]*$" begin t)
(progn (forward-line) (point))
begin)))
(end (save-excursion
(end-of-line)
(if (re-search-forward "^[ \t]*#[ \t]*$" end 'move)
(1- (line-beginning-position))
(skip-chars-backward " \r\t\n")
(line-end-position)))))
;; Do not fill comments when at a blank line.
(when (> end begin)
(let ((fill-prefix
(save-excursion
(beginning-of-line)
(looking-at "[ \t]*#")
(let ((comment-prefix (match-string 0)))
(goto-char (match-end 0))
(if (looking-at adaptive-fill-regexp)
(concat comment-prefix (match-string 0))
(concat comment-prefix " "))))))
(save-excursion
(fill-region-as-paragraph begin end justify))))))
t))
;; Ignore every other element.
(otherwise t)))))
(defun org-fill-paragraph (&optional justify region)
"Fill element at point, when applicable.
This function only applies to comment blocks, comments, example
blocks and paragraphs. Also, as a special case, re-align table
when point is at one.
For convenience, when point is at a plain list, an item or
a footnote definition, try to fill the first paragraph within.
If JUSTIFY is non-nil (interactively, with prefix argument),
justify as well. If `sentence-end-double-space' is non-nil, then
period followed by one space does not end a sentence, so don't
break a line there. The variable `fill-column' controls the
width for filling.
The REGION argument is non-nil if called interactively; in that
case, if Transient Mark mode is enabled and the mark is active,
fill each of the elements in the active region, instead of just
filling the current element."
(interactive (progn
(barf-if-buffer-read-only)
(list (if current-prefix-arg 'full) t)))
(cond
((and (derived-mode-p 'message-mode)
(or (not (message-in-body-p))
(save-excursion (move-beginning-of-line 1)
(looking-at message-cite-prefix-regexp))))
;; First ensure filling is correct in message-mode.
(let ((fill-paragraph-function
(cl-cadadr (assq 'fill-paragraph-function org-fb-vars)))
(fill-prefix (cl-cadadr (assq 'fill-prefix org-fb-vars)))
(paragraph-start (cl-cadadr (assq 'paragraph-start org-fb-vars)))
(paragraph-separate
(cl-cadadr (assq 'paragraph-separate org-fb-vars))))
(fill-paragraph nil)))
((and region transient-mark-mode mark-active
(not (eq (region-beginning) (region-end))))
(let ((origin (point-marker))
(start (region-beginning)))
(unwind-protect
(progn
(goto-char (region-end))
(while (> (point) start)
(org-backward-paragraph)
(org-fill-element justify)))
(goto-char origin)
(set-marker origin nil))))
(t (org-fill-element justify))))
(org-remap org-mode-map 'fill-paragraph 'org-fill-paragraph)
(defun org-auto-fill-function ()
"Auto-fill function."

View File

@ -456,23 +456,23 @@
;;; Filling
(ert-deftest test-org/fill-paragraph ()
"Test `org-fill-paragraph' specifications."
(ert-deftest test-org/fill-element ()
"Test `org-fill-element' specifications."
;; At an Org table, align it.
(should
(equal "| a |\n"
(org-test-with-temp-text "|a|"
(org-fill-paragraph)
(org-fill-element)
(buffer-string))))
(should
(equal "#+name: table\n| a |\n"
(org-test-with-temp-text "#+name: table\n| a |\n"
(org-fill-paragraph)
(org-fill-element)
(buffer-string))))
;; At a paragraph, preserve line breaks.
(org-test-with-temp-text "some \\\\\nlong\ntext"
(let ((fill-column 20))
(org-fill-paragraph)
(org-fill-element)
(should (equal (buffer-string) "some \\\\\nlong text"))))
;; Correctly fill a paragraph when point is at its very end.
(should
@ -480,7 +480,7 @@
(org-test-with-temp-text "A\nB"
(let ((fill-column 20))
(goto-char (point-max))
(org-fill-paragraph)
(org-fill-element)
(buffer-string)))))
;; Correctly fill the last paragraph of a greater element.
(should
@ -489,7 +489,7 @@
(let ((fill-column 8))
(forward-line)
(end-of-line)
(org-fill-paragraph)
(org-fill-element)
(buffer-string)))))
;; Correctly fill an element in a narrowed buffer.
(should
@ -497,7 +497,7 @@
(org-test-with-temp-text "01234 6789"
(let ((fill-column 5))
(narrow-to-region 1 8)
(org-fill-paragraph)
(org-fill-element)
(buffer-string)))))
;; Handle `adaptive-fill-regexp' in paragraphs.
(should
@ -505,7 +505,7 @@
(org-test-with-temp-text "> a\n> b"
(let ((fill-column 5)
(adaptive-fill-regexp "[ \t]*>+[ \t]*"))
(org-fill-paragraph)
(org-fill-element)
(buffer-string)))))
;; Special case: Fill first paragraph when point is at an item or
;; a plain-list or a footnote reference.
@ -513,17 +513,17 @@
(equal "- A B"
(org-test-with-temp-text "- A\n B"
(let ((fill-column 20))
(org-fill-paragraph)
(org-fill-element)
(buffer-string)))))
(should
(equal "[fn:1] A B"
(org-test-with-temp-text "[fn:1] A\nB"
(let ((fill-column 20))
(org-fill-paragraph)
(org-fill-element)
(buffer-string)))))
(org-test-with-temp-text "#+BEGIN_VERSE\nSome \\\\\nlong\ntext\n#+END_VERSE"
(let ((fill-column 20))
(org-fill-paragraph)
(org-fill-element)
(should (equal (buffer-string)
"#+BEGIN_VERSE\nSome \\\\\nlong\ntext\n#+END_VERSE"))))
;; Fill contents of `comment-block' elements.
@ -532,7 +532,7 @@
(org-test-with-temp-text "#+BEGIN_COMMENT\nSome\ntext\n#+END_COMMENT"
(let ((fill-column 20))
(forward-line)
(org-fill-paragraph)
(org-fill-element)
(buffer-string)))
"#+BEGIN_COMMENT\nSome text\n#+END_COMMENT"))
;; Fill `comment' elements.
@ -540,21 +540,21 @@
(equal " # A B"
(org-test-with-temp-text " # A\n # B"
(let ((fill-column 20))
(org-fill-paragraph)
(org-fill-element)
(buffer-string)))))
;; Do not mix consecutive comments when filling one of them.
(should
(equal "# A B\n\n# C"
(org-test-with-temp-text "# A\n# B\n\n# C"
(let ((fill-column 20))
(org-fill-paragraph)
(org-fill-element)
(buffer-string)))))
;; Use commented empty lines as separators when filling comments.
(should
(equal "# A B\n#\n# C"
(org-test-with-temp-text "# A\n# B\n#\n# C"
(let ((fill-column 20))
(org-fill-paragraph)
(org-fill-element)
(buffer-string)))))
;; Handle `adaptive-fill-regexp' in comments.
(should
@ -562,18 +562,18 @@
(org-test-with-temp-text "# > a\n# > b"
(let ((fill-column 20)
(adaptive-fill-regexp "[ \t]*>+[ \t]*"))
(org-fill-paragraph)
(org-fill-element)
(buffer-string)))))
;; Do nothing at affiliated keywords.
(org-test-with-temp-text "#+NAME: para\nSome\ntext."
(let ((fill-column 20))
(org-fill-paragraph)
(org-fill-element)
(should (equal (buffer-string) "#+NAME: para\nSome\ntext."))))
;; Do not move point after table when filling a table.
(should-not
(org-test-with-temp-text "| a | b |\n| c | d |\n"
(forward-char)
(org-fill-paragraph)
(org-fill-element)
(eobp))))
(ert-deftest test-org/auto-fill-function ()