2020-12-18 17:46:46 +01:00
|
|
|
(require 'patch-sly)
|
|
|
|
|
2020-12-18 21:13:24 +01:00
|
|
|
(cl-defun ambrevar/guix-environment (&key root
|
|
|
|
(pure? t)
|
|
|
|
(preserve-args '())
|
|
|
|
load
|
|
|
|
(packages '())
|
|
|
|
(ad-hoc-args '())
|
|
|
|
(command-args '()))
|
|
|
|
(apply #'call-process "guix" nil nil nil
|
|
|
|
`("environment"
|
|
|
|
,(when pure?
|
|
|
|
"--pure")
|
|
|
|
,@(when preserve-args
|
|
|
|
(mapcar (lambda (s) (format "--preserve=^%s$" s))
|
|
|
|
preserve-args))
|
|
|
|
,(when root
|
|
|
|
(concat "--root=" root))
|
|
|
|
,(when load
|
|
|
|
(concat "--load=" load))
|
|
|
|
,@packages
|
|
|
|
,@(when ad-hoc-args
|
|
|
|
(cons "--ad-hoc" ad-hoc-args))
|
|
|
|
,@(when command-args
|
|
|
|
(cons "--" command-args)))))
|
|
|
|
|
|
|
|
(cl-defun ambrevar/lisp-implementation-from-guix-environment (&rest args
|
|
|
|
&key (load (error "Must provide file to load."))
|
|
|
|
ad-hoc-args
|
|
|
|
command-args
|
|
|
|
&allow-other-keys)
|
2020-12-18 21:26:01 +01:00
|
|
|
"Like `ambrevar/guix-environment' but cache profile to speed up switch.
|
|
|
|
`lisp-repl-core-dumper' is used to speed up SBCL startup."
|
2020-12-18 21:13:24 +01:00
|
|
|
(let* ((load-mtime (when load
|
|
|
|
(file-attribute-modification-time (file-attributes load))))
|
|
|
|
(root (or (cl-getf args :root)
|
|
|
|
(concat (expand-file-name "~/.guix-temp-profiles/")
|
|
|
|
(file-name-sans-extension load))))
|
|
|
|
(root-mtime (file-attribute-modification-time (file-attributes root)))
|
|
|
|
(cache (concat (expand-file-name "~/.cache/lisp-repl-core-")
|
|
|
|
(file-name-base root))))
|
|
|
|
(unless (and (file-exists-p root)
|
|
|
|
(or (not load-mtime)
|
|
|
|
(time-less-p load-mtime root-mtime)))
|
|
|
|
(cl-remf args :ad-hoc-args)
|
|
|
|
(cl-pushnew "lisp-repl-core-dumper" ad-hoc-args)
|
|
|
|
(cl-pushnew "coreutils" ad-hoc-args)
|
|
|
|
(setf command-args (append (list "env" (concat "LISP_REPL_CORE_PATH=" cache))
|
|
|
|
command-args))
|
|
|
|
(make-directory (file-name-directory root) :parents)
|
|
|
|
(apply #'ambrevar/guix-environment (append (list :root root)
|
|
|
|
(list :ad-hoc-args ad-hoc-args)
|
|
|
|
(list :command-args command-args)
|
|
|
|
args)))
|
2020-12-18 21:26:01 +01:00
|
|
|
`((,@(unless (not (eq nil (cl-getf args :pure?)))
|
|
|
|
'("env" "-i"))
|
|
|
|
,(executable-find "bash") "--norc" "--noprofile" "-c"
|
|
|
|
,(concat
|
|
|
|
(format "source '%s/etc/profile'" root)
|
|
|
|
" && LISP_REPL_CORE_PATH=" cache
|
|
|
|
" lisp-repl-core-dumper sbcl")))))
|
2020-12-18 21:13:24 +01:00
|
|
|
|
2020-12-18 17:46:46 +01:00
|
|
|
(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"))
|
2020-12-18 21:26:01 +01:00
|
|
|
(sbcl-nyxt ;; Faster, but not pure. TODO: Run it in a container?
|
2020-12-18 18:55:20 +01:00
|
|
|
;; TODO: Add easy way to reload: must delete profile. No need to delete dump if we use -f.
|
2020-12-18 17:46:46 +01:00
|
|
|
(lambda ()
|
2020-12-18 21:17:43 +01:00
|
|
|
(cl-flet ((ambrevar/prepare-sbcl-for-nyxt
|
|
|
|
()
|
|
|
|
(let ((file (make-temp-file "sbcl")))
|
|
|
|
(with-temp-file file
|
|
|
|
(insert
|
|
|
|
(format "%S"
|
|
|
|
'(mapc #'asdf:load-system
|
|
|
|
(delete-if (lambda (s)
|
|
|
|
(string= "nyxt" (subseq s 0 (min (length s) 4))))
|
|
|
|
(append
|
|
|
|
(asdf:system-depends-on (asdf:find-system :nyxt))
|
|
|
|
(asdf:system-depends-on (asdf:find-system :nyxt/gtk))))))))
|
|
|
|
file)))
|
|
|
|
(let ((root (expand-file-name "~/.guix-temp-profiles/nyxt"))
|
|
|
|
(setup-file (ambrevar/prepare-sbcl-for-nyxt)))
|
|
|
|
(prog1
|
|
|
|
(ambrevar/lisp-implementation-from-guix-environment
|
|
|
|
:root root
|
|
|
|
:load "~/common-lisp/nyxt/build-scripts/guix.scm"
|
|
|
|
:preserve-args '("PERSONAL")
|
|
|
|
:ad-hoc-args '("glib" "glib-networking" "gsettings-desktop-schemas"
|
|
|
|
;; "nss-certs" ; Only needed in containers.
|
|
|
|
;; "libfixposix" ; TODO: We should not need this. Delete if there is no issue after a while (Jan 2021?).
|
|
|
|
;; For user .gpg decryption:
|
|
|
|
"gnupg")
|
|
|
|
:command-args `("lisp-repl-core-dumper" "-f" "-g" ,(format "--load %s" setup-file) "sbcl"))
|
|
|
|
(let ((delete-by-moving-to-trash nil))
|
|
|
|
(delete-file setup-file)))))))
|
2020-12-18 19:12:38 +01:00
|
|
|
;; Simple REPL environment (no container):
|
|
|
|
(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"))
|
2020-12-18 17:46:46 +01:00
|
|
|
(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)
|
|
|
|
|
2020-12-18 17:54:48 +01:00
|
|
|
(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)
|
|
|
|
(global-helm-sly-mode)
|
|
|
|
(add-to-list 'helm-source-names-using-follow "Lisp xrefs"))
|
2020-12-18 17:46:46 +01:00
|
|
|
|
|
|
|
(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)
|