From ae35b8c4ad03bc858c0c64f043c4da7b493c0568 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sat, 13 Sep 2014 22:43:45 +0200 Subject: [PATCH] org-element: Update property drawers parsing * lisp/org-element.el (org-element--get-node-properties, org-element--get-time-properties): New functions. (org-element-headline-parser, org-element-inlinetask-parser): Use new functions. (org-element-property-drawer-parser): Change signature. Simplify parsing. drawer. (org-element--current-element, org-element--next-mode): Property drawers are located right after a headline or a planning element. * testing/lisp/test-org-element.el (test-org-element/drawer-parser, test-org-element/node-property, test-org-element/property-drawer-interpreter): Update tests. (test-org-element/property-drawer-parser): Add tests. * testing/lisp/test-org.el (test-org/indent-line, test-org/indent-region, test-org/forward-paragraph, test-org/backward-paragraph): Update tests. --- lisp/org-element.el | 233 ++++++++++--------------------- testing/lisp/test-org-element.el | 76 +++++----- testing/lisp/test-org.el | 47 +++---- 3 files changed, 140 insertions(+), 216 deletions(-) diff --git a/lisp/org-element.el b/lisp/org-element.el index cb0c1af04..b669de733 100644 --- a/lisp/org-element.el +++ b/lisp/org-element.el @@ -31,12 +31,13 @@ ;; ;; An element always starts and ends at the beginning of a line. With ;; a few exceptions (`clock', `headline', `inlinetask', `item', -;; `planning', `node-property', `section' and `table-row' types), it -;; can also accept a fixed set of keywords as attributes. Those are -;; called "affiliated keywords" to distinguish them from other -;; keywords, which are full-fledged elements. Almost all affiliated -;; keywords are referenced in `org-element-affiliated-keywords'; the -;; others are export attributes and start with "ATTR_" prefix. +;; `planning', `property-drawer', `node-property', `section' and +;; `table-row' types), it can also accept a fixed set of keywords as +;; attributes. Those are called "affiliated keywords" to distinguish +;; them from other keywords, which are full-fledged elements. Almost +;; all affiliated keywords are referenced in +;; `org-element-affiliated-keywords'; the others are export attributes +;; and start with "ATTR_" prefix. ;; ;; Element containing other elements (and only elements) are called ;; greater elements. Concerned types are: `center-block', `drawer', @@ -765,6 +766,42 @@ CONTENTS is the contents of the footnote-definition." ;;;; Headline +(defun org-element--get-node-properties () + "Return node properties associated to headline at point. +Upcase property names. It avoids confusion between properties +obtained through property drawer and default properties from the +parser (e.g. `:end' and :END:). Return value is a plist." + (save-excursion + (forward-line) + (when (org-looking-at-p org-planning-line-re) (forward-line)) + (when (looking-at org-property-drawer-re) + (forward-line) + (let ((end (match-end 0)) properties) + (while (< (line-end-position) end) + (looking-at org-property-re) + (push (org-match-string-no-properties 3) properties) + (push (intern (concat ":" (upcase (match-string 2)))) properties) + (forward-line)) + properties)))) + +(defun org-element--get-time-properties () + "Return time properties associated to headline at point. +Return value is a plist." + (save-excursion + (when (progn (forward-line) (looking-at org-planning-line-re)) + (let ((end (line-end-position)) plist) + (while (re-search-forward org-keyword-time-not-clock-regexp end t) + (goto-char (match-end 1)) + (skip-chars-forward " \t") + (let ((keyword (match-string 1)) + (time (org-element-timestamp-parser))) + (cond ((equal keyword org-scheduled-string) + (setq plist (plist-put plist :scheduled time))) + ((equal keyword org-deadline-string) + (setq plist (plist-put plist :deadline time))) + (t (setq plist (plist-put plist :closed time)))))) + plist)))) + (defun org-element-headline-parser (limit &optional raw-secondary-p) "Parse a headline. @@ -802,61 +839,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))) - (standard-props - ;; Find property drawer associated to current headline and - ;; extract properties. - ;; - ;; Upcase property names. It avoids confusion between - ;; properties obtained through property drawer and default - ;; properties from the parser (e.g. `:end' and :END:) - (let ((end (save-excursion - (org-with-limited-levels (outline-next-heading)) - (point))) - plist) - (save-excursion - (while (and (null plist) - (re-search-forward org-property-start-re end t)) - (let ((drawer (org-element-at-point))) - (when (and (eq (org-element-type drawer) 'property-drawer) - ;; Make sure drawer is not associated - ;; to an inlinetask. - (let ((p drawer)) - (while (and (setq p (org-element-property - :parent p)) - (not (eq (org-element-type p) - 'inlinetask)))) - (not p))) - (let ((end (org-element-property :contents-end drawer))) - (when end - (forward-line) - (while (< (point) end) - (when (looking-at org-property-re) - (setq plist - (plist-put - plist - (intern - (concat ":" (upcase (match-string 2)))) - (org-match-string-no-properties 3)))) - (forward-line))))))) - plist))) - (time-props - ;; Read time properties on the line below the headline. - (save-excursion - (forward-line) - (when (looking-at org-planning-line-re) - (let ((end (line-end-position)) plist) - (while (re-search-forward - org-keyword-time-not-clock-regexp end t) - (goto-char (match-end 1)) - (skip-chars-forward " \t") - (let ((keyword (match-string 1)) - (time (org-element-timestamp-parser))) - (cond ((equal keyword org-scheduled-string) - (setq plist (plist-put plist :scheduled time))) - ((equal keyword org-deadline-string) - (setq plist (plist-put plist :deadline time))) - (t (setq plist (plist-put plist :closed time)))))) - plist)))) + (standard-props (org-element--get-node-properties)) + (time-props (org-element--get-time-properties)) (begin (point)) (end (min (save-excursion (org-end-of-subtree t t)) limit)) (pos-after-head (progn (forward-line) (point))) @@ -997,25 +981,8 @@ Assume point is at beginning of the inline task." (and (re-search-forward org-outline-regexp-bol limit t) (org-looking-at-p "END[ \t]*$") (line-beginning-position)))) - (time-props - ;; Read time properties on the line below the inlinetask - ;; opening string. - (when task-end - (save-excursion - (when (progn (forward-line) (looking-at org-planning-line-re)) - (let ((end (line-end-position)) plist) - (while (re-search-forward - org-keyword-time-not-clock-regexp end t) - (goto-char (match-end 1)) - (skip-chars-forward " \t") - (let ((keyword (match-string 1)) - (time (org-element-timestamp-parser))) - (cond ((equal keyword org-scheduled-string) - (setq plist (plist-put plist :scheduled time))) - ((equal keyword org-deadline-string) - (setq plist (plist-put plist :deadline time))) - (t (setq plist (plist-put plist :closed time)))))) - plist))))) + (standard-props (and task-end (org-element--get-node-properties))) + (time-props (and task-end (org-element--get-time-properties))) (contents-begin (progn (forward-line) (and task-end (< (point) task-end) (point)))) (contents-end (and contents-begin task-end)) @@ -1025,43 +992,6 @@ Assume point is at beginning of the inline task." (point))) (end (progn (skip-chars-forward " \r\t\n" limit) (if (eobp) (point) (line-beginning-position)))) - (standard-props - ;; Find property drawer associated to current inlinetask - ;; and extract properties. - ;; - ;; HACK: Calling `org-element-at-point' triggers a parsing - ;; of this inlinetask and, thus, an infloop. To avoid the - ;; problem, we extract contents of the inlinetask and - ;; parse them in a new buffer. - ;; - ;; Upcase property names. It avoids confusion between - ;; properties obtained through property drawer and default - ;; properties from the parser (e.g. `:end' and :END:) - (when contents-begin - (let ((contents (buffer-substring contents-begin contents-end)) - plist) - (with-temp-buffer - (let ((org-inhibit-startup t)) (org-mode)) - (insert contents) - (goto-char (point-min)) - (while (and (null plist) - (re-search-forward - org-property-start-re task-end t)) - (let ((d (org-element-at-point))) - (when (eq (org-element-type d) 'property-drawer) - (let ((end (org-element-property :contents-end d))) - (when end - (forward-line) - (while (< (point) end) - (when (looking-at org-property-re) - (setq plist - (plist-put - plist - (intern - (concat ":" (upcase (match-string 2)))) - (org-match-string-no-properties 3)))) - (forward-line)))))))) - plist))) (inlinetask (list 'inlinetask (nconc @@ -1378,47 +1308,33 @@ CONTENTS is the contents of the element." ;;;; Property Drawer -(defun org-element-property-drawer-parser (limit affiliated) +(defun org-element-property-drawer-parser (limit) "Parse a property drawer. -LIMIT bounds the search. AFFILIATED is a list of which CAR is -the buffer position at the beginning of the first affiliated -keyword and CDR is a plist of affiliated keywords along with -their value. +LIMIT bounds the search. -Return a list whose CAR is `property-drawer' and CDR is a plist +Return a list whose car is `property-drawer' and cdr is a plist containing `:begin', `:end', `:contents-begin', `:contents-end', `:post-blank' and `:post-affiliated' keywords. Assume point is at the beginning of the property drawer." - (let ((case-fold-search t)) - (if (not (save-excursion (re-search-forward "^[ \t]*:END:[ \t]*$" limit t))) - ;; Incomplete drawer: parse it as a paragraph. - (org-element-paragraph-parser limit affiliated) - (save-excursion - (let* ((drawer-end-line (match-beginning 0)) - (begin (car affiliated)) - (post-affiliated (point)) - (contents-begin - (progn - (forward-line) - (and (re-search-forward org-property-re drawer-end-line t) - (line-beginning-position)))) - (contents-end (and contents-begin drawer-end-line)) - (pos-before-blank (progn (goto-char drawer-end-line) - (forward-line) - (point))) - (end (progn (skip-chars-forward " \r\t\n" limit) - (if (eobp) (point) (line-beginning-position))))) - (list 'property-drawer - (nconc - (list :begin begin - :end end - :contents-begin contents-begin - :contents-end contents-end - :post-blank (count-lines pos-before-blank end) - :post-affiliated post-affiliated) - (cdr affiliated)))))))) + (save-excursion + (let ((case-fold-search t) + (begin (point)) + (contents-begin (line-beginning-position 2))) + (re-search-forward "^[ \t]*:END:[ \t]*$" limit t) + (let ((contents-end (and (> (match-beginning 0) contents-begin) + (match-beginning 0))) + (before-blank (progn (forward-line) (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position))))) + (list 'property-drawer + (list :begin begin + :end end + :contents-begin (and contents-end contents-begin) + :contents-end contents-end + :post-blank (count-lines before-blank end) + :post-affiliated begin)))))) (defun org-element-property-drawer-interpreter (property-drawer contents) "Interpret PROPERTY-DRAWER element as Org syntax. @@ -3709,6 +3625,10 @@ element it has to parse." ;; Planning. ((and (eq mode 'planning) (looking-at org-planning-line-re)) (org-element-planning-parser limit)) + ;; Property drawer. + ((and (memq mode '(planning property-drawer)) + (looking-at org-property-drawer-re)) + (org-element-property-drawer-parser limit)) ;; When not at bol, point is at the beginning of an item or ;; a footnote definition: next item is always a paragraph. ((not (bolp)) (org-element-paragraph-parser limit (list (point)))) @@ -3730,9 +3650,7 @@ element it has to parse." (org-element-latex-environment-parser limit affiliated)) ;; Drawer and Property Drawer. ((looking-at org-drawer-regexp) - (if (equal (match-string 1) "PROPERTIES") - (org-element-property-drawer-parser limit affiliated) - (org-element-drawer-parser limit affiliated))) + (org-element-drawer-parser limit affiliated)) ;; Fixed Width ((looking-at "[ \t]*:\\( \\|$\\)") (org-element-fixed-width-parser limit affiliated)) @@ -4125,8 +4043,9 @@ looking into captions: "Return next special mode according to TYPE, or nil. TYPE is a symbol representing the type of an element or object containing next element if PARENTP is non-nil, or before it -otherwise. Modes can be either `first-section', `section', -`planning', `item', `node-property' and `table-row'." +otherwise. Modes can be either `first-section', `item', +`node-property', `planning', `property-drawer', `section', +`table-row' or nil." (if parentp (case type (headline 'section) @@ -4137,7 +4056,7 @@ otherwise. Modes can be either `first-section', `section', (case type (item 'item) (node-property 'node-property) - (planning nil) + (planning 'property-drawer) (table-row 'table-row)))) (defun org-element--parse-elements diff --git a/testing/lisp/test-org-element.el b/testing/lisp/test-org-element.el index e93ab7583..7f7c9cb9d 100644 --- a/testing/lisp/test-org-element.el +++ b/testing/lisp/test-org-element.el @@ -555,10 +555,6 @@ Some other text (should (org-test-with-temp-text ":TEST:\nText\n:END:" (org-element-map (org-element-parse-buffer) 'drawer 'identity))) - ;; Do not mix regular drawers and property drawers. - (should-not - (org-test-with-temp-text ":PROPERTIES:\n:prop: value\n:END:" - (org-element-map (org-element-parse-buffer) 'drawer 'identity nil t))) ;; Ignore incomplete drawer. (should-not (org-test-with-temp-text ":TEST:" @@ -1604,14 +1600,15 @@ e^{i\\pi}+1=0 ;; Standard test. (should (equal '("abc" "value") - (org-test-with-temp-text ":PROPERTIES:\n:abc: value\n:END:" + (org-test-with-temp-text "* H\n:PROPERTIES:\n:abc: value\n:END:" (let ((element (org-element-at-point))) (list (org-element-property :key element) (org-element-property :value element)))))) ;; Value should be trimmed. (should (equal "value" - (org-test-with-temp-text ":PROPERTIES:\n:abc: value \n:END:" + (org-test-with-temp-text + "* H\n:PROPERTIES:\n:abc: value \n:END:" (org-element-property :value (org-element-at-point))))) ;; A node property requires to be wrapped within a property drawer. (should-not @@ -1621,20 +1618,11 @@ e^{i\\pi}+1=0 ;; Accept empty properties. (should (equal '(("foo" "value") ("bar" "")) - (org-test-with-temp-text ":PROPERTIES:\n:foo: value\n:bar:\n:END:" + (org-test-with-temp-text "* H\n:PROPERTIES:\n:foo: value\n:bar:\n:END:" (org-element-map (org-element-parse-buffer) 'node-property (lambda (p) (list (org-element-property :key p) - (org-element-property :value p))))))) - ;; Ignore all non-property lines in property drawers. - (should - (equal - '(("foo" "value")) - (org-test-with-temp-text ":PROPERTIES:\nWrong1\n:foo: value\nWrong2\n:END:" - (org-element-map (org-element-parse-buffer) 'node-property - (lambda (p) - (list (org-element-property :key p) - (org-element-property :value p)))))))) + (org-element-property :value p)))))))) ;;;; Paragraph @@ -1760,22 +1748,42 @@ Outside list" "Test `property-drawer' parser." ;; Standard test. (should - (org-test-with-temp-text ":PROPERTIES:\n:prop: value\n:END:" - (org-element-map - (org-element-parse-buffer) 'property-drawer 'identity nil t))) - ;; Do not mix property drawers and regular drawers. - (should-not - (org-test-with-temp-text ":TEST:\n:prop: value\n:END:" - (org-element-map - (org-element-parse-buffer) 'property-drawer 'identity nil t))) - ;; Ignore incomplete drawer. - (should-not - (org-test-with-temp-text ":PROPERTIES:\n:prop: value" - (org-element-map - (org-element-parse-buffer) 'property-drawer 'identity nil t))) - ;; Handle non-empty blank line at the end of buffer. + (eq 'property-drawer + (org-test-with-temp-text "* H\n:PROPERTIES:\n:prop: value\n:END:" + (org-element-type (org-element-at-point))))) (should - (org-test-with-temp-text ":PROPERTIES:\n:END:\n " + (eq 'property-drawer + (org-test-with-temp-text + "* H\nDEADLINE: <2014-03-04 tue.>\n:PROPERTIES:\n:prop: value\n:END:" + (org-element-type (org-element-at-point))))) + ;; Allow properties without value and no property at all. + (should + (eq 'property-drawer + (org-test-with-temp-text "* H\n:PROPERTIES:\n:prop:\n:END:" + (org-element-type (org-element-at-point))))) + (should + (eq 'property-drawer + (org-test-with-temp-text "* H\n:PROPERTIES:\n:END:" + (org-element-type (org-element-at-point))))) + ;; Ignore incomplete drawer, drawer at a wrong location or with + ;; wrong contents. + (should-not + (eq 'property-drawer + (org-test-with-temp-text "* H\n:PROPERTIES:\n:prop: value" + (org-element-type (org-element-at-point))))) + (should-not + (eq 'property-drawer + (org-test-with-temp-text + "* H\nParagraph\n:PROPERTIES:\n:prop: value\n:END:" + (org-element-type (org-element-at-point))))) + (should-not + (eq 'property-drawer + (org-test-with-temp-text + "* H\nParagraph\n:PROPERTIES:\nparagraph\n:END:" + (org-element-type (org-element-at-point))))) + ;; Handle non-empty blank line at the end of buffer. + (should + (org-test-with-temp-text "* H\n:PROPERTIES:\n:END:\n " (= (org-element-property :end (org-element-at-point)) (point-max))))) @@ -2550,8 +2558,8 @@ DEADLINE: <2012-03-29 thu.> SCHEDULED: <2012-03-29 thu.> CLOSED: [2012-03-29 thu "Test property drawer interpreter." (should (equal (let ((org-property-format "%-10s %s")) (org-test-parse-and-interpret - ":PROPERTIES:\n:prop: value\n:END:")) - ":PROPERTIES:\n:prop: value\n:END:\n"))) + "* H\n:PROPERTIES:\n:prop: value\n:END:")) + "* H\n:PROPERTIES:\n:prop: value\n:END:\n"))) (ert-deftest test-org-element/src-block-interpreter () "Test src block interpreter." diff --git a/testing/lisp/test-org.el b/testing/lisp/test-org.el index 6a103838c..ad4fac5f6 100644 --- a/testing/lisp/test-org.el +++ b/testing/lisp/test-org.el @@ -584,19 +584,15 @@ ;; Align node properties according to `org-property-format'. Handle ;; nicely empty values. (should - (equal ":PROPERTIES:\n:key: value\n:END:" - (org-test-with-temp-text ":PROPERTIES:\n:key: value\n:END:" - (forward-line) - (let ((org-property-format "%-10s %s")) - (org-indent-line) - (buffer-string))))) + (equal "* H\n:PROPERTIES:\n:key: value\n:END:" + (org-test-with-temp-text "* H\n:PROPERTIES:\n:key: value\n:END:" + (let ((org-property-format "%-10s %s")) (org-indent-line)) + (buffer-string)))) (should - (equal ":PROPERTIES:\n:key:\n:END:" - (org-test-with-temp-text ":PROPERTIES:\n:key:\n:END:" - (forward-line) - (let ((org-property-format "%-10s %s")) - (org-indent-line) - (buffer-string)))))) + (equal "* H\n:PROPERTIES:\n:key:\n:END:" + (org-test-with-temp-text "* H\n:PROPERTIES:\n:key:\n:END:" + (let ((org-property-format "%-10s %s")) (org-indent-line)) + (buffer-string))))) (ert-deftest test-org/indent-region () "Test `org-indent-region' specifications." @@ -644,16 +640,18 @@ ;; Align node properties according to `org-property-format'. Handle ;; nicely empty values. (should - (equal ":PROPERTIES:\n:key: value\n:END:" - (org-test-with-temp-text ":PROPERTIES:\n:key: value\n:END:" - (let ((org-property-format "%-10s %s")) - (org-indent-region (point-min) (point-max))) + (equal "* H\n:PROPERTIES:\n:key: value\n:END:" + (org-test-with-temp-text "* H\n:PROPERTIES:\n:key: value\n:END:" + (let ((org-property-format "%-10s %s") + (org-adapt-indentation nil)) + (org-indent-region (point) (point-max))) (buffer-string)))) (should - (equal ":PROPERTIES:\n:key:\n:END:" - (org-test-with-temp-text ":PROPERTIES:\n:key:\n:END:" - (let ((org-property-format "%-10s %s")) - (org-indent-region (point-min) (point-max))) + (equal "* H\n:PROPERTIES:\n:key:\n:END:" + (org-test-with-temp-text "* H\n:PROPERTIES:\n:key:\n:END:" + (let ((org-property-format "%-10s %s") + (org-adapt-indentation nil)) + (org-indent-region (point) (point-max))) (buffer-string)))) ;; Indent plain lists. (should @@ -1261,7 +1259,8 @@ drops support for Emacs 24.1 and 24.2." (org-forward-paragraph) (looking-at "Paragraph"))) (should - (org-test-with-temp-text ":PROPERTIES:\n:prop: value\n:END:\nParagraph" + (org-test-with-temp-text + "* H\n:PROPERTIES:\n:prop: value\n:END:\nParagraph" (org-forward-paragraph) (looking-at "Paragraph"))) ;; On a verse or source block, stop after blank lines. @@ -1336,11 +1335,9 @@ drops support for Emacs 24.1 and 24.2." (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-test-with-temp-text "* H\n:PROPERTIES:\n:prop: value\n:END:\nP1" (org-backward-paragraph) - (bobp))) + (looking-at ":PROPERTIES:"))) ;; 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"