1.1--- a/emacs/default.el Fri Aug 16 21:27:00 2024 -0400
1.2+++ b/emacs/default.el Sat Aug 17 23:42:08 2024 -0400
1.3@@ -69,6 +69,7 @@
1.4
1.5 (defvar default-theme 'leuven-dark)
1.6 (defvar company-source-directory (join-paths user-home-directory "comp"))
1.7+(defvar company-org-directory (join-paths company-source-directory "org"))
1.8 (defvar company-domain "compiler.company")
1.9 (defvar company-name "The Compiler Company, LLC")
1.10 (defvar company-vc-domain "vc.compiler.company")
1.11@@ -747,7 +748,7 @@
1.12 (setq org-id-link-to-org-use-id t)
1.13 ;; capture templates
1.14 (setq org-capture-templates
1.15- '(("t" "task" entry (file "inbox.org") "* %^{title}\n- %?" :prepend t)
1.16+ '(("t" "task" entry (file "core.org") "* %^{title}\n- %?" :prepend t)
1.17 ("1" "current-task-item" item (clock) "%i%?")
1.18 ("2" "current-task-checkbox" checkitem (clock) "%i%?")
1.19 ("3" "current-task-region" plain (clock) "%i" :immediate-finish t :empty-lines 1)
1.20@@ -758,6 +759,10 @@
1.21 ("i" "idea" entry (file "inbox.org") "* OUTLINE %?\n:notes:\n:end:\n- _outline_ [/]\n - [ ] \n - [ ] \n- _refs_" :prepend t)
1.22 ("b" "bug" entry (file "inbox.org") "* FIX %?\n- _review_\n- _fix_\n- _test_" :prepend t)
1.23 ("r" "research" entry (file "inbox.org") "* RESEARCH %?\n:notes:\n:end:\n- _refs_" :prepend t)))
1.24+
1.25+(setq org-default-notes-file (join-paths org-directory "inbox.org")
1.26+ org-capture-use-agenda-date t)
1.27+
1.28 (setq org-html-htmlize-output-type 'css
1.29 org-html-head-include-default-style nil
1.30 ;; cc default
1.31@@ -786,21 +791,24 @@
1.32
1.33 org-refile-targets '((nil :maxlevel . 3)
1.34 (org-agenda-files :maxlevel . 3))
1.35- org-agenda-files (list "inbox.org")
1.36+ ;; org-agenda-files (list "inbox.org")
1.37+ org-agenda-include-diary t
1.38+ org-agenda-include-inactive-timestamps t
1.39 org-confirm-babel-evaluate nil
1.40 org-src-fontify-natively t
1.41 org-src-tabs-act-natively t
1.42 org-footnote-section nil
1.43 org-log-into-drawer t
1.44+ org-log-refile 'time
1.45+ org-log-redeadline 'time
1.46 org-log-states-order-reversed nil
1.47 org-clock-persist 'history)
1.48
1.49-(setq org-stuck-projects '("+PROJECT/-DONE" ("NEXT") nil ""))
1.50-
1.51 (add-hook 'after-init-hook #'org-clock-persistence-insinuate)
1.52
1.53 ;; archive
1.54 (setq org-archive-location "archive.org::")
1.55+
1.56 (defun extract-org-directory-titles-as-list (&optional dir)
1.57 (interactive "D")
1.58 (print
1.59@@ -978,6 +986,9 @@
1.60 t nil))))
1.61
1.62 ;;;; Agenda
1.63+(require 'org-agenda)
1.64+(cl-pushnew '("w" "Work in progress tasks" ((todo "WIP") (agenda))) org-agenda-custom-commands)
1.65+
1.66 (defvar org-agenda-overriding-header)
1.67 (defvar org-agenda-sorting-strategy)
1.68 (defvar org-agenda-restrict)
1.69@@ -1080,17 +1091,14 @@
1.70 :html translation-html
1.71 :utf-8 translation-utf-8)))))))
1.72
1.73-;;; Glossary
1.74-(use-package org-glossary
1.75- :vc (:url "https://github.com/tecosaur/org-glossary.git" :branch "master")
1.76- :after org)
1.77+;;; Dictionary
1.78+(setq dictionary-server "compiler.company"
1.79+ switch-to-buffer-obey-display-actions t)
1.80
1.81-;;; Dictionary
1.82-(setq switch-to-buffer-obey-display-actions t)
1.83-(add-to-list 'display-buffer-alist
1.84- '("^\\*Dictionary\\*" display-buffer-in-side-window
1.85- (side . right)))
1.86-
1.87+;;; Ispell
1.88+;; requires aspell and a hunspell dictionary (hunspell-en_us)
1.89+(setq-default ispell-program-name "aspell")
1.90+(add-hook 'mail-send-hook #'ispell-message)
1.91
1.92 ;;; Skel
1.93 (add-to-load-path user-emacs-lib-directory)
2.1--- a/emacs/lib/inbox.el Fri Aug 16 21:27:00 2024 -0400
2.2+++ b/emacs/lib/inbox.el Sat Aug 17 23:42:08 2024 -0400
2.3@@ -19,8 +19,8 @@
2.4
2.5 ;;; Commentary:
2.6
2.7-;; This is The Compiler Company inbox system. The main interface is
2.8-;; the inbox.org file which manages personal tasks.
2.9+;; This is the elisp interface to the CC Inbox system. The main
2.10+;; interface is the inbox.org file which manages personal tasks.
2.11
2.12 ;; Users may use `org-capture' to insert tasks and notes into their
2.13 ;; own `org-inbox-file' and refactor them to a more sensible
2.14@@ -28,10 +28,16 @@
2.15
2.16 ;;; Code:
2.17 (require 'org)
2.18+(require 'org-agenda)
2.19 (require 'default)
2.20+(require 'uml-mode)
2.21+(require 'eieio)
2.22+(require 'org-expiry)
2.23+
2.24 (defgroup inbox nil
2.25- "RW Inbox")
2.26+ "CC Inbox")
2.27
2.28+;;; Vars
2.29 (defcustom org-inbox-file
2.30 (concat (file-name-as-directory org-directory) "inbox.org")
2.31 "Custom inbox file location."
2.32@@ -44,6 +50,15 @@
2.33 :type 'string
2.34 :group 'inbox)
2.35
2.36+(defvar org-inbox-buffer-name "*Inbox*"
2.37+ "The name of the org-inbox buffer.")
2.38+
2.39+(defvar org-inbox-properties
2.40+ '("NEXT" "PREV" "FROM" "TO" "OWNER" "PROJECT" "BLOCKER"))
2.41+
2.42+(defvar org-inbox-db-schema
2.43+ '(id file node edge contents properties schedule))
2.44+;;; Utils
2.45 ;; `org-archive-all-done' doesn't work the way we want. This function
2.46 ;; will archive all done tasks in the current subtree, or the whole file
2.47 ;; if prefix arg is given.
2.48@@ -200,5 +215,19 @@
2.49 (interactive)
2.50 (org-sort-entries nil ?f #'org-sort-todo-priority #'org-sort-compare-todo-priority))
2.51
2.52+(defun org-inbox-open ()
2.53+ "Open `org-inbox-file' or switch to its buffer if already open."
2.54+ (interactive)
2.55+ (if-let ((inbox (get-buffer org-inbox-buffer-name)))
2.56+ (switch-to-buffer inbox)
2.57+ (find-file org-inbox-file)
2.58+ (rename-buffer org-inbox-buffer-name)))
2.59+
2.60+(defun org-inbox-close ()
2.61+ "Close the org-inbox and associated buffers."
2.62+ (interactive)
2.63+ (when-let ((inbox (get-buffer org-inbox-buffer-name)))
2.64+ (kill-buffer inbox)))
2.65+
2.66 (provide 'inbox)
2.67 ;; inbox.el ends here
5.1--- /dev/null Thu Jan 01 00:00:00 1970 +0000
5.2+++ b/emacs/lib/org-expiry.el Sat Aug 17 23:42:08 2024 -0400
5.3@@ -0,0 +1,370 @@
5.4+;;; org-expiry.el --- expiry mechanism for Org entries -*- lexical-binding: t; -*-
5.5+;;
5.6+;; Copyright 2007-2021 Free Software Foundation, Inc.
5.7+;;
5.8+;; Author: Bastien Guerry <bzg@gnu.org>
5.9+;; Version: 0.2
5.10+;; Keywords: org, expiry
5.11+;; Homepage: https://git.sr.ht/~bzg/org-contrib
5.12+
5.13+;; This file is not part of GNU Emacs.
5.14+
5.15+;; This program is free software; you can redistribute it and/or modify
5.16+;; it under the terms of the GNU General Public License as published by
5.17+;; the Free Software Foundation; either version 3, or (at your option)
5.18+;; any later version.
5.19+;;
5.20+;; This program is distributed in the hope that it will be useful,
5.21+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
5.22+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
5.23+;; GNU General Public License for more details.
5.24+;;
5.25+;; You should have received a copy of the GNU General Public License
5.26+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
5.27+;;
5.28+;;; Commentary:
5.29+;;
5.30+;; This gives you a chance to get rid of old entries in your Org files
5.31+;; by expiring them.
5.32+;;
5.33+;; By default, entries that have no EXPIRY property are considered to be
5.34+;; new (i.e. 0 day old) and only entries older than one year go to the
5.35+;; expiry process, which consist in adding the ARCHIVE tag. None of
5.36+;; your tasks will be deleted with the default settings.
5.37+;;
5.38+;; When does an entry expires?
5.39+;;
5.40+;; Consider this entry:
5.41+;;
5.42+;; * Stop watching TV
5.43+;; :PROPERTIES:
5.44+;; :CREATED: <2008-01-07 lun 08:01>
5.45+;; :EXPIRY: <2008-01-09 08:01>
5.46+;; :END:
5.47+;;
5.48+;; This entry will expire on the 9th, january 2008.
5.49+
5.50+;; * Stop watching TV
5.51+;; :PROPERTIES:
5.52+;; :CREATED: <2008-01-07 lun 08:01>
5.53+;; :EXPIRY: +1w
5.54+;; :END:
5.55+;;
5.56+;; This entry will expire on the 14th, january 2008, one week after its
5.57+;; creation date.
5.58+;;
5.59+;; What happen when an entry is expired? Nothing until you explicitly
5.60+;; M-x org-expiry-process-entries When doing this, org-expiry will check
5.61+;; for expired entries and request permission to process them.
5.62+;;
5.63+;; Processing an expired entries means calling the function associated
5.64+;; with `org-expiry-handler-function'; the default is to add the tag
5.65+;; :ARCHIVE:, but you can also add a EXPIRED keyword or even archive
5.66+;; the subtree.
5.67+;;
5.68+;; Is this useful? Well, when you're in a brainstorming session, it
5.69+;; might be useful to know about the creation date of an entry, and be
5.70+;; able to archive those entries that are more than xxx days/weeks old.
5.71+;;
5.72+;; When you're in such a session, you can insinuate org-expiry like
5.73+;; this: M-x org-expiry-insinuate
5.74+;;
5.75+;; Then, each time you're pressing M-RET to insert an item, the CREATION
5.76+;; property will be automatically added. Same when you're scheduling or
5.77+;; deadlining items. You can deinsinuate: M-x org-expiry-deinsinuate
5.78+
5.79+;;; Code:
5.80+
5.81+(require 'org)
5.82+
5.83+;;; User variables:
5.84+
5.85+(defgroup org-expiry nil
5.86+ "Org expiry process."
5.87+ :tag "Org Expiry"
5.88+ :group 'org)
5.89+
5.90+(defcustom org-expiry-inactive-timestamps nil
5.91+ "Insert inactive timestamps for created/expired properties."
5.92+ :type 'boolean
5.93+ :group 'org-expiry)
5.94+
5.95+(defcustom org-expiry-created-property-name "CREATED"
5.96+ "The name of the property for setting the creation date."
5.97+ :type 'string
5.98+ :group 'org-expiry)
5.99+
5.100+(defcustom org-expiry-expiry-property-name "EXPIRY"
5.101+ "The name of the property for setting the expiry date/delay."
5.102+ :type 'string
5.103+ :group 'org-expiry)
5.104+
5.105+(defcustom org-expiry-keyword "EXPIRED"
5.106+ "The default keyword for `org-expiry-add-keyword'."
5.107+ :type 'string
5.108+ :group 'org-expiry)
5.109+
5.110+(defcustom org-expiry-wait "+1y"
5.111+ "Time span between the creation date and the expiry.
5.112+The default value for this variable (\"+1y\") means that entries
5.113+will expire if there are at least one year old.
5.114+
5.115+If the expiry delay cannot be retrieved from the entry or the
5.116+subtree above, the expiry process compares the expiry delay with
5.117+`org-expiry-wait'. This can be either an ISO date or a relative
5.118+time specification. See `org-read-date' for details."
5.119+ :type 'string
5.120+ :group 'org-expiry)
5.121+
5.122+(defcustom org-expiry-created-date "+0d"
5.123+ "The default creation date.
5.124+The default value of this variable (\"+0d\") means that entries
5.125+without a creation date will be handled as if they were created
5.126+today.
5.127+
5.128+If the creation date cannot be retrieved from the entry or the
5.129+subtree above, the expiry process will compare the expiry delay
5.130+with this date. This can be either an ISO date or a relative
5.131+time specification. See `org-read-date' for details on relative
5.132+time specifications."
5.133+ :type 'string
5.134+ :group 'org-expiry)
5.135+
5.136+(defcustom org-expiry-handler-function 'org-toggle-archive-tag
5.137+ "Function to process expired entries.
5.138+Possible candidates for this function are:
5.139+
5.140+`org-toggle-archive-tag'
5.141+`org-expiry-add-keyword'
5.142+`org-expiry-archive-subtree'"
5.143+ :type 'function
5.144+ :group 'org-expiry)
5.145+
5.146+(defcustom org-expiry-confirm-flag t
5.147+ "Non-nil means confirm expiration process."
5.148+ :type '(choice
5.149+ (const :tag "Always require confirmation" t)
5.150+ (const :tag "Do not require confirmation" nil)
5.151+ (const :tag "Require confirmation in interactive expiry process"
5.152+ interactive))
5.153+ :group 'org-expiry)
5.154+
5.155+(defcustom org-expiry-advised-functions
5.156+ '(org-scheduled org-deadline org-time-stamp)
5.157+ "A list of advised functions.
5.158+`org-expiry-insinuate' will activate the expiry advice for these
5.159+functions. `org-expiry-deinsinuate' will deactivate them."
5.160+ :type 'boolean
5.161+ :group 'list)
5.162+
5.163+;;; Advices and insinuation:
5.164+
5.165+(define-advice org-schedule (:after (&rest _) org-schedule-update-created)
5.166+ "Update the creation-date property when calling `org-schedule'."
5.167+ (org-expiry-insert-created))
5.168+
5.169+(define-advice org-deadline (:after (&rest _) org-deadline-update-created)
5.170+ "Update the creation-date property when calling `org-deadline'."
5.171+ (org-expiry-insert-created))
5.172+
5.173+(define-advice org-time-stamp (:after (&rest _) org-time-stamp-update-created)
5.174+ "Update the creation-date property when calling `org-time-stamp'."
5.175+ (org-expiry-insert-created))
5.176+
5.177+(defun org-expiry-insinuate (&optional arg)
5.178+ "Add hooks and activate advices for org-expiry.
5.179+If ARG, also add a hook to `before-save-hook' in `org-mode' and
5.180+restart `org-mode' if necessary."
5.181+ (interactive "P")
5.182+ (ad-activate 'org-schedule)
5.183+ (ad-activate 'org-time-stamp)
5.184+ (ad-activate 'org-deadline)
5.185+ (add-hook 'org-insert-heading-hook 'org-expiry-insert-created)
5.186+ (add-hook 'org-after-todo-state-change-hook 'org-expiry-insert-created)
5.187+ (add-hook 'org-after-tags-change-hook 'org-expiry-insert-created)
5.188+ (when arg
5.189+ (add-hook 'org-mode-hook
5.190+ (lambda() (add-hook 'before-save-hook
5.191+ 'org-expiry-process-entries t t)))
5.192+ ;; need this to refresh org-mode hooks
5.193+ (when (eq major-mode 'org-mode)
5.194+ (org-mode)
5.195+ (if (called-interactively-p 'any)
5.196+ (message "Org-expiry insinuated, `org-mode' restarted.")))))
5.197+
5.198+(defun org-expiry-deinsinuate (&optional arg)
5.199+ "Remove hooks and deactivate advices for org-expiry.
5.200+If ARG, also remove org-expiry hook in Org's `before-save-hook'
5.201+and restart `org-mode' if necessary."
5.202+ (interactive "P")
5.203+ (advice-remove 'org-schedule #'org-schedule@org-schedule-update-created)
5.204+ (advice-remove 'org-time-stamp #'org-time-stamp@org-time-stamp-update-created)
5.205+ (advice-remove 'org-deadline #'org-deadline@org-deadline-update-created)
5.206+ (remove-hook 'org-insert-heading-hook 'org-expiry-insert-created)
5.207+ (remove-hook 'org-after-todo-state-change-hook 'org-expiry-insert-created)
5.208+ (remove-hook 'org-after-tags-change-hook 'org-expiry-insert-created)
5.209+ (remove-hook 'org-mode-hook
5.210+ (lambda() (add-hook 'before-save-hook
5.211+ 'org-expiry-process-entries t t)))
5.212+ (when arg
5.213+ ;; need this to refresh org-mode hooks
5.214+ (when (eq major-mode 'org-mode)
5.215+ (org-mode)
5.216+ (if (called-interactively-p 'any)
5.217+ (message "Org-expiry de-insinuated, `org-mode' restarted.")))))
5.218+
5.219+;;; org-expiry-expired-p:
5.220+
5.221+(defun org-expiry-expired-p ()
5.222+ "Check if the entry at point is expired.
5.223+Return nil if the entry is not expired. Otherwise return the
5.224+amount of time between today and the expiry date.
5.225+
5.226+If there is no creation date, use `org-expiry-created-date'.
5.227+If there is no expiry date, use `org-expiry-wait'."
5.228+ (let* ((ex-prop org-expiry-expiry-property-name)
5.229+ (cr-prop org-expiry-created-property-name)
5.230+ (ct (current-time))
5.231+ (cr (org-read-date nil t (or (org-entry-get (point) cr-prop t)
5.232+ org-expiry-created-date)))
5.233+ (ex-field (or (org-entry-get (point) ex-prop t) org-expiry-wait))
5.234+ (ex (if (string-match "^[ \t]?[+-]" ex-field)
5.235+ (time-add cr (time-subtract (org-read-date nil t ex-field) ct))
5.236+ (org-read-date nil t ex-field))))
5.237+ (if (time-less-p ex ct)
5.238+ (time-subtract ct ex))))
5.239+
5.240+;;; Expire an entry or a region/buffer:
5.241+
5.242+(defun org-expiry-process-entry (&optional force)
5.243+ "Call `org-expiry-handler-function' on entry.
5.244+If FORCE is non-nil, don't require confirmation from the user.
5.245+Otherwise rely on `org-expiry-confirm-flag' to decide."
5.246+ (interactive "P")
5.247+ (save-excursion
5.248+ (when (called-interactively-p 'interactive) (org-reveal))
5.249+ (when (org-expiry-expired-p)
5.250+ (org-back-to-heading)
5.251+ (looking-at org-complex-heading-regexp)
5.252+ (let* ((ov (make-overlay (point) (match-end 0)))
5.253+ (e (org-expiry-expired-p))
5.254+ (d (time-to-number-of-days e)))
5.255+ (overlay-put ov 'face 'secondary-selection)
5.256+ (if (or force
5.257+ (null org-expiry-confirm-flag)
5.258+ (and (eq org-expiry-confirm-flag 'interactive)
5.259+ (not (called-interactively-p 'interactive)))
5.260+ (and org-expiry-confirm-flag
5.261+ (y-or-n-p (format "Entry expired by %d days. Process? " d))))
5.262+ (funcall org-expiry-handler-function))
5.263+ (delete-overlay ov)))))
5.264+
5.265+(defun org-expiry-process-entries (_ _)
5.266+ "Process all expired entries between BEG and END.
5.267+The expiry process will run the function defined by
5.268+`org-expiry-handler-functions'."
5.269+ (interactive "r")
5.270+ (save-excursion
5.271+ (let ((beg (if (org-region-active-p)
5.272+ (region-beginning) (point-min)))
5.273+ (end (if (org-region-active-p)
5.274+ (region-end) (point-max))))
5.275+ (goto-char beg)
5.276+ (let ((expired 0) (processed 0))
5.277+ (while (and (outline-next-heading) (< (point) end))
5.278+ (when (org-expiry-expired-p)
5.279+ (setq expired (1+ expired))
5.280+ (if (if (called-interactively-p 'any)
5.281+ (call-interactively 'org-expiry-process-entry)
5.282+ (org-expiry-process-entry))
5.283+ (setq processed (1+ processed)))))
5.284+ (if (equal expired 0)
5.285+ (message "No expired entry")
5.286+ (message "Processed %d on %d expired entries"
5.287+ processed expired))))))
5.288+
5.289+;;; Insert created/expiry property:
5.290+(defun org-expiry-format-timestamp (timestr inactive)
5.291+ "Properly format TIMESTR into an org (in)active timestamp"
5.292+ (format (if inactive "[%s]" "<%s>") timestr))
5.293+
5.294+(defun org-expiry-insert-created (&optional arg)
5.295+ "Insert or update a property with the creation date.
5.296+If ARG, always update it. With one `C-u' prefix, silently update
5.297+to today's date. With two `C-u' prefixes, prompt the user for to
5.298+update the date."
5.299+ (interactive "P")
5.300+ (let* ((d (org-entry-get (point) org-expiry-created-property-name))
5.301+ d-time d-hour timestr)
5.302+ (when (or (null d) arg)
5.303+ ;; update if no date or non-nil prefix argument
5.304+ ;; FIXME Use `org-time-string-to-time'
5.305+ (setq d-time (if d (org-time-string-to-time d)
5.306+ (current-time)))
5.307+ (setq d-hour (format-time-string "%H:%M" d-time))
5.308+ (setq timestr
5.309+ ;; two C-u prefixes will call org-read-date
5.310+ (org-expiry-format-timestamp
5.311+ (if (equal arg '(16))
5.312+ (org-read-date nil nil nil nil d-time d-hour)
5.313+ (format-time-string
5.314+ (replace-regexp-in-string "\\(^<\\|>$\\)" ""
5.315+ (cdr org-time-stamp-formats))))
5.316+ org-expiry-inactive-timestamps))
5.317+ (save-excursion
5.318+ (org-entry-put
5.319+ (point) org-expiry-created-property-name timestr)))))
5.320+
5.321+(defun org-expiry-insert-expiry (&optional today)
5.322+ "Insert a property with the expiry date.
5.323+With one `C-u' prefix, don't prompt interactively for the date
5.324+and insert today's date."
5.325+ (interactive "P")
5.326+ (let* ((d (org-entry-get (point) org-expiry-expiry-property-name))
5.327+ d-time d-hour timestr)
5.328+ (setq d-time (if d (org-time-string-to-time d)
5.329+ (current-time)))
5.330+ (setq d-hour (format-time-string "%H:%M" d-time))
5.331+ (setq timestr (org-expiry-format-timestamp
5.332+ (if today
5.333+ (format-time-string
5.334+ (replace-regexp-in-string "\\(^<\\|>$\\)" ""
5.335+ (cdr org-time-stamp-formats)))
5.336+ (org-read-date nil nil nil nil d-time d-hour))
5.337+ org-expiry-inactive-timestamps))
5.338+ ;; maybe transform to inactive timestamp
5.339+ (if org-expiry-inactive-timestamps
5.340+ (setq timestr (concat "[" (substring timestr 1 -1) "]")))
5.341+
5.342+ (save-excursion
5.343+ (org-entry-put
5.344+ (point) org-expiry-expiry-property-name timestr))))
5.345+
5.346+;;; Functions to process expired entries:
5.347+
5.348+(defun org-expiry-archive-subtree ()
5.349+ "Archive the entry at point if it is expired."
5.350+ (interactive)
5.351+ (save-excursion
5.352+ (if (org-expiry-expired-p)
5.353+ (org-archive-subtree)
5.354+ (if (called-interactively-p 'any)
5.355+ (message "Entry at point is not expired.")))))
5.356+
5.357+(defun org-expiry-add-keyword (&optional keyword)
5.358+ "Add KEYWORD to the entry at point if it is expired."
5.359+ (interactive "sKeyword: ")
5.360+ (if (or (member keyword org-todo-keywords-1)
5.361+ (setq keyword org-expiry-keyword))
5.362+ (save-excursion
5.363+ (if (org-expiry-expired-p)
5.364+ (org-todo keyword)
5.365+ (if (called-interactively-p 'any)
5.366+ (message "Entry at point is not expired."))))
5.367+ (error "\"%s\" is not a to-do keyword in this buffer" keyword)))
5.368+
5.369+;; FIXME what about using org-refile ?
5.370+
5.371+(provide 'org-expiry)
5.372+
5.373+;;; org-expiry.el ends here
6.1--- a/emacs/lib/publish.el Fri Aug 16 21:27:00 2024 -0400
6.2+++ b/emacs/lib/publish.el Sat Aug 17 23:42:08 2024 -0400
6.3@@ -122,3 +122,5 @@
6.4 (let ((default-directory project-dir))
6.5 (message (format "publishing from %s" default-directory))
6.6 (org-publish "compiler.company" force async)))
6.7+(provide 'publish)
6.8+;;; publish.el ends here
7.1--- a/emacs/lib/ulang.el Fri Aug 16 21:27:00 2024 -0400
7.2+++ b/emacs/lib/ulang.el Sat Aug 17 23:42:08 2024 -0400
7.3@@ -26,7 +26,8 @@
7.4 ;;; Code:
7.5 (require 'org)
7.6 (require 'ox)
7.7-
7.8+(require 'inbox)
7.9+(require 'publish)
7.10 (defvar ulang-links-history nil)
7.11 (defvar ulang-files-history nil)
7.12
7.13@@ -43,6 +44,9 @@
7.14
7.15 (org-export-translate-to-lang (list '("Table of Contents" "Index")) "ulang")
7.16
7.17+;; todo keywords
7.18+(setq org-stuck-projects '("+PROJECT+LEVEL=2|HOLD|WAIT|TEST|DRAFT|REVIEW|KLUDGE/-DONE" ("NEXT") nil ""))
7.19+
7.20 (setq org-todo-keywords
7.21 '((type "TBD(0!)" "TODO(t!)" "|")
7.22 (type "WIP(w!)" "|")
7.23@@ -70,6 +74,7 @@
7.24 ("WIP" . (:foreground "darkorchid2" :weight bold))
7.25 ("NOPE" . (:foreground "hotpink" :weight bold :background "darkgreen"))))
7.26
7.27+;; link abbrevs
7.28 (setq org-link-abbrev-alist
7.29 '(("vc" . "https://vc.compiler.company/%s")
7.30 ("comp" . "https://compiler.company/%s")
8.1--- /dev/null Thu Jan 01 00:00:00 1970 +0000
8.2+++ b/emacs/lib/uml-mode.el Sat Aug 17 23:42:08 2024 -0400
8.3@@ -0,0 +1,581 @@
8.4+;;; uml-mode.el --- Minor mode for ascii uml sequence diagrams -*- lexical-binding: t -*-
8.5+
8.6+;; Copyright (C) 2015-2020 Ian Martins
8.7+
8.8+;; Author: Ian Martins <ianxm@jhu.edu>
8.9+;; URL: http://github.com/ianxm/emacs-uml
8.10+;; Version: 0.0.4
8.11+;; Keywords: docs
8.12+;; Package-Requires: ((emacs "24.4") seq)
8.13+
8.14+;; This file is not part of GNU Emacs.
8.15+
8.16+;; This program is free software: you can redistribute it and/or modify
8.17+;; it under the terms of the GNU General Public License as published by
8.18+;; the Free Software Foundation, either version 3 of the License, or
8.19+;; (at your option) any later version.
8.20+
8.21+;; This program is distributed in the hope that it will be useful,
8.22+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
8.23+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
8.24+;; GNU General Public License for more details.
8.25+
8.26+;; For a full copy of the GNU General Public License
8.27+;; see <http://www.gnu.org/licenses/>.
8.28+
8.29+;;; Commentary:
8.30+
8.31+;; provides functions that help in writing ascii uml sequence diagrams.
8.32+
8.33+;;; Code:
8.34+
8.35+(require 'seq)
8.36+(require 'subr-x)
8.37+
8.38+(defun uml-forward-timeline ()
8.39+ "Move the point to the next timeline bar."
8.40+ (interactive)
8.41+ (let ((start (point))
8.42+ word)
8.43+ (forward-word)
8.44+ (setq word (point))
8.45+ (goto-char start)
8.46+ (forward-char)
8.47+ (while (and
8.48+ (not (eq ?| (char-after)))
8.49+ (< (point) word))
8.50+ (forward-char))))
8.51+
8.52+(defun uml-back-timeline ()
8.53+ "Move the point to the previous timeline bar."
8.54+ (interactive)
8.55+ (let ((start (point))
8.56+ word)
8.57+ (forward-word -1)
8.58+ (setq word (point))
8.59+ (goto-char start)
8.60+ (forward-char -1)
8.61+ (while (and
8.62+ (not (eq ?| (char-after)))
8.63+ (> (point) word))
8.64+ (forward-char -1))))
8.65+
8.66+(defun uml-swap-left ()
8.67+ "Swap the timeline at the point with the timeline to its left."
8.68+ (interactive)
8.69+ (uml--redraw-sequence-diagram (list 'name :swapleft 'col (current-column))))
8.70+
8.71+(defun uml-swap-right ()
8.72+ "Swap the timeline at the point with the timeline to its right."
8.73+ (interactive)
8.74+ (uml--redraw-sequence-diagram (list 'name :swapright 'col (current-column))))
8.75+
8.76+(defun uml-delete-timeline ()
8.77+ "Delete the timeline at point."
8.78+ (interactive)
8.79+ (uml--redraw-sequence-diagram (list 'name :delete 'col (current-column))))
8.80+
8.81+(defun uml-insert-timeline ()
8.82+ "Insert a timeline to the right of the point."
8.83+ (interactive)
8.84+ (uml--redraw-sequence-diagram (list 'name :insert 'col (current-column))))
8.85+
8.86+(defun uml-sequence-diagram ()
8.87+ "Formats a sequence diagram."
8.88+ (interactive)
8.89+ (uml--redraw-sequence-diagram nil))
8.90+
8.91+(defun uml--write-text-centered-on (text target)
8.92+ "Write TEXT centered on the TARGET column."
8.93+ (let* ((halfname (floor (/ (length text) 2)))
8.94+ (col (- target halfname))) ; target-pos-len/2
8.95+ (move-to-column col t)
8.96+ (insert (format "%s" text))))
8.97+
8.98+(defun uml--write-vertical-space (timelines prefix)
8.99+ "Write a row of empty timeline bars for TIMELINES after writing PREFIX."
8.100+ (if prefix
8.101+ (insert prefix))
8.102+ (dolist (elt timelines)
8.103+ (let* ((col (plist-get elt 'center)))
8.104+ (move-to-column col t)
8.105+ (insert (format "|")))))
8.106+
8.107+(defun uml--find-nearest-timeline (timelines col)
8.108+ "Return the index of the nearest of TIMELINES to the column COL."
8.109+ (let ((ii 0)
8.110+ olddelta
8.111+ ret
8.112+ delta)
8.113+ (dolist (elt timelines)
8.114+ (setq delta (abs (- col (plist-get elt 'origcenter))))
8.115+ (when (or (not ret) (< delta olddelta))
8.116+ (setq ret ii)
8.117+ (setq olddelta delta))
8.118+ (setq ii (1+ ii)))
8.119+ ret))
8.120+
8.121+(defun uml--write-arrow (from to dashed)
8.122+ "Write an arrow from FROM timeline to TO timeline, possibly with a DASHED line."
8.123+ (let ((delta (abs (- to from)))
8.124+ (ii 0)
8.125+ on) ; bool to toggle between dash or space
8.126+ (move-to-column (1+ (min to from)))
8.127+ (if (> from to) ; <---
8.128+ (insert ?<))
8.129+ (while (< ii (- delta 2))
8.130+ (insert (if (or (not dashed) on) ?- ? ))
8.131+ (if on (setq on nil) (setq on t)) ; toggle dash
8.132+ (setq ii (1+ ii)))
8.133+ (if (< from to) ; --->
8.134+ (insert ?>))
8.135+ (delete-char (- delta 1))))
8.136+
8.137+(defun uml--write-label-and-arrow (timelines prefix fromcol tocol text dashed)
8.138+ "Write TIMELINES with PREFIX then label and arrow for a message from column FROMCOL to column TOCOL with label TEXT which may be DASHED."
8.139+ ;; write label
8.140+ (if text
8.141+ (let (center)
8.142+ (dotimes (ii (length text))
8.143+ (uml--write-vertical-space timelines prefix)
8.144+ (newline)
8.145+ (forward-line -1)
8.146+ (setq center (floor (/ (+ fromcol tocol) 2)))
8.147+ (uml--write-text-centered-on (nth ii text) center)
8.148+ (delete-char (length (nth ii text)))
8.149+ (forward-line))))
8.150+
8.151+ ;; write arrow
8.152+ (uml--write-vertical-space timelines prefix)
8.153+ (newline)
8.154+ (forward-line -1)
8.155+ (uml--write-arrow fromcol tocol dashed)
8.156+ (forward-line))
8.157+
8.158+(defun uml--write-self-arrow (timelines prefix col text)
8.159+ "Write TIMELINES with PREFIX and an arrow from and to column COL, labeled with TEXT."
8.160+ (let ((numrows (max 2 (length text)))
8.161+ arrow part-index text-part)
8.162+ (dotimes (ii numrows)
8.163+ (setq arrow (cond
8.164+ ((= (- numrows ii) 2) " --.")
8.165+ ((= (- numrows ii) 1) "<--'")
8.166+ (t " ")))
8.167+ (if (not text)
8.168+ (setq text-part "")
8.169+ (setq part-index (+ (- ii numrows) (length text)))
8.170+ (setq text-part (if (< part-index 0) "" (nth part-index text))))
8.171+ (uml--write-vertical-space timelines prefix)
8.172+ (newline)
8.173+ (forward-line -1)
8.174+ (move-to-column (1+ col))
8.175+ (insert (format "%s %s" arrow text-part))
8.176+ (delete-char (min (+ 5 (length text-part)) (- (line-end-position) (point))))
8.177+ (forward-line))))
8.178+
8.179+(defun uml--fit-label-between (timelines left right width)
8.180+ "Spread out TIMELINES so that LEFT and RIGHT have WIDTH space between them."
8.181+ (let (leftcol
8.182+ rightcol
8.183+ needed)
8.184+ (setq leftcol (plist-get (nth left timelines) 'center))
8.185+ (setq rightcol (plist-get (nth right timelines) 'center))
8.186+ (setq needed (- (+ leftcol width) rightcol))
8.187+ (if (> needed 0)
8.188+ (uml--shift-to-the-right timelines right needed))))
8.189+
8.190+(defun uml--shift-to-the-right (timelines right needed)
8.191+ "Shift all TIMELINES greater than or equal to RIGHT to the right by NEEDED."
8.192+ (let ((ii right)
8.193+ elt)
8.194+ (while (< ii (length timelines))
8.195+ (setq elt (nth ii timelines))
8.196+ (plist-put elt 'center (+ (plist-get elt 'center) needed))
8.197+ (setq ii (1+ ii)))))
8.198+
8.199+(defun uml--swap-timelines (timelines messages col1 col2)
8.200+ "Given all TIMELINES and MESSAGES, swap COL1 and COL2."
8.201+ (let (tmp)
8.202+ (setq tmp (nth col1 timelines))
8.203+ (setcar (nthcdr col1 timelines) (nth col2 timelines))
8.204+ (setcar (nthcdr col2 timelines) tmp))
8.205+ (dolist (elt messages)
8.206+ (if (= (plist-get elt 'from) col1) (plist-put elt 'from col2)
8.207+ (if (= (plist-get elt 'from) col2) (plist-put elt 'from col1)))
8.208+ (if (= (plist-get elt 'to) col1) (plist-put elt 'to col2)
8.209+ (if (= (plist-get elt 'to) col2) (plist-put elt 'to col1)))))
8.210+
8.211+(defun uml--find-top-or-bottom (direction)
8.212+ "Return the position at the top or bottom of the diagram depending on DIRECTION (:top or :bottom)."
8.213+ (let ((end-of-buffer (if (eq direction :top) (point-min) (point-max)))
8.214+ (step (if (eq direction :top) -1 1)))
8.215+ (while (and
8.216+ (not (= (point) end-of-buffer))
8.217+ (not (looking-at "^[^[:word:]|]*$")))
8.218+ (forward-line step))
8.219+ (cond
8.220+ ((eq direction :top)
8.221+ (if (looking-at "^[^[:word:]|]*$")
8.222+ (forward-line))
8.223+ (point))
8.224+ ((eq direction :bottom)
8.225+ (if (not (= (point) (point-max)))
8.226+ (forward-line -1))
8.227+ (line-end-position)))))
8.228+
8.229+(defun uml--calc-middle (start end)
8.230+ "This just computes the integer mean of START and END."
8.231+ (floor (/ (+ start end) 2)))
8.232+
8.233+(defun uml--determine-prefix ()
8.234+ "Determine the prefix (if there is one).
8.235+
8.236+The prefix is made up of any characters on the left margin that
8.237+aren't part of the diagram, such as comment characters. Prefixes
8.238+can be any length but must be made up of only special
8.239+characters. Prefixes can have leading spaces but cannot contain
8.240+spaces in the middle or at the end."
8.241+ (if (looking-at "\\([[:blank:]]*[^[:word:][:blank:]]+\\) ")
8.242+ (match-string 1)
8.243+ nil))
8.244+
8.245+(defun uml--parse-timelines (prefix bottom)
8.246+ "Parse the timeline names.
8.247+
8.248+Parse timeline names after the PREFIX of each line until we hit
8.249+BOTTOM or see a pipe indicating we're past the timeline names and
8.250+into the messages. For each timeline, determine the name and
8.251+center column. The return structure looks like:
8.252+
8.253+ [ (name \"timeline1\" origcenter 5) ... ]
8.254+
8.255+Names can contain any characters except whitespace or pipes."
8.256+ (let (timelines eob)
8.257+ (while (and (looking-at (concat prefix "[^|]+$"))
8.258+ (< (point) bottom))
8.259+ (forward-char (length prefix))
8.260+ ;; the first "[:blank:]" allows whitespace leading to the name,
8.261+ ;; but doesn't let the while loop go to the next line.
8.262+ (while (looking-at "[[:blank:]]*\\([^[:blank:]|\n]+\\)")
8.263+ (let* ((name (match-string 1))
8.264+ (beg (- (match-beginning 1) (line-beginning-position)))
8.265+ (end (- (match-end 1) (line-beginning-position)))
8.266+ (center (uml--calc-middle beg end))
8.267+ (index (uml--find-nearest-timeline timelines center))
8.268+ (halflen (and index (/ (uml--max-length-multipart-name (plist-get (nth index timelines) 'name) 2) 2))))
8.269+ ;; if this is the first timeline or center is outside of the
8.270+ ;; nearest existing timeline, then this is a new timeline
8.271+ ;; and we should create a new timeline, else append to an
8.272+ ;; existing one
8.273+ (if (or (not timelines)
8.274+ (or (> beg (+ (plist-get (nth index timelines) 'origcenter) halflen))
8.275+ (< end (- (plist-get (nth index timelines) 'origcenter) halflen))))
8.276+ (setq timelines (append timelines (list (list 'name (list name)
8.277+ 'origcenter center))))
8.278+ (nconc (plist-get (nth index timelines) 'name) (list name))))
8.279+ (goto-char (match-end 1)))
8.280+ (setq eob (= 1 (forward-line 1))))
8.281+ (if (not eob) ; if we didn't hit the end of the buffer,
8.282+ (forward-line -1)) ; back up so message parsing can pick up from the last header line
8.283+
8.284+ (sort timelines (lambda (a b) (< (plist-get a 'origcenter)
8.285+ (plist-get b 'origcenter))))))
8.286+
8.287+(defun uml--parse-messages (timelines prefix bottom)
8.288+ "Parse the messages from the diagram.
8.289+
8.290+Parse messages from the diagram given the TIMELINES and PREFIX
8.291+until we reach the BOTTOM. Messages is a mixed list of plists of
8.292+arrows and separators.
8.293+
8.294+Arrows look like:
8.295+ (from 0 to 2 label (\"doIt()\") dashed nil)
8.296+
8.297+Labels must start with a number or letter and cannot contain
8.298+spaces, angle brackets or dashes.
8.299+
8.300+Separators look like:
8.301+ (text \"title for next part\")"
8.302+ (let (messages label dashed found)
8.303+ (while (and (< (line-end-position) (- bottom (length prefix)))
8.304+ (< (line-end-position) (buffer-end 1)))
8.305+ (forward-line 1)
8.306+ (forward-char (length prefix))
8.307+
8.308+ ;; the label may be above the message or on the same line
8.309+ (when (re-search-forward "[[:word:]][^\n|<>\-]*" (line-end-position) t)
8.310+ (if (not label)
8.311+ (setq label (list (string-trim-right (match-string 0)))) ; single part
8.312+ (nconc label (list (string-trim-right (match-string 0))))) ; multi part
8.313+ (beginning-of-line))
8.314+
8.315+ ;; FOUND is (from . to) where FROM and TO are timeline indices
8.316+ (setq found (uml--find-message-bounds-maybe timelines))
8.317+
8.318+ (when found
8.319+ (beginning-of-line)
8.320+ (setq dashed (re-search-forward "\- \-" (line-end-position) t))
8.321+ (setq messages (append messages (list (list 'label label
8.322+ 'from (car found)
8.323+ 'to (cdr found)
8.324+ 'dashed dashed))))
8.325+ (setq label nil)))
8.326+ messages))
8.327+
8.328+(defun uml--find-message-bounds-maybe (timelines)
8.329+ "Find which timelines a message connects.
8.330+
8.331+Return the indices in TIMELINES between which the message passes
8.332+as (from . to), else nil if there is no message on the current
8.333+line"
8.334+ (let (from to found)
8.335+ (cond
8.336+ ((re-search-forward "\-.*>" (line-end-position) t) ; ->
8.337+ (setq from (uml--find-nearest-timeline timelines (- (match-beginning 0) (line-beginning-position))))
8.338+ (setq to (uml--find-nearest-timeline timelines (- (match-end 0) (line-beginning-position))))
8.339+ (setq found t))
8.340+
8.341+ ((re-search-forward "<.*\-" (line-end-position) t) ; <-
8.342+ (setq from (uml--find-nearest-timeline timelines (- (match-end 0) (line-beginning-position))))
8.343+ (setq to (uml--find-nearest-timeline timelines (- (match-beginning 0) (line-beginning-position))))
8.344+ (setq found t))
8.345+
8.346+ ((re-search-forward "<" (line-end-position) t) ; <
8.347+ (setq from (uml--find-nearest-timeline timelines (- (match-end 0) (line-beginning-position))))
8.348+ (setq to (uml--find-nearest-timeline timelines (- (match-beginning 0) (line-beginning-position))))
8.349+ (setq found t))
8.350+
8.351+ ((re-search-forward "|\-" (line-end-position) t) ; |-
8.352+ (setq from (uml--find-nearest-timeline timelines (- (match-beginning 0) (line-beginning-position))))
8.353+ (setq to (1+ from))
8.354+ (if (< to (length timelines))
8.355+ (setq found t)
8.356+ (message "Ignoring out of bounds message.")))
8.357+
8.358+ ((re-search-forward "\-|" (line-end-position) t) ; -|
8.359+ (setq from (uml--find-nearest-timeline timelines (- (match-beginning 0) (line-beginning-position))))
8.360+ (setq to (- from 1))
8.361+ (if (>= to 0)
8.362+ (setq found t)
8.363+ (message "Ignoring out of bounds message."))))
8.364+ (if found (cons from to) nil)))
8.365+
8.366+(defun uml--apply-adjustments (adjust timelines messages)
8.367+ "Apply ADJUST to TIMELINES and MESSAGES.
8.368+
8.369+Return (TIMELINES . MESSAGES) since we mucked with both of them."
8.370+ (cond
8.371+ ((eq :swapleft (plist-get adjust 'name))
8.372+ (let (current swapwith)
8.373+ (setq current (uml--find-nearest-timeline timelines (plist-get adjust 'col)))
8.374+ (setq swapwith (- current 1))
8.375+ (if (or (< swapwith 0) (>= swapwith (length timelines)))
8.376+ (plist-put adjust 'movetocol current)
8.377+ (plist-put adjust 'movetocol swapwith)
8.378+ (uml--swap-timelines timelines messages current swapwith))))
8.379+
8.380+ ((eq :swapright (plist-get adjust 'name))
8.381+ (let (current swapwith)
8.382+ (setq current (uml--find-nearest-timeline timelines (plist-get adjust 'col)))
8.383+ (setq swapwith (1+ current))
8.384+ (if (or (< swapwith 0) (>= swapwith (length timelines)))
8.385+ (plist-put adjust 'movetocol current)
8.386+ (plist-put adjust 'movetocol swapwith)
8.387+ (uml--swap-timelines timelines messages current swapwith))))
8.388+
8.389+ ((eq :delete (plist-get adjust 'name))
8.390+ (let (current col)
8.391+ (setq current (uml--find-nearest-timeline timelines (plist-get adjust 'col))
8.392+ col current)
8.393+ (plist-put adjust 'movetocol (max 0 (1- col)))
8.394+ (when (>= col 0)
8.395+ (setq timelines (delete (nth col timelines) timelines))
8.396+ (dolist (elt messages)
8.397+ (let ((from (plist-get elt 'from))
8.398+ (to (plist-get elt 'to)))
8.399+ (if (or (= from col) (= to col))
8.400+ (setq messages (delete elt messages))
8.401+ (if (> from col) (plist-put elt 'from (- from 1)))
8.402+ (if (> to col) (plist-put elt 'to (- to 1)))))))))
8.403+
8.404+ ((eq :insert (plist-get adjust 'name))
8.405+ (let (current new rest)
8.406+ (setq current (uml--find-nearest-timeline timelines (plist-get adjust 'col)))
8.407+ (plist-put adjust 'movetocol current)
8.408+ (setq current (1+ current))
8.409+ (setq new (list (list 'name (list "new")
8.410+ 'origcenter nil)))
8.411+ (setq rest (nthcdr current timelines))
8.412+ (setcdr (nthcdr (- current 1) timelines) new)
8.413+ (setcdr new rest)
8.414+ (dolist (elt messages)
8.415+ (let ((from (plist-get elt 'from))
8.416+ (to (plist-get elt 'to)))
8.417+ (if (>= from current) (plist-put elt 'from (1+ from)))
8.418+ (if (>= to current) (plist-put elt 'to (1+ to))))))))
8.419+ (cons timelines messages))
8.420+
8.421+(defun uml--max-length-multipart-name (multipart-name min)
8.422+ "Convenience function to compute the longest string.
8.423+
8.424+Return the longest string in MULTIPART-NAME, which is a list of
8.425+strings, or MIN if it is longer."
8.426+ (seq-reduce (lambda (namelength namepart) (max namelength (length namepart)))
8.427+ multipart-name
8.428+ min))
8.429+
8.430+(defun uml--space-out-timelines (timelines messages prefix)
8.431+ "Space out TIMELINES to fit MESSAGES' labels and PREFIX."
8.432+ (dotimes (ii (length timelines))
8.433+ (plist-put (nth ii timelines) 'center (+ (* 12 ii) 6 (length prefix))))
8.434+ (let (elt needed namelen)
8.435+ (dotimes (ii (length timelines))
8.436+ (setq elt (nth ii timelines))
8.437+ (setq namelen (uml--max-length-multipart-name (plist-get elt 'name) 8))
8.438+ (setq needed (floor (/ (- namelen 8) 2)))
8.439+ (when (> needed 0)
8.440+ (uml--shift-to-the-right timelines ii needed)
8.441+ (uml--shift-to-the-right timelines (1+ ii) needed))))
8.442+
8.443+ (dolist (elt messages)
8.444+ (let* ((to (plist-get elt 'to))
8.445+ (from (plist-get elt 'from))
8.446+ (left (min to from))
8.447+ (right (max to from)))
8.448+ (if (= left right)
8.449+ (if (< (1+ left) (length timelines))
8.450+ (uml--fit-label-between timelines ; self arrow
8.451+ left
8.452+ (1+ left)
8.453+ (+ (uml--max-length-multipart-name (plist-get elt 'label) 0) 8)))
8.454+ (uml--fit-label-between timelines
8.455+ left
8.456+ right
8.457+ (+ (uml--max-length-multipart-name (plist-get elt 'label) 0) 4))))))
8.458+
8.459+(defun uml--count-timeline-name-rows (timelines)
8.460+ "Count the rows of the TIMELINES' names."
8.461+ (seq-reduce (lambda (val elt) (max val (length (plist-get elt 'name))))
8.462+ timelines 0))
8.463+
8.464+(defun uml--write-diagram (timelines messages prefix)
8.465+ "Write the TIMELINES and MESSAGES using PREFIX to the buffer.
8.466+
8.467+This is done in two steps:
8.468+1. write timeline names
8.469+2. write messages"
8.470+
8.471+ ;; 1. write timeline names
8.472+ (let (numrows)
8.473+ ;; determine the number of rows needed for the timeline names
8.474+ (setq numrows (uml--count-timeline-name-rows timelines))
8.475+ ;; then write them out to the buffer
8.476+ (dotimes (ii numrows)
8.477+ (if prefix
8.478+ (insert prefix))
8.479+ (dolist (elt timelines)
8.480+ (let* ((parts (plist-get elt 'name))
8.481+ (index (+ (- (length parts) numrows) ii))
8.482+ (part (and (>= index 0) (nth index parts))))
8.483+ (if part
8.484+ (uml--write-text-centered-on part
8.485+ (plist-get elt 'center)))))
8.486+ (newline)))
8.487+
8.488+ ;; 2. write messages
8.489+ (dolist (elt messages)
8.490+ (uml--write-vertical-space timelines prefix)
8.491+ (newline)
8.492+
8.493+ (let* ((text (plist-get elt 'label))
8.494+ (from (plist-get elt 'from))
8.495+ (to (plist-get elt 'to))
8.496+ (fromcenter (plist-get (nth from timelines) 'center))
8.497+ (tocenter (plist-get (nth to timelines) 'center))
8.498+ (dashed (plist-get elt 'dashed))
8.499+ selfmessage)
8.500+ (setq selfmessage (= (plist-get elt 'from) (plist-get elt 'to)))
8.501+
8.502+ (if selfmessage
8.503+ (uml--write-self-arrow timelines prefix fromcenter text)
8.504+ (uml--write-label-and-arrow timelines prefix fromcenter tocenter text dashed))))
8.505+
8.506+ (uml--write-vertical-space timelines prefix))
8.507+
8.508+(defun uml--redraw-sequence-diagram (adjust)
8.509+ "Redraws a sequence diagram after applying ADJUST. This is the main routine."
8.510+ (let (top ; first line in buffer of diagram
8.511+ bottom ; last line in buffer of diagram
8.512+ prefix ; comment character or nil
8.513+ timelines ; list of timeline data
8.514+ messages) ; list of arrow data
8.515+
8.516+ (beginning-of-line)
8.517+
8.518+ ;; find the top and bottom of the diagram
8.519+ (setq top (uml--find-top-or-bottom :top))
8.520+ (setq bottom (uml--find-top-or-bottom :bottom))
8.521+ ;; (message "top: %d bottom: %d" top bottom)
8.522+
8.523+ (goto-char top)
8.524+ (setq prefix (uml--determine-prefix))
8.525+
8.526+ ;; parse timeline names from old diagram
8.527+ (setq timelines (uml--parse-timelines prefix bottom))
8.528+ ;; (message "timelines %s" timelines)
8.529+
8.530+ ;; parse messages from old diagram
8.531+ (setq messages (uml--parse-messages timelines prefix bottom))
8.532+ ;; (message "messages %s" messages)
8.533+
8.534+ ;; clear the old diagram content from the buffer
8.535+ (goto-char top)
8.536+ (delete-char (- bottom top))
8.537+
8.538+ ;; apply adjustments such as shifts or swaps
8.539+ (let (ret)
8.540+ (setq ret (uml--apply-adjustments adjust timelines messages))
8.541+ (setq timelines (car ret)
8.542+ messages (cdr ret)))
8.543+
8.544+ ;; calculate timeline center columns
8.545+ (uml--space-out-timelines timelines messages prefix)
8.546+
8.547+ ;; render the diagram into the buffer
8.548+ (uml--write-diagram timelines messages prefix)
8.549+
8.550+ ;; move the cursor back to the column where it was before we did anything
8.551+ (goto-char top)
8.552+ (when (plist-get adjust 'movetocol)
8.553+ (forward-line (1- (uml--count-timeline-name-rows timelines)))
8.554+ (move-to-column (plist-get (nth (plist-get adjust 'movetocol) timelines) 'center)))))
8.555+
8.556+;;;###autoload
8.557+(define-minor-mode uml-mode
8.558+ "Toggle uml mode.
8.559+Interactively with no argument, this command toggles the mode.
8.560+A positive prefix argument enables the mode, any other prefix
8.561+argument disables it. From Lisp, argument omitted or nil enables
8.562+the mode, `toggle' toggles the state.
8.563+
8.564+When uml mode is enabled, C-c while the point is in a
8.565+sequence diagram cleans up the formatting of the diagram.
8.566+See the command \\[uml-seqence-diagram]."
8.567+ ;; The initial value.
8.568+ :init-value nil
8.569+ ;; The indicator for the mode line.
8.570+ :lighter " uml"
8.571+ ;; The minor mode bindings.
8.572+ :keymap
8.573+ `((,(kbd "C-c C-c") . uml-sequence-diagram)
8.574+ (,(kbd "<M-left>") . uml-swap-left)
8.575+ (,(kbd "<M-right>") . uml-swap-right)
8.576+ (,(kbd "<M-S-left>") . uml-delete-timeline)
8.577+ (,(kbd "<M-S-right>") . uml-insert-timeline)
8.578+ (,(kbd "M-f") . uml-forward-timeline)
8.579+ (,(kbd "M-b") . uml-back-timeline))
8.580+ :group 'uml)
8.581+
8.582+(provide 'uml-mode)
8.583+
8.584+;;; uml-mode.el ends here
9.1--- a/lisp/lib/dat/dat.asd Fri Aug 16 21:27:00 2024 -0400
9.2+++ b/lisp/lib/dat/dat.asd Sat Aug 17 23:42:08 2024 -0400
9.3@@ -1,5 +1,5 @@
9.4 (defsystem :dat
9.5- :description "Data formats"
9.6+ :description "Data Systems"
9.7 :depends-on (:cl-ppcre :std :obj #+png :png :flexi-streams :io :log)
9.8 :version "0.1.0"
9.9 :serial t
9.10@@ -29,6 +29,7 @@
9.11 ((:file "const")
9.12 (:file "entity")
9.13 (:file "html")))
9.14+ (:file "handlebars")
9.15 (:file "mime")
9.16 (:file "toml")
9.17 (:file "arff")
10.1--- /dev/null Thu Jan 01 00:00:00 1970 +0000
10.2+++ b/lisp/lib/dat/handlebars.lisp Sat Aug 17 23:42:08 2024 -0400
10.3@@ -0,0 +1,18 @@
10.4+;;; handlebars.lisp --- Handlebars Template Format
10.5+
10.6+;; Minimal templating on steroids in Lisp
10.7+
10.8+;;; Commentary
10.9+
10.10+;; handlebars is a popular templating system initially derived from mustache
10.11+;; which happened to have some CL bindings:
10.12+;; https://github.com/kanru/cl-mustache
10.13+
10.14+;; This package aims to integrate directly with the DAT/HTML package but
10.15+;; should be able to be dropped-in to other serde-enabled formats like DAT/XML
10.16+;; or DAT/JSON.
10.17+
10.18+;; ref: https://handlebarsjs.com
10.19+
10.20+;;; Code:
10.21+(in-package :dat/handlebars)
11.1--- a/lisp/lib/dat/pkg.lisp Fri Aug 16 21:27:00 2024 -0400
11.2+++ b/lisp/lib/dat/pkg.lisp Sat Aug 17 23:42:08 2024 -0400
11.3@@ -175,6 +175,10 @@
11.4 :extract-path-list
11.5 :extract-path))
11.6
11.7+(defpackage :dat/handlebars
11.8+ (:use :cl :std :dat/proto :dat/html)
11.9+ (:export))
11.10+
11.11 (defpackage :dat/mime
11.12 (:use :cl :std :dat/proto :dat/xml)
11.13 (:export :*mime-database*
12.1--- a/readme.org Fri Aug 16 21:27:00 2024 -0400
12.2+++ b/readme.org Sat Aug 17 23:42:08 2024 -0400
12.3@@ -3,16 +3,14 @@
12.4 #+author: Richard Westhaver
12.5 #+email: richard.westhaver@gmail.com
12.6 #+setupfile: https://cdn.compiler.company/org/clean.theme
12.7+#+property: header-args :eval no-export
12.8 - [[https://compiler.company/docs/core][Docs]]
12.9 - [[https://compiler.company/docs/core/install.html][Install]] :: Install Guide
12.10 - [[https://compiler.company/docs/core/tests.html][Tests]] :: Testing Guide
12.11 - [[https://compiler.company/docs/core/stats.html][Stats]] :: Project Statistics
12.12
12.13 * Overview
12.14- is a small software research laboratory
12.15-concerned with the future of Mechanical Freedom.
12.16-
12.17-This repository contains the monolothic core of the Compiler Company.
12.18+This repository contains the monolothic core of [[comp:][The Compiler Company]].
12.19
12.20 To bootstrap the core you will need recent versions of [[https://www.rust-lang.org/][Rust]], [[http://www.sbcl.org/][SBCL]], and
12.21 a C compiler (clang or gcc). Only Unix systems are explicitly
12.22@@ -27,25 +25,25 @@
12.23 platform-specific [[https://packy.compiler.company/dist][binary distributions]].
12.24
12.25 #+NAME: Optional Dependencies
12.26-| dependency | dependents | src |
12.27-|-------------+------------------------+-----------------------------------------------+
12.28-| Blake3 | ffi/blake3 | https://vc.compiler.company/packy/blake3 |
12.29-| Tree-sitter | ffi/tree-sitter | https://vc.compiler.company/packy/tree-sitter |
12.30-| Uring | ffi/uring | https://vc.compiler.company/packy/uring |
12.31-| Btrfs | ffi/btrfs | https://vc.compiler.company/packy/btrfs |
12.32-| Ublksrv | ffi/ublk | https://vc.compiler.company/packy/ublksrv |
12.33-| OpenSSL | lib/net | |
12.34-| RocksDB | ffi/rocksdb | https://vc.compiler.company/packy/rocksdb |
12.35-| Git | lib/vc/git | https://vc.compiler.company/packy/git |
12.36-| Hg | lib/vc/hg | https://vc.compiler.company/packy/hg |
12.37-| Zstd | ffi/zstd | https://vc.compiler.company/packy/zstd |
12.38-| Qemu | lib/box | https://vc.compiler.company/packy/qemu |
12.39-| Podman | lib/pod | https://vc.compiler.company/packy/podman |
12.40-| Emacs | emacs | https://vc.compiler.company/packy/emacs |
12.41-| StumpWM | lib/gui/wm/x11/stumpwm | https://vc.compiler.company/packy/stumpwm |
12.42-| Readline | ffi/readline | |
12.43-| Keyutils | ffi/keyutils | |
12.44-| Mpd | lib/aud/mpd | https://vc.compiler.company/packy/mpd |
12.45+| dependency | dependents | src |
12.46+|-------------+------------------------+-----------------------------------------------|
12.47+| Blake3 | ffi/blake3 | https://vc.compiler.company/packy/blake3 |
12.48+| Tree-sitter | ffi/tree-sitter | https://vc.compiler.company/packy/tree-sitter |
12.49+| Uring | ffi/uring | https://vc.compiler.company/packy/uring |
12.50+| Btrfs | ffi/btrfs | https://vc.compiler.company/packy/btrfs |
12.51+| Ublksrv | ffi/ublk | https://vc.compiler.company/packy/ublksrv |
12.52+| OpenSSL | lib/net | [[https://vc.compiler.company/packy/openssl]] |
12.53+| RocksDB | ffi/rocksdb | https://vc.compiler.company/packy/rocksdb |
12.54+| Git | lib/vc/git | https://vc.compiler.company/packy/git |
12.55+| Hg | lib/vc/hg | https://vc.compiler.company/packy/hg |
12.56+| Zstd | ffi/zstd | https://vc.compiler.company/packy/zstd |
12.57+| Qemu | lib/box | https://vc.compiler.company/packy/qemu |
12.58+| Podman | lib/pod | https://vc.compiler.company/packy/podman |
12.59+| Emacs | emacs | https://vc.compiler.company/packy/emacs |
12.60+| StumpWM | lib/gui/wm/x11/stumpwm | https://vc.compiler.company/packy/stumpwm |
12.61+| Readline | ffi/readline | [[https://vc.compiler.company/packy/readline]] |
12.62+| Keyutils | ffi/keyutils | [[https://vc.compiler.company/packy/libkeyutils]] |
12.63+| Mpd | lib/aud/mpd | https://vc.compiler.company/packy/mpd |
12.64
12.65 * Build
12.66 The Core consists of two major system: the *lisp* system and the
12.67@@ -81,7 +79,7 @@
12.68
12.69 #+RESULTS: x-help
12.70 #+begin_example
12.71-This is SBCL 2.4.7:dc890089a, an implementation of ANSI Common Lisp.
12.72+This is SBCL 2.4.7:76bbecb68, an implementation of ANSI Common Lisp.
12.73 More information about SBCL is available at <http://www.sbcl.org/>.
12.74
12.75 SBCL is free software, provided as is, with absolutely no warranty.
