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

REF rewrite iterator and periodical status functions with while macro

This commit is contained in:
Nathan Dwarshuis 2021-04-18 18:41:43 -04:00
parent 71c9cdceb1
commit cf2b63e276
1 changed files with 23 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -708,36 +708,28 @@ Allowed statuscodes are in list `nd/get-iter-statuscodes.' where
latter codes in the list trump earlier ones." latter codes in the list trump earlier ones."
(let ((cur-status (first org-x-iter-statuscodes)) (let ((cur-status (first org-x-iter-statuscodes))
(breaker-status (-last-item org-x-iter-statuscodes)) (breaker-status (-last-item org-x-iter-statuscodes))
(subtree-end (save-excursion (org-end-of-subtree t)))
(prev-point (point))
(kw nil) (kw nil)
(new-status nil) (new-status nil)
(ts nil)) (ts nil))
(save-excursion (org-x-while-child-headlines (not (eq cur-status breaker-status))
(outline-next-heading) (setq kw (org-x-is-todoitem-p))
(while (and (not (eq cur-status breaker-status)) (when kw
(< prev-point (point) subtree-end)) ;; test if project or atomic task
(setq kw (org-x-is-todoitem-p) ;; assume that there are no todoitems above this headline
new-status nil) ;; to make checking easier
(when kw (setq
;; test if project of atomic task new-status
;; assume that there are no todoitems above this headline (if (org-x-headline-has-children 'org-x-is-todoitem-p)
;; to make checking easier (org-x--clone-get-iterator-project-status kw)
(setq (setq ts (or (org-x-is-scheduled-heading-p)
new-status (org-x-is-deadlined-heading-p)))
(if (org-x-headline-has-children 'org-x-is-todoitem-p) (cond
(org-x--clone-get-iterator-project-status kw) ((member kw org-done-keywords) :empt)
(setq ts (or (org-x-is-scheduled-heading-p) ((not ts) :unscheduled)
(org-x-is-deadlined-heading-p))) ((< org-x-iter-future-time (- ts (float-time))) :actv)
(cond (t :empt))))
((member kw org-done-keywords) :empt) (when (org-x-compare-statuscodes > new-status cur-status org-x-iter-statuscodes)
((not ts) :unscheduled) (setq cur-status new-status))))
((< org-x-iter-future-time (- ts (float-time))) :actv)
(t :empt))))
(when (org-x-compare-statuscodes > new-status cur-status org-x-iter-statuscodes)
(setq cur-status new-status)))
(setq prev-point (point))
(org-forward-heading-same-level 1 t)))
cur-status)) cur-status))
;; periodicals ;; periodicals
@ -767,16 +759,9 @@ latter codes in the list trump earlier ones."
new new
cur-status)))) cur-status))))
(let ((cur-status (first org-x-peri-statuscodes)) (let ((cur-status (first org-x-peri-statuscodes))
(breaker-status (-last-item org-x-peri-statuscodes)) (breaker-status (-last-item org-x-peri-statuscodes)))
(subtree-end (save-excursion (org-end-of-subtree t))) (org-x-while-child-headlines (not (eq cur-status breaker-status))
(prev-point (point))) (setq cur-status (->> (get-ts) (new-status cur-status))))
(save-excursion
(outline-next-heading)
(while (and (not (eq cur-status breaker-status))
(< prev-point (point) subtree-end))
(setq cur-status (->> (get-ts) (new-status cur-status)))
(setq prev-point (point))
(org-forward-heading-same-level 1 t)))
cur-status))) cur-status)))
;; skip functions ;; skip functions
@ -922,6 +907,7 @@ N is the number of clones to produce."
;; marking subtrees ;; marking subtrees
;; put this in terms of org-ml
(defun org-x-mark-subtree-keyword (new-keyword &optional exclude no-log) (defun org-x-mark-subtree-keyword (new-keyword &optional exclude no-log)
"Change the todo keyword of all tasks in a subtree to NEW-KEYWORD. "Change the todo keyword of all tasks in a subtree to NEW-KEYWORD.
If EXCLUDE is given, it should be a list of todo keywords; any headline If EXCLUDE is given, it should be a list of todo keywords; any headline