From c2f4eec5dcd2f7490aaedb41f5f7df64e42a572a Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Mon, 22 May 2017 15:01:25 +0200 Subject: [PATCH] `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 --- etc/ORG-NEWS | 1 + lisp/org.el | 273 ++++++++++++++++++++++----------------- testing/lisp/test-org.el | 38 +++--- 3 files changed, 174 insertions(+), 138 deletions(-) diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS index 3ca5b0553..23e8a1db7 100644 --- a/etc/ORG-NEWS +++ b/etc/ORG-NEWS @@ -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) diff --git a/lisp/org.el b/lisp/org.el index 9117e3c9d..6a15e801c 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -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." diff --git a/testing/lisp/test-org.el b/testing/lisp/test-org.el index a2d177702..9ab14fa2d 100644 --- a/testing/lisp/test-org.el +++ b/testing/lisp/test-org.el @@ -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 ()