From 59f9c58718c9c4d61784d788808dcca6a27aa260 Mon Sep 17 00:00:00 2001 From: ndwarshuis Date: Sat, 24 Aug 2024 19:09:37 -0400 Subject: [PATCH] WIP test org-ml 6.0.0 --- etc/conf.org | 12 ++++++---- init.el | 2 +- local/lib/org-x/org-x-agg.el | 8 +++---- local/lib/org-x/org-x-const.el | 2 +- local/lib/org-x/org-x-dag.el | 44 +++++++++++++++++----------------- local/lib/org-x/org-x-macs.el | 2 +- local/lib/org-x/org-x.el | 30 ++++++++++++----------- 7 files changed, 52 insertions(+), 48 deletions(-) diff --git a/etc/conf.org b/etc/conf.org index d14b720..e32c603 100644 --- a/etc/conf.org +++ b/etc/conf.org @@ -1784,11 +1784,11 @@ Save all org buffers 1 minute before the hour, then commit whatever I saved. *** stateless configuration =org-ml= provides stateless functions for operating on org buffers. #+BEGIN_SRC emacs-lisp -(use-package org-ml - :straight t - :config - ;; make the match functions super fast with memoization - (setq org-ml-memoize-match-patterns t)) +;; (use-package org-ml +;; :straight t +;; :config +;; ;; make the match functions super fast with memoization +;; (setq org-ml-memoize-match-patterns t)) #+END_SRC *** 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 "dag")) (nd/load-and-compile (nd/expand-lib-directory "org-x")) +(nd/load-and-compile (nd/expand-local-pkg-directory "org-ml")) (require 'dag) (require 'org-x) +(require 'org-ml) #+end_src ** buffer interface *** folding diff --git a/init.el b/init.el index b00e536..a8fdc1c 100644 --- a/init.el +++ b/init.el @@ -14,7 +14,7 @@ (straight-use-package '(org :type 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.el") diff --git a/local/lib/org-x/org-x-agg.el b/local/lib/org-x/org-x-agg.el index 9df7156..12410d6 100644 --- a/local/lib/org-x/org-x-agg.el +++ b/local/lib/org-x/org-x-agg.el @@ -77,7 +77,7 @@ Returns a new timespan." (when timestamp (let ((offset (org-element-property :begin headline)) (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)))) (defun org-x-agg--effort-to-seconds (effort-str) @@ -178,7 +178,7 @@ time of the :start-time property." (cl-flet ((append-unixtime (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))) ;; get conflict headlines @@ -230,7 +230,7 @@ returned." "Return TIMESPANS that conflict with each other. The returned list will be a list of pairs of timespans 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-remove-past) (--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 ;; unless specified manually (-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))) ((y m d H M) start-time*) (start-epoch (encode-float-time `(0 ,M ,H ,d ,m ,y nil nil ,tz))) diff --git a/local/lib/org-x/org-x-const.el b/local/lib/org-x/org-x-const.el index d1b6a86..cd911a3 100644 --- a/local/lib/org-x/org-x-const.el +++ b/local/lib/org-x/org-x-const.el @@ -44,7 +44,7 @@ "Headline todo keyword for canceled task or project.") (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) "Allowed keywords for meetings.") diff --git a/local/lib/org-x/org-x-dag.el b/local/lib/org-x/org-x-dag.el index 0788917..d30130a 100644 --- a/local/lib/org-x/org-x-dag.el +++ b/local/lib/org-x/org-x-dag.el @@ -66,7 +66,7 @@ (defun org-x-dag-timestamp-to-epoch (ts) (->> (org-ml-timestamp-get-start-time ts) - (org-ml-time-to-unixtime))) + (org-ml-timelist-to-unixtime))) ;; calendar interface @@ -91,7 +91,7 @@ (defun org-x-dag-datetimes-same-length-p (datetime0 datetime1) ;; ASSUME all digits in this comparison are on the calendar/clock (eg day 32 ;; 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 ;; Maybe a -> Maybe a -> (a -> a -> b) -> b -> Maybe b @@ -110,7 +110,7 @@ (defun org-x-dag-datetime-split (datetime) ;; TODO this function doesn't guarantee that a short timestamp is properly ;; formatted - (if (org-ml-time-is-long datetime) + (if (org-ml-timelist-has-time datetime) (-split-at 3 datetime) `(,(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) (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) :repeater (org-ml-timestamp-extract-modulus 'repeater 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)) (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) (->> (plist-get pts :datetime) @@ -804,7 +804,7 @@ used for optimization." (-if-let (,c (-some->> it-planning (org-ml-get-property :closed) (org-ml-timestamp-get-start-time) - (org-ml-time-to-unixtime))) + (org-ml-timelist-to-unixtime))) (cond ((equal it-todo org-x-kw-canc) (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 (let ((this-epoch (-some->> deadline (org-ml-timestamp-get-start-time) - (org-ml-time-to-unixtime)))) + (org-ml-timelist-to-unixtime)))) (< parent-epoch this-epoch)))))) (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 (org-ml-get-property :deadline) (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)) :held-parent-p (or h (equal todo org-x-kw-hold)) :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) (org-ml-get-property :scheduled) (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") (-let (((&plist :date d :offset o) date-offset) (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) (string-to-number))) (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")) ((< offset 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) (-let* (((&alist :lifetime l) res) (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) (either :right `(:committed ,l :deadline ,d))))) (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))) (let ((set-dead (org-ml-timestamp-get-start-time to-set))) (cond - ((xor (org-ml-time-is-long this-dead) - (org-ml-time-is-long set-dead)) + ((xor (org-ml-timelist-has-time this-dead) + (org-ml-timelist-has-time set-dead)) (-> "EPG as parent with different deadline precision" (org-x-dag--ns-err nil))) ((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) (-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) "Retrieve timestamp information of ID for sorting agenda views. @@ -2892,7 +2892,7 @@ encountered will be returned." ('warning '(:warning-value :warning-unit :warning-type)) ('repeater '(:repeater-value :repeater-unit :repeater-type)))) (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)) (let ((v (convert-value islongp value unit)) (u (convert-unit unit))) @@ -2944,7 +2944,7 @@ FUTURE-LIMIT in a list." (defun org-x-dag-get-scheduled-at (sel-date 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)) ((future-limit cur) (if islongp @@ -2955,7 +2955,7 @@ FUTURE-LIMIT in a list." (defun org-x-dag-get-deadlines-at (sel-date 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) (if w w (let ((f (if islongp 1440 1))) @@ -3465,14 +3465,14 @@ FUTURE-LIMIT in a list." ;; agenda/calendar (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))) (cl-flet* ((to-interval (duration datetime) - (when (and (< 0 duration) (org-ml-time-is-long datetime)) - (let* ((start (org-ml-time-to-unixtime datetime)) + (when (and (< 0 duration) (org-ml-timelist-has-time datetime)) + (let* ((start (org-ml-timelist-to-unixtime datetime)) (end (+ start duration))) (when (or (and (<= epoch start) (<= start epoch+)) (and (<= epoch- start) (<= epoch end))) @@ -3605,7 +3605,7 @@ FUTURE-LIMIT in a list." (x) (-let* (((&plist :datetime :id) x) (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))))) (format-dtl (fun dtl conflict) @@ -3621,7 +3621,7 @@ FUTURE-LIMIT in a list." (can-conflict-p (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)))))) (with-temp-buffer (org-mode) diff --git a/local/lib/org-x/org-x-macs.el b/local/lib/org-x/org-x-macs.el index 7064568..72c1420 100644 --- a/local/lib/org-x/org-x-macs.el +++ b/local/lib/org-x/org-x-macs.el @@ -66,7 +66,7 @@ nothing." (with-current-buffer buffer (widen) (goto-char pos) - (org-show-context 'agenda) + (org-fold-show-context 'agenda) ,@body ,@get-head-form) ,@update-form diff --git a/local/lib/org-x/org-x.el b/local/lib/org-x/org-x.el index f903a57..b3210d0 100644 --- a/local/lib/org-x/org-x.el +++ b/local/lib/org-x/org-x.el @@ -94,7 +94,7 @@ entire subtrees to save time and ignore tasks") (car) (org-ml-get-property :value) (org-ml-timestamp-get-end-time) - (org-ml-time-to-unixtime)))) + (org-ml-timelist-to-unixtime)))) (cond ((and first-item-ut first-clock-ut (< first-item-ut first-clock-ut)) first-clock-ut) @@ -294,7 +294,7 @@ the epoch time of the timestamp." (org-x-headline-is-closed-p))) (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 headline is tested analogously to `org-x-headline-is-created-p' except tests if the timestamp is in the future. Actual returned @@ -321,11 +321,11 @@ timestamp." (scheduled-ut (-some->> planning (org-ml-get-property :scheduled) (org-ml-timestamp-get-start-time) - (org-ml-time-to-unixtime))) + (org-ml-timelist-to-unixtime))) (deadline-ut (-some->> planning (org-ml-get-property :deadline) (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) (org-2ft)))) ;; 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) "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)) `(-when-let (it (org-x-headline-is-task-p)) (and ,@body t))) @@ -562,7 +562,7 @@ property." (defun org-x-headline-get-meeting-drawer (drawer-name) "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 list of nodes. If none of these conditions are true, return nil." (-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) (car) (org-ml-timestamp-get-start-time) - (org-ml-time-to-unixtime))) + (org-ml-timelist-to-unixtime))) (new-status (cur-status ts) (let ((new (cond @@ -1528,7 +1528,7 @@ ARG and INTERACTIVE are passed to `org-store-link'." (node) (-some->> (org-x-metablock-get-timestamp node) (org-ml-timestamp-get-start-time) - (org-ml-time-to-unixtime) + (org-ml-timelist-to-unixtime) (< (float-time))))) (->> (org-x-parse-file-headlines (org-x-get-daily-plan-file) 'all) (--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) (org-ml-get-property :scheduled) (org-ml-timestamp-get-start-time) - (org-ml-time-to-unixtime)))) + (org-ml-timelist-to-unixtime)))) (when (org-ml-is-type 'plain-list first) (->> (org-ml-get-children first) (--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 CLOSED planning entry (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 (org-ml-match-map* '(section :any * item) (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) (assign-id 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 (* offset (1+ it-index)) unit it)) (-map #'assign-id)))) @@ -1896,7 +1898,7 @@ including those that are inherited." (let ((atodo (org-ml-get-property :todo-keyword headline)) (atime (-> (substring (cdr org-time-stamp-formats) 1 -1) (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_FILE" afile) (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-headline-map-planning* (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 (org-ml-shift-property :level level-shift) (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' function. This is intended to be used as :before-until advice and will return nil if the type is not valid (which is currently -'property')" +`property')" (when (eq type 'property) (-some->> (-map #'org-x-agenda-filter-make-property-matcher-form filter) (cons 'and))))