From 2a876c2250c6d5fbf3bddd051c5b6711c5a3ac28 Mon Sep 17 00:00:00 2001
From: Timo Wilken
Date: Thu, 19 Jan 2023 23:52:38 +0100
Subject: Add prototype of guile flymake linter

---
 tw/home/files/emacs-packages/flymake-guile.el | 95 +++++++++++++++++++++++++++
 1 file changed, 95 insertions(+)
 create mode 100644 tw/home/files/emacs-packages/flymake-guile.el

(limited to 'tw/home')

diff --git a/tw/home/files/emacs-packages/flymake-guile.el b/tw/home/files/emacs-packages/flymake-guile.el
new file mode 100644
index 00000000..2d2a65a0
--- /dev/null
+++ b/tw/home/files/emacs-packages/flymake-guile.el
@@ -0,0 +1,95 @@
+;;; flymake-guile.el --- Flymake checker using `guild compile'  -*- lexical-binding: t -*-
+;;; Commentary:
+;;; "guild compile" compiles Guile code to bytecode and can output a few basic
+;;; warnings.  Let's use this as a linter!
+;;; Code:
+
+(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.")
+
+;; 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.
+Any running invocations are killed before running another one."
+  (unless (executable-find flymake-guile-guild-executable)
+    (funcall report-fn :panic
+             :explanation "Cannot find `flymake-guile-guild-executable' program")
+    (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)))))))
+
+  ;; 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)))
+    (save-restriction
+      (widen)
+      ;; Send the buffer to guild on stdin.
+      (with-temp-file flymake-guile--temp-file
+        (insert-buffer-substring-no-properties source))
+      (setq flymake-guile--flymake-proc
+            (make-process
+             :name "flymake-guild" :noquery t :connection-type 'pipe
+             ;; 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)
+             :sentinel
+             (lambda (proc _event)
+               "Parse diagnostic messages once the process PROC has exited."
+               ;; Check the process has actually exited, not just been suspended.
+               (when (memq (process-status proc) '(exit signal))
+                 (unwind-protect
+                     ;; Only proceed if we've got the "latest" process.
+                     (if (with-current-buffer source (eq proc flymake-guile--flymake-proc))
+                         (with-current-buffer (process-buffer proc)
+                           (goto-char (point-min))
+                           (cl-loop
+                            while (search-forward-regexp flymake-guile--message-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)
+                                         ("warning" :warning)
+                                         ("error" :error)
+                                         (type (error "Unknown guild error type %s" type)))
+                            collect (flymake-make-diagnostic source beg end type (match-string 5))
+                            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)))))))))
+
+(provide 'flymake-guile)
+;;; flymake-guile.el ends here
-- 
cgit v1.2.3