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

ADD incubator scanner

This commit is contained in:
Nathan Dwarshuis 2022-01-23 12:01:41 -05:00
parent 4cfae73ca2
commit 2c717aa050
2 changed files with 82 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -102,7 +102,7 @@ that file as it currently sits on disk.")
;; )) ;; ))
`(,(org-x-get-lifetime-goal-file) `(,(org-x-get-lifetime-goal-file)
,(org-x-get-endpoint-goal-file) ,(org-x-get-endpoint-goal-file)
,@(org-x-get-action-files))) ,@(org-x-get-action-and-incubator-files)))
(defun org-x-dag-get-md5 (path) (defun org-x-dag-get-md5 (path)
"Get the md5 checksum of PATH." "Get the md5 checksum of PATH."
@ -214,44 +214,50 @@ valid keyword or none of its parents have valid keywords."
(when (= ?* (following-char)) (when (= ?* (following-char))
(setq this-point (point) (setq this-point (point)
this-key nil) this-key nil)
;; TODO this might be optimizable
;; Get tags (must be done from the first column) ;; Get tags (must be done from the first column)
(setq this-tags (org--get-local-tags)) (setq this-tags (org--get-local-tags))
;; Get the level ;; Get the level if the following char is a space (if it isn't this is
;; actually a bolded object that starts on the first column like
;; '*blabla*'
(while (= ?* (following-char)) (forward-char 1)) (while (= ?* (following-char)) (forward-char 1))
(setq this-level (current-column)) (when (= 32 (following-char))
;; Check if the headline has a keyword (setq this-level (current-column))
(forward-char 1) ;; Check if the headline has a keyword
(while (not (memq (following-char) '(? ?\n))) (forward-char 1)) (forward-char 1)
(setq this-todo (-> (+ 1 this-point this-level) (while (not (memq (following-char) '(? ?\n))) (forward-char 1))
(buffer-substring (+ this-point (current-column)))) (setq this-todo (-> (+ 1 this-point this-level)
has-todo (member this-todo kws)) (buffer-substring (+ this-point (current-column))))
;; Adjust the stack so that the top headline is the parent of the has-todo (member this-todo kws))
;; current headline ;; Adjust the stack so that the top headline is the parent of the
(while (and cur-path (<= this-level (nth 0 (car cur-path)))) ;; current headline
(!cdr cur-path)) (while (and cur-path (<= this-level (nth 0 (car cur-path))))
(setq this-parent (car cur-path) (!cdr cur-path))
toplevelp (not (nth 1 this-parent))) (setq this-parent (car cur-path)
;; Add the current headline to accumulator if it has a keyword, but only toplevelp (not (nth 1 this-parent)))
;; if its parent has a keyword or none of its parents have keywords ;; Add the current headline to accumulator if it has a keyword, but only
(when (and has-todo (or (not toplevelp) (--none-p (nth 1 it) cur-path)) ;; if its parent has a keyword or none of its parents have keywords
(setq this-key (org-x-dag-get-local-property "ID"))) (when (and has-todo (or (not toplevelp) (--none-p (nth 1 it) cur-path))
;; If parent is not a todo and we want tag inheritance, store all tags (setq this-key (org-x-dag-get-local-property "ID")))
;; above this headline (sans file-tags which we can get later easily) ;; If parent is not a todo and we want tag inheritance, store all tags
(setq tags (if (and toplevelp org-use-tag-inheritance) ;; above this headline (sans file-tags which we can get later easily)
(->> cur-path (setq tags (if (and toplevelp org-use-tag-inheritance)
(--mapcat (nth 2 it)) (->> cur-path
(append this-tags)) (--mapcat (nth 2 it))
this-tags) (append this-tags))
this-meta (org-x-dag-build-meta file this-tags)
this-point this-meta (org-x-dag-build-meta file
this-level this-point
(substring-no-properties this-todo) this-level
tags (substring-no-properties this-todo)
toplevelp)) tags
(!cons (cons this-key this-meta) acc-meta) toplevelp))
(!cons (cons this-key (-some-> (nth 1 this-parent) (list))) acc)) (!cons (cons this-key this-meta) acc-meta)
;; Add current headline to stack (!cons (cons this-key (append (list (nth 1 this-parent))
(!cons (list this-level this-key this-tags) cur-path)) (org-x-dag-get-link-property)))
acc))
;; Add current headline to stack
(!cons (list this-level this-key this-tags) cur-path)))
(setq more (= 0 (forward-line 1)))) (setq more (= 0 (forward-line 1))))
;; TODO reverse these to make things make sense later? ;; TODO reverse these to make things make sense later?
(list acc acc-meta))) (list acc acc-meta)))
@ -960,23 +966,50 @@ encountered will be returned."
'x-status s))))))))) 'x-status s)))))))))
(org-x-dag-with-files (org-x-get-action-files) (org-x-dag-with-files (org-x-get-action-files)
(org-x-dag-id->is-toplevel-p it) (org-x-dag-id->is-toplevel-p it)
;; TODO this is firing for each key, probably not necessary but whatever,
;; not that slow
(let ((category (org-get-category))) (let ((category (org-get-category)))
(-if-let (project-tasks (org-x-dag-get-task-nodes it)) (-if-let (project-tasks (org-x-dag-get-task-nodes it))
(--map (format-key category nil it) project-tasks) (--map (format-key category nil it) project-tasks)
(list (format-key category t it))))))) (list (format-key category t it)))))))
;; (defun org-x-dag-scan-tags () ;; (defun org-x-dag-partition-children (ids)
;; (let* ((dag org-x-dag) ;; (cl-labels
;; (nodes (org-x-dag-get-toplevel-project-nodes dag))) ;; ((descend
;; (->> (--group-by (org-x-dag-key-get-file (car it)) nodes) ;; (acc children)
;; (--mapcat ;; (-let (((projects tasks) acc))
;; (-let (((path . nodes) it)) ;; (->> (--remove (member (org-x-dag-id-lookup-prop it :todo)
;; (org-x-with-file path ;; (list org-x-kw-canc org-x-kw-hold))
;; (->> (-map #'car nodes) ;; children)
;; (--mapcat ;; (--mapcat (-if-let (cs (org-x-dag-id->headline-children it))
;; (progn ;; (descend `((it ,@projects) (,@tasks)) cs)
;; (goto-char (org-x-dag-key-get-point it)) ;; `((,@projects) (it ,@tasks))))))))
;; (org-x-dag-format-tag-node dag (org-get-tags (point)) it)))))))))) ;; (-reduce-from #'descend nil ids)))
(defun org-x-dag-scan-incubated ()
(cl-flet
((format-key
(category key)
(let ((tags (->> (org-x-dag-get-inherited-tags org-file-tags
(plist-get org-x-dag :dag)
key)
(append (org-x-dag-id-lookup-prop key :tags))
(org-x-dag-collapse-tags))))
(when (member org-x-tag-incubated tags)
(org-x-dag-with-key key
(let* ((sch (org-x-headline-is-scheduled t))
(dead (org-x-headline-is-deadlined t))
(is-project (org-x-dag-id->headline-children key)))
(-> (org-x-dag-format-tag-node category tags key)
(org-add-props nil
'x-project-p is-project
'x-scheduled sch
'x-deadlined dead))))))))
(org-x-dag-with-files (org-x-get-action-and-incubator-files)
(and (org-x-dag-id->is-toplevel-p it)
(not (member (org-x-dag-id-lookup-prop it :todo) org-x-done-keywords)))
(let ((category (org-get-category)))
(list (format-key category it))))))
(defun org-x-dag-get-inherited-tags (init dag key) (defun org-x-dag-get-inherited-tags (init dag key)
(let* ((this-file (org-x-dag-key-get-file key))) (let* ((this-file (org-x-dag-key-get-file key)))

2
local/lib/org-x/org-x.el
View File

@ -2083,7 +2083,7 @@ This includes unchecking all checkboxes, marking keywords as
(org-ml-headline-map-planning* (org-ml-headline-map-planning*
(-some->> it (org-ml-planning-set-timestamp! :closed nil))) (-some->> it (org-ml-planning-set-timestamp! :closed nil)))
;; remove ID property ;; remove ID property
(org-ml-headline-set-node-property "ID" nil) (org-ml-headline-set-node-property "ID" (org-id-new))
;; clear item checkboxes ;; clear item checkboxes
(org-ml-match-map* '(section :any * item) (org-ml-match-map* '(section :any * item)
(org-ml-set-property :checkbox 'off it)) (org-ml-set-property :checkbox 'off it))