summaryrefslogtreecommitdiff
path: root/elisp
diff options
context:
space:
mode:
Diffstat (limited to 'elisp')
-rw-r--r--elisp/geiser-autodoc.el2
-rw-r--r--elisp/geiser-base.el33
-rw-r--r--elisp/geiser-capf.el22
-rw-r--r--elisp/geiser-compile.el2
-rw-r--r--elisp/geiser-completion.el2
-rw-r--r--elisp/geiser-connection.el54
-rw-r--r--elisp/geiser-custom.el26
-rw-r--r--elisp/geiser-debug.el2
-rw-r--r--elisp/geiser-doc.el58
-rw-r--r--elisp/geiser-edit.el82
-rw-r--r--elisp/geiser-eval.el12
-rw-r--r--elisp/geiser-image.el6
-rw-r--r--elisp/geiser-impl.el10
-rw-r--r--elisp/geiser-log.el2
-rw-r--r--elisp/geiser-menu.el2
-rw-r--r--elisp/geiser-mode.el17
-rw-r--r--elisp/geiser-popup.el2
-rw-r--r--elisp/geiser-reload.el54
-rw-r--r--elisp/geiser-repl.el181
-rw-r--r--elisp/geiser-syntax.el9
-rw-r--r--elisp/geiser-table.el2
-rw-r--r--elisp/geiser-xref.el7
-rw-r--r--elisp/geiser.el8
23 files changed, 366 insertions, 229 deletions
diff --git a/elisp/geiser-autodoc.el b/elisp/geiser-autodoc.el
index 67d3213..e22c9d4 100644
--- a/elisp/geiser-autodoc.el
+++ b/elisp/geiser-autodoc.el
@@ -1,4 +1,4 @@
-;;; geiser-autodoc.el -- autodoc mode -*- lexical-binding: t; -*-
+;;; geiser-autodoc.el --- Autodoc mode -*- lexical-binding: t; -*-
;; Copyright (C) 2009, 2010, 2011, 2012, 2015, 2016, 2021, 2022 Jose Antonio Ortega Ruiz
diff --git a/elisp/geiser-base.el b/elisp/geiser-base.el
index 6d6277f..71aa8b4 100644
--- a/elisp/geiser-base.el
+++ b/elisp/geiser-base.el
@@ -1,14 +1,16 @@
-;;; geiser-base.el --- shared bits -*- lexical-binding: t -*-
+;;; geiser-base.el --- Shared bits -*- lexical-binding: t -*-
-;; Copyright (C) 2009, 2010, 2012, 2013, 2015, 2016, 2019 Jose Antonio Ortega Ruiz
+;; Copyright (C) 2009, 2010, 2012, 2013, 2015, 2016, 2019, 2024 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
;; have received a copy of the license along with this program. If
;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>.
-;; Settings and vars shared by all geiser modules, including little
-;; utilities and emacsen compatibility bits.
+;;; Commentary:
+
+;; Settings and variables shared by all geiser modules, including
+;; little utilities and emacsen compatibility bits.
;;; Code:
@@ -16,15 +18,14 @@
(require 'ring)
-(eval-after-load "ring"
- '(when (not (fboundp 'ring-member))
- (defun ring-member (ring item)
- (catch 'found
- (dotimes (ind (ring-length ring))
- (when (equal item (ring-ref ring ind))
- (throw 'found ind)))))))
+(unless (fboundp 'ring-member)
+ (defun ring-member (ring item)
+ (catch 'found
+ (dotimes (ind (ring-length ring))
+ (when (equal item (ring-ref ring ind))
+ (throw 'found ind))))))
-(when (not (fboundp 'looking-at-p))
+(unless (fboundp 'looking-at-p)
(defsubst looking-at-p (regexp)
(with-no-warnings
(let ((inhibit-changing-match-data t))
@@ -40,9 +41,14 @@
;;; Utilities:
+(require 'ansi-color)
+
(defsubst geiser--chomp (str)
(if (string-match-p ".*\n$" str) (substring str 0 -1) str))
+(defsubst geiser--strip-ansi (s)
+ (replace-regexp-in-string "" "" (ansi-color-filter-apply s)))
+
(defun geiser--shorten-str (str len &optional sep)
(let ((str-len (length str)))
(if (<= str-len len)
@@ -66,12 +72,11 @@
(insert str)
(put-text-property p (point) 'face face)))
-
(defmacro geiser--save-msg (&rest body)
(let ((msg (make-symbol "msg")))
`(let ((,msg (current-message)))
,@body
- (message ,msg))))
+ (message "%s" ,msg))))
(put 'geiser--save-msg 'lisp-indent-function 0)
diff --git a/elisp/geiser-capf.el b/elisp/geiser-capf.el
index 542cac7..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; -*-
+;;; 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
@@ -10,6 +10,7 @@
;; Start date: Sat Apr 23, 2022 18:39
+;;; Code:
(require 'geiser-autodoc)
(require 'geiser-impl)
@@ -17,6 +18,7 @@
(require 'geiser-doc)
(require 'geiser-completion)
(require 'geiser-edit)
+(require 'geiser-syntax)
(defun geiser-capf--company-docsig (id)
(condition-case err
@@ -37,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-compile.el b/elisp/geiser-compile.el
index 3897499..9458f4d 100644
--- a/elisp/geiser-compile.el
+++ b/elisp/geiser-compile.el
@@ -1,4 +1,4 @@
-;;; geiser-compile.el -- compile/load scheme files -*- lexical-binding: t; -*-
+;;; geiser-compile.el --- Compile/load scheme files -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2013, 2016, 2018, 2021-2022 Jose Antonio Ortega Ruiz
diff --git a/elisp/geiser-completion.el b/elisp/geiser-completion.el
index 584e9e0..f68b8fa 100644
--- a/elisp/geiser-completion.el
+++ b/elisp/geiser-completion.el
@@ -1,4 +1,4 @@
-;;; geiser-completion.el -- tab completion -*- lexical-binding: t; -*-
+;;; geiser-completion.el --- Tab completion -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2012, 2018, 2020-2022 Jose Antonio Ortega Ruiz
diff --git a/elisp/geiser-connection.el b/elisp/geiser-connection.el
index b7d312e..414cc6b 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; -*-
+;;; 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, 2026 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
@@ -39,7 +39,7 @@
;;; Request datatype:
(defun geiser-con--make-request (con str cont &optional sender-buffer)
- (list (cons :id (geiser-con--connection-inc-count con))
+ (list (cons :id (and (car con) (geiser-con--connection-inc-count con)))
(cons :string str)
(cons :continuation cont)
(cons :buffer (or sender-buffer (current-buffer)))
@@ -81,7 +81,7 @@
(progn (geiser-log--error "Unexpected queue input:\n %s" in)
(delete-region (point-min) (point-max)))
(goto-char (point-max))
- (insert in)
+ (insert (geiser--strip-ansi in))
(goto-char (point-min))
(when (re-search-forward (tq-queue-head-regexp tq) nil t)
(unwind-protect
@@ -110,6 +110,9 @@
(cons :count 0)
(cons :completed (make-hash-table :weakness 'value))))
+(defsubst geiser-con--pending-requests-p (c)
+ (not (tq-queue-empty (geiser-con--connection-tq c))))
+
(defsubst geiser-con--connection-process (c)
(tq-process (cdr (assq :tq c))))
@@ -139,7 +142,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))
@@ -157,7 +160,7 @@
new))
(defun geiser-con--has-entered-debugger (con answer)
- (when-let ((p (car (last (split-string answer "\n" t)))))
+ (when-let* ((p (car (last (split-string answer "\n" t)))))
(geiser-con--connection-update-debugging con p))
(geiser-con--connection-is-debugging con))
@@ -202,7 +205,20 @@
(debugging (geiser-con--has-entered-debugger con answer)))
(condition-case err
(let ((start (string-match "((\\(?:result)?\\|error\\) " answer)))
- (or (and start (car (read-from-string answer start)))
+ (or (and start
+ (progn
+ (let ((extra-output (substring answer 0 start)))
+ (unless (string-blank-p extra-output)
+ (geiser-log--warn "Extra output (before): %s"
+ (string-trim extra-output))))
+ (let* ((ret (read-from-string answer start))
+ (extra-output (substring answer (cdr ret))))
+ (unless (string-blank-p extra-output)
+ ;; Usually, the extra output is just the return value
+ ;; being echoed by the REPL, and not worth noting.
+ (geiser-log--debug "Extra output (after): %s"
+ (string-trim extra-output)))
+ (car ret))))
`((error (key . retort-syntax))
(output . ,answer)
(debug . ,debugging))))
@@ -247,7 +263,8 @@
(defun geiser-con--send-string (con str cont &optional sbuf)
(let ((req (geiser-con--make-request con str cont sbuf)))
- (geiser-con--connection-add-request con req)
+ (when (geiser-con--request-id req)
+ (geiser-con--connection-add-request con req))
req))
(defvar geiser-connection-timeout 30000
@@ -255,24 +272,29 @@
(defun geiser-con--interrupt (con)
"Interrupt any request being currently in process."
- (when-let (proc (and con (geiser-con--connection-process con)))
+ (when-let* ((proc (and con (geiser-con--connection-process con))))
(when (process-live-p proc)
(interrupt-process proc))))
(defun geiser-con--wait (req timeout)
- "Wait up to TIMEOUT msecs for request REQ to finish, returning its result."
+ "Wait up to TIMEOUT msecs for request REQ to finish."
(let* ((con (or (geiser-con--request-connection req)
(error "Geiser connection not active")))
(proc (geiser-con--connection-process con))
(id (geiser-con--request-id req))
(timeout (/ (or timeout geiser-connection-timeout) 1000.0))
(step (/ timeout 10)))
- (with-timeout (timeout (geiser-con--request-deactivate req))
- (condition-case nil
- (while (and (geiser-con--connection-process con)
- (not (geiser-con--connection-completed-p con id)))
- (accept-process-output proc step))
- (error (geiser-con--request-deactivate req))))))
+ (if (null (geiser-con--request-id req)) ;; request sent with paused conn
+ (when-let* ((cont (geiser-con--request-continuation req)))
+ (with-current-buffer (or (geiser-con--request-buffer req)
+ (current-buffer))
+ (funcall cont '((result)))))
+ (with-timeout (timeout (geiser-con--request-deactivate req))
+ (condition-case nil
+ (while (and (geiser-con--connection-process con)
+ (not (geiser-con--connection-completed-p con id)))
+ (accept-process-output proc step))
+ (error (geiser-con--request-deactivate req)))))))
(defun geiser-con--send-string/wait (con str cont &optional timeout sbuf)
(when (and (stringp str) (not (string-blank-p str)))
diff --git a/elisp/geiser-custom.el b/elisp/geiser-custom.el
index 4b42d91..f9b05a7 100644
--- a/elisp/geiser-custom.el
+++ b/elisp/geiser-custom.el
@@ -1,6 +1,6 @@
;;; geiser-custom.el -- customization utilities -*- lexical-binding: t; -*-
-;; Copyright (C) 2009, 2010, 2012 Jose Antonio Ortega Ruiz
+;; Copyright (C) 2009, 2010, 2012, 2024 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
@@ -31,6 +31,10 @@
:group 'faces)
(defmacro geiser-custom--defface (face def group doc)
+ "Utility macro to define geiser.
+This is a very simple macro ensuring all geiser faces follow a common
+naming pattern and are added to a common group besides the one provided
+in the macro arguments."
(declare (doc-string 4) (indent 1))
(let ((face (intern (format "geiser-font-lock-%s" face))))
`(defface ,face (face-default-spec ,def)
@@ -43,18 +47,24 @@
(defvar geiser-custom--memoized-vars nil)
(defun geiser-custom--memoize (name)
- ;; FIXME: Why not build this list with mapatoms, filtering on a "\\`'geiser-"
+ ;; Why not build this list with mapatoms, filtering on a "\\`'geiser-"
;; prefix and checking that it's a `defcustom', so we don't need
- ;; `geiser-custom--defcustom'?
+ ;; `geiser-custom--defcustom'? Because implementation-specific modules using
+ ;; geiser may use similarly named custom variables that are, for some reason
+ ;; or another, not meant to partake in the geiser-reload mechanism, and we
+ ;; don't know their names.
(add-to-list 'geiser-custom--memoized-vars name))
(defmacro geiser-custom--defcustom (name &rest body)
"Like `defcustom' but also put NAME on an internal list.
-That list is used by `geiser-reload' to preserve the values
-of the listed variables. It is not used for anything else."
- ;; FIXME Remembering the value like this is not actually
- ;; necessary. Evaluating `defcustom' always preserves the
- ;; existing value, if any.
+That list is used by `geiser-reload' to preserve the values of the
+listed variables. It is not used for anything else.
+
+Note that, even though defcustom preserves the existing value of a
+variable if it's already defined, geiser-reload unloads all geiser
+features and therefore undefines all defined variables: we keep this
+list of values around to be able to restore them after loading
+a (presumably) new version of geiser after that unloading."
(declare (doc-string 3) (debug (name body)) (indent 2))
`(progn
(geiser-custom--memoize ',name)
diff --git a/elisp/geiser-debug.el b/elisp/geiser-debug.el
index 88f1e72..c5e30a9 100644
--- a/elisp/geiser-debug.el
+++ b/elisp/geiser-debug.el
@@ -1,4 +1,4 @@
-;;; geiser-debug.el -- displaying debug and eval info -*- lexical-binding: t; -*-
+;;; geiser-debug.el --- Displaying debug and eval info -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2016, 2020-2022 Jose Antonio Ortega Ruiz
diff --git a/elisp/geiser-doc.el b/elisp/geiser-doc.el
index de18d9f..36712b5 100644
--- a/elisp/geiser-doc.el
+++ b/elisp/geiser-doc.el
@@ -1,6 +1,6 @@
-;;; geiser-doc.el -- accessing scheme-provided documentation -*- lexical-binding: t; -*-
+;;; geiser-doc.el --- Accessing scheme-provided documentation -*- lexical-binding: t; -*-
-;; Copyright (C) 2009-2016, 2021-2022 Jose Antonio Ortega Ruiz
+;; Copyright (C) 2009-2016, 2021-2022, 2024, 2026 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
@@ -149,14 +149,14 @@ value if the default action should be skipped.")
(let ((link (button-get button 'geiser-link)))
(when link (geiser-doc--follow-link link))))
-(define-button-type 'geiser-doc--button
+(define-button-type 'geiser-doc
'action 'geiser-doc--button-action
'follow-link t)
(defun geiser-doc--make-module-button (beg end module impl)
(let ((link (geiser-doc--make-link nil module impl))
(help (format "Help for module %s" module)))
- (make-text-button beg end :type 'geiser-doc--button
+ (make-text-button beg end :type 'geiser-doc
'face 'geiser-font-lock-doc-link
'geiser-link link
'help-echo help)))
@@ -171,52 +171,46 @@ value if the default action should be skipped.")
(if target (format "%s in " target) "")
(or module "<unknown>"))))
(insert-text-button text
- :type 'geiser-doc--button
+ :type 'geiser-doc
'face 'geiser-font-lock-doc-link
'geiser-link link
'help-echo help)))
-(defun geiser-doc-goto-source ()
+(define-button-type 'geiser-doc-source
+ 'action 'geiser-doc-goto-source
+ 'face 'geiser-font-lock-doc-button
+ 'help-echo "Go to definition"
+ 'follow-link t)
+
+(defun geiser-doc-goto-source (&rest _)
"Go to the definition of this item."
(interactive)
- (when-let (link geiser-doc--buffer-link)
+ (when-let* ((link geiser-doc--buffer-link))
(with--geiser-implementation (geiser-doc--link-impl link)
- (if-let (target (geiser-doc--link-target link))
+ (if-let* ((target (geiser-doc--link-target link)))
(geiser-edit-symbol target nil (point-marker))
(geiser-edit-module (geiser-doc--link-module link))))))
-(defun geiser-doc-goto-manual ()
+(define-button-type 'geiser-doc-manual
+ 'action 'geiser-doc-goto-manual
+ 'face 'geiser-font-lock-doc-button
+ 'help-echo "Look up in Scheme manual"
+ 'follow-link t)
+
+(defun geiser-doc-goto-manual (&rest _)
"Go to the manual for this item."
(interactive)
- (when-let (link geiser-doc--buffer-link)
+ (when-let* ((link geiser-doc--buffer-link))
(let ((tm (geiser-doc--link-target link))
(mod (geiser-doc--link-module link))
(impl (geiser-doc--link-impl link)))
(geiser-doc--external-help impl (or tm mod) mod))))
-(defun geiser-doc--xbutton-action (button)
- (let ((k (button-get button 'x-kind)))
- (cond ((eq 'source k) (geiser-doc-goto-source))
- ((eq 'manual k) (geiser-doc-goto-manual)))))
-
-(define-button-type 'geiser-doc--xbutton
- 'action 'geiser-doc--xbutton-action
- 'face 'geiser-font-lock-doc-button
- 'follow-link t)
-
-(defun geiser-doc--insert-xbutton (&optional manual)
- (let ((label (if manual "[manual]" "[source]"))
- (help (if manual "Look up in Scheme manual" "Go to definition")))
- (insert-text-button label
- :type 'geiser-doc--xbutton
- 'help-echo help
- 'x-kind (if manual 'manual 'source))))
-
-(defun geiser-doc--insert-xbuttons (impl)
+(defun geiser-doc--insert-doc-buttons (impl)
(when (geiser-impl--method 'external-help impl)
- (geiser-doc--insert-xbutton t)
+ (insert-text-button "[manual]" :type 'geiser-doc-manual)
(insert " "))
- (geiser-doc--insert-xbutton))
+ (insert-text-button "[source]" :type 'geiser-doc-source))
(defun geiser-doc--insert-nav-button (next)
(let* ((lnk (if next (geiser-doc--history-next-link)
@@ -269,7 +263,7 @@ value if the default action should be skipped.")
(defun geiser-doc--insert-footer (impl)
(newline 2)
- (geiser-doc--insert-xbuttons impl)
+ (geiser-doc--insert-doc-buttons impl)
(let* ((prev (and (geiser-doc--history-previous-p) 8))
(nxt (and (geiser-doc--history-next-p) 10))
(len (max 1 (- (window-width)
diff --git a/elisp/geiser-edit.el b/elisp/geiser-edit.el
index df4231c..1251969 100644
--- a/elisp/geiser-edit.el
+++ b/elisp/geiser-edit.el
@@ -1,6 +1,6 @@
-;;; geiser-edit.el -- scheme edit locations -*- lexical-binding: t; -*-
+;;; geiser-edit.el --- Scheme edit locations -*- lexical-binding: t; -*-
-;; Copyright (C) 2009, 2010, 2012, 2013, 2019-2023 Jose Antonio Ortega Ruiz
+;; Copyright (C) 2009, 2010, 2012, 2013, 2019-2026 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
@@ -36,8 +36,16 @@
"How the new buffer is opened when invoking \\[geiser-edit-symbol-at-point]
or following links in error buffers.")
+(defgroup geiser-edit nil
+ "Customizations for scheme buffers and information about them."
+ :group 'geiser)
+
(geiser-custom--defface error-link
- 'link geiser-debug "links in error buffers")
+ 'link geiser-edit "links in error buffers")
+
+(geiser-custom--defcustom geiser-insert-actual-lambda t
+ "Whether geiser-insert-lambda should insert \"λ\" or \"lambda\"."
+ :type 'boolean)
;;; Auxiliary functions:
@@ -52,7 +60,7 @@ or following links in error buffers.")
(cdr (assoc "name" loc)))
(defsubst geiser-edit--location-file (loc)
- (when-let ((file-name (cdr (assoc "file" loc))))
+ (when-let* ((file-name (cdr (assoc "file" loc))))
(concat (or (file-remote-p default-directory) "")
file-name)))
@@ -85,10 +93,14 @@ or following links in error buffers.")
"define*"
"define-method"
"define-class"
- "define-struct")))
+ "define-struct"
+ ;; SRFI 253
+ "define-checked")))
(defconst geiser-edit--def-re*
- (regexp-opt '("define-syntaxes" "define-values")))
+ (regexp-opt '("define-syntaxes" "define-values"
+ ;; SRFI 273
+ "define-values-checked")))
(defsubst geiser-edit--def-re (thing)
(let ((sx (regexp-quote (format "%s" thing))))
@@ -128,7 +140,7 @@ or following links in error buffers.")
(forward-line (max 0 (1- line))))
((numberp pos) (goto-char pos)))
(if (not col)
- (when-let (pos (car (geiser-edit--find-def symbol)))
+ (when-let* ((pos (car (geiser-edit--find-def symbol))))
(goto-char pos))
(beginning-of-line)
(forward-char col)
@@ -147,16 +159,15 @@ 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
-(define-button-type 'geiser-edit--button
+(define-button-type 'geiser-edit
'action 'geiser-edit--button-action
'face 'geiser-font-lock-error-link
'follow-link t)
@@ -168,7 +179,7 @@ or following links in error buffers.")
(defun geiser-edit--make-link (beg end file line col &optional method)
(make-button beg end
- :type 'geiser-edit--button
+ :type 'geiser-edit
'geiser-method method
'geiser-location
(geiser-edit--make-location 'error file line col)
@@ -202,7 +213,7 @@ or following links in error buffers.")
(while (> n 0)
(let ((b (ignore-errors (funcall nxt 1))))
(unless b (setq n 0))
- (when (and b (eq (button-type b) 'geiser-edit--button))
+ (when (and b (eq (button-type b) 'geiser-edit))
(setq n (- n 1))
(when (<= n 0)
(setq found t)
@@ -249,26 +260,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)))
@@ -282,11 +297,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."
@@ -298,10 +322,6 @@ With prefix, asks for the symbol to locate."
(when marker (xref-push-marker-stack marker))
t)))
-(geiser-custom--defcustom geiser-insert-actual-lambda t
- "Whether geiser-insert-lambda should insert \"λ\" or \"lambda\"."
- :type 'boolean)
-
(defun geiser-insert-lambda (&optional full)
"Insert λ or lambda at point. With prefix, inserts (λ ()) or (lambda ()).
diff --git a/elisp/geiser-eval.el b/elisp/geiser-eval.el
index 5e4c566..069dfb9 100644
--- a/elisp/geiser-eval.el
+++ b/elisp/geiser-eval.el
@@ -1,6 +1,6 @@
-;;; geiser-eval.el -- sending scheme code for evaluation -*- lexical-binding: t; -*-
+;;; geiser-eval.el --- Sending scheme code for evaluation -*- lexical-binding: t; -*-
-;; Copyright (C) 2009, 2010, 2011, 2012, 2013, 2015, 2021, 2023 Jose Antonio Ortega Ruiz
+;; Copyright (C) 2009-2013, 2015, 2021, 2023, 2026 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
@@ -9,6 +9,8 @@
;; Start date: Sat Feb 07, 2009 22:35
+;;; Commentary:
+
;; Functions, building on top of geiser-connection, to evaluate scheme
;; code.
@@ -148,7 +150,8 @@ module-exports, autodoc, callers, callees and generic-methods.")
(geiser-con--send-string (geiser-eval--connection)
(geiser-eval--code-str code)
(lambda (s)
- (setq geiser-eval--async-retort (geiser-eval--log s))
+ (setq geiser-eval--async-retort
+ (geiser-eval--log s))
(funcall cont s))
buffer))
@@ -165,6 +168,9 @@ module-exports, autodoc, callers, callees and generic-methods.")
buffer)
sync-retort))
+(defun geiser-eval--pending-requests-p ()
+ (geiser-con--pending-requests-p (geiser-eval--connection)))
+
(defun geiser-eval-interrupt ()
"Interrupt on-going evaluation, if any."
(interactive)
diff --git a/elisp/geiser-image.el b/elisp/geiser-image.el
index 62cb970..8476954 100644
--- a/elisp/geiser-image.el
+++ b/elisp/geiser-image.el
@@ -1,4 +1,4 @@
-;;; geiser-image.el -- support for image display -*- lexical-binding: t; -*-
+;;; geiser-image.el --- Support for image display -*- lexical-binding: t; -*-
;; Copyright (c) 2012, 2015 Jose Antonio Ortega Ruiz
@@ -76,13 +76,13 @@ images in `geiser-image--cache-dir'."
(let ((file (button-get button 'geiser-image-file)))
(when (file-exists-p file) (geiser-image--display file))))
-(define-button-type 'geiser-image--button
+(define-button-type 'geiser-image
'action 'geiser-image--button-action
'follow-link t)
(defun geiser-image--insert-button (file)
(insert-text-button "[image]"
- :type 'geiser-image--button
+ :type 'geiser-image
'face 'geiser-font-lock-image-button
'geiser-image-file file
'help-echo "Click to display image"))
diff --git a/elisp/geiser-impl.el b/elisp/geiser-impl.el
index 3034cb3..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; -*-
+;;; 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-log.el b/elisp/geiser-log.el
index ead748f..fcd2e1a 100644
--- a/elisp/geiser-log.el
+++ b/elisp/geiser-log.el
@@ -1,4 +1,4 @@
-;;; geiser-log.el -- logging utilities -*- lexical-binding: t; -*-
+;;; geiser-log.el --- Logging utilities -*- lexical-binding: t; -*-
;; Copyright (C) 2009, 2010, 2012, 2019, 2021, 2022 Jose Antonio Ortega Ruiz
diff --git a/elisp/geiser-menu.el b/elisp/geiser-menu.el
index 9492f3c..afc0353 100644
--- a/elisp/geiser-menu.el
+++ b/elisp/geiser-menu.el
@@ -1,4 +1,4 @@
-;;; geiser-menu.el -- menu and keymaps definition -*- lexical-binding: t; -*-
+;;; geiser-menu.el --- Menu and keymaps definition -*- lexical-binding: t; -*-
;; Copyright (c) 2010, 2012 Jose Antonio Ortega Ruiz
diff --git a/elisp/geiser-mode.el b/elisp/geiser-mode.el
index df8493a..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; -*-
+;;; 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-popup.el b/elisp/geiser-popup.el
index c838dd7..bfd5055 100644
--- a/elisp/geiser-popup.el
+++ b/elisp/geiser-popup.el
@@ -1,4 +1,4 @@
-;;; geiser-popup.el -- popup windows -*- lexical-binding: t; -*-
+;;; geiser-popup.el --- Popup windows -*- lexical-binding: t; -*-
;; Copyright (C) 2009, 2010, 2012, 2013 Jose Antonio Ortega Ruiz
diff --git a/elisp/geiser-reload.el b/elisp/geiser-reload.el
index 678e374..25560c6 100644
--- a/elisp/geiser-reload.el
+++ b/elisp/geiser-reload.el
@@ -1,4 +1,4 @@
-;;; geiser-reload.el -- unload/load geiser packages -*- lexical-binding: t; -*-
+;;; geiser-reload.el --- Unload/load geiser packages -*- lexical-binding: t; -*-
;; Copyright (C) 2009, 2010, 2012, 2020, 2021, 2022, 2024 Jose Antonio Ortega Ruiz
@@ -21,36 +21,36 @@
;;; Reload:
-(defmacro geiser--features-list ()
- (quote '(
- geiser-mode
- geiser-repl
- geiser-capf
- geiser-doc
- geiser-xref
- geiser-compile
- geiser-debug
- geiser-completion
- geiser-autodoc
- geiser-edit
- geiser-eval
- geiser-connection
- geiser-syntax
- geiser-menu
- geiser-inf
- geiser-impl
- geiser-image
- geiser-custom
- geiser-log
- geiser-popup
- geiser-base
- geiser
- )))
+(defconst geiser--features-list
+ '(
+ geiser-mode
+ geiser-repl
+ geiser-capf
+ geiser-doc
+ geiser-xref
+ geiser-compile
+ geiser-debug
+ geiser-edit
+ geiser-completion
+ geiser-autodoc
+ geiser-eval
+ geiser-connection
+ geiser-syntax
+ geiser-menu
+ geiser-inf
+ geiser-impl
+ geiser-image
+ geiser-custom
+ geiser-log
+ geiser-popup
+ geiser-base
+ geiser
+ ))
(defun geiser-unload ()
"Unload all Geiser modules."
(interactive)
- (let ((fs (geiser--features-list)))
+ (let ((fs geiser--features-list))
(unload-feature 'geiser-reload t)
(dolist (f fs)
(when (featurep f) (unload-feature f t)))
diff --git a/elisp/geiser-repl.el b/elisp/geiser-repl.el
index 698a394..76dac80 100644
--- a/elisp/geiser-repl.el
+++ b/elisp/geiser-repl.el
@@ -1,6 +1,6 @@
;;; geiser-repl.el --- Geiser's REPL -*- lexical-binding: t; -*-
-;; Copyright (C) 2009-2013, 2015-2016, 2018-2023 Jose Antonio Ortega Ruiz
+;; Copyright (C) 2009-2013, 2015-2016, 2018-2023, 2026 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
@@ -56,7 +56,7 @@ used to discover a buffer's project."
(defun geiser-repl-project-root ()
"Use project.el, to determine a buffer's project root."
- (when-let (p (project-current)) (project-root p)))
+ (when-let* ((p (project-current))) (project-root p)))
(geiser-custom--defcustom geiser-repl-current-project-function
#'geiser-repl-project-root
@@ -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."
@@ -521,7 +573,7 @@ will be set up using `geiser-connect-local' when a REPL is started.")
(forward-line)
(when (> (point) geiser-repl--last-output-start)
(set-marker geiser-repl--last-output-start (point)))))
- (> (- geiser-repl--last-output-end geiser-repl--last-output-start) 2)))
+ (>= (- geiser-repl--last-output-end geiser-repl--last-output-start) 2)))
(defun geiser-repl--treat-output-region ()
(with-silent-modifications
@@ -533,13 +585,24 @@ will be set up using `geiser-connect-local' when a REPL is started.")
(geiser--font-lock-ensure geiser-repl--last-output-start
geiser-repl--last-output-end)))
+(defsubst geiser-repl--prompt-rx ()
+ (or (geiser-con--connection-prompt geiser-repl--connection) "\\b\\B"))
+
+(defsubst geiser-repl--debug-prompt-rx ()
+ (or (geiser-con--connection-debug-prompt geiser-repl--connection) "\\b\\B"))
+
+(defun geiser-repl--matches-prompt-p (txt)
+ (and (stringp txt)
+ (or (string-match-p (geiser-repl--prompt-rx) txt)
+ (string-match-p (geiser-repl--debug-prompt-rx) txt))))
+
(defun geiser-repl--output-filter (txt)
(when (geiser-repl--find-output-region) (geiser-repl--treat-output-region))
(geiser-con--connection-update-debugging geiser-repl--connection txt)
(geiser-image--replace-images geiser-repl-inline-images-p
geiser-repl-auto-display-images-p)
- (when (string-match-p (geiser-con--connection-prompt geiser-repl--connection)
- txt)
+ (when (geiser-repl--matches-prompt-p txt)
+ (geiser-con--connection-activate geiser-repl--connection)
(geiser-autodoc--disinhibit-autodoc)))
(defun geiser-repl--check-version (impl)
@@ -552,12 +615,12 @@ will be set up using `geiser-connect-local' when a REPL is started.")
(defvar geiser-repl--last-scm-buffer)
(defun geiser-repl--set-default-directory ()
- (when-let (root (funcall geiser-repl-current-project-function))
+ (when-let* ((root (funcall geiser-repl-current-project-function)))
(setq-local default-directory root)))
(defun geiser-repl--set-up-load-path ()
(when geiser-repl-add-project-paths
- (when-let (root (funcall geiser-repl-current-project-function))
+ (when-let* ((root (funcall geiser-repl-current-project-function)))
(dolist (p (cond ((eq t geiser-repl-add-project-paths) '("."))
((listp geiser-repl-add-project-paths)
geiser-repl-add-project-paths)))
@@ -697,14 +760,16 @@ will be set up using `geiser-connect-local' when a REPL is started.")
"Send CMD input string to the current REPL buffer.
If SAVE-HISTORY is non-nil, save CMD in the REPL history."
(when (and cmd (eq major-mode 'geiser-repl-mode))
- (geiser-repl--prepare-send)
- (goto-char (point-max))
- (comint-kill-input)
- (insert cmd)
- (let ((comint-input-filter (if save-history
- comint-input-filter
- 'ignore)))
- (comint-send-input nil t))))
+ (if (geiser-eval--pending-requests-p)
+ (message "Waiting for scheme process...")
+ (geiser-repl--prepare-send)
+ (goto-char (point-max))
+ (comint-kill-input)
+ (insert cmd)
+ (let ((comint-input-filter (if save-history
+ comint-input-filter
+ 'ignore)))
+ (comint-send-input nil t)))))
(defun geiser-repl-interrupt ()
(interactive)
@@ -751,8 +816,8 @@ If SAVE-HISTORY is non-nil, save CMD in the REPL history."
(when (buffer-live-p geiser-repl--connection-buffer)
(kill-buffer geiser-repl--connection-buffer)
(setq geiser-repl--connection-buffer nil)
- (when-let (a (geiser-repl--connection-address
- geiser-impl--implementation))
+ (when-let* ((a (geiser-repl--connection-address
+ geiser-impl--implementation)))
(delete-file a))))
(dolist (buffer (buffer-list))
(when (buffer-live-p buffer)
@@ -803,17 +868,21 @@ If SAVE-HISTORY is non-nil, save CMD in the REPL history."
;;; geiser-repl-autoeval-mode minor mode:
-(defun geiser-repl--autoeval-paren-function ()
- (let* ((data (show-paren--default))
- (here (nth 0 data))
- (there (nth 2 data))
- (mismatch (nth 4 data)))
- (if (and here
- (eq 0 (geiser-repl--nesting-level))
- (not mismatch)
- (> here there))
- (geiser-repl--send-input))
- data))
+(defun geiser-repl--autoeval-paren-function (show-paren-enabled)
+ (lambda ()
+ (let* ((data (show-paren--default))
+ (here (nth 0 data))
+ (there (nth 2 data))
+ (mismatch (nth 4 data)))
+ (if (and (= (point) (point-max))
+ here
+ (eq 0 (geiser-repl--nesting-level))
+ (not mismatch)
+ (> here there))
+ (progn (geiser-repl--send-input)
+ ;; Don't highlight if we're doing an autoeval.
+ nil)
+ (and show-paren-enabled data)))))
(defvar-local geiser-repl-autoeval-mode-string " E"
"Modeline indicator for geiser-repl-autoeval-mode")
@@ -825,20 +894,19 @@ Non-null prefix argument turns on the mode.
Null prefix argument turns off the mode.
When Autoeval mode is enabled, balanced S-expressions are automatically
-evaluated without having to press ENTER.
-
-This mode may cause issues with structural editing modes such as paredit."
+evaluated without having to press ENTER."
:init-value nil
:lighter geiser-repl-autoeval-mode-string
:group 'geiser-repl
- (if (boundp 'show-paren-data-function)
- (if geiser-repl-autoeval-mode
- (progn (show-paren-local-mode 1)
- (setq-local show-paren-delay geiser-repl-autoeval-mode-delay)
- (setq-local show-paren-data-function
- 'geiser-repl--autoeval-paren-function))
- (setq-local show-paren-data-function 'show-paren--default)))
+ (if geiser-repl-autoeval-mode
+ (let ((show-paren-enabled show-paren-mode))
+ (progn (show-paren-local-mode 1)
+ (setq-local show-paren-delay geiser-repl-autoeval-mode-delay)
+ (setq-local show-paren-data-function
+ (geiser-repl--autoeval-paren-function
+ show-paren-enabled))))
+ (setq-local show-paren-data-function 'show-paren--default))
(when (called-interactively-p nil)
(message "Geiser Autoeval %s"
(if geiser-repl-autoeval-mode "enabled" "disabled"))))
@@ -849,7 +917,12 @@ This mode may cause issues with structural editing modes such as paredit."
(defun geiser-repl--superparen-function ()
(when (char-equal (char-before) geiser-repl-superparen-character)
(delete-char -1)
- (insert-char ?\) (geiser-repl--nesting-level))))
+ (let ((level (geiser-repl--nesting-level)))
+ (if (memq nil (mapcar (lambda (idx)
+ (= (char-after idx) ?\)))
+ (number-sequence (point) (- (+ (point) level) 1))))
+ (insert-char ?\) level)
+ (forward-char level)))))
(defvar-local geiser-repl-superparen-mode-string " S"
"Modeline indicator for geiser-repl-superparen-mode")
@@ -1092,7 +1165,7 @@ buffer."
(geiser-repl-autoeval-mode 1))
(when geiser-repl-superparen-mode-p
(geiser-repl-superparen-mode 1))
-
+ (add-hook 'comint-preoutput-filter-functions #'geiser--strip-ansi nil t)
;; enabling compilation-shell-minor-mode without the annoying highlighter
(compilation-setup t))
@@ -1136,7 +1209,7 @@ over a Unix-domain socket."
(or geiser-repl--arglist (geiser-repl--arglist impl)))
(defun geiser-repl--call-in-repl (cmd)
- (when-let (b (geiser-repl--repl/impl geiser-impl--implementation))
+ (when-let* ((b (geiser-repl--repl/impl geiser-impl--implementation)))
(save-window-excursion
(with-current-buffer b (funcall cmd)))))
diff --git a/elisp/geiser-syntax.el b/elisp/geiser-syntax.el
index dbbf9e5..1dc42cc 100644
--- a/elisp/geiser-syntax.el
+++ b/elisp/geiser-syntax.el
@@ -1,6 +1,6 @@
-;;; geiser-syntax.el -- utilities for parsing scheme syntax -*- lexical-binding: t; -*-
+;;; geiser-syntax.el --- Utilities for parsing scheme syntax -*- lexical-binding: t; -*-
-;; Copyright (C) 2009-2016, 2019-2022 Jose Antonio Ortega Ruiz
+;; Copyright (C) 2009-2016, 2019-2022, 2026 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
@@ -194,7 +194,7 @@ implementation-specific entries for font-lock-keywords.")
(defun geiser-syntax--read/ex-symbol () ;; #{foo bar}# style symbols
(let ((tk (geiser-syntax--read/matching "{" "}")))
- (when-let (c (geiser-syntax--read/next-char))
+ (when-let* ((c (geiser-syntax--read/next-char)))
(when (char-equal ?\# c)
(geiser-syntax--read/next-char)
(cons 'atom (make-symbol (format "#{%s}#" tk)))))))
@@ -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-table.el b/elisp/geiser-table.el
index 619d563..dc3925b 100644
--- a/elisp/geiser-table.el
+++ b/elisp/geiser-table.el
@@ -1,4 +1,4 @@
-;;; geiser-table.el -- table creation -*- lexical-binding: t; -*-
+;;; geiser-table.el --- Table creation -*- lexical-binding: t; -*-
;; Copyright (C) 2009, 2010, 2012 Jose Antonio Ortega Ruiz
diff --git a/elisp/geiser-xref.el b/elisp/geiser-xref.el
index 0726d62..aa64f17 100644
--- a/elisp/geiser-xref.el
+++ b/elisp/geiser-xref.el
@@ -1,4 +1,4 @@
-;;; geiser-xref.el -- utilities for cross-referencing -*- lexical-binding: t; -*-
+;;; geiser-xref.el --- Utilities for cross-referencing -*- lexical-binding: t; -*-
;; Copyright (C) 2009, 2010, 2012, 2022 Jose Antonio Ortega Ruiz
@@ -24,6 +24,7 @@
;;; Customization:
+
(defgroup geiser-xref nil
"Options for cross-referencing commands."
:group 'geiser)
@@ -60,7 +61,7 @@
;;; Ref button:
-(define-button-type 'geiser-xref--button
+(define-button-type 'geiser-xref
'action 'geiser-xref--button-action
'face 'geiser-font-lock-xref-link
'follow-link t)
@@ -84,7 +85,7 @@
(insert " - ")
(if (stringp file)
(insert-text-button signature-txt
- :type 'geiser-xref--button
+ :type 'geiser-xref
'location location
'name (car signature)
'help-echo (format "%s in %s"
diff --git a/elisp/geiser.el b/elisp/geiser.el
index 837a9d5..bb41a8c 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-2026 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.30
+;; Version: 0.33.2
;;; Commentary:
@@ -54,7 +54,8 @@
;;; Locations:
;;;###autoload
-(defconst geiser-elisp-dir (file-name-directory load-file-name)
+(defconst geiser-elisp-dir
+ (file-name-directory (or load-file-name buffer-file-name))
"Directory containing Geiser's Elisp files.")
@@ -108,6 +109,7 @@
(custom-add-load group (symbol-name group))
(custom-add-load 'geiser (symbol-name group)))
'(geiser
+ geiser-edit
geiser-repl
geiser-autodoc
geiser-doc
generated by cgit v1.2.3 (git 2.46.0) at 2026-09-16 05:21:03 +0000