[elpa] externals/org a06dc07cc0 028/101: org-element: Defer more when parsing headings and inlinetasks

[ELPA Syncer]

branch: externals/org
commit a06dc07cc04b6a1e260b9a035770234e1532912d
Author: Ihor Radchenko <yantar92@posteo.net>
Commit: Ihor Radchenko <yantar92@posteo.net>

    org-element: Defer more when parsing headings and inlinetasks
    
    * lisp/org-element.el (org-element-headline-parser--deferred):
    (org-element--headline-deferred): Rename.
    (org-element--headline-archivedp):
    (org-element--headline-footnote-section-p):
    (org-element--headline-parse-title): New internal helpers.
    (org-element-headline-parser):
    (org-element-inlinetask-parser): Defer parsing headline components.
    *
    testing/lisp/test-org-attach.el 
(test-org-attach/dired-attach-to-next-best-subtree/1):
    Use property API instead of relying upon internal syntax node 
representation.
---
 lisp/org-element.el             | 325 ++++++++++++++++++++--------------------
 testing/lisp/test-org-attach.el |   8 +-
 2 files changed, 163 insertions(+), 170 deletions(-)

diff --git a/lisp/org-element.el b/lisp/org-element.el
index 7441752549..b120f4ef9e 100644
--- a/lisp/org-element.el
+++ b/lisp/org-element.el
@@ -940,7 +940,7 @@ Return value is a plist."
                  (t (setq plist (plist-put plist :closed time))))))
        plist))))
 
