Re: New Flymake rewrite in emacs-26

[joaotavora@gmail.com (João Távora)]

joaotavora@gmail.com (João Távora) writes:

> No, I was aiming for something more generic that includes at least Emacs
> and perhaps other GNU projects.

FWIW, here's what I hacked up so far. Seems to work OK in two GNU
projects: Emacs and Hello (after ./configure, of course).

Probably flawed, but it's a start. Feedback welcome. To test, just load
this file and M-x flymake-mode in a C file.

Another option, as suggested previously, is to have a special Makefile
target (that'll need reconfiguring for each project, though).

João

;;; flymake-gcc.el --- naive gcc Flymake backend -*- lexical-binding: t; -*-

(defvar flymake-gcc-program "gcc"
  "GCC program")

(defun flymake--gcc-heroic-unescape (string)
  (with-temp-buffer
    (let ((error-buffer (current-buffer)))
      (with-temp-buffer
        (cond
         ((zerop
           ;; I suspect "shell-command" makes windows even when called
           ;; from lisp.
           (save-window-excursion
             (shell-command
              (format
               "%s -Q --batch --eval \"%s\" -- %s"
               (expand-file-name invocation-name
                                 invocation-directory)
               "(mapc 'print (nthcdr 4 command-line-args))"
               string)
              (current-buffer)
              error-buffer)))
          (goto-char (point-min))
          (cl-loop with eof = (make-symbol "eof")
                   for form =
                   (condition-case _err
                       (read (current-buffer))
                     (error eof))
                   while (not (eq form eof))
                   collect form))
         (t
          (with-current-buffer error-buffer
            (error (buffer-string)))))))))

(defvar flymake-gcc-flags 'flymake-gcc-guess-flags
  "A list of flags passed to GCC.
Alternatively, a symbol naming a function called with no
arguments that should produce this list of flags, or error if it
cannot do so.")

(defvar flymake-gcc-extra-flags '("-Wextra" "-Wall")
  "A list of extra flags passed to GCC.")

(defvar-local flymake--gcc-cached-flags nil
  "Internal variable for `flymake-gcc-guess-flags'")

(defun flymake-gcc-guess-flags (&optional trash-cache)
  "Guess GCC flags for compiling current buffer "
  (interactive "P")
  (unless (executable-find "make") (error "Cannot find a suitable make"))
  (when trash-cache (setq flymake--gcc-cached-flags nil))
  (catch 'retval
    (unless (buffer-file-name)
      ;; don't error and don't cache, so that when the buffer is saved
      ;; we get another chance.
      (throw 'retval nil))
    (when-let* ((makefile-dir
                 (locate-dominating-file default-directory "Makefile"))
                (makefile (expand-file-name "Makefile" makefile-dir))
                (mtime (file-attribute-modification-time
                        (file-attributes makefile))))
      (cond
       ((equal (list makefile mtime)
               (cdr flymake--gcc-cached-flags))
        (when (called-interactively-p 'interactive)
          (message "cached hit for flags for this buffer: %s"
                   (car flymake--gcc-cached-flags)))
        (throw 'retval (car flymake--gcc-cached-flags)))
       (t
        (let*
            ((sans-nothing
              (file-name-nondirectory
               (file-name-sans-extension
                (buffer-file-name))))
             (blob (shell-command-to-string
                    (format "make -C %s -f %s --just-print %s.o"
                            makefile-dir
                            makefile
                            sans-nothing)))
             (match (string-match
                     (format "gcc[[:space:]]+\\(\\(?:-.*\\)*\\)%s"
                             sans-nothing)
                     blob))
             (flag-string (and match
                               (match-string 1 blob)))
             (flags (and flag-string
                         (flymake--gcc-heroic-unescape flag-string))))
          (when (or flags (string= "" flag-string))
            (setq flymake--gcc-cached-flags (list flags makefile mtime))
            (when (called-interactively-p 'interactive)
              (message "cached miss for flags for this buffer: %s" flags))
            (throw 'retval flags))))))
    (error "Could not guess gcc flags")))


(defvar-local flymake--gcc-proc nil
  "Internal variable for `flymake-gcc'")

(defun flymake-gcc (report-fn &rest _args)
  "Flymake backend for GCC"
  (unless (executable-find flymake-gcc-program)
    (error "Cannot find a suitable gcc"))
  (when (process-live-p flymake--gcc-proc)
    (kill-process flymake--gcc-proc))
  (let ((source (current-buffer)))
    (save-restriction
      (widen)
      (setq flymake--gcc-proc
            (make-process
             :name "gcc-flymake"
             :buffer (generate-new-buffer "*gcc-flymake*")
             :command `(,flymake-gcc-program
                        "-fsyntax-only"
                        ,@flymake-gcc-extra-flags
                        ,@(if (symbolp flymake-gcc-flags)
                              (funcall flymake-gcc-flags)
                            flymake-gcc-flags)
                        "-x" "c" "-")
             :noquery t :connection-type 'pipe
             :sentinel
             (lambda (p _ev)
               (when (eq 'exit (process-status p))
                 (unwind-protect
                     (when (eq p flymake--gcc-proc)
                       (with-current-buffer (process-buffer p)
                         (goto-char (point-min))
                         (cl-loop
                          while (search-forward-regexp
                                 "^<stdin>:\\([0-9]+\\):\\([0-9]+\\): \\(.*\\): \\(.*\\)$"
                                 nil t)
                          for msg = (match-string 4)
                          for (beg . end) =
                          (flymake-diag-region
                           source
                           (string-to-number (match-string 1))
                           (string-to-number (match-string 2)))
                          for type = (assoc-default
                                      (match-string 3)
                                      '(("error" . :error)
                                        ("note" . :note)
                                        ("warning" . :warning))
                                      #'string-match)
                          collect (flymake-make-diagnostic source beg end type msg)
                          into diags
                          finally (funcall report-fn diags))))
                   ;; (display-buffer (process-buffer p)) ; use this instead of the next one for debug
                   (kill-buffer (process-buffer p))
                   ))
               )))
      (process-send-region flymake--gcc-proc (point-min) (point-max))
      (process-send-eof flymake--gcc-proc))))

(defun flymake--setup-gcc-flymake ()
  (add-hook 'flymake-diagnostic-functions 'flymake-gcc nil t))

(add-hook 'c-mode-hook 'flymake--setup-gcc-flymake)

;;; flymake-gcc.el ends here