# HG changeset patch
# User Richard Westhaver <ellis@rwest.io>
# Date 1726366386 14400
# Node ID af486e0a40c9d1cabed4adf051943ff885c2c3da
# Parent  692dfd7f02d067b9e1b8ca65de40afcb3db03237
multi-binaries, working on removing x.lisp

diff -r 692dfd7f02d0 -r af486e0a40c9 emacs/default.el
--- a/emacs/default.el	Fri Sep 13 20:30:55 2024 -0400
+++ b/emacs/default.el	Sat Sep 14 22:13:06 2024 -0400
@@ -102,7 +102,8 @@
    org-web-tools ;; web parsing
    citeproc ;; citations
    htmlize ;; html export
-   all-the-icons all-the-icons-dired all-the-icons-ibuffer ;; icons
+   ;; all-the-icons all-the-icons-dired all-the-icons-ibuffer ;; icons
+   nerd-icons nerd-icons-dired nerd-icons-ibuffer nerd-icons-corfu nerd-icons-completion
    hide-mode-line) ;; ui
   ;; bbdb
   (package-install-selected-packages t))
@@ -1074,7 +1075,7 @@
        t nil))))
 
 ;;;; Agenda
-(cl-pushnew '("w" "Work in progress tasks" ((todo "WIP") (agenda))) org-agenda-custom-commands)
+(cl-pushnew '("i" "Work in progress tasks" ((todo "WIP") (agenda))) org-agenda-custom-commands)
 
 (defvar org-agenda-overriding-header)
 (defvar org-agenda-sorting-strategy)
diff -r 692dfd7f02d0 -r af486e0a40c9 emacs/lib/graph.el
--- a/emacs/lib/graph.el	Fri Sep 13 20:30:55 2024 -0400
+++ b/emacs/lib/graph.el	Sat Sep 14 22:13:06 2024 -0400
@@ -107,5 +107,413 @@
 (defun org-dblock-write:graph ()
   "Generate a 'graph' block for the designated set of nodes.")
 
+;;; Links
+;; See https://github.com/toshism/org-super-links/blob/develop/org-super-links.el
+(declare-function org-make-link-description-function "ext:org-mode")
+
+(defvar org-graph-edge-backlink-into-drawer "LINKS"
+  "Controls how/where to insert the backlinks.
+If non-nil a drawer will be created and backlinks inserted there.  The
+default is BACKLINKS.  If this is set to a string a drawer will be
+created using that string.  For example LINKS.  If nil backlinks will
+just be inserted under the heading.")
+
+(defvar org-graph-edge-backlink-prefix 'org-graph-edge-backlink-prefix-timestamp
+  "Prefix to insert before the backlink.
+This can be a string, nil, or a function that takes no arguments and
+returns a string.
+
+Default is the function `org-graph-edge-backlink-prefix-timestamp'
+which returns an inactive timestamp formatted according to the variable
+`org-time-stamp-formats' and a separator ' <- '.")
+
+(defvar org-graph-edge-backlink-postfix nil
+  "Postfix to insert after the backlink.
+This can be a string, nil, or a function that takes no arguments and
+returns a string")
+
+(defvar org-graph-edge-related-into-drawer nil
+    "Controls how/where to insert links.
+If non-nil a drawer will be created and links inserted there.  The
+default is `org-graph-edge-related-drawer-default-name'.  If this is set to a
+string a drawer will be created using that string.  For example LINKS.
+If nil links will just be inserted at point.")
+
+(defvar org-graph-edge-related-drawer-default-name "RELATED"
+  "Default name to use for link drawer.
+If variable `org-graph-edge-related-into-drawer' is 't' use this
+name for the drawer.  See variable `org-graph-edge-related-into-drawer' for more info.")
+
+(defvar org-graph-edge-link-prefix nil
+  "Prefix to insert before the link.
+This can be a string, nil, or a function that takes no arguments and
+returns a string")
+
+(defvar org-graph-edge-link-postfix nil
+  "Postfix to insert after the link.
+This can be a string, nil, or a function that takes no arguments and
+returns a string")
+
+(defvar org-graph-edge-default-description-formatter org-make-link-description-function
+  "What to use if no description is provided.
+This can be a string, nil or a function that accepts two arguments
+LINK and DESC and returns a string.
+
+nil will return the default desciption or the link.
+string will be used only as a default fall back if set.
+function will be called for every link.
+
+Default is the variable `org-make-link-desciption-function'.")
+
+(defvar org-graph-edge-search-function
+  (cond ((require 'helm-org-ql nil 'no-error) "helm-org-ql")
+        ((require 'helm-org-rifle nil 'no-error) "helm-org-rifle")
+        (t 'org-graph-edge-get-location))
+  "The interface to use for finding target links.
+This can be a string with one of the values 'helm-org-ql',
+'helm-org-rifle', or a function.  If you provide a custom
+function it will be called with the `point` at the location the link
+should be inserted.  The only other requirement is that it should call
+the function `org-graph-edge--insert-link' with a marker to the target link.
+AKA the place you want the backlink.
+
+Using 'helm-org-ql' or 'helm-org-rifle' will also add a new
+action to the respective action menu.
+
+See the function `org-graph-edge-link-search-interface-ql' or for an example.
+
+Default is set based on currently installed packages.  In order of priority:
+- 'helm-org-ql'
+- 'helm-org-rifle'
+- `org-graph-edge-get-location'
+
+`org-graph-edge-get-location' internally uses `org-refile-get-location'.")
+
+(defvar org-graph-edge-pre-link-hook nil
+  "Hook called before storing the link on the link side.
+This is called with point at the location where it was called.")
+
+(defvar org-graph-edge-pre-backlink-hook nil
+  "Hook called before storing the link on the backlink side.
+This is called with point in the heading of the backlink.")
+
+(declare-function org-graph-edge-org-ql-link-search-interface "ext:org-graph-edge-org-ql")
+(declare-function org-graph-edge-org-rifle-link-search-interface "ext:org-graph-edge-org-rifle")
+
+(defun org-graph-edge-get-location ()
+  "Default for function `org-graph-edge-search-function' that reuses the `org-refile' machinery."
+  (let ((target (org-refile-get-location "Super Link")))
+    (org-graph-edge--insert-link (set-marker (make-marker) (car (cdddr target))
+                                 (get-file-buffer (car (cdr target)))))))
+
+(defun org-graph-edge-search-function ()
+  "Call the search interface specified in variable `org-graph-edge-search-function'."
+  (cond ((string= org-graph-edge-search-function "helm-org-ql")
+         (require 'org-graph-edge-org-ql)
+         (org-graph-edge-org-ql-link-search-interface))
+        ((string= org-graph-edge-search-function "helm-org-rifle")
+         (require 'org-graph-edge-org-rifle)
+         (org-graph-edge-org-rifle-link-search-interface))
+        (t (funcall org-graph-edge-search-function))))
+
+(defun org-graph-edge-backlink-prefix ()
+  "Return an appropriate string based on variable `org-graph-edge-backlink-prefix'."
+  (cond ((equal org-graph-edge-backlink-prefix nil) "")
+        ((stringp org-graph-edge-backlink-prefix) org-graph-edge-backlink-prefix)
+        (t (funcall org-graph-edge-backlink-prefix))))
+
+(defun org-graph-edge-backlink-postfix ()
+  "Return an appropriate string based on variable `org-graph-edge-backlink-postfix'."
+  (cond ((equal org-graph-edge-backlink-postfix nil) "\n")
+        ((stringp org-graph-edge-backlink-postfix) org-graph-edge-backlink-postfix)
+        (t (funcall org-graph-edge-backlink-postfix))))
+
+(defun org-graph-edge-link-prefix ()
+  "Return an appropriate string based on variable `org-graph-edge-link-prefix'."
+  (cond ((equal org-graph-edge-link-prefix nil) "")
+        ((stringp org-graph-edge-link-prefix) org-graph-edge-link-prefix)
+        (t (funcall org-graph-edge-link-prefix))))
+
+(defun org-graph-edge-link-postfix ()
+  "Return an appropriate string based on variable `org-graph-edge-link-postfix'."
+  (cond ((equal org-graph-edge-link-postfix nil) "")
+        ((stringp org-graph-edge-link-postfix) org-graph-edge-link-postfix)
+        (t (funcall org-graph-edge-link-postfix))))
+
+(defun org-graph-edge-backlink-prefix-timestamp ()
+  "Return the default prefix string for a backlink.
+Inactive timestamp formatted according to `org-time-stamp-formats' and
+a separator ' <- '."
+  (concat (format-time-string (org-time-stamp-format t t) (current-time))
+        " <- "))
+
+(defun org-graph-edge-default-description-formatter (link desc)
+  "Return a string to use as the link desciption.
+LINK is the link target.  DESC is the provided desc."
+  (let ((p org-graph-edge-default-description-formatter))
+    (cond ((equal p nil) (or desc link))
+          ((stringp p) (or desc p))
+          ((fboundp p) (funcall p link desc))
+          (t desc))))
+
+(defun org-graph-edge-backlink-into-drawer ()
+  "Name of the backlink drawer, as a string, or nil.
+This is the value of variable
+`org-graph-edge-backlink-into-drawer'.  However, if the current
+entry has or inherits a BACKLINK_INTO_DRAWER property, it will be
+used instead of the default value."
+  (let ((p (org-entry-get nil "BACKLINK_INTO_DRAWER" 'inherit t)))
+    (cond ((equal p "nil") nil)
+          ((equal p "t") "BACKLINKS")
+          ((stringp p) p)
+          (p "BACKLINKS")
+          ((stringp org-graph-edge-backlink-into-drawer) org-graph-edge-backlink-into-drawer)
+          (org-graph-edge-backlink-into-drawer "BACKLINKS"))))
+
+;; delete related functions
+(defun org-graph-edge--find-link (id)
+  "Return link element for ID."
+  (save-restriction
+    (org-graph-edge--org-narrow-to-here)
+    (let ((link
+           (org-element-map (org-element-parse-buffer) 'link
+             (lambda (link)
+               (when (string= (org-element-property :path link) id)
+                 link)))))
+      (widen)
+      (if (> (length link) 1)
+          (error "Multiple links found.  Canceling delete")
+        (car link)))))
+
+(defun org-graph-edge--org-narrow-to-here ()
+  "Narrow to current heading, excluding subheadings."
+  (org-narrow-to-subtree)
+  (save-excursion
+    (org-next-visible-heading 1)
+    (narrow-to-region (point-min) (point))))
+
+
+(defun org-graph-edge--in-drawer ()
+  "Return nil if point is not in a drawer.
+Return element at point is in a drawer."
+  (let ((element (org-element-at-point)))
+    (while (and element
+                (not (memq (org-element-type element) '(drawer property-drawer))))
+      (setq element (org-element-property :parent element)))
+    element))
+
+
+(defun org-graph-edge--delete-link (link)
+  "Delete the LINK.
+If point is in drawer, delete the entire line."
+  (save-excursion
+    (goto-char (org-element-property :begin link))
+    (if (org-graph-edge--in-drawer)
+        (progn
+          (kill-whole-line 1)
+          (org-remove-empty-drawer-at (point)))
+      (delete-region (org-element-property :begin link) (org-element-property :end link)))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; EXPERIMENTAL related into drawer
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun org-graph-edge-related-into-drawer ()
+  "Name of the related drawer, as a string, or nil.
+This is the value of variable
+`org-graph-edge-related-into-drawer'.  However, if the current
+entry has or inherits a RELATED_INTO_DRAWER property, it will be
+used instead of the default value."
+  (let ((p (org-entry-get nil "RELATED_INTO_DRAWER" 'inherit t)))
+    (cond ((equal p "nil") nil)
+          ((equal p "t") org-graph-edge-related-drawer-default-name)
+          ((stringp p) p)
+          (p org-graph-edge-related-drawer-default-name)
+          ((stringp org-graph-edge-related-into-drawer) org-graph-edge-related-into-drawer)
+          (org-graph-edge-related-into-drawer org-graph-edge-related-drawer-default-name))))
+
+(defun org-graph-edge-insert-relatedlink (link desc)
+  "LINK DESC related experiment."
+  (if (org-graph-edge-related-into-drawer)
+      (let* ((org-log-into-drawer (org-graph-edge-related-into-drawer))
+             (beg (org-log-beginning t)))
+        (goto-char beg)
+        (insert (org-graph-edge-link-prefix))
+        (org-insert-link nil link desc)
+        (insert (org-graph-edge-link-postfix) "\n")
+        (org-indent-region beg (point)))
+    (insert (org-graph-edge-link-prefix))
+    (org-insert-link nil link desc)
+    (insert (org-graph-edge-link-postfix))))
+
+(defun org-graph-edge-link-prefix-timestamp ()
+  "Return the default prefix string for a backlink.
+Inactive timestamp formatted according to `org-time-stamp-formats' and
+a separator ' -> '."
+  (concat (format-time-string (org-time-stamp-format t t) (current-time))
+        " -> "))
+
+(defun org-graph-edge-quick-insert-drawer-link ()
+  "Insert link into drawer regardless of variable `org-graph-edge-related-into-drawer' value."
+  (interactive)
+  ;; how to handle prefix here?
+  (let ((org-graph-edge-related-into-drawer (or org-graph-edge-related-into-drawer t))
+        (org-graph-edge-link-prefix 'org-graph-edge-link-prefix-timestamp))
+    (org-graph-edge-link)))
+
+(defun org-graph-edge-quick-insert-inline-link ()
+  "Insert inline link regardless of variable `org-graph-edge-related-into-drawer' value."
+  (interactive)
+  ;; how to handle prefix here?
+  (let ((org-graph-edge-related-into-drawer nil)
+        (org-graph-edge-link-prefix nil))
+    (org-graph-edge-link)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; /EXPERIMENTAL related into drawer
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun org-graph-edge-insert-backlink (link desc)
+  "Insert backlink to LINK with DESC.
+Where the backlink is placed is determined by the variable `org-graph-edge-backlink-into-drawer'."
+  (let* ((org-log-into-drawer (org-graph-edge-backlink-into-drawer))
+         (description (org-graph-edge-default-description-formatter link desc))
+         (beg (org-log-beginning t)))
+    (goto-char beg)
+    (insert (org-graph-edge-backlink-prefix))
+    (insert (org-link-make-string link description))
+    (insert (org-graph-edge-backlink-postfix))
+    (org-indent-region beg (point))))
+
+(defun org-graph-edge-links-action (marker hooks)
+  "Go to MARKER, run HOOKS and store a link."
+  (with-current-buffer (marker-buffer marker)
+    (save-excursion
+      (save-restriction
+        (widen) ;; buffer could be narrowed
+        (goto-char (marker-position marker))
+        (run-hooks hooks)
+        (call-interactively #'org-store-link)
+        (pop org-stored-links)))))
+
+(defun org-graph-edge-link-builder (link)
+  "Format link description for LINK."
+  (let* ((link-ref (car link))
+         (pre-desc (cadr link))
+         (description (org-graph-edge-default-description-formatter link-ref pre-desc)))
+    (cons link-ref description)))
+
+(defun org-graph-edge--insert-link (target &optional no-forward)
+  "Insert link to marker TARGET at current `point`, and create backlink to here.
+Only create backlinks in files in `org-mode' or a derived mode, otherwise just
+act like a normal link.
+
+If NO-FORWARD is non-nil skip creating the forward link.  Currently
+only used when converting a link."
+  (let* ((source (point-marker))
+         (source-link (org-graph-edge-links-action source 'org-graph-edge-pre-link-hook))
+         (target-link (org-graph-edge-links-action target 'org-graph-edge-pre-backlink-hook))
+         (source-formatted-link (org-graph-edge-link-builder source-link))
+         (target-formatted-link (org-graph-edge-link-builder target-link)))
+    (with-current-buffer (marker-buffer target)
+      (save-excursion
+        (save-restriction
+          (widen) ;; buffer could be narrowed
+          (goto-char (marker-position target))
+          (when (derived-mode-p 'org-mode)
+            (org-graph-edge-insert-backlink (car source-formatted-link) (cdr source-formatted-link))))))
+    (unless no-forward
+      (with-current-buffer (marker-buffer source)
+        (save-excursion
+          (goto-char (marker-position source))
+          (org-graph-edge-insert-relatedlink (car target-formatted-link) (cdr target-formatted-link)))))))
+
+
+;;;###autoload
+(defun org-graph-edge-convert-link-to-edge (arg)
+  "Convert a normal `org-mode' link at `point' to a graph link, ARG prefix.
+If variable `org-graph-edge-related-into-drawer' is non-nil move
+the link into drawer.
+
+When called interactively with a `C-u' prefix argument ignore
+variable `org-graph-edge-related-into-drawer' configuration and
+do not modify existing link."
+  (interactive "P")
+  (let ((from-m (point-marker))
+        (target (save-window-excursion
+                  (with-current-buffer (current-buffer)
+                    (save-excursion
+                      (org-open-at-point)
+                      (point-marker))))))
+    (org-graph-edge--insert-link target (or arg (not org-graph-edge-related-into-drawer)))
+    (goto-char (marker-position from-m)))
+
+  (when (and (not arg) (org-graph-edge-related-into-drawer))
+    (let ((begin (org-element-property :begin (org-element-context)))
+          (end (org-element-property :end (org-element-context))))
+      (delete-region begin end))))
+
+;;;###autoload
+(defun org-graph-edge-delete-link ()
+  "Delete the link at point, and the corresponding reverse link.
+If no reverse link exists, just delete link at point.
+This works from either side, and deletes both sides of a link."
+  (interactive)
+  (save-window-excursion
+    (with-current-buffer (current-buffer)
+      (save-excursion
+        (let ((id (org-id-get (point))))
+          (org-open-at-point)
+          (let ((link-element (org-graph-edge--find-link id)))
+            (if link-element
+                (org-graph-edge--delete-link link-element)
+              (message "No backlink found. Deleting active only.")))))))
+  (org-graph-edge--delete-link (org-element-context)))
+
+;;;###autoload
+(defun org-graph-edge-store-link (&optional GOTO KEYS)
+  "Store a point to register for use in function `org-graph-edge-insert-link'.
+This is primarily intended to be called before `org-capture', but
+could possibly even be used to replace `org-store-link' IF
+function `org-graph-edge-insert-link' is used to replace
+`org-insert-link'.  This has not been thoroughly tested outside
+of links to/form org files.  GOTO and KEYS are unused."
+  (interactive "P")
+  (ignore GOTO)
+  (ignore KEYS)
+  (save-excursion
+    ;; this is a hack. if the point is at the first char of a heading
+    ;; the marker is not updated as expected when text is inserted
+    ;; above the heading. for example a capture template inserted
+    ;; above. that results in the link being to the heading above the
+    ;; expected heading.
+    (goto-char (line-end-position))
+    (let ((c1 (make-marker)))
+      (set-marker c1 (point) (current-buffer))
+      (set-register ?^ c1)
+      (message "Link copied"))))
+
+;; not sure if this should be autoloaded or left to config?
+;;;###autoload
+(advice-add 'org-capture :before #'org-graph-edge-store-link)
+
+;;;###autoload
+(defun org-graph-edge-insert-link ()
+  "Insert a super link from the register."
+  (interactive)
+  (let* ((target (get-register ?^)))
+    (if target
+        (progn
+          (org-graph-edge--insert-link target)
+          (set-register ?^ nil))
+      (message "No link to insert!"))))
+
+;;;###autoload
+(defun org-graph-edge-link ()
+  "Insert a link and add a backlink to the target heading."
+  (interactive)
+  (org-graph-edge-search-function))
+
 (provide 'graph)
 ;; graph.el ends here
diff -r 692dfd7f02d0 -r af486e0a40c9 emacs/lib/inbox.el
--- a/emacs/lib/inbox.el	Fri Sep 13 20:30:55 2024 -0400
+++ b/emacs/lib/inbox.el	Sat Sep 14 22:13:06 2024 -0400
@@ -71,13 +71,9 @@
          "* %?\n%i"
          :empty-lines 1)
         ("t" "inbox-task" entry (file ,org-inbox-file) "* TODO %^{item}\n")
-        ("n" "inbox-note" entry (file ,org-inbox-file) "* NOTE %^{item}\n%a")
-        ("l" "inbox-link" entry (file ,org-inbox-file)
-         "* LINK %l")
-        ("L" "inbox-protocol-link" entry (file ,org-inbox-file)
-         "* LINK [[%:link][%:description]]\n%:initial" :empty-lines 1)
+        ("n" "inbox-note" entry (file ,org-inbox-file) "* %^{item}\n%a")
         ("w" "inbox-web-link" entry (file ,org-inbox-file)
-         "* LINK %?"
+         "* %?"
          :hook (lambda ()
                  (goto-char (pos-eol))
                  (org-web-tools-insert-link-for-url (org-web-tools--get-first-url))))
diff -r 692dfd7f02d0 -r af486e0a40c9 emacs/lib/scrum.el
--- a/emacs/lib/scrum.el	Fri Sep 13 20:30:55 2024 -0400
+++ b/emacs/lib/scrum.el	Sat Sep 14 22:13:06 2024 -0400
@@ -44,12 +44,27 @@
 ;; patience to learn Org-mode. This package isn't for them. It's for
 ;; small groups of like-minded Lispers :).
 
-;; ref: https://www.scrum.org/resources/what-scrum-module
+;;;; Refs
+;; scrum: https://www.scrum.org/resources/what-scrum-module
 
 ;; roadmap: https://compiler.company/plan/roadmap.html
 
 ;; tasks: https://compiler.company/plan/tasks
 
+;;;; API
+
+;; The API is still very much a WIP. Assume everything below to be
+;; theoretical.
+
+;; - task dependencies
+;;   - refer to org-depend.el for implementation details
+;;   - org-trigger-hook and org-blocker-hook
+;;   - org-todo-state-tags-triggers
+
+;; - dynamic blocks
+;;   - scrumboard
+;;   - burndown
+
 ;;; Code:
 (require 'ulang)
 (require 'uml-mode)
diff -r 692dfd7f02d0 -r af486e0a40c9 emacs/lib/ulang.el
--- a/emacs/lib/ulang.el	Fri Sep 13 20:30:55 2024 -0400
+++ b/emacs/lib/ulang.el	Sat Sep 14 22:13:06 2024 -0400
@@ -25,6 +25,7 @@
 
 ;;; Code:
 (require 'org)
+(require 'org-element)
 (require 'ox)
 
 (defgroup ulang nil
diff -r 692dfd7f02d0 -r af486e0a40c9 lisp/bin/bin.asd
--- a/lisp/bin/bin.asd	Fri Sep 13 20:30:55 2024 -0400
+++ b/lisp/bin/bin.asd	Sat Sep 14 22:13:06 2024 -0400
@@ -1,50 +1,45 @@
 (defsystem :bin
-  :depends-on (:bin/organ :bin/homer :bin/rdb :bin/skel :bin/packy)
-  :in-order-to ((test-op (test-op "app/tests")))
-  :perform (test-op (o c) (symbol-call :rt :do-tests :app)))
+  :depends-on (:bin/organ :bin/homer :bin/rdb :bin/skel :bin/packy :bin/core))
 
 (defsystem :bin/organ
   :build-operation program-op
   :build-pathname "organ"
-  :entry-point "bin/organ::main"
+  :entry-point "bin/organ::start-organ"
   :depends-on (:uiop :cl-ppcre :std :cli :organ :nlp)
-  :components ((:file "organ"))
-  :in-order-to ((test-op (test-op "app/tests")))
-  :perform (test-op (o c) (symbol-call :rt :do-tests :app)))
+  :components ((:file "organ")))
 
 (defsystem :bin/homer
   :build-operation program-op
   :build-pathname "homer"
-  :entry-point "bin/homer::main"
+  :entry-point "bin/homer::start-homer"
   :depends-on (:uiop :cl-ppcre :std :cli
                :organ :skel :nlp :rdb :packy :krypt)
-  :components ((:file "homer"))
-  :in-order-to ((test-op (test-op "app/tests")))
-  :perform (test-op (o c) (symbol-call :rt :do-tests :app)))
+  :components ((:file "homer")))
 
 (defsystem :bin/rdb
   :build-operation "program-op"
   :build-pathname "rdb"
-  :entry-point "bin/rdb::main"
+  :entry-point "bin/rdb::start-rdb"
   :depends-on (:uiop :cl-ppcre :std :rdb :cli)
-  :components ((:file "rdb"))
-  :in-order-to ((test-op (test-op "app/tests")))
-  :perform (test-op (o c) (symbol-call :rt :do-tests :app)))
+  :components ((:file "rdb")))
 
 (defsystem :bin/skel
   :build-operation program-op
   :build-pathname "skel"
-  :entry-point "bin/skel:main"
+  :entry-point "bin/skel::start-skel"
   :components ((:file "skel"))
-  :depends-on (:uiop :cl-ppcre :std :cli :skel)
-  :in-order-to ((test-op (test-op "app/tests")))
-  :perform (test-op (o c) (symbol-call :rt :do-tests :app)))
+  :depends-on (:uiop :cl-ppcre :std :cli :skel))
 
 (defsystem :bin/packy
   :build-operation program-op
   :build-pathname "packy"
-  :entry-point "bin/packy::main"
+  :entry-point "bin/packy::start-packy"
   :depends-on (:uiop :cl-ppcre :std :cli :packy :rdb)
-  :components ((:file "packy"))
-  :in-order-to ((test-op (test-op "app/tests")))
-  :perform (test-op (o c) (symbol-call :rt :do-tests :app)))
+  :components ((:file "packy")))
+
+(defsystem :bin/core
+  :build-operation program-op
+  :build-pathname "core"
+  :entry-point "bin/core::dispatch-core"
+  :components ((:file "core"))
+  :depends-on (:std :cli :log :bin/skel :bin/organ :bin/homer :bin/rdb :bin/packy))
diff -r 692dfd7f02d0 -r af486e0a40c9 lisp/bin/core.lisp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/bin/core.lisp	Sat Sep 14 22:13:06 2024 -0400
@@ -0,0 +1,18 @@
+;;; core.lisp --- Core Multi-binary
+
+;; Contains all core binaries - dispatches on argv[0].
+
+;;; Code:
+(defpackage :bin/core
+  (:use :cl :std :sb-ext :cli :log))
+
+(in-package :bin/core)
+
+(define-multi-main dispatch-core
+    (sb-impl::toplevel-init)
+    (:skel (bin/skel::start-skel))
+    (:packy (bin/packy::start-packy))
+    (:rdb (bin/rdb::start-rdb))
+    (:organ (bin/organ::start-organ))
+    (:homer (bin/homer::start-homer)))
+
diff -r 692dfd7f02d0 -r af486e0a40c9 lisp/bin/homer.lisp
--- a/lisp/bin/homer.lisp	Fri Sep 13 20:30:55 2024 -0400
+++ b/lisp/bin/homer.lisp	Sat Sep 14 22:13:06 2024 -0400
@@ -4,7 +4,7 @@
 (defpackage :bin/homer
   (:nicknames :homer)
   (:use :cl :std :log :sxp :rdb :skel :packy :cli :obj/id :krypt :vc)
-  (:export :main :*home-config*))
+  (:export :*home-config*))
 
 (in-package :bin/homer)
 (defvar *user* (sb-posix:getenv "USER"))
@@ -181,7 +181,7 @@
               (find-files src *home-hidden-paths*)))
       (error 'file-error :pathname src))))
 
-(define-cli *cli*
+(define-cli *homer-cli*
   :name "homer"
   :version "0.1.0"
   :description "user home manager"
@@ -198,13 +198,13 @@
 
 (defun run ()
   (let ((*log-level* :info))
-    (with-cli (*cli* opts cmds args) (cli:args)
+    (with-cli (*homer-cli* opts cmds args) (cli:args)
       (init-homer-vars)
       (load-homerc)
       (do-cmd *cli*)
       (debug-opts *cli*))))
 
-(defmain ()
+(defmain start-homer ()
   (let ((*print-readably* t))
     (run)
     (sb-ext:exit :code 0)))
diff -r 692dfd7f02d0 -r af486e0a40c9 lisp/bin/organ.lisp
--- a/lisp/bin/organ.lisp	Fri Sep 13 20:30:55 2024 -0400
+++ b/lisp/bin/organ.lisp	Sat Sep 14 22:13:06 2024 -0400
@@ -4,8 +4,7 @@
 
 ;;; Code:
 (defpackage :bin/organ
-  (:use :cl :organ :std :cli :log :clap)
-  (:export :main))
+  (:use :cl :organ :std :cli :log :clap))
 
 (in-package :bin/organ)
 (defopt organ-help (print-help *cli*))
@@ -33,7 +32,7 @@
   (let ((input (if *args* (car *args*) #P"readme.org")))
     (describe (org-parse :document input))))
 
-(define-cli *cli*
+(define-cli *organ-cli*
   :name "organ"
   :version "0.0.1"
   :description "org-mode toolbox"
@@ -57,10 +56,9 @@
 
 (defun run ()
   (let ((*log-level* :info))
-    (with-cli (*cli* opts cmds args) (cli:args)
+    (with-cli (*organ-cli* opts cmds args) (cli:args)
       (do-cmd *cli*)
       (debug-opts *cli*))))
 
-(defmain ()
-  (run)
-  (sb-ext:exit :code 0))
+(defmain start-organ ()
+  (run))
diff -r 692dfd7f02d0 -r af486e0a40c9 lisp/bin/packy.lisp
--- a/lisp/bin/packy.lisp	Fri Sep 13 20:30:55 2024 -0400
+++ b/lisp/bin/packy.lisp	Sat Sep 14 22:13:06 2024 -0400
@@ -1,6 +1,5 @@
 (defpackage :bin/packy
-  (:use :cl :std :sb-ext :cli :packy :clap :log)
-  (:export :main))
+  (:use :cl :std :sb-ext :cli :packy :clap :log))
 
 (in-package :bin/packy)
 
@@ -12,7 +11,7 @@
 (defopt pk-target (setq *pk-targets* *arg*))
 (defcmd pk-show (print (list *optc* *argc* *opts* *args* *pk-targets*)))
 
-(define-cli *cli*
+(define-cli *packy-cli*
   :name "packy"
   :version "0.1.0"
   :description "Universal Package Manager"
@@ -26,11 +25,11 @@
 
 (defun run ()
   (let ((*log-level* :info))
-    (with-cli (*cli* opts cmds args) (cli:args)
+    (with-cli (*packy-cli* opts cmds args) (cli:args)
       (do-cmd *cli*)
       (debug-opts *cli*))))
 
-(defmain ()
+(defmain start-packy ()
   (let ((*print-readably* t))
     (run)
     (sb-ext:exit :code 0)))
diff -r 692dfd7f02d0 -r af486e0a40c9 lisp/bin/rdb.lisp
--- a/lisp/bin/rdb.lisp	Fri Sep 13 20:30:55 2024 -0400
+++ b/lisp/bin/rdb.lisp	Sat Sep 14 22:13:06 2024 -0400
@@ -2,8 +2,7 @@
 
 ;;; Code:
 (uiop:define-package :bin/rdb
-  (:use :cl :rdb :std :cli/clap :log :clap)
-  (:export :main))
+  (:use :cl :rdb :std :cli/clap :log :clap))
 
 (in-package :bin/rdb)
 (rocksdb:load-rocksdb t)
@@ -70,7 +69,7 @@
                  (sb-ext:string-to-octets (string (gensym "foo")))
                  val)))))
 
-(define-cli *cli*
+(define-cli *rdb-cli*
   :name "rdb"
   :version "0.1.0"
   :thunk 'rdb-show
@@ -88,9 +87,9 @@
          (:name fuzz :thunk rdb-fuzz)
          (:name destroy :thunk rdb-destroy)))
 
-(defmain ()
+(defmain start-rdb ()
   (let ((*log-level* :info))
-    (with-slots (opts cmds args) *cli*
+    (with-cli (*rdb-cli* opts cmds args) ()
       (do-opts (active-opts *cli* t))
       (if (active-cmds *cli*)
           (let ((*rdb* (create-db (do-opt (car (find-opts *cli* "db"))))))
diff -r 692dfd7f02d0 -r af486e0a40c9 lisp/bin/skel.lisp
--- a/lisp/bin/skel.lisp	Fri Sep 13 20:30:55 2024 -0400
+++ b/lisp/bin/skel.lisp	Sat Sep 14 22:13:06 2024 -0400
@@ -8,8 +8,7 @@
    :vc :sb-ext :skel :log :cli/clap/util
    :dat/sxp #+tools :skel/tools/viz)
   (:import-from :cli/shell :*shell-input* :*shell-directory*)
-  (:use :cli/tools/sbcl)
-  (:export :main))
+  (:use :cli/tools/sbcl))
 
 (in-package :bin/skel)
 (in-readtable :shell)
@@ -232,7 +231,7 @@
 (defcmd skc-new
   (trace! *args* *opts*))
 
-(define-cli *cli*
+(define-cli *skel-cli*
   :name "skel"
   :version #.(format nil "0.1.1:~A" (read-line (sb-ext:process-output (vc:run-hg-command "id" '("-i") :stream))))
   :description "A hacker's project compiler."
@@ -340,16 +339,16 @@
 	  :description "open the sk-shell interpreter"
           :thunk skc-shell)))
 
-(defmain ()
+(defmain start-skel ()
   (in-package :sk-user)
   (let ((*log-level* :info))
     (in-readtable :shell)
-    (with-cli (*cli* opts cmds) (cli:args)
+    (with-cli (*skel-cli* opts cmds) (cli:args)
       (debug-opts *cli*)
       (init-skel-vars)
       (when-let ((project (find-skelfile #P".")))
         (let ((*default-pathname-defaults* (pathname (directory-namestring project))))
           (setq *skel-project* (load-skelfile project))
           (setq *skel-path* (sk-src *skel-project*))
-          (setq *shell-directory* (sk-src *skel-project*))))
+          (setq cli/shell:*shell-directory* (sk-src *skel-project*))))
       (do-cmd *cli*))))
diff -r 692dfd7f02d0 -r af486e0a40c9 lisp/lib/cli/clap/cli.lisp
--- a/lisp/lib/cli/clap/cli.lisp	Fri Sep 13 20:30:55 2024 -0400
+++ b/lisp/lib/cli/clap/cli.lisp	Sat Sep 14 22:13:06 2024 -0400
@@ -29,16 +29,14 @@
                                                   :opts (make-opts ',opts)
                                                   :cmds (make-cmds ',cmds)))))
 
-(defmacro defmain ((&key (exit t) (export t)) &body body)
+(defmacro defmain (name (&key (exit t)) &body body)
   "Define a CLI main function in the current package."
-  (let ((main (symbolicate "MAIN")))
-    `(let ((*no-exit* ,(not exit)))
-       (defun ,main ()
-         "Run the top-level function and print to *STDOUT*."
-         (with-cli-handlers
-           (progn
-             ,@body)))
-       ,@(when export `((export ',main))))))
+  `(let ((*no-exit* ,(not exit)))
+     (defun ,name ()
+       "Run the top-level function and print to *STDOUT*."
+       (with-cli-handlers
+         (progn
+           ,@body)))))
 
 ;; RESEARCH 2023-09-12: closed over hash-table with short/long flags
 ;; to avoid conflicts. if not, need something like a flag-function
diff -r 692dfd7f02d0 -r af486e0a40c9 lisp/lib/cli/multi.lisp
--- a/lisp/lib/cli/multi.lisp	Fri Sep 13 20:30:55 2024 -0400
+++ b/lisp/lib/cli/multi.lisp	Sat Sep 14 22:13:06 2024 -0400
@@ -27,7 +27,7 @@
 ;;; Code:
 (in-package :cli/multi)
 
-(defmacro define-multi-main ((&key default (exit t) (export t)) &rest mains)
+(defmacro define-multi-main (name default &rest mains)
   "Define a MAIN function for the current package which dispatches
   based on the value of '(ARG0)' at runtime to one of the pairs in
   MAINS.
@@ -39,9 +39,10 @@
 When you save an executable lisp image with this function you should
 arrange for symlinks for each handled value of (ARG0) to be generated
 ."
-  `(cli/clap::defmain (:exit ,exit :export ,export)
-       (string-case ((pathname-name (arg0)) :default ,default)
-         ,@mains)))
+  `(defun ,name ()
+     (case (keywordicate (string-upcase (pathname-name (clap:arg0))))
+       ,@mains
+       (t ,default))))
 
 (defun make-symlinks (src &optional directory &rest names)
   "Make a set of symlinks from SRC to NAMES.
diff -r 692dfd7f02d0 -r af486e0a40c9 lisp/lib/cli/tests.lisp
--- a/lisp/lib/cli/tests.lisp	Fri Sep 13 20:30:55 2024 -0400
+++ b/lisp/lib/cli/tests.lisp	Sat Sep 14 22:13:06 2024 -0400
@@ -682,13 +682,13 @@
   (signals clap-unknown-argument
     (proc-args *cli* '("--log" "default" "--foo=11"))))
 
-(defmain (:exit nil :export nil)
+(defmain foo-main (:exit nil :export nil)
   (with-cli (*cli*) ()
     (log:trace! "defmain is OK")
     t))
 
 (deftest clap-main ()
-  (is (null (funcall #'main))))
+  (is (null (funcall #'foo-main))))
 
 (deftest sbcl-tools ()
   (with-sbcl (:noinform t :quit t)
diff -r 692dfd7f02d0 -r af486e0a40c9 lisp/lib/cli/tools/sbcl.lisp
--- a/lisp/lib/cli/tools/sbcl.lisp	Fri Sep 13 20:30:55 2024 -0400
+++ b/lisp/lib/cli/tools/sbcl.lisp	Sat Sep 14 22:13:06 2024 -0400
@@ -46,5 +46,6 @@
 a PROGN and passed to the --eval flag."
   `(run-sbcl ,@(when keys (parse-sbcl-option-keys keys))
              ,@(when body
-                 (list "--eval"
-                       (with-output-to-string (s) (pprint `(progn ,@body) s))))))
+                 (flatten
+                  (mapcar (lambda (x) (list "--eval" (with-output-to-string (s) (prin1 x s))))
+                          body)))))
diff -r 692dfd7f02d0 -r af486e0a40c9 lisp/std/defpkg.lisp
--- a/lisp/std/defpkg.lisp	Fri Sep 13 20:30:55 2024 -0400
+++ b/lisp/std/defpkg.lisp	Sat Sep 14 22:13:06 2024 -0400
@@ -738,9 +738,7 @@
          (:export ,@pkg-externs)))))
 
 
-(defmacro with-package ((pkg) &body body)
+(defmacro with-package (pkg &body body)
   "Execute BODY within the package PKG."
-  `(let ((current (package-name *package*)))
-     (unwind-protect (progn (in-package ,pkg) ,@body)
-       (eval-when (:compile-toplevel :load-toplevel :execute)
-         (setq *package* (find-package current))))))
+  `(let ((*package* ,@(when pkg `((find-package ,pkg)))))
+     ,@body))
diff -r 692dfd7f02d0 -r af486e0a40c9 lisp/std/pkg.lisp
--- a/lisp/std/pkg.lisp	Fri Sep 13 20:30:55 2024 -0400
+++ b/lisp/std/pkg.lisp	Sat Sep 14 22:13:06 2024 -0400
@@ -458,7 +458,8 @@
    :save-lisp-tree-shake-and-die
    :save-lisp-and-live
    :forget-shared-object
-   :forget-shared-objects))
+   :forget-shared-objects
+   :compile-lisp))
 
 (defpkg :std
   (:use :cl :sb-unicode :cl-ppcre :sb-mop :sb-c :sb-thread :sb-alien :sb-gray :sb-concurrency)
diff -r 692dfd7f02d0 -r af486e0a40c9 lisp/std/sys.lisp
--- a/lisp/std/sys.lisp	Fri Sep 13 20:30:55 2024 -0400
+++ b/lisp/std/sys.lisp	Sat Sep 14 22:13:06 2024 -0400
@@ -105,6 +105,24 @@
                :test 'string-equal))
         t))
 
-(defun forget-shared-objects ()
+(defun forget-shared-objects (&optional (objects sb-sys:*shared-objects*))
   "Set the DONT-SAVE slot of all objects in SB-SYS:*SHARED-OBJECTS* to T."
-  (mapcar (lambda (obj) (setf (sb-alien::shared-object-dont-save obj) t)) sb-sys:*shared-objects*))
+  (mapcar (lambda (obj) (setf (sb-alien::shared-object-dont-save obj) t)) objects))
+
+(defun compile-lisp (name &key force save make package compression verbose version callable-exports executable (toplevel #'sb-impl::toplevel-init) forget save-runtime-options root-structures (purify t))
+  (pkg:with-package (or package *package*)
+    (asdf:compile-system name :force force :verbose verbose :version version)
+    (when make
+      (apply 'asdf:make name (unless (eq t make) make)))
+    (when forget
+      (forget-shared-objects (unless (eq t forget) forget)))
+    (when save
+      (when (probe-file save)
+        (delete-file save))
+      (sb-ext:save-lisp-and-die save :executable executable
+                                     :toplevel toplevel
+                                     :callable-exports callable-exports
+                                     :save-runtime-options save-runtime-options
+                                     :root-structures root-structures
+                                     :purify purify
+                                     :compression compression))))
diff -r 692dfd7f02d0 -r af486e0a40c9 skelfile
--- a/skelfile	Fri Sep 13 20:30:55 2024 -0400
+++ b/skelfile	Sat Sep 14 22:13:06 2024 -0400
@@ -18,6 +18,7 @@
        psl.dat parquet.json rgb.txt
        compile save-std save-prelude save-user
        save-infra save-core save-tests build-rdb
+       build-core
        build-skel build-organ build-homer build-packy
        fasl rust-bin build-tree-sitter-alien))
  (clean ()
@@ -95,7 +96,10 @@
                      (asdf:make :bin/packy))
                 #$mv lisp/bin/packy .stash/packy$#))
  (compile () #$./x.lisp compile$#)
- (std () (:save () #$./x.lisp save std$#))
+ (std () (:save () (with-sbcl (:noinform t :quit t)
+                     (ql:quickload :std)
+                     (in-package :std-user)
+                     (compile-lisp :std :save ".stash/std.core"))))
  (prelude ()
           (:save () #$./x.lisp save prelude$#)
           (:compile () #$./x.lisp make prelude$#))
@@ -104,8 +108,15 @@
        (:compile () #$./x.lisp make user$#))
  (infra () (:save () #$./x.lisp save infra$#))
  (core ()
-       (:save () #$./x.lisp save core$#)
-       (:compile () #$./x.lisp make core$#))
+       (:build () (with-sbcl (:noinform t :quit t)
+                    (ql:quickload :bin/core)
+                    (asdf:make :bin/core))
+               #$mv lisp/bin/core .stash/core$#)
+       (:save () (with-sbcl (:noinform t :quit t)
+                   (ql:quickload (list :std :core))
+                   (in-package :std-user)
+                   (compile-lisp :core :save ".stash/core.core")))
+       (:compile () (compile-lisp :core :force t :verbose t)))
  (tests ()
         (:save () #$./x.lisp save tests$#)
         (:compile () #$./x.lisp make core/tests$#))
diff -r 692dfd7f02d0 -r af486e0a40c9 x.lisp
--- a/x.lisp	Fri Sep 13 20:30:55 2024 -0400
+++ b/x.lisp	Sat Sep 14 22:13:06 2024 -0400
@@ -210,7 +210,6 @@
     (asdf:load-system sys)
     (in-package :std-user)
     (asdf:make sys)
-    ()
     (stash-output sys)
     (println :OK)))