[elpa] scratch/auctex-lexbind 60c12f8 02/10: * font-latex.el (font-latex-make-built-in-keywords): Make it a macro

[Stefan Monnier]

branch: scratch/auctex-lexbind
commit 60c12f8876c93459d146c9a6c93c09ca116a5f2b
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>

    * font-latex.el (font-latex-make-built-in-keywords): Make it a macro
    
    This lets us expose the code it generates to the compiler without
    having to call `byte-compile` explicitly.  It also reduces the reliance
    on `eval`, saving the souls of many kitten along the way.
    
    (font-latex-built-in-keyword-classes): Define it at compile-time as well.
    (font-latex-keywords-1, font-latex-keywords-2):
    Move their definition to `font-latex-make-built-in-keywords`.
    (font-latex-keyword-matcher): Define it at compile-time as well.
    (font-latex--make-match-defun): Rename from `font-latex-make-match-defun`.
    Define it at compile-time as well.  Return the function definition (as
    the docstring suggests) rather than evaluating it.
    (font-latex-make-user-keywords): Adjust call to it.
    (<toplevel>): Don't manually call the byte-compiler.
---
 font-latex.el | 141 ++++++++++++++++++++++++++++++----------------------------
 1 file changed, 72 insertions(+), 69 deletions(-)

