1.1--- a/emacs/default.el Mon Aug 26 22:12:39 2024 -0400
1.2+++ b/emacs/default.el Tue Aug 27 21:36:50 2024 -0400
1.3@@ -218,10 +218,14 @@
1.4 (add-hook 'tab-bar-mode-hook #'tab-bar-history-mode)
1.5
1.6 ;;; Lisp
1.7+(use-package company :ensure t)
1.8+(use-package slime-repl-ansi-color :ensure t)
1.9+(use-package slime-cape :after (company slime) :load-path user-emacs-lib-directory)
1.10+
1.11 (use-package slime
1.12 :ensure t
1.13+ :after (slime-cape slime-repl-ansi-color)
1.14 :init
1.15- (require 'slime-cape)
1.16 (setq slime-contribs '(slime-fancy
1.17 slime-quicklisp
1.18 slime-hyperdoc
1.19@@ -231,12 +235,14 @@
1.20 ;; slime-mrepl
1.21 slime-sbcl-exts
1.22 slime-cape ;; ext
1.23+ slime-repl-ansi-color
1.24 ;; slime-cl-indent
1.25 ;; slime-snapshot
1.26 slime-sprof
1.27 slime-tramp
1.28 ;; slime-typeout-frame
1.29 slime-xref-browser
1.30+ slime-repl-ansi-color
1.31 ;; slime-highlight-edits
1.32 slime-asdf))
1.33 (put 'make-instance 'common-lisp-indent-function 1)
1.34@@ -316,6 +322,7 @@
1.35
1.36 (use-package lisp-mode
1.37 :ensure nil
1.38+ :after slime
1.39 :custom
1.40 inferior-lisp-program "sbcl --dynamic-space-size=8G"
1.41 scheme-program-name "gsi"
1.42@@ -854,8 +861,6 @@
1.43 (add-hook 'after-init-hook #'org-clock-persistence-insinuate)
1.44
1.45 ;; archive
1.46-(setq org-archive-location "archive.org::")
1.47-
1.48 (defun extract-org-directory-titles-as-list (&optional dir)
1.49 (interactive "D")
1.50 (print
2.1--- a/emacs/keys.el Mon Aug 26 22:12:39 2024 -0400
2.2+++ b/emacs/keys.el Tue Aug 27 21:36:50 2024 -0400
2.3@@ -102,8 +102,8 @@
2.4 "a" #'org-agenda
2.5 "A" #'org-agenda-show-week-all
2.6 "RET" #'eshell
2.7- "C-RET" #'eshell-new
2.8- "s-RET" #'term
2.9+ "C-<return>" #'eshell-new
2.10+ "s-<return>" #'term
2.11 "!" #'async-shell-command
2.12 "i" #'imenu
2.13 "SPC" toggle-map
3.1--- a/emacs/lib/publish.el Mon Aug 26 22:12:39 2024 -0400
3.2+++ b/emacs/lib/publish.el Tue Aug 27 21:36:50 2024 -0400
3.3@@ -14,9 +14,6 @@
3.4 (defvar url "https://compiler.company")
3.5 (defvar vc-url "https://vc.compiler.company")
3.6 (defvar packy-url "https://packy.compiler.company")
3.7-(defvar html-nav (format "<div class=\"nav\" id=\"nav\"><h2 id=\"index\">*</h2><div id=\"text-index\"> (<a href = \"%s\">~</a><br> (<a href = \"%s/blog\">blog</a> <a href = \"%s/docs\">docs</a> <a href = \"%s/plan\">plan</a> <a href = \"%s/notes\">notes</a>)<br> (<a href = \"%s\">vc</a> <a href = \"%s\">packy</a>))</div></div>"
3.8- url url url url url vc-url packy-url))
3.9-
3.10 (defvar html-foot "<footer><p>updated %C</p></footer>")
3.11
3.12 ;; (setq org-protocol-project-alist
3.13@@ -27,18 +24,25 @@
3.14 ;; :working-suffix ".org")))
3.15
3.16 (setq org-html-style-default ""
3.17- org-html-scripts ""
3.18+ ;; org-html-scripts ""
3.19 org-html-htmlize-output-type 'css
3.20 org-export-htmlize-output-type 'css
3.21 org-export-allow-bind-keywords t
3.22 org-html-doctype "html5"
3.23 org-html-html5-fancy t
3.24- org-html-validation-link nil
3.25+ ;; org-html-validation-link nil
3.26 org-src-fontify-natively t
3.27 make-backup-files nil
3.28 debug-on-error t
3.29 org-id-link-to-org-use-id t)
3.30
3.31+(setq org-html-link-up "")
3.32+(setq org-html-link-home url)
3.33+
3.34+(setq org-html-home/up-format "<div id=\"org-div-home-and-up\"><a accesskey=\"H\" href=\"%s\"> HOME </a></div>")
3.35+
3.36+
3.37+
3.38 (setq org-publish-project-alist
3.39 `(("compiler.company" :components ("index" "meta" "blog" "docs" "notes" "plan"))
3.40 ("index"
3.41@@ -48,7 +52,6 @@
3.42 :htmlized-source t
3.43 :footnote-section-p t
3.44 :html-doctype "<!doctype html>"
3.45- ;; :html-preamble ,html-nav
3.46 :html-postamble ,html-foot
3.47 :publishing-directory ,publish-dir
3.48 :publishing-function org-html-publish-to-html)
3.49@@ -61,7 +64,6 @@
3.50 :publishing-directory ,(expand-file-name "meta" publish-dir)
3.51 :publishing-function org-html-publish-to-html
3.52 :htmlized-source t
3.53- :html-preamble ,html-nav
3.54 :html-postamble ,html-foot)
3.55 ("blog"
3.56 :base-directory ,(expand-file-name "blog" project-dir)
3.57@@ -72,7 +74,6 @@
3.58 :publishing-directory ,(expand-file-name "blog" publish-dir)
3.59 :publishing-function org-html-publish-to-html
3.60 :htmlized-source t
3.61- :html-preamble ,html-nav
3.62 :html-postamble ,html-foot)
3.63 ("plan"
3.64 :base-directory ,(expand-file-name "plan" project-dir)
3.65@@ -83,7 +84,6 @@
3.66 :publishing-directory ,(expand-file-name "plan" publish-dir)
3.67 :publishing-function org-html-publish-to-html
3.68 :htmlized-source t
3.69- :html-preamble ,html-nav
3.70 :html-postamble ,html-foot)
3.71 ("notes"
3.72 :base-directory ,(expand-file-name "notes" project-dir)
3.73@@ -94,7 +94,6 @@
3.74 :publishing-directory ,(expand-file-name "notes" publish-dir)
3.75 :publishing-function org-html-publish-to-html
3.76 :htmlized-source t
3.77- :html-preamble ,html-nav
3.78 :html-postamble ,html-foot)
3.79 ("docs"
3.80 :base-directory ,(expand-file-name "docs" project-dir)
3.81@@ -105,7 +104,6 @@
3.82 :publishing-directory ,(expand-file-name "docs" publish-dir)
3.83 :publishing-function org-html-publish-to-html
3.84 :htmlized-source t
3.85- :html-preamble ,html-nav
3.86 :html-postamble ,html-foot)))
3.87
3.88 ;; (defun org-export-get-reference-title (datum info)
4.1--- a/emacs/lib/slime-cape.el Mon Aug 26 22:12:39 2024 -0400
4.2+++ b/emacs/lib/slime-cape.el Tue Aug 27 21:36:50 2024 -0400
4.3@@ -27,7 +27,7 @@
4.4
4.5 (defun slime-cape-maybe-enable ()
4.6 (interactive)
4.7- (when (slime-company-active-p)
4.8+ (when slime-mode
4.9 (add-to-list 'completion-at-point-functions cape-slime-backend)))
4.10
4.11 (provide 'slime-cape)
5.1--- /dev/null Thu Jan 01 00:00:00 1970 +0000
5.2+++ b/emacs/lib/slime-company.el Tue Aug 27 21:36:50 2024 -0400
5.3@@ -0,0 +1,388 @@
5.4+;;; slime-company.el --- slime completion backend for company mode -*-lexical-binding:t-*-
5.5+;;
5.6+;; Copyright (C) 2009-2021 Ole Arndt
5.7+;;
5.8+;; Author: Ole Arndt <anwyn@sugarshark.com>
5.9+;; Keywords: convenience, lisp, abbrev
5.10+;; Version: 1.6
5.11+;; Package-Requires: ((emacs "24.4") (slime "2.13") (company "0.9.0"))
5.12+;;
5.13+;; This file is free software; you can redistribute it and/or modify
5.14+;; it under the terms of the GNU General Public License as published by
5.15+;; the Free Software Foundation, either version 3 of the License, or
5.16+;; (at your option) any later version.
5.17+;;
5.18+;; This program is distributed in the hope that it will be useful,
5.19+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
5.20+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
5.21+;; GNU General Public License for more details.
5.22+;;
5.23+;; You should have received a copy of the GNU General Public License
5.24+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
5.25+;;
5.26+;;; Commentary:
5.27+;;
5.28+;; This is a backend implementation for the completion package
5.29+;; company-mode by Nikolaj Schumacher. More info about this package
5.30+;; is available at http://company-mode.github.io/
5.31+;;
5.32+;; As of version 1.0 this completion backend supports the normal and
5.33+;; the fuzzy completion modes of SLIME.
5.34+;;
5.35+;;; Installation:
5.36+;;
5.37+;; Put this file somewhere into your load-path
5.38+;; (or just into slime-path/contribs) and then call
5.39+;;
5.40+;; (slime-setup '(slime-company))
5.41+;;
5.42+;; I also have the following, IMO more convenient key bindings for
5.43+;; company mode in my .emacs:
5.44+;;
5.45+;; (define-key company-active-map (kbd "\C-n") 'company-select-next)
5.46+;; (define-key company-active-map (kbd "\C-p") 'company-select-previous)
5.47+;; (define-key company-active-map (kbd "\C-d") 'company-show-doc-buffer)
5.48+;; (define-key company-active-map (kbd "M-.") 'company-show-location)
5.49+;;
5.50+;;; Code:
5.51+
5.52+;; TODO 2024-08-27: don't need this package but need to translate it
5.53+;; to a cape capf.
5.54+(require 'slime)
5.55+(require 'company)
5.56+(require 'cl-lib)
5.57+(require 'eldoc)
5.58+(require 'subr-x)
5.59+
5.60+(define-slime-contrib slime-company
5.61+ "Interaction between slime and the company completion mode."
5.62+ (:license "GPL")
5.63+ (:authors "Ole Arndt <anwyn@sugarshark.com>")
5.64+ (:swank-dependencies swank-arglists)
5.65+ (:on-load
5.66+ (dolist (h '(slime-mode-hook slime-repl-mode-hook sldb-mode-hook))
5.67+ (add-hook h 'slime-company-maybe-enable)))
5.68+ (:on-unload
5.69+ (dolist (h '(slime-mode-hook slime-repl-mode-hook sldb-mode-hook))
5.70+ (remove-hook h 'slime-company-maybe-enable))
5.71+ (slime-company-disable)))
5.72+
5.73+;;; ----------------------------------------------------------------------------
5.74+;;; * Customization
5.75+
5.76+(defgroup slime-company nil
5.77+ "Interaction between slime and the company completion mode."
5.78+ :group 'company
5.79+ :group 'slime)
5.80+
5.81+(defcustom slime-company-after-completion nil
5.82+ "What to do after a successful completion.
5.83+In addition to displaying the arglist slime-company will also do one of:
5.84+
5.85+- `nil': nothing,
5.86+- insert a space. Useful if space does not select the completion candidate.
5.87+ Works best if you also call `delete-horizontal-space' before closing
5.88+ parentheses to remove excess whitespace.
5.89+- call an arbitrary function with the completion string as the first parameter.
5.90+ Do not call company-complete inside this function, company doesn't like to
5.91+ be invoked recursively.
5.92+"
5.93+ :group 'slime-company
5.94+ :type '(choice
5.95+ (const :tag "Do nothing" nil)
5.96+ (const :tag "Insert space" slime-company-just-one-space)
5.97+ (function :tag "Custom function" nil)))
5.98+
5.99+(defcustom slime-company-transform-arglist 'downcase
5.100+ "Before echoing the arglist it is passed to this function for transformation."
5.101+ :group 'slime-company
5.102+ :type '(choice
5.103+ (const :tag "Downcase" downcase)
5.104+ (const :tag "Do nothing" identity)
5.105+ (function :tag "Custom function" nil)))
5.106+
5.107+(defcustom slime-company-display-arglist nil
5.108+ "Whether to display the arglist of a function in the company popup."
5.109+ :group 'slime-company
5.110+ :type '(choice
5.111+ (const :tag "Hide arglist" nil)
5.112+ (const :tag "Show arglist" t)))
5.113+
5.114+(defcustom slime-company-display-flags t
5.115+ "Whether to display the symbol's flags in the company popup.
5.116+Symbol flags are only returned with the `fuzzy' completion type."
5.117+ :group 'slime-company
5.118+ :type '(choice
5.119+ (const :tag "Hide flags" nil)
5.120+ (const :tag "Show flags" t)))
5.121+
5.122+(defcustom slime-company-completion 'simple
5.123+ "Which Slime completion method to use: `simple' or `fuzzy'.
5.124+
5.125+`simple' just displays the completion candidate,
5.126+`fuzzy' also displays the classification flags as an annotation,
5.127+alignment of annotations via `company-tooltip-align-annotations'
5.128+is recommended. This method also can complete package names.
5.129+"
5.130+ :group 'slime-company
5.131+ :type '(choice
5.132+ (const simple)
5.133+ (const fuzzy)))
5.134+
5.135+(defcustom slime-company-complete-in-comments-and-strings nil
5.136+ "Should slime-company also complete in comments and strings."
5.137+ :group 'slime-company
5.138+ :type 'boolean)
5.139+
5.140+(defcustom slime-company-major-modes
5.141+ '(lisp-mode clojure-mode slime-repl-mode scheme-mode)
5.142+ "List of major modes in which slime-company should be active.
5.143+Slime-company actually calls `derived-mode-p' on this list, so it will
5.144+be active in derived modes as well."
5.145+ :group 'slime-company
5.146+ :type '(repeat symbol))
5.147+
5.148+(defun slime-company-just-one-space (completion-string)
5.149+ (unless (string-suffix-p ":" completion-string)
5.150+ (just-one-space)))
5.151+
5.152+(defsubst slime-company-active-p ()
5.153+ "Test if the slime-company backend should be active in the current buffer."
5.154+ (apply #'derived-mode-p slime-company-major-modes))
5.155+
5.156+(define-derived-mode slime-company-doc-mode help-mode "Doc"
5.157+ "Documentation mode for slime-company."
5.158+ (setq font-lock-defaults
5.159+ '((("^\\([^ ]\\{4,\\}\\)\\b" . (1 font-lock-function-name-face t))
5.160+ ("^[ ]*\\b\\([A-Z][A-Za-z0-9_ %\\*\\-]+:\\)\\([ ]\\|$\\)"
5.161+ . (1 font-lock-doc-face))
5.162+ ("^\\([A-Z][A-Za-z ]+:\\)\\([ ]\\|$\\)"
5.163+ . (1 font-lock-doc-face t))
5.164+ ("(\\(FUNCTION\\|VALUES\\|OR\\|EQL\\|LAMBDA\\)\\b"
5.165+ . (1 font-lock-keyword-face))
5.166+ ("[ (]+\\(&[A-Z0-9\\-]+\\)\\b" . (1 font-lock-type-face))
5.167+ ("[ (]+\\(:[A-Z0-9\\-]+\\)\\b" . (1 font-lock-builtin-face))
5.168+ ("\\b\\(T\\|t\\|NIL\\|nil\\|NULL\\|null\\)\\b" . (1 font-lock-constant-face))
5.169+ ("\\b[+-]?[0-9/\\.]+[sdeSDE]?\\+?[0-9]*\\b" . font-lock-constant-face)
5.170+ ("#[xX][+-]?[0-9A-F/]+\\b" . font-lock-constant-face)
5.171+ ("#[oO][+-]?[0-7/]+\\b" . font-lock-constant-face)
5.172+ ("#[bB][+-]?[01/]+\\b" . font-lock-constant-face)
5.173+ ("#[0-9]+[rR][+-]?[0-9A-Z/]+\\b" . font-lock-constant-face)
5.174+ ("\\b\\([A-Z0-9:+%<>#*\\.\\-]\\{2,\\}\\)\\b"
5.175+ . (1 font-lock-variable-name-face))))))
5.176+
5.177+;;; ----------------------------------------------------------------------------
5.178+;;; * Activation
5.179+
5.180+(defun slime-company-maybe-enable ()
5.181+ (when (slime-company-active-p)
5.182+ (company-mode 1)
5.183+ (add-to-list 'company-backends 'company-slime)
5.184+ (unless (slime-find-contrib 'slime-fuzzy)
5.185+ (setq slime-company-completion 'simple))))
5.186+
5.187+(defun slime-company-disable ()
5.188+ (setq company-backends (remove 'company-slime company-backends)))
5.189+
5.190+;;; ----------------------------------------------------------------------------
5.191+;;; * Internals
5.192+
5.193+(defun slime-company--fetch-candidates-async (prefix)
5.194+ (when (slime-connected-p)
5.195+ (cl-ecase slime-company-completion
5.196+ (simple (slime-company--fetch-candidates-simple prefix))
5.197+ (fuzzy (slime-company--fetch-candidates-fuzzy prefix)))))
5.198+
5.199+(defun slime-company--fetch-candidates-simple (prefix)
5.200+ (let ((slime-current-thread :repl-thread)
5.201+ (package (slime-current-package)))
5.202+ (cons :async
5.203+ (lambda (callback)
5.204+ (slime-eval-async
5.205+ `(swank:simple-completions ,prefix ',package)
5.206+ (lambda (result)
5.207+ (funcall callback (car result)))
5.208+ package)))))
5.209+
5.210+(defun slime-company--fetch-candidates-fuzzy (prefix)
5.211+ (let ((slime-current-thread :repl-thread)
5.212+ (package (slime-current-package)))
5.213+ (cons :async
5.214+ (lambda (callback)
5.215+ (slime-eval-async
5.216+ `(swank:fuzzy-completions ,prefix ',package)
5.217+ (lambda (result)
5.218+ (funcall callback
5.219+ (mapcar
5.220+ (lambda (completion)
5.221+ (cl-destructuring-bind (sym score _ flags)
5.222+ completion
5.223+ (propertize sym 'score score 'flags flags)))
5.224+ (car result))))
5.225+ package)))))
5.226+
5.227+(defun slime-company--fontify-lisp-buffer ()
5.228+ "Return a buffer in lisp-mode usable for fontifying lisp expressions."
5.229+ (let ((buffer-name " *slime-company-fontify*"))
5.230+ (or (get-buffer buffer-name)
5.231+ (with-current-buffer (get-buffer-create buffer-name)
5.232+ (unless (derived-mode-p 'lisp-mode)
5.233+ ;; Advice from slime: Just calling (lisp-mode) will turn slime-mode
5.234+ ;; on in that buffer, which may interfere with the calling function
5.235+ (setq major-mode 'lisp-mode)
5.236+ (lisp-mode-variables t))
5.237+ (current-buffer)))))
5.238+
5.239+(defun slime-company--fontify-lisp (string)
5.240+ "Fontify STRING as `font-lock-mode' does in Lisp mode."
5.241+ ;; copied functionality from slime, trimmed somewhat
5.242+ (with-current-buffer (slime-company--fontify-lisp-buffer)
5.243+ (erase-buffer)
5.244+ (insert (funcall slime-company-transform-arglist string))
5.245+ (let ((font-lock-verbose nil))
5.246+ (font-lock-fontify-region (point-min) (point-max)))
5.247+ (goto-char (point-min))
5.248+ (buffer-substring (point-min) (point-max))))
5.249+
5.250+(defun slime-company--format (doc)
5.251+ (let ((doc (slime-company--fontify-lisp doc)))
5.252+ (cond ((eq eldoc-echo-area-use-multiline-p t) doc)
5.253+ (t (slime-oneliner (replace-regexp-in-string "[ \n\t]+" " " doc))))))
5.254+
5.255+(defun slime-company--arglist (arg)
5.256+ (let ((arglist (slime-eval
5.257+ `(swank:operator-arglist ,arg ,(slime-current-package)))))
5.258+ (when arglist
5.259+ (slime-company--format arglist))))
5.260+
5.261+(defun slime-company--arglist-only (arg)
5.262+ (let ((arglist (slime-eval
5.263+ `(swank:operator-arglist ,arg ,(slime-current-package)))))
5.264+ (when arglist
5.265+ (replace-regexp-in-string
5.266+ (concat "(" (funcall slime-company-transform-arglist arg) " ")
5.267+ " (" (funcall slime-company-transform-arglist arglist) t t))))
5.268+
5.269+(defun slime-company--echo-arglist (arg)
5.270+ (slime-eval-async `(swank:operator-arglist ,arg ,(slime-current-package))
5.271+ (lambda (arglist)
5.272+ (when arglist
5.273+ (slime-message "%s" (slime-company--format arglist))))))
5.274+
5.275+(defun slime-company--package-name (pkg)
5.276+ "Convert a string into into a uninterned symbol name, if it looks
5.277+like a package name, i.e. if it has a trailing colon.
5.278+Returns NIL if the string does not look like a package name."
5.279+ (when (string-suffix-p ":" pkg)
5.280+ (format "#:%s" (string-remove-suffix ":" (string-remove-suffix ":" pkg)))))
5.281+
5.282+(defun slime-company--build-describe-request (candidate &optional verbose)
5.283+ (let ((pkg-name (slime-company--package-name candidate)))
5.284+ (cond (pkg-name
5.285+ `(swank::describe-to-string
5.286+ (cl:find-package
5.287+ (cl:symbol-name (cl:read-from-string ,pkg-name)))))
5.288+ (verbose
5.289+ `(swank:describe-symbol ,candidate))
5.290+ (t
5.291+ `(swank:documentation-symbol ,candidate)))))
5.292+
5.293+(defun slime-company--fontify-doc-buffer (&optional doc)
5.294+ "Return a buffer in `slime-compary-doc-mode' usable for fontifying documentation."
5.295+ (with-current-buffer (company-doc-buffer)
5.296+ (slime-company-doc-mode)
5.297+ (setq buffer-read-only nil)
5.298+ (when doc
5.299+ (insert doc))
5.300+ (goto-char (point-min))
5.301+ (current-buffer)))
5.302+
5.303+(defun slime-company--doc-buffer (candidate)
5.304+ "Show the Lisp symbol documentation for CANDIDATE in a buffer.
5.305+Shows more type info than `slime-company--quickhelp-string'."
5.306+ (let* ((slime-current-thread :repl-thread))
5.307+ (slime-company--fontify-doc-buffer
5.308+ (slime-eval (slime-company--build-describe-request candidate t)
5.309+ (slime-current-package)))))
5.310+
5.311+(defun slime-company--quickhelp-string (candidate)
5.312+ "Retrieve the Lisp symbol documentation for CANDIDATE.
5.313+This function does not fontify and displays the result of SWANK's
5.314+`documentation-symbol' function, instead of the more verbose `describe-symbol'."
5.315+ (let ((slime-current-thread :repl-thread))
5.316+ (slime-eval (slime-company--build-describe-request candidate)
5.317+ (slime-current-package))))
5.318+
5.319+(defun slime-company--location (candidate)
5.320+ (let ((source-buffer (current-buffer)))
5.321+ (save-window-excursion
5.322+ (slime-edit-definition candidate)
5.323+ (let ((buffer (if (eq source-buffer (current-buffer))
5.324+ slime-xref-last-buffer
5.325+ (current-buffer))))
5.326+ (when (buffer-live-p buffer)
5.327+ (cons buffer (with-current-buffer buffer
5.328+ (point))))))))
5.329+
5.330+(defun slime-company--post-completion (candidate)
5.331+ (slime-company--echo-arglist candidate)
5.332+ (when (functionp slime-company-after-completion)
5.333+ (funcall slime-company-after-completion candidate)))
5.334+
5.335+(defun slime-company--in-string-or-comment ()
5.336+ "Return non-nil if point is within a string or comment.
5.337+In the REPL we disregard anything not in the current input area."
5.338+ (save-restriction
5.339+ (when (derived-mode-p 'slime-repl-mode)
5.340+ (narrow-to-region slime-repl-input-start-mark (point)))
5.341+ (let* ((sp (syntax-ppss))
5.342+ (beg (nth 8 sp)))
5.343+ (when (or (eq (char-after beg) ?\")
5.344+ (nth 4 sp))
5.345+ beg))))
5.346+
5.347+;;; ----------------------------------------------------------------------------
5.348+;;; * Company backend function
5.349+
5.350+(defvar *slime-company--meta-request* nil
5.351+ "Workaround lock for company-quickhelp, which invokes 'quickhelp-string' or
5.352+doc-buffer' while a 'meta' request is running, causing SLIME to cancel requests.")
5.353+
5.354+(defun company-slime (command &optional arg &rest ignored)
5.355+ "Company mode backend for slime."
5.356+ (let ((candidate (and arg (substring-no-properties arg))))
5.357+ (cl-case command
5.358+ (init
5.359+ (slime-company-active-p))
5.360+ (prefix
5.361+ (when (and (slime-company-active-p)
5.362+ (slime-connected-p)
5.363+ (or slime-company-complete-in-comments-and-strings
5.364+ (null (slime-company--in-string-or-comment))))
5.365+ (company-grab-symbol)))
5.366+ (candidates
5.367+ (slime-company--fetch-candidates-async candidate))
5.368+ (meta
5.369+ (let ((*slime-company--meta-request* t))
5.370+ (slime-company--arglist candidate)))
5.371+ (annotation
5.372+ (concat (when slime-company-display-arglist
5.373+ (slime-company--arglist-only candidate))
5.374+ (when slime-company-display-flags
5.375+ (concat " " (get-text-property 0 'flags arg)))))
5.376+ (doc-buffer
5.377+ (unless *slime-company--meta-request*
5.378+ (slime-company--doc-buffer candidate)))
5.379+ (quickhelp-string
5.380+ (unless *slime-company--meta-request*
5.381+ (slime-company--quickhelp-string candidate)))
5.382+ (location
5.383+ (slime-company--location candidate))
5.384+ (post-completion
5.385+ (slime-company--post-completion candidate))
5.386+ (sorted
5.387+ (eq slime-company-completion 'fuzzy)))))
5.388+
5.389+(provide 'slime-company)
5.390+
5.391+;;; slime-company.el ends here
