# HG changeset patch # User Richard Westhaver # Date 1726174127 14400 # Node ID 926d95e5fdc708275319874171274684ff474c04 # Parent 74e563ed453702c0ad9ca7dc2223cb0fefbd6a0c cli/multi and slime-cape fixes diff -r 74e563ed4537 -r 926d95e5fdc7 emacs/default.el --- a/emacs/default.el Wed Sep 11 21:40:01 2024 -0400 +++ b/emacs/default.el Thu Sep 12 16:48:47 2024 -0400 @@ -80,6 +80,8 @@ (defvar company-home "the.compiler.company") (defvar company-cdn-url "https://cdn.compiler.company") +(add-to-load-path user-emacs-lib-directory) + ;;; Theme (defun load-default-theme (&optional theme) (interactive) @@ -157,9 +159,9 @@ (interactive) (corfu-insert) (insert ,(cdr c))))) - (add-to-list 'completion-at-point-functions #'cape-dabbrev t) - (add-to-list 'completion-at-point-functions #'cape-abbrev t) - (add-to-list 'completion-at-point-functions #'cape-file) + ;; (add-to-list 'completion-at-point-functions #'cape-dabbrev t) + ;; (add-to-list 'completion-at-point-functions #'cape-abbrev t) + ;; (add-to-list 'completion-at-point-functions #'cape-file) (defun corfu-move-to-minibuffer () (interactive) (pcase completion-in-region--data @@ -240,9 +242,10 @@ (use-package slime :ensure t - :after (slime-cape slime-repl-ansi-color) + :after (slime-repl-ansi-color) :init - (require 'slime-cape) + (require 'slime-company "slime-company") + (require 'slime-cape "slime-cape") (setq slime-contribs '(slime-fancy slime-quicklisp slime-hyperdoc @@ -250,7 +253,7 @@ ;; slime-enclosing-context ;; slime-media ;; slime-mrepl - slime-company + ;; slime-company slime-sbcl-exts slime-cape ;; ext slime-repl-ansi-color @@ -265,7 +268,8 @@ slime-asdf)) (put 'make-instance 'common-lisp-indent-function 1) (put 'reinitialize-instance 'common-lisp-indent-function 1) - (slime-company-init) + (slime-repl-ansi-color-init) + (slime-cape-init) (slime-setup) ;; X11-only (mcclim requires clx) (defun clouseau-inspect (string) @@ -321,8 +325,9 @@ (setq common-lisp-style-default "core") ;; (define-key slime-prefix-map (kbd "i") 'clouseau-inspect) (setq slime-threads-update-interval 1) - (add-hook 'slime-mode-hook #'slime-cape-maybe-enable 100) - (add-hook 'slime-repl-mode-hook #'slime-cape-maybe-enable 100)) + ;; (add-hook 'slime-mode-hook 'slime-cape-maybe-enable) + ;; (add-hook 'slime-repl-mode-hook 'slime-cape-maybe-enable) + ) (use-package lisp-mode :ensure nil @@ -1183,7 +1188,6 @@ (add-hook 'mail-send-hook #'ispell-message) ;;; Skel -(add-to-load-path user-emacs-lib-directory) (require 'sk) (require 'skt) diff -r 74e563ed4537 -r 926d95e5fdc7 emacs/lib/slime-cape.el --- a/emacs/lib/slime-cape.el Wed Sep 11 21:40:01 2024 -0400 +++ b/emacs/lib/slime-cape.el Thu Sep 12 16:48:47 2024 -0400 @@ -14,6 +14,7 @@ ;; Package-Requires: ((slime-company "1.6")) (require 'slime) +(require 'slime-repl) (require 'slime-company) (require 'cape) @@ -22,13 +23,17 @@ (define-slime-contrib slime-cape (:authors "ccQpein") (:swank-dependencies swank-arglists) - (:on-unload - (delete cape-slime-backend completion-at-point-functions))) + (:on-load + (dolist (h '(slime-mode-hook slime-repl-mode-hook sldb-mode-hook)) + (add-hook h 'slime-cape-enable))) + (:on-unload + (dolist (h '(slime-mode-hook slime-repl-mode-hook sldb-mode-hook)) + (remove-hook h 'slime-cape-enable)))) -(defun slime-cape-maybe-enable () +(defun slime-cape-enable () (interactive) - (when slime-mode - (add-to-list 'completion-at-point-functions cape-slime-backend))) + (push cape-slime-backend completion-at-point-functions) + (push cape-slime-backend slime-completion-at-point-functions)) (provide 'slime-cape) ;;; slime-cape.el ends here diff -r 74e563ed4537 -r 926d95e5fdc7 emacs/lib/ulang.el --- a/emacs/lib/ulang.el Wed Sep 11 21:40:01 2024 -0400 +++ b/emacs/lib/ulang.el Thu Sep 12 16:48:47 2024 -0400 @@ -196,11 +196,11 @@ (insert "#+LOCATION: " val "\n"))) (org-set-property "LOCATION" value)))) -(defun org-follow-location () +(defun org-follow-location (point) "Open the location specified by the LOCATION property of the org heading or file at point." - (interactive) - (let ((loc )) + (interactive "d") + (let ((loc (org-get-location point))) (cond ((string-match-p org-link-any-re loc) (org-link-open-from-string loc)) ;; TODO 2024-08-29: handle other location types (physical, etc) diff -r 74e563ed4537 -r 926d95e5fdc7 lisp/lib/cli/cli.asd --- a/lisp/lib/cli/cli.asd Wed Sep 11 21:40:01 2024 -0400 +++ b/lisp/lib/cli/cli.asd Thu Sep 12 16:48:47 2024 -0400 @@ -33,6 +33,7 @@ (:file "opt" :depends-on ("macs" "proto" "ast")) (:file "cmd" :depends-on ("macs" "proto" "ast")) (:file "cli" :depends-on ("opt" "cmd")))) + (:file "multi" :depends-on ("repl" "clap")) (:file "cli")) :in-order-to ((test-op (test-op "cli/tests")))) diff -r 74e563ed4537 -r 926d95e5fdc7 lisp/lib/cli/cli.lisp --- a/lisp/lib/cli/cli.lisp Wed Sep 11 21:40:01 2024 -0400 +++ b/lisp/lib/cli/cli.lisp Thu Sep 12 16:48:47 2024 -0400 @@ -9,6 +9,6 @@ (:use :cl :std) (:use-reexport :cli/shell :cli/ansi :cli/prompt :cli/progress :cli/spark :cli/prompt :cli/ed - :cli/env :cli/repl :cli/clap)) + :cli/env :cli/repl :cli/clap :cli/multi)) (defpkg :cli-user (:use :cl :std :cli)) diff -r 74e563ed4537 -r 926d95e5fdc7 lisp/lib/cli/multi.lisp --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/lib/cli/multi.lisp Thu Sep 12 16:48:47 2024 -0400 @@ -0,0 +1,54 @@ +;;; multi.lisp --- Multi-entry Lisp Cores + +;; Busybox-style Lisp binaries + +;;; Commentary: + +;; We have quite a few Lisp 'binaries' at this point, each of which +;; are quite bloated Lisp core images with tons of duplication. + +;; This setup isn't ideal and while we can compress each individual +;; core, we are much better off if we can just share the same core +;; image and access multiple top-level entrypoints easily. + +;; The problem of course is that we want to be able to execute the +;; single core the same as we would the individual bloated +;; binaries. To do this we have two options: + +;; - build (non-lisp) trampoline programs which loads the +;; (non-executable) core as a shared library, and calls +;; foreign-symbols exposed from lisp. + +;; - parse argv[0] and dispatch to the correct top-level +;; function. Control argv[0] by symlinking to the executable core. + +;; This package currently exposes an API for the latter. + +;;; Code: +(in-package :cli/multi) + +(defmacro define-multi-main ((&key default (exit t) (export t)) &rest mains) + "Define a MAIN function for the current package which dispatches + based on the value of '(ARG0)' at runtime to one of the pairs in + MAINS. + +Each element of MAINS is a list of the form (NAME FUNCTION) where NAME +is the filename of the symlink which will be handled by the associated +main FUNCTION. + +When you save an executable lisp image with this function you should +arrange for symlinks for each handled value of (ARG0) to be generated +." + `(defmain (:exit ,exit :export ,export) + (string-case ((pathname-name (arg0)) :default ,default) + ,@mains))) + +(defun make-symlinks (src &optional directory &rest names) + "Make a set of symlinks from SRC to NAMES. + +If DIRECTORY is non-nil each name in NAMES is considered relative to +it." + (when directory + (setf names (mapcar (lambda (n) (merge-pathnames n directory)) names))) + (dolist (n names) + (sb-posix:symlink src n))) diff -r 74e563ed4537 -r 926d95e5fdc7 lisp/lib/cli/pkg.lisp --- a/lisp/lib/cli/pkg.lisp Wed Sep 11 21:40:01 2024 -0400 +++ b/lisp/lib/cli/pkg.lisp Thu Sep 12 16:48:47 2024 -0400 @@ -97,3 +97,9 @@ (defpackage :cli/ed (:use :cl :std :cli/env) (:export :run-emacs :run-emacsclient :org-store-link)) + +(defpackage :cli/multi + (:use :cl :std :cli/clap :cli/repl) + (:export + #:define-multi-main + #:make-symlinks)) diff -r 74e563ed4537 -r 926d95e5fdc7 lisp/std/path.lisp --- a/lisp/std/path.lisp Wed Sep 11 21:40:01 2024 -0400 +++ b/lisp/std/path.lisp Thu Sep 12 16:48:47 2024 -0400 @@ -5,6 +5,9 @@ ;;; Code: (in-package :std/path) +(defun symlinkp (pathname) + (sb-posix:s-islnk (sb-posix:stat-mode (sb-posix:lstat pathname)))) + (deftype wild-pathname () "A pathname with wild components." '(and pathname (satisfies wild-pathname-p))) @@ -23,6 +26,9 @@ (deftype directory-pathname () '(and pathname (satisfies uiop:directory-pathname-p))) +(deftype symlink-pathname () + '(and pathname (satisfies symlinkp))) + (deftype absolute-directory-pathname () '(and absolute-pathname directory-pathname)) diff -r 74e563ed4537 -r 926d95e5fdc7 lisp/std/pkg.lisp --- a/lisp/std/pkg.lisp Wed Sep 11 21:40:01 2024 -0400 +++ b/lisp/std/pkg.lisp Thu Sep 12 16:48:47 2024 -0400 @@ -386,6 +386,8 @@ :absolute-pathname :relative-pathname :directory-pathname + :symlink-pathname + :symlinkp :absolute-directory-pathname :+wildfile+ :+pathsep+ :set-pathname-suffix :*tmp-suffix* :tmpize-pathname))