changelog shortlog graph tags branches files raw help

Mercurial > core / changeset: cli/multi and slime-cape fixes

changeset 648: 926d95e5fdc7
parent 647: 74e563ed4537
child 649: 6e5006dfe7b8
author: Richard Westhaver <ellis@rwest.io>
date: Thu, 12 Sep 2024 16:48:47 -0400
files: emacs/default.el emacs/lib/slime-cape.el emacs/lib/ulang.el lisp/lib/cli/cli.asd lisp/lib/cli/cli.lisp lisp/lib/cli/multi.lisp lisp/lib/cli/pkg.lisp lisp/std/path.lisp lisp/std/pkg.lisp
description: cli/multi and slime-cape fixes
     1.1--- a/emacs/default.el	Wed Sep 11 21:40:01 2024 -0400
     1.2+++ b/emacs/default.el	Thu Sep 12 16:48:47 2024 -0400
     1.3@@ -80,6 +80,8 @@
     1.4 (defvar company-home "the.compiler.company")
     1.5 (defvar company-cdn-url "https://cdn.compiler.company")
     1.6 
     1.7+(add-to-load-path user-emacs-lib-directory)
     1.8+
     1.9 ;;; Theme
    1.10 (defun load-default-theme (&optional theme)
    1.11   (interactive)
    1.12@@ -157,9 +159,9 @@
    1.13                                            (interactive)
    1.14                                            (corfu-insert)
    1.15                                            (insert ,(cdr c)))))
    1.16-  (add-to-list 'completion-at-point-functions #'cape-dabbrev t)
    1.17-  (add-to-list 'completion-at-point-functions #'cape-abbrev t)
    1.18-  (add-to-list 'completion-at-point-functions #'cape-file)
    1.19+  ;; (add-to-list 'completion-at-point-functions #'cape-dabbrev t)
    1.20+  ;; (add-to-list 'completion-at-point-functions #'cape-abbrev t)
    1.21+  ;; (add-to-list 'completion-at-point-functions #'cape-file)
    1.22   (defun corfu-move-to-minibuffer ()
    1.23     (interactive)
    1.24     (pcase completion-in-region--data
    1.25@@ -240,9 +242,10 @@
    1.26 
    1.27 (use-package slime
    1.28   :ensure t
    1.29-  :after (slime-cape slime-repl-ansi-color)
    1.30+  :after (slime-repl-ansi-color)
    1.31   :init
    1.32-  (require 'slime-cape)
    1.33+  (require 'slime-company "slime-company")
    1.34+  (require 'slime-cape "slime-cape")
    1.35   (setq slime-contribs '(slime-fancy
    1.36                          slime-quicklisp
    1.37                          slime-hyperdoc
    1.38@@ -250,7 +253,7 @@
    1.39                          ;; slime-enclosing-context
    1.40                          ;; slime-media
    1.41                          ;; slime-mrepl
    1.42-                         slime-company
    1.43+                         ;; slime-company
    1.44                          slime-sbcl-exts
    1.45                          slime-cape ;; ext
    1.46                          slime-repl-ansi-color
    1.47@@ -265,7 +268,8 @@
    1.48                          slime-asdf))
    1.49   (put 'make-instance 'common-lisp-indent-function 1)
    1.50   (put 'reinitialize-instance 'common-lisp-indent-function 1)
    1.51-  (slime-company-init)
    1.52+  (slime-repl-ansi-color-init)
    1.53+  (slime-cape-init)
    1.54   (slime-setup)
    1.55   ;; X11-only (mcclim requires clx)
    1.56   (defun clouseau-inspect (string)
    1.57@@ -321,8 +325,9 @@
    1.58   (setq common-lisp-style-default "core")
    1.59   ;; (define-key slime-prefix-map (kbd "i") 'clouseau-inspect)
    1.60   (setq slime-threads-update-interval 1)
    1.61-  (add-hook 'slime-mode-hook #'slime-cape-maybe-enable 100)
    1.62-  (add-hook 'slime-repl-mode-hook #'slime-cape-maybe-enable 100))
    1.63+  ;; (add-hook 'slime-mode-hook 'slime-cape-maybe-enable)
    1.64+  ;; (add-hook 'slime-repl-mode-hook 'slime-cape-maybe-enable)
    1.65+  )
    1.66 
    1.67 (use-package lisp-mode
    1.68   :ensure nil
    1.69@@ -1183,7 +1188,6 @@
    1.70 (add-hook 'mail-send-hook  #'ispell-message)
    1.71 
    1.72 ;;; Skel
    1.73-(add-to-load-path user-emacs-lib-directory)
    1.74 (require 'sk)
    1.75 (require 'skt)
    1.76 
     2.1--- a/emacs/lib/slime-cape.el	Wed Sep 11 21:40:01 2024 -0400
     2.2+++ b/emacs/lib/slime-cape.el	Thu Sep 12 16:48:47 2024 -0400
     2.3@@ -14,6 +14,7 @@
     2.4 ;; Package-Requires: ((slime-company "1.6"))
     2.5 
     2.6 (require 'slime)
     2.7+(require 'slime-repl)
     2.8 (require 'slime-company)
     2.9 (require 'cape)
    2.10 
    2.11@@ -22,13 +23,17 @@
    2.12 (define-slime-contrib slime-cape
    2.13   (:authors "ccQpein")
    2.14   (:swank-dependencies swank-arglists)
    2.15-  (:on-unload
    2.16-   (delete cape-slime-backend completion-at-point-functions)))
    2.17+  (:on-load
    2.18+   (dolist (h '(slime-mode-hook slime-repl-mode-hook sldb-mode-hook))
    2.19+     (add-hook h 'slime-cape-enable)))
    2.20+   (:on-unload
    2.21+    (dolist (h '(slime-mode-hook slime-repl-mode-hook sldb-mode-hook))
    2.22+      (remove-hook h 'slime-cape-enable))))
    2.23 
    2.24-(defun slime-cape-maybe-enable ()
    2.25+(defun slime-cape-enable ()
    2.26   (interactive)
    2.27-  (when slime-mode
    2.28-    (add-to-list 'completion-at-point-functions cape-slime-backend)))
    2.29+  (push cape-slime-backend completion-at-point-functions)
    2.30+  (push cape-slime-backend slime-completion-at-point-functions))
    2.31 
    2.32 (provide 'slime-cape)
    2.33 ;;; slime-cape.el ends here
     3.1--- a/emacs/lib/ulang.el	Wed Sep 11 21:40:01 2024 -0400
     3.2+++ b/emacs/lib/ulang.el	Thu Sep 12 16:48:47 2024 -0400
     3.3@@ -196,11 +196,11 @@
     3.4             (insert "#+LOCATION: " val "\n")))
     3.5       (org-set-property "LOCATION" value))))
     3.6 
     3.7-(defun org-follow-location ()
     3.8+(defun org-follow-location (point)
     3.9   "Open the location specified by the LOCATION property of the org heading
    3.10 or file at point."
    3.11-  (interactive)
    3.12-  (let ((loc ))
    3.13+  (interactive "d")
    3.14+  (let ((loc (org-get-location point)))
    3.15     (cond
    3.16      ((string-match-p org-link-any-re loc) (org-link-open-from-string loc))
    3.17      ;; TODO 2024-08-29: handle other location types (physical, etc)
     4.1--- a/lisp/lib/cli/cli.asd	Wed Sep 11 21:40:01 2024 -0400
     4.2+++ b/lisp/lib/cli/cli.asd	Thu Sep 12 16:48:47 2024 -0400
     4.3@@ -33,6 +33,7 @@
     4.4                  (:file "opt" :depends-on ("macs" "proto" "ast"))
     4.5                  (:file "cmd" :depends-on ("macs" "proto" "ast"))
     4.6                  (:file "cli" :depends-on ("opt" "cmd"))))
     4.7+               (:file "multi" :depends-on ("repl" "clap"))
     4.8                (:file "cli"))
     4.9   :in-order-to ((test-op (test-op "cli/tests"))))
    4.10 
     5.1--- a/lisp/lib/cli/cli.lisp	Wed Sep 11 21:40:01 2024 -0400
     5.2+++ b/lisp/lib/cli/cli.lisp	Thu Sep 12 16:48:47 2024 -0400
     5.3@@ -9,6 +9,6 @@
     5.4   (:use :cl :std)
     5.5   (:use-reexport :cli/shell :cli/ansi :cli/prompt
     5.6    :cli/progress :cli/spark :cli/prompt :cli/ed
     5.7-   :cli/env :cli/repl :cli/clap))
     5.8+   :cli/env :cli/repl :cli/clap :cli/multi))
     5.9 
    5.10 (defpkg :cli-user (:use :cl :std :cli))
     6.1--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     6.2+++ b/lisp/lib/cli/multi.lisp	Thu Sep 12 16:48:47 2024 -0400
     6.3@@ -0,0 +1,54 @@
     6.4+;;; multi.lisp --- Multi-entry Lisp Cores
     6.5+
     6.6+;; Busybox-style Lisp binaries
     6.7+
     6.8+;;; Commentary:
     6.9+
    6.10+;; We have quite a few Lisp 'binaries' at this point, each of which
    6.11+;; are quite bloated Lisp core images with tons of duplication.
    6.12+
    6.13+;; This setup isn't ideal and while we can compress each individual
    6.14+;; core, we are much better off if we can just share the same core
    6.15+;; image and access multiple top-level entrypoints easily.
    6.16+
    6.17+;; The problem of course is that we want to be able to execute the
    6.18+;; single core the same as we would the individual bloated
    6.19+;; binaries. To do this we have two options:
    6.20+
    6.21+;; - build (non-lisp) trampoline programs which loads the
    6.22+;;   (non-executable) core as a shared library, and calls
    6.23+;;   foreign-symbols exposed from lisp.
    6.24+
    6.25+;; - parse argv[0] and dispatch to the correct top-level
    6.26+;;   function. Control argv[0] by symlinking to the executable core.
    6.27+
    6.28+;; This package currently exposes an API for the latter.
    6.29+
    6.30+;;; Code:
    6.31+(in-package :cli/multi)
    6.32+
    6.33+(defmacro define-multi-main ((&key default (exit t) (export t)) &rest mains)
    6.34+  "Define a MAIN function for the current package which dispatches
    6.35+  based on the value of '(ARG0)' at runtime to one of the pairs in
    6.36+  MAINS.
    6.37+
    6.38+Each element of MAINS is a list of the form (NAME FUNCTION) where NAME
    6.39+is the filename of the symlink which will be handled by the associated
    6.40+main FUNCTION.
    6.41+
    6.42+When you save an executable lisp image with this function you should
    6.43+arrange for symlinks for each handled value of (ARG0) to be generated
    6.44+."
    6.45+  `(defmain (:exit ,exit :export ,export)
    6.46+     (string-case ((pathname-name (arg0)) :default ,default)
    6.47+       ,@mains)))
    6.48+
    6.49+(defun make-symlinks (src &optional directory &rest names)
    6.50+  "Make a set of symlinks from SRC to NAMES.
    6.51+
    6.52+If DIRECTORY is non-nil each name in NAMES is considered relative to
    6.53+it."
    6.54+  (when directory
    6.55+    (setf names (mapcar (lambda (n) (merge-pathnames n directory)) names)))
    6.56+  (dolist (n names)
    6.57+    (sb-posix:symlink src n)))
     7.1--- a/lisp/lib/cli/pkg.lisp	Wed Sep 11 21:40:01 2024 -0400
     7.2+++ b/lisp/lib/cli/pkg.lisp	Thu Sep 12 16:48:47 2024 -0400
     7.3@@ -97,3 +97,9 @@
     7.4 (defpackage :cli/ed
     7.5   (:use :cl :std :cli/env)
     7.6   (:export :run-emacs :run-emacsclient :org-store-link))
     7.7+
     7.8+(defpackage :cli/multi
     7.9+  (:use :cl :std :cli/clap :cli/repl)
    7.10+  (:export
    7.11+   #:define-multi-main
    7.12+   #:make-symlinks))
     8.1--- a/lisp/std/path.lisp	Wed Sep 11 21:40:01 2024 -0400
     8.2+++ b/lisp/std/path.lisp	Thu Sep 12 16:48:47 2024 -0400
     8.3@@ -5,6 +5,9 @@
     8.4 ;;; Code:
     8.5 (in-package :std/path)
     8.6 
     8.7+(defun symlinkp (pathname)
     8.8+  (sb-posix:s-islnk (sb-posix:stat-mode (sb-posix:lstat pathname))))
     8.9+
    8.10 (deftype wild-pathname ()
    8.11   "A pathname with wild components."
    8.12   '(and pathname (satisfies wild-pathname-p)))
    8.13@@ -23,6 +26,9 @@
    8.14 (deftype directory-pathname ()
    8.15   '(and pathname (satisfies uiop:directory-pathname-p)))
    8.16 
    8.17+(deftype symlink-pathname ()
    8.18+  '(and pathname (satisfies symlinkp)))
    8.19+
    8.20 (deftype absolute-directory-pathname ()
    8.21   '(and absolute-pathname directory-pathname))
    8.22 
     9.1--- a/lisp/std/pkg.lisp	Wed Sep 11 21:40:01 2024 -0400
     9.2+++ b/lisp/std/pkg.lisp	Thu Sep 12 16:48:47 2024 -0400
     9.3@@ -386,6 +386,8 @@
     9.4    :absolute-pathname
     9.5    :relative-pathname
     9.6    :directory-pathname
     9.7+   :symlink-pathname
     9.8+   :symlinkp
     9.9    :absolute-directory-pathname
    9.10    :+wildfile+ :+pathsep+ :set-pathname-suffix :*tmp-suffix*
    9.11    :tmpize-pathname))