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

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
etc/conf.org
View File

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

2
init.el
View File

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

8
local/lib/org-x/org-x-agg.el
View File

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

2
local/lib/org-x/org-x-const.el
View File

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

44
local/lib/org-x/org-x-dag.el
View File

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

2
local/lib/org-x/org-x-macs.el
View File

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

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

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