From 58b6608cbb91c142d7e9fe6946651dd18fa4d9a0 Mon Sep 17 00:00:00 2001
From: Alexander Rosenberg <zanderpkg@pm.me>
Date: Sat, 8 Feb 2025 04:30:49 -0800
Subject: [PATCH] Fontify the sly mrepl

---
 init.el | 60 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 59 insertions(+), 1 deletion(-)

diff --git a/init.el b/init.el
index bb284bd..b2503be 100644
--- a/init.el
+++ b/init.el
@@ -2018,7 +2018,65 @@ line in the block and manually deal with indentation."
   (defun my/-hyperspec-loopup-in-eww (oldfun &rest r)
     (let ((browse-url-browser-function #'eww-browse-url))
       (apply oldfun r)))
-  (advice-add 'hyperspec-lookup :around #'my/-hyperspec-loopup-in-eww))
+  (advice-add 'hyperspec-lookup :around #'my/-hyperspec-loopup-in-eww)
+
+  (defvar-local my/-sly-fontification-buffer nil
+    "The fontification buffer for the current sly buffer.")
+  (defun my/-sly-get-fontification-buffer ()
+    "Return the sly fontification buffer."
+    (if (buffer-live-p my/-sly-fontification-buffer)
+        my/-sly-fontification-buffer
+      (let ((buffer (generate-new-buffer
+                     (format " %s-fontification-buffer" (buffer-name)))))
+        (with-current-buffer buffer
+          (unless (derived-mode-p 'c++-mode)
+            (let ((delayed-mode-hooks nil))
+              (delay-mode-hooks
+                (lisp-mode))))
+          (let ((inhibit-message t))
+            (indent-tabs-mode -1))
+          (unless font-lock-mode
+            (font-lock-mode 1)))
+        (setq-local my/-sly-fontification-buffer buffer))))
+  (defmacro my/-sly-with-font-lock-buffer (&rest body)
+    "Execute BODY in the sly indirect buffer.
+Note that this erases the buffer before doing anything."
+    `(with-current-buffer (my/-sly-get-fontification-buffer)
+       (erase-buffer)
+       ,@body))
+  (defun my/-sly-fontify-current-input ()
+    "Function called from `post-command-hook' to fontify the current input."
+    (when-let ((proc (get-buffer-process (current-buffer)))
+               (start (process-mark proc))
+               (end (point-max))
+               (input (buffer-substring-no-properties start end))
+               (fontified (my/-sly-with-font-lock-buffer
+                           (insert input)
+                           (font-lock-ensure)
+                           (buffer-string)))
+               (len (length fontified))
+               (i 0))
+      ;; mostly from:
+      ;; `python-shell-font-lock-post-command-hook'
+      (while (not (= i len))
+        (let* ((props (text-properties-at i fontified))
+               (change-i (or (next-property-change i fontified)
+                             len)))
+          (when-let ((face (plist-get props 'face)))
+            (setf (plist-get props 'face) nil
+                  (plist-get props 'font-lock-face) face))
+          (set-text-properties (+ start i) (+ start change-i) props)
+          (setq i change-i)))))
+  (defun my/-sly-cleanup-fontification-buffer ()
+    (when (buffer-live-p my/-sly-fontification-buffer)
+      (kill-buffer my/-sly-fontification-buffer)))
+  (defun my/-sly-mrepl-enable-fontification ()
+    (setq-local comint-highlight-input nil)
+    (add-hook 'post-command-hook #'my/-sly-fontify-current-input
+              nil t)
+    (add-hook 'kill-buffer-hook #'my/-sly-cleanup-fontification-buffer
+              nil t))
+  (add-hook 'sly-mrepl-mode-hook #'my/-sly-mrepl-enable-fontification))
 
 ;; jupyter
 (use-package jupyter