`org-fill-paragraph' is backed up by Org Element

* lisp/org.el (org-fill-paragraph): Rewrite function using
  `org-element-at-point'.
* lisp/org-element.el (org-element-fill-paragraph): Remove function.
* testing/lisp/test-org-element.el: Remove test.
* testing/lisp/test-org.el: Add test.
This commit is contained in:
Nicolas Goaziou 2012-07-28 10:24:08 +02:00
parent 07eaea26dd
commit b04f9e3268
4 changed files with 121 additions and 209 deletions

View File

@ -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

View File

@ -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."

View File

@ -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

View File

@ -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