diff --git a/lisp/org-element.el b/lisp/org-element.el index 692577a6a..67b2c3b4b 100644 --- a/lisp/org-element.el +++ b/lisp/org-element.el @@ -4442,83 +4442,6 @@ modified." (reverse contents)))))) (funcall unindent-tree (org-element-contents parse-tree)))) -(defun org-element-fill-paragraph (&optional justify) - "Fill element at point, when applicable. - -This function only applies to paragraph, comment blocks, example -blocks and fixed-width areas. Also, as a special case, re-align -table when point is at one. - -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." - (let ((element (org-element-at-point))) - (case (org-element-type element) - ;; Align Org tables, leave table.el tables as-is. - (table-row (org-table-align) t) - (table - (when (eq (org-element-property :type element) 'org) (org-table-align)) - t) - ;; Elements that may contain `line-break' type objects. - ((paragraph verse-block) - (let ((beg (org-element-property :contents-begin element)) - (end (org-element-property :contents-end element))) - ;; Do nothing if point is at an affiliated keyword or at - ;; verse block markers. - (if (or (< (point) beg) (>= (point) end)) t - ;; At a verse block, first narrow to current "paragraph" - ;; and set current element to that paragraph. - (save-restriction - (when (eq (org-element-type element) 'verse-block) - (narrow-to-region beg end) - (save-excursion - (end-of-line) - (let ((bol-pos (point-at-bol))) - (re-search-backward org-element-paragraph-separate nil 'move) - (unless (or (bobp) (= (point-at-bol) bol-pos)) - (forward-line)) - (setq element (org-element-paragraph-parser end) - beg (org-element-property :contents-begin element) - end (org-element-property :contents-end element))))) - ;; Fill paragraph, taking line breaks into consideration. - ;; For that, slice the paragraph using line breaks as - ;; separators, and fill the parts in reverse order to - ;; avoid messing with markers. - (save-excursion - (goto-char end) - (mapc - (lambda (pos) - (fill-region-as-paragraph pos (point) justify) - (goto-char pos)) - ;; Find the list of ending positions for line breaks - ;; in the current paragraph. Add paragraph beginning - ;; to include first slice. - (nreverse - (cons beg - (org-element-map - (org-element--parse-objects - beg end nil org-element-all-objects) - 'line-break - (lambda (lb) (org-element-property :end lb)))))))) t))) - ;; Elements whose contents should be filled as plain text. - ((comment-block example-block) - (save-restriction - (narrow-to-region - (save-excursion - (goto-char (org-element-property :begin element)) - (while (looking-at org-element--affiliated-re) (forward-line)) - (forward-line) - (point)) - (save-excursion - (goto-char (org-element-property :end element)) - (if (bolp) (forward-line -1) (beginning-of-line)) - (point))) - (fill-paragraph justify) t)) - ;; Ignore every other element. - (otherwise t)))) - (provide 'org-element) ;;; org-element.el ends here diff --git a/lisp/org.el b/lisp/org.el index 82c4ee8d6..9e48ac58e 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -20803,93 +20803,82 @@ the functionality can be provided as a fall-back.") (looking-at "\\\\\\\\\\($\\|[^\\\\]\\)"))) (defun org-fill-paragraph (&optional justify) - "Re-align a table, pass through to fill-paragraph if no table." - (let ((table-p (org-at-table-p)) - (table.el-p (org-at-table.el-p)) - (itemp (org-in-item-p)) - (srcp (org-in-src-block-p))) - (cond ((and (equal (char-after (point-at-bol)) ?*) - (save-excursion (goto-char (point-at-bol)) - (looking-at org-outline-regexp))) - t) ; skip headlines - (table.el-p t) ; skip table.el tables - (table-p (org-table-align) t) ; align Org tables - (srcp ; indent entire src block to prevent - (save-excursion ; fill-paragraph-as-region to mess up - (org-babel-do-in-edit-buffer - (indent-region (point-min) (point-max))))) - (itemp ; align text in items - (let* ((struct (save-excursion (goto-char itemp) - (org-list-struct))) - (parents (org-list-parents-alist struct)) - (children (org-list-get-children itemp struct parents)) - beg end prev next prefix) - ;; Determine in which part of item point is: before - ;; first child, after last child, between two - ;; sub-lists, or simply in item if there's no child. - (cond - ((not children) - (setq prefix (make-string (org-list-item-body-column itemp) ?\ ) - beg itemp - end (org-list-get-item-end itemp struct))) - ((< (point) (setq next (car children))) - (setq prefix (make-string (org-list-item-body-column itemp) ?\ ) - beg itemp - end next)) - ((> (point) (setq prev (car (last children)))) - (setq beg (org-list-get-item-end prev struct) - end (org-list-get-item-end itemp struct) - prefix (save-excursion - (goto-char beg) - (skip-chars-forward " \t") - (make-string (current-column) ?\ )))) - (t (catch 'exit - (while (setq next (pop children)) - (if (> (point) next) - (setq prev next) - (setq beg (org-list-get-item-end prev struct) - end next - prefix (save-excursion - (goto-char beg) - (skip-chars-forward " \t") - (make-string (current-column) ?\ ))) - (throw 'exit nil)))))) - ;; Use `fill-paragraph' with buffer narrowed to item - ;; without any child, and with our computed PREFIX. - (org-flet ((fill-context-prefix (from to &optional flr) prefix)) - (save-restriction - (narrow-to-region beg end) - (save-excursion (fill-paragraph justify)))) t)) - ;; Special case where point is not in a list but is on - ;; a paragraph adjacent to a list: make sure this paragraph - ;; doesn't get merged with the end of the list by narrowing - ;; buffer first. - ((and (derived-mode-p 'org-mode) - (save-excursion (forward-paragraph -1) - (setq itemp (org-in-item-p)))) - (let ((struct (save-excursion (goto-char itemp) - (org-list-struct)))) - (save-restriction - (narrow-to-region (org-list-get-bottom-point struct) - (save-excursion (forward-paragraph 1) - (point))) - (fill-paragraph justify) t))) - ;; Don't fill schedule/deadline line before a paragraph - ;; This only makes sense in real org-mode buffers - ((and (eq major-mode 'org-mode) - (save-excursion (forward-paragraph -1) - (or (looking-at (concat "^[^\n]*" org-scheduled-regexp ".*$")) - (looking-at (concat "^[^\n]*" org-deadline-regexp ".*$"))))) - (save-restriction - (narrow-to-region (1+ (match-end 0)) - (save-excursion (forward-paragraph 1) (point))) - (fill-paragraph justify) t)) - ;; Else fall back on fill-paragraph-function as possibly - ;; defined in `org-fb-vars' - (orgstruct-is-++ - (org-let org-fb-vars - '(fill-paragraph justify))) - (t nil)))) + "Fill element at point, when applicable. + +This function only applies to paragraph, comment blocks, example +blocks and fixed-width areas. Also, as a special case, re-align +table when point is at one. + +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." + (let ((element (org-element-at-point))) + (case (org-element-type element) + ;; Align Org tables, leave table.el tables as-is. + (table-row (org-table-align) t) + (table + (when (eq (org-element-property :type element) 'org) (org-table-align)) + t) + ;; Elements that may contain `line-break' type objects. + ((paragraph verse-block) + (let ((beg (org-element-property :contents-begin element)) + (end (org-element-property :contents-end element))) + ;; Do nothing if point is at an affiliated keyword or at + ;; verse block markers. + (if (or (< (point) beg) (>= (point) end)) t + ;; At a verse block, first narrow to current "paragraph" + ;; and set current element to that paragraph. + (save-restriction + (when (eq (org-element-type element) 'verse-block) + (narrow-to-region beg end) + (save-excursion + (end-of-line) + (let ((bol-pos (point-at-bol))) + (re-search-backward org-element-paragraph-separate nil 'move) + (unless (or (bobp) (= (point-at-bol) bol-pos)) + (forward-line)) + (setq element (org-element-paragraph-parser end) + beg (org-element-property :contents-begin element) + end (org-element-property :contents-end element))))) + ;; Fill paragraph, taking line breaks into consideration. + ;; For that, slice the paragraph using line breaks as + ;; separators, and fill the parts in reverse order to + ;; avoid messing with markers. + (save-excursion + (goto-char end) + (mapc + (lambda (pos) + (fill-region-as-paragraph pos (point) justify) + (goto-char pos)) + ;; Find the list of ending positions for line breaks + ;; in the current paragraph. Add paragraph beginning + ;; to include first slice. + (nreverse + (cons beg + (org-element-map + (org-element--parse-objects + beg end nil org-element-all-objects) + 'line-break + (lambda (lb) (org-element-property :end lb)))))))) t))) + ;; Contents of `comment-block' type elements should be filled as + ;; plain text. + (comment-block + (save-excursion + (fill-region-as-paragraph + (save-excursion + (goto-char (org-element-property :begin element)) + (while (looking-at org-element--affiliated-re) (forward-line)) + (forward-line) + (point)) + (save-excursion + (goto-char (org-element-property :end element)) + (if (bolp) (forward-line -1) (beginning-of-line)) + (point)) + justify)) t) + ;; Ignore every other element. + (otherwise t)))) (defun org-adaptive-fill-function () "Return a fill prefix for org-mode files." diff --git a/testing/lisp/test-org-element.el b/testing/lisp/test-org-element.el index 37daa6ed9..f4f0eb26e 100644 --- a/testing/lisp/test-org-element.el +++ b/testing/lisp/test-org-element.el @@ -2549,50 +2549,6 @@ Text. (mapcar (lambda (ov) (cons (overlay-start ov) (overlay-end ov))) (overlays-in (point-min) (point-max))))))) -(ert-deftest test-org-element/fill-paragraph () - "Test `org-element-fill-paragraph' specifications." - ;; At an Org table, align it. - (org-test-with-temp-text "|a|" - (org-element-fill-paragraph) - (should (equal (buffer-string) "| a |\n"))) - ;; At a paragraph, preserve line breaks. - (org-test-with-temp-text "some \\\\\nlong\ntext" - (let ((fill-column 20)) - (org-element-fill-paragraph) - (should (equal (buffer-string) "some \\\\\nlong text")))) - ;; At a verse block, fill paragraph at point, also preserving line - ;; breaks. Though, do nothing when point is at the block - ;; boundaries. - (org-test-with-temp-text "#+BEGIN_VERSE\nSome \\\\\nlong\ntext\n#+END_VERSE" - (forward-line) - (let ((fill-column 20)) - (org-element-fill-paragraph) - (should (equal (buffer-string) - "#+BEGIN_VERSE\nSome \\\\\nlong text\n#+END_VERSE")))) - (org-test-with-temp-text "#+BEGIN_VERSE\nSome \\\\\nlong\ntext\n#+END_VERSE" - (let ((fill-column 20)) - (org-element-fill-paragraph) - (should (equal (buffer-string) - "#+BEGIN_VERSE\nSome \\\\\nlong\ntext\n#+END_VERSE")))) - ;; Fill contents of `comment-block' and `example-block' elements. - (org-test-with-temp-text "#+BEGIN_COMMENT\nSome\ntext\n#+END_COMMENT" - (let ((fill-column 20)) - (forward-line) - (org-element-fill-paragraph) - (should (equal (buffer-string) - "#+BEGIN_COMMENT\nSome text\n#+END_COMMENT")))) - (org-test-with-temp-text "#+BEGIN_EXAMPLE\nSome\ntext\n#+END_EXAMPLE" - (let ((fill-column 20)) - (forward-line) - (org-element-fill-paragraph) - (should (equal (buffer-string) - "#+BEGIN_EXAMPLE\nSome text\n#+END_EXAMPLE")))) - ;; Do nothing at affiliated keywords. - (org-test-with-temp-text "#+NAME: para\nSome\ntext." - (let ((fill-column 20)) - (org-element-fill-paragraph) - (should (equal (buffer-string) "#+NAME: para\nSome\ntext."))))) - (provide 'test-org-element) ;;; test-org-element.el ends here diff --git a/testing/lisp/test-org.el b/testing/lisp/test-org.el index 5edc40178..1f120d982 100644 --- a/testing/lisp/test-org.el +++ b/testing/lisp/test-org.el @@ -98,7 +98,7 @@ http://article.gmane.org/gmane.emacs.orgmode/21459/" ;; a target keyword (aka an invisible target: #+TARGET: text), to ;; a named element (#+name: text) and to headlines (* Text). -(ert-deftest test-org-export/fuzzy-links () +(ert-deftest test-org/fuzzy-links () "Test fuzzy links specifications." ;; 1. Fuzzy link goes in priority to a matching target. (org-test-with-temp-text @@ -129,6 +129,50 @@ http://article.gmane.org/gmane.emacs.orgmode/21459/" (should (looking-at "\\* Test")))) + +;;; Filling + +(ert-deftest test-org/fill-paragraph () + "Test `org-fill-paragraph' specifications." + ;; At an Org table, align it. + (org-test-with-temp-text "|a|" + (org-fill-paragraph) + (should (equal (buffer-string) "| a |\n"))) + ;; At a paragraph, preserve line breaks. + (org-test-with-temp-text "some \\\\\nlong\ntext" + (let ((fill-column 20)) + (org-fill-paragraph) + (should (equal (buffer-string) "some \\\\\nlong text")))) + ;; At a verse block, fill paragraph at point, also preserving line + ;; breaks. Though, do nothing when point is at the block + ;; boundaries. + (org-test-with-temp-text "#+BEGIN_VERSE\nSome \\\\\nlong\ntext\n#+END_VERSE" + (forward-line) + (let ((fill-column 20)) + (org-fill-paragraph) + (should (equal (buffer-string) + "#+BEGIN_VERSE\nSome \\\\\nlong text\n#+END_VERSE")))) + (org-test-with-temp-text "#+BEGIN_VERSE\nSome \\\\\nlong\ntext\n#+END_VERSE" + (let ((fill-column 20)) + (org-fill-paragraph) + (should (equal (buffer-string) + "#+BEGIN_VERSE\nSome \\\\\nlong\ntext\n#+END_VERSE")))) + ;; Fill contents of `comment-block' elements. + (should + (equal + (org-test-with-temp-text "#+BEGIN_COMMENT\nSome\ntext\n#+END_COMMENT" + (let ((fill-column 20)) + (forward-line) + (org-fill-paragraph) + (buffer-string))) + "#+BEGIN_COMMENT\nSome text\n#+END_COMMENT")) + ;; Do nothing at affiliated keywords. + (org-test-with-temp-text "#+NAME: para\nSome\ntext." + (let ((fill-column 20)) + (org-fill-paragraph) + (should (equal (buffer-string) "#+NAME: para\nSome\ntext."))))) + + (provide 'test-org) ;;; test-org.el ends here