Fix and enable Guile flymake checker

2 files changed, 46 insertions, 27 deletions

diff --git a/tw/home/files/emacs-init.el b/tw/home/files/emacs-init.el
index ddc2bb20..0e8d2049 100644
--- a/tw/home/files/emacs-init.el
+++ b/tw/home/files/emacs-init.el
@@ -631,6 +631,11 @@ For use in `org-latex-classes'."
   :commands (alidist-mode)
   :mode (rx (or bot "/") "alidist/" (1+ (not ?\/)) ".sh" eot))
 
+(use-package flymake-guile
+  :after (flymake)
+  :load-path "include/"
+  :hook (scheme-mode . flymake-guile-enable))
+
 (use-package bemscript-mode
   :load-path "include/"
   :mode (rx ".bem" eos))
diff --git a/tw/home/files/emacs-packages/flymake-guile.el b/tw/home/files/emacs-packages/flymake-guile.el
index 2d2a65a0..a482cf18 100644
--- a/tw/home/files/emacs-packages/flymake-guile.el
+++ b/tw/home/files/emacs-packages/flymake-guile.el
@@ -4,28 +4,31 @@
 ;;; warnings.  Let's use this as a linter!
 ;;; Code:
 
+(require 'custom)
+(require 'flymake)
+(require 'geiser-impl)   ; for `geiser-active-implementations'
+
 (defcustom flymake-guile-guild-executable "guild"
   "The guild executable to use.  This will be looked up in $PATH."
   :type '(string)
   :risky t
   :group 'flymake-guile)
 
-(defvar flymake-guile--message-regexp
-  (rx bol (group (+? not-newline)) ":"     ; filename
-      (group (+ digit)) ":"                ; line
-      (group (+ digit)) ": "               ; column
-      (group (or "warning" "error")) ": "  ; type
-      (group (+ not-newline)) eol)         ; message
-  "Regular expression matching messages from guild compile.
-`flymake-guile' expects the following capturing groups in this regexp: (1)
-file name; (2) line number; (3) column number; (4) error type; (5) message.")
-
 (defvar-local flymake-guile--flymake-proc nil
   "The latest invocation of guild compile.")
 
 (defvar-local flymake-guile--temp-file nil
   "The temporary file name to pass to guild.")
 
+(defun flymake-guile--encode-filename (buffer-name)
+  "Create a safe temporary file name from BUFFER-NAME."
+  (concat "/tmp/flymake-guile-"
+          (string-replace
+           "/" "!"   ; we don't want to create subdirs under /tmp
+           (or buffer-name
+               (format "temp-%s.scm"
+                       (random most-positive-fixnum))))))
+
 ;; See info node: (flymake)An annotated example backend.
 (defun flymake-guile (report-fn &rest _args)
   "Run guild compile and report diagnostics from it using REPORT-FN.
@@ -36,21 +39,16 @@ Any running invocations are killed before running another one."
     (error "Cannot find guild executable"))
 
   (unless flymake-guile--temp-file
-    (setq-local
-     flymake-guile--temp-file
-     (concat "/tmp/flymake-guile-"
-             (string-replace
-              "/" "!"   ; we don't want to create subdirs under /tmp
-              (or (buffer-file-name)
-                  (format "temp-%s.scm"
-                          (random most-positive-fixnum)))))))
+    (setq-local flymake-guile--temp-file (flymake-guile--encode-filename (buffer-file-name))))
 
   ;; Kill previous check, if it's still running.
   (when (process-live-p flymake-guile--flymake-proc)
     (kill-process flymake-guile--flymake-proc))
 
   ;; This needs `lexical-binding'.
-  (let ((source (current-buffer)))
+  (let ((source (current-buffer))
+        ;; Copy `flymake-guile--temp-file' to a local var so that we can refer to it in the `lambda' below.
+        (temp-file flymake-guile--temp-file))
     (save-restriction
       (widen)
       ;; Send the buffer to guild on stdin.
@@ -62,7 +60,11 @@ Any running invocations are killed before running another one."
              ;; Direct output to a temporary buffer.
              :buffer (generate-new-buffer " *flymake-guile*")
              ;; Guild can't read from stdin; it needs a file.
-             :command (list flymake-guile-guild-executable "compile" "-W3" flymake-guile--temp-file)
+             :command (list flymake-guile-guild-executable "compile" "-W3"
+                            "-L" (expand-file-name
+                                  (project-root (project-current nil (file-name-directory
+                                                                      (buffer-file-name source)))))
+                            flymake-guile--temp-file)
              :sentinel
              (lambda (proc _event)
                "Parse diagnostic messages once the process PROC has exited."
@@ -74,22 +76,34 @@ Any running invocations are killed before running another one."
                          (with-current-buffer (process-buffer proc)
                            (goto-char (point-min))
                            (cl-loop
-                            while (search-forward-regexp flymake-guile--message-regexp nil t)
+                            with msg-regexp = (rx bol (literal temp-file) ":"          ; filename
+                                                  (group (+ digit)) ":"                ; line
+                                                  (group (+ digit)) ": "               ; column
+                                                  (group (or "warning" "error")) ": "  ; type
+                                                  (group (+ not-newline)) eol)         ; message
+                            while (search-forward-regexp msg-regexp nil t)
                             for (beg . end) = (flymake-diag-region
-                                               (match-string 1)  ; source
-                                               (string-to-number (match-string 2))
-                                               (string-to-number (match-string 3)))
-                            for type = (pcase (match-string 4)
+                                               source   ; we filter for messages matching our buffer in the regexp
+                                               (string-to-number (match-string 1))
+                                               (string-to-number (match-string 2)))
+                            for type = (pcase (match-string 3)
                                          ("warning" :warning)
                                          ("error" :error)
                                          (type (error "Unknown guild error type %s" type)))
-                            collect (flymake-make-diagnostic source beg end type (match-string 5))
+                            collect (flymake-make-diagnostic source beg end type (match-string 4))
                             into diags
                             finally (funcall report-fn diags)))
                        (flymake-log :warning "Canceling obsolete check %s" proc))
                    ;; Clean up temporary buffer.
                    (kill-buffer (process-buffer proc))
-                   (delete-file flymake-guile--temp-file)))))))))
+                   (delete-file temp-file)))))))))
+
+(defun flymake-guile-enable ()
+  "Set up the Guile checker for flymake, if in a Guile buffer."
+  (when (memq 'guile geiser-active-implementations)
+    (add-hook 'flymake-diagnostic-functions #'flymake-guile nil t)))
+
+(add-hook 'scheme-mode-hook #'flymake-guile-enable)
 
 (provide 'flymake-guile)
 ;;; flymake-guile.el ends here