1.1--- a/emacs/default.el Fri Sep 13 20:30:55 2024 -0400
1.2+++ b/emacs/default.el Sat Sep 14 22:13:06 2024 -0400
1.3@@ -102,7 +102,8 @@
1.4 org-web-tools ;; web parsing
1.5 citeproc ;; citations
1.6 htmlize ;; html export
1.7- all-the-icons all-the-icons-dired all-the-icons-ibuffer ;; icons
1.8+ ;; all-the-icons all-the-icons-dired all-the-icons-ibuffer ;; icons
1.9+ nerd-icons nerd-icons-dired nerd-icons-ibuffer nerd-icons-corfu nerd-icons-completion
1.10 hide-mode-line) ;; ui
1.11 ;; bbdb
1.12 (package-install-selected-packages t))
1.13@@ -1074,7 +1075,7 @@
1.14 t nil))))
1.15
1.16 ;;;; Agenda
1.17-(cl-pushnew '("w" "Work in progress tasks" ((todo "WIP") (agenda))) org-agenda-custom-commands)
1.18+(cl-pushnew '("i" "Work in progress tasks" ((todo "WIP") (agenda))) org-agenda-custom-commands)
1.19
1.20 (defvar org-agenda-overriding-header)
1.21 (defvar org-agenda-sorting-strategy)
2.1--- a/emacs/lib/graph.el Fri Sep 13 20:30:55 2024 -0400
2.2+++ b/emacs/lib/graph.el Sat Sep 14 22:13:06 2024 -0400
2.3@@ -107,5 +107,413 @@
2.4 (defun org-dblock-write:graph ()
2.5 "Generate a 'graph' block for the designated set of nodes.")
2.6
2.7+;;; Links
2.8+;; See https://github.com/toshism/org-super-links/blob/develop/org-super-links.el
2.9+(declare-function org-make-link-description-function "ext:org-mode")
2.10+
2.11+(defvar org-graph-edge-backlink-into-drawer "LINKS"
2.12+ "Controls how/where to insert the backlinks.
2.13+If non-nil a drawer will be created and backlinks inserted there. The
2.14+default is BACKLINKS. If this is set to a string a drawer will be
2.15+created using that string. For example LINKS. If nil backlinks will
2.16+just be inserted under the heading.")
2.17+
2.18+(defvar org-graph-edge-backlink-prefix 'org-graph-edge-backlink-prefix-timestamp
2.19+ "Prefix to insert before the backlink.
2.20+This can be a string, nil, or a function that takes no arguments and
2.21+returns a string.
2.22+
2.23+Default is the function `org-graph-edge-backlink-prefix-timestamp'
2.24+which returns an inactive timestamp formatted according to the variable
2.25+`org-time-stamp-formats' and a separator ' <- '.")
2.26+
2.27+(defvar org-graph-edge-backlink-postfix nil
2.28+ "Postfix to insert after the backlink.
2.29+This can be a string, nil, or a function that takes no arguments and
2.30+returns a string")
2.31+
2.32+(defvar org-graph-edge-related-into-drawer nil
2.33+ "Controls how/where to insert links.
2.34+If non-nil a drawer will be created and links inserted there. The
2.35+default is `org-graph-edge-related-drawer-default-name'. If this is set to a
2.36+string a drawer will be created using that string. For example LINKS.
2.37+If nil links will just be inserted at point.")
2.38+
2.39+(defvar org-graph-edge-related-drawer-default-name "RELATED"
2.40+ "Default name to use for link drawer.
2.41+If variable `org-graph-edge-related-into-drawer' is 't' use this
2.42+name for the drawer. See variable `org-graph-edge-related-into-drawer' for more info.")
2.43+
2.44+(defvar org-graph-edge-link-prefix nil
2.45+ "Prefix to insert before the link.
2.46+This can be a string, nil, or a function that takes no arguments and
2.47+returns a string")
2.48+
2.49+(defvar org-graph-edge-link-postfix nil
2.50+ "Postfix to insert after the link.
2.51+This can be a string, nil, or a function that takes no arguments and
2.52+returns a string")
2.53+
2.54+(defvar org-graph-edge-default-description-formatter org-make-link-description-function
2.55+ "What to use if no description is provided.
2.56+This can be a string, nil or a function that accepts two arguments
2.57+LINK and DESC and returns a string.
2.58+
2.59+nil will return the default desciption or the link.
2.60+string will be used only as a default fall back if set.
2.61+function will be called for every link.
2.62+
2.63+Default is the variable `org-make-link-desciption-function'.")
2.64+
2.65+(defvar org-graph-edge-search-function
2.66+ (cond ((require 'helm-org-ql nil 'no-error) "helm-org-ql")
2.67+ ((require 'helm-org-rifle nil 'no-error) "helm-org-rifle")
2.68+ (t 'org-graph-edge-get-location))
2.69+ "The interface to use for finding target links.
2.70+This can be a string with one of the values 'helm-org-ql',
2.71+'helm-org-rifle', or a function. If you provide a custom
2.72+function it will be called with the `point` at the location the link
2.73+should be inserted. The only other requirement is that it should call
2.74+the function `org-graph-edge--insert-link' with a marker to the target link.
2.75+AKA the place you want the backlink.
2.76+
2.77+Using 'helm-org-ql' or 'helm-org-rifle' will also add a new
2.78+action to the respective action menu.
2.79+
2.80+See the function `org-graph-edge-link-search-interface-ql' or for an example.
2.81+
2.82+Default is set based on currently installed packages. In order of priority:
2.83+- 'helm-org-ql'
2.84+- 'helm-org-rifle'
2.85+- `org-graph-edge-get-location'
2.86+
2.87+`org-graph-edge-get-location' internally uses `org-refile-get-location'.")
2.88+
2.89+(defvar org-graph-edge-pre-link-hook nil
2.90+ "Hook called before storing the link on the link side.
2.91+This is called with point at the location where it was called.")
2.92+
2.93+(defvar org-graph-edge-pre-backlink-hook nil
2.94+ "Hook called before storing the link on the backlink side.
2.95+This is called with point in the heading of the backlink.")
2.96+
2.97+(declare-function org-graph-edge-org-ql-link-search-interface "ext:org-graph-edge-org-ql")
2.98+(declare-function org-graph-edge-org-rifle-link-search-interface "ext:org-graph-edge-org-rifle")
2.99+
2.100+(defun org-graph-edge-get-location ()
2.101+ "Default for function `org-graph-edge-search-function' that reuses the `org-refile' machinery."
2.102+ (let ((target (org-refile-get-location "Super Link")))
2.103+ (org-graph-edge--insert-link (set-marker (make-marker) (car (cdddr target))
2.104+ (get-file-buffer (car (cdr target)))))))
2.105+
2.106+(defun org-graph-edge-search-function ()
2.107+ "Call the search interface specified in variable `org-graph-edge-search-function'."
2.108+ (cond ((string= org-graph-edge-search-function "helm-org-ql")
2.109+ (require 'org-graph-edge-org-ql)
2.110+ (org-graph-edge-org-ql-link-search-interface))
2.111+ ((string= org-graph-edge-search-function "helm-org-rifle")
2.112+ (require 'org-graph-edge-org-rifle)
2.113+ (org-graph-edge-org-rifle-link-search-interface))
2.114+ (t (funcall org-graph-edge-search-function))))
2.115+
2.116+(defun org-graph-edge-backlink-prefix ()
2.117+ "Return an appropriate string based on variable `org-graph-edge-backlink-prefix'."
2.118+ (cond ((equal org-graph-edge-backlink-prefix nil) "")
2.119+ ((stringp org-graph-edge-backlink-prefix) org-graph-edge-backlink-prefix)
2.120+ (t (funcall org-graph-edge-backlink-prefix))))
2.121+
2.122+(defun org-graph-edge-backlink-postfix ()
2.123+ "Return an appropriate string based on variable `org-graph-edge-backlink-postfix'."
2.124+ (cond ((equal org-graph-edge-backlink-postfix nil) "\n")
2.125+ ((stringp org-graph-edge-backlink-postfix) org-graph-edge-backlink-postfix)
2.126+ (t (funcall org-graph-edge-backlink-postfix))))
2.127+
2.128+(defun org-graph-edge-link-prefix ()
2.129+ "Return an appropriate string based on variable `org-graph-edge-link-prefix'."
2.130+ (cond ((equal org-graph-edge-link-prefix nil) "")
2.131+ ((stringp org-graph-edge-link-prefix) org-graph-edge-link-prefix)
2.132+ (t (funcall org-graph-edge-link-prefix))))
2.133+
2.134+(defun org-graph-edge-link-postfix ()
2.135+ "Return an appropriate string based on variable `org-graph-edge-link-postfix'."
2.136+ (cond ((equal org-graph-edge-link-postfix nil) "")
2.137+ ((stringp org-graph-edge-link-postfix) org-graph-edge-link-postfix)
2.138+ (t (funcall org-graph-edge-link-postfix))))
2.139+
2.140+(defun org-graph-edge-backlink-prefix-timestamp ()
2.141+ "Return the default prefix string for a backlink.
2.142+Inactive timestamp formatted according to `org-time-stamp-formats' and
2.143+a separator ' <- '."
2.144+ (concat (format-time-string (org-time-stamp-format t t) (current-time))
2.145+ " <- "))
2.146+
2.147+(defun org-graph-edge-default-description-formatter (link desc)
2.148+ "Return a string to use as the link desciption.
2.149+LINK is the link target. DESC is the provided desc."
2.150+ (let ((p org-graph-edge-default-description-formatter))
2.151+ (cond ((equal p nil) (or desc link))
2.152+ ((stringp p) (or desc p))
2.153+ ((fboundp p) (funcall p link desc))
2.154+ (t desc))))
2.155+
2.156+(defun org-graph-edge-backlink-into-drawer ()
2.157+ "Name of the backlink drawer, as a string, or nil.
2.158+This is the value of variable
2.159+`org-graph-edge-backlink-into-drawer'. However, if the current
2.160+entry has or inherits a BACKLINK_INTO_DRAWER property, it will be
2.161+used instead of the default value."
2.162+ (let ((p (org-entry-get nil "BACKLINK_INTO_DRAWER" 'inherit t)))
2.163+ (cond ((equal p "nil") nil)
2.164+ ((equal p "t") "BACKLINKS")
2.165+ ((stringp p) p)
2.166+ (p "BACKLINKS")
2.167+ ((stringp org-graph-edge-backlink-into-drawer) org-graph-edge-backlink-into-drawer)
2.168+ (org-graph-edge-backlink-into-drawer "BACKLINKS"))))
2.169+
2.170+;; delete related functions
2.171+(defun org-graph-edge--find-link (id)
2.172+ "Return link element for ID."
2.173+ (save-restriction
2.174+ (org-graph-edge--org-narrow-to-here)
2.175+ (let ((link
2.176+ (org-element-map (org-element-parse-buffer) 'link
2.177+ (lambda (link)
2.178+ (when (string= (org-element-property :path link) id)
2.179+ link)))))
2.180+ (widen)
2.181+ (if (> (length link) 1)
2.182+ (error "Multiple links found. Canceling delete")
2.183+ (car link)))))
2.184+
2.185+(defun org-graph-edge--org-narrow-to-here ()
2.186+ "Narrow to current heading, excluding subheadings."
2.187+ (org-narrow-to-subtree)
2.188+ (save-excursion
2.189+ (org-next-visible-heading 1)
2.190+ (narrow-to-region (point-min) (point))))
2.191+
2.192+
2.193+(defun org-graph-edge--in-drawer ()
2.194+ "Return nil if point is not in a drawer.
2.195+Return element at point is in a drawer."
2.196+ (let ((element (org-element-at-point)))
2.197+ (while (and element
2.198+ (not (memq (org-element-type element) '(drawer property-drawer))))
2.199+ (setq element (org-element-property :parent element)))
2.200+ element))
2.201+
2.202+
2.203+(defun org-graph-edge--delete-link (link)
2.204+ "Delete the LINK.
2.205+If point is in drawer, delete the entire line."
2.206+ (save-excursion
2.207+ (goto-char (org-element-property :begin link))
2.208+ (if (org-graph-edge--in-drawer)
2.209+ (progn
2.210+ (kill-whole-line 1)
2.211+ (org-remove-empty-drawer-at (point)))
2.212+ (delete-region (org-element-property :begin link) (org-element-property :end link)))))
2.213+
2.214+
2.215+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2.216+;; EXPERIMENTAL related into drawer
2.217+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2.218+
2.219+(defun org-graph-edge-related-into-drawer ()
2.220+ "Name of the related drawer, as a string, or nil.
2.221+This is the value of variable
2.222+`org-graph-edge-related-into-drawer'. However, if the current
2.223+entry has or inherits a RELATED_INTO_DRAWER property, it will be
2.224+used instead of the default value."
2.225+ (let ((p (org-entry-get nil "RELATED_INTO_DRAWER" 'inherit t)))
2.226+ (cond ((equal p "nil") nil)
2.227+ ((equal p "t") org-graph-edge-related-drawer-default-name)
2.228+ ((stringp p) p)
2.229+ (p org-graph-edge-related-drawer-default-name)
2.230+ ((stringp org-graph-edge-related-into-drawer) org-graph-edge-related-into-drawer)
2.231+ (org-graph-edge-related-into-drawer org-graph-edge-related-drawer-default-name))))
2.232+
2.233+(defun org-graph-edge-insert-relatedlink (link desc)
2.234+ "LINK DESC related experiment."
2.235+ (if (org-graph-edge-related-into-drawer)
2.236+ (let* ((org-log-into-drawer (org-graph-edge-related-into-drawer))
2.237+ (beg (org-log-beginning t)))
2.238+ (goto-char beg)
2.239+ (insert (org-graph-edge-link-prefix))
2.240+ (org-insert-link nil link desc)
2.241+ (insert (org-graph-edge-link-postfix) "\n")
2.242+ (org-indent-region beg (point)))
2.243+ (insert (org-graph-edge-link-prefix))
2.244+ (org-insert-link nil link desc)
2.245+ (insert (org-graph-edge-link-postfix))))
2.246+
2.247+(defun org-graph-edge-link-prefix-timestamp ()
2.248+ "Return the default prefix string for a backlink.
2.249+Inactive timestamp formatted according to `org-time-stamp-formats' and
2.250+a separator ' -> '."
2.251+ (concat (format-time-string (org-time-stamp-format t t) (current-time))
2.252+ " -> "))
2.253+
2.254+(defun org-graph-edge-quick-insert-drawer-link ()
2.255+ "Insert link into drawer regardless of variable `org-graph-edge-related-into-drawer' value."
2.256+ (interactive)
2.257+ ;; how to handle prefix here?
2.258+ (let ((org-graph-edge-related-into-drawer (or org-graph-edge-related-into-drawer t))
2.259+ (org-graph-edge-link-prefix 'org-graph-edge-link-prefix-timestamp))
2.260+ (org-graph-edge-link)))
2.261+
2.262+(defun org-graph-edge-quick-insert-inline-link ()
2.263+ "Insert inline link regardless of variable `org-graph-edge-related-into-drawer' value."
2.264+ (interactive)
2.265+ ;; how to handle prefix here?
2.266+ (let ((org-graph-edge-related-into-drawer nil)
2.267+ (org-graph-edge-link-prefix nil))
2.268+ (org-graph-edge-link)))
2.269+
2.270+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2.271+;; /EXPERIMENTAL related into drawer
2.272+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2.273+
2.274+(defun org-graph-edge-insert-backlink (link desc)
2.275+ "Insert backlink to LINK with DESC.
2.276+Where the backlink is placed is determined by the variable `org-graph-edge-backlink-into-drawer'."
2.277+ (let* ((org-log-into-drawer (org-graph-edge-backlink-into-drawer))
2.278+ (description (org-graph-edge-default-description-formatter link desc))
2.279+ (beg (org-log-beginning t)))
2.280+ (goto-char beg)
2.281+ (insert (org-graph-edge-backlink-prefix))
2.282+ (insert (org-link-make-string link description))
2.283+ (insert (org-graph-edge-backlink-postfix))
2.284+ (org-indent-region beg (point))))
2.285+
2.286+(defun org-graph-edge-links-action (marker hooks)
2.287+ "Go to MARKER, run HOOKS and store a link."
2.288+ (with-current-buffer (marker-buffer marker)
2.289+ (save-excursion
2.290+ (save-restriction
2.291+ (widen) ;; buffer could be narrowed
2.292+ (goto-char (marker-position marker))
2.293+ (run-hooks hooks)
2.294+ (call-interactively #'org-store-link)
2.295+ (pop org-stored-links)))))
2.296+
2.297+(defun org-graph-edge-link-builder (link)
2.298+ "Format link description for LINK."
2.299+ (let* ((link-ref (car link))
2.300+ (pre-desc (cadr link))
2.301+ (description (org-graph-edge-default-description-formatter link-ref pre-desc)))
2.302+ (cons link-ref description)))
2.303+
2.304+(defun org-graph-edge--insert-link (target &optional no-forward)
2.305+ "Insert link to marker TARGET at current `point`, and create backlink to here.
2.306+Only create backlinks in files in `org-mode' or a derived mode, otherwise just
2.307+act like a normal link.
2.308+
2.309+If NO-FORWARD is non-nil skip creating the forward link. Currently
2.310+only used when converting a link."
2.311+ (let* ((source (point-marker))
2.312+ (source-link (org-graph-edge-links-action source 'org-graph-edge-pre-link-hook))
2.313+ (target-link (org-graph-edge-links-action target 'org-graph-edge-pre-backlink-hook))
2.314+ (source-formatted-link (org-graph-edge-link-builder source-link))
2.315+ (target-formatted-link (org-graph-edge-link-builder target-link)))
2.316+ (with-current-buffer (marker-buffer target)
2.317+ (save-excursion
2.318+ (save-restriction
2.319+ (widen) ;; buffer could be narrowed
2.320+ (goto-char (marker-position target))
2.321+ (when (derived-mode-p 'org-mode)
2.322+ (org-graph-edge-insert-backlink (car source-formatted-link) (cdr source-formatted-link))))))
2.323+ (unless no-forward
2.324+ (with-current-buffer (marker-buffer source)
2.325+ (save-excursion
2.326+ (goto-char (marker-position source))
2.327+ (org-graph-edge-insert-relatedlink (car target-formatted-link) (cdr target-formatted-link)))))))
2.328+
2.329+
2.330+;;;###autoload
2.331+(defun org-graph-edge-convert-link-to-edge (arg)
2.332+ "Convert a normal `org-mode' link at `point' to a graph link, ARG prefix.
2.333+If variable `org-graph-edge-related-into-drawer' is non-nil move
2.334+the link into drawer.
2.335+
2.336+When called interactively with a `C-u' prefix argument ignore
2.337+variable `org-graph-edge-related-into-drawer' configuration and
2.338+do not modify existing link."
2.339+ (interactive "P")
2.340+ (let ((from-m (point-marker))
2.341+ (target (save-window-excursion
2.342+ (with-current-buffer (current-buffer)
2.343+ (save-excursion
2.344+ (org-open-at-point)
2.345+ (point-marker))))))
2.346+ (org-graph-edge--insert-link target (or arg (not org-graph-edge-related-into-drawer)))
2.347+ (goto-char (marker-position from-m)))
2.348+
2.349+ (when (and (not arg) (org-graph-edge-related-into-drawer))
2.350+ (let ((begin (org-element-property :begin (org-element-context)))
2.351+ (end (org-element-property :end (org-element-context))))
2.352+ (delete-region begin end))))
2.353+
2.354+;;;###autoload
2.355+(defun org-graph-edge-delete-link ()
2.356+ "Delete the link at point, and the corresponding reverse link.
2.357+If no reverse link exists, just delete link at point.
2.358+This works from either side, and deletes both sides of a link."
2.359+ (interactive)
2.360+ (save-window-excursion
2.361+ (with-current-buffer (current-buffer)
2.362+ (save-excursion
2.363+ (let ((id (org-id-get (point))))
2.364+ (org-open-at-point)
2.365+ (let ((link-element (org-graph-edge--find-link id)))
2.366+ (if link-element
2.367+ (org-graph-edge--delete-link link-element)
2.368+ (message "No backlink found. Deleting active only.")))))))
2.369+ (org-graph-edge--delete-link (org-element-context)))
2.370+
2.371+;;;###autoload
2.372+(defun org-graph-edge-store-link (&optional GOTO KEYS)
2.373+ "Store a point to register for use in function `org-graph-edge-insert-link'.
2.374+This is primarily intended to be called before `org-capture', but
2.375+could possibly even be used to replace `org-store-link' IF
2.376+function `org-graph-edge-insert-link' is used to replace
2.377+`org-insert-link'. This has not been thoroughly tested outside
2.378+of links to/form org files. GOTO and KEYS are unused."
2.379+ (interactive "P")
2.380+ (ignore GOTO)
2.381+ (ignore KEYS)
2.382+ (save-excursion
2.383+ ;; this is a hack. if the point is at the first char of a heading
2.384+ ;; the marker is not updated as expected when text is inserted
2.385+ ;; above the heading. for example a capture template inserted
2.386+ ;; above. that results in the link being to the heading above the
2.387+ ;; expected heading.
2.388+ (goto-char (line-end-position))
2.389+ (let ((c1 (make-marker)))
2.390+ (set-marker c1 (point) (current-buffer))
2.391+ (set-register ?^ c1)
2.392+ (message "Link copied"))))
2.393+
2.394+;; not sure if this should be autoloaded or left to config?
2.395+;;;###autoload
2.396+(advice-add 'org-capture :before #'org-graph-edge-store-link)
2.397+
2.398+;;;###autoload
2.399+(defun org-graph-edge-insert-link ()
2.400+ "Insert a super link from the register."
2.401+ (interactive)
2.402+ (let* ((target (get-register ?^)))
2.403+ (if target
2.404+ (progn
2.405+ (org-graph-edge--insert-link target)
2.406+ (set-register ?^ nil))
2.407+ (message "No link to insert!"))))
2.408+
2.409+;;;###autoload
2.410+(defun org-graph-edge-link ()
2.411+ "Insert a link and add a backlink to the target heading."
2.412+ (interactive)
2.413+ (org-graph-edge-search-function))
2.414+
2.415 (provide 'graph)
2.416 ;; graph.el ends here
3.1--- a/emacs/lib/inbox.el Fri Sep 13 20:30:55 2024 -0400
3.2+++ b/emacs/lib/inbox.el Sat Sep 14 22:13:06 2024 -0400
3.3@@ -71,13 +71,9 @@
3.4 "* %?\n%i"
3.5 :empty-lines 1)
3.6 ("t" "inbox-task" entry (file ,org-inbox-file) "* TODO %^{item}\n")
3.7- ("n" "inbox-note" entry (file ,org-inbox-file) "* NOTE %^{item}\n%a")
3.8- ("l" "inbox-link" entry (file ,org-inbox-file)
3.9- "* LINK %l")
3.10- ("L" "inbox-protocol-link" entry (file ,org-inbox-file)
3.11- "* LINK [[%:link][%:description]]\n%:initial" :empty-lines 1)
3.12+ ("n" "inbox-note" entry (file ,org-inbox-file) "* %^{item}\n%a")
3.13 ("w" "inbox-web-link" entry (file ,org-inbox-file)
3.14- "* LINK %?"
3.15+ "* %?"
3.16 :hook (lambda ()
3.17 (goto-char (pos-eol))
3.18 (org-web-tools-insert-link-for-url (org-web-tools--get-first-url))))
4.1--- a/emacs/lib/scrum.el Fri Sep 13 20:30:55 2024 -0400
4.2+++ b/emacs/lib/scrum.el Sat Sep 14 22:13:06 2024 -0400
4.3@@ -44,12 +44,27 @@
4.4 ;; patience to learn Org-mode. This package isn't for them. It's for
4.5 ;; small groups of like-minded Lispers :).
4.6
4.7-;; ref: https://www.scrum.org/resources/what-scrum-module
4.8+;;;; Refs
4.9+;; scrum: https://www.scrum.org/resources/what-scrum-module
4.10
4.11 ;; roadmap: https://compiler.company/plan/roadmap.html
4.12
4.13 ;; tasks: https://compiler.company/plan/tasks
4.14
4.15+;;;; API
4.16+
4.17+;; The API is still very much a WIP. Assume everything below to be
4.18+;; theoretical.
4.19+
4.20+;; - task dependencies
4.21+;; - refer to org-depend.el for implementation details
4.22+;; - org-trigger-hook and org-blocker-hook
4.23+;; - org-todo-state-tags-triggers
4.24+
4.25+;; - dynamic blocks
4.26+;; - scrumboard
4.27+;; - burndown
4.28+
4.29 ;;; Code:
4.30 (require 'ulang)
4.31 (require 'uml-mode)
5.1--- a/emacs/lib/ulang.el Fri Sep 13 20:30:55 2024 -0400
5.2+++ b/emacs/lib/ulang.el Sat Sep 14 22:13:06 2024 -0400
5.3@@ -25,6 +25,7 @@
5.4
5.5 ;;; Code:
5.6 (require 'org)
5.7+(require 'org-element)
5.8 (require 'ox)
5.9
5.10 (defgroup ulang nil
6.1--- a/lisp/bin/bin.asd Fri Sep 13 20:30:55 2024 -0400
6.2+++ b/lisp/bin/bin.asd Sat Sep 14 22:13:06 2024 -0400
6.3@@ -1,50 +1,45 @@
6.4 (defsystem :bin
6.5- :depends-on (:bin/organ :bin/homer :bin/rdb :bin/skel :bin/packy)
6.6- :in-order-to ((test-op (test-op "app/tests")))
6.7- :perform (test-op (o c) (symbol-call :rt :do-tests :app)))
6.8+ :depends-on (:bin/organ :bin/homer :bin/rdb :bin/skel :bin/packy :bin/core))
6.9
6.10 (defsystem :bin/organ
6.11 :build-operation program-op
6.12 :build-pathname "organ"
6.13- :entry-point "bin/organ::main"
6.14+ :entry-point "bin/organ::start-organ"
6.15 :depends-on (:uiop :cl-ppcre :std :cli :organ :nlp)
6.16- :components ((:file "organ"))
6.17- :in-order-to ((test-op (test-op "app/tests")))
6.18- :perform (test-op (o c) (symbol-call :rt :do-tests :app)))
6.19+ :components ((:file "organ")))
6.20
6.21 (defsystem :bin/homer
6.22 :build-operation program-op
6.23 :build-pathname "homer"
6.24- :entry-point "bin/homer::main"
6.25+ :entry-point "bin/homer::start-homer"
6.26 :depends-on (:uiop :cl-ppcre :std :cli
6.27 :organ :skel :nlp :rdb :packy :krypt)
6.28- :components ((:file "homer"))
6.29- :in-order-to ((test-op (test-op "app/tests")))
6.30- :perform (test-op (o c) (symbol-call :rt :do-tests :app)))
6.31+ :components ((:file "homer")))
6.32
6.33 (defsystem :bin/rdb
6.34 :build-operation "program-op"
6.35 :build-pathname "rdb"
6.36- :entry-point "bin/rdb::main"
6.37+ :entry-point "bin/rdb::start-rdb"
6.38 :depends-on (:uiop :cl-ppcre :std :rdb :cli)
6.39- :components ((:file "rdb"))
6.40- :in-order-to ((test-op (test-op "app/tests")))
6.41- :perform (test-op (o c) (symbol-call :rt :do-tests :app)))
6.42+ :components ((:file "rdb")))
6.43
6.44 (defsystem :bin/skel
6.45 :build-operation program-op
6.46 :build-pathname "skel"
6.47- :entry-point "bin/skel:main"
6.48+ :entry-point "bin/skel::start-skel"
6.49 :components ((:file "skel"))
6.50- :depends-on (:uiop :cl-ppcre :std :cli :skel)
6.51- :in-order-to ((test-op (test-op "app/tests")))
6.52- :perform (test-op (o c) (symbol-call :rt :do-tests :app)))
6.53+ :depends-on (:uiop :cl-ppcre :std :cli :skel))
6.54
6.55 (defsystem :bin/packy
6.56 :build-operation program-op
6.57 :build-pathname "packy"
6.58- :entry-point "bin/packy::main"
6.59+ :entry-point "bin/packy::start-packy"
6.60 :depends-on (:uiop :cl-ppcre :std :cli :packy :rdb)
6.61- :components ((:file "packy"))
6.62- :in-order-to ((test-op (test-op "app/tests")))
6.63- :perform (test-op (o c) (symbol-call :rt :do-tests :app)))
6.64+ :components ((:file "packy")))
6.65+
6.66+(defsystem :bin/core
6.67+ :build-operation program-op
6.68+ :build-pathname "core"
6.69+ :entry-point "bin/core::dispatch-core"
6.70+ :components ((:file "core"))
6.71+ :depends-on (:std :cli :log :bin/skel :bin/organ :bin/homer :bin/rdb :bin/packy))
7.1--- /dev/null Thu Jan 01 00:00:00 1970 +0000
7.2+++ b/lisp/bin/core.lisp Sat Sep 14 22:13:06 2024 -0400
7.3@@ -0,0 +1,18 @@
7.4+;;; core.lisp --- Core Multi-binary
7.5+
7.6+;; Contains all core binaries - dispatches on argv[0].
7.7+
7.8+;;; Code:
7.9+(defpackage :bin/core
7.10+ (:use :cl :std :sb-ext :cli :log))
7.11+
7.12+(in-package :bin/core)
7.13+
7.14+(define-multi-main dispatch-core
7.15+ (sb-impl::toplevel-init)
7.16+ (:skel (bin/skel::start-skel))
7.17+ (:packy (bin/packy::start-packy))
7.18+ (:rdb (bin/rdb::start-rdb))
7.19+ (:organ (bin/organ::start-organ))
7.20+ (:homer (bin/homer::start-homer)))
7.21+
8.1--- a/lisp/bin/homer.lisp Fri Sep 13 20:30:55 2024 -0400
8.2+++ b/lisp/bin/homer.lisp Sat Sep 14 22:13:06 2024 -0400
8.3@@ -4,7 +4,7 @@
8.4 (defpackage :bin/homer
8.5 (:nicknames :homer)
8.6 (:use :cl :std :log :sxp :rdb :skel :packy :cli :obj/id :krypt :vc)
8.7- (:export :main :*home-config*))
8.8+ (:export :*home-config*))
8.9
8.10 (in-package :bin/homer)
8.11 (defvar *user* (sb-posix:getenv "USER"))
8.12@@ -181,7 +181,7 @@
8.13 (find-files src *home-hidden-paths*)))
8.14 (error 'file-error :pathname src))))
8.15
8.16-(define-cli *cli*
8.17+(define-cli *homer-cli*
8.18 :name "homer"
8.19 :version "0.1.0"
8.20 :description "user home manager"
8.21@@ -198,13 +198,13 @@
8.22
8.23 (defun run ()
8.24 (let ((*log-level* :info))
8.25- (with-cli (*cli* opts cmds args) (cli:args)
8.26+ (with-cli (*homer-cli* opts cmds args) (cli:args)
8.27 (init-homer-vars)
8.28 (load-homerc)
8.29 (do-cmd *cli*)
8.30 (debug-opts *cli*))))
8.31
8.32-(defmain ()
8.33+(defmain start-homer ()
8.34 (let ((*print-readably* t))
8.35 (run)
8.36 (sb-ext:exit :code 0)))
9.1--- a/lisp/bin/organ.lisp Fri Sep 13 20:30:55 2024 -0400
9.2+++ b/lisp/bin/organ.lisp Sat Sep 14 22:13:06 2024 -0400
9.3@@ -4,8 +4,7 @@
9.4
9.5 ;;; Code:
9.6 (defpackage :bin/organ
9.7- (:use :cl :organ :std :cli :log :clap)
9.8- (:export :main))
9.9+ (:use :cl :organ :std :cli :log :clap))
9.10
9.11 (in-package :bin/organ)
9.12 (defopt organ-help (print-help *cli*))
9.13@@ -33,7 +32,7 @@
9.14 (let ((input (if *args* (car *args*) #P"readme.org")))
9.15 (describe (org-parse :document input))))
9.16
9.17-(define-cli *cli*
9.18+(define-cli *organ-cli*
9.19 :name "organ"
9.20 :version "0.0.1"
9.21 :description "org-mode toolbox"
9.22@@ -57,10 +56,9 @@
9.23
9.24 (defun run ()
9.25 (let ((*log-level* :info))
9.26- (with-cli (*cli* opts cmds args) (cli:args)
9.27+ (with-cli (*organ-cli* opts cmds args) (cli:args)
9.28 (do-cmd *cli*)
9.29 (debug-opts *cli*))))
9.30
9.31-(defmain ()
9.32- (run)
9.33- (sb-ext:exit :code 0))
9.34+(defmain start-organ ()
9.35+ (run))
10.1--- a/lisp/bin/packy.lisp Fri Sep 13 20:30:55 2024 -0400
10.2+++ b/lisp/bin/packy.lisp Sat Sep 14 22:13:06 2024 -0400
10.3@@ -1,6 +1,5 @@
10.4 (defpackage :bin/packy
10.5- (:use :cl :std :sb-ext :cli :packy :clap :log)
10.6- (:export :main))
10.7+ (:use :cl :std :sb-ext :cli :packy :clap :log))
10.8
10.9 (in-package :bin/packy)
10.10
10.11@@ -12,7 +11,7 @@
10.12 (defopt pk-target (setq *pk-targets* *arg*))
10.13 (defcmd pk-show (print (list *optc* *argc* *opts* *args* *pk-targets*)))
10.14
10.15-(define-cli *cli*
10.16+(define-cli *packy-cli*
10.17 :name "packy"
10.18 :version "0.1.0"
10.19 :description "Universal Package Manager"
10.20@@ -26,11 +25,11 @@
10.21
10.22 (defun run ()
10.23 (let ((*log-level* :info))
10.24- (with-cli (*cli* opts cmds args) (cli:args)
10.25+ (with-cli (*packy-cli* opts cmds args) (cli:args)
10.26 (do-cmd *cli*)
10.27 (debug-opts *cli*))))
10.28
10.29-(defmain ()
10.30+(defmain start-packy ()
10.31 (let ((*print-readably* t))
10.32 (run)
10.33 (sb-ext:exit :code 0)))
11.1--- a/lisp/bin/rdb.lisp Fri Sep 13 20:30:55 2024 -0400
11.2+++ b/lisp/bin/rdb.lisp Sat Sep 14 22:13:06 2024 -0400
11.3@@ -2,8 +2,7 @@
11.4
11.5 ;;; Code:
11.6 (uiop:define-package :bin/rdb
11.7- (:use :cl :rdb :std :cli/clap :log :clap)
11.8- (:export :main))
11.9+ (:use :cl :rdb :std :cli/clap :log :clap))
11.10
11.11 (in-package :bin/rdb)
11.12 (rocksdb:load-rocksdb t)
11.13@@ -70,7 +69,7 @@
11.14 (sb-ext:string-to-octets (string (gensym "foo")))
11.15 val)))))
11.16
11.17-(define-cli *cli*
11.18+(define-cli *rdb-cli*
11.19 :name "rdb"
11.20 :version "0.1.0"
11.21 :thunk 'rdb-show
11.22@@ -88,9 +87,9 @@
11.23 (:name fuzz :thunk rdb-fuzz)
11.24 (:name destroy :thunk rdb-destroy)))
11.25
11.26-(defmain ()
11.27+(defmain start-rdb ()
11.28 (let ((*log-level* :info))
11.29- (with-slots (opts cmds args) *cli*
11.30+ (with-cli (*rdb-cli* opts cmds args) ()
11.31 (do-opts (active-opts *cli* t))
11.32 (if (active-cmds *cli*)
11.33 (let ((*rdb* (create-db (do-opt (car (find-opts *cli* "db"))))))
12.1--- a/lisp/bin/skel.lisp Fri Sep 13 20:30:55 2024 -0400
12.2+++ b/lisp/bin/skel.lisp Sat Sep 14 22:13:06 2024 -0400
12.3@@ -8,8 +8,7 @@
12.4 :vc :sb-ext :skel :log :cli/clap/util
12.5 :dat/sxp #+tools :skel/tools/viz)
12.6 (:import-from :cli/shell :*shell-input* :*shell-directory*)
12.7- (:use :cli/tools/sbcl)
12.8- (:export :main))
12.9+ (:use :cli/tools/sbcl))
12.10
12.11 (in-package :bin/skel)
12.12 (in-readtable :shell)
12.13@@ -232,7 +231,7 @@
12.14 (defcmd skc-new
12.15 (trace! *args* *opts*))
12.16
12.17-(define-cli *cli*
12.18+(define-cli *skel-cli*
12.19 :name "skel"
12.20 :version #.(format nil "0.1.1:~A" (read-line (sb-ext:process-output (vc:run-hg-command "id" '("-i") :stream))))
12.21 :description "A hacker's project compiler."
12.22@@ -340,16 +339,16 @@
12.23 :description "open the sk-shell interpreter"
12.24 :thunk skc-shell)))
12.25
12.26-(defmain ()
12.27+(defmain start-skel ()
12.28 (in-package :sk-user)
12.29 (let ((*log-level* :info))
12.30 (in-readtable :shell)
12.31- (with-cli (*cli* opts cmds) (cli:args)
12.32+ (with-cli (*skel-cli* opts cmds) (cli:args)
12.33 (debug-opts *cli*)
12.34 (init-skel-vars)
12.35 (when-let ((project (find-skelfile #P".")))
12.36 (let ((*default-pathname-defaults* (pathname (directory-namestring project))))
12.37 (setq *skel-project* (load-skelfile project))
12.38 (setq *skel-path* (sk-src *skel-project*))
12.39- (setq *shell-directory* (sk-src *skel-project*))))
12.40+ (setq cli/shell:*shell-directory* (sk-src *skel-project*))))
12.41 (do-cmd *cli*))))
13.1--- a/lisp/lib/cli/clap/cli.lisp Fri Sep 13 20:30:55 2024 -0400
13.2+++ b/lisp/lib/cli/clap/cli.lisp Sat Sep 14 22:13:06 2024 -0400
13.3@@ -29,16 +29,14 @@
13.4 :opts (make-opts ',opts)
13.5 :cmds (make-cmds ',cmds)))))
13.6
13.7-(defmacro defmain ((&key (exit t) (export t)) &body body)
13.8+(defmacro defmain (name (&key (exit t)) &body body)
13.9 "Define a CLI main function in the current package."
13.10- (let ((main (symbolicate "MAIN")))
13.11- `(let ((*no-exit* ,(not exit)))
13.12- (defun ,main ()
13.13- "Run the top-level function and print to *STDOUT*."
13.14- (with-cli-handlers
13.15- (progn
13.16- ,@body)))
13.17- ,@(when export `((export ',main))))))
13.18+ `(let ((*no-exit* ,(not exit)))
13.19+ (defun ,name ()
13.20+ "Run the top-level function and print to *STDOUT*."
13.21+ (with-cli-handlers
13.22+ (progn
13.23+ ,@body)))))
13.24
13.25 ;; RESEARCH 2023-09-12: closed over hash-table with short/long flags
13.26 ;; to avoid conflicts. if not, need something like a flag-function
14.1--- a/lisp/lib/cli/multi.lisp Fri Sep 13 20:30:55 2024 -0400
14.2+++ b/lisp/lib/cli/multi.lisp Sat Sep 14 22:13:06 2024 -0400
14.3@@ -27,7 +27,7 @@
14.4 ;;; Code:
14.5 (in-package :cli/multi)
14.6
14.7-(defmacro define-multi-main ((&key default (exit t) (export t)) &rest mains)
14.8+(defmacro define-multi-main (name default &rest mains)
14.9 "Define a MAIN function for the current package which dispatches
14.10 based on the value of '(ARG0)' at runtime to one of the pairs in
14.11 MAINS.
14.12@@ -39,9 +39,10 @@
14.13 When you save an executable lisp image with this function you should
14.14 arrange for symlinks for each handled value of (ARG0) to be generated
14.15 ."
14.16- `(cli/clap::defmain (:exit ,exit :export ,export)
14.17- (string-case ((pathname-name (arg0)) :default ,default)
14.18- ,@mains)))
14.19+ `(defun ,name ()
14.20+ (case (keywordicate (string-upcase (pathname-name (clap:arg0))))
14.21+ ,@mains
14.22+ (t ,default))))
14.23
14.24 (defun make-symlinks (src &optional directory &rest names)
14.25 "Make a set of symlinks from SRC to NAMES.
15.1--- a/lisp/lib/cli/tests.lisp Fri Sep 13 20:30:55 2024 -0400
15.2+++ b/lisp/lib/cli/tests.lisp Sat Sep 14 22:13:06 2024 -0400
15.3@@ -682,13 +682,13 @@
15.4 (signals clap-unknown-argument
15.5 (proc-args *cli* '("--log" "default" "--foo=11"))))
15.6
15.7-(defmain (:exit nil :export nil)
15.8+(defmain foo-main (:exit nil :export nil)
15.9 (with-cli (*cli*) ()
15.10 (log:trace! "defmain is OK")
15.11 t))
15.12
15.13 (deftest clap-main ()
15.14- (is (null (funcall #'main))))
15.15+ (is (null (funcall #'foo-main))))
15.16
15.17 (deftest sbcl-tools ()
15.18 (with-sbcl (:noinform t :quit t)
16.1--- a/lisp/lib/cli/tools/sbcl.lisp Fri Sep 13 20:30:55 2024 -0400
16.2+++ b/lisp/lib/cli/tools/sbcl.lisp Sat Sep 14 22:13:06 2024 -0400
16.3@@ -46,5 +46,6 @@
16.4 a PROGN and passed to the --eval flag."
16.5 `(run-sbcl ,@(when keys (parse-sbcl-option-keys keys))
16.6 ,@(when body
16.7- (list "--eval"
16.8- (with-output-to-string (s) (pprint `(progn ,@body) s))))))
16.9+ (flatten
16.10+ (mapcar (lambda (x) (list "--eval" (with-output-to-string (s) (prin1 x s))))
16.11+ body)))))
17.1--- a/lisp/std/defpkg.lisp Fri Sep 13 20:30:55 2024 -0400
17.2+++ b/lisp/std/defpkg.lisp Sat Sep 14 22:13:06 2024 -0400
17.3@@ -738,9 +738,7 @@
17.4 (:export ,@pkg-externs)))))
17.5
17.6
17.7-(defmacro with-package ((pkg) &body body)
17.8+(defmacro with-package (pkg &body body)
17.9 "Execute BODY within the package PKG."
17.10- `(let ((current (package-name *package*)))
17.11- (unwind-protect (progn (in-package ,pkg) ,@body)
17.12- (eval-when (:compile-toplevel :load-toplevel :execute)
17.13- (setq *package* (find-package current))))))
17.14+ `(let ((*package* ,@(when pkg `((find-package ,pkg)))))
17.15+ ,@body))
18.1--- a/lisp/std/pkg.lisp Fri Sep 13 20:30:55 2024 -0400
18.2+++ b/lisp/std/pkg.lisp Sat Sep 14 22:13:06 2024 -0400
18.3@@ -458,7 +458,8 @@
18.4 :save-lisp-tree-shake-and-die
18.5 :save-lisp-and-live
18.6 :forget-shared-object
18.7- :forget-shared-objects))
18.8+ :forget-shared-objects
18.9+ :compile-lisp))
18.10
18.11 (defpkg :std
18.12 (:use :cl :sb-unicode :cl-ppcre :sb-mop :sb-c :sb-thread :sb-alien :sb-gray :sb-concurrency)
19.1--- a/lisp/std/sys.lisp Fri Sep 13 20:30:55 2024 -0400
19.2+++ b/lisp/std/sys.lisp Sat Sep 14 22:13:06 2024 -0400
19.3@@ -105,6 +105,24 @@
19.4 :test 'string-equal))
19.5 t))
19.6
19.7-(defun forget-shared-objects ()
19.8+(defun forget-shared-objects (&optional (objects sb-sys:*shared-objects*))
19.9 "Set the DONT-SAVE slot of all objects in SB-SYS:*SHARED-OBJECTS* to T."
19.10- (mapcar (lambda (obj) (setf (sb-alien::shared-object-dont-save obj) t)) sb-sys:*shared-objects*))
19.11+ (mapcar (lambda (obj) (setf (sb-alien::shared-object-dont-save obj) t)) objects))
19.12+
19.13+(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))
19.14+ (pkg:with-package (or package *package*)
19.15+ (asdf:compile-system name :force force :verbose verbose :version version)
19.16+ (when make
19.17+ (apply 'asdf:make name (unless (eq t make) make)))
19.18+ (when forget
19.19+ (forget-shared-objects (unless (eq t forget) forget)))
19.20+ (when save
19.21+ (when (probe-file save)
19.22+ (delete-file save))
19.23+ (sb-ext:save-lisp-and-die save :executable executable
19.24+ :toplevel toplevel
19.25+ :callable-exports callable-exports
19.26+ :save-runtime-options save-runtime-options
19.27+ :root-structures root-structures
19.28+ :purify purify
19.29+ :compression compression))))
20.1--- a/skelfile Fri Sep 13 20:30:55 2024 -0400
20.2+++ b/skelfile Sat Sep 14 22:13:06 2024 -0400
20.3@@ -18,6 +18,7 @@
20.4 psl.dat parquet.json rgb.txt
20.5 compile save-std save-prelude save-user
20.6 save-infra save-core save-tests build-rdb
20.7+ build-core
20.8 build-skel build-organ build-homer build-packy
20.9 fasl rust-bin build-tree-sitter-alien))
20.10 (clean ()
20.11@@ -95,7 +96,10 @@
20.12 (asdf:make :bin/packy))
20.13 #$mv lisp/bin/packy .stash/packy$#))
20.14 (compile () #$./x.lisp compile$#)
20.15- (std () (:save () #$./x.lisp save std$#))
20.16+ (std () (:save () (with-sbcl (:noinform t :quit t)
20.17+ (ql:quickload :std)
20.18+ (in-package :std-user)
20.19+ (compile-lisp :std :save ".stash/std.core"))))
20.20 (prelude ()
20.21 (:save () #$./x.lisp save prelude$#)
20.22 (:compile () #$./x.lisp make prelude$#))
20.23@@ -104,8 +108,15 @@
20.24 (:compile () #$./x.lisp make user$#))
20.25 (infra () (:save () #$./x.lisp save infra$#))
20.26 (core ()
20.27- (:save () #$./x.lisp save core$#)
20.28- (:compile () #$./x.lisp make core$#))
20.29+ (:build () (with-sbcl (:noinform t :quit t)
20.30+ (ql:quickload :bin/core)
20.31+ (asdf:make :bin/core))
20.32+ #$mv lisp/bin/core .stash/core$#)
20.33+ (:save () (with-sbcl (:noinform t :quit t)
20.34+ (ql:quickload (list :std :core))
20.35+ (in-package :std-user)
20.36+ (compile-lisp :core :save ".stash/core.core")))
20.37+ (:compile () (compile-lisp :core :force t :verbose t)))
20.38 (tests ()
20.39 (:save () #$./x.lisp save tests$#)
20.40 (:compile () #$./x.lisp make core/tests$#))
21.1--- a/x.lisp Fri Sep 13 20:30:55 2024 -0400
21.2+++ b/x.lisp Sat Sep 14 22:13:06 2024 -0400
21.3@@ -210,7 +210,6 @@
21.4 (asdf:load-system sys)
21.5 (in-package :std-user)
21.6 (asdf:make sys)
21.7- ()
21.8 (stash-output sys)
21.9 (println :OK)))
21.10
