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

288 lines
13 KiB
EmacsLisp

;;; Lisp
(require 'init-lispy)
(add-hook 'lisp-mode-hook 'ambrevar/turn-on-complete-filename)
(add-hook 'lisp-mode-hook 'ambrevar/turn-on-tab-width-to-8) ; Because some existing code uses tabs.
(add-hook 'lisp-mode-hook 'ambrevar/turn-off-indent-tabs) ; Should not use tabs.
(add-hook 'lisp-mode-hook 'ambrevar/init-lispy)
(when (fboundp 'rainbow-delimiters-mode)
(add-hook 'lisp-mode-hook #'rainbow-delimiters-mode))
;; Read CLHS locally.
(or
;; Quicklisp package.
(load "~/.quicklisp/clhs-use-local.el" 'noerror)
;; Unofficial Guix package (non-free license).
(when (require 'clhs nil 'noerror)
(clhs-setup)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Sly
;; TODO: Report upstream.
;; https://github.com/joaotavora/sly/issues/363
;; REVIEW: This probably works for SLIME too.
(defvar ambrevar/sly-sbcl-core-extra-packages '(:ambrevar))
(defun ambrevar/sly-dump-sbcl-core (&rest extra-package-keywords)
"Dump an SBCL core optimized for SLY.
EXTRA-PACKAGE-KEYWORDS can be included in the core.
The core is stored in `user-emacs-directory'/sly.
Return path to the generated core, or nil if it failed to generate.
If the core already exists, it's only regenerated if the SBCL version has
changed, of when called interactively."
(interactive ambrevar/sly-sbcl-core-extra-packages)
(cl-flet ((read-bytes (path)
(with-temp-buffer
(insert-file-contents-literally path)
(buffer-substring-no-properties (point-min) (point-max))))
(call-process-to-string (command &rest args)
(with-temp-buffer
(apply #'call-process command nil t nil args)
(buffer-string))))
(let* ((sbcl-core-dir (expand-file-name "sly/" user-emacs-directory))
(sbcl-core (expand-file-name "sbcl.core-for-sly" sbcl-core-dir))
(sbcl-core-version (expand-file-name "sbcl.version" sbcl-core-dir))
(current-sbcl-version (cadr (split-string
(call-process-to-string "sbcl" "--version"))))
(lisp-output-buffer (get-buffer-create " *Lisp dump log*")))
(when (or (called-interactively-p 'any)
(not (file-exists-p sbcl-core-version))
(not (version= (car (split-string (read-bytes sbcl-core-version)))
current-sbcl-version)))
(make-directory sbcl-core-dir :parents)
(with-current-buffer lisp-output-buffer
(erase-buffer))
(apply #'call-process
"sbcl" nil (list lisp-output-buffer t) nil
"--eval" "(mapc 'require '(sb-bsd-sockets sb-posix sb-introspect sb-cltl2 asdf))"
(append
(mapcan (lambda (package-keyword)
(list "--eval" (format "(require %S)" package-keyword)))
extra-package-keywords)
(list
"--eval" (format "(save-lisp-and-die %S)" sbcl-core)))))
(if (not (file-exists-p sbcl-core))
(switch-to-buffer-other-window lisp-output-buffer)
(with-temp-file sbcl-core-version
(insert current-sbcl-version))
sbcl-core))))
(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))))
(with-eval-after-load 'sly
(require 'patch-sly)
(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)
(when (executable-find "lisp-repl-core-dumper")
(setq sly-lisp-implementations
`((sbcl ("lisp-repl-core-dumper" "sbcl" "ambrevar"))
;; 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")
"--ad-hoc" "gnupg" "--" "sbcl"))
(sbcl-nyxt-site ("guix" "environment" "--pure"
"-m" ,(expand-file-name "~/common-lisp/nyxt-site/guix-manifest.scm")
"--" "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")))
(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" "gnupg" "lisp-repl-core-dumper"
"--" "lisp-repl-core-dumper" "sbcl"))
`(("bash" "-c" ,(concat
(format "source '%s/etc/profile'" root)
" && "
;; TODO:
"lisp-repl-core-dumper 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-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))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; SLIME
(defun ambrevar/slime-rainbow-init ()
(font-lock-mode -1)
(rainbow-delimiters-mode)
(font-lock-mode))
(with-eval-after-load 'slime
;; REVIEW: Fix issue https://github.com/slime/slime/issues/523:
;; Remove with SLIME 2.25.
(setq slime-defpackage-regexp
"^(\\(cl:\\|common-lisp:\\|uiop:\\)?\\(defpackage\\|define-package\\)\\>[ \t']*")
(setq slime-lisp-implementations
'((sbcl ("sbcl" "--noinform"))
(ccl ("ccl"))
(ecl ("ecl"))))
(let ((slime-extra '(slime-fancy
;; slime-banner
slime-mrepl
slime-xref-browser
;; slime-highlight-edits ; A bit slow...
slime-sprof
slime-quicklisp
slime-asdf
slime-indentation)))
;; TODO: Fix slime-repl-ansi-color.
;; (when (require 'slime-repl-ansi-color nil t)
;; (add-to-list 'slime-extra 'slime-repl-ansi-color)
;; (setq slime-repl-ansi-color t))
;; slime-company should not be `require'd, see
;; https://github.com/anwyn/slime-company/issues/11.
(when (ignore-errors (find-library-name "slime-company"))
(add-to-list 'slime-extra 'slime-company))
(define-key slime-editing-map (kbd "C-c C-d C-h") 'slime-documentation-lookup)
(slime-setup slime-extra)
(add-hook 'slime-repl-mode-hook 'ambrevar/init-lispy)
(add-hook 'slime-repl-mode-hook #'ambrevar/slime-rainbow-init)))
(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"))
(when (require 'helm-slime nil 'noerror)
(global-helm-slime-mode)
(add-to-list 'helm-source-names-using-follow "SLIME xrefs")))
(provide 'init-lisp)