Browse Source

New functions for paragraph-like navigation

* lisp/org.el (org-forward-paragraph, org-backward-paragraph): New
  functions.
* testing/lisp/test-org.el: Add tests.
Nicolas Goaziou 12 years ago
parent
commit
43733e33b1
2 changed files with 295 additions and 2 deletions
  1. 146 2
      lisp/org.el
  2. 149 0
      testing/lisp/test-org.el

+ 146 - 2
lisp/org.el

@@ -19102,8 +19102,8 @@ BEG and END default to the buffer boundaries."
 (org-defkey org-mode-map "\C-c\C-k" 'org-kill-note-or-show-branches)
 (org-defkey org-mode-map "\C-c\C-k" 'org-kill-note-or-show-branches)
 (org-defkey org-mode-map "\C-c#"    'org-update-statistics-cookies)
 (org-defkey org-mode-map "\C-c#"    'org-update-statistics-cookies)
 (org-defkey org-mode-map [remap open-line] 'org-open-line)
 (org-defkey org-mode-map [remap open-line] 'org-open-line)
-(org-defkey org-mode-map [remap forward-paragraph] 'org-forward-element)
-(org-defkey org-mode-map [remap backward-paragraph] 'org-backward-element)
+(org-defkey org-mode-map [remap forward-paragraph] 'org-forward-paragraph)
+(org-defkey org-mode-map [remap backward-paragraph] 'org-backward-paragraph)
 (org-defkey org-mode-map "\C-m"     'org-return)
 (org-defkey org-mode-map "\C-m"     'org-return)
 (org-defkey org-mode-map "\C-j"     'org-return-indent)
 (org-defkey org-mode-map "\C-j"     'org-return-indent)
 (org-defkey org-mode-map "\C-c?"    'org-table-field-info)
 (org-defkey org-mode-map "\C-c?"    'org-table-field-info)
@@ -23287,6 +23287,150 @@ When BLOCK-REGEXP is non-nil, use this regexp to find blocks."
   (interactive "p")
   (interactive "p")
   (org-next-block arg t block-regexp))
   (org-next-block arg t block-regexp))
 
 
+(defun org-forward-paragraph ()
+  "Move forward to beginning of next paragraph or equivalent.
+
+The function moves point to the beginning of the next visible
+structural element, which can be a paragraph, a table, a list
+item, etc.  It also provides some special moves for convenience:
+
+  - On an affiliated keyword, jump to the beginning of the
+    relative element.
+  - On an item or a footnote definition, move to the second
+    element inside, if any.
+  - On a table or a property drawer, jump after it.
+  - On a verse or source block, stop after blank lines."
+  (interactive)
+  (when (eobp) (user-error "Cannot move further down"))
+  (let* ((element (org-element-at-point))
+         (type (org-element-type element))
+         (post-affiliated (org-element-property :post-affiliated element))
+         (contents-begin (org-element-property :contents-begin element))
+         (contents-end (org-element-property :contents-end element))
+         (end (let ((end (org-element-property :end element)) (parent element))
+                (while (and (setq parent (org-element-property :parent parent))
+                            (= (org-element-property :contents-end parent) end))
+                  (setq end (org-element-property :end parent)))
+                end)))
+    (cond ((not element)
+           (skip-chars-forward " \r\t\n")
+           (or (eobp) (beginning-of-line)))
+          ;; On affiliated keywords, move to element's beginning.
+          ((and post-affiliated (< (point) post-affiliated))
+           (goto-char post-affiliated))
+          ;; At a table row, move to the end of the table.  Similarly,
+          ;; at a node property, move to the end of the property
+          ;; drawer.
+          ((memq type '(node-property table-row))
+           (goto-char (org-element-property
+                       :end (org-element-property :parent element))))
+          ((memq type '(property-drawer table)) (goto-char end))
+          ;; Consider blank lines as separators in verse and source
+          ;; blocks to ease editing.
+          ((memq type '(src-block verse-block))
+           (when (eq type 'src-block)
+             (setq contents-end
+                   (save-excursion (goto-char end)
+                                   (skip-chars-backward " \r\t\n")
+                                   (line-beginning-position))))
+           (beginning-of-line)
+           (when (looking-at "[ \t]*$") (skip-chars-forward " \r\t\n"))
+           (if (not (re-search-forward "^[ \t]*$" contents-end t))
+               (goto-char end)
+             (skip-chars-forward " \r\t\n")
+             (if (= (point) contents-end) (goto-char end)
+               (beginning-of-line))))
+          ;; With no contents, just skip element.
+          ((not contents-begin) (goto-char end))
+          ;; If contents are invisible, skip the element altogether.
+          ((outline-invisible-p (line-end-position))
+           (case type
+             (headline
+              (org-with-limited-levels (outline-next-visible-heading 1)))
+             ;; At a plain list, make sure we move to the next item
+             ;; instead of skipping the whole list.
+             (plain-list (forward-char)
+                         (org-forward-paragraph))
+             (otherwise (goto-char end))))
+          ((>= (point) contents-end) (goto-char end))
+          ((>= (point) contents-begin)
+           ;; This can only happen on paragraphs and plain lists.
+           (case type
+             (paragraph (goto-char end))
+             ;; At a plain list, try to move to second element in
+             ;; first item, if possible.
+             (plain-list (end-of-line)
+                         (org-forward-paragraph))))
+          ;; When contents start on the middle of a line (e.g. in
+          ;; items and footnote definitions), try to reach first
+          ;; element starting after current line.
+          ((> (line-end-position) contents-begin)
+           (end-of-line)
+           (org-forward-paragraph))
+          (t (goto-char contents-begin)))))
+
+(defun org-backward-paragraph ()
+  "Move backward to start of previous paragraph or equivalent.
+
+The function moves point to the beginning of the current
+structural element, which can be a paragraph, a table, a list
+item, etc., or to the beginning of the previous visible one if
+point is already there.  It also provides some special moves for
+convenience:
+
+  - On an affiliated keyword, jump to the first one.
+  - On a table or a property drawer, move to its beginning.
+  - On a verse or source block, stop before blank lines."
+  (interactive)
+  (when (bobp) (user-error "Cannot move further up"))
+  (let* ((element (org-element-at-point))
+         (type (org-element-type element))
+         (contents-begin (org-element-property :contents-begin element))
+         (contents-end (org-element-property :contents-end element))
+         (post-affiliated (org-element-property :post-affiliated element))
+         (begin (org-element-property :begin element)))
+    (cond
+     ((not element) (goto-char (point-min)))
+     ((= (point) begin)
+      (backward-char)
+      (org-backward-paragraph))
+     ((and post-affiliated (<= (point) post-affiliated)) (goto-char begin))
+     ((memq type '(node-property table-row))
+      (goto-char (org-element-property
+                  :post-affiliated (org-element-property :parent element))))
+     ((memq type '(property-drawer table)) (goto-char begin))
+     ((memq type '(src-block verse-block))
+      (when (eq type 'src-block)
+        (setq contents-begin
+              (save-excursion (goto-char begin) (forward-line) (point))))
+      (if (= (point) contents-begin) (goto-char post-affiliated)
+        ;; Inside a verse block, see blank lines as paragraph
+        ;; separators.
+        (let ((origin (point)))
+          (skip-chars-backward " \r\t\n" contents-begin)
+          (when (re-search-backward "^[ \t]*$" contents-begin 'move)
+            (skip-chars-forward " \r\t\n" origin)
+            (if (= (point) origin) (goto-char contents-begin)
+              (beginning-of-line))))))
+     ((not contents-begin) (goto-char (or post-affiliated begin)))
+     ((eq type 'paragraph)
+      (goto-char contents-begin)
+      ;; When at first paragraph in an item or a footnote definition,
+      ;; move directly to beginning of line.
+      (let ((parent-contents
+             (org-element-property
+              :contents-begin (org-element-property :parent element))))
+        (when (and parent-contents (= parent-contents contents-begin))
+          (beginning-of-line))))
+     ;; At the end of a greater element, move to the beginning of the
+     ;; last element within.
+     ((>= (point) contents-end)
+      (goto-char (1- contents-end))
+      (org-backward-paragraph))
+     (t (goto-char (or post-affiliated begin))))
+    ;; Ensure we never leave point invisible.
+    (when (outline-invisible-p (point)) (beginning-of-visual-line))))
+
 (defun org-forward-element ()
 (defun org-forward-element ()
   "Move forward by one element.
   "Move forward by one element.
 Move to the next element at the same level, when possible."
 Move to the next element at the same level, when possible."

+ 149 - 0
testing/lisp/test-org.el

@@ -651,6 +651,155 @@ http://article.gmane.org/gmane.emacs.orgmode/21459/"
        (org-end-of-line)
        (org-end-of-line)
        (eobp)))))
        (eobp)))))
 
 
+(ert-deftest test-org/forward-paragraph ()
+  "Test `org-forward-paragraph' specifications."
+  ;; At end of buffer, return an error.
+  (should-error
+   (org-test-with-temp-text "Paragraph"
+     (goto-char (point-max))
+     (org-forward-paragraph)))
+  ;; Standard test.
+  (should
+   (org-test-with-temp-text "P1\n\nP2\n\nP3"
+     (org-forward-paragraph)
+     (looking-at "P2")))
+  ;; Ignore depth.
+  (should
+   (org-test-with-temp-text "#+BEGIN_CENTER\nP1\n#+END_CENTER\nP2"
+     (org-forward-paragraph)
+     (looking-at "P1")))
+  ;; Do not enter elements with invisible contents.
+  (should
+   (org-test-with-temp-text "#+BEGIN_CENTER\nP1\n\nP2\n#+END_CENTER\nP3"
+     (org-hide-block-toggle)
+     (org-forward-paragraph)
+     (looking-at "P3")))
+  ;; On an affiliated keyword, jump to the beginning of the element.
+  (should
+   (org-test-with-temp-text "#+name: para\n#+caption: caption\nPara"
+     (org-forward-paragraph)
+     (looking-at "Para")))
+  ;; On an item or a footnote definition, move to the second element
+  ;; inside, if any.
+  (should
+   (org-test-with-temp-text "- Item1\n\n  Paragraph\n- Item2"
+     (org-forward-paragraph)
+     (looking-at "  Paragraph")))
+  (should
+   (org-test-with-temp-text "[fn:1] Def1\n\nParagraph\n\n[fn:2] Def2"
+     (org-forward-paragraph)
+     (looking-at "Paragraph")))
+  ;; On an item, or a footnote definition, when the first line is
+  ;; empty, move to the first item.
+  (should
+   (org-test-with-temp-text "- \n\n  Paragraph\n- Item2"
+     (org-forward-paragraph)
+     (looking-at "  Paragraph")))
+  (should
+   (org-test-with-temp-text "[fn:1]\n\nParagraph\n\n[fn:2] Def2"
+     (org-forward-paragraph)
+     (looking-at "Paragraph")))
+  ;; On a table (resp. a property drawer) do not move through table
+  ;; rows (resp. node properties).
+  (should
+   (org-test-with-temp-text "| a | b |\n| c | d |\nParagraph"
+     (org-forward-paragraph)
+     (looking-at "Paragraph")))
+  (should
+   (org-test-with-temp-text ":PROPERTIES:\n:prop: value\n:END:\nParagraph"
+     (org-forward-paragraph)
+     (looking-at "Paragraph")))
+  ;; On a verse or source block, stop after blank lines.
+  (should
+   (org-test-with-temp-text "#+BEGIN_VERSE\nL1\n\nL2\n#+END_VERSE"
+     (org-forward-paragraph)
+     (looking-at "L2")))
+  (should
+   (org-test-with-temp-text "#+BEGIN_SRC\nL1\n\nL2\n#+END_SRC"
+     (org-forward-paragraph)
+     (looking-at "L2"))))
+
+(ert-deftest test-org/backward-paragraph ()
+  "Test `org-backward-paragraph' specifications."
+  ;; Error at beginning of buffer.
+  (should-error
+   (org-test-with-temp-text "Paragraph"
+     (org-backward-paragraph)))
+  ;; Regular test.
+  (should
+   (org-test-with-temp-text "P1\n\nP2\n\nP3"
+     (goto-char (point-max))
+     (org-backward-paragraph)
+     (looking-at "P3")))
+  (should
+   (org-test-with-temp-text "P1\n\nP2\n\nP3"
+     (goto-char (point-max))
+     (beginning-of-line)
+     (org-backward-paragraph)
+     (looking-at "P2")))
+  ;; Ignore depth.
+  (should
+   (org-test-with-temp-text "P1\n\n#+BEGIN_CENTER\nP2\n#+END_CENTER\nP3"
+     (goto-char (point-max))
+     (beginning-of-line)
+     (org-backward-paragraph)
+     (looking-at "P2")))
+  ;; Ignore invisible elements.
+  (should
+   (org-test-with-temp-text "* H1\n  P1\n* H2"
+     (org-cycle)
+     (goto-char (point-max))
+     (beginning-of-line)
+     (org-backward-paragraph)
+     (bobp)))
+  ;; On an affiliated keyword, jump to the first one.
+  (should
+   (org-test-with-temp-text "P1\n#+name: n\n#+caption: c1\n#+caption: c2\nP2"
+     (search-forward "c2")
+     (org-backward-paragraph)
+     (looking-at "#\\+name")))
+  ;; On the second element in an item or a footnote definition, jump
+  ;; to item or the definition.
+  (should
+   (org-test-with-temp-text "- line1\n\n  line2"
+     (goto-char (point-max))
+     (beginning-of-line)
+     (org-backward-paragraph)
+     (looking-at "- line1")))
+  (should
+   (org-test-with-temp-text "[fn:1] line1\n\n  line2"
+     (goto-char (point-max))
+     (beginning-of-line)
+     (org-backward-paragraph)
+     (looking-at "\\[fn:1\\] line1")))
+  ;; On a table (resp. a property drawer), ignore table rows
+  ;; (resp. node properties).
+  (should
+   (org-test-with-temp-text "| a | b |\n| c | d |\nP1"
+     (goto-char (point-max))
+     (beginning-of-line)
+     (org-backward-paragraph)
+     (bobp)))
+  (should
+   (org-test-with-temp-text ":PROPERTIES:\n:prop: value\n:END:\nP1"
+     (goto-char (point-max))
+     (beginning-of-line)
+     (org-backward-paragraph)
+     (bobp)))
+  ;; On a source or verse block, stop before blank lines.
+  (should
+   (org-test-with-temp-text "#+BEGIN_VERSE\nL1\n\nL2\n\nL3\n#+END_VERSE"
+     (search-forward "L3")
+     (beginning-of-line)
+     (org-backward-paragraph)
+     (looking-at "L2")))
+  (should
+   (org-test-with-temp-text "#+BEGIN_SRC\nL1\n\nL2\n\nL3#+END_SRC"
+     (search-forward "L3")
+     (beginning-of-line)
+     (org-backward-paragraph)
+     (looking-at "L2"))))
+
 (ert-deftest test-org/forward-element ()
 (ert-deftest test-org/forward-element ()
   "Test `org-forward-element' specifications."
   "Test `org-forward-element' specifications."
   ;; 1. At EOB: should error.
   ;; 1. At EOB: should error.