From eca49ccec53882720d3d20172b2c35c315a7ebeb Mon Sep 17 00:00:00 2001 From: Timo Wilken Date: Mon, 30 Oct 2023 23:36:22 +0100 Subject: Fix and enable Guile flymake checker --- tw/home/files/emacs-init.el | 5 ++ tw/home/files/emacs-packages/flymake-guile.el | 68 ++++++++++++++++----------- 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 -- cgit v1.2.3