Tweak geiser configuration and add flycheck-guile

modules/lang/scheme/autoload.el

@@ -50,8 +50,8 @@ lists properly and names starting with 'default'."
                (funcall method state indent-point normal-indent)))))))
 
 ;;;###autoload
-(defun +scheme/open-repl (&optional arg)
+(defun +scheme/open-repl ()
   "Open the Scheme REPL."
-  (interactive "P")
-  (switch-to-geiser arg)
+  (interactive)
+  (call-interactively #'switch-to-geiser)
   (current-buffer))

modules/lang/scheme/autoload/flycheck-guile.el

@@ -0,0 +1,71 @@
+;;; flycheck-guile --- Checker for guile using guild -*- lexical-binding: t; -*-
+
+;; NOTE: This checker was initially borrowed from guile-studio:
+;; https://git.elephly.net/software/guile-studio.git
+
+(defvar flycheck-guile-warnings
+  '(;"unsupported-warning"         ; warn about unknown warning types
+    "unused-variable"             ; report unused variables
+    "unused-toplevel"             ; report unused local top-level variables
+    ;"shadowed-toplevel"           ; report shadowed top-level variables
+    "unbound-variable"            ; report possibly unbound variables
+    "macro-use-before-definition" ; report possibly mis-use of macros before they are defined
+    "arity-mismatch"              ; report procedure arity mismatches (wrong number of arguments)
+    "duplicate-case-datum"        ; report a duplicate datum in a case expression
+    "bad-case-datum"              ; report a case datum that cannot be meaningfully compared using `eqv?'
+    "format"                      ; report wrong number of arguments to `format'
+    )
+  "A list of warnings to enable for `guild compile'.
+
+The value of this variable is a list of strings, where each string names a
+supported warning type.
+
+The list of supported warning types can be found by running
+`guild compile -W help'.")
+
+(flycheck-define-checker guile
+  "A Guile syntax checker using `guild compile'."
+  :command ("guild" "compile" "--to=cps"
+            (option-list "-W" flycheck-guile-warnings)
+            (option-list "-L" geiser-guile-load-path list expand-file-name)
+            source)
+  :predicate
+  (lambda ()
+    (and (boundp 'geiser-impl--implementation)
+         (eq geiser-impl--implementation 'guile)))
+  :verify
+  (lambda (checker)
+    (let ((geiser-impl (bound-and-true-p geiser-impl--implementation)))
+      (list
+       (flycheck-verification-result-new
+        :label "Geiser Implementation"
+        :message (cond
+                  ((eq geiser-impl 'guile) "Guile")
+                  (geiser-impl (format "Other: %s" geiser-impl))
+                  (t "Geiser not active"))
+        :face (cond
+               ((or (eq geiser-impl 'guile)) 'success)
+               (t '(bold error)))))))
+  :error-patterns
+  ((warning
+    line-start
+    (file-name) ":" line ":" column ": warning:" (message) line-end)
+   (error
+    line-start
+    "ice-9/boot-9.scm:" (+ digit) ":" (+ digit) ":" (+ (any space "\n"))
+    "In procedure raise-exception:"                 (+ (any space "\n"))
+    "In procedure " (id (+ (not ":"))) ":"          (+ (any space "\n"))
+    (file-name) ":" line ":" column ":" (message (+? anything)) (* space) string-end)
+   (error
+    line-start
+    "ice-9/boot-9.scm:" (+ digit) ":" (+ digit) ":" (+ (any space "\n"))
+    "In procedure raise-exception:"                 (+ (any space "\n"))
+    (id (+ (not ":"))) ":"                          (+ (any space "\n"))
+    (file-name) ":" line ":" column ":" (message (+? anything)) (* space) string-end)
+   (error
+    line-start
+    (file-name) ":" line ":" column ":" (message (+? anything)) (* space) string-end)
+   )
+  :modes (scheme-mode geiser-mode))
+
+(add-to-list 'flycheck-checkers 'guile)

modules/lang/scheme/config.el

@@ -9,6 +9,7 @@
   :hook (scheme-mode . geiser-mode)
   :init
   (setq geiser-active-implementations '(guile chicken mit chibi chez)
+        geiser-autodoc-identifier-format "%s → %s"
         geiser-smart-tab-p t)
   (unless (featurep! :lang racket)
     (push 'racket geiser-active-implementations))
@@ -18,10 +19,16 @@
     (set-lookup-handlers! 'scheme-mode
       :definition #'geiser-edit-symbol-at-point
       :documentation #'geiser-doc-symbol-at-point))
+  (when (featurep! :checkers syntax)
+    (after! flycheck
+      (load! "autoload/flycheck-guile")))
   :config
   (set-popup-rules!
-    '(("\\*[Gg]eiser \\(?:[Mm]essages\\|DBG\\|Xref\\)\\*" :quit nil)
-      ( "\\* [A-Za-z0-9_-]+ REPL \\*" :quit nil)))
+    '(("^\\*geiser messages\\*$" :slot 1 :vslot -1)
+      ("^\\*Geiser dbg\\*$"      :slot 1 :vslot -1)
+      ("^\\*Geiser xref\\*$"     :slot 1 :vslot -1)
+      ("^\\*Geiser documentation\\*$" :slot 2 :vslot 2 :select t :size 0.35)
+      ("^\\* [A-Za-z0-9_-]+ REPL \\*$" :quit nil :ttl nil)))
   (map! :localleader
         :map scheme-mode-map
         "'"  #'geiser-mode-switch-to-repl