diff options
| -rw-r--r-- | elisp/geiser-capf.el | 19 | ||||
| -rw-r--r-- | elisp/geiser-connection.el | 6 | ||||
| -rw-r--r-- | elisp/geiser-edit.el | 48 | ||||
| -rw-r--r-- | elisp/geiser-impl.el | 8 | ||||
| -rw-r--r-- | elisp/geiser-mode.el | 15 | ||||
| -rw-r--r-- | elisp/geiser-repl.el | 78 | ||||
| -rw-r--r-- | elisp/geiser-syntax.el | 3 | ||||
| -rw-r--r-- | elisp/geiser.el | 4 | ||||
| -rw-r--r-- | news.org | 4 |
9 files changed, 127 insertions, 58 deletions
diff --git a/elisp/geiser-capf.el b/elisp/geiser-capf.el index a3c47a3..e7c1139 100644 --- a/elisp/geiser-capf.el +++ b/elisp/geiser-capf.el @@ -1,6 +1,6 @@ ;;; geiser-capf.el --- Setup for Geiser's CAPFs -*- lexical-binding: t; -*- -;; Copyright (c) 2022 Jose Antonio Ortega Ruiz +;; Copyright (c) 2022, 2025 Jose Antonio Ortega Ruiz ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the Modified BSD License. You should @@ -18,6 +18,7 @@ (require 'geiser-doc) (require 'geiser-completion) (require 'geiser-edit) +(require 'geiser-syntax) (defun geiser-capf--company-docsig (id) (condition-case err @@ -38,13 +39,15 @@ (current-buffer)))))) (defun geiser-capf--company-location (id) - (condition-case _err - (when (and geiser-impl--implementation (not (geiser-autodoc--inhibit))) - (let ((id (make-symbol id))) - (condition-case nil - (geiser-edit-module id 'noselect) - (error (geiser-edit-symbol id 'noselect))))) - (error (message "Location not found for %s" id)))) + (ignore-errors + (when (and geiser-impl--implementation (not (geiser-autodoc--inhibit))) + (let ((id (if (stringp id) (geiser-syntax--form-from-string id) id))) + (if-let* ((mloc (geiser-edit-module-location id)) + (f (geiser-edit--location-file mloc))) + (cons f 1) + (if-let* ((sloc (geiser-edit-symbol-location id)) + (f (geiser-edit--location-file sloc))) + (cons f (or (geiser-edit--location-line sloc) 1)))))))) (defun geiser-capf--thing-at-point (module &optional _predicate) (with-syntax-table scheme-mode-syntax-table diff --git a/elisp/geiser-connection.el b/elisp/geiser-connection.el index af185b4..24c9a2c 100644 --- a/elisp/geiser-connection.el +++ b/elisp/geiser-connection.el @@ -1,6 +1,6 @@ ;;; geiser-connection.el --- Talking to a scheme process -*- lexical-binding: t; -*- -;; Copyright (C) 2009-2011, 2013, 2021-2022 Jose Antonio Ortega Ruiz +;; Copyright (C) 2009-2011, 2013, 2021-2022, 2025 Jose Antonio Ortega Ruiz ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the Modified BSD License. You should @@ -87,7 +87,7 @@ (unwind-protect (funcall (tq-queue-head-fn tq) (tq-queue-head-closure tq) - (buffer-substring (point-min) (match-beginning 0))) + (buffer-substring (point-min) (point))) (delete-region (point-min) (point-max)) (tq-queue-pop tq))))))) @@ -139,7 +139,7 @@ (defun geiser-con--connection-update-debugging (c txt) (let* ((dp (geiser-con--connection-debug-prompt c)) - (is-d (and (stringp dp) (string-match dp txt)))) + (is-d (and (stringp dp) (string-match-p dp txt)))) (geiser-con--connection-set-debugging c is-d) is-d)) diff --git a/elisp/geiser-edit.el b/elisp/geiser-edit.el index 0d47cbe..0c6be2f 100644 --- a/elisp/geiser-edit.el +++ b/elisp/geiser-edit.el @@ -1,6 +1,6 @@ ;;; geiser-edit.el --- Scheme edit locations -*- lexical-binding: t; -*- -;; Copyright (C) 2009, 2010, 2012, 2013, 2019-2024 Jose Antonio Ortega Ruiz +;; Copyright (C) 2009, 2010, 2012, 2013, 2019-2025 Jose Antonio Ortega Ruiz ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the Modified BSD License. You should @@ -155,11 +155,10 @@ or following links in error buffers.") (unless no-error (error "Couldn't find location for '%s'" symbol))))) -(defsubst geiser-edit--try-edit (symbol ret &optional method no-error) - (let ((res (geiser-eval--retort-result ret))) - (if (listp res) - (geiser-edit--try-edit-location symbol res method no-error) - (unless no-error (error "Couldn't find location for '%s'" symbol))))) +(defsubst geiser-edit--try-edit (symbol res &optional method no-error) + (if (listp res) + (geiser-edit--try-edit-location symbol res method no-error) + (unless no-error (error "Couldn't find location for '%s'" symbol)))) ;;; Links @@ -257,26 +256,30 @@ or following links in error buffers.") (defvar geiser-edit--symbol-history nil) +(defun geiser-edit-symbol-location (&optional symbol) + (let* ((symbol (or symbol + (geiser--symbol-at-point) + (error "No symbol at point"))) + (cmd `(:eval (:ge symbol-location ',symbol)))) + (geiser-eval--retort-result (geiser-eval--send/wait cmd)))) + (defun geiser-edit-symbol (symbol &optional method marker) "Asks for a symbol to edit, with completion." (interactive (list (geiser-completion--read-symbol "Edit symbol: " nil geiser-edit--symbol-history))) - (let ((cmd `(:eval (:ge symbol-location ',symbol)))) - (geiser-edit--try-edit symbol (geiser-eval--send/wait cmd) method) - (when marker (xref-push-marker-stack)))) + (geiser-edit--try-edit symbol (geiser-edit-symbol-location symbol) method) + (when marker (xref-push-marker-stack))) (defun geiser-edit-symbol-at-point (&optional arg) "Visit the definition of the symbol at point. With prefix, asks for the symbol to locate." (interactive "P") - (let* ((symbol (or (and (not arg) (geiser--symbol-at-point)) - (geiser-completion--read-symbol "Edit symbol: "))) - (cmd `(:eval (:ge symbol-location ',symbol))) - (marker (point-marker)) - (ret (ignore-errors (geiser-eval--send/wait cmd)))) - (if (geiser-edit--try-edit symbol ret nil t) + (let ((symbol (or (and (not arg) (geiser--symbol-at-point)) + (geiser-completion--read-symbol "Edit symbol: "))) + (marker (point-marker))) + (if (geiser-edit--try-edit symbol (geiser-edit-symbol-location symbol) nil t) (when marker (xref-push-marker-stack marker)) (unless (geiser-edit-module-at-point t) (error "Couldn't find location for '%s'" symbol))) @@ -290,11 +293,20 @@ With prefix, asks for the symbol to locate." (with-no-warnings (xref-pop-marker-stack)))) -(defun geiser-edit-module (module &optional method no-error) +(defun geiser-edit-module-location (&optional module) + (let* ((module (or module + (geiser-completion--module-at-point) + (error "No module at point"))) + (cmd `(:eval (:ge module-location '(:module ,module))))) + (geiser-eval--retort-result (geiser-eval--send/wait cmd)))) + +(defun geiser-edit-module (&optional module method no-error) "Asks for a module and opens it in a new buffer." (interactive (list (geiser-completion--read-module))) - (let ((cmd `(:eval (:ge module-location '(:module ,module))))) - (geiser-edit--try-edit module (geiser-eval--send/wait cmd) method no-error))) + (geiser-edit--try-edit module + (geiser-edit-module-location module) + method + no-error)) (defun geiser-edit-module-at-point (&optional no-error) "Opens a new window visiting the module at point." diff --git a/elisp/geiser-impl.el b/elisp/geiser-impl.el index f95034a..e4b33d6 100644 --- a/elisp/geiser-impl.el +++ b/elisp/geiser-impl.el @@ -1,6 +1,6 @@ ;;; geiser-impl.el --- Generic support for scheme implementations -*- lexical-binding: t; -*- -;; Copyright (C) 2009-2010, 2012-2013, 2015-2016, 2019, 2021-2022 Jose Antonio Ortega Ruiz +;; Copyright (C) 2009-2010, 2012-2013, 2015-2016, 2019, 2021-2022, 2025 Jose Antonio Ortega Ruiz ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the Modified BSD License. You should @@ -143,9 +143,9 @@ in order to determine its scheme flavour." (push (cons impl file) geiser-impl--load-files))) ;;;###autoload -(progn ;Copy the whole def to the autoloads file. -(defun geiser-activate-implementation (impl) - (add-to-list 'geiser-active-implementations impl))) +(progn ;Copy the whole def to the autoloads file. + (defun geiser-activate-implementation (impl) + (add-to-list 'geiser-active-implementations impl))) (defsubst geiser-deactivate-implementation (impl) (setq geiser-active-implementations diff --git a/elisp/geiser-mode.el b/elisp/geiser-mode.el index c8a9e0d..75162d4 100644 --- a/elisp/geiser-mode.el +++ b/elisp/geiser-mode.el @@ -1,6 +1,6 @@ ;;; geiser-mode.el --- Minor mode for scheme buffers -*- lexical-binding: t; -*- -;; Copyright (C) 2009-2017, 2020, 2022, 2024 Jose Antonio Ortega Ruiz +;; Copyright (C) 2009-2017, 2020, 2022, 2024, 2025 Jose Antonio Ortega Ruiz ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the Modified BSD License. You should @@ -244,16 +244,15 @@ With prefix, recursively macro-expand the resulting expression." all t)) -(defun geiser-set-scheme () +(defun geiser-set-scheme (impl) "Associates current buffer with a given Scheme implementation." - (interactive) + (interactive (list (geiser-impl--read-impl))) (save-excursion (geiser-syntax--remove-kws) - (let ((impl (geiser-impl--read-impl))) - (geiser-impl--set-buffer-implementation impl) - (geiser-repl--set-up-repl impl) - (geiser-syntax--add-kws) - (geiser-syntax--fontify)))) + (geiser-impl--set-buffer-implementation impl) + (geiser-repl--set-up-repl impl) + (geiser-syntax--add-kws) + (geiser-syntax--fontify))) (defun geiser-mode-switch-to-repl (arg) "Switches to Geiser REPL. 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." diff --git a/elisp/geiser-syntax.el b/elisp/geiser-syntax.el index af750fb..683d37e 100644 --- a/elisp/geiser-syntax.el +++ b/elisp/geiser-syntax.el @@ -438,7 +438,8 @@ implementation-specific entries for font-lock-keywords.") (not bns)))) (when name (push name locals)) (when (geiser-syntax--symbol-eq head 'case-lambda) - (dolist (n (and (> nesting 0) (caar (last form)))) + (dolist (n (and (> nesting 0) + (geiser-syntax--linearize (caar (last form))))) (when n (push n locals))) (setq rest (and (> nesting 0) (cdr form))) (setq use-names nil)) diff --git a/elisp/geiser.el b/elisp/geiser.el index a7aabb9..47ce75e 100644 --- a/elisp/geiser.el +++ b/elisp/geiser.el @@ -1,6 +1,6 @@ ;;; geiser.el --- GNU Emacs and Scheme talk to each other -*- lexical-binding: t; -*- -;; Copyright (C) 2009-2013, 2015, 2018, 2021-2024 Jose Antonio Ortega Ruiz +;; Copyright (C) 2009-2013, 2015, 2018, 2021-2025 Jose Antonio Ortega Ruiz ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the Modified BSD License. You should @@ -13,7 +13,7 @@ ;; Homepage: https://gitlab.com/emacs-geiser/ ;; Package-Requires: ((emacs "27.1") (project "0.8.1")) ;; SPDX-License-Identifier: BSD-3-Clause -;; Version: 0.31.1 +;; Version: 0.32 ;;; Commentary: @@ -1,4 +1,4 @@ -* Version 0.32 +* Version 0.32 (August 10, 2024) - REPL: Fix for highlighting of 2-character input prompts (thanks to Macon Gambill) @@ -9,6 +9,8 @@ - Highlight only if show-paren-mode is enabled - Compatibility with electric-pair-mode + - REPL: Fix for debugger access affecting mainly Guile. + * Version 0.31.1 (September 1, 2024) - Code cleanups |