Mercurial > core / emacs/lib/slime-company.el
| changeset 698: |
96958d3eb5b0 |
| parent: |
ab02408636b7
|
| author: |
Richard Westhaver <ellis@rwest.io> |
| date: |
Fri, 04 Oct 2024 22:04:59 -0400 |
| permissions: |
-rw-r--r-- |
| description: |
fixes |
1 ;;; slime-company.el --- slime completion backend for company mode -*-lexical-binding:t-*- 3 ;; Copyright (C) 2009-2021 Ole Arndt 5 ;; Author: Ole Arndt <anwyn@sugarshark.com> 6 ;; Keywords: convenience, lisp, abbrev 8 ;; Package-Requires: ((emacs "24.4") (slime "2.13") (company "0.9.0")) 10 ;; This file is free software; you can redistribute it and/or modify 11 ;; it under the terms of the GNU General Public License as published by 12 ;; the Free Software Foundation, either version 3 of the License, or 13 ;; (at your option) any later version. 15 ;; This program is distributed in the hope that it will be useful, 16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18 ;; GNU General Public License for more details. 20 ;; You should have received a copy of the GNU General Public License 21 ;; along with this program. If not, see <http://www.gnu.org/licenses/>. 25 ;; This is a backend implementation for the completion package 26 ;; company-mode by Nikolaj Schumacher. More info about this package 27 ;; is available at http://company-mode.github.io/ 29 ;; As of version 1.0 this completion backend supports the normal and 30 ;; the fuzzy completion modes of SLIME. 34 ;; Put this file somewhere into your load-path 35 ;; (or just into slime-path/contribs) and then call 37 ;; (slime-setup '(slime-company)) 39 ;; I also have the following, IMO more convenient key bindings for 40 ;; company mode in my .emacs: 42 ;; (define-key company-active-map (kbd "\C-n") 'company-select-next) 43 ;; (define-key company-active-map (kbd "\C-p") 'company-select-previous) 44 ;; (define-key company-active-map (kbd "\C-d") 'company-show-doc-buffer) 45 ;; (define-key company-active-map (kbd "M-.") 'company-show-location) 49 ;; TODO 2024-08-27: don't need this package but need to translate it 57 (define-slime-contrib slime-company 58 "Interaction between slime and the company completion mode." 60 (:authors "Ole Arndt <anwyn@sugarshark.com>") 61 (:swank-dependencies swank-arglists) 63 (dolist (h '(slime-mode-hook slime-repl-mode-hook sldb-mode-hook)) 64 (add-hook h 'slime-company-maybe-enable))) 66 (dolist (h '(slime-mode-hook slime-repl-mode-hook sldb-mode-hook)) 67 (remove-hook h 'slime-company-maybe-enable)) 68 (slime-company-disable))) 70 ;;; ---------------------------------------------------------------------------- 73 (defgroup slime-company nil 74 "Interaction between slime and the company completion mode." 78 (defcustom slime-company-after-completion nil 79 "What to do after a successful completion. 80 In addition to displaying the arglist slime-company will also do one of: 83 - insert a space. Useful if space does not select the completion candidate. 84 Works best if you also call `delete-horizontal-space' before closing 85 parentheses to remove excess whitespace. 86 - call an arbitrary function with the completion string as the first parameter. 87 Do not call company-complete inside this function, company doesn't like to 88 be invoked recursively. 92 (const :tag "Do nothing" nil) 93 (const :tag "Insert space" slime-company-just-one-space) 94 (function :tag "Custom function" nil))) 96 (defcustom slime-company-transform-arglist 'downcase 97 "Before echoing the arglist it is passed to this function for transformation." 100 (const :tag "Downcase" downcase) 101 (const :tag "Do nothing" identity) 102 (function :tag "Custom function" nil))) 104 (defcustom slime-company-display-arglist nil 105 "Whether to display the arglist of a function in the company popup." 106 :group 'slime-company 108 (const :tag "Hide arglist" nil) 109 (const :tag "Show arglist" t))) 111 (defcustom slime-company-display-flags t 112 "Whether to display the symbol's flags in the company popup. 113 Symbol flags are only returned with the `fuzzy' completion type." 114 :group 'slime-company 116 (const :tag "Hide flags" nil) 117 (const :tag "Show flags" t))) 119 (defcustom slime-company-completion 'simple 120 "Which Slime completion method to use: `simple' or `fuzzy'. 122 `simple' just displays the completion candidate, 123 `fuzzy' also displays the classification flags as an annotation, 124 alignment of annotations via `company-tooltip-align-annotations' 125 is recommended. This method also can complete package names. 127 :group 'slime-company 132 (defcustom slime-company-complete-in-comments-and-strings nil 133 "Should slime-company also complete in comments and strings." 134 :group 'slime-company 137 (defcustom slime-company-major-modes 138 '(lisp-mode clojure-mode slime-repl-mode scheme-mode) 139 "List of major modes in which slime-company should be active. 140 Slime-company actually calls `derived-mode-p' on this list, so it will 141 be active in derived modes as well." 142 :group 'slime-company 143 :type '(repeat symbol)) 145 (defun slime-company-just-one-space (completion-string) 146 (unless (string-suffix-p ":" completion-string) 149 (defsubst slime-company-active-p () 150 "Test if the slime-company backend should be active in the current buffer." 151 (apply #'derived-mode-p slime-company-major-modes)) 153 (define-derived-mode slime-company-doc-mode help-mode "Doc" 154 "Documentation mode for slime-company." 155 (setq font-lock-defaults 156 '((("^\\([^ ]\\{4,\\}\\)\\b" . (1 font-lock-function-name-face t)) 157 ("^[ ]*\\b\\([A-Z][A-Za-z0-9_ %\\*\\-]+:\\)\\([ ]\\|$\\)" 158 . (1 font-lock-doc-face)) 159 ("^\\([A-Z][A-Za-z ]+:\\)\\([ ]\\|$\\)" 160 . (1 font-lock-doc-face t)) 161 ("(\\(FUNCTION\\|VALUES\\|OR\\|EQL\\|LAMBDA\\)\\b" 162 . (1 font-lock-keyword-face)) 163 ("[ (]+\\(&[A-Z0-9\\-]+\\)\\b" . (1 font-lock-type-face)) 164 ("[ (]+\\(:[A-Z0-9\\-]+\\)\\b" . (1 font-lock-builtin-face)) 165 ("\\b\\(T\\|t\\|NIL\\|nil\\|NULL\\|null\\)\\b" . (1 font-lock-constant-face)) 166 ("\\b[+-]?[0-9/\\.]+[sdeSDE]?\\+?[0-9]*\\b" . font-lock-constant-face) 167 ("#[xX][+-]?[0-9A-F/]+\\b" . font-lock-constant-face) 168 ("#[oO][+-]?[0-7/]+\\b" . font-lock-constant-face) 169 ("#[bB][+-]?[01/]+\\b" . font-lock-constant-face) 170 ("#[0-9]+[rR][+-]?[0-9A-Z/]+\\b" . font-lock-constant-face) 171 ("\\b\\([A-Z0-9:+%<>#*\\.\\-]\\{2,\\}\\)\\b" 172 . (1 font-lock-variable-name-face)))))) 174 ;;; ---------------------------------------------------------------------------- 177 (defun slime-company-maybe-enable () 178 (when (slime-company-active-p) 180 (add-to-list 'company-backends 'company-slime) 181 (unless (slime-find-contrib 'slime-fuzzy) 182 (setq slime-company-completion 'simple)))) 184 (defun slime-company-disable () 185 (setq company-backends (remove 'company-slime company-backends))) 187 ;;; ---------------------------------------------------------------------------- 190 (defun slime-company--fetch-candidates-async (prefix) 191 (when (slime-connected-p) 192 (cl-ecase slime-company-completion 193 (simple (slime-company--fetch-candidates-simple prefix)) 194 (fuzzy (slime-company--fetch-candidates-fuzzy prefix))))) 196 (defun slime-company--fetch-candidates-simple (prefix) 197 (let ((slime-current-thread :repl-thread) 198 (package (slime-current-package))) 202 `(swank:simple-completions ,prefix ',package) 204 (funcall callback (car result))) 207 (defun slime-company--fetch-candidates-fuzzy (prefix) 208 (let ((slime-current-thread :repl-thread) 209 (package (slime-current-package))) 213 `(swank:fuzzy-completions ,prefix ',package) 218 (cl-destructuring-bind (sym score _ flags) 220 (propertize sym 'score score 'flags flags))) 224 (defun slime-company--fontify-lisp-buffer () 225 "Return a buffer in lisp-mode usable for fontifying lisp expressions." 226 (let ((buffer-name " *slime-company-fontify*")) 227 (or (get-buffer buffer-name) 228 (with-current-buffer (get-buffer-create buffer-name) 229 (unless (derived-mode-p 'lisp-mode) 230 ;; Advice from slime: Just calling (lisp-mode) will turn slime-mode 231 ;; on in that buffer, which may interfere with the calling function 232 (setq major-mode 'lisp-mode) 233 (lisp-mode-variables t)) 236 (defun slime-company--fontify-lisp (string) 237 "Fontify STRING as `font-lock-mode' does in Lisp mode." 238 ;; copied functionality from slime, trimmed somewhat 239 (with-current-buffer (slime-company--fontify-lisp-buffer) 241 (insert (funcall slime-company-transform-arglist string)) 242 (let ((font-lock-verbose nil)) 243 (font-lock-fontify-region (point-min) (point-max))) 244 (goto-char (point-min)) 245 (buffer-substring (point-min) (point-max)))) 247 (defun slime-company--format (doc) 248 (let ((doc (slime-company--fontify-lisp doc))) 249 (cond ((eq eldoc-echo-area-use-multiline-p t) doc) 250 (t (slime-oneliner (replace-regexp-in-string "[ \n\t]+" " " doc)))))) 252 (defun slime-company--arglist (arg) 253 (let ((arglist (slime-eval 254 `(swank:operator-arglist ,arg ,(slime-current-package))))) 256 (slime-company--format arglist)))) 258 (defun slime-company--arglist-only (arg) 259 (let ((arglist (slime-eval 260 `(swank:operator-arglist ,arg ,(slime-current-package))))) 262 (replace-regexp-in-string 263 (concat "(" (funcall slime-company-transform-arglist arg) " ") 264 " (" (funcall slime-company-transform-arglist arglist) t t)))) 266 (defun slime-company--echo-arglist (arg) 267 (slime-eval-async `(swank:operator-arglist ,arg ,(slime-current-package)) 270 (slime-message "%s" (slime-company--format arglist)))))) 272 (defun slime-company--package-name (pkg) 273 "Convert a string into into a uninterned symbol name, if it looks 274 like a package name, i.e. if it has a trailing colon. 275 Returns NIL if the string does not look like a package name." 276 (when (string-suffix-p ":" pkg) 277 (format "#:%s" (string-remove-suffix ":" (string-remove-suffix ":" pkg))))) 279 (defun slime-company--build-describe-request (candidate &optional verbose) 280 (let ((pkg-name (slime-company--package-name candidate))) 282 `(swank::describe-to-string 284 (cl:symbol-name (cl:read-from-string ,pkg-name))))) 286 `(swank:describe-symbol ,candidate)) 288 `(swank:documentation-symbol ,candidate))))) 290 (defun slime-company--fontify-doc-buffer (&optional doc) 291 "Return a buffer in `slime-compary-doc-mode' usable for fontifying documentation." 292 (with-current-buffer (company-doc-buffer) 293 (slime-company-doc-mode) 294 (setq buffer-read-only nil) 297 (goto-char (point-min)) 300 (defun slime-company--doc-buffer (candidate) 301 "Show the Lisp symbol documentation for CANDIDATE in a buffer. 302 Shows more type info than `slime-company--quickhelp-string'." 303 (let* ((slime-current-thread :repl-thread)) 304 (slime-company--fontify-doc-buffer 305 (slime-eval (slime-company--build-describe-request candidate t) 306 (slime-current-package))))) 308 (defun slime-company--quickhelp-string (candidate) 309 "Retrieve the Lisp symbol documentation for CANDIDATE. 310 This function does not fontify and displays the result of SWANK's 311 `documentation-symbol' function, instead of the more verbose `describe-symbol'." 312 (let ((slime-current-thread :repl-thread)) 313 (slime-eval (slime-company--build-describe-request candidate) 314 (slime-current-package)))) 316 (defun slime-company--location (candidate) 317 (let ((source-buffer (current-buffer))) 318 (save-window-excursion 319 (slime-edit-definition candidate) 320 (let ((buffer (if (eq source-buffer (current-buffer)) 321 slime-xref-last-buffer 323 (when (buffer-live-p buffer) 324 (cons buffer (with-current-buffer buffer 327 (defun slime-company--post-completion (candidate) 328 (slime-company--echo-arglist candidate) 329 (when (functionp slime-company-after-completion) 330 (funcall slime-company-after-completion candidate))) 332 (defun slime-company--in-string-or-comment () 333 "Return non-nil if point is within a string or comment. 334 In the REPL we disregard anything not in the current input area." 336 (when (derived-mode-p 'slime-repl-mode) 337 (narrow-to-region slime-repl-input-start-mark (point))) 338 (let* ((sp (syntax-ppss)) 340 (when (or (eq (char-after beg) ?\") 344 ;;; ---------------------------------------------------------------------------- 345 ;;; * Company backend function 347 (defvar *slime-company--meta-request* nil 348 "Workaround lock for company-quickhelp, which invokes 'quickhelp-string' or 349 doc-buffer' while a 'meta' request is running, causing SLIME to cancel requests.") 351 (defun company-slime (command &optional arg &rest ignored) 352 "Company mode backend for slime." 353 (let ((candidate (and arg (substring-no-properties arg)))) 356 (slime-company-active-p)) 358 (when (and (slime-company-active-p) 360 (or slime-company-complete-in-comments-and-strings 361 (null (slime-company--in-string-or-comment)))) 362 (company-grab-symbol))) 364 (slime-company--fetch-candidates-async candidate)) 366 (let ((*slime-company--meta-request* t)) 367 (slime-company--arglist candidate))) 369 (concat (when slime-company-display-arglist 370 (slime-company--arglist-only candidate)) 371 (when slime-company-display-flags 372 (concat " " (get-text-property 0 'flags arg))))) 374 (unless *slime-company--meta-request* 375 (slime-company--doc-buffer candidate))) 377 (unless *slime-company--meta-request* 378 (slime-company--quickhelp-string candidate))) 380 (slime-company--location candidate)) 382 (slime-company--post-completion candidate)) 384 (eq slime-company-completion 'fuzzy))))) 386 (provide 'slime-company) 388 ;;; slime-company.el ends here
