summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--doc/geiser.texi6
-rw-r--r--doc/install.texi6
-rw-r--r--doc/macros.texi12
-rw-r--r--doc/parens.texi2
-rw-r--r--doc/repl.texi12
-rw-r--r--doc/thanks.texi4
-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
-rw-r--r--news.org43
-rw-r--r--readme.org33
31 files changed, 456 insertions, 257 deletions
diff --git a/doc/geiser.texi b/doc/geiser.texi
index 29166d8..ea27717 100644
--- a/doc/geiser.texi
+++ b/doc/geiser.texi
@@ -8,7 +8,7 @@
@copying
This manual documents Geiser, an Emacs environment to hack in Scheme.
-Copyright @copyright{} 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2018, 2020, 2021 Jose Antonio Ortega Ruiz
+Copyright @copyright{} 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2018, 2020, 2021, 2026 Jose Antonio Ortega Ruiz
@quotation
Permission is granted to copy, distribute and/or modify this document
@@ -103,8 +103,8 @@ Cheat sheet
@html
<br/>
<div class="navigation" align="right">
-<a class="navlink" href="https://gitlab.com/groups/emacs-geiser/-/issues">Bugs</a>&nbsp;&nbsp;&nbsp;&nbsp;
-<a class="navlink" href="https://gitlab.com/emacs-geiser">Source</a>&nbsp;&nbsp;&nbsp;&nbsp;
+<a class="navlink" href="https://codeberg.org/org/geiser/issues">Bugs</a>&nbsp;&nbsp;&nbsp;&nbsp;
+<a class="navlink" href="https://codeberg.org/geiser">Source</a>&nbsp;&nbsp;&nbsp;&nbsp;
<a class="navlink" href="http://lists.nongnu.org/mailman/listinfo/geiser-users">Mailing list</a>&nbsp;
</div>
@end html
diff --git a/doc/install.texi b/doc/install.texi
index b6eb030..0675af9 100644
--- a/doc/install.texi
+++ b/doc/install.texi
@@ -19,16 +19,16 @@ recent Emacs snapshot) and at least one of the supported Schemes,
namely:
@itemize @bullet
+@gsupimpl{GNU Kawa, http://www.gnu.org/software/kawa/index.html, 3.1, kawa}
+@gsupimpl{Gauche, http://practical-scheme.net/gauche/, 0.9.6, gauche}
+@gsupimpl{Stklos, https://stklos.net/, 1.50, stklos}
@supimpl{Chez, http://www.scheme.com, 9.4,chez}
@supimpl{Chibi, http://synthcode.com/scheme/chibi, 0.7.3,chibi}
@supimpl{Chicken, http://call-cc.org, 4.8.0, chicken}
@supimpl{Gambit, http://gambitscheme.org/wiki/index.php/Main_Page, 4.9.3, gambit}
-@supimpl{Gauche, http://practical-scheme.net/gauche/, 0.9.6, gauche}
@supimpl{Guile, http://www.gnu.org/software/guile, 2.2, guile}
-@supimpl{GNU Kawa, http://www.gnu.org/software/kawa/index.html, 3.1, kawa}
@supimpl{MIT/GNU Scheme, https://www.gnu.org/software/mit-scheme, 9.0, mit}
@supimpl{Racket, http://www.racket-lang.org, 7.0, racket}
-@supimpl{Stklos, https://stklos.net/, 1.50, stklos}
@end itemize
Since Geiser supports multiple REPLs, having all of them will just add
diff --git a/doc/macros.texi b/doc/macros.texi
index c218dff..b1f99cd 100644
--- a/doc/macros.texi
+++ b/doc/macros.texi
@@ -1,11 +1,17 @@
-@set VERSION 0.20
+@set VERSION 0.33
@set VERSION_NICK
-@set RELEASE_DATE December 2021
-@set EMACS_VERSION 24.4
+@set RELEASE_DATE May 2025
+@set EMACS_VERSION 27.1
+@set CODEBERG https://codeberg.org/geiser/
@set GITLAB https://gitlab.com/emacs-geiser/
@macro supimpl{NAME,URL,VERS,NM}
@item
+@uref{\URL\, \NAME\} \VERS\ or better, via @uref{@value{CODEBERG}\NM\, geiser-\NM\}
+@end macro
+
+@macro gsupimpl{NAME,URL,VERS,NM}
+@item
@uref{\URL\, \NAME\} \VERS\ or better, via @uref{@value{GITLAB}\NM\, geiser-\NM\}
@end macro
diff --git a/doc/parens.texi b/doc/parens.texi
index 82c2e2c..b4c6319 100644
--- a/doc/parens.texi
+++ b/doc/parens.texi
@@ -99,7 +99,7 @@ for you to first call @code{geiser}
(or @ref{choosing-impl,,one of its variants}),
@end ifhtml
@ifnothtml
-(or one of its variants, e.g. @code{run-guile}),
+(or one of its variants, e.g. @code{geiser-guile}),
@end ifnothtml
and then open some Scheme files;
but there's nothing wrong in first opening a couple Scheme buffers and
diff --git a/doc/repl.texi b/doc/repl.texi
index 01a0a18..a522a82 100644
--- a/doc/repl.texi
+++ b/doc/repl.texi
@@ -382,12 +382,12 @@ some related tips.
Instead of using the generic @command{geiser} command, you can directly
start your Scheme of choice using any of the following commands:
@itemize @bullet
-@item @command{run-racket}
-@item @command{run-guile}
-@item @command{run-chicken}
-@item @command{run-mit}
-@item @command{run-chibi}
-@item @command{run-chez}
+@item @command{geiser-racket}
+@item @command{geiser-guile}
+@item @command{geiser-chicken}
+@item @command{geiser-mit}
+@item @command{geiser-chibi}
+@item @command{geiser-chez}
@end itemize
@anchor{active-implementations} In addition, the
variable @code{geiser-active-implementations} contains a list of those
diff --git a/doc/thanks.texi b/doc/thanks.texi
index 14eae9b..856afad 100644
--- a/doc/thanks.texi
+++ b/doc/thanks.texi
@@ -78,8 +78,8 @@ gmane.lisp.scheme.geiser}.
@item
@cindex bug tracker
You can submit bug reports either to the mailing list or to
-@uref{https://gitlab.com/groups/emacs-geiser/-/issues, our bug tracker} over at
-Gitlab.
+@uref{https://codeberg.org/org/geiser/issues, our bug tracker} over at
+Codeberg.
@item
@cindex IRC channel
The Freenode IRC channel @i{#geiser} is the Geiserati's meeting point in
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
diff --git a/news.org b/news.org
index c5f88c6..144fe05 100644
--- a/news.org
+++ b/news.org
@@ -1,7 +1,48 @@
-* Version 0.31 (unreleased)
+
+* Version 0.33.2 (Aug 10, 2026)
+
+ - Fix for chicken repl.
+
+* Version 0.33.1 (May 23, 2026)
+
+ - Fix: no evaluations sent to REPLs that are waiting for input (e.g.,
+ because a call to =read=).
+
+* Version 0.33 (May 3, 2026)
+
+ - Project migrated to codeberg.org: https://codeberg.org/geiser
+ - New geiser-repl-classify-output-p flag that enables classification of REPL
+ outputs as error/warning/success with customizable faces
+ (geiser-repl-output-*). Thanks, Lorenzo.
+ - Fix completion for local variadic args (thanks, rvs314).
+ - Fix for company code locations (thanks, Daniel).
+ - Fix race condition between REPL and background evaluations (thanks, Ian).
+ - Fix for ansi escapes in connected REPLs (thanks, ewhispers and martian
+ hiauts).
+
+* Version 0.32 (August 10, 2024)
+
+ - REPL: Fix for highlighting of 2-character input prompts (thanks to Macon
+ Gambill)
+
+ - REPL autoeval mode improvements (thanks to Anter Mejr):
+ - Autoeval just once
+ - Stop paren highlighting after autoevaluations
+ - 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
+
+* Version 0.31 (May 23, 2024)
- New custom variable geiser-insert-actual-lambda
- Non-existent geiser-version function removed from autoloads
+ - New customization group: geiser-edit
+ - Debug logging improvements
* Version 0.30 (December 15, 2023)
diff --git a/readme.org b/readme.org
index 7145d2a..ce2cf27 100644
--- a/readme.org
+++ b/readme.org
@@ -1,3 +1,9 @@
+#+html: <p align=right>
+#+html: <a href="http://elpa.nongnu.org/nongnu/geiser.html"><img alt="NonGNU Elpa" src="http://elpa.nongnu.org/nongnu/geiser.svg"/> </a>
+#+html: <a href="http://elpa.nongnu.org/nongnu-devel/geiser.html"><img alt="NonGNU Devel Elpa" src="http://elpa.nongnu.org/nongnu-devel/geiser.svg"/></a>
+#+html: <a href="https://melpa.org/#/geiser"><img alt="MELPA" src="https://melpa.org/packages/geiser-badge.svg"/></a>
+#+html: </p>
+
* Overview
Geiser is a generic Emacs/Scheme interaction mode, featuring an
@@ -33,15 +39,15 @@
The following schemes are supported via an independent package,
installable from either NonGNU ELPA or MELPA:
- - Chez 9.4 or better, via [[https://gitlab.com/emacs-geiser/chez][geiser-chez]]
- - Chibi 0.7.3 or better, via [[https://gitlab.com/emacs-geiser/chibi][geiser-chibi]]
- - Chicken 4.8.0 or better, via [[https://gitlab.com/emacs-geiser/chicken][geiser-chicken]]
- - Gambit 4.9.3 or better, via [[https://gitlab.com/emacs-geiser/gambit][geiser-gambit]]
+ - Chez 9.4 or better, via [[https://codeberg.org/geiser/chez][geiser-chez]]
+ - Chibi 0.7.3 or better, via [[https://codeberg.org/geiser/chibi][geiser-chibi]]
+ - Chicken 4.8.0 or better, via [[https://codeberg.org/geiser/chicken][geiser-chicken]]
+ - Gambit 4.9.3 or better, via [[https://codeberg.org/geiser/gambit][geiser-gambit]]
- Gauche 0.9.6 or better, via [[https://gitlab.com/emacs-geiser/gauche][geiser-gauche]]
- - Guile 2.2 or better, via [[https://gitlab.com/emacs-geiser/guile][geiser-guile]]
+ - Guile 2.2 or better, via [[https://codeberg.org/geiser/guile][geiser-guile]]
- Kawa 3.1, via [[https://gitlab.com/emacs-geiser/kawa][geiser-kawa]]
- - MIT/GNU Scheme, via [[https://gitlab.com/emacs-geiser/mit][geiser-mit]]
- - Racket 6.0 or better, via [[https://gitlab.com/emacs-geiser/racket][geiser-racket]]
+ - MIT/GNU Scheme, via [[https://codeberg.org/geiser/mit][geiser-mit]]
+ - Racket 6.0 or better, via [[https://codeberg.org/geiser/racket][geiser-racket]]
- Stklos 1.50, via [[https://gitlab.com/emacs-geiser/stklos][geiser-stklos]]
* Installation
@@ -118,7 +124,7 @@
* Quick key reference
- (See also [[http://geiser.nongnu.org/geiser_5.html#Cheat-sheet][the user's manual cheat sheet]]')
+ (See also [[https://geiser.nongnu.org/Cheat-sheet.html#Cheat-sheet][the user's manual cheat sheet]]')
** In Scheme buffers:
@@ -214,7 +220,7 @@
To see what elisp functions one needs to implement, just execute the
command `M-x geiser-implementation-help` inside emacs with a recent
version of geiser installed. And then take a look at, say,
- [[https://gitlab.com/emacs-geiser/guile/-/blob/master/geiser-guile.el][geiser-guile.el]] for examples of how those functions are implemented
+ [[https://codeberg.org/geiser/guile/src/branch/master/geiser-guile.el][geiser-guile.el]] for examples of how those functions are implemented
for concrete schemes.
Not all schemes can provide introspective information to implement all
@@ -222,3 +228,12 @@
leave as many functions unimplemented as you see fit (there is even an
explicit list of unsupported features), and geiser will still know how
to use the ones that are implemented.
+
+* Contributing
+*** Generative AI (LLMs)
+
+ Use of generative AI (LLMs, diffusion models and similar technology) is not
+ acceptable for contributions to or interactions with the geiser project.
+
+ This includes words, images and code, as well as bug reports, commit
+ messages, email (mailing list or private) and IRC messages.