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.
This commit is contained in:
Nicolas Goaziou 2012-07-28 23:21:38 +02:00
parent 2da2c923aa
commit e7397fda3f
2 changed files with 158 additions and 114 deletions

View File

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

View File

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