From ef97ad7fa90d27581b988fe1d8ebec38669c3a14 Mon Sep 17 00:00:00 2001 From: Alexander Rosenberg Date: Mon, 15 Jul 2024 02:11:26 -0700 Subject: [PATCH] Back to sly --- early-init.el | 2 +- elisp/slime-capf.el | 365 -------------------------------------------- init.el | 41 +++-- 3 files changed, 30 insertions(+), 378 deletions(-) delete mode 100644 elisp/slime-capf.el diff --git a/early-init.el b/early-init.el index 4a7055e..b5b4f7f 100644 --- a/early-init.el +++ b/early-init.el @@ -2,7 +2,7 @@ ;;; Commentary: ;;; Code: -;; Move native compile cache to follor no-littering conventions +;; Move native compile cache to follow no-littering conventions (when (fboundp 'startup-redirect-eln-cache) (startup-redirect-eln-cache "var/eln-cache/")) diff --git a/elisp/slime-capf.el b/elisp/slime-capf.el deleted file mode 100644 index 7f04143..0000000 --- a/elisp/slime-capf.el +++ /dev/null @@ -1,365 +0,0 @@ -;;; slime-capf.el --- slime completion capf -*-lexical-binding:t-*- -;; -;; Copyright (C) 2009-2021 Ole Arndt -;; Copyright (C) 2023 Alexander Rosenberg -;; -;; Author: Ole Arndt , Alexander Rosenberg -;; Keywords: convenience, lisp, abbrev -;; Version: 1.0 -;; Package-Requires: ((emacs "24.4") (slime "2.13") (cape "1.5")) -;; -;; This file is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . -;; -;;; Commentary: -;; This file is adapted from this repository: -;; https://github.com/anwyn/slime-company -;; -;; It was modified so that it will work with as a capf instead of a company -;; backend. -;;; Code: - -(require 'slime) -(require 'cl-lib) -(require 'eldoc) -(require 'subr-x) -(require 'thingatpt) -(require 'cape) - -;;; ---------------------------------------------------------------------------- -;;; * Customization - -(defgroup slime-capf nil - "Interaction between slime and the company completion mode." - :group 'slime) - -(defcustom slime-capf-after-completion nil - "What to do after a successful completion. -In addition to displaying the arglist slime-capf will also do one of: - -- `nil': nothing, -- insert a space. Useful if space does not select the completion candidate. - Works best if you also call `delete-horizontal-space' before closing - parentheses to remove excess whitespace. -- call an arbitrary function with the completion string as the first parameter. - Do not call company-complete inside this function, company doesn't like to - be invoked recursively. -" - :group 'slime-capf - :type '(choice - (const :tag "Do nothing" nil) - (const :tag "Insert space" slime-capf-just-one-space) - (function :tag "Custom function" nil))) - -(defcustom slime-capf-transform-arglist 'downcase - "Before echoing the arglist it is passed to this function for transformation." - :group 'slime-capf - :type '(choice - (const :tag "Downcase" downcase) - (const :tag "Do nothing" identity) - (function :tag "Custom function" nil))) - -(defcustom slime-capf-display-arglist nil - "Whether to display the arglist of a function in the company popup." - :group 'slime-capf - :type '(choice - (const :tag "Hide arglist" nil) - (const :tag "Show arglist" t))) - -(defcustom slime-capf-display-flags t - "Whether to display the symbol's flags in the company popup. -Symbol flags are only returned with the `fuzzy' completion type." - :group 'slime-capf - :type '(choice - (const :tag "Hide flags" nil) - (const :tag "Show flags" t))) - -(defcustom slime-capf-completion 'simple - "Which Slime completion method to use: `simple' or `fuzzy'. - -`simple' just displays the completion candidate, -`fuzzy' also displays the classification flags as an annotation, -alignment of annotations via `company-tooltip-align-annotations' -is recommended. This method also can complete package names. -" - :group 'slime-capf - :type '(choice - (const simple) - (const fuzzy))) - -(defcustom slime-capf-complete-in-comments-and-strings nil - "Should slime-capf also complete in comments and strings." - :group 'slime-capf - :type 'boolean) - -(defcustom slime-capf-major-modes - '(lisp-mode clojure-mode slime-repl-mode scheme-mode) - "List of major modes in which slime-capf should be active. -slime-capf actually calls `derived-mode-p' on this list, so it will -be active in derived modes as well." - :group 'slime-capf - :type '(repeat symbol)) - -(defun slime-capf-just-one-space (completion-string) - (unless (string-suffix-p ":" completion-string) - (just-one-space))) - -(defsubst slime-capf-active-p () - "Test if the slime-capf backend should be active in the current buffer." - (apply #'derived-mode-p slime-capf-major-modes)) - -(define-derived-mode slime-capf-doc-mode help-mode "Doc" - "Documentation mode for slime-capf." - (setq font-lock-defaults - '((("^\\([^ ]\\{4,\\}\\)\\b" . (1 font-lock-function-name-face t)) - ("^[ ]*\\b\\([A-Z][A-Za-z0-9_ %\\*\\-]+:\\)\\([ ]\\|$\\)" - . (1 font-lock-doc-face)) - ("^\\([A-Z][A-Za-z ]+:\\)\\([ ]\\|$\\)" - . (1 font-lock-doc-face t)) - ("(\\(FUNCTION\\|VALUES\\|OR\\|EQL\\|LAMBDA\\)\\b" - . (1 font-lock-keyword-face)) - ("[ (]+\\(&[A-Z0-9\\-]+\\)\\b" . (1 font-lock-type-face)) - ("[ (]+\\(:[A-Z0-9\\-]+\\)\\b" . (1 font-lock-builtin-face)) - ("\\b\\(T\\|t\\|NIL\\|nil\\|NULL\\|null\\)\\b" . (1 font-lock-constant-face)) - ("\\b[+-]?[0-9/\\.]+[sdeSDE]?\\+?[0-9]*\\b" . font-lock-constant-face) - ("#[xX][+-]?[0-9A-F/]+\\b" . font-lock-constant-face) - ("#[oO][+-]?[0-7/]+\\b" . font-lock-constant-face) - ("#[bB][+-]?[01/]+\\b" . font-lock-constant-face) - ("#[0-9]+[rR][+-]?[0-9A-Z/]+\\b" . font-lock-constant-face) - ("\\b\\([A-Z0-9:+%<>#*\\.\\-]\\{2,\\}\\)\\b" - . (1 font-lock-variable-name-face)))))) - -;;; ---------------------------------------------------------------------------- -;;; * Internals - -(defun slime-capf--fetch-candidates-async (prefix) - (when (slime-connected-p) - (cl-ecase slime-capf-completion - (simple (slime-capf--fetch-candidates-simple prefix)) - (fuzzy (slime-capf--fetch-candidates-fuzzy prefix))))) - -(defun slime-capf--fetch-candidates-simple (prefix) - (let ((slime-current-thread :repl-thread) - (package (slime-current-package))) - (cons :async - (lambda (callback) - (slime-eval-async - `(swank:simple-completions ,prefix ',package) - (lambda (result) - (funcall callback (car result))) - package))))) - -(defun slime-capf--fetch-candidates-fuzzy (prefix) - (let ((slime-current-thread :repl-thread) - (package (slime-current-package))) - (cons :async - (lambda (callback) - (slime-eval-async - `(swank:fuzzy-completions ,prefix ',package) - (lambda (result) - (funcall callback - (mapcar - (lambda (completion) - (cl-destructuring-bind (sym score _ flags) - completion - (propertize sym 'score score 'flags flags))) - (car result)))) - package))))) - -(defun slime-capf--fontify-lisp-buffer () - "Return a buffer in lisp-mode usable for fontifying lisp expressions." - (let ((buffer-name " *slime-capf-fontify*")) - (or (get-buffer buffer-name) - (with-current-buffer (get-buffer-create buffer-name) - (unless (derived-mode-p 'lisp-mode) - ;; Advice from slime: Just calling (lisp-mode) will turn slime-mode - ;; on in that buffer, which may interfere with the calling function - (setq major-mode 'lisp-mode) - (lisp-mode-variables t)) - (current-buffer))))) - -(defun slime-capf--fontify-lisp (string) - "Fontify STRING as `font-lock-mode' does in Lisp mode." - ;; copied functionality from slime, trimmed somewhat - (with-current-buffer (slime-capf--fontify-lisp-buffer) - (erase-buffer) - (insert (funcall slime-capf-transform-arglist string)) - (let ((font-lock-verbose nil)) - (font-lock-fontify-region (point-min) (point-max))) - (goto-char (point-min)) - (buffer-substring (point-min) (point-max)))) - -(defun slime-capf--format (doc) - (let ((doc (slime-capf--fontify-lisp doc))) - (cond ((eq eldoc-echo-area-use-multiline-p t) doc) - (t (slime-oneliner (replace-regexp-in-string "[ \n\t]+" " " doc)))))) - -(defun slime-capf--arglist (arg) - (let ((arglist (slime-eval - `(swank:operator-arglist ,arg ,(slime-current-package))))) - (when arglist - (slime-capf--format arglist)))) - -(defun slime-capf--arglist-only (arg) - (let ((arglist (slime-eval - `(swank:operator-arglist ,arg ,(slime-current-package))))) - (when arglist - (replace-regexp-in-string - (concat "(" (funcall slime-capf-transform-arglist arg) " ") - " (" (funcall slime-capf-transform-arglist arglist) t t)))) - -(defun slime-capf--echo-arglist (arg) - (slime-eval-async `(swank:operator-arglist ,arg ,(slime-current-package)) - (lambda (arglist) - (when arglist - (slime-message "%s" (slime-capf--format arglist)))))) - -(defun slime-capf--package-name (pkg) - "Convert a string into into a uninterned symbol name, if it looks -like a package name, i.e. if it has a trailing colon. -Returns NIL if the string does not look like a package name." - (when (string-suffix-p ":" pkg) - (format "#:%s" (string-remove-suffix ":" (string-remove-suffix ":" pkg))))) - -(defun slime-capf--build-describe-request (candidate &optional verbose) - (let ((pkg-name (slime-capf--package-name candidate))) - (cond (pkg-name - `(swank::describe-to-string - (cl:find-package - (cl:symbol-name (cl:read-from-string ,pkg-name))))) - (verbose - `(swank:describe-symbol ,candidate)) - (t - `(swank:documentation-symbol ,candidate))))) - -(defun slime-capf--fontify-doc-buffer (&optional doc) - "Return a buffer in `slime-capf-doc-mode' usable for fontifying documentation." - (with-current-buffer (get-buffer-create "*slime-capf-doc-buffer*") - (slime-capf-doc-mode) - (setq buffer-read-only nil) - (when doc - (insert doc)) - (goto-char (point-min)) - (current-buffer))) - -(defun slime-capf--doc-buffer (candidate) - "Show the Lisp symbol documentation for CANDIDATE in a buffer. -Shows more type info than `slime-capf--quickhelp-string'." - (let* ((slime-current-thread :repl-thread)) - (slime-capf--fontify-doc-buffer - (slime-eval (slime-capf--build-describe-request candidate t) - (slime-current-package))))) - -(defun slime-capf--quickhelp-string (candidate) - "Retrieve the Lisp symbol documentation for CANDIDATE. -This function does not fontify and displays the result of SWANK's -`documentation-symbol' function, instead of the more verbose `describe-symbol'." - (let ((slime-current-thread :repl-thread)) - (slime-eval (slime-capf--build-describe-request candidate) - (slime-current-package)))) - -(defun slime-capf--location (candidate) - (let ((source-buffer (current-buffer))) - (save-window-excursion - (slime-edit-definition candidate) - (let ((buffer (if (eq source-buffer (current-buffer)) - slime-xref-last-buffer - (current-buffer)))) - (when (buffer-live-p buffer) - (cons buffer (with-current-buffer buffer - (point)))))))) - -(defun slime-capf--post-completion (candidate) - (slime-capf--echo-arglist candidate) - (when (functionp slime-capf-after-completion) - (funcall slime-capf-after-completion candidate))) - -(defun slime-capf--in-string-or-comment () - "Return non-nil if point is within a string or comment. -In the REPL we disregard anything not in the current input area." - (save-restriction - (when (derived-mode-p 'slime-repl-mode) - (narrow-to-region slime-repl-input-start-mark (point))) - (let* ((sp (syntax-ppss)) - (beg (nth 8 sp))) - (when (or (eq (char-after beg) ?\") - (nth 4 sp)) - beg)))) - -(defun slime-capf--kind (candidate) - "Return the kind of completion that CANDIDATE is." - (when-let ((cs (get-text-property 0 'flags candidate)) - ((stringp cs))) - (cl-loop for c across cs - when (eq c ?m) - return 'macro - when (or (eq c ?f) (eq c ?g)) - return 'function - when (eq c ?b) - return 'variable - when (eq c ?c) - return 'class - when (eq c ?p) - return 'module - when (eq c ?s) - return 'keyword))) - -;;; ---------------------------------------------------------------------------- -;;; * Company backend function - -(defvar *slime-capf--meta-request* nil - "Workaround lock for company-quickhelp, which invokes 'quickhelp-string' or -doc-buffer' while a 'meta' request is running, causing SLIME to cancel requests.") - -(defun slime-capf-company-slime (command &optional arg &rest ignored) - "Company mode backend for slime." - (let ((candidate (and arg (substring-no-properties arg)))) - (cl-case command - (init - (slime-capf-active-p)) - (prefix - (when (and (slime-capf-active-p) - (slime-connected-p) - (or slime-capf-complete-in-comments-and-strings - (null (slime-capf--in-string-or-comment)))) - (thing-at-point 'symbol t))) - (candidates - (slime-capf--fetch-candidates-async candidate)) - (meta - (let ((*slime-capf--meta-request* t)) - (slime-capf--arglist candidate))) - (annotation - (concat (when slime-capf-display-arglist - (slime-capf--arglist-only candidate)) - (when slime-capf-display-flags - (concat " " (get-text-property 0 'flags arg))))) - (kind - (slime-capf--kind arg)) - (doc-buffer - (unless *slime-capf--meta-request* - (slime-capf--doc-buffer candidate))) - (quickhelp-string - (unless *slime-capf--meta-request* - (slime-capf--quickhelp-string candidate))) - (location - (slime-capf--location candidate)) - (post-completion - (slime-capf--post-completion candidate)) - (sorted - (eq slime-capf-completion 'fuzzy))))) - -(defalias 'slime-capf-complete-at-point - (cape-company-to-capf 'slime-capf-company-slime)) - -(provide 'slime-capf) -;;; slime-capf.el ends here diff --git a/init.el b/init.el index 9ba0849..0225c1d 100644 --- a/init.el +++ b/init.el @@ -901,20 +901,37 @@ COMMAND and COMINT are like `compile'." ;; yuck (config language for eww) (use-package yuck-mode) -;; slime -(use-package slime - :defer nil +;; sly +(use-package sly + :hook (lisp-mode . my/-lisp-mode-autoconnect-sly) + :bind (:map sly-mode-map + ("C-c e" . my/sly-show-notes-at-point)) + :autoload sly-connected-p :init - (setq inferior-lisp-program "sbcl") + (defun my/-lisp-mode-autoconnect-sly () + (unless (sly-connected-p) + (sly))) + (defun my/sly-notes-at-point (pos &optional buffer) + "Returns the sly notes at POS in BUFFER. +If BUFFER is nil, the current buffer is used." + (with-current-buffer (or buffer (current-buffer)) + (cl-loop for overlay in (overlays-at pos) + for note = (overlay-get overlay 'sly-note) + when note + collect note))) + (defun my/sly-show-notes-at-point () + "Show all sly notes at point in a floating window." + (interactive) + (my/floating-tooltip " *sly-note-posframe*" + (with-output-to-string + (dolist (note (my/sly-notes-at-point (point))) + (when-let (msg (plist-get note :message)) + (princ "ยท") + (princ msg) + (terpri)))))) + (setq inferior-lisp-program "/usr/bin/sbcl") :config - (slime-setup '(slime-fancy-inspector inferior-slime slime-references - slime-xref-browser slime-mdot-fu slime-sprof slime-fancy))) -(use-package slime-capf - :ensure nil - :after slime - :config - (advice-add 'slime--completion-at-point :override - 'slime-capf-complete-at-point)) + (sly-symbol-completion-mode -1)) ;; pdf-tools (use-package pdf-tools