diff --git a/font-latex.el b/font-latex.el
index e4a313b..1e9e6be 100644
--- a/font-latex.el
+++ b/font-latex.el
@@ -234,13 +234,8 @@ variable `font-latex-fontify-sectioning'." ',num)
 
 ;;; Keywords
 
-(defvar font-latex-keywords-1 nil
-  "Subdued level highlighting for LaTeX modes.")
-
-(defvar font-latex-keywords-2 nil
-  "High level highlighting for LaTeX modes.")
-
-(defvar font-latex-built-in-keyword-classes
+(eval-and-compile
+(defconst font-latex-built-in-keyword-classes
   '(("warning"
      ("nopagebreak" "pagebreak" "newpage" "clearpage" "cleardoublepage"
       "enlargethispage" "nolinebreak" "linebreak" "newline" "-" "\\" "\\*"
@@ -453,7 +448,7 @@ The fifth element is the type of construct to be matched.  
It can
 be one of 'noarg which will match simple macros without
 arguments (like \"\\foo\"), 'declaration which will match macros
 inside a TeX group (like \"{\\bfseries foo}\"), or 'command which
-will match macros of the form \"\\foo[bar]{baz}\".")
+will match macros of the form \"\\foo[bar]{baz}\"."))
 
 (defcustom font-latex-deactivated-keyword-classes nil
   "List of strings for built-in keyword classes to be deactivated.
@@ -494,7 +489,8 @@ You have to restart Emacs for a change of this variable to 
take effect."
                            ,(car spec)))
                  font-latex-built-in-keyword-classes)))
 
-(defun font-latex-make-match-defun (prefix name face type)
+(eval-and-compile
+(defun font-latex--make-match-defun (prefix name face type)
   "Return a function definition for keyword matching.
 The variable holding the keywords to match are determined by the
 strings PREFIX and NAME.  The type of matcher is determined by
@@ -510,40 +506,40 @@ use."
   ;; (command 1).  This indicated a macro with one argument.  Provide
   ;; a match function in this case but don't actually support it.
   (cond ((or (eq type 'command) (listp type))
-         (eval `(defun ,(intern (concat prefix name)) (limit)
-                  ,(concat "Fontify `" prefix name "' up to LIMIT.
-
-Generated by `font-latex-make-match-defun'.")
-                  (when ,(intern (concat prefix name))
-                    (font-latex-match-command-with-arguments
-                     ,(intern (concat prefix name))
-                     (append
-                      (when (boundp ',(intern (concat prefix name
-                                                      "-keywords-local")))
-                        ,(intern (concat prefix name "-keywords-local")))
-                      ,(intern (concat prefix name "-keywords")))
-                     ;; `face' can be a face symbol, a form returning
-                     ;; a face symbol, or a list of face attributes.
-                     ,(if (and (listp face) (fboundp (car face)))
-                         face
-                        `',face)
-                     limit)))))
+         `(defun ,(intern (concat prefix name)) (limit)
+            ,(concat "Fontify `" prefix name "' up to LIMIT.
+
+Generated by `font-latex--make-match-defun'.")
+            (when ,(intern (concat prefix name))
+              (font-latex-match-command-with-arguments
+               ,(intern (concat prefix name))
+               (append
+                (when (boundp ',(intern (concat prefix name
+                                                "-keywords-local")))
+                  ,(intern (concat prefix name "-keywords-local")))
+                ,(intern (concat prefix name "-keywords")))
+               ;; `face' can be a face symbol, a form returning
+               ;; a face symbol, or a list of face attributes.
+               ,(if (and (listp face) (fboundp (car face)))
+                    face
+                  `',face)
+               limit))))
         ((eq type 'declaration)
-         (eval `(defun ,(intern (concat prefix name)) (limit)
-                  ,(concat "Fontify `" prefix name "' up to LIMIT.
+         `(defun ,(intern (concat prefix name)) (limit)
+            ,(concat "Fontify `" prefix name "' up to LIMIT.
 
-Generated by `font-latex-make-match-defun'.")
-                  (when ,(intern (concat prefix name))
-                    (font-latex-match-command-in-braces
-                     ,(intern (concat prefix name)) limit)))))
+Generated by `font-latex--make-match-defun'.")
+            (when ,(intern (concat prefix name))
+              (font-latex-match-command-in-braces
+               ,(intern (concat prefix name)) limit))))
         ((eq type 'noarg)
-         (eval `(defun ,(intern (concat prefix name)) (limit)
-                  ,(concat "Fontify `" prefix name "' up to LIMIT.
+         `(defun ,(intern (concat prefix name)) (limit)
+            ,(concat "Fontify `" prefix name "' up to LIMIT.
 
-Generated by `font-latex-make-match-defun'.")
-                  (when ,(intern (concat prefix name))
-                    (re-search-forward
-                     ,(intern (concat prefix name)) limit t)))))))
+Generated by `font-latex--make-match-defun'.")
+            (when ,(intern (concat prefix name))
+              (re-search-forward
+               ,(intern (concat prefix name)) limit t))))))
 
 (defun font-latex-keyword-matcher (prefix name face type)
   "Return a matcher and highlighter as required by `font-lock-keywords'.
@@ -587,11 +583,13 @@ use."
          `(,(intern (concat prefix name))
            (0 'font-latex-warning-face t t)
            (1 'font-lock-keyword-face append t)
-           (2 ,face append t)))))
+           (2 ,face append t))))))
 
-(defun font-latex-make-built-in-keywords ()
+(defmacro font-latex-make-built-in-keywords ()
   "Build defuns, defvars and defcustoms for built-in keyword fontification."
-  (dolist (item font-latex-built-in-keyword-classes)
+  (let ((flks '())
+        (defs '()))
+    (dolist (item font-latex-built-in-keyword-classes)
     (let ((prefix "font-latex-match-")
           (name (nth 0 item))
           (keywords (nth 1 item))
@@ -600,7 +598,7 @@ use."
           (type (nth 4 item)))
 
       ;; defvar font-latex-match-*-keywords-local
-      (eval `(defvar ,(intern (concat prefix name "-keywords-local"))
+      (push `(defvar-local ,(intern (concat prefix name "-keywords-local"))
                ',keywords
                ,(concat "Buffer-local keywords to add to `"
                         prefix name "-keywords'.\n\n"
@@ -618,12 +616,11 @@ regular expression\) omitting the leading backslash.")
 This is an internal variable which should not be set directly.
 Use `font-latex-add-keywords' instead.
 
-Generated by `font-latex-make-built-in-keywords'.")))
-      (make-variable-buffer-local
-       (intern (concat prefix name "-keywords-local")))
+Generated by `font-latex-make-built-in-keywords'."))
+            defs)
 
       ;; defcustom font-latex-match-*-keywords
-      (eval `(defcustom ,(intern (concat prefix name "-keywords")) nil
+      (push `(defcustom ,(intern (concat prefix name "-keywords")) nil
                ,(concat "List of keywords "
                         (when (eq type 'command) "and formats ")
                         "for " name " face.\n"
@@ -647,19 +644,19 @@ Generated by `font-latex-make-built-in-keywords'.")
                :set (lambda (symbol value)
                       (set-default symbol value)
                       (funcall ',(intern (concat prefix name "-make"))))
-               :group 'font-latex-keywords))
+               :group 'font-latex-keywords)
+            defs)
 
       ;; defvar font-latex-match-*
-      (eval `(defvar ,(intern (concat prefix name)) nil
+      (push `(defvar-local ,(intern (concat prefix name)) nil
                ,(concat "Regular expression to match " name
                         " keywords.
 
-Generated by `font-latex-make-built-in-keywords'")))
-      (make-variable-buffer-local (intern (concat prefix name)))
+Generated by `font-latex-make-built-in-keywords'"))
+            defs)
 
       ;; defun font-latex-match-*-make
-      ;; Note: The functions are byte-compiled at the end of font-latex.el.
-      (eval `(defun ,(intern (concat prefix name "-make")) ()
+      (push `(defun ,(intern (concat prefix name "-make")) ()
                ,(concat "Make or remake the variable `" prefix name "'.
 
 Generated by `font-latex-make-built-in-keywords'.")
@@ -686,20 +683,26 @@ Generated by `font-latex-make-built-in-keywords'.")
                             (concat
                              (when multi-char-macros "\\|")
                              "\\(?:" (regexp-opt single-char-macros) "\\)"))
-                          "\\)"))))))
+                          "\\)")))))
+            defs)
 
       ;; defun font-latex-match-*
-      (font-latex-make-match-defun prefix name face type)
+      (push (font-latex--make-match-defun prefix name face type) defs)
 
       ;; Add matchers and highlighters to `font-latex-keywords-{1,2}'.
       (let ((keywords-entry (font-latex-keyword-matcher
                              prefix name face type)))
-        (add-to-list (intern (concat "font-latex-keywords-"
-                                     (number-to-string level)))
-                     keywords-entry t)
-        (when (= level 1)
-          (add-to-list 'font-latex-keywords-2
-                       keywords-entry t))))))
+        (push (cons level keywords-entry) flks))))
+    `(progn
+       ,@(nreverse defs)
+       (defvar font-latex-keywords-1
+         ',(nreverse (delq nil (mapcar (lambda (x) (if (eq 1 (car x)) (cdr x)))
+                                       flks)))
+         "High level highlighting for LaTeX modes.")
+       (defvar font-latex-keywords-2
+         ',(nreverse (mapcar #'cdr flks))
+         "High level highlighting for LaTeX modes."))))
+
 (font-latex-make-built-in-keywords)
 
 (defcustom font-latex-user-keyword-classes nil
@@ -826,7 +829,7 @@ Generated by `font-latex-user-keyword-classes'"))))
 Generated by `font-latex-make-user-keywords'.")))
 
         ;; defun font-latex-match-*
-        (font-latex-make-match-defun prefix name face type)
+        (eval (font-latex--make-match-defun prefix name face type) t)
 
         ;; Add the matcher to `font-latex-keywords-2'.
         (add-to-list 'font-latex-keywords-2
@@ -2278,13 +2281,13 @@ set to french, and >>german<< (and 8-bit) are used if 
set to german."
 ;; yourself.
 
 ;;; Byte-compilation of generated functions
-
-(when (byte-code-function-p
-       (symbol-function 'font-latex-make-built-in-keywords))
-  (dolist (elt font-latex-built-in-keyword-classes)
-    (let ((name (nth 0 elt)))
-      (byte-compile (intern (concat "font-latex-match-" name)))
-      (byte-compile (intern (concat "font-latex-match-" name "-make"))))))
+;; Not needed now that we generate the code via a macro.
+;; (when (byte-code-function-p
+;;        (symbol-function 'font-latex-make-built-in-keywords))
+;;   (dolist (elt font-latex-built-in-keyword-classes)
+;;     (let ((name (nth 0 elt)))
+;;       (byte-compile (intern (concat "font-latex-match-" name)))
+;;       (byte-compile (intern (concat "font-latex-match-" name "-make"))))))
 
 
 ;; Provide ourselves: