1.1--- a/emacs/lib/inbox.el	Wed Aug 28 22:08:42 2024 -0400
     1.2+++ b/emacs/lib/inbox.el	Fri Aug 30 21:29:55 2024 -0400
     1.3@@ -89,22 +89,12 @@
     1.4         ("s" "secret" table-line (file+function "krypt" org-ask-location) "| %^{key} | %^{val} |" :immediate-finish t :kill-buffer t)
     1.5         ("N" "note-item" plain (file+function "notes.org" org-ask-location) "%?")))
     1.6 
     1.7-(defun org-insert-logbook-drawer () (org-log-beginning t))
     1.8-
     1.9-;; (add-hook 'org-capture-mode-hook
    1.10-;;           #'org-insert-logbook-drawer)
    1.11-
    1.12 (add-hook 'org-after-todo-state-change-hook #'org-id-get-create)
    1.13 (add-hook 'org-after-todo-state-change-hook #'org-expiry-insert-created)
    1.14 
    1.15-(add-hook 'org-capture-mode-hook
    1.16-  #'org-id-get-create)
    1.17-
    1.18-(add-hook 'org-capture-mode-hook
    1.19-          #'org-expiry-insert-created)
    1.20-
    1.21 (setq org-default-notes-file (join-paths org-directory "inbox.org")
    1.22-      org-capture-use-agenda-date t)
    1.23+      org-capture-use-agenda-date t
    1.24+      org-archive-location "archive.org::")
    1.25 
    1.26 ;;; Utils
    1.27 ;; `org-archive-all-done' doesn't work the way we want. This function
    1.28@@ -128,120 +118,36 @@
    1.29      (org-todo "DONE"))
    1.30    nil 'tree)))
    1.31 
    1.32-(defun org-inbox-migrate ()
    1.33-  "Migrate all sub-headings to the current week heading, archive
    1.34-DONE tasks, and delete the empty previous week heading."
    1.35-  (interactive)
    1.36-  (let ((scope 'tree)
    1.37-        (cur (org-inbox-current-week-heading))
    1.38-        ;; (prev (format-iso-week-number
    1.39-        ;; (float-time (time-subtract (current-time) (days-to-time 7)))))
    1.40-        (pos (save-excursion
    1.41-               (find-file-noselect org-inbox-file)
    1.42-               (org-find-exact-headline-in-buffer
    1.43-                (org-inbox-current-week-heading) nil t))))
    1.44-    (org-archive-done)
    1.45-    (org-map-entries
    1.46-     (lambda ()
    1.47-       (org-refile nil nil (list cur org-inbox-file nil pos))
    1.48-       (setq org-map-continue-from (org-element-property :begin (org-element-at-point)))
    1.49-       (setq pos (org-find-exact-headline-in-buffer cur nil t)))
    1.50-     "LEVEL=2" scope)
    1.51-    (org-inbox-delete-week-heading)))
    1.52-
    1.53-(defun org-inbox-week-heading-p ()
    1.54-  "Check if the heading at point is an org-inbox week heading."
    1.55-  (let ((hd (org-heading-components)))
    1.56-    (when (and (eq (car hd) 1)
    1.57-               (null (caddr hd))
    1.58-               (null (cadddr hd))
    1.59-               (string-match "^w[0-9][0-9]$" (nth 4 hd))
    1.60-               (string-match "^:\\([0-9]\\)\\{4\\}:[A-Z]\\([a-z]\\)\\{2\\}:$" (nth 5 hd)))
    1.61-      t)))
    1.62-
    1.63-(defun org-inbox-current-week-p ()
    1.64-  "Check if the inbox has a heading for current week."
    1.65-  (let ((buf (find-buffer-visiting org-inbox-file)))
    1.66-    (unless buf
    1.67-      (setq buf (find-file-noselect org-inbox-file)))
    1.68-    (save-excursion
    1.69-      (with-current-buffer buf
    1.70-        (goto-char (point-max))
    1.71-        (if (re-search-backward (concat "^* " (format-iso-week-number)) nil t) t)))))
    1.72-
    1.73-(defun org-inbox-delete-week-heading ()
    1.74-  "Delete the week heading at point."
    1.75-  (interactive)
    1.76-  (if (not (org-inbox-week-heading-p))
    1.77-      (if (= (org-current-level) 1)
    1.78-          (message "Failed to find a week heading at point")
    1.79-        (progn (org-up-heading-safe)
    1.80-               (org-inbox-delete-week-heading)))
    1.81-    (progn (org-mark-subtree)
    1.82-           (delete-region (region-beginning) (region-end)))))
    1.83-
    1.84-(defun org-inbox-insert-week-heading ()
    1.85-  "Insert a new heading for the current week.
    1.86-Format:
    1.87-* w01 :2023:Jan:
    1.88-  SCHEDULED: <2023-01-02 Mon>--<2023-01-09 Sun>
    1.89-"
    1.90-  (interactive)
    1.91-  (let ((buf (find-buffer-visiting org-inbox-file)))
    1.92-    (unless buf
    1.93-      (setq buf (find-file-noselect org-inbox-file)))
    1.94-    (save-excursion
    1.95-      (with-current-buffer buf
    1.96-        (goto-char (point-max))
    1.97-        (org-previous-visible-heading 1)
    1.98-        (while (> (org-outline-level) 1)
    1.99-          (outline-up-heading 1))
   1.100-        (let* ((fmt org-inbox-date-start-format)
   1.101-               (date-start
   1.102-                (time-add
   1.103-                 (org-timestamp-to-time
   1.104-                  (org-timestamp-from-string
   1.105-                   (plist-get
   1.106-                    (cadr (org-element-at-point))
   1.107-                    :DATE_START)))
   1.108-                 (days-to-time 7)))
   1.109-               (date-end (format-time-string fmt (last-day-of-week date-start)))
   1.110-               (title (format-iso-week-number date-start))
   1.111-               (elt (org-element-interpret-data
   1.112-                     `(headline
   1.113-                       (:title ,title :level 1 :tags (,(format-time-string "%Y:%b" date-start)))
   1.114-                       (property-drawer nil
   1.115-                                        ((node-property
   1.116-                                          (:key "DATE_START" :value ,(format-time-string fmt date-start)))))))))
   1.117-          (goto-char (point-max))
   1.118-          (newline)
   1.119-          (insert elt)
   1.120-          title)))))
   1.121-
   1.122-(defun org-inbox-current-week-heading ()
   1.123-  "Find the location of the current week heading in
   1.124-  `org-inbox-file'. Create it if it doesn't exist."
   1.125-  (if (org-inbox-current-week-p)
   1.126-      (format-iso-week-number)
   1.127-    (org-inbox-insert-week-heading)))
   1.128+(defmacro with-inbox-buffer (&rest body)
   1.129+  `(save-excursion
   1.130+     (with-current-buffer (find-file org-inbox-file)
   1.131+       ,@body)))
   1.132 
   1.133 (defun org-sort-todo-priority ()
   1.134   "Sorting function used by `org-sort' to sort by todo order
   1.135     followed by priority. Returns a pair of numbers (TODO . PRIO)."
   1.136   (let* ((elt (cadr (org-element-at-point)))
   1.137-         (todo (substring-no-properties (plist-get elt :todo-keyword)))
   1.138-         (prio (plist-get elt :priority))
   1.139+         (todo (when-let ((kw (plist-get elt :todo-keyword)))
   1.140+                 (when (stringp kw)
   1.141+                   (substring-no-properties kw))))
   1.142+         (prio (pcase (plist-get elt :priority)
   1.143+                 ("A" 1)
   1.144+                 ("B" 2)
   1.145+                 ("C" 3)
   1.146+                 (t 2)))
   1.147          (res))
   1.148-    (message "%s %s" todo prio)
   1.149-    (unless prio (setq prio 5))
   1.150     ;; FIXME todo states shouldn't be hardcoded
   1.151     (cond
   1.152-     ((string= todo "GOTO") (setq res (cons 1 prio)))
   1.153+     ((null todo) (setq res (cons 3 prio)))
   1.154+     ((string= todo "WATCH") (setq res (cons 3 prio)))
   1.155+     ((string= todo "WAIT") (setq res (cons 1 prio)))
   1.156+     ((string= todo "HOLD") (setq res (cons 1 prio)))
   1.157+     ((string= todo "WIP") (setq res (cons 1 prio)))
   1.158+     ((string= todo "GOTO") (setq res (cons 2 prio)))
   1.159      ((string= todo "TODO") (setq res (cons 2 prio)))
   1.160-     ((string= todo "WAIT") (setq res (cons 3 prio)))
   1.161-     ((string= todo "HOLD") (setq res (cons 4 prio)))
   1.162-     ((string= todo "DONE") (setq res (cons 5 prio)))
   1.163-     ((string= todo "NOPE") (setq res (cons 6 prio))))
   1.164+     ((string= todo "RESEARCH") (setq res (cons 3 prio)))
   1.165+     ((string= todo "DONE") (setq res (cons 4 prio)))
   1.166+     ((string= todo "NOPE") (setq res (cons 4 prio))))
   1.167     (unless res (setq res (cons 0 prio)))
   1.168     res))
   1.169 
   1.170@@ -255,14 +161,24 @@
   1.171    ((= (car a) (car b))
   1.172     (cond
   1.173      ((< (cdr a) (cdr b)) t)
   1.174-     ((> (cdr a) (cdr b)) nil)
   1.175-     ;; nil ommitted since cond defaults to it
   1.176-     ))))
   1.177+     ((> (cdr a) (cdr b)) nil)))))
   1.178+     
   1.179 
   1.180 (defun org-inbox-sort ()
   1.181   "Sort the current heading by todo order followed by priority."
   1.182   (interactive)
   1.183-  (org-sort-entries nil ?f #'org-sort-todo-priority #'org-sort-compare-todo-priority))
   1.184+  (with-inbox-buffer
   1.185+   (org-sort-entries nil ?f #'org-sort-todo-priority #'org-sort-compare-todo-priority)))
   1.186+
   1.187+(defun org-inbox-compact ()
   1.188+  "Assign missing IDs and creation dates, archive DONE tasks."
   1.189+  (interactive)
   1.190+  (with-inbox-buffer
   1.191+   (org-id-update-id-locations)
   1.192+   (org-id-add-to-headlines-in-file)
   1.193+   (org-archive-done)
   1.194+   (org-map-entries #'org-expiry-insert-created)
   1.195+   (org-inbox-sort)))
   1.196 
   1.197 (defun org-inbox-open ()
   1.198   "Open `org-inbox-file' or switch to its buffer if already open."

     2.1--- a/emacs/lib/ulang.el	Wed Aug 28 22:08:42 2024 -0400
     2.2+++ b/emacs/lib/ulang.el	Fri Aug 30 21:29:55 2024 -0400
     2.3@@ -33,13 +33,14 @@
     2.4 (defvar ulang-link-history nil)
     2.5 (defvar ulang-file-history nil)
     2.6 
     2.7-(defvar ulang-extra-properties
     2.8+;; see org-special-properties
     2.9+(defvar ulang-special-properties
    2.10   '("VERSION"))
    2.11 
    2.12 ;;;###autoload
    2.13 (defun dblock-insert-links (regexp)
    2.14   "Create dblock to insert links matching REGEXP."
    2.15-  (interactive (list (read-regexp "Insert links matching: " nil ulang-links-history)))
    2.16+  (interactive (list (read-regexp "Insert links matching: " nil ulang-link-history)))
    2.17   (org-create-dblock (list :name "links"
    2.18                            :regexp regexp
    2.19                            :id-only nil))
    2.20@@ -143,4 +144,18 @@
    2.21 (message "Initialized ULANG.")
    2.22 
    2.23 (provide 'ulang)
    2.24+;;; Commands
    2.25+
    2.26+;; (org-property-inherit-p "LOCATION")
    2.27+(defun org-follow-location ()
    2.28+  "Open the location specified by the LOCATION property of the org heading
    2.29+or file at point."
    2.30+  (interactive)
    2.31+  (let ((loc (or (org-entry-get-with-inheritance "LOCATION")
    2.32+                 (caadar (org-collect-keywords '("LOCATION") nil '("LOCATION"))))))
    2.33+    (cond
    2.34+     ((string-match-p org-link-any-re loc) (org-link-open-from-string loc))
    2.35+     ;; TODO 2024-08-29: handle other location types (physical, etc)
    2.36+     (t (find-file loc t)))))
    2.37+
    2.38 ;;; ulang.el ends here

     3.1--- a/lisp/user.asd	Wed Aug 28 22:08:42 2024 -0400
     3.2+++ b/lisp/user.asd	Fri Aug 30 21:29:55 2024 -0400
     3.3@@ -3,7 +3,9 @@
     3.4   :depends-on (:std :cli :doc :nlp
     3.5                :obj :skel :syn :organ
     3.6                :packy :parse :pod :rdb
     3.7-               :krypt :gui :aud)
     3.8+               :krypt :gui :aud :net
     3.9+               :krypt :rt :vc :dat
    3.10+               :q :box :log :gui)
    3.11   :components ((:file "user"))
    3.12   :build-operation monolithic-compile-bundle-op
    3.13   :build-pathname "user")