ADD incubator scanner
This commit is contained in:
parent
4cfae73ca2
commit
2c717aa050
|
@ -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)))
|
||||||
|
|
|
@ -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))
|
||||||
|
|
Loading…
Reference in New Issue