Hook Flymake onto proper checkdoc and byte-compile interfaces

The interfaces in bytecomp.el and checkdoc.el are mostly boilerplate,
with little knowledge of actual internals or thought given to the
usefulness of said interfaces in contexts other than Flymake's.

* lisp/emacs-lisp/bytecomp.el
(byte-compile-log-warning-function): New variable.
(byte-compile-log-warning): Use it.
(byte-compile--log-warning-for-byte-compile): New function.

* lisp/emacs-lisp/checkdoc.el
(checkdoc-create-error-function): New variable.
(checkdoc-create-error): Use it.
(checkdoc--create-error-for-checkdoc): New function.xo

* lisp/progmodes/flymake-elisp.el (flymake-elisp--checkdoc-1):
Use checkdoc-create-error-function.
(flymake-elisp--batch-byte-compile): Use
byte-compile-log-warning-function.

diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 1b42961f1a41ed1c7114ea06487e352d48f15acf..590db570c560f590ce91dd6c2e6f83f7f6f3feb2 100644 (file)
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -1183,7 +1183,29 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
           (compilation-forget-errors)
           pt))))
 
+(defvar byte-compile-log-warning-function
+  #'byte-compile--log-warning-for-byte-compile
+  "Function called when encountering a warning or error.
+Called with arguments (STRING POSITION FILL LEVEL).  STRING is a
+message describing the problem.  POSITION is a buffer position
+where the problem was detected.  FILL is a prefix as in
+`warning-fill-prefix'.  LEVEL is the level of the
+problem (`:warning' or `:error').  POSITION, FILL and LEVEL may be
+nil.")
+
 (defun byte-compile-log-warning (string &optional fill level)
+  "Log a byte-compilation warning.
+STRING, FILL and LEVEL are as described in
+`byte-compile-log-warning-function', which see."
+  (funcall byte-compile-log-warning-function
+           string byte-compile-last-position
+           fill
+           level))
+
+(defun byte-compile--log-warning-for-byte-compile (string &optional
+                                                          _position
+                                                          fill
+                                                          level)
   "Log a message STRING in `byte-compile-log-buffer'.
 Also log the current function and file if not already done.  If
 FILL is non-nil, set `warning-fill-prefix' to four spaces.  LEVEL

diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el
index 7997ba6014c4ac2eec8ef5b79daaedcb5878d218..72f82f26f6fc3bc807d07297c61b45f06df9177c 100644 (file)
--- a/lisp/emacs-lisp/checkdoc.el
+++ b/lisp/emacs-lisp/checkdoc.el
@@ -1147,14 +1147,27 @@ Prefix argument is the same as for `checkdoc-defun'"
 ;; features and behaviors, so we need some ways of specifying
 ;; them, and making them easier to use in the wacked-out interfaces
 ;; people are requesting
-(defun checkdoc-create-error (text start end &optional unfixable)
-  "Used to create the return error text returned from all engines.
+(defvar checkdoc-create-error-function #'checkdoc--create-error-for-checkdoc
+  "Function called when Checkdoc encounters an error.
+Should accept as arguments (TEXT START END &optional UNFIXABLE).
+
 TEXT is the descriptive text of the error.  START and END define the region
 it is sensible to highlight when describing the problem.
 Optional argument UNFIXABLE means that the error has no auto-fix available.
 
 A list of the form (TEXT START END UNFIXABLE) is returned if we are not
-generating a buffered list of errors."
+generating a buffered list of errors.")
+
+(defun checkdoc-create-error (text start end &optional unfixable)
+  "Used to create the return error text returned from all engines.
+TEXT, START, END and UNFIXABLE conform to
+`checkdoc-create-error-function', which see."
+  (funcall checkdoc-create-error-function text start end unfixable))
+
+(defun checkdoc--create-error-for-checkdoc (text start end &optional unfixable)
+  "Create an error for Checkdoc.
+TEXT, START, END and UNFIXABLE conform to
+`checkdoc-create-error-function', which see."
   (if checkdoc-generate-compile-warnings-flag
       (progn (checkdoc-error start text)
             nil)

diff --git a/lisp/progmodes/flymake-elisp.el b/lisp/progmodes/flymake-elisp.el
index b42767c3facc98511491aee601ef321bfb5b95c8..b433dc24e127d7a8d95b22974698af5cbc397bdb 100644 (file)
--- a/lisp/progmodes/flymake-elisp.el
+++ b/lisp/progmodes/flymake-elisp.el
@@ -32,18 +32,18 @@
 (defun flymake-elisp--checkdoc-1 ()
   "Do actual work for `flymake-elisp-checkdoc'."
   (let (collected)
-    (cl-letf (((symbol-function 'checkdoc-create-error)
-               (lambda (text start end &optional unfixable)
-                 (push (list text start end unfixable) collected)
-                 nil)))
-      (let* ((checkdoc-autofix-flag nil)
-             (checkdoc-generate-compile-warnings-flag nil)
-             (buf (generate-new-buffer " *checkdoc-temp*"))
-             (checkdoc-diagnostic-buffer buf))
-        (unwind-protect
-            (save-excursion
-              (checkdoc-current-buffer t))
-          (kill-buffer buf))))
+    (let* ((checkdoc-create-error-function
+            (lambda (text start end &optional unfixable)
+              (push (list text start end unfixable) collected)
+              nil))
+           (checkdoc-autofix-flag nil)
+           (checkdoc-generate-compile-warnings-flag nil)
+           (buf (generate-new-buffer " *checkdoc-temp*"))
+           (checkdoc-diagnostic-buffer buf))
+      (unwind-protect
+          (save-excursion
+            (checkdoc-current-buffer t))
+        (kill-buffer buf)))
     collected))
 
 ;;;###autoload
@@ -165,14 +165,14 @@ Runs in a batch-mode Emacs.  Interactively use variable
          (byte-compile-dest-file-function
           (lambda (source)
             (setq dummy-elc-file (make-temp-file (file-name-nondirectory source)))))
-         (collected))
+         (collected)
+         (byte-compile-log-warning-function
+          (lambda (string &optional position fill level)
+            (push (list string position fill level)
+                  collected)
+            t)))
     (unwind-protect
-        (cl-letf (((symbol-function 'byte-compile-log-warning)
-                   (lambda (string &optional fill level)
-                     (push (list string byte-compile-last-position fill level)
-                           collected)
-                     t)))
-          (byte-compile-file file))
+        (byte-compile-file file)
       (ignore-errors
         (delete-file dummy-elc-file)
         (kill-buffer byte-compile-log-buffer)))