# HG changeset patch # User Richard Westhaver # Date 1717309854 14400 # Node ID d876b572b5b9b735ba4e2846d960f92240842f58 # Parent a866723aac841fe653ab9069759166f0a4cf6e2e updates diff -r a866723aac84 -r d876b572b5b9 emacs/default.el --- a/emacs/default.el Sat Jun 01 19:16:02 2024 -0400 +++ b/emacs/default.el Sun Jun 02 02:30:54 2024 -0400 @@ -47,7 +47,7 @@ eww-auto-rename-buffer 'title eww-search-prefix "https://duckduckgo.com/html?q=" view-read-only t) - +(browse-url-default-browser "") ;;; Variables (defvar user-custom-file (expand-file-name (format "%s.el" user-login-name) user-emacs-directory)) (defvar user-home-directory (expand-file-name "~")) diff -r a866723aac84 -r d876b572b5b9 emacs/lib/publish.el --- a/emacs/lib/publish.el Sat Jun 01 19:16:02 2024 -0400 +++ b/emacs/lib/publish.el Sun Jun 02 02:30:54 2024 -0400 @@ -7,8 +7,8 @@ (require 'org-id) ;; vendored (require 'htmlize) -(defvar project-dir "~/dev/comp/org") -(defvar publish-dir "/mnt/w/compiler.company") +(defvar project-dir "~/comp/org") +(defvar publish-dir "/mnt/y/stash/compiler.company") (defvar html-theme nil) (defvar url "https://compiler.company") (defvar html-nav "
(~ (blog docs) (vc packy))
") diff -r a866723aac84 -r d876b572b5b9 emacs/lib/sk.el --- a/emacs/lib/sk.el Sat Jun 01 19:16:02 2024 -0400 +++ b/emacs/lib/sk.el Sun Jun 02 02:30:54 2024 -0400 @@ -139,7 +139,7 @@ (add-to-list 'auto-mode-alist '("\\.sk\\'" . skel-mode))) ;;; Autotype -;; From: https://github.com/xFA25E/skempo/blob/master/skempo.el +;; ref: https://raw.githubusercontent.com/xFA25E/skempo/master/skempo.el ;; (defun modify-lisp-syntax-tables () ;; (modify-syntax-entry ?* "w" (syntax-table)) diff -r a866723aac84 -r d876b572b5b9 lisp/ffi/zstd/pkg.lisp --- a/lisp/ffi/zstd/pkg.lisp Sat Jun 01 19:16:02 2024 -0400 +++ b/lisp/ffi/zstd/pkg.lisp Sun Jun 02 02:30:54 2024 -0400 @@ -1,7 +1,16 @@ ;;; ffi/zstd/pkg.lisp --- ZSTD FFI -;; from zstd.h: -#| +;; Zstd compression support for Lisp + +;;; Commentary: + +;; The following programs have compile-time flags which can be used to enable +;; internal Zstd support: + +;; SBCL +;; QEMU + +#| from zstd.h: Introduction zstd, short for Zstandard, is a fast lossless compression algorithm, targeting diff -r a866723aac84 -r d876b572b5b9 lisp/lib/box/archiso.lisp --- a/lisp/lib/box/archiso.lisp Sat Jun 01 19:16:02 2024 -0400 +++ b/lisp/lib/box/archiso.lisp Sun Jun 02 02:30:54 2024 -0400 @@ -191,4 +191,30 @@ ;; TODO 2024-05-31: (defcfg archiso-cfg () - ()) + ((config-version :initform "2.6.0" :type string) + (hostname :type string) + (kernels :initform '("linux") :type list) + locale-config + mirror-config + network-config + (no-pkg-lookups :initform nil :type boolean) + (ntp :initform t :type boolean) + network + (offline :initform nil :type boolean) + packages + (archinstall-language :initform "English" :type string) + (bootloader :initform "Systemd-boot" :type string) + (debug :initform nil :type boolean) + parallel-downloads + disk-config + disk-encryption + profile-config + save-config + audio-config + (additional-repositories :initform nil :type list) + script + silent + (swap :initform t :type boolean) + timezone + (version :initform "2.6.0" :type string))) + diff -r a866723aac84 -r d876b572b5b9 lisp/lib/box/box.lisp --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/lib/box/box.lisp Sun Jun 02 02:30:54 2024 -0400 @@ -0,0 +1,8 @@ +;;; box/box.lisp --- Box API + +;; High-level Box interface for KVM management. + +;;; Commentary: + +;;; Code: +(in-package :box) diff -r a866723aac84 -r d876b572b5b9 lisp/lib/box/qmp.lisp --- a/lisp/lib/box/qmp.lisp Sat Jun 01 19:16:02 2024 -0400 +++ b/lisp/lib/box/qmp.lisp Sun Jun 02 02:30:54 2024 -0400 @@ -1,6 +1,23 @@ ;;; box/qmp.lisp --- QEMU Monitor Protocol -;; +;; Lisp Interface for QMP commands, objects, and events. + +;;; Commentary: + +;; ref: https://www.qemu.org/docs/master/interop/qemu-qmp-ref.html + +;; QEMU is a complex, surprisingly flexible, and at times difficult piece of +;; software which is often used via proxy with VirtualBox or Proxmox - as in +;; via another application calling QEMU internally. + +;; My problem with this is that too many of the implementation details are +;; hidden from the user, or covered up with additional abstractions. As the +;; developers maintain these abstractions they struggle to keep up with the +;; new low-level features implemented in their core systems. + +;; To avoid the trickle-down economics of external application development, we +;; will develop a library which supports as much of the QMP and QAPI +;; surface-area that we deem suitable to support our applications. ;;; Code: (in-package :box/qmp) diff -r a866723aac84 -r d876b572b5b9 lisp/lib/dat/json.lisp --- a/lisp/lib/dat/json.lisp Sat Jun 01 19:16:02 2024 -0400 +++ b/lisp/lib/dat/json.lisp Sun Jun 02 02:30:54 2024 -0400 @@ -18,16 +18,12 @@ :accessor json-object-members)) (:documentation "An associative list of key/value pairs.")) -;;; ---------------------------------------------------- - (defmethod print-object ((obj json-object) stream) "Output a JSON object to a stream in readable form." (print-unreadable-object (obj stream :type t) (let ((*print-level* 1)) (json-encode obj stream)))) -;;; ---------------------------------------------------- - (defun json-getf (object key &optional value) "Find an member's value in a JSON object." (let ((place (assoc key (json-object-members object) :test 'string=))) @@ -35,8 +31,6 @@ value (values (second place) t)))) -;;; ---------------------------------------------------- - (defun json-setf (object key value) "Assign a value to a key in a JSON object." (let ((place (assoc key (json-object-members object) :test 'string=))) @@ -48,12 +42,8 @@ (push (list k value) (json-object-members object))) (rplacd place (list value)))))) -;;; ---------------------------------------------------- - (defsetf json-getf json-setf) -;;; ---------------------------------------------------- - (defun json-decode (string &key (start 0) end) "Convert a JSON string into a Lisp object." (with-input-from-string (stream string :start start :end end) @@ -64,8 +54,6 @@ (declare (ignore format)) (json-decode obj :start start :end end)) -;;; ---------------------------------------------------- - (defun json-encode (value &optional stream) "Encodes a Lisp value into a stream." (json-write value stream)) @@ -78,8 +66,6 @@ (json-encode obj s) s))) -;;; ---------------------------------------------------- - (defun json-enable-reader-macro () "Set the #{ dispatch macro character for reading JSON objects." (flet ((json-object-reader (stream char n) @@ -112,20 +98,15 @@ (#\{ (json-read-object stream)) (#\[ (json-read-list stream)) (#\" (json-read-string stream)) - ;; must be a number (otherwise (json-read-number stream))))) -;;; ---------------------------------------------------- - (defun json-peek-char (stream expected &key skip-ws) "Peek at the next character or token and optionally error if unexpected." (declare (optimize (speed 3) (debug 0))) (when (equal (peek-char skip-ws stream) expected) (read-char stream))) -;;; ---------------------------------------------------- - (defun json-read-char (stream expected &key skip-ws) "Read the next, expected character in the stream." (declare (optimize (speed 3) (debug 0))) @@ -133,8 +114,6 @@ t (error "JSON error: unexpected ~s" (read-char stream)))) -;;; ---------------------------------------------------- - (defun json-read-true (stream) "Read true from a JSON stream." (json-read-char stream #\t :skip-ws t) @@ -142,8 +121,6 @@ (json-read-char stream #\u) (json-read-char stream #\e)) -;;; ---------------------------------------------------- - (defun json-read-false (stream) "Read false from a JSON stream." (prog1 nil @@ -153,8 +130,6 @@ (json-read-char stream #\s) (json-read-char stream #\e))) -;;; ---------------------------------------------------- - (defun json-read-null (stream) "Read null from a JSON stream." (prog1 nil @@ -163,8 +138,6 @@ (json-read-char stream #\l) (json-read-char stream #\l))) -;;; ---------------------------------------------------- - (defun json-read-number (stream) "Read a number from a JSON stream." (declare (optimize (speed 3) (debug 0))) @@ -218,8 +191,6 @@ (prog1 (read-from-string s)))) -;;; ---------------------------------------------------- - (defun json-read-string (stream) "Read a string from a JSON stream." (declare (optimize (speed 3) (debug 0))) @@ -259,8 +230,6 @@ (otherwise c)))) (write-char c s)))))) -;;; ---------------------------------------------------- - (defun json-read-list (stream) "Read a list of JSON values." (declare (optimize (speed 3) (debug 0))) @@ -283,8 +252,6 @@ finally (return (prog1 xs (json-read-char stream #\] :skip-ws t)))))) -;;; ---------------------------------------------------- - (defun json-read-object (stream) "Read an associative list of key/value pairs into a JSON object." (declare (optimize (speed 3) (debug 0))) @@ -317,33 +284,23 @@ (declare (ignore value)) (format stream "~")) -;;; ---------------------------------------------------- - (defmethod json-write ((value (eql nil)) &optional stream) "Encode the null constant." (declare (ignore value)) (format stream "~")) -;;; ---------------------------------------------------- - (defmethod json-write ((value symbol) &optional stream) "Encode a symbol to a stream." (json-write (symbol-name value) stream)) -;;; ---------------------------------------------------- - (defmethod json-write ((value number) &optional stream) "Encode a number to a stream." (format stream "~<~a~>" value)) -;;; ---------------------------------------------------- - (defmethod json-write ((value ratio) &optional stream) "Encode a ratio to a stream." (format stream "~<~a~>" (float value))) -;;; ---------------------------------------------------- - (defmethod json-write ((value string) &optional stream) "Encode a string as a stream." (flet ((encode-char (c) @@ -361,14 +318,10 @@ (string c))))) (format stream "~<\"~{~a~}\"~>" (map 'list #'encode-char value)))) -;;; ---------------------------------------------------- - (defmethod json-write ((value pathname) &optional stream) "Encode a pathname as a stream." (json-write (namestring value) stream)) -;;; ---------------------------------------------------- - (defmethod json-write ((value vector) &optional stream) "Encode an array to a stream." (let ((*print-pretty* t) @@ -386,8 +339,6 @@ (pprint-indent :block 0) (json-write (aref value i) stream)))))) -;;; ---------------------------------------------------- - (defmethod json-write ((value list) &optional stream) "Encode a list to a stream." (let ((*print-pretty* t) @@ -403,8 +354,6 @@ (pprint-newline :fill) (pprint-indent :block 0))))) -;;; ---------------------------------------------------- - (defmethod json-write ((value hash-table) &optional stream) "Encode a hash-table to a stream." (let ((*print-pretty* t) @@ -429,8 +378,6 @@ (pprint-newline :mandatory) (pprint-indent :current 0))))))))) -;;; ---------------------------------------------------- - (defmethod json-write ((value json-object) &optional stream) "Encode a JSON object with an associative list of members to a stream." (let ((*print-pretty* t) diff -r a866723aac84 -r d876b572b5b9 lisp/lib/doc/file.lisp --- a/lisp/lib/doc/file.lisp Sat Jun 01 19:16:02 2024 -0400 +++ b/lisp/lib/doc/file.lisp Sun Jun 02 02:30:54 2024 -0400 @@ -93,9 +93,13 @@ (define-source-file* rust "rs") (define-source-file* shell "sh") +(define-source-file* makefile "mk") (define-source-file* nushell "nu") (define-source-file* common-lisp "lisp") (define-source-file* emacs-lisp "el") +(define-source-file* scheme "scm") +(define-source-file* skel "sk") +(define-source-file* sxp "sxp") (defconstant +max-file-heading-level+ 8) (defconstant +min-file-heading-level+ 3) @@ -180,7 +184,6 @@ :headings #() )))) - ;; (defmacro define-file-heading (type slots)) (defclass file-documentation () diff -r a866723aac84 -r d876b572b5b9 lisp/std/defpkg.lisp --- a/lisp/std/defpkg.lisp Sat Jun 01 19:16:02 2024 -0400 +++ b/lisp/std/defpkg.lisp Sun Jun 02 02:30:54 2024 -0400 @@ -9,17 +9,16 @@ (:use :cl) (:nicknames :pkg) (:export :defpkg - :find-package* :find-symbol* :symbol-call - :intern* :export* :import* :shadowing-import* - :shadow* :make-symbol* :unintern* - :symbol-shadowing-p :home-package-p + :find-package* :find-symbol* :symbol-call :intern* + :export* :import* :shadowing-import* :shadow* + :symbol-shadowing-p :home-package-p :make-symbol* :unintern* :symbol-package-name :standard-common-lisp-symbol-p :reify-package :unreify-package :reify-symbol :unreify-symbol :nuke-symbol-in-package :nuke-symbol :rehome-symbol :ensure-package-unused :delete-package* :package-names :packages-from-names :fresh-package-name :rename-package-away :package-definition-form :parse-defpkg-form - :ensure-package)) + :ensure-package :with-package)) (in-package :std/defpkg) @@ -738,3 +737,11 @@ (:import-from ,pkg-name ,@(set-difference pkg-externs pkg-shadows)) (:export ,@cl-externs) (:export ,@pkg-externs))))) + + +(defmacro with-package ((pkg) &body body) + "Execute BODY within the package PKG." + `(let ((current (package-name *package*))) + (unwind-protect (progn (in-package ,pkg) ,@body) + (eval-when (:compile-toplevel :load-toplevel :execute) + (setq *package* (find-package current)))))) diff -r a866723aac84 -r d876b572b5b9 lisp/std/pkg.lisp --- a/lisp/std/pkg.lisp Sat Jun 01 19:16:02 2024 -0400 +++ b/lisp/std/pkg.lisp Sun Jun 02 02:30:54 2024 -0400 @@ -5,8 +5,8 @@ ;;; Code: (defpackage :std-user (:use :cl :std/named-readtables) - (:shadowing-import-from :std/defpkg :defpkg :define-lisp-package) - (:export :defpkg :define-lisp-package)) + (:shadowing-import-from :std/defpkg :defpkg :define-lisp-package :with-package) + (:export :defpkg :define-lisp-package :with-package)) (in-package :std-user) (pushnew :std *features*) diff -r a866723aac84 -r d876b572b5b9 lisp/std/readtable.lisp --- a/lisp/std/readtable.lisp Sat Jun 01 19:16:02 2024 -0400 +++ b/lisp/std/readtable.lisp Sun Jun 02 02:30:54 2024 -0400 @@ -201,7 +201,6 @@ `(funcall ,(cadr clause) ,arg) (cadr clause)))) (cdr contents))))))))) - (defreadtable :std (:merge :modern) ;; curry @@ -221,3 +220,5 @@ ;; lambdas (:dispatch-macro-char #\# #\` #'|#`-reader|) (:dispatch-macro-char #\# #\f #'|#f-reader|)) + +(std::in-readtable :std)