ndwarshuis
/
emacs-config
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

ENH make buffer scanner store title (and use a real regexp matcher)

This commit is contained in:
Nathan Dwarshuis 2022-02-20 12:34:28 -05:00
parent 72eeac0225
commit 9d87f8e685
1 changed files with 58 additions and 63 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

121
local/lib/org-x/org-x-dag.el
View File

@ -216,11 +216,12 @@ that file as it currently sits on disk.")
;; functions to construct nodes within state ;; functions to construct nodes within state
(defun org-x-dag-build-meta (file point level todo tags parent) (defun org-x-dag-build-meta (file point level todo title tags parent)
(list :file file (list :file file
:point point :point point
:level level :level level
:todo todo :todo todo
:title title
:tags tags :tags tags
:buffer-parent parent)) :buffer-parent parent))
@ -897,6 +898,13 @@ A date like (YEAR MONTH DAY).")
(s-split "\n") (s-split "\n")
(--map (cadr (s-match "id:\\([^][]\\{36\\}\\)" it))))))) (--map (cadr (s-match "id:\\([^][]\\{36\\}\\)" it)))))))
(defun org-x-dag-line-regexp (kws)
(let ((level-re "\\(\\*+\\)")
(kw-re (format "\\(%s\\)?" (s-join "\\|" kws)))
(title-re "\\(.*?\\)?")
(tag-re "\\(?:\\([[:alnum:]_@#%%:]+\\):\\)?"))
(format "^%s[ ]+%s%s%s[ ]*$" level-re kw-re title-re tag-re)))
(defun org-x-dag-get-buffer-nodes (file kws) (defun org-x-dag-get-buffer-nodes (file kws)
"Return a list of nodes from FILE. "Return a list of nodes from FILE.
@ -904,6 +912,7 @@ A node will only be returned if the headline to which it points
has a valid (meaning in KWS) keyword and either its parent has a has a valid (meaning in KWS) keyword and either its parent has a
valid keyword or none of its parents have valid keywords." valid keyword or none of its parents have valid keywords."
(let ((more t) (let ((more t)
(line-re (org-x-dag-line-regexp kws))
cur-path this-point this-key this-level this-todo has-todo this-parent cur-path this-point this-key this-level this-todo has-todo this-parent
this-tags this-meta all-tags this-file-links this-links acc acc-meta this-tags this-meta all-tags this-file-links this-links acc acc-meta
this-parent-key) this-parent-key)
@ -911,69 +920,55 @@ valid keyword or none of its parents have valid keywords."
(goto-char (point-min)) (goto-char (point-min))
;; If not on a headline, check for a property drawer with links in it ;; If not on a headline, check for a property drawer with links in it
(unless (= ?* (following-char)) (unless (= ?* (following-char))
;; (setq this-file-links (org-x-dag-get-link-property)))
(setq this-file-links (org-x-dag-get-parent-links))) (setq this-file-links (org-x-dag-get-parent-links)))
;; move forward until on a headline ;; loop through all headlines
(while (and (not (= ?* (following-char))) (= 0 (forward-line 1)))) (while (re-search-forward line-re nil t)
;; Build alist; Keep track of how 'deep' we are in a given org-tree using a ;; Keep track of how 'deep' we are in a given org-tree using a stack. The
;; stack. The stack will have members like (LEVEL KEY) where LEVEL is the ;; stack will have members like (LEVEL KEY TAGS) where LEVEL is the level
;; level of the headline and KEY is the node key if it has a keyword. Only ;; of the headline and KEY is the node key if it has a keyword, and TAGS
;; add a node to the accumulator if it has a keyword, and only include its ;; is a list of tags for the headlines. Only add a node to the accumulator
;; parent headline if the parent also has a keyword (add the link targets ;; if it has a keyword and an ID property, and only include its parent
;; regardless). ;; headline if the parent also has a keyword.
(while more (setq this-point (car (match-data))
(when (= ?* (following-char)) this-level (length (match-string 1))
(setq this-point (point) this-todo (match-string-no-properties 2)
this-key nil) this-tags (-some-> (match-string-no-properties 4)
;; TODO this might be optimizable (split-string ":" t))
;; Get tags (must be done from the first column) this-key nil)
(setq this-tags (org--get-local-tags)) ;; Adjust the stack so that the top headline is the parent of the
;; Get the level if the following char is a space (if it isn't this is ;; current headline
;; actually a bolded object that starts on the first column like (while (and cur-path (<= this-level (nth 0 (car cur-path))))
;; '*blabla*' (!cdr cur-path))
(while (= ?* (following-char)) (forward-char 1)) (setq this-parent (car cur-path)
(when (= 32 (following-char)) this-parent-key (nth 1 this-parent))
(setq this-level (current-column)) ;; Add the current headline to accumulator if it has a keyword, but only
;; Check if the headline has a keyword ;; if its parent has a keyword or none of its parents have keywords
(forward-char 1) (when (and this-todo
(while (not (memq (following-char) '(? ?\n))) (forward-char 1)) (or this-parent-key (--none-p (nth 1 it) cur-path))
(setq this-todo (-> (+ 1 this-point this-level) (setq this-key (org-x-dag-get-local-property "ID")))
(buffer-substring (+ this-point (current-column)))) ;; If parent is not a todo and we want tag inheritance, store all
has-todo (member this-todo kws)) ;; tags above this headline (including file tags)
;; Adjust the stack so that the top headline is the parent of the (setq all-tags (if (and (not this-parent-key) org-use-tag-inheritance)
;; current headline (->> cur-path
(while (and cur-path (<= this-level (nth 0 (car cur-path)))) (--mapcat (nth 2 it))
(!cdr cur-path)) (append this-tags org-file-tags))
(setq this-parent (car cur-path) this-tags)
this-parent-key (nth 1 this-parent)) ;; TODO this could be inherited to make parent linking easier later
;; Add the current headline to accumulator if it has a keyword, but only this-links (or (org-x-dag-get-parent-links)
;; if its parent has a keyword or none of its parents have keywords (when (not this-parent-key) this-file-links))
(when (and has-todo (or this-parent-key (--none-p (nth 1 it) cur-path)) this-meta (org-x-dag-build-meta file
(setq this-key (org-x-dag-get-local-property "ID"))) this-point
;; If parent is not a todo and we want tag inheritance, store all this-level
;; tags above this headline (including file tags) this-todo
(setq all-tags (if (and (not this-parent-key) org-use-tag-inheritance) (match-string-no-properties 3)
(->> cur-path all-tags
(--mapcat (nth 2 it)) this-parent-key))
(append this-tags org-file-tags)) (!cons (cons this-key this-meta) acc-meta)
this-tags) (!cons (cons this-key (append (list (nth 1 this-parent)) this-links))
this-links (or (org-x-dag-get-parent-links) acc))
;;(org-x-dag-get-link-property) ;; Add current headline to stack
(when (not this-parent-key) this-file-links)) (!cons (list this-level this-key this-tags) cur-path))
this-meta (org-x-dag-build-meta file (list (nreverse acc) (nreverse acc-meta))))
this-point
this-level
(substring-no-properties this-todo)
all-tags
this-parent-key))
(!cons (cons this-key this-meta) acc-meta)
(!cons (cons this-key (append (list (nth 1 this-parent)) this-links))
acc))
;; Add current headline to stack
(!cons (list this-level this-key this-tags) cur-path)))
(setq more (= 0 (forward-line 1))))
;; TODO reverse these to make things make sense later?
(list acc acc-meta)))
(defun org-x-dag-get-file-nodes (file) (defun org-x-dag-get-file-nodes (file)
"Return all nodes in FILE in one pass." "Return all nodes in FILE in one pass."