1.1--- a/emacs/default.el Sat Jun 01 19:16:02 2024 -0400
1.2+++ b/emacs/default.el Sun Jun 02 02:30:54 2024 -0400
1.3@@ -47,7 +47,7 @@
1.4 eww-auto-rename-buffer 'title
1.5 eww-search-prefix "https://duckduckgo.com/html?q="
1.6 view-read-only t)
1.7-
1.8+(browse-url-default-browser "")
1.9 ;;; Variables
1.10 (defvar user-custom-file (expand-file-name (format "%s.el" user-login-name) user-emacs-directory))
1.11 (defvar user-home-directory (expand-file-name "~"))
2.1--- a/emacs/lib/publish.el Sat Jun 01 19:16:02 2024 -0400
2.2+++ b/emacs/lib/publish.el Sun Jun 02 02:30:54 2024 -0400
2.3@@ -7,8 +7,8 @@
2.4 (require 'org-id)
2.5 ;; vendored
2.6 (require 'htmlize)
2.7-(defvar project-dir "~/dev/comp/org")
2.8-(defvar publish-dir "/mnt/w/compiler.company")
2.9+(defvar project-dir "~/comp/org")
2.10+(defvar publish-dir "/mnt/y/stash/compiler.company")
2.11 (defvar html-theme nil)
2.12 (defvar url "https://compiler.company")
2.13 (defvar html-nav "<div class=\"nav\"> (<a href = \"https://compiler.company\">~</a> (<a href = \"https://compiler.company/blog\">blog</a> <a href = \"https://compiler.company/docs\">docs</a>) (<a href = \"https://vc.compiler.company/comp\">vc</a> <a href = \"https://packy.compiler.company\">packy</a>))</div>")
3.1--- a/emacs/lib/sk.el Sat Jun 01 19:16:02 2024 -0400
3.2+++ b/emacs/lib/sk.el Sun Jun 02 02:30:54 2024 -0400
3.3@@ -139,7 +139,7 @@
3.4 (add-to-list 'auto-mode-alist '("\\.sk\\'" . skel-mode)))
3.5
3.6 ;;; Autotype
3.7-;; From: https://github.com/xFA25E/skempo/blob/master/skempo.el
3.8+;; ref: https://raw.githubusercontent.com/xFA25E/skempo/master/skempo.el
3.9
3.10 ;; (defun modify-lisp-syntax-tables ()
3.11 ;; (modify-syntax-entry ?* "w" (syntax-table))
4.1--- a/lisp/ffi/zstd/pkg.lisp Sat Jun 01 19:16:02 2024 -0400
4.2+++ b/lisp/ffi/zstd/pkg.lisp Sun Jun 02 02:30:54 2024 -0400
4.3@@ -1,7 +1,16 @@
4.4 ;;; ffi/zstd/pkg.lisp --- ZSTD FFI
4.5
4.6-;; from zstd.h:
4.7-#|
4.8+;; Zstd compression support for Lisp
4.9+
4.10+;;; Commentary:
4.11+
4.12+;; The following programs have compile-time flags which can be used to enable
4.13+;; internal Zstd support:
4.14+
4.15+;; SBCL
4.16+;; QEMU
4.17+
4.18+#| from zstd.h:
4.19 Introduction
4.20
4.21 zstd, short for Zstandard, is a fast lossless compression algorithm, targeting
5.1--- a/lisp/lib/box/archiso.lisp Sat Jun 01 19:16:02 2024 -0400
5.2+++ b/lisp/lib/box/archiso.lisp Sun Jun 02 02:30:54 2024 -0400
5.3@@ -191,4 +191,30 @@
5.4
5.5 ;; TODO 2024-05-31:
5.6 (defcfg archiso-cfg ()
5.7- ())
5.8+ ((config-version :initform "2.6.0" :type string)
5.9+ (hostname :type string)
5.10+ (kernels :initform '("linux") :type list)
5.11+ locale-config
5.12+ mirror-config
5.13+ network-config
5.14+ (no-pkg-lookups :initform nil :type boolean)
5.15+ (ntp :initform t :type boolean)
5.16+ network
5.17+ (offline :initform nil :type boolean)
5.18+ packages
5.19+ (archinstall-language :initform "English" :type string)
5.20+ (bootloader :initform "Systemd-boot" :type string)
5.21+ (debug :initform nil :type boolean)
5.22+ parallel-downloads
5.23+ disk-config
5.24+ disk-encryption
5.25+ profile-config
5.26+ save-config
5.27+ audio-config
5.28+ (additional-repositories :initform nil :type list)
5.29+ script
5.30+ silent
5.31+ (swap :initform t :type boolean)
5.32+ timezone
5.33+ (version :initform "2.6.0" :type string)))
5.34+
6.1--- /dev/null Thu Jan 01 00:00:00 1970 +0000
6.2+++ b/lisp/lib/box/box.lisp Sun Jun 02 02:30:54 2024 -0400
6.3@@ -0,0 +1,8 @@
6.4+;;; box/box.lisp --- Box API
6.5+
6.6+;; High-level Box interface for KVM management.
6.7+
6.8+;;; Commentary:
6.9+
6.10+;;; Code:
6.11+(in-package :box)
7.1--- a/lisp/lib/box/qmp.lisp Sat Jun 01 19:16:02 2024 -0400
7.2+++ b/lisp/lib/box/qmp.lisp Sun Jun 02 02:30:54 2024 -0400
7.3@@ -1,6 +1,23 @@
7.4 ;;; box/qmp.lisp --- QEMU Monitor Protocol
7.5
7.6-;;
7.7+;; Lisp Interface for QMP commands, objects, and events.
7.8+
7.9+;;; Commentary:
7.10+
7.11+;; ref: https://www.qemu.org/docs/master/interop/qemu-qmp-ref.html
7.12+
7.13+;; QEMU is a complex, surprisingly flexible, and at times difficult piece of
7.14+;; software which is often used via proxy with VirtualBox or Proxmox - as in
7.15+;; via another application calling QEMU internally.
7.16+
7.17+;; My problem with this is that too many of the implementation details are
7.18+;; hidden from the user, or covered up with additional abstractions. As the
7.19+;; developers maintain these abstractions they struggle to keep up with the
7.20+;; new low-level features implemented in their core systems.
7.21+
7.22+;; To avoid the trickle-down economics of external application development, we
7.23+;; will develop a library which supports as much of the QMP and QAPI
7.24+;; surface-area that we deem suitable to support our applications.
7.25
7.26 ;;; Code:
7.27 (in-package :box/qmp)
8.1--- a/lisp/lib/dat/json.lisp Sat Jun 01 19:16:02 2024 -0400
8.2+++ b/lisp/lib/dat/json.lisp Sun Jun 02 02:30:54 2024 -0400
8.3@@ -18,16 +18,12 @@
8.4 :accessor json-object-members))
8.5 (:documentation "An associative list of key/value pairs."))
8.6
8.7-;;; ----------------------------------------------------
8.8-
8.9 (defmethod print-object ((obj json-object) stream)
8.10 "Output a JSON object to a stream in readable form."
8.11 (print-unreadable-object (obj stream :type t)
8.12 (let ((*print-level* 1))
8.13 (json-encode obj stream))))
8.14
8.15-;;; ----------------------------------------------------
8.16-
8.17 (defun json-getf (object key &optional value)
8.18 "Find an member's value in a JSON object."
8.19 (let ((place (assoc key (json-object-members object) :test 'string=)))
8.20@@ -35,8 +31,6 @@
8.21 value
8.22 (values (second place) t))))
8.23
8.24-;;; ----------------------------------------------------
8.25-
8.26 (defun json-setf (object key value)
8.27 "Assign a value to a key in a JSON object."
8.28 (let ((place (assoc key (json-object-members object) :test 'string=)))
8.29@@ -48,12 +42,8 @@
8.30 (push (list k value) (json-object-members object)))
8.31 (rplacd place (list value))))))
8.32
8.33-;;; ----------------------------------------------------
8.34-
8.35 (defsetf json-getf json-setf)
8.36
8.37-;;; ----------------------------------------------------
8.38-
8.39 (defun json-decode (string &key (start 0) end)
8.40 "Convert a JSON string into a Lisp object."
8.41 (with-input-from-string (stream string :start start :end end)
8.42@@ -64,8 +54,6 @@
8.43 (declare (ignore format))
8.44 (json-decode obj :start start :end end))
8.45
8.46-;;; ----------------------------------------------------
8.47-
8.48 (defun json-encode (value &optional stream)
8.49 "Encodes a Lisp value into a stream."
8.50 (json-write value stream))
8.51@@ -78,8 +66,6 @@
8.52 (json-encode obj s)
8.53 s)))
8.54
8.55-;;; ----------------------------------------------------
8.56-
8.57 (defun json-enable-reader-macro ()
8.58 "Set the #{ dispatch macro character for reading JSON objects."
8.59 (flet ((json-object-reader (stream char n)
8.60@@ -112,20 +98,15 @@
8.61 (#\{ (json-read-object stream))
8.62 (#\[ (json-read-list stream))
8.63 (#\" (json-read-string stream))
8.64-
8.65 ;; must be a number
8.66 (otherwise (json-read-number stream)))))
8.67
8.68-;;; ----------------------------------------------------
8.69-
8.70 (defun json-peek-char (stream expected &key skip-ws)
8.71 "Peek at the next character or token and optionally error if unexpected."
8.72 (declare (optimize (speed 3) (debug 0)))
8.73 (when (equal (peek-char skip-ws stream) expected)
8.74 (read-char stream)))
8.75
8.76-;;; ----------------------------------------------------
8.77-
8.78 (defun json-read-char (stream expected &key skip-ws)
8.79 "Read the next, expected character in the stream."
8.80 (declare (optimize (speed 3) (debug 0)))
8.81@@ -133,8 +114,6 @@
8.82 t
8.83 (error "JSON error: unexpected ~s" (read-char stream))))
8.84
8.85-;;; ----------------------------------------------------
8.86-
8.87 (defun json-read-true (stream)
8.88 "Read true from a JSON stream."
8.89 (json-read-char stream #\t :skip-ws t)
8.90@@ -142,8 +121,6 @@
8.91 (json-read-char stream #\u)
8.92 (json-read-char stream #\e))
8.93
8.94-;;; ----------------------------------------------------
8.95-
8.96 (defun json-read-false (stream)
8.97 "Read false from a JSON stream."
8.98 (prog1 nil
8.99@@ -153,8 +130,6 @@
8.100 (json-read-char stream #\s)
8.101 (json-read-char stream #\e)))
8.102
8.103-;;; ----------------------------------------------------
8.104-
8.105 (defun json-read-null (stream)
8.106 "Read null from a JSON stream."
8.107 (prog1 nil
8.108@@ -163,8 +138,6 @@
8.109 (json-read-char stream #\l)
8.110 (json-read-char stream #\l)))
8.111
8.112-;;; ----------------------------------------------------
8.113-
8.114 (defun json-read-number (stream)
8.115 "Read a number from a JSON stream."
8.116 (declare (optimize (speed 3) (debug 0)))
8.117@@ -218,8 +191,6 @@
8.118 (prog1
8.119 (read-from-string s))))
8.120
8.121-;;; ----------------------------------------------------
8.122-
8.123 (defun json-read-string (stream)
8.124 "Read a string from a JSON stream."
8.125 (declare (optimize (speed 3) (debug 0)))
8.126@@ -259,8 +230,6 @@
8.127 (otherwise c))))
8.128 (write-char c s))))))
8.129
8.130-;;; ----------------------------------------------------
8.131-
8.132 (defun json-read-list (stream)
8.133 "Read a list of JSON values."
8.134 (declare (optimize (speed 3) (debug 0)))
8.135@@ -283,8 +252,6 @@
8.136 finally (return (prog1 xs
8.137 (json-read-char stream #\] :skip-ws t))))))
8.138
8.139-;;; ----------------------------------------------------
8.140-
8.141 (defun json-read-object (stream)
8.142 "Read an associative list of key/value pairs into a JSON object."
8.143 (declare (optimize (speed 3) (debug 0)))
8.144@@ -317,33 +284,23 @@
8.145 (declare (ignore value))
8.146 (format stream "~<true~>"))
8.147
8.148-;;; ----------------------------------------------------
8.149-
8.150 (defmethod json-write ((value (eql nil)) &optional stream)
8.151 "Encode the null constant."
8.152 (declare (ignore value))
8.153 (format stream "~<null~>"))
8.154
8.155-;;; ----------------------------------------------------
8.156-
8.157 (defmethod json-write ((value symbol) &optional stream)
8.158 "Encode a symbol to a stream."
8.159 (json-write (symbol-name value) stream))
8.160
8.161-;;; ----------------------------------------------------
8.162-
8.163 (defmethod json-write ((value number) &optional stream)
8.164 "Encode a number to a stream."
8.165 (format stream "~<~a~>" value))
8.166
8.167-;;; ----------------------------------------------------
8.168-
8.169 (defmethod json-write ((value ratio) &optional stream)
8.170 "Encode a ratio to a stream."
8.171 (format stream "~<~a~>" (float value)))
8.172
8.173-;;; ----------------------------------------------------
8.174-
8.175 (defmethod json-write ((value string) &optional stream)
8.176 "Encode a string as a stream."
8.177 (flet ((encode-char (c)
8.178@@ -361,14 +318,10 @@
8.179 (string c)))))
8.180 (format stream "~<\"~{~a~}\"~>" (map 'list #'encode-char value))))
8.181
8.182-;;; ----------------------------------------------------
8.183-
8.184 (defmethod json-write ((value pathname) &optional stream)
8.185 "Encode a pathname as a stream."
8.186 (json-write (namestring value) stream))
8.187
8.188-;;; ----------------------------------------------------
8.189-
8.190 (defmethod json-write ((value vector) &optional stream)
8.191 "Encode an array to a stream."
8.192 (let ((*print-pretty* t)
8.193@@ -386,8 +339,6 @@
8.194 (pprint-indent :block 0)
8.195 (json-write (aref value i) stream))))))
8.196
8.197-;;; ----------------------------------------------------
8.198-
8.199 (defmethod json-write ((value list) &optional stream)
8.200 "Encode a list to a stream."
8.201 (let ((*print-pretty* t)
8.202@@ -403,8 +354,6 @@
8.203 (pprint-newline :fill)
8.204 (pprint-indent :block 0)))))
8.205
8.206-;;; ----------------------------------------------------
8.207-
8.208 (defmethod json-write ((value hash-table) &optional stream)
8.209 "Encode a hash-table to a stream."
8.210 (let ((*print-pretty* t)
8.211@@ -429,8 +378,6 @@
8.212 (pprint-newline :mandatory)
8.213 (pprint-indent :current 0)))))))))
8.214
8.215-;;; ----------------------------------------------------
8.216-
8.217 (defmethod json-write ((value json-object) &optional stream)
8.218 "Encode a JSON object with an associative list of members to a stream."
8.219 (let ((*print-pretty* t)
9.1--- a/lisp/lib/doc/file.lisp Sat Jun 01 19:16:02 2024 -0400
9.2+++ b/lisp/lib/doc/file.lisp Sun Jun 02 02:30:54 2024 -0400
9.3@@ -93,9 +93,13 @@
9.4
9.5 (define-source-file* rust "rs")
9.6 (define-source-file* shell "sh")
9.7+(define-source-file* makefile "mk")
9.8 (define-source-file* nushell "nu")
9.9 (define-source-file* common-lisp "lisp")
9.10 (define-source-file* emacs-lisp "el")
9.11+(define-source-file* scheme "scm")
9.12+(define-source-file* skel "sk")
9.13+(define-source-file* sxp "sxp")
9.14
9.15 (defconstant +max-file-heading-level+ 8)
9.16 (defconstant +min-file-heading-level+ 3)
9.17@@ -180,7 +184,6 @@
9.18 :headings #()
9.19 ))))
9.20
9.21-
9.22 ;; (defmacro define-file-heading (type slots))
9.23
9.24 (defclass file-documentation ()
10.1--- a/lisp/std/defpkg.lisp Sat Jun 01 19:16:02 2024 -0400
10.2+++ b/lisp/std/defpkg.lisp Sun Jun 02 02:30:54 2024 -0400
10.3@@ -9,17 +9,16 @@
10.4 (:use :cl)
10.5 (:nicknames :pkg)
10.6 (:export :defpkg
10.7- :find-package* :find-symbol* :symbol-call
10.8- :intern* :export* :import* :shadowing-import*
10.9- :shadow* :make-symbol* :unintern*
10.10- :symbol-shadowing-p :home-package-p
10.11+ :find-package* :find-symbol* :symbol-call :intern*
10.12+ :export* :import* :shadowing-import* :shadow*
10.13+ :symbol-shadowing-p :home-package-p :make-symbol* :unintern*
10.14 :symbol-package-name :standard-common-lisp-symbol-p
10.15 :reify-package :unreify-package :reify-symbol :unreify-symbol
10.16 :nuke-symbol-in-package :nuke-symbol :rehome-symbol
10.17 :ensure-package-unused :delete-package*
10.18 :package-names :packages-from-names :fresh-package-name
10.19 :rename-package-away :package-definition-form :parse-defpkg-form
10.20- :ensure-package))
10.21+ :ensure-package :with-package))
10.22
10.23 (in-package :std/defpkg)
10.24
10.25@@ -738,3 +737,11 @@
10.26 (:import-from ,pkg-name ,@(set-difference pkg-externs pkg-shadows))
10.27 (:export ,@cl-externs)
10.28 (:export ,@pkg-externs)))))
10.29+
10.30+
10.31+(defmacro with-package ((pkg) &body body)
10.32+ "Execute BODY within the package PKG."
10.33+ `(let ((current (package-name *package*)))
10.34+ (unwind-protect (progn (in-package ,pkg) ,@body)
10.35+ (eval-when (:compile-toplevel :load-toplevel :execute)
10.36+ (setq *package* (find-package current))))))
11.1--- a/lisp/std/pkg.lisp Sat Jun 01 19:16:02 2024 -0400
11.2+++ b/lisp/std/pkg.lisp Sun Jun 02 02:30:54 2024 -0400
11.3@@ -5,8 +5,8 @@
11.4 ;;; Code:
11.5 (defpackage :std-user
11.6 (:use :cl :std/named-readtables)
11.7- (:shadowing-import-from :std/defpkg :defpkg :define-lisp-package)
11.8- (:export :defpkg :define-lisp-package))
11.9+ (:shadowing-import-from :std/defpkg :defpkg :define-lisp-package :with-package)
11.10+ (:export :defpkg :define-lisp-package :with-package))
11.11 (in-package :std-user)
11.12 (pushnew :std *features*)
11.13
12.1--- a/lisp/std/readtable.lisp Sat Jun 01 19:16:02 2024 -0400
12.2+++ b/lisp/std/readtable.lisp Sun Jun 02 02:30:54 2024 -0400
12.3@@ -201,7 +201,6 @@
12.4 `(funcall ,(cadr clause) ,arg)
12.5 (cadr clause))))
12.6 (cdr contents)))))))))
12.7-
12.8 (defreadtable :std
12.9 (:merge :modern)
12.10 ;; curry
12.11@@ -221,3 +220,5 @@
12.12 ;; lambdas
12.13 (:dispatch-macro-char #\# #\` #'|#`-reader|)
12.14 (:dispatch-macro-char #\# #\f #'|#f-reader|))
12.15+
12.16+(std::in-readtable :std)