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

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

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<point>:abc: value\n:END:"
+	  (org-test-with-temp-text "* H\n:PROPERTIES:\n<point>: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<point>:abc: value  \n:END:"
+	  (org-test-with-temp-text
+	      "* H\n:PROPERTIES:\n<point>: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.
+   (eq 'property-drawer
+       (org-test-with-temp-text "* H\n<point>:PROPERTIES:\n:prop: value\n:END:"
+	 (org-element-type (org-element-at-point)))))
+  (should
+   (eq 'property-drawer
+       (org-test-with-temp-text
+	   "* H\nDEADLINE: <2014-03-04 tue.>\n<point>: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<point>:PROPERTIES:\n:prop:\n:END:"
+	 (org-element-type (org-element-at-point)))))
+  (should
+   (eq 'property-drawer
+       (org-test-with-temp-text "* H\n<point>:PROPERTIES:\n:END:"
+	 (org-element-type (org-element-at-point)))))
+  ;; Ignore incomplete drawer, drawer at a wrong location or with
+  ;; wrong contents.
   (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.
+   (eq 'property-drawer
+       (org-test-with-temp-text "* H\n<point>:PROPERTIES:\n:prop: value"
+	 (org-element-type (org-element-at-point)))))
   (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\nParagraph\n<point>: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<point>: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 ":PROPERTIES:\n:END:\n "
+   (org-test-with-temp-text "* H\n<point>: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."

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<point>: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<point>: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<point>: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<point>: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<point>: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:\n<point>P1"
      (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"