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

REF iterator and periodical functions

This commit is contained in:
Nathan Dwarshuis 2021-04-11 00:53:32 -04:00
parent 34d578045d
commit 45d82754ca
1 changed files with 56 additions and 60 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -470,7 +470,7 @@ should be this function again)."
((:empt) ((:empt)
(:project-error :unscheduled :actv)) (:project-error :unscheduled :actv))
(if (member it-kw org-done-keywords) 0 1) (if (member it-kw org-done-keywords) 0 1)
#'org-x--clone-get-iterator-project-status)) org-x--clone-get-iterator-project-status))
;; project with TODO states could be basically any status ;; project with TODO states could be basically any status
((equal kw "TODO") ((equal kw "TODO")
@ -494,30 +494,33 @@ Allowed statuscodes are in list `nd/get-iter-statuscodes.' where
(let ((cur-status (first org-clone-iter-statuscodes)) (let ((cur-status (first org-clone-iter-statuscodes))
(breaker-status (-last-item org-clone-iter-statuscodes)) (breaker-status (-last-item org-clone-iter-statuscodes))
(subtree-end (save-excursion (org-end-of-subtree t))) (subtree-end (save-excursion (org-end-of-subtree t)))
(prev-point (point))) (prev-point (point))
(kw nil)
(new-status nil)
(ts nil))
(save-excursion (save-excursion
(outline-next-heading) (outline-next-heading)
(while (and (not (eq cur-status breaker-status)) (while (and (not (eq cur-status breaker-status))
(< prev-point (point) subtree-end)) (< prev-point (point) subtree-end))
(let ((kw (org-x-is-todoitem-p)) (setq kw (org-x-is-todoitem-p)
(new-status)) new-status nil)
(when kw (when kw
;; test if project of atomic task ;; test if project of atomic task
;; assume that there are no todoitems above this headline ;; assume that there are no todoitems above this headline
;; to make checking easier ;; to make checking easier
(setq (setq
new-status new-status
(if (org-x-headline-has-children 'org-x-is-todoitem-p) (if (org-x-headline-has-children 'org-x-is-todoitem-p)
(org-x--clone-get-iterator-project-status kw) (org-x--clone-get-iterator-project-status kw)
(let ((ts (or (org-x-is-scheduled-heading-p) (setq ts (or (org-x-is-scheduled-heading-p)
(org-x-is-deadlined-heading-p)))) (org-x-is-deadlined-heading-p)))
(cond (cond
((member kw org-done-keywords) :empt) ((member kw org-done-keywords) :empt)
((not ts) :unscheduled) ((not ts) :unscheduled)
((< org-clone-iter-future-time (- ts (float-time))) :actv) ((< org-clone-iter-future-time (- ts (float-time))) :actv)
(t :empt))))) (t :empt))))
(when (org-x-compare-statuscodes > new-status cur-status org-clone-iter-statuscodes) (when (org-x-compare-statuscodes > new-status cur-status org-clone-iter-statuscodes)
(setq cur-status new-status)))) (setq cur-status new-status)))
(setq prev-point (point)) (setq prev-point (point))
(org-forward-heading-same-level 1 t))) (org-forward-heading-same-level 1 t)))
cur-status)) cur-status))
@ -526,46 +529,39 @@ Allowed statuscodes are in list `nd/get-iter-statuscodes.' where
"Get the status of a periodical. "Get the status of a periodical.
Allowed statuscodes are in list `nd/get-peri-statuscodes.' where Allowed statuscodes are in list `nd/get-peri-statuscodes.' where
latter codes in the list trump earlier ones." latter codes in the list trump earlier ones."
(letrec (cl-flet
((max-ts ((get-ts
(lambda () ()
(-some--> (-some->> (org-ml-parse-this-headline)
(org-ml-parse-this-headline) (org-ml-headline-get-contents (list :log-into-drawer org-log-into-drawer
(org-element-map it 'timestamp #'identity) :clock-into-drawer org-clock-into-drawer))
(--filter (org-ml-match '(:first :any * (:and timestamp
(memq (org-element-property :type it) '(active active-range)) (:or (:type 'active)
it) (:type 'active-range)))))
(--map (car)
(--> it (org-ml-timestamp-get-start-time)
(org-timestamp-split-range it t) (org-ml-time-to-unixtime)))
(org-element-property :raw-value it)
(org-2ft it))
it)
(-max it))))
(compare
(lambda (s1 s2)
(if (org-x-compare-statuscodes > s1 s2 org-clone-peri-statuscodes) s1 s2)))
(new-status (new-status
(lambda (ts) (cur-status ts)
(--> (let ((new (cond
ts ((not ts) :unscheduled)
(cond ((< org-clone-peri-future-time (- ts (float-time))) :actv)
((not it) :unscheduled) (t :empt))))
((< org-clone-peri-future-time (- it (float-time))) :actv) (if (org-x-compare-statuscodes > new cur-status org-clone-peri-statuscodes)
(t :empt)) new
(funcall compare it cur-status)))) cur-status))))
(cur-status (first org-clone-peri-statuscodes)) (let ((cur-status (first org-clone-peri-statuscodes))
(breaker-status (-last-item org-clone-peri-statuscodes)) (breaker-status (-last-item org-clone-peri-statuscodes))
(subtree-end (save-excursion (org-end-of-subtree t))) (subtree-end (save-excursion (org-end-of-subtree t)))
(prev-point (point))) (prev-point (point)))
(save-excursion (save-excursion
(outline-next-heading) (outline-next-heading)
(while (and (not (eq cur-status breaker-status)) (while (and (not (eq cur-status breaker-status))
(< prev-point (point) subtree-end)) (< prev-point (point) subtree-end))
(setq cur-status (->> (funcall max-ts) (funcall new-status))) (setq cur-status (->> (get-ts) (new-status cur-status)))
(setq prev-point (point)) (setq prev-point (point))
(org-forward-heading-same-level 1 t))) (org-forward-heading-same-level 1 t)))
cur-status)) cur-status)))
;; skip functions ;; skip functions