From fea961c9782a32698f3f2d1074e81429c8bfec87 Mon Sep 17 00:00:00 2001
From: Pierre Neidhardt <mail@ambrevar.xyz>
Date: Thu, 14 Jan 2021 16:59:01 +0100
Subject: [PATCH] SLY: Colorize prompt and display entry index.

---
 .emacs.d/lisp/init-sly.el | 30 +++++++++++++++++++++++++++---
 1 file changed, 27 insertions(+), 3 deletions(-)

diff --git a/.emacs.d/lisp/init-sly.el b/.emacs.d/lisp/init-sly.el
index e55c4ee8..85915780 100644
--- a/.emacs.d/lisp/init-sly.el
+++ b/.emacs.d/lisp/init-sly.el
@@ -199,7 +199,7 @@ returns a string."
       (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))
         (new-prompt (format "%s%s\n%s"
                             (ambrevar/sly-status)
@@ -209,6 +209,32 @@ returns a string."
         (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 (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 ()
   "Go to the beginning of the previous REPL prompt."
   (interactive)
@@ -237,8 +263,6 @@ returns a string."
                                                      '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)