WIP test org-ml 6.0.0

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
+;; (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
 *** 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

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")
 

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)))

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.")

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)
+             ((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"
                   (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))
+          (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)))
               (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)

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

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))))