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.
This commit is contained in:
Ihor Radchenko
parent
a7d1dfa171
commit
a06dc07cc0
|
|
@ -940,7 +940,7 @@ Return value is a plist."
|
||||||
(t (setq plist (plist-put plist :closed time))))))
|
(t (setq plist (plist-put plist :closed time))))))
|
||||||
plist))))
|
plist))))
|
||||||
|
|
||||||
(defun org-element-headline-parser--deferred (element)
|
(defun org-element--headline-deferred (element)
|
||||||
"Parse and set extra properties for ELEMENT headline in BUFFER."
|
"Parse and set extra properties for ELEMENT headline in BUFFER."
|
||||||
(with-current-buffer (org-element-property :buffer element)
|
(with-current-buffer (org-element-property :buffer element)
|
||||||
(org-with-wide-buffer
|
(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."
|
"Retrieve :raw-value in HEADLINE according to BEG-OFFSET and END-OFFSET."
|
||||||
(org-trim (org-element--substring headline beg-offset 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)
|
(defun org-element-headline-parser (&optional _ raw-secondary-p)
|
||||||
"Parse a headline.
|
"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."
|
Assume point is at beginning of the headline."
|
||||||
(save-excursion
|
(save-excursion
|
||||||
(let* ((begin (point))
|
(let* ((deferred-title-prop
|
||||||
(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
|
|
||||||
(org-element-deferred-create
|
(org-element-deferred-create
|
||||||
nil #'org-element--headline-raw-value
|
nil #'org-element--headline-parse-title raw-secondary-p))
|
||||||
(- title-start begin) (- title-end begin)))
|
(begin (point))
|
||||||
(archivedp (if (member org-element-archive-tag tags) t nil))
|
(true-level (skip-chars-forward "*"))
|
||||||
(footnote-section-p (and org-footnote-section
|
|
||||||
(string= org-footnote-section raw-value)))
|
|
||||||
(end
|
(end
|
||||||
(save-excursion
|
(save-excursion
|
||||||
(if (re-search-forward (org-headline-re true-level) nil t)
|
(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)
|
(when (> (- contents-end 2) robust-begin)
|
||||||
(- contents-end 2)))))
|
(- contents-end 2)))))
|
||||||
(unless robust-end (setq robust-begin nil))
|
(unless robust-end (setq robust-begin nil))
|
||||||
(let ((headline
|
(org-element-create
|
||||||
(org-element-create
|
'headline
|
||||||
'headline
|
(list
|
||||||
(list :raw-value raw-value-deferred
|
:begin begin
|
||||||
:begin begin
|
:end end
|
||||||
:end end
|
:pre-blank
|
||||||
:pre-blank
|
(if (not contents-begin) 0
|
||||||
(if (not contents-begin) 0
|
(1- (count-lines begin contents-begin)))
|
||||||
(1- (count-lines begin contents-begin)))
|
:contents-begin contents-begin
|
||||||
:contents-begin contents-begin
|
:contents-end contents-end
|
||||||
:contents-end contents-end
|
:robust-begin robust-begin
|
||||||
:robust-begin robust-begin
|
:robust-end robust-end
|
||||||
:robust-end robust-end
|
:true-level true-level
|
||||||
:true-level true-level
|
:buffer (current-buffer)
|
||||||
:level level
|
:raw-value deferred-title-prop
|
||||||
:priority priority
|
:title deferred-title-prop
|
||||||
:tags tags
|
:level deferred-title-prop
|
||||||
:todo-keyword todo
|
:priority deferred-title-prop
|
||||||
:todo-type todo-type
|
:tags deferred-title-prop
|
||||||
:post-blank
|
:todo-keyword deferred-title-prop
|
||||||
(if contents-end
|
:todo-type deferred-title-prop
|
||||||
(count-lines contents-end end)
|
:post-blank
|
||||||
(1- (count-lines begin end)))
|
(if contents-end
|
||||||
:footnote-section-p footnote-section-p
|
(count-lines contents-end end)
|
||||||
:archivedp archivedp
|
(1- (count-lines begin end)))
|
||||||
:commentedp commentedp
|
:footnote-section-p deferred-title-prop
|
||||||
:post-affiliated begin
|
:archivedp deferred-title-prop
|
||||||
:secondary (alist-get
|
:commentedp deferred-title-prop
|
||||||
'headline
|
:post-affiliated begin
|
||||||
org-element-secondary-value-alist)
|
:secondary (alist-get
|
||||||
:deferred
|
'headline
|
||||||
(org-element-deferred-create
|
org-element-secondary-value-alist)
|
||||||
t #'org-element-headline-parser--deferred)))))
|
:deferred
|
||||||
(org-element-put-property
|
(org-element-deferred-create
|
||||||
headline :title
|
t #'org-element--headline-deferred))))))
|
||||||
(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)))))))
|
|
||||||
|
|
||||||
(defun org-element-headline-interpreter (headline contents)
|
(defun org-element-headline-interpreter (headline contents)
|
||||||
"Interpret HEADLINE element as Org syntax.
|
"Interpret HEADLINE element as Org syntax.
|
||||||
|
|
@ -1273,48 +1315,15 @@ string instead.
|
||||||
|
|
||||||
Assume point is at beginning of the inline task."
|
Assume point is at beginning of the inline task."
|
||||||
(save-excursion
|
(save-excursion
|
||||||
(let* ((begin (point))
|
(let* ((deferred-title-prop
|
||||||
(level (prog1 (org-reduced-level (skip-chars-forward "*"))
|
(org-element-deferred-create
|
||||||
(skip-chars-forward " \t")))
|
nil #'org-element--headline-parse-title raw-secondary-p))
|
||||||
(todo (and org-todo-regexp
|
(begin (point))
|
||||||
(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))
|
|
||||||
(task-end (save-excursion
|
(task-end (save-excursion
|
||||||
(end-of-line)
|
(end-of-line)
|
||||||
(and (re-search-forward org-element-headline-re limit t)
|
(and (re-search-forward org-element-headline-re limit t)
|
||||||
(looking-at-p "[ \t]*END[ \t]*$")
|
(looking-at-p "[ \t]*END[ \t]*$")
|
||||||
(line-beginning-position))))
|
(line-beginning-position))))
|
||||||
(time-props (and task-end (org-element--get-time-properties)))
|
|
||||||
(contents-begin (and task-end
|
(contents-begin (and task-end
|
||||||
(< (point) task-end)
|
(< (point) task-end)
|
||||||
(progn
|
(progn
|
||||||
|
|
@ -1325,50 +1334,36 @@ Assume point is at beginning of the inline task."
|
||||||
(end (progn (when task-end (goto-char task-end))
|
(end (progn (when task-end (goto-char task-end))
|
||||||
(forward-line)
|
(forward-line)
|
||||||
(skip-chars-forward " \r\t\n" limit)
|
(skip-chars-forward " \r\t\n" limit)
|
||||||
(if (eobp) (point) (line-beginning-position))))
|
(if (eobp) (point) (line-beginning-position)))))
|
||||||
(inlinetask
|
(org-element-create
|
||||||
(org-element-create
|
'inlinetask
|
||||||
'inlinetask
|
(list
|
||||||
(nconc
|
:begin begin
|
||||||
(list :raw-value raw-value-deferred
|
:end end
|
||||||
:begin begin
|
:pre-blank
|
||||||
:end end
|
(if (not contents-begin) 0
|
||||||
:pre-blank
|
(1- (count-lines begin contents-begin)))
|
||||||
(if (not contents-begin) 0
|
:contents-begin contents-begin
|
||||||
(1- (count-lines begin contents-begin)))
|
:contents-end contents-end
|
||||||
:contents-begin contents-begin
|
:buffer (current-buffer)
|
||||||
:contents-end contents-end
|
:raw-value deferred-title-prop
|
||||||
:level level
|
:title deferred-title-prop
|
||||||
:priority priority
|
:level deferred-title-prop
|
||||||
:tags tags
|
:priority deferred-title-prop
|
||||||
:todo-keyword todo
|
:tags deferred-title-prop
|
||||||
:todo-type todo-type
|
:todo-keyword deferred-title-prop
|
||||||
:post-blank (1- (count-lines (or task-end begin) end))
|
:todo-type deferred-title-prop
|
||||||
:post-affiliated begin
|
:archivedp deferred-title-prop
|
||||||
:archivedp archivedp
|
:commentedp deferred-title-prop
|
||||||
:commentedp commentedp
|
:post-blank (1- (count-lines (or task-end begin) end))
|
||||||
:secondary (alist-get
|
:post-affiliated begin
|
||||||
'inlinetask
|
:secondary (alist-get
|
||||||
org-element-secondary-value-alist)
|
'inlinetask
|
||||||
:deferred
|
org-element-secondary-value-alist)
|
||||||
(and task-end
|
:deferred
|
||||||
(org-element-deferred
|
(and task-end
|
||||||
t #'org-element-headline-parser--deferred))
|
(org-element-deferred-create
|
||||||
:buffer (current-buffer))
|
t #'org-element--headline-deferred)))))))
|
||||||
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))))))
|
|
||||||
|
|
||||||
(defun org-element-inlinetask-interpreter (inlinetask contents)
|
(defun org-element-inlinetask-interpreter (inlinetask contents)
|
||||||
"Interpret INLINETASK element as Org syntax.
|
"Interpret INLINETASK element as Org syntax.
|
||||||
|
|
|
||||||
|
|
@ -130,11 +130,9 @@
|
||||||
(search-forward "* foo")
|
(search-forward "* foo")
|
||||||
; expectation. tag ATTACH has been appended.
|
; expectation. tag ATTACH has been appended.
|
||||||
(cl-reduce (lambda (x y) (or x y))
|
(cl-reduce (lambda (x y) (or x y))
|
||||||
(mapcar (lambda (x) (string-equal "ATTACH" x))
|
(mapcar
|
||||||
(plist-get
|
(lambda (x) (string-equal "ATTACH" x))
|
||||||
(plist-get
|
(org-element-property :tags (org-element-at-point)))))
|
||||||
(org-element-at-point) 'headline)
|
|
||||||
:tags))))
|
|
||||||
(delete-file a-filename)))))
|
(delete-file a-filename)))))
|
||||||
|
|
||||||
(ert-deftest test-org-attach/dired-attach-to-next-best-subtree/2 ()
|
(ert-deftest test-org-attach/dired-attach-to-next-best-subtree/2 ()
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue