325 lines
14 KiB
EmacsLisp
325 lines
14 KiB
EmacsLisp
(require 'patch-sly)
|
|
|
|
(defun pure-env (&rest preserve-vars)
|
|
"Return a pure `env' command as a list of string."
|
|
(append '("env" "-i")
|
|
(mapcar (lambda (var) (concat var "=" (getenv var)))
|
|
(append
|
|
'("DISPLAY"
|
|
"HOME"
|
|
"LOGNAME"
|
|
"TERM"
|
|
"USER")
|
|
preserve-vars))))
|
|
|
|
(defun ambrevar/delete-lisp-image-dump ()
|
|
"Delete SLY current connection image dump.
|
|
This dump is expected to be generated by `lisp-repl-core-dumper'."
|
|
(interactive)
|
|
(let* ((pid (process-id (sly-inferior-process (sly-current-connection))))
|
|
(args (alist-get 'args (process-attributes pid)))
|
|
(command (car (split-string (alist-get 'args (process-attributes pid))))))
|
|
(if (and (string= "image"
|
|
(file-name-extension command))
|
|
(string= (file-name-directory command)
|
|
(expand-file-name "~/.cache/lisp-repl-core-directory/")))
|
|
(when (yes-or-no-p (format "Delete %s?" command))
|
|
(let ((delete-by-moving-to-trash nil))
|
|
(delete-file command)
|
|
(message "%S deleted." command)))
|
|
(message "%S is not a Lisp image dump." command))))
|
|
|
|
(defun ambrevar/sbcl-for-nyxt (&optional refresh) ;; TODO: Run it in a container?
|
|
"Fast, pure Guix environment for Nyxt development.
|
|
If REFRESH is non-nil, rebuild the environment."
|
|
(cl-flet ((mtime (file)
|
|
(when (file-exists-p file)
|
|
(file-attribute-modification-time (file-attributes file)))))
|
|
(let* ((root (expand-file-name "~/.guix-temp-profiles/nyxt/nyxt"))
|
|
(guix-def (expand-file-name "~/common-lisp/nyxt/build-scripts/guix.scm"))
|
|
(guix-sbcl-def (expand-file-name "~/common-lisp/nyxt/build-scripts/guix-sbcl-for-nyxt.scm"))
|
|
(guix-checkout (format "/var/guix/profiles/per-user/%s/current-guix" (user-login-name))))
|
|
(when (or refresh
|
|
(not (file-exists-p root))
|
|
(time-less-p (mtime root) (mtime guix-def))
|
|
(time-less-p (mtime root) (mtime guix-sbcl-def))
|
|
(time-less-p (mtime root) (mtime guix-checkout)))
|
|
(make-directory (file-name-directory root) :parents)
|
|
(call-process "guix" nil nil nil "package"
|
|
;; May be needed to avoid having to rebuild some packages
|
|
;; after the REPL has started.
|
|
"--no-grafts"
|
|
(concat "--profile=" root)
|
|
(concat "--install-from-file=" guix-sbcl-def))
|
|
;; Update root mtime in case it's not changed.
|
|
;; Can't use `set-file-times' on links.
|
|
(call-process "touch" nil nil nil "-h" root))
|
|
`((,@(pure-env "PERSONAL")
|
|
,(executable-find "bash") "--norc" "--noprofile" "-c"
|
|
,(concat (format "source '%s/etc/profile'" root)
|
|
" && sbcl"))))))
|
|
|
|
;; Warning: ,restart-lisp does not take changes into account, the buffer must be re-created.
|
|
(setq sly-lisp-implementations
|
|
(let ((maybe-core-dumper (when-let ((exec (executable-find "lisp-repl-core-dumper")))
|
|
(list exec))))
|
|
`((sbcl-ambrevar ("lisp-repl-core-dumper" "-p" "ambrevar" "sbcl"
|
|
"--eval" "(in-package :ambrevar/all)"
|
|
"--eval" "(named-readtables:in-readtable ambrevar/all:syntax)"))
|
|
(sbcl (,@maybe-core-dumper "sbcl"))
|
|
(sbcl-failsafe ("sbcl"))
|
|
(sbcl-nyxt (lambda () (ambrevar/sbcl-for-nyxt)))
|
|
(sbcl-nyxt-refresh (lambda () (ambrevar/sbcl-for-nyxt :refresh)))
|
|
;; Simple REPL environment for Nyxt, in case sbcl-nyxt does not work.
|
|
(sbcl-nyxt-failsafe ("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"))
|
|
(sbcl-nyxt-site ("guix" "environment" "--pure"
|
|
"-m" ,(expand-file-name "~/common-lisp/nyxt-site/guix-manifest.scm")
|
|
"--" "sbcl"))
|
|
(ccl (,@maybe-core-dumper "ccl"))
|
|
(clisp (,@maybe-core-dumper "clisp"))
|
|
(ecl ("ecl")))))
|
|
|
|
(setq sly-connection-update-interval 0.1)
|
|
|
|
(when (require 'helm nil :noerror)
|
|
(with-eval-after-load 'sly-mrepl
|
|
(define-key sly-mrepl-mode-map (kbd "M-p") 'helm-comint-input-ring)
|
|
(define-key sly-mrepl-mode-map (kbd "M-s f") 'helm-comint-prompts-all)
|
|
(define-key sly-autodoc-mode-map (kbd "C-c C-d C-a") 'helm-sly-apropos)
|
|
(define-key sly-mrepl-mode-map (kbd "C-c C-x c") 'helm-sly-list-connections)))
|
|
|
|
(when (require 'helm-sly nil :noerror)
|
|
(when (require 'evil-collection nil :noerror)
|
|
(evil-define-key '(normal insert) helm-sly-connections-map
|
|
(kbd "S-<return>") 'helm-sly-run-go-to-repl-other-window))
|
|
(defun ambrevar/helm-sly-format-connection (connection buffer)
|
|
(let ((fstring "%s%2s %s"))
|
|
(format fstring
|
|
(if (eq sly-default-connection connection)
|
|
"*"
|
|
" ")
|
|
(helm-sly-connection-number connection)
|
|
(replace-regexp-in-string
|
|
"*$" ""
|
|
(replace-regexp-in-string
|
|
"*sly-mrepl for " ""
|
|
(replace-regexp-in-string "*sly-inferior-lisp for " ""
|
|
(buffer-name buffer)))))))
|
|
(setq helm-sly-connection-formatter #'ambrevar/helm-sly-format-connection)
|
|
(global-helm-sly-mode)
|
|
(add-to-list 'helm-source-names-using-follow "Lisp xrefs"))
|
|
|
|
(defun ambrevar/sly-insert-double-quotes ()
|
|
"Convenient to write list of string, e.g. when writing a shell command line."
|
|
(interactive)
|
|
(while (sly-inside-string-p)
|
|
(forward-char))
|
|
(cycle-spacing)
|
|
(insert "\"\"")
|
|
(backward-char)
|
|
(when (and (boundp 'evil-state)
|
|
(not (eq evil-state 'insert)))
|
|
(call-interactively #'evil-insert)))
|
|
|
|
(defun ambrevar/sly-insert-pipe ()
|
|
"Convenient to write a `:-' pipe."
|
|
(interactive)
|
|
(while (sly-inside-string-p)
|
|
(forward-char))
|
|
(newline-and-indent)
|
|
(insert ":-")
|
|
(ambrevar/sly-insert-double-quotes))
|
|
|
|
(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)
|
|
(define-key sly-mrepl-mode-map (kbd "S-SPC") 'ambrevar/sly-insert-double-quotes)
|
|
(define-key sly-mrepl-mode-map (kbd "C-S-SPC") 'ambrevar/sly-insert-pipe))
|
|
|
|
(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: https://github.com/joaotavora/sly/issues/404
|
|
(defun ambrevar/do-not-append-space-after-file-completion ()
|
|
"This setting is buffer local."
|
|
(set (make-local-variable 'comint-completion-addsuffix) '("/" . "")))
|
|
(add-hook 'sly-mrepl-hook #'ambrevar/do-not-append-space-after-file-completion)
|
|
|
|
;; 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)))
|
|
|
|
(when (require 'helm-selector nil :noerror)
|
|
(require 'init-sly-selector))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; 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) ; TODO: Remove when upstream have merged `sly-mrepl-prompt-formatter'.
|
|
(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)))
|
|
|
|
(cl-defun ambrevar/sly-new-prompt (_package
|
|
package-nickname
|
|
&key
|
|
entry-idx
|
|
error-level
|
|
&allow-other-keys)
|
|
(concat
|
|
(propertize (ambrevar/sly-status) 'font-lock-face 'font-lock-comment-face)
|
|
"("
|
|
(propertize (abbreviate-file-name default-directory) 'font-lock-face 'diff-added)
|
|
")\n"
|
|
(propertize "<" 'font-lock-face 'sly-mrepl-prompt-face)
|
|
(propertize (number-to-string entry-idx) 'font-lock-face 'sly-mode-line)
|
|
(propertize ":" 'font-lock-face 'sly-mrepl-prompt-face)
|
|
(propertize package-nickname 'font-lock-face 'sly-mode-line)
|
|
(when (cl-plusp error-level)
|
|
(concat (sly-make-action-button
|
|
(format "[%d]" error-level)
|
|
#'sly-db-pop-to-debugger-maybe)
|
|
" "))
|
|
(propertize "> " 'font-lock-face 'sly-mrepl-prompt-face)))
|
|
|
|
(with-eval-after-load 'sly-mrepl
|
|
(if (boundp 'sly-mrepl-prompt-formatter)
|
|
(setq sly-mrepl-prompt-formatter
|
|
#'ambrevar/sly-new-prompt)
|
|
(advice-add 'sly-mrepl--insert-prompt :around #'ambrevar/sly-prepare-prompt)))
|
|
|
|
(defun ambrevar/sly-end-of-prompt-p ()
|
|
(and (not (= (point) (point-min)))
|
|
(not (get-text-property (point) 'sly-mrepl--prompt))
|
|
(get-text-property (1- (point)) 'sly-mrepl--prompt)))
|
|
|
|
(defun ambrevar/sly-prompt-line-p ()
|
|
(or (ambrevar/sly-end-of-prompt-p)
|
|
(save-excursion
|
|
(goto-char (line-beginning-position))
|
|
(ambrevar/sly-end-of-prompt-p))))
|
|
|
|
(defun ambrevar/sly-mrepl-previous-prompt ()
|
|
"Go to the beginning of the previous REPL prompt."
|
|
(interactive)
|
|
(cl-flet ((go-back ()
|
|
(goto-char
|
|
(previous-single-char-property-change
|
|
(point) 'sly-mrepl--prompt))))
|
|
(if (ambrevar/sly-prompt-line-p)
|
|
(progn
|
|
(unless (ambrevar/sly-end-of-prompt-p)
|
|
(goto-char (line-beginning-position)))
|
|
(go-back)
|
|
(go-back))
|
|
(go-back))
|
|
(unless (ambrevar/sly-prompt-line-p)
|
|
;; We did not end up on a prompt, means we are above the first prompt.
|
|
;; Return back.
|
|
(ambrevar/sly-mrepl-next-prompt))))
|
|
|
|
(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-next-prompt :override #'ambrevar/sly-mrepl-next-prompt)
|
|
(advice-add 'sly-mrepl-previous-prompt :override #'ambrevar/sly-mrepl-previous-prompt)
|
|
|
|
(require 'init-sly-narrow)
|
|
|
|
(provide 'init-sly)
|