-(defun org-element-headline-parser--deferred (element)
+(defun org-element--headline-deferred (element)
   "Parse and set extra properties for ELEMENT headline in BUFFER."
   (with-current-buffer (org-element-property :buffer element)
     (org-with-wide-buffer
@@ -991,6 +991,92 @@ Return value is a plist."
   "Retrieve :raw-value in HEADLINE according to BEG-OFFSET and END-OFFSET."
   (org-trim (org-element--substring headline beg-offset end-offset)))
 
+(defun org-element--headline-archivedp (headline)
+  "Return t when HEADLINE is archived and nil otherwise."
+  (if (member org-element-archive-tag
+              (org-element-property :tags headline))
+      t nil))
+
+(defun org-element--headline-footnote-section-p (headline)
+  "Return t when HEADLINE is a footnote section and nil otherwise."
+  (and org-footnote-section
+       (string= org-footnote-section
+                (org-element-property :raw-value headline))))
+
+(defun org-element--headline-parse-title (headline raw-secondary-p)
+  "Resolve title properties of HEADLINE for side effect.
+When RAW-SECONDARY-P is non-nil, headline's title will not be
+parsed as a secondary string, but as a plain string instead.
+
+Throw `:org-element-deferred-retry' signal at the end."
+  (with-current-buffer (org-element-property :buffer headline)
+    (org-with-point-at (org-element-property :begin headline)
+      (let* ((begin (point))
+             (true-level (prog1 (skip-chars-forward "*")
+                           (skip-chars-forward " \t")))
+            (level (org-reduced-level true-level))
+            (todo (and org-todo-regexp
+                       (let (case-fold-search) (looking-at (concat 
org-todo-regexp "\\(?: \\|$\\)")))
+                       (progn (goto-char (match-end 0))
+                              (skip-chars-forward " \t")
+                               (org-element--get-cached-string 
(match-string-no-properties 1)))))
+            (todo-type
+             (and todo (if (member todo org-done-keywords) 'done 'todo)))
+            (priority (and (looking-at "\\[#.\\][ \t]*")
+                           (progn (goto-char (match-end 0))
+                                  (aref (match-string 0) 2))))
+            (commentedp
+             (and (let ((case-fold-search nil))
+                     (looking-at (concat org-element-comment-string "\\(?: 
\\|$\\)")))
+                   (prog1 t
+                    (goto-char (match-end 0))
+                     (skip-chars-forward " \t"))))
+            (title-start (point))
+            (tags (when (re-search-forward
+                         "\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"
+                         (line-end-position)
+                         'move)
+                    (goto-char (match-beginning 0))
+                     (mapcar #'org-element--get-cached-string
+                            (org-split-string (match-string-no-properties 1) 
":"))))
+            (title-end (point))
+            (raw-value
+              (org-element-deferred-create
+               nil #'org-element--headline-raw-value
+               (- title-start begin) (- title-end begin)))
+            (archivedp
+              (org-element-deferred-create
+               nil #'org-element--headline-archivedp))
+            (footnote-section-p
+              (org-element-deferred-create
+               nil #'org-element--headline-footnote-section-p)))
+        (org-element-put-property headline :raw-value raw-value)
+        (org-element-put-property headline :level level)
+        (org-element-put-property headline :priority priority)
+        (org-element-put-property headline :tags tags)
+        (org-element-put-property headline :todo-keyword todo)
+        (org-element-put-property headline :todo-type todo-type)
+        (org-element-put-property
+         headline :footnote-section-p footnote-section-p)
+        (org-element-put-property headline :archivedp archivedp)
+        (org-element-put-property headline :commentedp commentedp)
+       (org-element-put-property
+        headline :title
+        (if raw-secondary-p
+             (org-element-deferred-create-alias :raw-value)
+          (org-element--parse-objects
+           (progn (goto-char title-start)
+                  (skip-chars-forward " \t")
+                  (point))
+           (progn (goto-char title-end)
+                  (skip-chars-backward " \t")
+                  (point))
+           nil
+           (org-element-restriction
+             (org-element-type headline))
+           headline))))))
+  (throw :org-element-deferred-retry nil))
+
 (defun org-element-headline-parser (&optional _ raw-secondary-p)
   "Parse a headline.
 
@@ -1010,44 +1096,11 @@ parsed as a secondary string, but as a plain string 
instead.
 
 Assume point is at beginning of the headline."
   (save-excursion
-    (let* ((begin (point))
-           (true-level (prog1 (skip-chars-forward "*")
-                         (skip-chars-forward " \t")))
-          (level (org-reduced-level true-level))
-          (todo (and org-todo-regexp
-                     (let (case-fold-search) (looking-at (concat 
org-todo-regexp "\\(?: \\|$\\)")))
-                     (progn (goto-char (match-end 0))
-                            (skip-chars-forward " \t")
-                             (org-element--get-cached-string 
(match-string-no-properties 1)))))
-          (todo-type
-           (and todo (if (member todo org-done-keywords) 'done 'todo)))
-          (priority (and (looking-at "\\[#.\\][ \t]*")
-                         (progn (goto-char (match-end 0))
-                                (aref (match-string 0) 2))))
-          (commentedp
-           (and (let ((case-fold-search nil))
-                   (looking-at (concat org-element-comment-string "\\(?: 
\\|$\\)")))
-                 (prog1 t
-                  (goto-char (match-end 0))
-                   (skip-chars-forward " \t"))))
-          (title-start (point))
-          (tags (when (re-search-forward
-                       "\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"
-                       (line-end-position)
-                       'move)
-                  (goto-char (match-beginning 0))
-                   (mapcar #'org-element--get-cached-string
-                          (org-split-string (match-string-no-properties 1) 
":"))))
-          (title-end (point))
-           (raw-value (org-trim
-                      (buffer-substring-no-properties title-start title-end)))
-          (raw-value-deferred
+    (let* ((deferred-title-prop
             (org-element-deferred-create
-             nil #'org-element--headline-raw-value
-             (- title-start begin) (- title-end begin)))
-          (archivedp (if (member org-element-archive-tag tags) t nil))
-          (footnote-section-p (and org-footnote-section
-                                   (string= org-footnote-section raw-value)))
+             nil #'org-element--headline-parse-title raw-secondary-p))
+           (begin (point))
+           (true-level (skip-chars-forward "*"))
            (end
             (save-excursion
               (if (re-search-forward (org-headline-re true-level) nil t)
@@ -1072,52 +1125,41 @@ Assume point is at beginning of the headline."
                             (when (> (- contents-end 2) robust-begin)
                               (- contents-end 2)))))
       (unless robust-end (setq robust-begin nil))
-      (let ((headline
-            (org-element-create
-              'headline
-             (list :raw-value raw-value-deferred
-                   :begin begin
-                   :end end
-                   :pre-blank
-                   (if (not contents-begin) 0
-                     (1- (count-lines begin contents-begin)))
-                   :contents-begin contents-begin
-                   :contents-end contents-end
-                    :robust-begin robust-begin
-                    :robust-end robust-end
-                   :true-level true-level
-                   :level level
-                   :priority priority
-                   :tags tags
-                   :todo-keyword todo
-                   :todo-type todo-type
-                   :post-blank
-                   (if contents-end
-                       (count-lines contents-end end)
-                     (1- (count-lines begin end)))
-                   :footnote-section-p footnote-section-p
-                   :archivedp archivedp
-                   :commentedp commentedp
-                   :post-affiliated begin
-                    :secondary (alist-get
-                                'headline
-                                org-element-secondary-value-alist)
-                    :deferred
-                    (org-element-deferred-create
-                     t #'org-element-headline-parser--deferred)))))
-       (org-element-put-property
-        headline :title
-        (if raw-secondary-p (org-element-deferred-alias :raw-value)
-          (org-element--parse-objects
-           (progn (goto-char title-start)
-                  (skip-chars-forward " \t")
-                  (point))
-           (progn (goto-char title-end)
-                  (skip-chars-backward " \t")
-                  (point))
-           nil
-           (org-element-restriction 'headline)
-           headline)))))))
+      (org-element-create
+       'headline
+       (list
+       :begin begin
+       :end end
+       :pre-blank
+       (if (not contents-begin) 0
+         (1- (count-lines begin contents-begin)))
+       :contents-begin contents-begin
+       :contents-end contents-end
+        :robust-begin robust-begin
+        :robust-end robust-end
+       :true-level true-level
+        :buffer (current-buffer)
+        :raw-value deferred-title-prop
+        :title deferred-title-prop
+        :level deferred-title-prop
+       :priority deferred-title-prop
+       :tags deferred-title-prop
+       :todo-keyword deferred-title-prop
+       :todo-type deferred-title-prop
+       :post-blank
+       (if contents-end
+           (count-lines contents-end end)
+         (1- (count-lines begin end)))
+       :footnote-section-p deferred-title-prop
+       :archivedp deferred-title-prop
+       :commentedp deferred-title-prop
+       :post-affiliated begin
+        :secondary (alist-get
+                    'headline
+                    org-element-secondary-value-alist)
+        :deferred
+        (org-element-deferred-create
+         t #'org-element--headline-deferred))))))
 
 (defun org-element-headline-interpreter (headline contents)
   "Interpret HEADLINE element as Org syntax.
@@ -1273,48 +1315,15 @@ string instead.
 
 Assume point is at beginning of the inline task."
   (save-excursion
-    (let* ((begin (point))
-          (level (prog1 (org-reduced-level (skip-chars-forward "*"))
-                   (skip-chars-forward " \t")))
-          (todo (and org-todo-regexp
-                     (let (case-fold-search) (looking-at org-todo-regexp))
-                     (progn (goto-char (match-end 0))
-                            (skip-chars-forward " \t")
-                             (org-element--get-cached-string 
(match-string-no-properties 0)))))
-          (todo-type (and todo
-                          (if (member todo org-done-keywords) 'done 'todo)))
-          (priority (and (looking-at "\\[#.\\][ \t]*")
-                         (progn (goto-char (match-end 0))
-                                (aref (match-string-no-properties 0) 2))))
-           (commentedp
-           (and (let ((case-fold-search nil))
-                   (looking-at org-element-comment-string))
-                (goto-char (match-end 0))
-                 (when (looking-at-p "\\(?:[ \t]\\|$\\)")
-                   t)))
-          (title-start (prog1 (point)
-                          (unless (or todo priority commentedp)
-                            ;; Headline like "* :tag:"
-                            (skip-chars-backward " \t"))))
-          (tags (when (re-search-forward
-                       "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"
-                       (line-end-position)
-                       'move)
-                  (goto-char (match-beginning 0))
-                   (mapcar #'org-element--get-cached-string
-                          (org-split-string (match-string-no-properties 1) 
":"))))
-          (title-end (point))
-          (raw-value-deferred
-            (org-element-deferred
-             nil #'org-element--headline-raw-value
-             (- title-start begin) (- title-end begin)))
-           (archivedp (if (member org-element-archive-tag tags) t nil))
+    (let* ((deferred-title-prop
+            (org-element-deferred-create
+             nil #'org-element--headline-parse-title raw-secondary-p))
+           (begin (point))
           (task-end (save-excursion
                       (end-of-line)
                       (and (re-search-forward org-element-headline-re limit t)
                            (looking-at-p "[ \t]*END[ \t]*$")
                            (line-beginning-position))))
-          (time-props (and task-end (org-element--get-time-properties)))
           (contents-begin (and task-end
                                (< (point) task-end)
                                (progn
@@ -1325,50 +1334,36 @@ Assume point is at beginning of the inline task."
           (end (progn (when task-end (goto-char task-end))
                       (forward-line)
                       (skip-chars-forward " \r\t\n" limit)
-                      (if (eobp) (point) (line-beginning-position))))
-          (inlinetask
-           (org-element-create
-             'inlinetask
-            (nconc
-             (list :raw-value raw-value-deferred
-                   :begin begin
-                   :end end
-                   :pre-blank
-                   (if (not contents-begin) 0
-                     (1- (count-lines begin contents-begin)))
-                   :contents-begin contents-begin
-                   :contents-end contents-end
-                   :level level
-                   :priority priority
-                   :tags tags
-                   :todo-keyword todo
-                   :todo-type todo-type
-                   :post-blank (1- (count-lines (or task-end begin) end))
-                   :post-affiliated begin
-                    :archivedp archivedp
-                   :commentedp commentedp
-                    :secondary (alist-get
-                                'inlinetask
-                                org-element-secondary-value-alist)
-                    :deferred
-                    (and task-end
-                         (org-element-deferred
-                          t #'org-element-headline-parser--deferred))
-                    :buffer (current-buffer))
-             time-props))))
-      (org-element-put-property
-       inlinetask :title
-       (if raw-secondary-p (org-element-deferred-alias :raw-value)
-        (org-element--parse-objects
-         (progn (goto-char title-start)
-                (skip-chars-forward " \t")
-                (point))
-         (progn (goto-char title-end)
-                (skip-chars-backward " \t")
-                (point))
-         nil
-         (org-element-restriction 'inlinetask)
-         inlinetask))))))
+                      (if (eobp) (point) (line-beginning-position)))))
+      (org-element-create
+       'inlinetask
+       (list
+       :begin begin
+       :end end
+       :pre-blank
+       (if (not contents-begin) 0
+         (1- (count-lines begin contents-begin)))
+       :contents-begin contents-begin
+       :contents-end contents-end
+        :buffer (current-buffer)
+        :raw-value deferred-title-prop
+        :title deferred-title-prop
+        :level deferred-title-prop
+       :priority deferred-title-prop
+       :tags deferred-title-prop
+       :todo-keyword deferred-title-prop
+       :todo-type deferred-title-prop
+       :archivedp deferred-title-prop
+       :commentedp deferred-title-prop
+       :post-blank (1- (count-lines (or task-end begin) end))
+       :post-affiliated begin
+        :secondary (alist-get
+                    'inlinetask
+                    org-element-secondary-value-alist)
+        :deferred
+        (and task-end
+             (org-element-deferred-create
+              t #'org-element--headline-deferred)))))))
 
 (defun org-element-inlinetask-interpreter (inlinetask contents)
   "Interpret INLINETASK element as Org syntax.
diff --git a/testing/lisp/test-org-attach.el b/testing/lisp/test-org-attach.el
index 4e37c7cf8c..4f0870bec0 100644
--- a/testing/lisp/test-org-attach.el
+++ b/testing/lisp/test-org-attach.el
@@ -130,11 +130,9 @@
           (search-forward "* foo")
                                        ; expectation.  tag ATTACH has been 
appended.
           (cl-reduce (lambda (x y) (or x y))
-                     (mapcar (lambda (x) (string-equal "ATTACH" x))
-                             (plist-get
-                              (plist-get
-                               (org-element-at-point) 'headline)
-                              :tags))))
+                     (mapcar
+                       (lambda (x) (string-equal "ATTACH" x))
+                       (org-element-property :tags (org-element-at-point)))))
        (delete-file a-filename)))))
 
 (ert-deftest test-org-attach/dired-attach-to-next-best-subtree/2 ()