From e7397fda3f09585082cc53cc90f1db9b543a87ad Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sat, 28 Jul 2012 23:21:38 +0200 Subject: [PATCH] org-element: Refactor code * lisp/org-element.el (org-element-center-block-parser, org-element-dynamic-block-parser, org-element-footnote-definition-parser, org-element-headline-parser, org-element-inlinetask-parser, org-element-quote-block-parser, org-element-special-block-parser, org-element-plain-list-parser): Refactor code. (org-element-drawer-parser): Fall-back to paragraph parser when drawer is incomplete. * testing/lisp/test-org-export.el: Update test. --- lisp/org-element.el | 262 +++++++++++++++++++------------- testing/lisp/test-org-export.el | 10 +- 2 files changed, 158 insertions(+), 114 deletions(-) diff --git a/lisp/org-element.el b/lisp/org-element.el index f8cf1497d..0fe947e51 100644 --- a/lisp/org-element.el +++ b/lisp/org-element.el @@ -110,7 +110,6 @@ (eval-when-compile (require 'cl)) -(declare-function org-inlinetask-goto-end "org-inlinetask" ()) @@ -462,28 +461,31 @@ Assume point is at the beginning of the block." (let ((case-fold-search t)) (if (not (save-excursion (re-search-forward "^[ \t]*#\\+END_CENTER" limit t))) - ;; Incomplete-block: parse it as a comment. + ;; Incomplete block: parse it as a comment. (org-element-comment-parser limit) - (let ((contents-end (match-beginning 0))) - (save-excursion - (let* ((keywords (org-element--collect-affiliated-keywords)) - (begin (car keywords)) - (contents-begin (progn (forward-line) (point))) - (hidden (org-invisible-p2)) - (pos-before-blank (progn (goto-char contents-end) - (forward-line) - (point))) - (end (progn (org-skip-whitespace) - (if (eobp) (point) (point-at-bol))))) - (list 'center-block - (nconc - (list :begin begin - :end end - :hiddenp hidden - :contents-begin contents-begin - :contents-end contents-end - :post-blank (count-lines pos-before-blank end)) - (cadr keywords))))))))) + (let ((block-end-line (match-beginning 0))) + (let* ((keywords (org-element--collect-affiliated-keywords)) + (begin (car keywords)) + ;; Empty blocks have no contents. + (contents-begin (progn (forward-line) + (and (< (point) block-end-line) + (point)))) + (contents-end (and contents-begin block-end-line)) + (hidden (org-invisible-p2)) + (pos-before-blank (progn (goto-char block-end-line) + (forward-line) + (point))) + (end (save-excursion (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (point-at-bol))))) + (list 'center-block + (nconc + (list :begin begin + :end end + :hiddenp hidden + :contents-begin contents-begin + :contents-end contents-end + :post-blank (count-lines pos-before-blank end)) + (cadr keywords)))))))) (defun org-element-center-block-interpreter (center-block contents) "Interpret CENTER-BLOCK element as Org syntax. @@ -503,29 +505,38 @@ Return a list whose CAR is `drawer' and CDR is a plist containing `:contents-end' and `:post-blank' keywords. Assume point is at beginning of drawer." - (save-excursion - (let* ((case-fold-search t) - (name (progn (looking-at org-drawer-regexp) - (org-match-string-no-properties 1))) - (keywords (org-element--collect-affiliated-keywords)) - (begin (car keywords)) - (contents-begin (progn (forward-line) (point))) - (hidden (org-invisible-p2)) - (contents-end (progn (re-search-forward "^[ \t]*:END:" limit t) - (point-at-bol))) - (pos-before-blank (progn (forward-line) (point))) - (end (progn (org-skip-whitespace) - (if (eobp) (point) (point-at-bol))))) - (list 'drawer - (nconc - (list :begin begin - :end end - :drawer-name name - :hiddenp hidden - :contents-begin contents-begin - :contents-end contents-end - :post-blank (count-lines pos-before-blank end)) - (cadr keywords)))))) + (let ((case-fold-search t)) + (if (not (save-excursion (re-search-forward "^[ \t]*:END:" limit t))) + ;; Incomplete drawer: parse it as a paragraph. + (org-element-paragraph-parser limit) + (let ((drawer-end-line (match-beginning 0))) + (save-excursion + (let* ((case-fold-search t) + (name (progn (looking-at org-drawer-regexp) + (org-match-string-no-properties 1))) + (keywords (org-element--collect-affiliated-keywords)) + (begin (car keywords)) + ;; Empty drawers have no contents. + (contents-begin (progn (forward-line) + (and (< (point) drawer-end-line) + (point)))) + (contents-end (and contents-begin drawer-end-line)) + (hidden (org-invisible-p2)) + (pos-before-blank (progn (goto-char drawer-end-line) + (forward-line) + (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (point-at-bol))))) + (list 'drawer + (nconc + (list :begin begin + :end end + :drawer-name name + :hiddenp hidden + :contents-begin contents-begin + :contents-end contents-end + :post-blank (count-lines pos-before-blank end)) + (cadr keywords))))))))) (defun org-element-drawer-interpreter (drawer contents) "Interpret DRAWER element as Org syntax. @@ -552,19 +563,23 @@ Assume point is at beginning of dynamic block." (if (not (save-excursion (re-search-forward org-dblock-end-re limit t))) ;; Incomplete block: parse it as a comment. (org-element-comment-parser limit) - (let ((contents-end (match-beginning 0))) + (let ((block-end-line (match-beginning 0))) (save-excursion (let* ((name (progn (looking-at org-dblock-start-re) (org-match-string-no-properties 1))) (arguments (org-match-string-no-properties 3)) (keywords (org-element--collect-affiliated-keywords)) (begin (car keywords)) - (contents-begin (progn (forward-line) (point))) + ;; Empty blocks have no contents. + (contents-begin (progn (forward-line) + (and (< (point) block-end-line) + (point)))) + (contents-end (and contents-begin block-end-line)) (hidden (org-invisible-p2)) - (pos-before-blank (progn (goto-char contents-end) + (pos-before-blank (progn (goto-char block-end-line) (forward-line) (point))) - (end (progn (org-skip-whitespace) + (end (progn (skip-chars-forward " \r\t\n" limit) (if (eobp) (point) (point-at-bol))))) (list 'dynamic-block (nconc @@ -601,22 +616,25 @@ a plist containing `:label', `:begin' `:end', `:contents-begin', Assume point is at the beginning of the footnote definition." (save-excursion - (looking-at org-footnote-definition-re) - (let* ((label (org-match-string-no-properties 1)) + (let* ((label (progn (looking-at org-footnote-definition-re) + (org-match-string-no-properties 1))) (keywords (org-element--collect-affiliated-keywords)) (begin (car keywords)) + (ending (save-excursion + (if (progn + (end-of-line) + (re-search-forward + (concat org-outline-regexp-bol "\\|" + org-footnote-definition-re "\\|" + "^[ \t]*$") limit 'move)) + (match-beginning 0) + (point)))) (contents-begin (progn (search-forward "]") - (org-skip-whitespace) - (point))) - (contents-end (if (progn - (end-of-line) - (re-search-forward - (concat org-outline-regexp-bol "\\|" - org-footnote-definition-re "\\|" - "^[ \t]*$") limit 'move)) - (match-beginning 0) - (point))) - (end (progn (org-skip-whitespace) + (skip-chars-forward " \r\t\n" ending) + (and (/= (point) ending) (point)))) + (contents-end (and contents-begin ending)) + (end (progn (goto-char ending) + (skip-chars-forward " \r\t\n" limit) (if (eobp) (point) (point-at-bol))))) (list 'footnote-definition (nconc @@ -625,7 +643,7 @@ Assume point is at the beginning of the footnote definition." :end end :contents-begin contents-begin :contents-end contents-end - :post-blank (count-lines contents-end end)) + :post-blank (count-lines ending end)) (cadr keywords)))))) (defun org-element-footnote-definition-interpreter (footnote-definition contents) @@ -675,6 +693,8 @@ Assume point is at beginning of the headline." (archivedp (member org-archive-tag tags)) (footnote-section-p (and org-footnote-section (string= org-footnote-section raw-value))) + ;; Normalize property names: ":SOME_PROP:" becomes + ;; ":some-prop". (standard-props (let (plist) (mapc (lambda (p) @@ -693,15 +713,17 @@ Assume point is at beginning of the headline." (clock (cdr (assoc "CLOCK" time-props))) (timestamp (cdr (assoc "TIMESTAMP" time-props))) (begin (point)) - (pos-after-head (save-excursion (forward-line) (point))) - (contents-begin (save-excursion (forward-line) - (org-skip-whitespace) - (if (eobp) (point) (point-at-bol)))) - (hidden (save-excursion (forward-line) (org-invisible-p2))) - (end (progn (goto-char (org-end-of-subtree t t)))) - (contents-end (progn (skip-chars-backward " \r\t\n") - (forward-line) - (point)))) + (end (save-excursion (goto-char (org-end-of-subtree t t)))) + (pos-after-head (progn (forward-line) (point))) + (contents-begin (save-excursion + (skip-chars-forward " \r\t\n" end) + (and (/= (point) end) (line-beginning-position)))) + (hidden (org-invisible-p2)) + (contents-end (and contents-begin + (progn (goto-char end) + (skip-chars-backward " \r\t\n") + (forward-line) + (point))))) ;; Clean RAW-VALUE from any quote or comment string. (when (or quotedp commentedp) (setq raw-value @@ -717,7 +739,9 @@ Assume point is at beginning of the headline." (list :raw-value raw-value :begin begin :end end - :pre-blank (count-lines pos-after-head contents-begin) + :pre-blank + (if (not contents-begin) 0 + (count-lines pos-after-head contents-begin)) :hiddenp hidden :contents-begin contents-begin :contents-end contents-end @@ -730,7 +754,12 @@ Assume point is at beginning of the headline." :deadline deadline :timestamp timestamp :clock clock - :post-blank (count-lines contents-end end) + :post-blank (count-lines + (if (not contents-end) pos-after-head + (goto-char contents-end) + (forward-line) + (point)) + end) :footnote-section-p footnote-section-p :archivedp archivedp :commentedp commentedp @@ -818,6 +847,8 @@ Assume point is at beginning of the inline task." (if (member todo org-done-keywords) 'done 'todo))) (tags (let ((raw-tags (nth 5 components))) (and raw-tags (org-split-string raw-tags ":")))) + ;; Normalize property names: ":SOME_PROP:" becomes + ;; ":some-prop". (standard-props (let (plist) (mapc (lambda (p) @@ -835,22 +866,26 @@ Assume point is at beginning of the inline task." (deadline (cdr (assoc "DEADLINE" time-props))) (clock (cdr (assoc "CLOCK" time-props))) (timestamp (cdr (assoc "TIMESTAMP" time-props))) - (contents-begin (save-excursion (forward-line) (point))) - (hidden (org-invisible-p2)) - (pos-before-blank (org-inlinetask-goto-end)) - ;; In the case of a single line task, CONTENTS-BEGIN and - ;; CONTENTS-END might overlap. - (contents-end (max contents-begin - (if (not (bolp)) (point-at-bol) - (save-excursion (forward-line -1) (point))))) - (end (progn (org-skip-whitespace) + (task-end (save-excursion + (end-of-line) + (and (re-search-forward "^\\*+ END" limit t) + (match-beginning 0)))) + (contents-begin (progn (forward-line) + (and task-end (< (point) task-end) (point)))) + (hidden (and contents-begin (org-invisible-p2))) + (contents-end (and contents-begin task-end)) + (before-blank (if (not task-end) (point) + (goto-char task-end) + (forward-line) + (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) (if (eobp) (point) (point-at-bol)))) (inlinetask (list 'inlinetask (nconc (list :begin begin :end end - :hiddenp (and (> contents-end contents-begin) hidden) + :hiddenp hidden :contents-begin contents-begin :contents-end contents-end :level (nth 1 components) @@ -862,7 +897,7 @@ Assume point is at beginning of the inline task." :deadline deadline :timestamp timestamp :clock clock - :post-blank (count-lines pos-before-blank end)) + :post-blank (count-lines before-blank end)) standard-props (cadr keywords))))) (org-element-put-property @@ -1057,7 +1092,7 @@ Assume point is at the beginning of the list." ;; Blank lines below list belong to the top-level list only. (unless (= (org-list-get-top-point struct) contents-begin) (setq end (min (org-list-get-bottom-point struct) - (progn (org-skip-whitespace) + (progn (skip-chars-forward " \r\t\n" limit) (if (eobp) (point) (point-at-bol)))))) ;; Return value. (list 'plain-list @@ -1094,16 +1129,20 @@ Assume point is at the beginning of the block." (re-search-forward "^[ \t]*#\\+END_QUOTE" limit t))) ;; Incomplete block: parse it as a comment. (org-element-comment-parser limit) - (let ((contents-end (match-beginning 0))) + (let ((block-end-line (match-beginning 0))) (save-excursion (let* ((keywords (org-element--collect-affiliated-keywords)) (begin (car keywords)) - (contents-begin (progn (forward-line) (point))) + ;; Empty blocks have no contents. + (contents-begin (progn (forward-line) + (and (< (point) block-end-line) + (point)))) + (contents-end (and contents-begin block-end-line)) (hidden (org-invisible-p2)) - (pos-before-blank (progn (goto-char contents-end) + (pos-before-blank (progn (goto-char block-end-line) (forward-line) (point))) - (end (progn (org-skip-whitespace) + (end (progn (skip-chars-forward " \r\t\n" limit) (if (eobp) (point) (point-at-bol))))) (list 'quote-block (nconc @@ -1172,13 +1211,17 @@ Assume point is at the beginning of the block." (re-search-forward (concat "^[ \t]*#\\+END_" type) limit t))) ;; Incomplete block: parse it as a comment. (org-element-comment-parser limit) - (let ((contents-end (match-beginning 0))) + (let ((block-end-line (match-beginning 0))) (save-excursion (let* ((keywords (org-element--collect-affiliated-keywords)) (begin (car keywords)) - (contents-begin (progn (forward-line) (point))) + ;; Empty blocks have no contents. + (contents-begin (progn (forward-line) + (and (< (point) block-end-line) + (point)))) + (contents-end (and contents-begin block-end-line)) (hidden (org-invisible-p2)) - (pos-before-blank (progn (goto-char contents-end) + (pos-before-blank (progn (goto-char block-end-line) (forward-line) (point))) (end (progn (org-skip-whitespace) @@ -1232,7 +1275,7 @@ keywords." (org-babel-lob-get-info))) (begin (point-at-bol)) (pos-before-blank (progn (forward-line) (point))) - (end (progn (org-skip-whitespace) + (end (progn (skip-chars-forward " \r\t\n" limit) (if (eobp) (point) (point-at-bol))))) (list 'babel-call (list :begin begin @@ -1275,7 +1318,7 @@ as keywords." (org-match-string-no-properties 1))) (status (if time 'closed 'running)) (post-blank (let ((before-blank (progn (forward-line) (point)))) - (org-skip-whitespace) + (skip-chars-forward " \r\t\n" limit) (unless (eobp) (beginning-of-line)) (count-lines before-blank (point)))) (end (point))) @@ -1335,7 +1378,7 @@ Assume point is at comment beginning." (progn (forward-line) (point)))))) (point))) (end (progn (goto-char com-end) - (org-skip-whitespace) + (skip-chars-forward " \r\t\n" limit) (if (eobp) (point) (point-at-bol))))) (list 'comment (nconc @@ -1377,7 +1420,7 @@ Assume point is at comment block beginning." (pos-before-blank (progn (goto-char contents-end) (forward-line) (point))) - (end (progn (org-skip-whitespace) + (end (progn (skip-chars-forward " \r\t\n" limit) (if (eobp) (point) (point-at-bol)))) (value (buffer-substring-no-properties contents-begin contents-end))) @@ -1446,7 +1489,7 @@ containing `:begin', `:end', `:number-lines', `:preserve-indent', (pos-before-blank (progn (goto-char contents-end) (forward-line) (point))) - (end (progn (org-skip-whitespace) + (end (progn (skip-chars-forward " \r\t\n" limit) (if (eobp) (point) (point-at-bol))))) (list 'example-block (nconc @@ -1501,7 +1544,7 @@ Assume point is at export-block beginning." (pos-before-blank (progn (goto-char contents-end) (forward-line) (point))) - (end (progn (org-skip-whitespace) + (end (progn (skip-chars-forward " \r\t\n" limit) (if (eobp) (point) (point-at-bol)))) (value (buffer-substring-no-properties contents-begin contents-end))) @@ -1551,7 +1594,7 @@ Assume point is at the beginning of the fixed-width area." "\n")) (forward-line)) (point))) - (end (progn (org-skip-whitespace) + (end (progn (skip-chars-forward " \r\t\n" limit) (if (eobp) (point) (point-at-bol))))) (list 'fixed-width (nconc @@ -1581,7 +1624,7 @@ containing `:begin', `:end' and `:post-blank' keywords." (let* ((keywords (org-element--collect-affiliated-keywords)) (begin (car keywords)) (post-hr (progn (forward-line) (point))) - (end (progn (org-skip-whitespace) + (end (progn (skip-chars-forward " \r\t\n" limit) (if (eobp) (point) (point-at-bol))))) (list 'horizontal-rule (nconc @@ -1614,7 +1657,7 @@ keywords." (value (org-trim (buffer-substring-no-properties (match-end 0) (point-at-eol)))) (pos-before-blank (progn (forward-line) (point))) - (end (progn (org-skip-whitespace) + (end (progn (skip-chars-forward " \r\t\n" limit) (if (eobp) (point) (point-at-bol))))) (list 'keyword (list :key key @@ -1655,7 +1698,7 @@ Assume point is at the beginning of the latex environment." (forward-line) (point))) (value (buffer-substring-no-properties code-begin code-end)) - (end (progn (org-skip-whitespace) + (end (progn (skip-chars-forward " \r\t\n" limit) (if (eobp) (point) (point-at-bol))))) (list 'latex-environment (nconc @@ -1695,7 +1738,8 @@ Assume point is at the beginning of the paragraph." (goto-char (match-beginning 0)) (point)))) (contents-end (progn (skip-chars-backward " \r\t\n" contents-begin) - (line-end-position))) + (forward-line) + (point))) (end (progn (skip-chars-forward " \r\t\n" limit) (if (eobp) (point) (point-at-bol))))) (list 'paragraph @@ -1729,7 +1773,7 @@ and `:post-blank' keywords." (let* ((case-fold-search nil) (begin (point)) (post-blank (let ((before-blank (progn (forward-line) (point)))) - (org-skip-whitespace) + (skip-chars-forward " \r\t\n" limit) (unless (eobp) (beginning-of-line)) (count-lines before-blank (point)))) (end (point)) @@ -1800,7 +1844,7 @@ Assume point is at the beginning of the property drawer." (prop-end (progn (re-search-forward "^[ \t]*:END:" limit t) (point-at-bol))) (pos-before-blank (progn (forward-line) (point))) - (end (progn (org-skip-whitespace) + (end (progn (skip-chars-forward " \r\t\n" limit) (if (eobp) (point) (point-at-bol))))) (list 'property-drawer (list :begin begin @@ -1915,7 +1959,7 @@ Assume point is at the beginning of the block." (forward-line) (point))) ;; Get position after ending blank lines. - (end (progn (org-skip-whitespace) + (end (progn (skip-chars-forward " \r\t\n" limit) (if (eobp) (point) (point-at-bol))))) (list 'src-block (nconc @@ -1987,7 +2031,7 @@ Assume point is at the beginning of the table." (forward-line)) acc)) (pos-before-blank (point)) - (end (progn (org-skip-whitespace) + (end (progn (skip-chars-forward " \r\t\n" limit) (if (eobp) (point) (point-at-bol))))) (list 'table (nconc @@ -2084,7 +2128,7 @@ Assume point is at beginning of the block." (pos-before-blank (progn (goto-char contents-end) (forward-line) (point))) - (end (progn (org-skip-whitespace) + (end (progn (skip-chars-forward " \r\t\n" limit) (if (eobp) (point) (point-at-bol))))) (list 'verse-block (nconc diff --git a/testing/lisp/test-org-export.el b/testing/lisp/test-org-export.el index b38869cc3..3b372f964 100644 --- a/testing/lisp/test-org-export.el +++ b/testing/lisp/test-org-export.el @@ -444,11 +444,11 @@ body\n"))) (let ((org-footnote-section nil) (org-export-with-footnotes t)) ;; 1. Read every type of footnote. - (org-test-with-parsed-data - "Text[fn:1] [1] [fn:label:C] [fn::D]\n\n[fn:1] A\n\n[1] B" - (should - (equal - '((1 . "A") (2 . "B") (3 . "C") (4 . "D")) + (should + (equal + '((1 . "A\n") (2 . "B") (3 . "C") (4 . "D")) + (org-test-with-parsed-data + "Text[fn:1] [1] [fn:label:C] [fn::D]\n\n[fn:1] A\n\n[1] B" (org-element-map tree 'footnote-reference (lambda (ref)