SLY: Colorize prompt and display entry index.

master
Pierre Neidhardt 2021-01-14 16:59:01 +01:00
parent 071a0c453c
commit fea961c978
1 changed files with 27 additions and 3 deletions

View File

@ -199,7 +199,7 @@ returns a string."
(advice-add 'sly-mrepl--send-input-sexp :after #'ambrevar/sly-status--record) (advice-add 'sly-mrepl--send-input-sexp :after #'ambrevar/sly-status--record)
""))) "")))
(defun ambrevar/sly-prepare-prompt (old-func &rest args) (defun ambrevar/sly-prepare-prompt (old-func &rest args) ; TODO: Remove when upstream have merged `sly-mrepl-prompt-formatter'.
(let ((package (nth 0 args)) (let ((package (nth 0 args))
(new-prompt (format "%s%s\n%s" (new-prompt (format "%s%s\n%s"
(ambrevar/sly-status) (ambrevar/sly-status)
@ -209,6 +209,32 @@ returns a string."
(condition (nth 3 args))) (condition (nth 3 args)))
(funcall old-func package new-prompt error-level condition))) (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 (format "%s:" entry-idx) 'font-lock-face 'sly-part-button-face)
(propertize package-nickname 'font-lock-face 'sly-mrepl-prompt-face)
(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-mrepl-previous-prompt () (defun ambrevar/sly-mrepl-previous-prompt ()
"Go to the beginning of the previous REPL prompt." "Go to the beginning of the previous REPL prompt."
(interactive) (interactive)
@ -237,8 +263,6 @@ returns a string."
'sly-mrepl--prompt)) 'sly-mrepl--prompt))
(point)))) (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-next-prompt :override #'ambrevar/sly-mrepl-next-prompt)
(advice-add 'sly-mrepl-previous-prompt :override #'ambrevar/sly-mrepl-previous-prompt) (advice-add 'sly-mrepl-previous-prompt :override #'ambrevar/sly-mrepl-previous-prompt)