branch: elpa/geiser
commit 8842104d1521a00c182ce78e9d50d394e9ba86f5
Author: laluxx <[email protected]>
Commit: laluxx <[email protected]>
Opt-in REPL output classification
---
elisp/geiser-repl.el | 78 +++++++++++++++++++++++++++++++++++++++++++---------
1 file changed, 65 insertions(+), 13 deletions(-)
diff --git a/elisp/geiser-repl.el b/elisp/geiser-repl.el
index b8df566e2a0..54cf6d89d30 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."
