WIP test org-ml 6.0.0

This commit is contained in:
Nathan Dwarshuis 2024-08-24 19:09:37 -04:00
parent c1db214e70
commit 59f9c58718
7 changed files with 52 additions and 48 deletions

View File

@ -1784,11 +1784,11 @@ Save all org buffers 1 minute before the hour, then commit whatever I saved.
*** stateless configuration *** stateless configuration
=org-ml= provides stateless functions for operating on org buffers. =org-ml= provides stateless functions for operating on org buffers.
#+BEGIN_SRC emacs-lisp #+BEGIN_SRC emacs-lisp
(use-package org-ml ;; (use-package org-ml
:straight t ;; :straight t
:config ;; :config
;; make the match functions super fast with memoization ;; ;; make the match functions super fast with memoization
(setq org-ml-memoize-match-patterns t)) ;; (setq org-ml-memoize-match-patterns t))
#+END_SRC #+END_SRC
*** personal library *** personal library
@ -1804,9 +1804,11 @@ The advantage of doing it this way is that I can byte-compile and test independe
(nd/load-and-compile (nd/expand-lib-directory "interval")) (nd/load-and-compile (nd/expand-lib-directory "interval"))
(nd/load-and-compile (nd/expand-lib-directory "dag")) (nd/load-and-compile (nd/expand-lib-directory "dag"))
(nd/load-and-compile (nd/expand-lib-directory "org-x")) (nd/load-and-compile (nd/expand-lib-directory "org-x"))
(nd/load-and-compile (nd/expand-local-pkg-directory "org-ml"))
(require 'dag) (require 'dag)
(require 'org-x) (require 'org-x)
(require 'org-ml)
#+end_src #+end_src
** buffer interface ** buffer interface
*** folding *** folding

View File

@ -14,7 +14,7 @@
(straight-use-package (straight-use-package
'(org :type git '(org :type git
:repo "git://git.savannah.gnu.org/emacs/org-mode.git" :repo "git://git.savannah.gnu.org/emacs/org-mode.git"
:branch "release_9.7.3")) :branch "release_9.7.9"))
;;(load-file "~/.config/emacs/straight/repos/org/lisp/org-element-ast.el") ;;(load-file "~/.config/emacs/straight/repos/org/lisp/org-element-ast.el")
;;(load-file "~/.config/emacs/straight/repos/org/lisp/org-element.el") ;;(load-file "~/.config/emacs/straight/repos/org/lisp/org-element.el")

View File

