Re: Three Flymake backends Was Re: Two issues with the new Flymake

[João Távora]

Stefan Monnier <address@hidden> writes:

> FWIW, I think we can install those backends into emacs-26, and later
> consolidate them in `master`.

That's my idea too.

> Also using a macro like you did makes it difficult to debug/edebug the
> common code.  Better move that common code into a function.

Sure, of course, what I proposed was just a quick draft. Sorry if I
passed the idea that I wanted a full review. I mostly wanted how
something like this could simplify the backends.

>>   (defvar-local flymake--simple-backend-procs
>>     (make-hash-table))
>
> You never `setq` this var, so it will behave like a global var.
> More specifically, a single hash-table is used for all buffers, which
> I believe is not what you intended.

Yep, that's a bug. Thanks.

>>   (defmacro flymake-define-simple-backend (name command pattern &optional 
>> type-predicate)
>>     "Define a simple Flymake backend under NAME.
>
> I had to look at the code to understand what you meant by "under NAME".
>
Then it wasn't such a bad idea haha :-)

>>   PATTERN must evaluate to a list of the form (REGEXP LINE COLUMN
>>   TYPE MESSAGE): if REGEXP matches, the LINE'th subexpression gives
>>   the line number, the COLUMN'th subexpression gives the column
>>   number on that line, the TYPE'th subexpression gives the type of
>>   the message and the MESSAGE'th gives the message text itself.
>
> Line numbers are reasonably standardized, but column numbers aren't.
> Some tools start counting from 0 others from 1, some count bytes, others
> count chars, yet others count actual "visual" columns.  `compile.el` has
> added some vars to control this, but it's rather messy.  So we should
> make it possible to provide code which does the conversion to whatever
> we use.
>
> Maybe it would also make sense to try and support message which include
> both the BEG and the END.
>
> Rather than `type-predicate`, I'd rather just allow `type` to be a function.
> Also it'd probably make sense to allow the type returned by that
> function to be nil in which case we should just skip the match
> (i.e. not create a diagnostic for it).

All this makes sense, but what could also be done is just use
compile.el. All the code we're talking about has been written before. We
should just let compile.el do the parsing. I have a prototype of this
with a few changes to compile.el that I attach as a prelimiary
patch. I'm still using a lot of compile.el internals that would have to
be exported somehow.

Obviously, the advantage is that writing a backend for a language that
compile.el already supports would become as easy as:

  (flymake-define-simple-backend
   language-flymake
   language-tool-command-that-supports-stdin
   '(language)
   "stdin")

It *almost* works. It might be slow, didn't measure. And for the moment
is particularly naive when looking for the compilation message text and
perl, for example, fools it because the message text comes before the
link. But the big problem that I haven't been able to to debug, is that
when invoked in this barebones manner, compile.el leaves all the
compilation messages at same type, so everything's an error in C code,
for example.

>>     (let ((name-once name))
>
> I must say I don't get what this <foo>-once business is about.
> What is `-once` supposed to mean?  What did you need it for?

name-once was probably a brainf*rt but the others are so that do don't
evaluate the form passed to the macro more than once, because it can be
something with side-effects. Nevermind, it goes away once you use the
function anyway.

>> +  (add-hook 'flymake-diagnostic-functions 'perl-flymake nil t))
>                                            #'

I did this for consistency of style with the rest of Emacs because I'd
never seen #' in add-hooks before, but now I see a few, though the vast
majority doesn't have it. Also I have a (probably misguided) tendency to
think of function objects as stuff that isn't quite as `eq' as symbols
interned somewhere, so not so good for lists you might want to `delq'
later..

João

So the patch here. Notice that in flymake.el I take the opportunity to
tidy up and move some functions around.

diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 0794830fcb..ca5b27acb4 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -533,7 +533,7 @@ compilation-error-regexp-alist-alist
   "Alist of values for `compilation-error-regexp-alist'.")
 
 (defcustom compilation-error-regexp-alist
-  (mapcar 'car compilation-error-regexp-alist-alist)
+  (mapcar 'car compilation-error-regexp-alist-alist))
   "Alist that specifies how to match errors in compiler output.
 On GNU and Unix, any string is a valid filename, so these
 matchers must make some common sense assumptions, which catch
@@ -1228,34 +1228,34 @@ compilation-internal-error-properties
                (if (local-variable-p 'compilation-first-column)
                    compilation-first-column first-column)))
           (save-excursion
-         (save-restriction
-           (widen)
-           (goto-char (marker-position marker))
-           ;; Set end-marker if appropriate and go to line.
-           (if (not (or end-col end-line))
-               (compilation-beginning-of-line (- line marker-line -1))
-             (compilation-beginning-of-line (- (or end-line line)
-                                                marker-line -1))
-             (if (or (null end-col) (< end-col 0))
-                 (end-of-line)
-               (compilation-move-to-column end-col screen-columns))
-             (setq end-marker (point-marker))
-             (when end-line
-                (compilation-beginning-of-line (- line end-line -1))))
-           (if col
-               (compilation-move-to-column col screen-columns)
-             (forward-to-indentation 0))
-           (setq marker (point-marker)))))))
+           (save-restriction
+             (widen)
+             (goto-char (marker-position marker))
+             ;; Set end-marker if appropriate and go to line.
+             (if (not (or end-col end-line))
+                 (compilation-beginning-of-line (- line marker-line -1))
+               (compilation-beginning-of-line (- (or end-line line)
+                                                  marker-line -1))
+               (if (or (null end-col) (< end-col 0))
+                   (end-of-line)
+                 (compilation-move-to-column end-col screen-columns))
+               (setq end-marker (point-marker))
+               (when end-line
+                  (compilation-beginning-of-line (- line end-line -1))))
+             (if col
+                 (compilation-move-to-column col screen-columns)
+               (forward-to-indentation 0))
+             (setq marker (point-marker)))))))
 
     (setq loc (compilation-assq line (compilation--file-struct->loc-tree
                                       file-struct)))
     (setq end-loc
-    (if end-line
+          (if end-line
               (compilation-assq
                end-col (compilation-assq
                         end-line (compilation--file-struct->loc-tree
                                   file-struct)))
-      (if end-col                      ; use same line element
+            (if end-col                        ; use same line element
                 (compilation-assq end-col loc))))
     (setq loc (compilation-assq col loc))
     ;; If they are new, make the loc(s) reference the file they point to.
@@ -1275,17 +1275,16 @@ compilation-internal-error-properties
            (setcdr end-loc
                     (compilation--make-cdrloc (or end-line line) file-struct
                                               end-marker))))
