[#302] User option: apheleia-mode-predicates (#303)

For https://github.com/radian-software/apheleia/issues/302. Not tested
yet. Going to add unit tests before merging.

3 files changed, 92 insertions, 2 deletions

diff --git a/CHANGELOG.md b/CHANGELOG.md
index f03780b..3d7a553 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -12,6 +12,13 @@ The format is based on [Keep a Changelog].
   backwards compatibility, and errors can also be reported by
   throwing, as normal. Implemented in [#204].
 
+### Features
+* New user option `apheleia-mode-predicates`. The default value
+  handles `mhtml-mode` correctly by always using whatever formatter
+  you have configured for that mode, rather than using `css-mode`,
+  `html-mode`, etc formatters depending on the position of point
+  ([#302]).
+
 ### Enhancements
 * There is a new keyword argument to `apheleia-format-buffer` which is
   a more powerful callback that is guaranteed to be called except in
@@ -42,6 +49,7 @@ The format is based on [Keep a Changelog].
 [#286]: https://github.com/radian-software/apheleia/pull/286
 [#285]: https://github.com/radian-software/apheleia/issues/285
 [#290]: https://github.com/radian-software/apheleia/pull/290
+[#302]: https://github.com/radian-software/apheleia/issues/302
 
 ## 4.1 (released 2024-02-25)
 ### Enhancements
diff --git a/apheleia-formatters.el b/apheleia-formatters.el
index a96272b..6257e09 100644
--- a/apheleia-formatters.el
+++ b/apheleia-formatters.el
@@ -405,6 +405,32 @@ mode."
                    (symbol :tag "Formatter"))))
   :group 'apheleia)
 
+(defun apheleia-mhtml-mode-predicate ()
+  "Return `mhtml-mode' if the user is in that mode.
+This checks text properties because `mhtml-mode' sets
+`major-mode' to different values depending on where the user is
+in the buffer."
+  (when (get-text-property
+         (if (and (eobp) (not (bobp)))
+             (1- (point))
+           (point))
+         'mhtml-submode)
+    #'mhtml-mode))
+
+;;;###autoload
+(defcustom apheleia-mode-predicates '(apheleia-mhtml-mode-predicate)
+  "List of predicates that check for sneaky major modes.
+Sometimes a major mode will set `major-mode' to something other
+than itself, making it hard to correctly detect what major mode
+is active. In such cases you can add a predicate to this list to
+handle it. Predicates take no arguments, are run in the current
+buffer, and should return the name of a mode if one is detected.
+If all the predicates return nil, or if there aren't any in the
+list, then only the value of `major-mode' is used to determine
+the major mode. The detected major mode affects the selection
+from `apheleia-mode-alist'."
+  :type '(repeat function)
+  :group 'apheleia)
 
 (defcustom apheleia-formatter-exited-hook nil
   "Abnormal hook run after a formatter has finished running.
@@ -1240,6 +1266,7 @@ the current buffer.
 
 Consult the values of `apheleia-mode-alist' and
 `apheleia-formatter' to determine which formatter is configured.
+Consult also `apheleia-mode-predicates', if non-nil.
 
 If INTERACTIVE is non-nil, then prompt the user for which
 formatter to run if none is configured, instead of returning nil.
@@ -1268,7 +1295,12 @@ even if a formatter is configured."
                 ;; didn't exit early.
                 (let* ((unset (make-symbol "gensym-unset"))
                        (matched-mode nil)
-                       (formatters unset))
+                       (formatters unset)
+                       (mode major-mode))
+                  (cl-dolist (pred apheleia-mode-predicates)
+                    (when-let ((new-mode (funcall pred)))
+                      (setq mode new-mode)
+                      (cl-return)))
                   (cl-dolist (entry apheleia-mode-alist
                                     (unless (eq formatters unset)
                                       formatters))
@@ -1279,7 +1311,7 @@ even if a formatter is configured."
                                (eq formatters unset))
                       (cl-return (cdr entry)))
                     (when (and (symbolp (car entry))
-                               (derived-mode-p (car entry))
+                               (provided-mode-derived-p mode (car entry))
                                (or (eq formatters unset)
                                    (and
                                     (not (eq (car entry) matched-mode))
diff --git a/test/unit/apheleia-unit-test.el b/test/unit/apheleia-unit-test.el
index c5d54cc..da49005 100644
--- a/test/unit/apheleia-unit-test.el
+++ b/test/unit/apheleia-unit-test.el
@@ -95,3 +95,53 @@
        "solves issue #290"
        ("      | <div class=\"left-[40rem] fixed inset-y-0 right-0 z-0 hidden lg:block xl:left-[50rem]\">\n  <svg\n"
         "|<div class=\"left-[40rem] fixed inset-y-0 right-0 z-0 hidden lg:block xl:left-[50rem]\">\n <svg")))))
+
+(describe "apheleia--get-formatters"
+  (cl-macrolet ((testcases
+                 (description mode-alist pred-list &rest specs)
+                 `(cl-flet ((fmt-error
+                             (mode fname expected)
+                             (with-temp-buffer
+                               (setq major-mode mode)
+                               (setq-local buffer-file-name fname)
+                               (let ((real (apheleia--get-formatters)))
+                                 (unless (equal real expected)
+                                   real)))))
+                    (it ,description
+                      ,@(mapcar
+                         (lambda (spec)
+                           `(let ((apheleia-mode-alist ,mode-alist)
+                                  (apheleia-mode-predicates ,pred-list))
+                              (expect
+                               (fmt-error ,@spec)
+                               :to-be nil)))
+                         specs)))))
+    (testcases
+     "always returns nil when user options are nil"
+     nil nil
+     ('text-mode "foo.txt" nil)
+     ('fundamental-mode nil nil)
+     ('cc-mode "foo.c" nil)
+     ('mhtml-mode "foo.html" nil))
+    (testcases
+     "selects based on mode, filename, and predicates"
+     '(("\\.foobar\\'" . fmt-foobar)
+       (sgml-mode . fmt-sgml)
+       (html-mode . (fmt-html fmt-html-again))
+       (text-mode . fmt-text)
+       (blah-mode . fmt-blah)
+       ("\\.foobaz\\'" . fmt-foobaz))
+     '((lambda ()
+         (when (and buffer-file-name
+                    (string-match-p "\\.blah" buffer-file-name))
+           'blah-mode)))
+     ('fundamental-mode nil nil)
+     ('fundamental-mode "ok.foobar" '(fmt-foobar))
+     ('text-mode nil '(fmt-text))
+     ('sgml-mode nil '(fmt-sgml))
+     ('html-mode nil '(fmt-html fmt-html-again))
+     ('html-mode "ok.foobar" '(fmt-foobar))
+     ('html-mode "ok.foobaz" '(fmt-html fmt-html-again))
+     ('html-mode "ok.blah" '(fmt-blah))
+     ('html-mode "ok.blah.foobar" '(fmt-foobar))
+     ('html-mode "ok.blah.foobaz" '(fmt-blah)))))