@ -77,7 +77,7 @@ Returns a new timespan."
(when timestamp (when timestamp
(let ((offset (org-element-property :begin headline)) (let ((offset (org-element-property :begin headline))
(start-time (org-ml-timestamp-get-start-time timestamp)) (start-time (org-ml-timestamp-get-start-time timestamp))
(range (org-ml-timestamp-get-range timestamp))) (range (org-ml-timestamp-get-length timestamp)))
(org-x-agg--make-timespan start-time range offset filepath)))) (org-x-agg--make-timespan start-time range offset filepath))))
(defun org-x-agg--effort-to-seconds (effort-str) (defun org-x-agg--effort-to-seconds (effort-str)
@ -178,7 +178,7 @@ time of the :start-time property."
(cl-flet (cl-flet
((append-unixtime ((append-unixtime
(span) (span)
`(:unixtime ,(org-ml-time-to-unixtime (plist-get span :start-time)) ,@span))) `(:unixtime ,(org-ml-timelist-to-unixtime (plist-get span :start-time)) ,@span)))
(-map #'append-unixtime timespans))) (-map #'append-unixtime timespans)))
;; get conflict headlines ;; get conflict headlines
@ -230,7 +230,7 @@ returned."
"Return TIMESPANS that conflict with each other. "Return TIMESPANS that conflict with each other.
The returned list will be a list of pairs of timespans The returned list will be a list of pairs of timespans
like (SPAN-a SPAN-b) which are two timespans that conflict." like (SPAN-a SPAN-b) which are two timespans that conflict."
(->> (--filter (org-ml-time-is-long (plist-get it :start-time)) timespans) (->> (--filter (org-ml-timelist-has-time (plist-get it :start-time)) timespans)
(org-x-agg--timespans-append-unixtime) (org-x-agg--timespans-append-unixtime)
(org-x-agg--timespans-remove-past) (org-x-agg--timespans-remove-past)
(--sort (< (plist-get it :unixtime) (plist-get other :unixtime))) (--sort (< (plist-get it :unixtime) (plist-get other :unixtime)))
@ -265,7 +265,7 @@ like (SPAN-a SPAN-b) which are two timespans that conflict."
;; `encode-time' and `decode-time' might not use the right time zone ;; `encode-time' and `decode-time' might not use the right time zone
;; unless specified manually ;; unless specified manually
(-let* ((tz (current-time-zone)) (-let* ((tz (current-time-zone))
(start-time* (if (org-ml-time-is-long start-time) start-time (start-time* (if (org-ml-timelist-has-time start-time) start-time
`(,@(-take 3 start-time) 0 0))) `(,@(-take 3 start-time) 0 0)))
((y m d H M) start-time*) ((y m d H M) start-time*)
(start-epoch (encode-float-time `(0 ,M ,H ,d ,m ,y nil nil ,tz))) (start-epoch (encode-float-time `(0 ,M ,H ,d ,m ,y nil nil ,tz)))

View File

@ -44,7 +44,7 @@
"Headline todo keyword for canceled task or project.") "Headline todo keyword for canceled task or project.")
(defconst org-x-done-keywords `(,org-x-kw-done ,org-x-kw-canc) (defconst org-x-done-keywords `(,org-x-kw-done ,org-x-kw-canc)
"Headline todo keywords that mark a task as 'complete'.") "Headline todo keywords that mark a task as `complete'.")
(defconst org-x-meeting-keywords (cons org-x-kw-todo org-x-done-keywords) (defconst org-x-meeting-keywords (cons org-x-kw-todo org-x-done-keywords)
"Allowed keywords for meetings.") "Allowed keywords for meetings.")

View File

@ -66,7 +66,7 @@
(defun org-x-dag-timestamp-to-epoch (ts) (defun org-x-dag-timestamp-to-epoch (ts)
(->> (org-ml-timestamp-get-start-time ts) (->> (org-ml-timestamp-get-start-time ts)
(org-ml-time-to-unixtime))) (org-ml-timelist-to-unixtime)))
;; calendar interface ;; calendar interface
@ -91,7 +91,7 @@
(defun org-x-dag-datetimes-same-length-p (datetime0 datetime1) (defun org-x-dag-datetimes-same-length-p (datetime0 datetime1)
;; ASSUME all digits in this comparison are on the calendar/clock (eg day 32 ;; ASSUME all digits in this comparison are on the calendar/clock (eg day 32
;; does not 'rollover' to day 1 on the next month) ;; does not 'rollover' to day 1 on the next month)
(not (xor (org-ml-time-is-long datetime0) (org-ml-time-is-long datetime1)))) (not (xor (org-ml-timelist-has-time datetime0) (org-ml-timelist-has-time datetime1))))
;; TODO some of this is redundant because I'm checking the length twice ;; TODO some of this is redundant because I'm checking the length twice
;; Maybe a -> Maybe a -> (a -> a -> b) -> b -> Maybe b ;; Maybe a -> Maybe a -> (a -> a -> b) -> b -> Maybe b
@ -110,7 +110,7 @@
(defun org-x-dag-datetime-split (datetime) (defun org-x-dag-datetime-split (datetime)
;; TODO this function doesn't guarantee that a short timestamp is properly ;; TODO this function doesn't guarantee that a short timestamp is properly
;; formatted ;; formatted
(if (org-ml-time-is-long datetime) (if (org-ml-timelist-has-time datetime)
(-split-at 3 datetime) (-split-at 3 datetime)
`(,(org-x-dag-datetime-to-date datetime) nil))) `(,(org-x-dag-datetime-to-date datetime) nil)))
@ -403,7 +403,7 @@ relative shift in days from ABS."
(defun org-x-dag-partition-timestamp (ts) (defun org-x-dag-partition-timestamp (ts)
(list :datetime (org-ml-timestamp-get-start-time ts) (list :datetime (org-ml-timestamp-get-start-time ts)
:length (org-ml-timestamp-get-range ts) :length (org-ml-timestamp-get-length ts)
:pos (org-ml-get-property :begin ts) :pos (org-ml-get-property :begin ts)
:repeater (org-ml-timestamp-extract-modulus 'repeater ts) :repeater (org-ml-timestamp-extract-modulus 'repeater ts)
:warning (org-ml-timestamp-extract-modulus 'warning ts))) :warning (org-ml-timestamp-extract-modulus 'warning ts)))
@ -427,7 +427,7 @@ relative shift in days from ABS."
(-max-by #'org-x-dag-pts> ps)) (-max-by #'org-x-dag-pts> ps))
(defun org-x-dag-pts-is-long-p (pts) (defun org-x-dag-pts-is-long-p (pts)
(org-ml-time-is-long (plist-get pts :datetime))) (org-ml-timelist-has-time (plist-get pts :datetime)))
(defun org-x-dag-pts-to-epoch (pts) (defun org-x-dag-pts-to-epoch (pts)
(->> (plist-get pts :datetime) (->> (plist-get pts :datetime)
@ -804,7 +804,7 @@ used for optimization."
(-if-let (,c (-some->> it-planning (-if-let (,c (-some->> it-planning
(org-ml-get-property :closed) (org-ml-get-property :closed)
(org-ml-timestamp-get-start-time) (org-ml-timestamp-get-start-time)
(org-ml-time-to-unixtime))) (org-ml-timelist-to-unixtime)))
(cond (cond
((equal it-todo org-x-kw-canc) ((equal it-todo org-x-kw-canc)
(let ((it-comptime (complete-time ,c t))) (let ((it-comptime (complete-time ,c t)))
@ -852,7 +852,7 @@ deadline (eg via epoch time) or if it has a repeater."
(if (car (org-ml-timestamp-get-repeater deadline)) t (if (car (org-ml-timestamp-get-repeater deadline)) t
(let ((this-epoch (-some->> deadline (let ((this-epoch (-some->> deadline
(org-ml-timestamp-get-start-time) (org-ml-timestamp-get-start-time)
(org-ml-time-to-unixtime)))) (org-ml-timelist-to-unixtime))))
(< parent-epoch this-epoch)))))) (< parent-epoch this-epoch))))))
(defun org-x-dag-bs-action-project-inner (node-data ancestry child-bss) (defun org-x-dag-bs-action-project-inner (node-data ancestry child-bss)
@ -1298,7 +1298,7 @@ deadline (eg via epoch time) or if it has a repeater."
(deadline (-some->> planning (deadline (-some->> planning
(org-ml-get-property :deadline) (org-ml-get-property :deadline)
(org-ml-timestamp-get-start-time) (org-ml-timestamp-get-start-time)
(org-ml-time-to-unixtime)))) (org-ml-timelist-to-unixtime))))
(list :canceled-parent-p (or c (equal todo org-x-kw-canc)) (list :canceled-parent-p (or c (equal todo org-x-kw-canc))
:held-parent-p (or h (equal todo org-x-kw-hold)) :held-parent-p (or h (equal todo org-x-kw-hold))
:parent-deadline (cond :parent-deadline (cond
@ -1526,7 +1526,7 @@ deadline (eg via epoch time) or if it has a repeater."
(-if-let (sched (-some->> (plist-get m :planning) (-if-let (sched (-some->> (plist-get m :planning)
(org-ml-get-property :scheduled) (org-ml-get-property :scheduled)
(org-ml-timestamp-get-start-time))) (org-ml-timestamp-get-start-time)))
(if (org-ml-time-is-long sched) (if (org-ml-timelist-has-time sched)
(either :left "WKP branch node must be short scheduled") (either :left "WKP branch node must be short scheduled")
(-let (((&plist :date d :offset o) date-offset) (-let (((&plist :date d :offset o) date-offset)
(this-abs (org-x-dag-date-to-absolute sched))) (this-abs (org-x-dag-date-to-absolute sched)))
@ -1557,7 +1557,7 @@ deadline (eg via epoch time) or if it has a repeater."
(offset (->> (alist-get org-x-prop-week-len props nil nil #'equal) (offset (->> (alist-get org-x-prop-week-len props nil nil #'equal)
(string-to-number))) (string-to-number)))
(ancestry (cond (ancestry (cond
((or (not datetime) (org-ml-time-is-long datetime)) ((or (not datetime) (org-ml-timelist-has-time datetime))
(either :left "WKP root nodes must be short scheduled")) (either :left "WKP root nodes must be short scheduled"))
((< offset 1) ((< offset 1)
(either :left "WKP root week length must be an int >= 1")) (either :left "WKP root week length must be an int >= 1"))
@ -1811,7 +1811,7 @@ denoted by CUR-KEY with any errors that are found."
(lambda (id this-h res) (lambda (id this-h res)
(-let* (((&alist :lifetime l) res) (-let* (((&alist :lifetime l) res)
(d (org-x-dag-adjlist-id-planning adjlist :deadline id)) (d (org-x-dag-adjlist-id-planning adjlist :deadline id))
(ns (if (car (org-ml-timestamp-get-repeater d)) (ns (if (and d (car (org-ml-timestamp-get-repeater d)))
(org-x-dag--ns-err "EPG has deadline with repeater" nil) (org-x-dag--ns-err "EPG has deadline with repeater" nil)
(either :right `(:committed ,l :deadline ,d))))) (either :right `(:committed ,l :deadline ,d)))))
(ht-set this-h id ns) (ht-set this-h id ns)
@ -2044,8 +2044,8 @@ DEF-FUN and the output from GET-FUN (type :: a -> NS)."
(org-ml-timestamp-get-start-time))) (org-ml-timestamp-get-start-time)))
(let ((set-dead (org-ml-timestamp-get-start-time to-set))) (let ((set-dead (org-ml-timestamp-get-start-time to-set)))
(cond (cond
((xor (org-ml-time-is-long this-dead) ((xor (org-ml-timelist-has-time this-dead)
(org-ml-time-is-long set-dead)) (org-ml-timelist-has-time set-dead))
(-> "EPG as parent with different deadline precision" (-> "EPG as parent with different deadline precision"
(org-x-dag--ns-err nil))) (org-x-dag--ns-err nil)))
((org-x-dag-datetime< set-dead this-dead) ((org-x-dag-datetime< set-dead this-dead)
@ -2599,7 +2599,7 @@ highest in the tree."
(defun org-x-dag-id->planning-epoch (which id) (defun org-x-dag-id->planning-epoch (which id)
(-some->> (org-x-dag-id->planning-datetime which id) (-some->> (org-x-dag-id->planning-datetime which id)
(org-ml-time-to-unixtime))) (org-ml-timelist-to-unixtime)))
(defun org-x-dag-id->agenda-timestamp (id) (defun org-x-dag-id->agenda-timestamp (id)
"Retrieve timestamp information of ID for sorting agenda views. "Retrieve timestamp information of ID for sorting agenda views.
@ -2892,7 +2892,7 @@ encountered will be returned."
('warning '(:warning-value :warning-unit :warning-type)) ('warning '(:warning-value :warning-unit :warning-type))
('repeater '(:repeater-value :repeater-unit :repeater-type)))) ('repeater '(:repeater-value :repeater-unit :repeater-type))))
(islongp (->> (org-ml-timestamp-get-start-time ts) (islongp (->> (org-ml-timestamp-get-start-time ts)
(org-ml-time-is-long)))) (org-ml-timelist-has-time))))
(-when-let ((value unit type) (org-ml-get-properties props ts)) (-when-let ((value unit type) (org-ml-get-properties props ts))
(let ((v (convert-value islongp value unit)) (let ((v (convert-value islongp value unit))
(u (convert-unit unit))) (u (convert-unit unit)))
@ -2944,7 +2944,7 @@ FUTURE-LIMIT in a list."
(defun org-x-dag-get-scheduled-at (sel-date pts) (defun org-x-dag-get-scheduled-at (sel-date pts)
(-let* (((&plist :datetime d :repeater r) pts) (-let* (((&plist :datetime d :repeater r) pts)
(islongp (org-ml-time-is-long d)) (islongp (org-ml-timelist-has-time d))
(sel-date+ (org-x-dag-datetime-shift sel-date 1 'submonth)) (sel-date+ (org-x-dag-datetime-shift sel-date 1 'submonth))
((future-limit cur) ((future-limit cur)
(if islongp (if islongp
@ -2955,7 +2955,7 @@ FUTURE-LIMIT in a list."
(defun org-x-dag-get-deadlines-at (sel-date pts) (defun org-x-dag-get-deadlines-at (sel-date pts)
(-let* (((&plist :datetime d :repeater r :warning w) pts) (-let* (((&plist :datetime d :repeater r :warning w) pts)
(islongp (org-ml-time-is-long d)) (islongp (org-ml-timelist-has-time d))
((warn-shift warn-shifttype) ((warn-shift warn-shifttype)
(if w w (if w w
(let ((f (if islongp 1440 1))) (let ((f (if islongp 1440 1)))
@ -3465,14 +3465,14 @@ FUTURE-LIMIT in a list."
;; agenda/calendar ;; agenda/calendar
(defun org-x-dag-show-gaps (sel-date ids) (defun org-x-dag-show-gaps (sel-date ids)
(let* ((epoch (org-ml-time-to-unixtime sel-date)) (let* ((epoch (org-ml-timelist-to-unixtime sel-date))
(epoch+ (+ epoch 86400)) (epoch+ (+ epoch 86400))
(epoch- (- epoch 86400))) (epoch- (- epoch 86400)))
(cl-flet* (cl-flet*
((to-interval ((to-interval
(duration datetime) (duration datetime)
(when (and (< 0 duration) (org-ml-time-is-long datetime)) (when (and (< 0 duration) (org-ml-timelist-has-time datetime))
(let* ((start (org-ml-time-to-unixtime datetime)) (let* ((start (org-ml-timelist-to-unixtime datetime))
(end (+ start duration))) (end (+ start duration)))
(when (or (and (<= epoch start) (<= start epoch+)) (when (or (and (<= epoch start) (<= start epoch+))
(and (<= epoch- start) (<= epoch end))) (and (<= epoch- start) (<= epoch end)))
@ -3605,7 +3605,7 @@ FUTURE-LIMIT in a list."
(x) (x)
(-let* (((&plist :datetime :id) x) (-let* (((&plist :datetime :id) x)
(duration (or (org-x-dag-id->duration id) 0)) (duration (or (org-x-dag-id->duration id) 0))
(start (org-ml-time-to-unixtime datetime))) (start (org-ml-timelist-to-unixtime datetime)))
`(,start ,(+ start (* 60 duration))))) `(,start ,(+ start (* 60 duration)))))
(format-dtl (format-dtl
(fun dtl conflict) (fun dtl conflict)
@ -3621,7 +3621,7 @@ FUTURE-LIMIT in a list."
(can-conflict-p (can-conflict-p
(dtl) (dtl)
(-let (((&plist :datetime :id) dtl)) (-let (((&plist :datetime :id) dtl))
(and (org-ml-time-is-long datetime) (and (org-ml-timelist-has-time datetime)
(not (org-x-dag-id->is-done-p id)))))) (not (org-x-dag-id->is-done-p id))))))
(with-temp-buffer (with-temp-buffer
(org-mode) (org-mode)

View File

@ -66,7 +66,7 @@ nothing."
(with-current-buffer buffer (with-current-buffer buffer
(widen) (widen)
(goto-char pos) (goto-char pos)
(org-show-context 'agenda) (org-fold-show-context 'agenda)
,@body ,@body
,@get-head-form) ,@get-head-form)
,@update-form ,@update-form

View File

@ -94,7 +94,7 @@ entire subtrees to save time and ignore tasks")
(car) (car)
(org-ml-get-property :value) (org-ml-get-property :value)
(org-ml-timestamp-get-end-time) (org-ml-timestamp-get-end-time)
(org-ml-time-to-unixtime)))) (org-ml-timelist-to-unixtime))))
(cond (cond
((and first-item-ut first-clock-ut (< first-item-ut first-clock-ut)) ((and first-item-ut first-clock-ut (< first-item-ut first-clock-ut))
first-clock-ut) first-clock-ut)
@ -294,7 +294,7 @@ the epoch time of the timestamp."
(org-x-headline-is-closed-p))) (org-x-headline-is-closed-p)))
(defun org-x-headline-is-created-in-future () (defun org-x-headline-is-created-in-future ()
"Return non-nil if current headline was 'created' in the future. "Return non-nil if current headline was \"created\" in the future.
This should not happen and is an error if it does, and the This should not happen and is an error if it does, and the
headline is tested analogously to `org-x-headline-is-created-p' headline is tested analogously to `org-x-headline-is-created-p'
except tests if the timestamp is in the future. Actual returned except tests if the timestamp is in the future. Actual returned
@ -321,11 +321,11 @@ timestamp."
(scheduled-ut (-some->> planning (scheduled-ut (-some->> planning
(org-ml-get-property :scheduled) (org-ml-get-property :scheduled)
(org-ml-timestamp-get-start-time) (org-ml-timestamp-get-start-time)
(org-ml-time-to-unixtime))) (org-ml-timelist-to-unixtime)))
(deadline-ut (-some->> planning (deadline-ut (-some->> planning
(org-ml-get-property :deadline) (org-ml-get-property :deadline)
(org-ml-timestamp-get-start-time) (org-ml-timestamp-get-start-time)
(org-ml-time-to-unixtime))) (org-ml-timelist-to-unixtime)))
(created-ut (-some->> (org-ml-headline-get-node-property org-x-prop-created hl) (created-ut (-some->> (org-ml-headline-get-node-property org-x-prop-created hl)
(org-2ft)))) (org-2ft))))
;; not inert if headline is scheduled or deadlined in the future ;; not inert if headline is scheduled or deadlined in the future
@ -504,7 +504,7 @@ property."
(defmacro org-x-headline-is-task-with-p (&rest body) (defmacro org-x-headline-is-task-with-p (&rest body)
"Return t if all of BODY is t on the current headline. "Return t if all of BODY is t on the current headline.
'it' is bound to the keyword (if any)." `it' is bound to the keyword (if any)."
(declare (indent 0)) (declare (indent 0))
`(-when-let (it (org-x-headline-is-task-p)) `(-when-let (it (org-x-headline-is-task-p))
(and ,@body t))) (and ,@body t)))
@ -562,7 +562,7 @@ property."
(defun org-x-headline-get-meeting-drawer (drawer-name) (defun org-x-headline-get-meeting-drawer (drawer-name)
"Return DRAWER-NAME under current headline. "Return DRAWER-NAME under current headline.
If drawer is present but has no children, return 'none'. If If drawer is present but has no children, return `none'. If
drawer is present and has a plain-list, return its items as a drawer is present and has a plain-list, return its items as a
list of nodes. If none of these conditions are true, return nil." list of nodes. If none of these conditions are true, return nil."
(-when-let (d (->> (org-ml-parse-this-headline) (-when-let (d (->> (org-ml-parse-this-headline)
@ -1281,7 +1281,7 @@ latter codes in the list trump earlier ones."
(org-ml-match org-x--first-active-ts-pattern) (org-ml-match org-x--first-active-ts-pattern)
(car) (car)
(org-ml-timestamp-get-start-time) (org-ml-timestamp-get-start-time)
(org-ml-time-to-unixtime))) (org-ml-timelist-to-unixtime)))
(new-status (new-status
(cur-status ts) (cur-status ts)
(let ((new (cond (let ((new (cond
@ -1528,7 +1528,7 @@ ARG and INTERACTIVE are passed to `org-store-link'."
(node) (node)
(-some->> (org-x-metablock-get-timestamp node) (-some->> (org-x-metablock-get-timestamp node)
(org-ml-timestamp-get-start-time) (org-ml-timestamp-get-start-time)
(org-ml-time-to-unixtime) (org-ml-timelist-to-unixtime)
(< (float-time))))) (< (float-time)))))
(->> (org-x-parse-file-headlines (org-x-get-daily-plan-file) 'all) (->> (org-x-parse-file-headlines (org-x-get-daily-plan-file) 'all)
(--filter (null (org-ml-headline-get-subheadlines it))) (--filter (null (org-ml-headline-get-subheadlines it)))
@ -1614,7 +1614,7 @@ ARG and INTERACTIVE are passed to `org-store-link'."
(ts (-some->> (org-ml-headline-get-planning headline) (ts (-some->> (org-ml-headline-get-planning headline)
(org-ml-get-property :scheduled) (org-ml-get-property :scheduled)
(org-ml-timestamp-get-start-time) (org-ml-timestamp-get-start-time)
(org-ml-time-to-unixtime)))) (org-ml-timelist-to-unixtime))))
(when (org-ml-is-type 'plain-list first) (when (org-ml-is-type 'plain-list first)
(->> (org-ml-get-children first) (->> (org-ml-get-children first)
(--map (org-x--make-agenda-metaitem headline is-closed ts it)))))) (--map (org-x--make-agenda-metaitem headline is-closed ts it))))))
@ -1723,7 +1723,8 @@ This includes unchecking all checkboxes, marking keywords as
(--remove (org-x--is-drawer-with-name org-x-drwr-agenda it)))) (--remove (org-x--is-drawer-with-name org-x-drwr-agenda it))))
;; remove CLOSED planning entry ;; remove CLOSED planning entry
(org-ml-headline-map-planning* (org-ml-headline-map-planning*
(-some->> it (org-ml-planning-set-timestamp! :closed nil))) (plist-put it :closed nil))
;; (-some->> it (org-ml-planning-set-timestamp! :closed nil)))
;; 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))
@ -1785,7 +1786,8 @@ timestamp in the contents of the headline will be shifted."
(--map-when (org-ml-get-property :todo-keyword it) (--map-when (org-ml-get-property :todo-keyword it)
(assign-id it) (assign-id it)
it))))) it)))))
(->> (org-ml-clone-node-n n headline) (->> (-repeat n headline)
(--map (org-element-copy it t))
(--map-indexed (org-x--subtree-shift-timestamps (--map-indexed (org-x--subtree-shift-timestamps
(* offset (1+ it-index)) unit it)) (* offset (1+ it-index)) unit it))
(-map #'assign-id)))) (-map #'assign-id))))
@ -1896,7 +1898,7 @@ including those that are inherited."
(let ((atodo (org-ml-get-property :todo-keyword headline)) (let ((atodo (org-ml-get-property :todo-keyword headline))
(atime (-> (substring (cdr org-time-stamp-formats) 1 -1) (atime (-> (substring (cdr org-time-stamp-formats) 1 -1)
(format-time-string)))) (format-time-string))))
(->> (org-ml-clone-node headline) (->> (org-element-copy headline t)
(org-ml-headline-set-node-property "ARCHIVE_TIME" atime) (org-ml-headline-set-node-property "ARCHIVE_TIME" atime)
(org-ml-headline-set-node-property "ARCHIVE_FILE" afile) (org-ml-headline-set-node-property "ARCHIVE_FILE" afile)
(org-ml-headline-set-node-property "ARCHIVE_OLPATH" apath) (org-ml-headline-set-node-property "ARCHIVE_OLPATH" apath)
@ -1936,7 +1938,7 @@ and slow."
(org-ml-set-property :todo-keyword org-x-kw-done) (org-ml-set-property :todo-keyword org-x-kw-done)
(org-ml-headline-map-planning* (org-ml-headline-map-planning*
(let ((time (org-ml-unixtime-to-time-long (float-time)))) (let ((time (org-ml-unixtime-to-time-long (float-time))))
(org-ml-planning-set-timestamp! :closed time it))) (plist-put it :closed time)))
;; shift it to the top level ;; shift it to the top level
(org-ml-shift-property :level level-shift) (org-ml-shift-property :level level-shift)
(org-ml-match-map* '(:any * headline) (org-ml-match-map* '(:any * headline)
@ -2127,7 +2129,7 @@ This will return matching matcher form for FILTER and TYPE
where TYPE is not in the regular `org-agenda-filter-make-matcher' where TYPE is not in the regular `org-agenda-filter-make-matcher'
function. This is intended to be used as :before-until advice and function. This is intended to be used as :before-until advice and
will return nil if the type is not valid (which is currently will return nil if the type is not valid (which is currently
'property')" `property')"
(when (eq type 'property) (when (eq type 'property)
(-some->> (-map #'org-x-agenda-filter-make-property-matcher-form filter) (-some->> (-map #'org-x-agenda-filter-make-property-matcher-form filter)
(cons 'and)))) (cons 'and))))