-
     ;; Must start with face
     `(font-lock-face ,compilation-message-face
-      compilation-message ,(compilation--make-message loc type end-loc)
-      help-echo ,(if col
-                     "mouse-2: visit this file, line and column"
-                   (if line
-                       "mouse-2: visit this file and line"
-                     "mouse-2: visit this file"))
-      keymap compilation-button-map
-      mouse-face highlight)))
+                     compilation-message ,(compilation--make-message loc type 
end-loc)
+                     help-echo ,(if col
+                                    "mouse-2: visit this file, line and column"
+                                  (if line
+                                      "mouse-2: visit this file and line"
+                                    "mouse-2: visit this file"))
+                     keymap compilation-button-map
+                     mouse-face highlight)))
 
 (defun compilation--put-prop (matchnum prop val)
   (when (and (integerp matchnum) (match-beginning matchnum))
@@ -2480,6 +2479,38 @@ compilation-find-buffer
       (current-buffer)
     (next-error-find-buffer avoid-current 'compilation-buffer-internal-p)))
 
+;;;###autoload
+(defun compilation-compute-loc (loc)
+  "Compute the actual marker for LOC once in its target buffer.
+LOC represents a location of the error message, and is an object
+of the kind extracted with `compilation--message->loc' or
+`compilation--message->end-loc'."
+  (let ((last 1))
+    (save-excursion
+      (save-restriction
+        (widen)
+        (goto-char (point-min))
+        ;; Treat file's found lines in forward order, 1 by 1.
+        (dolist (line (reverse (cddr (compilation--loc->file-struct loc))))
+          (when (car line)             ; else this is a filename w/o a line#
+            (compilation-beginning-of-line (- (car line) last -1))
+            (setq last (car line)))
+          ;; Treat line's found columns and store/update a marker for each.
+          (dolist (col (cdr line))
+            (if (compilation--loc->col col)
+                (if (eq (compilation--loc->col col) -1)
+                    ;; Special case for range end.
+                    (end-of-line)
+                  (compilation-move-to-column (compilation--loc->col col)
+                                              
compilation-error-screen-columns))
+              (beginning-of-line)
+              (skip-chars-forward " \t"))
+            (if (compilation--loc->marker col)
+                (set-marker (compilation--loc->marker col) (point))
+              (setf (compilation--loc->marker col) (point-marker)))
+            ;; (setf (compilation--loc->timestamp col) timestamp)
+            ))))))
+
 ;;;###autoload
 (defun compilation-next-error-function (n &optional reset)
   "Advance to the next error message and visit the file where the error was.
@@ -2489,7 +2520,6 @@ compilation-next-error-function
     (setq compilation-current-error nil))
   (let* ((screen-columns compilation-error-screen-columns)
         (first-column compilation-first-column)
-        (last 1)
         (msg (compilation-next-error (or n 1) nil
                                      (or compilation-current-error
                                          compilation-messages-start
@@ -2499,9 +2529,9 @@ compilation-next-error-function
         (marker (point-marker)))
     (setq compilation-current-error (point-marker)
          overlay-arrow-position
-           (if (bolp)
-               compilation-current-error
-             (copy-marker (line-beginning-position))))
+         (if (bolp)
+             compilation-current-error
+           (copy-marker (line-beginning-position))))
     ;; If loc contains no marker, no error in that file has been visited.
     ;; If the marker is invalid the buffer has been killed.
     ;; So, recalculate all markers for that file.
@@ -2525,37 +2555,18 @@ compilation-next-error-function
                  (cadr (car (compilation--loc->file-struct loc)))
                  (compilation--file-struct->formats
                   (compilation--loc->file-struct loc)))
-        (let ((screen-columns
+        (let ((compilation-error-screen-columns
                ;; Obey the compilation-error-screen-columns of the target
                ;; buffer if its major mode set it buffer-locally.
+               ;;
+               ;; Why is this necessary, shouldn't just accessing the
+               ;; variable do the same indirection? -- address@hidden
                (if (local-variable-p 'compilation-error-screen-columns)
                    compilation-error-screen-columns screen-columns))
               (compilation-first-column
                (if (local-variable-p 'compilation-first-column)
                    compilation-first-column first-column)))
-          (save-restriction
-            (widen)
-            (goto-char (point-min))
-            ;; Treat file's found lines in forward order, 1 by 1.
-            (dolist (line (reverse (cddr (compilation--loc->file-struct loc))))
-              (when (car line)         ; else this is a filename w/o a line#
-                (compilation-beginning-of-line (- (car line) last -1))
-                (setq last (car line)))
-              ;; Treat line's found columns and store/update a marker for each.
-              (dolist (col (cdr line))
-                (if (compilation--loc->col col)
-                    (if (eq (compilation--loc->col col) -1)
-                        ;; Special case for range end.
-                        (end-of-line)
-                      (compilation-move-to-column (compilation--loc->col col)
-                                                  screen-columns))
-                  (beginning-of-line)
-                  (skip-chars-forward " \t"))
-                (if (compilation--loc->marker col)
-                    (set-marker (compilation--loc->marker col) (point))
-                  (setf (compilation--loc->marker col) (point-marker)))
-                ;; (setf (compilation--loc->timestamp col) timestamp)
-                ))))))
+          (compilation-compute-loc loc))))
     (compilation-goto-locus marker (compilation--loc->marker loc)
                             (compilation--loc->marker end-loc))
     (setf (compilation--loc->visited loc) t)))
diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el
index 1048bc5065..23a935481c 100644
--- a/lisp/progmodes/flymake.el
+++ b/lisp/progmodes/flymake.el
@@ -218,27 +218,6 @@ flymake-error
                (:constructor flymake--diag-make))
   buffer beg end type text backend)
 
-;;;###autoload
-(defun flymake-make-diagnostic (buffer
-                                beg
-                                end
-                                type
-                                text)
-  "Make a Flymake diagnostic for BUFFER's region from BEG to END.
-TYPE is a key to `flymake-diagnostic-types-alist' and TEXT is a
-description of the problem detected in this region."
-  (flymake--diag-make :buffer buffer :beg beg :end end :type type :text text))
-
-;;;###autoload
-(defun flymake-diagnostics (&optional beg end)
-  "Get Flymake diagnostics in region determined by BEG and END.
-
-If neither BEG or END is supplied, use the whole buffer,
-otherwise if BEG is non-nil and END is nil, consider only
-diagnostics at BEG."
-  (mapcar (lambda (ov) (overlay-get ov 'flymake-diagnostic))
-          (flymake--overlays :beg beg :end end)))
-
 (defmacro flymake--diag-accessor (public internal thing)
   "Make PUBLIC an alias for INTERNAL, add doc using THING."
   `(defsubst ,public (diag)
@@ -305,45 +284,6 @@ flymake-note
 (define-obsolete-face-alias 'flymake-warnline 'flymake-warning "26.1")
 (define-obsolete-face-alias 'flymake-errline 'flymake-error "26.1")
 
-;;;###autoload
-(defun flymake-diag-region (buffer line &optional col)
-  "Compute BUFFER's region (BEG . END) corresponding to LINE and COL.
-If COL is nil, return a region just for LINE.  Return nil if the
-region is invalid."
-  (condition-case-unless-debug _err
-      (with-current-buffer buffer
-        (let ((line (min (max line 1)
-                         (line-number-at-pos (point-max) 'absolute))))
-          (save-excursion
-            (goto-char (point-min))
-            (forward-line (1- line))
-            (cl-flet ((fallback-bol
-                       () (progn (back-to-indentation) (point)))
-                      (fallback-eol
-                       (beg)
-                       (progn
-                         (end-of-line)
-                         (skip-chars-backward " \t\f\t\n" beg)
-                         (if (eq (point) beg)
-                             (line-beginning-position 2)
-                           (point)))))
-              (if (and col (cl-plusp col))
-                  (let* ((beg (progn (forward-char (1- col))
-                                     (point)))
-                         (sexp-end (ignore-errors (end-of-thing 'sexp)))
-                         (end (or (and sexp-end
-                                       (not (= sexp-end beg))
-                                       sexp-end)
-                                  (ignore-errors (goto-char (1+ beg)))))
-                         (safe-end (or end
-                                       (fallback-eol beg))))
-                    (cons (if end beg (fallback-bol))
-                          safe-end))
-                (let* ((beg (fallback-bol))
-                       (end (fallback-eol beg)))
-                  (cons beg end)))))))
-    (error (flymake-error "Invalid region line=%s col=%s" line col))))
-
 (defvar flymake-diagnostic-functions nil
   "Special hook of Flymake backends that check a buffer.
 
@@ -1193,6 +1133,213 @@ flymake-show-diagnostics-buffer
       (revert-buffer)
       (display-buffer (current-buffer)))))
 
+
+;;; Utility functions (API)
+;;;
+;;;###autoload
+(defun flymake-diag-region (buffer line &optional col)
+  "Compute BUFFER's region (BEG . END) corresponding to LINE and COL.
+If COL is nil, return a region just for LINE.  Return nil if the
+region is invalid."
+  (condition-case-unless-debug _err
+      (with-current-buffer buffer
+        (let ((line (min (max line 1)
+                         (line-number-at-pos (point-max) 'absolute))))
+          (save-excursion
+            (goto-char (point-min))
+            (forward-line (1- line))
+            (cl-flet ((fallback-bol
+                       () (progn (back-to-indentation) (point)))
+                      (fallback-eol
+                       (beg)
+                       (progn
+                         (end-of-line)
+                         (skip-chars-backward " \t\f\t\n" beg)
+                         (if (eq (point) beg)
+                             (line-beginning-position 2)
+                           (point)))))
+              (if (and col (cl-plusp col))
+                  (let* ((beg (progn (forward-char (1- col))
+                                     (point)))
+                         (sexp-end (ignore-errors (end-of-thing 'sexp)))
+                         (end (or (and sexp-end
+                                       (not (= sexp-end beg))
+                                       sexp-end)
+                                  (ignore-errors (goto-char (1+ beg)))))
+                         (safe-end (or end
+                                       (fallback-eol beg))))
+                    (cons (if end beg (fallback-bol))
+                          safe-end))
+                (let* ((beg (fallback-bol))
+                       (end (fallback-eol beg)))
+                  (cons beg end)))))))
+    (error (flymake-error "Invalid region line=%s col=%s" line col))))
+
+;;;###autoload
+(defun flymake-make-diagnostic (buffer
+                                beg
+                                end
+                                type
+                                text)
+  "Make a Flymake diagnostic for BUFFER's region from BEG to END.
+TYPE is a key to `flymake-diagnostic-types-alist' and TEXT is a
+description of the problem detected in this region."
+  (flymake--diag-make :buffer buffer :beg beg :end end :type type :text text))
+
+;;;###autoload
+(defun flymake-diagnostics (&optional beg end)
+  "Get Flymake diagnostics in region determined by BEG and END.
+
+If neither BEG or END is supplied, use the whole buffer,
+otherwise if BEG is non-nil and END is nil, consider only
+diagnostics at BEG."
+  (mapcar (lambda (ov) (overlay-get ov 'flymake-diagnostic))
+          (flymake--overlays :beg beg :end end)))
+
+;;;###autoload
+(defun flymake-compilation-to-diagnostics (source-buffer
+                                           &optional
+                                           compilation-alist-symbols
+                                           buffer-filename-alias)
+  "Search current buffer for compiler diagnostics for SOURCE-BUFFER.
+BUFFER-FILENAME-ALIAS is a regular expression matching the
+filename component of those compilation messages that pertain
+exclusively to SOURCE-BUFFER.  If nil, the string \"<stdin>\" is
+used, since it is a relatively of compilers to output this string
+when checking content passed to their standard inputs.
+
+COMPILATION-ALIST-SYMBOLS is a list of symbols used to index
+`compilation-error-regexp-alist-alist' (which see) and thus
+specifying the error patterns to look for. If nil, a large (and
+slow) collection of symbols is used."
+  (set (make-local-variable 'compilation-locs)
+       (make-hash-table :test 'equal :weakness 'value))
+  (apply #'compilation-parse-errors (point-min) (point-max)
+         (or compilation-alist-symbols
+             (cl-remove-if-not #'symbolp
+                               compilation-error-regexp-alist)))
+  (let ((next (point-min))
+        (regexp (or buffer-filename-alias "<stdin>"))
+        retval)
+
+    ;; HACK the case where property starts right away and we don't
+    ;; want to skip it.
+    (goto-char (point-min)) (insert "\n")
+    (while (setq next
+                 (next-single-property-change next 'compilation-message))
+      (let ((message (get-text-property next 'compilation-message)))
+        (when message
+          (let* (;; This wont work with perl, the
+                 ;; message appears before the link. 
+                 (message-text (buffer-substring
+                                (goto-char
+                                 (setq
+                                  next
+                                  (next-single-property-change
+                                   next 'compilation-message)))
+                                (line-end-position)))
+                 (beg-loc (compilation--message->loc message))
+                 (end-loc (compilation--message->end-loc message))
+                 (file-spec
+                  (compilation--file-struct->file-spec
+                   (compilation--loc->file-struct beg-loc))))
+            (when (string-match
+                   regexp
+                   (car file-spec))
+              (with-current-buffer source-buffer
+                (compilation-compute-loc beg-loc)
+                (when end-loc
+                  (compilation-compute-loc end-loc))
+                (push
+                 (flymake-make-diagnostic source-buffer
+                                          (compilation--loc->marker beg-loc)
+                                          (if end-loc
+                                              (compilation--loc->marker 
end-loc)
+                                            (1+ (compilation--loc->marker 
beg-loc)))
+                                          (assoc-default
+                                           (compilation--message->type message)
+                                           '((0 . :note)
+                                             (1 . :warning)
+                                             (2 . :error)))
+                                          message-text)
+                 retval))))
+          )
+        ))
+    retval))
+
+;;;###autoload
+(defmacro flymake-define-simple-backend (name
+                                         command
+                                         compilation-alist-symbols
+                                         buffer-filename-alias)
+  "Define a simple Flymake backend named NAME.
+This backend runs the COMMAND syntax tool, passes the current
+buffer contents to its standard input, and uses library
+compile.el to examine the output and look for diagnostic
+messages.
+
+BUFFER-FILENAME-ALIAS is a regular expression matching the
+filename component of those compilation messages that pertain
+exclusively to SOURCE-BUFFER.  If nil, the string \"<stdin>\" is
+used, since it is a relatively of compilers to output this string
+when checking content passed to their standard inputs.
+
+COMPILATION-ALIST-SYMBOLS is a list of symbols used to index
+`compilation-error-regexp-alist-alist' (which see) and thus
+specifying the error patterns to look for. If nil, a large (and
+slow) collection of symbols is used. It can also be a pattern"
+  `(defun ,name (report-fn &rest _args)
+     "A Flymake backend defined with
+  `flymake-define-simple-backend'."
+     (flymake--simple-backend-1 ',name
+                                ,command
+                                ,compilation-alist-symbols
+                                ,buffer-filename-alias
+                                report-fn)))
+
+(defun flymake--simple-backend-1 (name command
+                                       compilation-alist-symbols
+                                       buffer-filename-alias
+                                       report-fn)
+  "Help `flymake-define-simple-backend'."
+  (let* ((process (gethash name flymake--simple-backend-procs))
+         (source (current-buffer)))
+    (unless (executable-find (car command))
+      (error "Cannot find a suitable checker"))
+    (when (process-live-p process)
+      (kill-process process))
+    (save-restriction
+      (widen)
+      (setq
+       process
+       (puthash
+        name
+        (make-process
+         :name (symbol-name name) :noquery t :connection-type 'pipe
+         :buffer (generate-new-buffer
+                  (format " *simple backend %s*" name))
+         :command command
+         :sentinel
+         (lambda (proc _event)
+           (when (eq 'exit (process-status proc))
+             (unwind-protect
+                 (if (with-current-buffer source
+                       (eq proc
+                           (gethash name flymake--simple-backend-procs)))
+                     (with-current-buffer (process-buffer proc)
+                       (funcall
+                        report-fn
+                        (flymake-compilation-to-diagnostics
+                         source
+                         compilation-alist-symbols
+                         buffer-filename-alias)))
+                   (flymake-log :debug "Canceling obsolete check %s"
+                                proc))
+               (display-buffer (process-buffer proc))))))
+        flymake--simple-backend-procs))
+      (process-send-region process (point-min) (point-max))
+      (process-send-eof process))))
+
 (provide 'flymake)
 
 (require 'flymake-proc)