(defun flymake-elisp-checkdoc (report-fn)
"A flymake backend for `checkdoc'.
Calls REPORT-FN directly."
- (when (derived-mode-p 'emacs-lisp-mode)
- (funcall report-fn
- (cl-loop for (text start end _unfixable) in
- (flymake-elisp--checkdoc-1)
- collect
- (flymake-make-diagnostic
- (current-buffer)
- start end :note text)))))
+ (unless (derived-mode-p 'emacs-lisp-mode)
+ (error "Can only work on `emacs-lisp-mode' buffers"))
+ (funcall report-fn
+ (cl-loop for (text start end _unfixable) in
+ (flymake-elisp--checkdoc-1)
+ collect
+ (flymake-make-diagnostic
+ (current-buffer)
+ start end :note text))))
(defun flymake-elisp--byte-compile-done (report-fn
origin-buffer
(kill-buffer output-buffer)
(ignore-errors (delete-file temp-file))))
+(defvar-local flymake-elisp--byte-compile-process nil
+ "Buffer-local process started for byte-compiling the buffer.")
+
(defun flymake-elisp-byte-compile (report-fn)
- "A flymake backend for elisp byte compilation.
+ "A Flymake backend for elisp byte compilation.
Spawn an Emacs process that byte-compiles a file representing the
current buffer state and calls REPORT-FN when done."
(interactive (list (lambda (stuff)
(message "aha %s" stuff))))
- (when (derived-mode-p 'emacs-lisp-mode)
- (let ((temp-file (make-temp-file "flymake-elisp-byte-compile"))
- (origin-buffer (current-buffer)))
- (save-restriction
- (widen)
- (write-region (point-min) (point-max) temp-file nil 'nomessage))
- (let* ((output-buffer (generate-new-buffer " *flymake-elisp-byte-compile*")))
- (make-process
- :name "flymake-elisp-byte-compile"
- :buffer output-buffer
- :command (list (expand-file-name invocation-name invocation-directory)
- "-Q"
- "--batch"
- ;; "--eval" "(setq load-prefer-newer t)" ; for testing
- "-L" default-directory
- "-l" "flymake-elisp"
- "-f" "flymake-elisp--batch-byte-compile"
- temp-file)
- :connection-type 'pipe
- :sentinel
- (lambda (proc _event)
- (unless (process-live-p proc)
- (flymake-elisp--byte-compile-done report-fn
- origin-buffer
- output-buffer
- temp-file))))
- :stderr null-device
- :noquery t))))
+ (unless (derived-mode-p 'emacs-lisp-mode)
+ (error "Can only work on `emacs-lisp-mode' buffers"))
+ (when flymake-elisp--byte-compile-process
+ (process-put flymake-elisp--byte-compile-process 'flymake-elisp--obsolete t)
+ (when (process-live-p flymake-elisp--byte-compile-process)
+ (kill-process flymake-elisp--byte-compile-process)))
+ (let ((temp-file (make-temp-file "flymake-elisp-byte-compile"))
+ (origin-buffer (current-buffer)))
+ (save-restriction
+ (widen)
+ (write-region (point-min) (point-max) temp-file nil 'nomessage))
+ (let* ((output-buffer (generate-new-buffer " *flymake-elisp-byte-compile*")))
+ (setq
+ flymake-elisp--byte-compile-process
+ (make-process
+ :name "flymake-elisp-byte-compile"
+ :buffer output-buffer
+ :command (list (expand-file-name invocation-name invocation-directory)
+ "-Q"
+ "--batch"
+ ;; "--eval" "(setq load-prefer-newer t)" ; for testing
+ "-L" default-directory
+ "-l" "flymake-elisp"
+ "-f" "flymake-elisp--batch-byte-compile"
+ temp-file)
+ :connection-type 'pipe
+ :sentinel
+ (lambda (proc _event)
+ (unless (process-live-p proc)
+ (unwind-protect
+ (cond
+ ((zerop (process-exit-status proc))
+ (flymake-elisp--byte-compile-done report-fn
+ origin-buffer
+ output-buffer
+ temp-file))
+ ((process-get proc 'flymake-elisp--obsolete)
+ (flymake-log 3 "proc %s considered obsolete" proc))
+ (t
+ (funcall report-fn
+ :panic
+ :explanation (format "proc %s died violently" proc)))))))))
+ :stderr null-device
+ :noquery t)))
(defun flymake-elisp--batch-byte-compile (&optional file)
"Helper for `flymake-elisp-byte-compile'.
(const :tag "flymake-proc-get-real-file-name" nil)
function))))
-(defvar-local flymake-proc--process nil
+(defvar-local flymake-proc--current-process nil
"Currently active flymake process for a buffer, if any.")
-(defvar flymake-proc--processes nil
- "List of currently active flymake processes.")
-
(defvar flymake-proc--report-fn nil
"If bound, function used to report back to flymake's UI.")
"Parse STRING and collect diagnostics info."
(flymake-log 3 "received %d byte(s) of output from process %d"
(length string) (process-id proc))
- (let ((output-buffer (process-get proc 'flymake-proc--output-buffer))
- (flymake-proc--report-fn
- (process-get proc 'flymake-proc--report-fn)))
+ (let ((output-buffer (process-get proc 'flymake-proc--output-buffer)))
(when (and (buffer-live-p (process-buffer proc))
output-buffer)
(with-current-buffer output-buffer
(defun flymake-proc--process-sentinel (proc _event)
"Sentinel for syntax check buffers."
- (when (memq (process-status proc) '(signal exit))
- (let* ((exit-status (process-exit-status proc))
- (command (process-command proc))
- (source-buffer (process-buffer proc))
- (flymake-proc--report-fn (process-get proc
- 'flymake-proc--report-fn))
- (cleanup-f (flymake-proc--get-cleanup-function
- (buffer-file-name source-buffer)))
- (diagnostics (process-get
- proc
- 'flymake-proc--collected-diagnostics))
- (interrupted (process-get proc 'flymake-proc--interrupted))
- (panic nil)
- (output-buffer (process-get proc 'flymake-proc--output-buffer)))
- (flymake-log 2 "process %d exited with code %d"
- (process-id process) exit-status)
- (condition-case-unless-debug err
- (progn
- (flymake-log 3 "cleaning up using %s" cleanup-f)
- (with-current-buffer source-buffer
- (funcall cleanup-f)
- (cond ((equal 0 exit-status)
- (funcall flymake-proc--report-fn diagnostics))
- (interrupted
- (flymake-proc--panic :stopped interrupted))
- (diagnostics
- ;; non-zero exit but some diagnostics is quite
- ;; normal...
- (funcall flymake-proc--report-fn diagnostics))
- ((null diagnostics)
- ;; ...but no diagnostics is strange, so panic.
- (setq panic t)
- (flymake-proc--panic
- :configuration-error
- (format "Command %s errored, but no diagnostics"
- command))))))
- (delete-process proc)
- (setq flymake-proc--processes
- (delq proc flymake-proc--processes))
- (if panic
- (flymake-log 1 "Output buffer %s kept alive for debugging"
- output-buffer)
- (kill-buffer output-buffer))))))
+ (let (debug
+ (pid (process-id proc))
+ (source-buffer (process-buffer proc)))
+ (unwind-protect
+ (when (buffer-live-p source-buffer)
+ (with-current-buffer source-buffer
+ (cond ((process-get proc 'flymake-proc--obsolete)
+ (flymake-log 3 "proc %s considered obsolete"
+ pid))
+ ((process-get proc 'flymake-proc--interrupted)
+ (flymake-log 3 "proc %s interrupted by user"
+ pid))
+ ((not (process-live-p proc))
+ (let* ((exit-status (process-exit-status proc))
+ (command (process-command proc))
+ (diagnostics (process-get
+ proc
+ 'flymake-proc--collected-diagnostics)))
+ (flymake-log 2 "process %d exited with code %d"
+ pid exit-status)
+ (cond
+ ((equal 0 exit-status)
+ (funcall flymake-proc--report-fn diagnostics
+ :explanation (format "a gift from %s" (process-id proc))
+ ))
+ (diagnostics
+ ;; non-zero exit but some diagnostics is quite
+ ;; normal...
+ (funcall flymake-proc--report-fn diagnostics
+ :explanation (format "a gift from %s" (process-id proc))))
+ ((null diagnostics)
+ ;; ...but no diagnostics is strange, so panic.
+ (setq debug debug-on-error)
+ (flymake-proc--panic
+ :configuration-error
+ (format "Command %s errored, but no diagnostics"
+ command)))))))))
+ (let ((output-buffer (process-get proc 'flymake-proc--output-buffer)))
+ (cond (debug
+ (flymake-log 3 "Output buffer %s kept alive for debugging"
+ output-buffer))
+ (t
+ (when (buffer-live-p source-buffer)
+ (with-current-buffer source-buffer
+ (let ((cleanup-f (flymake-proc--get-cleanup-function
+ (buffer-file-name))))
+ (flymake-log 3 "cleaning up using %s" cleanup-f)
+ (funcall cleanup-f))))
+ (kill-buffer output-buffer)))))))
(defun flymake-proc--panic (problem explanation)
"Tell flymake UI about a fatal PROBLEM with this backend.
diags
(append args '(:force t))))
t))
- (cond
- ((process-live-p flymake-proc--process)
- (when interactive
- (user-error
- "There's already a flymake process running in this buffer")))
- ((and buffer-file-name
- ;; Since we write temp files in current dir, there's no point
- ;; trying if the directory is read-only (bug#8954).
- (file-writable-p (file-name-directory buffer-file-name))
- (or (not flymake-proc-compilation-prevents-syntax-check)
- (not (flymake-proc--compilation-is-running))))
- (let ((init-f (flymake-proc--get-init-function buffer-file-name)))
- (unless init-f (error "Can find a suitable init function"))
- (flymake-proc--clear-buildfile-cache)
- (flymake-proc--clear-project-include-dirs-cache)
-
- (let* ((flymake-proc--report-fn report-fn)
- (cleanup-f (flymake-proc--get-cleanup-function buffer-file-name))
- (cmd-and-args (funcall init-f))
- (cmd (nth 0 cmd-and-args))
- (args (nth 1 cmd-and-args))
- (dir (nth 2 cmd-and-args)))
- (cond ((not cmd-and-args)
- (progn
- (flymake-log 0 "init function %s for %s failed, cleaning up"
- init-f buffer-file-name)
- (funcall cleanup-f)))
- (t
- (setq flymake-last-change-time nil)
- (flymake-proc--start-syntax-check-process cmd
- args
- dir)
- t)))))))
+ (let ((proc flymake-proc--current-process)
+ (flymake-proc--report-fn report-fn))
+ (when (processp proc)
+ (process-put proc 'flymake-proc--obsolete t)
+ (flymake-log 3 "marking %s obsolete" (process-id proc))
+ (when (process-live-p proc)
+ (when interactive
+ (user-error
+ "There's already a flymake process running in this buffer")
+ (kill-process proc))))
+ (when
+ ;; A number of situations make us not want to error right away
+ ;; (and disable ourselves), in case the situation changes in
+ ;; the near future.
+ (and buffer-file-name
+ ;; Since we write temp files in current dir, there's no point
+ ;; trying if the directory is read-only (bug#8954).
+ (file-writable-p (file-name-directory buffer-file-name))
+ (or (not flymake-proc-compilation-prevents-syntax-check)
+ (not (flymake-proc--compilation-is-running))))
+ (let ((init-f (flymake-proc--get-init-function buffer-file-name)))
+ (unless init-f (error "Can find a suitable init function"))
+ (flymake-proc--clear-buildfile-cache)
+ (flymake-proc--clear-project-include-dirs-cache)
+
+ (let* ((cleanup-f (flymake-proc--get-cleanup-function buffer-file-name))
+ (cmd-and-args (funcall init-f))
+ (cmd (nth 0 cmd-and-args))
+ (args (nth 1 cmd-and-args))
+ (dir (nth 2 cmd-and-args))
+ (success nil))
+ (unwind-protect
+ (cond
+ ((not cmd-and-args)
+ (flymake-log 0 "init function %s for %s failed, cleaning up"
+ init-f buffer-file-name))
+ (t
+ (setq flymake-last-change-time nil)
+ (setq proc
+ (let ((default-directory (or dir default-directory)))
+ (when dir
+ (flymake-log 3 "starting process on dir %s" dir))
+ (make-process
+ :name "flymake-proc"
+ :buffer (current-buffer)
+ :command (cons cmd args)
+ :noquery t
+ :filter
+ (lambda (proc string)
+ (let ((flymake-proc--report-fn report-fn))
+ (flymake-proc--process-filter proc string)))
+ :sentinel
+ (lambda (proc event)
+ (let ((flymake-proc--report-fn report-fn))
+ (flymake-proc--process-sentinel proc event))))))
+ (process-put proc 'flymake-proc--output-buffer
+ (generate-new-buffer
+ (format " *flymake output for %s*" (current-buffer))))
+ (setq flymake-proc--current-process proc)
+ (flymake-log 2 "started process %d, command=%s, dir=%s"
+ (process-id proc) (process-command proc)
+ default-directory)
+ (setq success t)))
+ (unless success
+ (funcall cleanup-f))))))))
(define-obsolete-function-alias 'flymake-start-syntax-check
'flymake-proc-legacy-flymake "26.1")
-(defun flymake-proc--start-syntax-check-process (cmd args dir)
- "Start syntax check process."
- (condition-case-unless-debug err
- (let* ((process
- (let ((default-directory (or dir default-directory)))
- (when dir
- (flymake-log 3 "starting process on dir %s" dir))
- (make-process :name "flymake-proc"
- :buffer (current-buffer)
- :command (cons cmd args)
- :noquery t
- :filter 'flymake-proc--process-filter
- :sentinel 'flymake-proc--process-sentinel))))
- (process-put process 'flymake-proc--output-buffer
- (generate-new-buffer
- (format " *flymake output for %s*" (current-buffer))))
- (process-put process 'flymake-proc--report-fn
- flymake-proc--report-fn)
-
- (setq-local flymake-proc--process process)
- (push process flymake-proc--processes)
-
- (setq flymake-is-running t)
- (setq flymake-last-change-time nil)
-
- (flymake-log 2 "started process %d, command=%s, dir=%s"
- (process-id process) (process-command process)
- default-directory)
- process)
- (error
- (flymake-proc--panic :make-process-error
- (format-message
- "Failed to launch syntax check process `%s' with args %s: %s"
- cmd args (error-message-string err)))
- (funcall (flymake-proc--get-cleanup-function buffer-file-name)))))
-
(defun flymake-proc-stop-all-syntax-checks (&optional reason)
"Kill all syntax check processes."
(interactive (list "Interrupted by user"))
- (mapc (lambda (proc)
- (kill-process proc)
- (process-put proc 'flymake-proc--interrupted reason)
- (flymake-log 2 "killed process %d" (process-id proc)))
- flymake-proc--processes))
+ (dolist (buf (buffer-list))
+ (with-current-buffer buf
+ (let (p flymake-proc--current-process)
+ (when (process-live-p p)
+ (kill-process p)
+ (process-put p 'flymake-proc--interrupted reason)
+ (flymake-log 2 "killed process %d" (process-id p)))))))
(defun flymake-proc--compilation-is-running ()
(and (boundp 'compilation-in-progress)
(require 'thingatpt) ; end-of-thing
(require 'warnings) ; warning-numeric-level, display-warning
(require 'compile) ; for some faces
-(eval-when-compile (require 'subr-x)) ; when-let*, if-let*
+(require 'subr-x) ; when-let*, if-let*, hash-table-keys, hash-table-values
(defgroup flymake nil
"Universal on-the-fly syntax checker."
Whenever Flymake or the user decides to re-check the buffer, each
function is called with a common calling convention, a single
-REPORT-FN argument, detailed below. Backend functions are first
-expected to quickly and inexpensively announce the feasibility of
-checking the buffer via the return value (i.e. they aren't
-required to immediately start checking the buffer):
-
-* If the backend function returns nil, Flymake forgets about this
- backend for the current check, but will call it again for the
- next one;
-
-* If the backend function returns non-nil, Flymake expects this
- backend to check the buffer and call its REPORT-FN callback
- function exactly once. If the computation involved is
- inexpensive, the backend function may do so synchronously,
- before returning. If it is not, it should do so after
- returning, using idle timers, asynchronous processes or other
- asynchronous mechanisms.
-
-* If the backend function signals an error, it is disabled,
- i.e. Flymake will not use it again for the current or any
- future checks of this buffer. Certain commands, like turning
- `flymake-mode' on and off again, resets the list of disabled
- backends.
-
-Backends are required to call REPORT-FN with a single argument
-ACTION followed by an optional list of keywords parameters and
+REPORT-FN argument, detailed below. Backend functions are
+expected to initiate the buffer check, but aren't required to
+complete it check before exiting: if the computation involved is
+expensive, especially for large buffers, that task can be
+scheduled for the future using asynchronous processes or other
+asynchronous mechanisms.
+
+In any case, backend functions are expected to return quickly or
+signal an error, in which case the backend is disabled. Flymake
+will not try disabled backends again for any future checks of
+this buffer. Certain commands, like turning `flymake-mode' off
+and on again, reset the list of disabled backends.
+
+If the function returns, Flymake considers the backend to be
+\"running\". If it has not done so already, the backend is
+expected to call the function REPORT-FN with a single argument
+ACTION followed by an optional list of keyword arguments and
their values (:KEY1 VALUE1 :KEY2 VALUE2...).
The possible values for ACTION are.
-* A (possibly empty) list of objects created with
+* A (possibly empty) list of diagnostic objects created with
`flymake-make-diagnostic', causing Flymake to annotate the
- buffer with this information and consider the backend has
- having finished its check normally.
+ buffer with this information.
-* The symbol `:progress', signalling that the backend is still
- working and will call REPORT-FN again in the future.
+ A backend may call REPORT-FN repeatedly in this manner, but
+ only until Flymake considers that the most recently requested
+ buffer check is now obsolete because, say, buffer contents have
+ changed in the meantime. The backend is only given notice of
+ this via a renewed call to the backend function. Thus, to
+ prevent making obsolete reports and wasting resources, backend
+ functions should first cancel any ongoing processing from
+ previous calls.
* The symbol `:panic', signalling that the backend has
encountered an exceptional situation and should be disabled.
* ‘:explanation’: value should give user-readable details of
the situation encountered, if any.
-* ‘:force’: value should be a boolean forcing the Flymake UI
- to consider the report even if was somehow unexpected.")
+* ‘:force’: value should be a boolean suggesting that the Flymake
+ considers the report even if was somehow unexpected.")
(defvar flymake-diagnostic-types-alist
`((:error
;; third-party compatibility.
(define-obsolete-function-alias 'flymake-display-warning 'message-box "26.1")
-(defvar-local flymake--running-backends nil
- "List of currently active flymake backends.
-An active backend is a member of `flymake-diagnostic-functions'
-that has been invoked but hasn't reported any final status yet.")
-
-(defvar-local flymake--disabled-backends nil
- "List of currently disabled flymake backends.
-A backend is disabled if it reported `:panic'.")
-
-(defvar-local flymake--diagnostics-table nil
- "Hash table of all diagnostics indexed by backend.")
+(defvar-local flymake--backend-state nil
+ "Buffer-local hash table of a Flymake backend's state.
+The keys to this hash table are functions as found in
+`flymake-diagnostic-functions'. The values are plists where the
+following keys are possible:
+
+`:running', a symbol to keep track of a backend's replies via its
+REPORT-FN argument. A backend is running if this key is
+present. If the key is absent if the backend isn't expecting any
+replies from the backend.
+
+`:diags', a (possibly empty) list of diagnostic objects created
+with `flymake-make-diagnostic'. This key is absent if the
+backend hasn't reported anything yet.
+
+`:disabled', a string with the explanation for a previous
+exceptional situation reported by the backend. If this key is
+present the backend is disabled.")
+
+(defmacro flymake--saving-backend-state (backend state-var &rest body)
+ "Bind BACKEND's STATE-VAR to its state, run BODY, then save it."
+ (declare (indent 2) (debug (sexp sexp &rest form)))
+ (let ((b (make-symbol "b")))
+ `(let* ((,b ,backend)
+ (,state-var (gethash ,b flymake--backend-state)))
+ (unwind-protect
+ (progn ,@body)
+ (puthash ,b ,state-var flymake--backend-state)))))
(defun flymake-is-running ()
"Tell if flymake has running backends in this buffer"
- flymake--running-backends)
-
-(defun flymake--disable-backend (backend action &optional explanation)
- (cl-pushnew backend flymake--disabled-backends)
- (flymake-log :warning "Disabled the backend %s due to reports of %s (%s)"
- backend action explanation))
-
-(cl-defun flymake--handle-report (backend action &key explanation force)
- "Handle reports from flymake backend identified by BACKEND.
-
-BACKEND, ACTION and EXPLANATION conform to the calling convention
-described in `flymake-diagnostic-functions' (which see). Optional
-FORCE says to handle a report even if it was not expected."
- (cond
- ((and (not (memq backend flymake--running-backends))
- (not force))
- (flymake-error "Ignoring unexpected report from backend %s" backend))
- ((eq action :progress)
- (flymake-log 3 "Backend %s reports progress: %s" backend explanation))
- ((eq :panic action)
- (flymake--disable-backend backend action explanation))
- ((listp action)
- (let ((diagnostics action))
- (save-restriction
- (widen)
- (flymake-delete-own-overlays
- (lambda (ov)
- (eq backend
- (flymake--diag-backend
- (overlay-get ov 'flymake--diagnostic)))))
- (puthash backend diagnostics flymake--diagnostics-table)
- (mapc (lambda (diag)
- (flymake--highlight-line diag)
- (setf (flymake--diag-backend diag) backend))
- diagnostics)
- (when flymake-check-start-time
- (flymake-log 2 "backend %s reported %d diagnostics in %.2f second(s)"
- backend
- (length diagnostics)
- (- (float-time) flymake-check-start-time))))))
- (t
- (flymake--disable-backend "?"
- :strange
- (format "unknown action %s (%s)"
- action explanation))))
- (unless (eq action :progress)
- (flymake--stop-backend backend)))
-
-(defun flymake-make-report-fn (backend)
+ (flymake-running-backends))
+
+(cl-defun flymake--handle-report (backend token action &key explanation force)
+ "Handle reports from BACKEND identified by TOKEN.
+
+BACKEND, ACTION and EXPLANATION, and FORCE conform to the calling
+convention described in `flymake-diagnostic-functions' (which
+see). Optional FORCE says to handle a report even if TOKEN was
+not expected."
+ (let ((state (gethash backend flymake--backend-state)))
+ (let (expected-token
+ new-diags)
+ (cond
+ ((null state)
+ (flymake-error
+ "Unexpected report from unknown backend %s" backend))
+ ((cl-getf state :disabled)
+ (flymake-error
+ "Unexpected report from disabled backend %s" backend))
+ ((progn
+ (setq expected-token (cl-getf state :running))
+ (null expected-token))
+ ;; should never happen
+ (flymake-error "Unexpected report from stopped backend %s" backend))
+ ((and (not (eq expected-token token))
+ (not force))
+ (flymake-error "Obsolete report from backend %s with explanation %s"
+ backend explanation))
+ ((eq :panic action)
+ (flymake--disable-backend backend explanation))
+ ((not (listp action))
+ (flymake--disable-backend backend
+ (format "Unknown action %S" action))
+ (flymake-error "Expected report, but got unknown key %s" action))
+ (t
+ (setq new-diags action)
+ (save-restriction
+ (widen)
+ (unless (cl-getf state :diags)
+ ;; only delete overlays if this is the first batch of
+ ;; diagnostics we are receiving.
+ (flymake-delete-own-overlays
+ (lambda (ov)
+ (eq backend
+ (flymake--diag-backend
+ (overlay-get ov 'flymake--diagnostic))))))
+ (mapc (lambda (diag)
+ (flymake--highlight-line diag)
+ (setf (flymake--diag-backend diag) backend))
+ new-diags)
+ (flymake--saving-backend-state backend state
+ (setf (cl-getf state :diags)
+ (append new-diags (cl-getf state :diags))))
+ (when flymake-check-start-time
+ (flymake-log :debug "backend %s reported %d diagnostics in %.2f second(s)"
+ backend
+ (length new-diags)
+ (- (float-time) flymake-check-start-time)))))))))
+
+(defun flymake-make-report-fn (backend &optional token)
"Make a suitable anonymous report function for BACKEND.
-BACKEND is used to help flymake distinguish diagnostic
-sources."
- (lambda (&rest args)
- (apply #'flymake--handle-report backend args)))
-
-(defun flymake--stop-backend (backend)
- "Stop the backend BACKEND."
- (setq flymake--running-backends (delq backend flymake--running-backends)))
+BACKEND is used to help flymake distinguish different diagnostic
+sources. If provided, TOKEN helps flymake distinguish between
+different runs of the same backend."
+ (let ((buffer (current-buffer)))
+ (lambda (&rest args)
+ (when (buffer-live-p buffer)
+ (with-current-buffer buffer
+ (apply #'flymake--handle-report backend token args))))))
+
+(defun flymake--collect (fn)
+ (let (retval)
+ (maphash (lambda (backend state)
+ (when (funcall fn state) (push backend retval)))
+ flymake--backend-state)
+ retval))
+
+(defun flymake-running-backends ()
+ "Compute running Flymake backends in current buffer."
+ (flymake--collect (lambda (state) (cl-getf state :running))))
+
+(defun flymake-disabled-backends ()
+ "Compute disabled Flymake backends in current buffer."
+ (flymake--collect (lambda (state) (cl-getf state :disabled))))
+
+(defun flymake-reporting-backends ()
+ "Compute reporting Flymake backends in current buffer."
+ (flymake--collect (lambda (state) (or (plist-member state :diags)
+ (plist-member state :disabled)))))
+
+(defun flymake--disable-backend (backend &optional explanation)
+ "Disable BACKEND because EXPLANATION.
+If is is running also stop it."
+ (flymake-log :warning "Disabling backend %s because %s" backend explanation)
+ (flymake--saving-backend-state backend state
+ (setf (cl-getf state :disabled) explanation)
+ (cl-remf state :running)))
(defun flymake--run-backend (backend)
- "Run the backend BACKEND."
- (push backend flymake--running-backends)
- (remhash backend flymake--diagnostics-table)
- ;; FIXME: Should use `condition-case-unless-debug' here, but that
- ;; won't let me catch errors from inside `ert-deftest' where
- ;; `debug-on-error' is always t
- (condition-case err
- (unless (funcall backend
- (flymake-make-report-fn backend))
- (flymake--stop-backend backend))
- (error
- (flymake--disable-backend backend :error
- err)
- (flymake--stop-backend backend))))
-
-(defun flymake-start (&optional deferred interactive)
+ "Run the backend BACKEND, reenabling if necessary."
+ (flymake-log :debug "Running backend %s" backend)
+ (let ((run-token (cl-gensym "backend-token")))
+ (flymake--saving-backend-state backend state
+ (setf (cl-getf state :running) run-token)
+ (cl-remf state :disabled)
+ (cl-remf state :diags))
+ ;; FIXME: Should use `condition-case-unless-debug' here, for don't
+ ;; for two reasons: (1) that won't let me catch errors from inside
+ ;; `ert-deftest' where `debug-on-error' appears to be always
+ ;; t. (2) In cases where the user is debugging elisp somewhere
+ ;; else, and using flymake, the presence of a frequently
+ ;; misbehaving backend in the global hook (most likely the legacy
+ ;; backend) will trigger an annoying backtrace.
+ ;;
+ (condition-case err
+ (funcall backend
+ (flymake-make-report-fn backend run-token))
+ (error
+ (flymake--disable-backend backend err)))))
+
+(defun flymake-start (&optional deferred force)
"Start a syntax check.
Start it immediately, or after current command if DEFERRED is
-non-nil. With optional INTERACTIVE or interactively, clear any
-stale information about running and automatically disabled
-backends."
- (interactive (list nil t))
+non-nil. With optional FORCE run even disabled backends.
+
+Interactively, with a prefix arg, FORCE is t."
+ (interactive (list nil current-prefix-arg))
(cl-labels
((start
()
(remove-hook 'post-command-hook #'start 'local)
(setq flymake-check-start-time (float-time))
- (when interactive
- (setq flymake--diagnostics-table (make-hash-table)
- flymake--running-backends nil
- flymake--disabled-backends nil))
(run-hook-wrapped
'flymake-diagnostic-functions
(lambda (backend)
- (cond ((memq backend flymake--running-backends)
- (flymake-log :debug "Backend %s still running, not restarting"
- backend))
- ((memq backend flymake--disabled-backends)
- (flymake-log :debug "Backend %s is disabled, not starting"
- backend))
- (t
- (flymake--run-backend backend)))
+ (cond
+ ((and (not force)
+ (plist-member (gethash backend flymake--backend-state) :disabled))
+ (flymake-log :debug "Backend %s is disabled, not starting"
+ backend))
+ (t
+ (flymake--run-backend backend)))
nil))))
(if (and deferred
this-command)
;;;###autoload
(define-minor-mode flymake-mode nil
:group 'flymake :lighter flymake--mode-line-format :keymap flymake-mode-map
- (setq flymake--running-backends nil
- flymake--disabled-backends nil)
(cond
;; Turning the mode ON.
(flymake-mode
(setq flymake-timer
(run-at-time nil 1 'flymake-on-timer-event (current-buffer)))
- (setq flymake--diagnostics-table (make-hash-table))
+ (setq flymake--backend-state (make-hash-table))
(when flymake-start-syntax-check-on-find-file
(flymake-start)))))
(defun flymake--mode-line-format ()
"Produce a pretty minor mode indicator."
- (let ((running flymake--running-backends)
- (reported (cl-plusp
- (hash-table-count flymake--diagnostics-table))))
+ (let ((known (hash-table-keys flymake--backend-state))
+ (running (flymake-running-backends))
+ (disabled (flymake-disabled-backends))
+ (reported (flymake-reporting-backends))
+ (diags-by-type (make-hash-table)))
+ (maphash (lambda (_b state)
+ (mapc (lambda (diag)
+ (push diag
+ (gethash (flymake--diag-type diag)
+ diags-by-type)))
+ (cl-getf state :diags)))
+ flymake--backend-state)
`((:propertize " Flymake"
mouse-face mode-line-highlight
- ,@(when (not reported)
- `(face compilation-mode-line-fail))
help-echo
- ,(concat (format "%s registered backends\n"
- (length flymake-diagnostic-functions))
- (format "%s running\n"
- (length running))
- (format "%s disabled\n"
- (length flymake--disabled-backends))
+ ,(concat (format "%s known backends\n" (length known))
+ (format "%s running\n" (length running))
+ (format "%s disabled\n" (length disabled))
"mouse-1: go to log buffer ")
keymap
,(let ((map (make-sparse-keymap)))
(interactive "e")
(switch-to-buffer "*Flymake log*")))
map))
- ,@(when running
- `(":" (:propertize "Run"
- face compilation-mode-line-run
- help-echo
- ,(format "%s running backends"
- (length running)))))
- ,@(when reported
- (let ((by-type (make-hash-table)))
- (maphash (lambda (_backend diags)
- (mapc (lambda (diag)
- (push diag
- (gethash (flymake--diag-type diag)
- by-type)))
- diags))
- flymake--diagnostics-table)
- (cl-loop
- for (type . severity)
- in (cl-sort (mapcar (lambda (type)
- (cons type (flymake--lookup-type-property
- type
- 'severity
- (warning-numeric-level :error))))
- (cl-union (hash-table-keys by-type)
- '(:error :warning)))
- #'>
- :key #'cdr)
- for diags = (gethash type by-type)
- for face = (flymake--lookup-type-property type
- 'mode-line-face
- 'compilation-error)
- when (or diags
- (>= severity (warning-numeric-level :warning)))
- collect `(:propertize
- ,(format "%d" (length diags))
- face ,face
- mouse-face mode-line-highlight
- keymap
- ,(let ((map (make-sparse-keymap))
- (type type))
- (define-key map [mode-line mouse-4]
- (lambda (_event)
- (interactive "e")
- (flymake-goto-prev-error 1 (list type) t)))
- (define-key map [mode-line mouse-5]
- (lambda (_event)
- (interactive "e")
- (flymake-goto-next-error 1 (list type) t)))
- map)
- help-echo
- ,(concat (format "%s diagnostics of type %s\n"
- (propertize (format "%d"
- (length diags))
- 'face face)
- (propertize (format "%s" type)
- 'face face))
- "mouse-4/mouse-5: previous/next of this type\n"))
- into forms
- finally return
- `((:propertize "[")
- ,@(cl-loop for (a . rest) on forms by #'cdr
- collect a when rest collect
- '(:propertize " "))
- (:propertize "]"))))))))
+ ,@(if (null reported)
+ (pcase-let ((`(,ind ,face ,explain)
+ (cond ((null known)
+ `("?" mode-line "No known backends"))
+ (running
+ `("Wait" compilation-mode-line-run
+ ,(format "Waiting for %s running backends"
+ (length running))))
+ (disabled
+ `("!" compilation-mode-line-run
+ "All backends disabled")))))
+ `(":"
+ (:propertize ,ind
+ face ,face
+ help-echo ,explain)))
+ (cl-loop
+ for (type . severity)
+ in (cl-sort (mapcar (lambda (type)
+ (cons type (flymake--lookup-type-property
+ type
+ 'severity
+ (warning-numeric-level :error))))
+ (cl-union (hash-table-keys diags-by-type)
+ '(:error :warning)))
+ #'>
+ :key #'cdr)
+ for diags = (gethash type diags-by-type)
+ for face = (flymake--lookup-type-property type
+ 'mode-line-face
+ 'compilation-error)
+ when (or diags
+ (>= severity (warning-numeric-level :warning)))
+ collect `(:propertize
+ ,(format "%d" (length diags))
+ face ,face
+ mouse-face mode-line-highlight
+ keymap
+ ,(let ((map (make-sparse-keymap))
+ (type type))
+ (define-key map [mode-line mouse-4]
+ (lambda (_event)
+ (interactive "e")
+ (flymake-goto-prev-error 1 (list type) t)))
+ (define-key map [mode-line mouse-5]
+ (lambda (_event)
+ (interactive "e")
+ (flymake-goto-next-error 1 (list type) t)))
+ map)
+ help-echo
+ ,(concat (format "%s diagnostics of type %s\n"
+ (propertize (format "%d"
+ (length diags))
+ 'face face)
+ (propertize (format "%s" type)
+ 'face face))
+ "mouse-4/mouse-5: previous/next of this type\n"))
+ into forms
+ finally return
+ `((:propertize "[")
+ ,@(cl-loop for (a . rest) on forms by #'cdr
+ collect a when rest collect
+ '(:propertize " "))
+ (:propertize "]")))))))
\f
;;
;;
+(defun flymake-tests--wait-for-backends ()
+ ;; Weirdness here... http://debbugs.gnu.org/17647#25
+ ;; ... meaning `sleep-for', and even
+ ;; `accept-process-output', won't suffice as ways to get
+ ;; process filters and sentinels to run, though they do work
+ ;; fine in a non-interactive batch session. The only thing
+ ;; that will indeed unblock pending process output is
+ ;; reading an input event, so, as a workaround, use a dummy
+ ;; `read-event' with a very short timeout.
+ (unless noninteractive (read-event "" nil 0.1))
+ (cl-loop repeat 5
+ for notdone = (cl-set-difference (flymake-running-backends)
+ (flymake-reporting-backends))
+ while notdone
+ unless noninteractive do (read-event "" nil 0.1)
+ do (sleep-for (+ 0.5 flymake-no-changes-timeout))
+ finally (when notdone (ert-fail
+ (format "Some backends not reporting yet %s"
+ notdone)))))
+
(cl-defun flymake-tests--call-with-fixture (fn file
&key (severity-predicate
nil sev-pred-supplied-p))
(visiting (find-buffer-visiting file))
(buffer (or visiting (find-file-noselect file)))
(process-environment (cons "LC_ALL=C" process-environment))
- (i 0)
(warning-minimum-log-level :error))
(unwind-protect
(with-current-buffer buffer
(setq-local flymake-proc-diagnostic-type-pred severity-predicate))
(goto-char (point-min))
(unless flymake-mode (flymake-mode 1))
- ;; Weirdness here... http://debbugs.gnu.org/17647#25
- ;; ... meaning `sleep-for', and even
- ;; `accept-process-output', won't suffice as ways to get
- ;; process filters and sentinels to run, though they do work
- ;; fine in a non-interactive batch session. The only thing
- ;; that will indeed unblock pending process output is
- ;; reading an input event, so, as a workaround, use a dummy
- ;; `read-event' with a very short timeout.
- (unless noninteractive (read-event "" nil 0.1))
- (while (and (flymake-is-running) (< (setq i (1+ i)) 10))
- (unless noninteractive (read-event "" nil 0.1))
- (sleep-for (+ 0.5 flymake-no-changes-timeout)))
+ (flymake-tests--wait-for-backends)
(funcall fn)))
(and buffer
(not visiting)
(ert-deftest different-diagnostic-types ()
"Test GCC warning via function predicate."
(skip-unless (and (executable-find "gcc") (executable-find "make")))
- (flymake-tests--with-flymake
- ("errors-and-warnings.c")
- (flymake-goto-next-error)
- (should (eq 'flymake-error (face-at-point)))
- (flymake-goto-next-error)
- (should (eq 'flymake-note (face-at-point)))
- (flymake-goto-next-error)
- (should (eq 'flymake-warning (face-at-point)))
- (flymake-goto-next-error)
- (should (eq 'flymake-error (face-at-point)))
- (flymake-goto-next-error)
- (should (eq 'flymake-warning (face-at-point)))
- (flymake-goto-next-error)
- (should (eq 'flymake-warning (face-at-point)))
- (let ((flymake-wrap-around nil))
- (should-error (flymake-goto-next-error nil nil t))) ))
+ (let ((flymake-wrap-around nil))
+ (flymake-tests--with-flymake
+ ("errors-and-warnings.c")
+ (flymake-goto-next-error)
+ (should (eq 'flymake-error (face-at-point)))
+ (flymake-goto-next-error)
+ (should (eq 'flymake-note (face-at-point)))
+ (flymake-goto-next-error)
+ (should (eq 'flymake-warning (face-at-point)))
+ (flymake-goto-next-error)
+ (should (eq 'flymake-error (face-at-point)))
+ (flymake-goto-next-error)
+ (should (eq 'flymake-warning (face-at-point)))
+ (flymake-goto-next-error)
+ (should (eq 'flymake-warning (face-at-point)))
+ (should-error (flymake-goto-next-error nil nil t)))))
(ert-deftest included-c-header-files ()
"Test inclusion of .h header files."
(skip-unless (and (executable-find "gcc") (executable-find "make")))
- (flymake-tests--with-flymake
- ("some-problems.h")
- (flymake-goto-next-error)
- (should (eq 'flymake-warning (face-at-point)))
- (flymake-goto-next-error)
- (should (eq 'flymake-error (face-at-point)))
- (let ((flymake-wrap-around nil))
- (should-error (flymake-goto-next-error nil nil t))) )
- (flymake-tests--with-flymake
- ("no-problems.h")
- (let ((flymake-wrap-around nil))
- (should-error (flymake-goto-next-error nil nil t))) ))
+ (let ((flymake-wrap-around nil))
+ (flymake-tests--with-flymake
+ ("some-problems.h")
+ (flymake-goto-next-error)
+ (should (eq 'flymake-warning (face-at-point)))
+ (flymake-goto-next-error)
+ (should (eq 'flymake-error (face-at-point)))
+ (should-error (flymake-goto-next-error nil nil t)))
+ (flymake-tests--with-flymake
+ ("no-problems.h")
+ (should-error (flymake-goto-next-error nil nil t)))))
(defmacro flymake-tests--assert-set (set
should
`(progn
,@(cl-loop
for s in should
- collect `(should (memq ,s ,set)))
+ collect `(should (memq (quote ,s) ,set)))
,@(cl-loop
for s in should-not
- collect `(should-not (memq ,s ,set)))))
+ collect `(should-not (memq (quote ,s) ,set)))))
-(ert-deftest dummy-backends ()
- "Test GCC warning via function predicate."
- (with-temp-buffer
- (cl-labels
- ((diagnose
- (report-fn type words)
- (funcall
- report-fn
+(defun flymake-tests--diagnose-words
+ (report-fn type words)
+ "Helper. Call REPORT-FN with diagnostics for WORDS in buffer."
+ (funcall report-fn
(cl-loop
for word in words
append
(match-end 0)
type
(concat word " is wrong")))))))
- (error-backend
- (report-fn)
- (run-with-timer
- 0.5 nil
- #'diagnose report-fn :error '("manha" "prognata")))
- (warning-backend
- (report-fn)
- (run-with-timer
- 0.5 nil
- #'diagnose report-fn :warning '("ut" "dolor")))
- (sync-backend
- (report-fn)
- (diagnose report-fn :note '("quis" "commodo")))
- (refusing-backend
- (_report-fn)
- nil)
- (panicking-backend
- (report-fn)
- (run-with-timer
- 0.5 nil
- report-fn :panic :explanation "The spanish inquisition!"))
- (crashing-backend
- (_report-fn)
- ;; HACK: Shoosh log during tests
- (setq-local warning-minimum-log-level :emergency)
- (error "crashed")))
+
+(ert-deftest dummy-backends ()
+ "Test many different kinds of backends."
+ (with-temp-buffer
+ (cl-letf
+ (((symbol-function 'error-backend)
+ (lambda (report-fn)
+ (run-with-timer
+ 0.5 nil
+ #'flymake-tests--diagnose-words report-fn :error '("manha" "prognata"))))
+ ((symbol-function 'warning-backend)
+ (lambda (report-fn)
+ (run-with-timer
+ 0.5 nil
+ #'flymake-tests--diagnose-words report-fn :warning '("ut" "dolor"))))
+ ((symbol-function 'sync-backend)
+ (lambda (report-fn)
+ (flymake-tests--diagnose-words report-fn :note '("quis" "commodo"))))
+ ((symbol-function 'panicking-backend)
+ (lambda (report-fn)
+ (run-with-timer
+ 0.5 nil
+ report-fn :panic :explanation "The spanish inquisition!")))
+ ((symbol-function 'crashing-backend)
+ (lambda (_report-fn)
+ ;; HACK: Shoosh log during tests
+ (setq-local warning-minimum-log-level :emergency)
+ (error "crashed"))))
(insert "Lorem ipsum dolor sit amet, consectetur adipiscing
elit, sed do eiusmod tempor incididunt ut labore et dolore
manha aliqua. Ut enim ad minim veniam, quis nostrud
sunt in culpa qui officia deserunt mollit anim id est
laborum.")
(let ((flymake-diagnostic-functions
- (list #'error-backend #'warning-backend #'sync-backend
- #'refusing-backend #'panicking-backend
- #'crashing-backend
- )))
+ (list 'error-backend 'warning-backend 'sync-backend
+ 'panicking-backend
+ 'crashing-backend
+ ))
+ (flymake-wrap-around nil))
(flymake-mode)
- ;; FIXME: accessing some flymake-ui's internals here...
- (flymake-tests--assert-set flymake--running-backends
- (#'error-backend #'warning-backend #'panicking-backend)
- (#'sync-backend #'crashing-backend #'refusing-backend))
- (flymake-tests--assert-set flymake--disabled-backends
- (#'crashing-backend)
- (#'error-backend #'warning-backend #'sync-backend
- #'panicking-backend #'refusing-backend))
+ (flymake-tests--assert-set (flymake-running-backends)
+ (error-backend warning-backend panicking-backend)
+ (crashing-backend))
- (cl-loop repeat 10 while (flymake-is-running)
- unless noninteractive do (read-event "" nil 0.1)
- do (sleep-for (+ 0.5 flymake-no-changes-timeout)))
+ (flymake-tests--assert-set (flymake-disabled-backends)
+ (crashing-backend)
+ (error-backend warning-backend sync-backend
+ panicking-backend))
- (should (eq flymake--running-backends '()))
+ (flymake-tests--wait-for-backends)
- (flymake-tests--assert-set flymake--disabled-backends
- (#'crashing-backend #'panicking-backend)
- (#'error-backend #'warning-backend #'sync-backend
- #'refusing-backend))
+ (flymake-tests--assert-set (flymake-disabled-backends)
+ (crashing-backend panicking-backend)
+ (error-backend warning-backend sync-backend))
(goto-char (point-min))
(flymake-goto-next-error)
(should (eq 'flymake-warning (face-at-point))) ; dolor
(flymake-goto-next-error)
(should (eq 'flymake-error (face-at-point))) ; prognata
- (let ((flymake-wrap-around nil))
- (should-error (flymake-goto-next-error nil nil t)))))))
+ (should-error (flymake-goto-next-error nil nil t))))))
+
+(ert-deftest recurrent-backend ()
+ "Test a backend that calls REPORT-FN multiple times"
+ (with-temp-buffer
+ (let (tick)
+ (cl-letf
+ (((symbol-function 'eager-backend)
+ (lambda (report-fn)
+ (funcall report-fn nil :explanation "very eager but no diagnostics")
+ (display-buffer (current-buffer))
+ (run-with-timer
+ 0.5 nil
+ (lambda ()
+ (flymake-tests--diagnose-words report-fn :warning '("consectetur"))
+ (setq tick t)
+ (run-with-timer
+ 0.5 nil
+ (lambda ()
+ (flymake-tests--diagnose-words report-fn :error '("fugiat"))
+ (setq tick t))))))))
+ (insert "Lorem ipsum dolor sit amet, consectetur adipiscing
+ elit, sed do eiusmod tempor incididunt ut labore et dolore
+ manha aliqua. Ut enim ad minim veniam, quis nostrud
+ exercitation ullamco laboris nisi ut aliquip ex ea commodo
+ consequat. Duis aute irure dolor in reprehenderit in
+ voluptate velit esse cillum dolore eu fugiat nulla
+ pariatur. Excepteur sint occaecat cupidatat non prognata
+ sunt in culpa qui officia deserunt mollit anim id est
+ laborum.")
+ (let ((flymake-diagnostic-functions
+ (list 'eager-backend))
+ (flymake-wrap-around nil))
+ (flymake-mode)
+ (flymake-tests--assert-set (flymake-running-backends)
+ (eager-backend) ())
+ (cl-loop until tick repeat 4 do (sleep-for 0.2))
+ (setq tick nil)
+ (goto-char (point-max))
+ (flymake-goto-prev-error)
+ (should (eq 'flymake-warning (face-at-point))) ; consectetur
+ (should-error (flymake-goto-prev-error nil nil t))
+ (cl-loop until tick repeat 4 do (sleep-for 0.2))
+ (flymake-goto-next-error)
+ (should (eq 'flymake-error (face-at-point))) ; fugiat
+ (flymake-goto-prev-error)
+ (should (eq 'flymake-warning (face-at-point))) ; back at consectetur
+ (should-error (flymake-goto-prev-error nil nil t))
+ )))))
(provide 'flymake-tests)
projects / emacs.git / commitdiff