ambevar-dotfiles/.emacs.d/lisp/init-sly.el

189 lines
8.7 KiB
EmacsLisp
Raw Normal View History

(require 'patch-sly)
(when (executable-find "lisp-repl-core-dumper")
;; Warning: ,restart-lisp does not take changes into account, the buffer must be re-created.
(setq sly-lisp-implementations
`((sbcl-ambrevar ("lisp-repl-core-dumper" "sbcl" "ambrevar"))
(sbcl ("lisp-repl-core-dumper" "sbcl"))
;; Simple REPL environment (no container):
(sbcl-nyxt ("guix" "environment" "--pure"
"--preserve=^PERSONAL$" ; To find personal config, like engines and bookmarks.
"-l" ,(expand-file-name "~/common-lisp/nyxt/build-scripts/guix.scm")
;; glib is needed to export GIO_EXTRA_MODULES.
"--ad-hoc" "glib" "glib-networking" "gsettings-desktop-schemas"
"gnupg" "--" "sbcl"))
;; Faster, but not pure. TODO: Can we purify it? Run it in a container?
(sbcl-nyxt-fast
(lambda ()
;; TODO: Replace root when source has changed?
(let ((root (expand-file-name "~/.guix-temp-profiles/nyxt"))
(cache (expand-file-name "~/.cache/lisp-repl-core-nyxt")))
(unless (file-exists-p root)
(make-directory (file-name-directory root) :parents)
(call-process "guix" nil nil nil
"environment" "--pure"
"--preserve=^PERSONAL$" ; To find personal config, like engines and bookmarks.
"-r" root
"-l" (expand-file-name "~/common-lisp/nyxt/build-scripts/guix.scm")
"--ad-hoc" "glib" "glib-networking" "gsettings-desktop-schemas"
;; "nss-certs" ; Only needed in containers.
;; "libfixposix" ; TODO: We should not need this.
"gnupg"
"coreutils"
"lisp-repl-core-dumper"
"--" "env" (concat "LISP_REPL_CORE_PATH=" cache)
"lisp-repl-core-dumper" "sbcl"))
;; TODO: Include Nyxt Lisp deps in core dump?
`(("bash" "-c" ,(concat
(format "source '%s/etc/profile'" root)
" && LISP_REPL_CORE_PATH=" cache
" lisp-repl-core-dumper sbcl"))))))
(sbcl-nyxt-site ("guix" "environment" "--pure"
"-m" ,(expand-file-name "~/common-lisp/nyxt-site/guix-manifest.scm")
"--" "sbcl"))
(ccl ("lisp-repl-core-dumper" "ccl"))
(clisp ("lisp-repl-core-dumper" "clisp"))
(ecl ("ecl")))))
(setq sly-connection-update-interval 0.1)
(with-eval-after-load 'sly
(when (require 'helm-sly nil :noerror)
(global-helm-sly-mode)
(add-to-list 'helm-source-names-using-follow "Lisp xrefs")))
(with-eval-after-load 'sly-mrepl
(set-face-attribute 'sly-mrepl-output-face nil :inherit 'default :foreground)
(setq sly-mrepl-history-file-name (expand-file-name "sly-mrepl-history" user-emacs-directory))
;; While `,i RET` is short enough, it's one more key away in Evil insert state:
(define-key sly-mrepl-mode-map (kbd "C-c M-p") 'sly-mrepl-set-package)
(define-key sly-mrepl-mode-map (kbd "C-c M-o") 'sly-mrepl-clear-repl))
(defun ambrevar/sly-load-reload-system ()
(interactive)
(funcall
(if (sly-eval `(slynk-asdf:asdf-system-loaded-p ,(intern (sly-current-package))))
#'sly-asdf-reload-system
#'sly-asdf-load-system)
(intern (sly-current-package))))
(define-key lisp-mode-map (kbd "<f6>") 'ambrevar/sly-load-reload-system)
(defun ambrevar/sly-colorize-buffer (str)
"Useful for colorized output like the tests of Prove."
(ansi-color-apply str))
(add-hook 'sly-mrepl-output-filter-functions 'ambrevar/sly-colorize-buffer)
(defun ambrevar/indent-and-helm-company (arg)
"Indent then call `helm-company'.
Good substitute for `sly-mrepl-indent-and-complete-symbol'."
(interactive "P")
(indent-for-tab-command arg)
(helm-company))
(setq sly-command-switch-to-existing-lisp 'always)
(add-hook 'sly-mrepl-hook #'ambrevar/init-lispy)
(add-hook 'sly-mrepl-hook #'rainbow-delimiters-mode)
;; REVIEW: With Emacs 27 we can:
;; (customize-set-variable 'helm-completion-style 'emacs)
;; (add-to-list 'completion-styles 'backend)
(when (require 'helm-sly nil 'noerror)
;; (add-hook 'sly-mrepl-hook #'helm-sly-disable-internal-completion)
;; REVIEW: Company completion has the benefit of having annotations.
(when (require 'helm-company nil :noerror)
(add-hook 'lisp-mode-hook #'company-mode)
(define-key lisp-mode-map (kbd "<tab>") 'ambrevar/indent-and-helm-company)
(define-key lisp-mode-map (kbd "M-<tab>") 'ambrevar/indent-and-helm-company)
(defun ambrevar/sly-set-keys ()
(define-key sly-mrepl-mode-map (kbd "<tab>") 'ambrevar/indent-and-helm-company)
(define-key sly-mrepl-mode-map (kbd "M-<tab>") 'ambrevar/indent-and-helm-company))
(add-hook 'sly-mrepl-hook #'ambrevar/sly-set-keys)
(add-hook 'sly-mrepl-hook #'company-mode)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Prompt customization
;; TODO: Upstream!
(defvar ambrevar/sly-status--last-command-time nil)
(make-variable-buffer-local 'ambrevar/sly-status--last-command-time)
(defun ambrevar/sly-status--record ()
(setq ambrevar/sly-status--last-command-time (current-time)))
(defun ambrevar/sly-status-formatter (timestamp duration)
"Return the status display for `ambrevar/sly-status'.
TIMESTAMP is the value returned by `current-time' and DURATION is the floating
time the command took to complete in seconds."
(format "#[STATUS] End time %s, duration %.3fs\n"
(format-time-string "%F %T" timestamp)
duration))
(defcustom ambrevar/sly-status-min-duration 1
"If a command takes more time than this, display its status with `ambrevar/sly-status'."
:group 'sly
:type 'number)
(defun ambrevar/sly-status (&optional formatter min-duration)
"Termination timestamp and duration of command.
Status is only returned if command duration was longer than
MIN-DURATION \(defaults to `ambrevar/sly-status-min-duration'). FORMATTER
is a function of two arguments, TIMESTAMP and DURATION, that
returns a string."
(if ambrevar/sly-status--last-command-time
(let ((duration (time-to-seconds
(time-subtract (current-time) ambrevar/sly-status--last-command-time))))
(setq ambrevar/sly-status--last-command-time nil)
(if (> duration (or min-duration
ambrevar/sly-status-min-duration))
(funcall (or formatter
#'ambrevar/sly-status-formatter)
(current-time)
duration)
""))
(progn
(advice-add 'sly-mrepl--send-input-sexp :after #'ambrevar/sly-status--record)
"")))
(defun ambrevar/sly-prepare-prompt (old-func &rest args)
(let ((package (nth 0 args))
(new-prompt (format "%s%s\n%s"
(ambrevar/sly-status)
(abbreviate-file-name default-directory)
(nth 1 args)))
(error-level (nth 2 args))
(condition (nth 3 args)))
(funcall old-func package new-prompt error-level condition)))
(defun ambrevar/sly-mrepl-previous-prompt ()
"Go to the beginning of the previous REPL prompt."
(interactive)
;; This has two wrinkles around the first prompt: (1) when going to
;; the first prompt it leaves point at column 0 (1) when called from
;; frist prompt goes to beginning of buffer. The correct fix is to
;; patch comint.el's comint-next-prompt and comint-previous-prompt
;; anyway...
(let* ((inhibit-field-text-motion t)
(pos (previous-single-char-property-change
(previous-single-char-property-change (point)
'sly-mrepl--prompt)
'sly-mrepl--prompt)))
(goto-char pos)
(goto-char (line-beginning-position)))
(end-of-line))
(defun ambrevar/sly-mrepl-next-prompt ()
"Go to the beginning of the next REPL prompt."
(interactive)
(let ((pos (next-single-char-property-change (line-beginning-position 2)
'sly-mrepl--prompt)))
(goto-char pos)
(if (get-text-property (point) 'sly-mrepl--prompt)
(goto-char (next-single-char-property-change (point)
'sly-mrepl--prompt))
(point))))
(advice-add 'sly-mrepl--insert-prompt :around #'ambrevar/sly-prepare-prompt)
(advice-add 'sly-mrepl-next-prompt :override #'ambrevar/sly-mrepl-next-prompt)
(advice-add 'sly-mrepl-previous-prompt :override #'ambrevar/sly-mrepl-previous-prompt)
(provide 'init-sly)