Opt-in REPL output classificationHEADmaster

1 files changed, 65 insertions, 13 deletions

diff --git a/elisp/geiser-repl.el b/elisp/geiser-repl.el
index b8df566..54cf6d8 100644
--- a/elisp/geiser-repl.el
+++ b/elisp/geiser-repl.el
@@ -235,12 +235,30 @@ See also `geiser-repl-startup-hook'."
   "The character that represents a closing super parentheses."
   :type 'character)
 
+(geiser-custom--defcustom geiser-repl-classify-output-p nil
+  "Whether to classify REPL output by type (success/warning/error).
+
+When enabled, REPL output will be colored differently based on
+whether it represents successful evaluation, a warning, or an error.
+This classification is based on pattern matching of the output."
+  :type 'boolean)
+
+
 (geiser-custom--defface repl-input
   'comint-highlight-input geiser-repl "evaluated input highlighting")
 
 (geiser-custom--defface repl-output
   'font-lock-string-face geiser-repl "REPL output")
 
+(geiser-custom--defface repl-output-success
+  'font-lock-string-face geiser-repl "REPL output (success)")
+
+(geiser-custom--defface repl-output-warning
+  'warning geiser-repl "REPL output (warnings)")
+
+(geiser-custom--defface repl-output-error
+  'error geiser-repl "REPL output (errors)")
+
 (geiser-custom--defface repl-prompt
   'comint-highlight-prompt geiser-repl "REPL prompt")
 
@@ -465,21 +483,55 @@ will be set up using `geiser-connect-local' when a REPL is started.")
          (setq header-line-format
                (format "Socket: %s" address)))))
 
+
+(defun geiser-repl--classify-output (start end)
+  "Classify output region as :success, :warning, or :error.
+Returns the classification based on the first line of output.
+Only used when `geiser-repl-classify-output-p' is non-nil."
+  (save-excursion
+    (goto-char start)
+    (let ((first-line (buffer-substring-no-properties 
+                       start 
+                       (min end (line-end-position)))))
+      (cond
+       ((string-match-p "raise-exception" first-line) :error)
+       ((string-match-p "warning:" first-line) :warning)
+       (t :success)))))
+
 (defun geiser-repl--fontify-output-region (beg end)
-  "Apply highlighting to a REPL output region."
+  "Apply highlighting to a REPL output region.
+If `geiser-repl-highlight-output-p' is enabled, applies syntax
+highlighting. Otherwise, if `geiser-repl-classify-output-p' is
+enabled, classifies output and applies appropriate face. If neither
+is enabled, applies default output face."
   (remove-text-properties beg end '(font-lock-face nil face nil))
-  (if geiser-repl-highlight-output-p
-      (geiser-syntax--fontify-syntax-region beg end)
-    (geiser-repl--fontify-plaintext beg end)))
-
-(defun geiser-repl--fontify-plaintext (start end)
-  "Fontify REPL output plainly."
-  (add-text-properties
-   start end
-   '(font-lock-fontified t
-                         fontified t
-                         font-lock-multiline t
-                         font-lock-face geiser-font-lock-repl-output)))
+  (cond
+   (geiser-repl-highlight-output-p
+    (geiser-syntax--fontify-syntax-region beg end))
+   (geiser-repl-classify-output-p
+    (let ((output-type (geiser-repl--classify-output beg end)))
+      (geiser-repl--fontify-plaintext beg end output-type)))
+   (t
+    (geiser-repl--fontify-plaintext beg end))))
+
+(defun geiser-repl--fontify-plaintext (start end &optional output-type)
+  "Fontify REPL output plainly with appropriate face.
+If OUTPUT-TYPE is provided and `geiser-repl-classify-output-p' is
+enabled, it can be :success, :warning, or :error. Otherwise defaults
+to standard output face."
+  (let ((face (if (and output-type geiser-repl-classify-output-p)
+                  (pcase output-type
+                    (:error 'geiser-font-lock-repl-output-error)
+                    (:warning 'geiser-font-lock-repl-output-warning)
+                    (:success 'geiser-font-lock-repl-output-success)
+                    (_ 'geiser-font-lock-repl-output))
+                'geiser-font-lock-repl-output)))
+    (add-text-properties
+     start end
+     `(font-lock-fontified t
+                           fontified t
+                           font-lock-multiline t
+                           font-lock-face ,face))))
 
 (defun geiser-repl--narrow-to-prompt ()
   "Narrow to active prompt region and return t, otherwise returns nil."