summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicolas Goaziou <mail@nicolasgoaziou.fr>2017-05-22 15:01:25 +0200
committerNicolas Goaziou <mail@nicolasgoaziou.fr>2017-05-22 15:02:34 +0200
commitc2f4eec5dcd2f7490aaedb41f5f7df64e42a572a (patch)
tree022b8e3473562a312106e7c625c8fbb07bb61c12
parent78a8078d648fa81e3b8d767ec47b0c9250917dda (diff)
downloadorg-mode-c2f4eec5dcd2f7490aaedb41f5f7df64e42a572a.tar.gz
`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>
-rw-r--r--etc/ORG-NEWS1
-rw-r--r--lisp/org.el273
-rw-r--r--testing/lisp/test-org.el38
3 files changed, 174 insertions, 138 deletions
diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS
index 3ca5b05..23e8a1d 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 9117e3c..6a15e80 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 a2d1777..9ab14fa 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 ()