unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
* Use the new let-opt macro in place of pcase-let in lisp-mode.el
@ 2015-05-18 15:16 Oleh Krehel
  2015-05-18 16:39 ` Stefan Monnier
  0 siblings, 1 reply; 10+ messages in thread
From: Oleh Krehel @ 2015-05-18 15:16 UTC (permalink / raw)
  To: emacs-devel

[-- Attachment #1: Type: text/plain, Size: 2621 bytes --]


Hi all,

As I was trying to figure out how `indent-sexp' works, I got the warning
about an unused lexical var `el-kws-re'.  This type of bug isn't easy to
fix without knowing how `pcase-let' works, and even though it's obvious
what it does in this case, it still very inconvenient:

Instead of a single `kill-sexp' or a comment char, as would be the case
with a plain `let', I would have to remove the fifth symbol in a list of
length 10, and make sure that in the list one page down the fifth sexp
in a list of length 10 is removed.

As I understood, all this hassle is for not having to call `regexp-opt'
at run-time, but instead at compile-time.  For your consideration, I add
a new macro named `let-opt' that is more efficient (I assume,
`macroexpand' doesn't work properly for `pcase-let') than `pcase-let' in
this case, and also much more simple and straightforward.

Here's a small example based on the patch. Using `pcase-let':

(pcase-let
    ((`(,var1 ,var2)
      (eval-when-compile
        (let ((lisp-fdefs '("defmacro" "defsubst" "defun"))
              (el-fdefs '("define-advice" "defadvice" "defalias")))
          (list (regexp-opt lisp-fdefs)
                (regexp-opt (append lisp-fdefs el-fdefs)))))))
  (defconst temp-el-keywords var1)
  (defconst temp-cl-keywords var2))

Here's the equivalent with `let-opt':

(let-opt ((lisp-fdefs '("defmacro" "defsubst" "defun"))
          (el-fdefs '("define-advice" "defadvice" "defalias")))
  (let ((var1 (opt (regexp-opt lisp-fdefs)))
        (var2 (opt (regexp-opt (append lisp-fdefs el-fdefs)))))
    (defconst temp-el-keywords var1)
    (defconst temp-cl-keywords var2)))

And here's the definition of `let-opt':

(defmacro let-opt (bindings &rest body)
  "Like `let', but allows for compile time optimization.
Expressions wrapped with `opt' will be subsituted for their values.
\n(fn BINDINGS BODY)"
  (declare (indent 1) (debug let))
  (let ((bnd (mapcar (lambda (x) (cons (car x) (eval (cadr x))))
                     bindings)))
    `(cl-macrolet ((opt (&rest body)
                        (list 'quote (eval (cons 'progn body) ',bnd))))
       ,@body)))

In my own config, I've also set (defalias 'opt 'identity), so that I can
just incrementally eval stuff when debugging.

Please let me know if you have any comments on this, whether the new
code is basically correct (maybe there are some corner cases that need
to be checked, or there already exists a similar macro), and if it's
appropriate to merge this patch. The disadvantage of the new macro is
that several `let-opt' can't be nested currently, but maybe it's not
needed anyway.

Oleh


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Add-let-opt-macro-instead-of-using-pcase-let.patch --]
[-- Type: text/x-diff, Size: 27716 bytes --]

From e0caf6118392e712b2af72e9973f7404ff05be4a Mon Sep 17 00:00:00 2001
From: Oleh Krehel <ohwoeowho@gmail.com>
Date: Mon, 18 May 2015 16:16:32 +0200
Subject: [PATCH] Add let-opt macro instead of using pcase-let

* lisp/emacs-lisp/lisp-mode.el (let-opt): New let-like macro that
makes its bindings known to the corresponding `eval-when-compile'
construct (`opt').

* lisp/emacs-lisp/lisp-mode.el: Change the top-level `pcase-let' to a
  `let-opt'. Also comment out the unused lexical var `el-kws-re'.

The change greatly improves readability, while providing almost the
same (even shorter) byte code: instead of pre-evaluating 10 variables,
tossing them into a list, and destructuring that list a full screen
page later, the variables are simply bound as they are evaluated,
using the `opt' wrapper.
---
 lisp/emacs-lisp/lisp-mode.el | 484 +++++++++++++++++++++----------------------
 1 file changed, 242 insertions(+), 242 deletions(-)

diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index 108d5cc..919f3f3 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -229,248 +229,248 @@
                              (match-beginning 0)))))
 	  (throw 'found t))))))

-(pcase-let
-    ((`(,vdefs ,tdefs
-        ,el-defs-re ,cl-defs-re
-        ,el-kws-re  ,cl-kws-re
-        ,el-errs-re ,cl-errs-re)
-      (eval-when-compile
-        (let ((lisp-fdefs '("defmacro" "defsubst" "defun"))
-              (lisp-vdefs '("defvar"))
-              (lisp-kw '("cond" "if" "while" "let" "let*" "progn" "prog1"
-                         "prog2" "lambda" "unwind-protect" "condition-case"
-                         "when" "unless" "with-output-to-string"
-                         "ignore-errors" "dotimes" "dolist" "declare"))
-              (lisp-errs '("warn" "error" "signal"))
-              ;; Elisp constructs.  Now they are update dynamically
-              ;; from obarray but they are also used for setting up
-              ;; the keywords for Common Lisp.
-              (el-fdefs '("define-advice" "defadvice" "defalias"
-                          "define-derived-mode" "define-minor-mode"
-                          "define-generic-mode" "define-global-minor-mode"
-                          "define-globalized-minor-mode" "define-skeleton"
-                          "define-widget"))
-              (el-vdefs '("defconst" "defcustom" "defvaralias" "defvar-local"
-                          "defface"))
-              (el-tdefs '("defgroup" "deftheme"))
-              (el-kw '("while-no-input" "letrec" "pcase" "pcase-exhaustive"
-                       "pcase-lambda" "pcase-let" "pcase-let*" "save-restriction"
-                       "save-excursion" "save-selected-window"
-                       ;; "eval-after-load" "eval-next-after-load"
-                       "save-window-excursion" "save-current-buffer"
-                       "save-match-data" "combine-after-change-calls"
-                       "condition-case-unless-debug" "track-mouse"
-                       "eval-and-compile" "eval-when-compile" "with-case-table"
-                       "with-category-table" "with-coding-priority"
-                       "with-current-buffer" "with-demoted-errors"
-                       "with-electric-help" "with-eval-after-load"
-                       "with-file-modes"
-                       "with-local-quit" "with-no-warnings"
-                       "with-output-to-temp-buffer" "with-selected-window"
-                       "with-selected-frame" "with-silent-modifications"
-                       "with-syntax-table" "with-temp-buffer" "with-temp-file"
-                       "with-temp-message" "with-timeout"
-                       "with-timeout-handler"))
-              (el-errs '("user-error"))
-              ;; Common-Lisp constructs supported by EIEIO.  FIXME: namespace.
-              (eieio-fdefs '("defgeneric" "defmethod"))
-              (eieio-tdefs '("defclass"))
-              (eieio-kw '("with-slots"))
-              ;; Common-Lisp constructs supported by cl-lib.
-              (cl-lib-fdefs '("defmacro" "defsubst" "defun" "defmethod"))
-              (cl-lib-tdefs '("defstruct" "deftype"))
-              (cl-lib-kw '("progv" "eval-when" "case" "ecase" "typecase"
-                           "etypecase" "ccase" "ctypecase" "loop" "do" "do*"
-                           "the" "locally" "proclaim" "declaim" "letf" "go"
-                           ;; "lexical-let" "lexical-let*"
-                           "symbol-macrolet" "flet" "flet*" "destructuring-bind"
-                           "labels" "macrolet" "tagbody" "multiple-value-bind"
-                           "block" "return" "return-from"))
-              (cl-lib-errs '("assert" "check-type"))
-              ;; Common-Lisp constructs not supported by cl-lib.
-              (cl-fdefs '("defsetf" "define-method-combination"
-                          "define-condition" "define-setf-expander"
-                          ;; "define-function"??
-                          "define-compiler-macro" "define-modify-macro"))
-              (cl-vdefs '("define-symbol-macro" "defconstant" "defparameter"))
-              (cl-tdefs '("defpackage" "defstruct" "deftype"))
-              (cl-kw '("prog" "prog*" "handler-case" "handler-bind"
-                       "in-package" "restart-case" ;; "inline"
-                       "restart-bind" "break" "multiple-value-prog1"
-                       "compiler-let" "with-accessors" "with-compilation-unit"
-                       "with-condition-restarts" "with-hash-table-iterator"
-                       "with-input-from-string" "with-open-file"
-                       "with-open-stream" "with-package-iterator"
-                       "with-simple-restart" "with-standard-io-syntax"))
-              (cl-errs '("abort" "cerror")))
-
-          (list (append lisp-vdefs el-vdefs cl-vdefs)
-                (append el-tdefs eieio-tdefs cl-tdefs cl-lib-tdefs
-                        (mapcar (lambda (s) (concat "cl-" s)) cl-lib-tdefs))
-
-                ;; Elisp and Common Lisp definers.
-                (regexp-opt (append lisp-fdefs lisp-vdefs
-                                    el-fdefs el-vdefs el-tdefs
-                                    (mapcar (lambda (s) (concat "cl-" s))
-                                            (append cl-lib-fdefs cl-lib-tdefs))
-                                    eieio-fdefs eieio-tdefs)
-                            t)
-                (regexp-opt (append lisp-fdefs lisp-vdefs
-                                    cl-lib-fdefs cl-lib-tdefs
-                                    eieio-fdefs eieio-tdefs
-                                    cl-fdefs cl-vdefs cl-tdefs)
-                            t)
-
-                ;; Elisp and Common Lisp keywords.
-                (regexp-opt (append
-                             lisp-kw el-kw eieio-kw
-                             (cons "go" (mapcar (lambda (s) (concat "cl-" s))
-                                                (remove "go" cl-lib-kw))))
-                            t)
-                (regexp-opt (append lisp-kw cl-kw eieio-kw cl-lib-kw)
-                            t)
-
-                ;; Elisp and Common Lisp "errors".
-                (regexp-opt (append (mapcar (lambda (s) (concat "cl-" s))
-                                            cl-lib-errs)
-                                    lisp-errs el-errs)
-                            t)
-                (regexp-opt (append lisp-errs cl-lib-errs cl-errs) t))))))
-
-  (dolist (v vdefs)
-    (put (intern v) 'lisp-define-type 'var))
-  (dolist (v tdefs)
-    (put (intern v) 'lisp-define-type 'type))
-
-  (define-obsolete-variable-alias 'lisp-font-lock-keywords-1
-    'lisp-el-font-lock-keywords-1 "24.4")
-  (defconst lisp-el-font-lock-keywords-1
-    `( ;; Definitions.
-      (,(concat "(" el-defs-re "\\_>"
-                ;; Any whitespace and defined object.
-                "[ \t']*"
-		"\\(([ \t']*\\)?" ;; An opening paren.
-                "\\(\\(setf\\)[ \t]+\\(?:\\sw\\|\\s_\\)+\\|\\(?:\\sw\\|\\s_\\)+\\)?")
-       (1 font-lock-keyword-face)
-       (3 (let ((type (get (intern-soft (match-string 1)) 'lisp-define-type)))
-	    (cond ((eq type 'var) font-lock-variable-name-face)
-		  ((eq type 'type) font-lock-type-face)
-		  ;; If match-string 2 is non-nil, we encountered a
-		  ;; form like (defalias (intern (concat s "-p"))),
-		  ;; unless match-string 4 is also there.  Then its a
-		  ;; defmethod with (setf foo) as name.
-		  ((or (not (match-string 2))  ;; Normal defun.
-		       (and (match-string 2)   ;; Setf method.
-			    (match-string 4))) font-lock-function-name-face)))
-	  nil t))
-      ;; Emacs Lisp autoload cookies.  Supports the slightly different
-      ;; forms used by mh-e, calendar, etc.
-      ("^;;;###\\([-a-z]*autoload\\)" 1 font-lock-warning-face prepend))
-    "Subdued level highlighting for Emacs Lisp mode.")
-
-  (defconst lisp-cl-font-lock-keywords-1
-    `( ;; Definitions.
-      (,(concat "(" cl-defs-re "\\_>"
-                ;; Any whitespace and defined object.
-                "[ \t']*"
-		"\\(([ \t']*\\)?" ;; An opening paren.
-                "\\(\\(setf\\)[ \t]+\\(?:\\sw\\|\\s_\\)+\\|\\(?:\\sw\\|\\s_\\)+\\)?")
-       (1 font-lock-keyword-face)
-       (3 (let ((type (get (intern-soft (match-string 1)) 'lisp-define-type)))
-            (cond ((eq type 'var) font-lock-variable-name-face)
-                  ((eq type 'type) font-lock-type-face)
-                  ((or (not (match-string 2))  ;; Normal defun.
-		       (and (match-string 2)   ;; Setf function.
-			    (match-string 4))) font-lock-function-name-face)))
-          nil t)))
-    "Subdued level highlighting for Lisp modes.")
-
-  (define-obsolete-variable-alias 'lisp-font-lock-keywords-2
-    'lisp-el-font-lock-keywords-2 "24.4")
-  (defconst lisp-el-font-lock-keywords-2
-    (append
-     lisp-el-font-lock-keywords-1
-     `( ;; Regexp negated char group.
-       ("\\[\\(\\^\\)" 1 font-lock-negation-char-face prepend)
-       ;; Control structures.  Common Lisp forms.
-       (lisp--el-match-keyword . 1)
-       ;; Exit/Feature symbols as constants.
-       (,(concat "(\\(catch\\|throw\\|featurep\\|provide\\|require\\)\\_>"
-                 "[ \t']*\\(\\(?:\\sw\\|\\s_\\)+\\)?")
-        (1 font-lock-keyword-face)
-        (2 font-lock-constant-face nil t))
-       ;; Erroneous structures.
-       (,(concat "(" el-errs-re "\\_>")
-        (1 font-lock-warning-face))
-       ;; Words inside \\[] tend to be for `substitute-command-keys'.
-       ("\\\\\\\\\\[\\(\\(?:\\sw\\|\\s_\\)+\\)\\]"
-        (1 font-lock-constant-face prepend))
-       ;; Words inside `' tend to be symbol names.
-       ("`\\(\\(?:\\sw\\|\\s_\\)\\(?:\\sw\\|\\s_\\)+\\)'"
-        (1 font-lock-constant-face prepend))
-       ;; Constant values.
-       ("\\_<:\\(?:\\sw\\|\\s_\\)+\\_>" 0 font-lock-builtin-face)
-       ;; ELisp and CLisp `&' keywords as types.
-       ("\\_<\\&\\(?:\\sw\\|\\s_\\)+\\_>" . font-lock-type-face)
-       ;; ELisp regexp grouping constructs
-       (,(lambda (bound)
-           (catch 'found
-             ;; The following loop is needed to continue searching after matches
-             ;; that do not occur in strings.  The associated regexp matches one
-             ;; of `\\\\' `\\(' `\\(?:' `\\|' `\\)'.  `\\\\' has been included to
-             ;; avoid highlighting, for example, `\\(' in `\\\\('.
-             (while (re-search-forward "\\(\\\\\\\\\\)\\(?:\\(\\\\\\\\\\)\\|\\((\\(?:\\?[0-9]*:\\)?\\|[|)]\\)\\)" bound t)
-               (unless (match-beginning 2)
-                 (let ((face (get-text-property (1- (point)) 'face)))
-                   (when (or (and (listp face)
-                                  (memq 'font-lock-string-face face))
-                             (eq 'font-lock-string-face face))
-                     (throw 'found t)))))))
-        (1 'font-lock-regexp-grouping-backslash prepend)
-        (3 'font-lock-regexp-grouping-construct prepend))
-       ;; This is too general -- rms.
-       ;; A user complained that he has functions whose names start with `do'
-       ;; and that they get the wrong color.
-       ;; ;; CL `with-' and `do-' constructs
-       ;;("(\\(\\(do-\\|with-\\)\\(\\s_\\|\\w\\)*\\)" 1 font-lock-keyword-face)
-       (lisp--match-hidden-arg
-        (0 '(face font-lock-warning-face
-             help-echo "Hidden behind deeper element; move to another line?")))
-       ))
-    "Gaudy level highlighting for Emacs Lisp mode.")
-
-  (defconst lisp-cl-font-lock-keywords-2
-    (append
-     lisp-cl-font-lock-keywords-1
-     `( ;; Regexp negated char group.
-       ("\\[\\(\\^\\)" 1 font-lock-negation-char-face prepend)
-       ;; Control structures.  Common Lisp forms.
-       (,(concat "(" cl-kws-re "\\_>") . 1)
-       ;; Exit/Feature symbols as constants.
-       (,(concat "(\\(catch\\|throw\\|provide\\|require\\)\\_>"
-                 "[ \t']*\\(\\(?:\\sw\\|\\s_\\)+\\)?")
-        (1 font-lock-keyword-face)
-        (2 font-lock-constant-face nil t))
-       ;; Erroneous structures.
-       (,(concat "(" cl-errs-re "\\_>")
-        (1 font-lock-warning-face))
-       ;; Words inside `' tend to be symbol names.
-       ("`\\(\\(?:\\sw\\|\\s_\\)\\(?:\\sw\\|\\s_\\)+\\)'"
-        (1 font-lock-constant-face prepend))
-       ;; Constant values.
-       ("\\_<:\\(?:\\sw\\|\\s_\\)+\\_>" 0 font-lock-builtin-face)
-       ;; ELisp and CLisp `&' keywords as types.
-       ("\\_<\\&\\(?:\\sw\\|\\s_\\)+\\_>" . font-lock-type-face)
-       ;; This is too general -- rms.
-       ;; A user complained that he has functions whose names start with `do'
-       ;; and that they get the wrong color.
-       ;; ;; CL `with-' and `do-' constructs
-       ;;("(\\(\\(do-\\|with-\\)\\(\\s_\\|\\w\\)*\\)" 1 font-lock-keyword-face)
-       (lisp--match-hidden-arg
-        (0 '(face font-lock-warning-face
-             help-echo "Hidden behind deeper element; move to another line?")))
-       ))
-    "Gaudy level highlighting for Lisp modes."))
+(defmacro let-opt (bindings &rest body)
+  "Like `let', but allows for compile time optimization.
+Expressions wrapped with `opt' will be subsituted for their values.
+\n(fn BINDINGS BODY)"
+  (declare (indent 1) (debug let))
+  (let ((bnd (mapcar (lambda (x) (cons (car x) (eval (cadr x))))
+                     bindings)))
+    `(cl-macrolet ((opt (&rest body)
+                        (list 'quote (eval (cons 'progn body) ',bnd))))
+       ,@body)))
+
+(let-opt ((lisp-fdefs '("defmacro" "defsubst" "defun"))
+          (lisp-vdefs '("defvar"))
+          (lisp-kw '("cond" "if" "while" "let" "let*" "progn" "prog1"
+                     "prog2" "lambda" "unwind-protect" "condition-case"
+                     "when" "unless" "with-output-to-string"
+                     "ignore-errors" "dotimes" "dolist" "declare"))
+          (lisp-errs '("warn" "error" "signal"))
+          ;; Elisp constructs.  Now they are update dynamically
+          ;; from obarray but they are also used for setting up
+          ;; the keywords for Common Lisp.
+          (el-fdefs '("define-advice" "defadvice" "defalias"
+                      "define-derived-mode" "define-minor-mode"
+                      "define-generic-mode" "define-global-minor-mode"
+                      "define-globalized-minor-mode" "define-skeleton"
+                      "define-widget"))
+          (el-vdefs '("defconst" "defcustom" "defvaralias" "defvar-local"
+                      "defface"))
+          (el-tdefs '("defgroup" "deftheme"))
+          (el-kw '("while-no-input" "letrec" "pcase" "pcase-exhaustive"
+                   "pcase-lambda" "pcase-let" "pcase-let*" "save-restriction"
+                   "save-excursion" "save-selected-window"
+                   ;; "eval-after-load" "eval-next-after-load"
+                   "save-window-excursion" "save-current-buffer"
+                   "save-match-data" "combine-after-change-calls"
+                   "condition-case-unless-debug" "track-mouse"
+                   "eval-and-compile" "eval-when-compile" "with-case-table"
+                   "with-category-table" "with-coding-priority"
+                   "with-current-buffer" "with-demoted-errors"
+                   "with-electric-help" "with-eval-after-load"
+                   "with-file-modes"
+                   "with-local-quit" "with-no-warnings"
+                   "with-output-to-temp-buffer" "with-selected-window"
+                   "with-selected-frame" "with-silent-modifications"
+                   "with-syntax-table" "with-temp-buffer" "with-temp-file"
+                   "with-temp-message" "with-timeout"
+                   "with-timeout-handler"))
+          (el-errs '("user-error"))
+          ;; Common-Lisp constructs supported by EIEIO.  FIXME: namespace.
+          (eieio-fdefs '("defgeneric" "defmethod"))
+          (eieio-tdefs '("defclass"))
+          (eieio-kw '("with-slots"))
+          ;; Common-Lisp constructs supported by cl-lib.
+          (cl-lib-fdefs '("defmacro" "defsubst" "defun" "defmethod"))
+          (cl-lib-tdefs '("defstruct" "deftype"))
+          (cl-lib-kw '("progv" "eval-when" "case" "ecase" "typecase"
+                       "etypecase" "ccase" "ctypecase" "loop" "do" "do*"
+                       "the" "locally" "proclaim" "declaim" "letf" "go"
+                       ;; "lexical-let" "lexical-let*"
+                       "symbol-macrolet" "flet" "flet*" "destructuring-bind"
+                       "labels" "macrolet" "tagbody" "multiple-value-bind"
+                       "block" "return" "return-from"))
+          (cl-lib-errs '("assert" "check-type"))
+          ;; Common-Lisp constructs not supported by cl-lib.
+          (cl-fdefs '("defsetf" "define-method-combination"
+                      "define-condition" "define-setf-expander"
+                      ;; "define-function"??
+                      "define-compiler-macro" "define-modify-macro"))
+          (cl-vdefs '("define-symbol-macro" "defconstant" "defparameter"))
+          (cl-tdefs '("defpackage" "defstruct" "deftype"))
+          (cl-kw '("prog" "prog*" "handler-case" "handler-bind"
+                   "in-package" "restart-case" ;; "inline"
+                   "restart-bind" "break" "multiple-value-prog1"
+                   "compiler-let" "with-accessors" "with-compilation-unit"
+                   "with-condition-restarts" "with-hash-table-iterator"
+                   "with-input-from-string" "with-open-file"
+                   "with-open-stream" "with-package-iterator"
+                   "with-simple-restart" "with-standard-io-syntax"))
+          (cl-errs '("abort" "cerror")))
+  (let ((vdefs (opt (append lisp-vdefs el-vdefs cl-vdefs)))
+        (tdefs (opt (append el-tdefs eieio-tdefs cl-tdefs cl-lib-tdefs
+                            (mapcar (lambda (s) (concat "cl-" s)) cl-lib-tdefs))))
+        ;; Elisp and Common Lisp definers.
+        (el-defs-re (opt (regexp-opt (append lisp-fdefs lisp-vdefs
+                                             el-fdefs el-vdefs el-tdefs
+                                             (mapcar (lambda (s) (concat "cl-" s))
+                                                     (append cl-lib-fdefs cl-lib-tdefs))
+                                             eieio-fdefs eieio-tdefs)
+                                     t)))
+        (cl-defs-re (opt (regexp-opt (append lisp-fdefs lisp-vdefs
+                                             cl-lib-fdefs cl-lib-tdefs
+                                             eieio-fdefs eieio-tdefs
+                                             cl-fdefs cl-vdefs cl-tdefs)
+                                     t)))
+        ;; Elisp and Common Lisp keywords.
+        ;; (el-kws-re (opt (regexp-opt (append
+        ;;                              lisp-kw el-kw eieio-kw
+        ;;                              (cons "go" (mapcar (lambda (s) (concat "cl-" s))
+        ;;                                                 (remove "go" cl-lib-kw))))
+        ;;                             t)))
+        (cl-kws-re (opt (regexp-opt (append lisp-kw cl-kw eieio-kw cl-lib-kw)
+                                    t)))
+        ;; Elisp and Common Lisp "errors".
+        (el-errs-re (opt (regexp-opt (append (mapcar (lambda (s) (concat "cl-" s))
+                                                     cl-lib-errs)
+                                             lisp-errs el-errs)
+                                     t)))
+        (cl-errs-re (opt (regexp-opt (append lisp-errs cl-lib-errs cl-errs) t))))
+    (dolist (v vdefs)
+      (put (intern v) 'lisp-define-type 'var))
+    (dolist (v tdefs)
+      (put (intern v) 'lisp-define-type 'type))
+
+    (define-obsolete-variable-alias 'lisp-font-lock-keywords-1
+      'lisp-el-font-lock-keywords-1 "24.4")
+    (defconst lisp-el-font-lock-keywords-1
+      `( ;; Definitions.
+        (,(concat "(" el-defs-re "\\_>"
+                  ;; Any whitespace and defined object.
+                  "[ \t']*"
+                  "\\(([ \t']*\\)?" ;; An opening paren.
+                  "\\(\\(setf\\)[ \t]+\\(?:\\sw\\|\\s_\\)+\\|\\(?:\\sw\\|\\s_\\)+\\)?")
+         (1 font-lock-keyword-face)
+         (3 (let ((type (get (intern-soft (match-string 1)) 'lisp-define-type)))
+              (cond ((eq type 'var) font-lock-variable-name-face)
+                    ((eq type 'type) font-lock-type-face)
+                    ;; If match-string 2 is non-nil, we encountered a
+                    ;; form like (defalias (intern (concat s "-p"))),
+                    ;; unless match-string 4 is also there.  Then its a
+                    ;; defmethod with (setf foo) as name.
+                    ((or (not (match-string 2)) ;; Normal defun.
+                         (and (match-string 2)  ;; Setf method.
+                              (match-string 4))) font-lock-function-name-face)))
+            nil t))
+        ;; Emacs Lisp autoload cookies.  Supports the slightly different
+        ;; forms used by mh-e, calendar, etc.
+        ("^;;;###\\([-a-z]*autoload\\)" 1 font-lock-warning-face prepend))
+      "Subdued level highlighting for Emacs Lisp mode.")
+
+    (defconst lisp-cl-font-lock-keywords-1
+      `( ;; Definitions.
+        (,(concat "(" cl-defs-re "\\_>"
+                  ;; Any whitespace and defined object.
+                  "[ \t']*"
+                  "\\(([ \t']*\\)?" ;; An opening paren.
+                  "\\(\\(setf\\)[ \t]+\\(?:\\sw\\|\\s_\\)+\\|\\(?:\\sw\\|\\s_\\)+\\)?")
+         (1 font-lock-keyword-face)
+         (3 (let ((type (get (intern-soft (match-string 1)) 'lisp-define-type)))
+              (cond ((eq type 'var) font-lock-variable-name-face)
+                    ((eq type 'type) font-lock-type-face)
+                    ((or (not (match-string 2)) ;; Normal defun.
+                         (and (match-string 2)  ;; Setf function.
+                              (match-string 4))) font-lock-function-name-face)))
+            nil t)))
+      "Subdued level highlighting for Lisp modes.")
+
+    (define-obsolete-variable-alias 'lisp-font-lock-keywords-2
+      'lisp-el-font-lock-keywords-2 "24.4")
+    (defconst lisp-el-font-lock-keywords-2
+      (append
+       lisp-el-font-lock-keywords-1
+       `( ;; Regexp negated char group.
+         ("\\[\\(\\^\\)" 1 font-lock-negation-char-face prepend)
+         ;; Control structures.  Common Lisp forms.
+         (lisp--el-match-keyword . 1)
+         ;; Exit/Feature symbols as constants.
+         (,(concat "(\\(catch\\|throw\\|featurep\\|provide\\|require\\)\\_>"
+                   "[ \t']*\\(\\(?:\\sw\\|\\s_\\)+\\)?")
+          (1 font-lock-keyword-face)
+          (2 font-lock-constant-face nil t))
+         ;; Erroneous structures.
+         (,(concat "(" el-errs-re "\\_>")
+          (1 font-lock-warning-face))
+         ;; Words inside \\[] tend to be for `substitute-command-keys'.
+         ("\\\\\\\\\\[\\(\\(?:\\sw\\|\\s_\\)+\\)\\]"
+          (1 font-lock-constant-face prepend))
+         ;; Words inside `' tend to be symbol names.
+         ("`\\(\\(?:\\sw\\|\\s_\\)\\(?:\\sw\\|\\s_\\)+\\)'"
+          (1 font-lock-constant-face prepend))
+         ;; Constant values.
+         ("\\_<:\\(?:\\sw\\|\\s_\\)+\\_>" 0 font-lock-builtin-face)
+         ;; ELisp and CLisp `&' keywords as types.
+         ("\\_<\\&\\(?:\\sw\\|\\s_\\)+\\_>" . font-lock-type-face)
+         ;; ELisp regexp grouping constructs
+         (,(lambda (bound)
+             (catch 'found
+               ;; The following loop is needed to continue searching after matches
+               ;; that do not occur in strings.  The associated regexp matches one
+               ;; of `\\\\' `\\(' `\\(?:' `\\|' `\\)'.  `\\\\' has been included to
+               ;; avoid highlighting, for example, `\\(' in `\\\\('.
+               (while (re-search-forward "\\(\\\\\\\\\\)\\(?:\\(\\\\\\\\\\)\\|\\((\\(?:\\?[0-9]*:\\)?\\|[|)]\\)\\)" bound t)
+                 (unless (match-beginning 2)
+                   (let ((face (get-text-property (1- (point)) 'face)))
+                     (when (or (and (listp face)
+                                    (memq 'font-lock-string-face face))
+                               (eq 'font-lock-string-face face))
+                       (throw 'found t)))))))
+          (1 'font-lock-regexp-grouping-backslash prepend)
+          (3 'font-lock-regexp-grouping-construct prepend))
+         ;; This is too general -- rms.
+         ;; A user complained that he has functions whose names start with `do'
+         ;; and that they get the wrong color.
+         ;; ;; CL `with-' and `do-' constructs
+         ;;("(\\(\\(do-\\|with-\\)\\(\\s_\\|\\w\\)*\\)" 1 font-lock-keyword-face)
+         (lisp--match-hidden-arg
+          (0 '(face font-lock-warning-face
+                    help-echo "Hidden behind deeper element; move to another line?")))
+         ))
+      "Gaudy level highlighting for Emacs Lisp mode.")
+
+    (defconst lisp-cl-font-lock-keywords-2
+      (append
+       lisp-cl-font-lock-keywords-1
+       `( ;; Regexp negated char group.
+         ("\\[\\(\\^\\)" 1 font-lock-negation-char-face prepend)
+         ;; Control structures.  Common Lisp forms.
+         (,(concat "(" cl-kws-re "\\_>") . 1)
+         ;; Exit/Feature symbols as constants.
+         (,(concat "(\\(catch\\|throw\\|provide\\|require\\)\\_>"
+                   "[ \t']*\\(\\(?:\\sw\\|\\s_\\)+\\)?")
+          (1 font-lock-keyword-face)
+          (2 font-lock-constant-face nil t))
+         ;; Erroneous structures.
+         (,(concat "(" cl-errs-re "\\_>")
+          (1 font-lock-warning-face))
+         ;; Words inside `' tend to be symbol names.
+         ("`\\(\\(?:\\sw\\|\\s_\\)\\(?:\\sw\\|\\s_\\)+\\)'"
+          (1 font-lock-constant-face prepend))
+         ;; Constant values.
+         ("\\_<:\\(?:\\sw\\|\\s_\\)+\\_>" 0 font-lock-builtin-face)
+         ;; ELisp and CLisp `&' keywords as types.
+         ("\\_<\\&\\(?:\\sw\\|\\s_\\)+\\_>" . font-lock-type-face)
+         ;; This is too general -- rms.
+         ;; A user complained that he has functions whose names start with `do'
+         ;; and that they get the wrong color.
+         ;; ;; CL `with-' and `do-' constructs
+         ;;("(\\(\\(do-\\|with-\\)\\(\\s_\\|\\w\\)*\\)" 1 font-lock-keyword-face)
+         (lisp--match-hidden-arg
+          (0 '(face font-lock-warning-face
+                    help-echo "Hidden behind deeper element; move to another line?")))
+         ))
+      "Gaudy level highlighting for Lisp modes.")))

 (define-obsolete-variable-alias 'lisp-font-lock-keywords
   'lisp-el-font-lock-keywords "24.4")
--
1.8.4

^ permalink raw reply related	[flat|nested] 10+ messages in thread

* Re: Use the new let-opt macro in place of pcase-let in lisp-mode.el
  2015-05-18 15:16 Use the new let-opt macro in place of pcase-let in lisp-mode.el Oleh Krehel
@ 2015-05-18 16:39 ` Stefan Monnier
  2015-05-18 17:26   ` Oleh Krehel
  0 siblings, 1 reply; 10+ messages in thread
From: Stefan Monnier @ 2015-05-18 16:39 UTC (permalink / raw)
  To: Oleh Krehel; +Cc: emacs-devel

> As I understood, all this hassle is for not having to call `regexp-opt'
> at run-time, but instead at compile-time.

That's right (and it's particularly important here since this file is
preloaded, so calling it at runtime would require preloading regexp-opt
as well).

> For your consideration, I add a new macro named `let-opt' that is more
> efficient (I assume, `macroexpand' doesn't work properly for
> `pcase-let') than `pcase-let' in this case, and also much more simple
> and straightforward.

For this particular case, I think efficiency is of no importance, really.
And in their more general uses, these two macros are fairly unrelated.

> (defmacro let-opt (bindings &rest body)
>   "Like `let', but allows for compile time optimization.
> Expressions wrapped with `opt' will be subsituted for their values.
> \n(fn BINDINGS BODY)"
>   (declare (indent 1) (debug let))
>   (let ((bnd (mapcar (lambda (x) (cons (car x) (eval (cadr x))))
>                      bindings)))
>     `(cl-macrolet ((opt (&rest body)
>                         (list 'quote (eval (cons 'progn body) ',bnd))))
>        ,@body)))

I think I like this idea of "compile-time-only let-binding".
But I don't like this `opt' thingy very much and I think we can get rid
of it if we use dynamic-scoping instead.

IOW, define a let-when-compile macro which uses progv to setup the
bindings and then calls `macroexpand-all' on the body.  The body's
`eval-when-compile' can then use those vars just fine.


        Stefan



^ permalink raw reply	[flat|nested] 10+ messages in thread

* Re: Use the new let-opt macro in place of pcase-let in lisp-mode.el
  2015-05-18 16:39 ` Stefan Monnier
@ 2015-05-18 17:26   ` Oleh Krehel
  2015-05-19  1:11     ` Stefan Monnier
  0 siblings, 1 reply; 10+ messages in thread
From: Oleh Krehel @ 2015-05-18 17:26 UTC (permalink / raw)
  To: Stefan Monnier; +Cc: emacs-devel

Stefan Monnier <monnier@iro.umontreal.ca> writes:

>> (defmacro let-opt (bindings &rest body)
>>   "Like `let', but allows for compile time optimization.
>> Expressions wrapped with `opt' will be subsituted for their values.
>> \n(fn BINDINGS BODY)"
>>   (declare (indent 1) (debug let))
>>   (let ((bnd (mapcar (lambda (x) (cons (car x) (eval (cadr x))))
>>                      bindings)))
>>     `(cl-macrolet ((opt (&rest body)
>>                         (list 'quote (eval (cons 'progn body) ',bnd))))
>>        ,@body)))
>
> I think I like this idea of "compile-time-only let-binding".
> But I don't like this `opt' thingy very much and I think we can get rid
> of it if we use dynamic-scoping instead.
>
> IOW, define a let-when-compile macro which uses progv to setup the
> bindings and then calls `macroexpand-all' on the body.  The body's
> `eval-when-compile' can then use those vars just fine.

I wrote this:

(defmacro let-when-compile (bindings &rest body)
  "Like `let', but allows for compile time optimization.
\n(fn BINDINGS BODY)"
  (declare (indent 1) (debug let))
  `(progv ',(mapcar #'car bindings)
       ',(mapcar (lambda (x) (eval (cadr x))) bindings)
     ,@body))

It sort of works (evals to the correct thing, and the byte code looks
OK), but I get a lot of byte compiler warnings. And I don't see while
`progv' should expand to a `while' loop. Anyway, here's an example:

(let-when-compile ((foo (+ 2 2)))
  (defvar bar (+ foo foo)))

And here's the expansion, after I've evaluated the while loop:

(eval
 (let ((foo (quote 4)))
   (funcall
    (quote
     (lambda nil
       (defvar bar (+ foo foo)))))))

On the other hand, using `let-opt':

(let-opt ((foo (+ 2 2)))
  (defvar bar (opt (+ foo foo))))

expands to this:

(defvar bar '8)

Which I think could be valuable while refactoring.

Oleh



^ permalink raw reply	[flat|nested] 10+ messages in thread

* Re: Use the new let-opt macro in place of pcase-let in lisp-mode.el
  2015-05-18 17:26   ` Oleh Krehel
@ 2015-05-19  1:11     ` Stefan Monnier
  2015-05-19  8:08       ` Oleh Krehel
  0 siblings, 1 reply; 10+ messages in thread
From: Stefan Monnier @ 2015-05-19  1:11 UTC (permalink / raw)
  To: Oleh Krehel; +Cc: emacs-devel

>> IOW, define a let-when-compile macro which uses progv to setup the
>> bindings and then calls `macroexpand-all' on the body.  The body's
>> `eval-when-compile' can then use those vars just fine.

> I wrote this:

> (defmacro let-when-compile (bindings &rest body)
>   "Like `let', but allows for compile time optimization.
> \n(fn BINDINGS BODY)"
>   (declare (indent 1) (debug let))
>   `(progv ',(mapcar #'car bindings)
>        ',(mapcar (lambda (x) (eval (cadr x))) bindings)
>      ,@body))

That's not what I suggest.  The `progv' should be done at
macroexpansion-time (otherwise, you're better off using `let').


        Stefan



^ permalink raw reply	[flat|nested] 10+ messages in thread

* Re: Use the new let-opt macro in place of pcase-let in lisp-mode.el
  2015-05-19  1:11     ` Stefan Monnier
@ 2015-05-19  8:08       ` Oleh Krehel
  2015-05-20  2:03         ` Stefan Monnier
  0 siblings, 1 reply; 10+ messages in thread
From: Oleh Krehel @ 2015-05-19  8:08 UTC (permalink / raw)
  To: Stefan Monnier; +Cc: emacs-devel

[-- Attachment #1: Type: text/plain, Size: 1813 bytes --]

Stefan Monnier <monnier@iro.umontreal.ca> writes:

>>> IOW, define a let-when-compile macro which uses progv to setup the
>>> bindings and then calls `macroexpand-all' on the body.  The body's
>>> `eval-when-compile' can then use those vars just fine.
>
>> I wrote this:
>
>> (defmacro let-when-compile (bindings &rest body)
>>   "Like `let', but allows for compile time optimization.
>> \n(fn BINDINGS BODY)"
>>   (declare (indent 1) (debug let))
>>   `(progv ',(mapcar #'car bindings)
>>        ',(mapcar (lambda (x) (eval (cadr x))) bindings)
>>      ,@body))
>
> That's not what I suggest.  The `progv' should be done at
> macroexpansion-time (otherwise, you're better off using `let').

OK, here's the updated macro:

(defmacro let-when-compile (bindings &rest body)
  "Like `let', but allows for compile time optimization.
\n(fn BINDINGS BODY)"
  (declare (indent 1) (debug let))
  (progv (mapcar #'car bindings)
      (mapcar (lambda (x) (eval (cadr x))) bindings)
    (funcall
     `(lambda ()
        (macroexpand-all
         '(progn
            ,@body))))))

The code in lisp-mode.el works fine, but there's still one thing on
which I'm not sure: what should happen if an `eval-when-compile' wrapper
is omitted?

Example that works fine:

(macroexpand
 '(let-when-compile ((foo (+ 2 3)))
   (setq bar (eval-when-compile (+ foo foo)))
   (setq boo (eval-when-compile (* foo foo)))))
;; =>
;; (progn (setq bar (quote 10)) (setq boo (quote 25)))

Example that works weird:

(macroexpand
 '(let-when-compile ((foo (+ 2 3)))
   (setq bar (+ foo foo))
   (setq boo (eval-when-compile (* foo foo)))))
;; =>
;; (progn (setq bar (+ foo foo)) (setq boo (quote 25)))

In this case, maybe `foo' could be let bound around the resulting
expression, but that kind of defeats the purpose of `let-when-compile'.

Oleh


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Add-let-when-compile-macro-instead-of-using-pcase-le.patch --]
[-- Type: text/x-diff, Size: 27570 bytes --]

From aa19096196f1302a070780e22fa672c59a2dfaf2 Mon Sep 17 00:00:00 2001
From: Oleh Krehel <ohwoeowho@gmail.com>
Date: Tue, 19 May 2015 09:49:12 +0200
Subject: [PATCH] Add let-when-compile macro instead of using pcase-let

* lisp/emacs-lisp/lisp-mode.el (let-when-compile): New let-like macro
that makes its bindings known to macros like `eval-when-compile' in
the body.

* lisp/emacs-lisp/lisp-mode.el: Change the top-level `pcase-let' to a
  `let-when-compile'. Also comment out the unused lexical var
  `el-kws-re'.

The change greatly improves readability, while providing almost the
same (even shorter) byte code: instead of pre-evaluating 10 variables,
tossing them into a list, and destructuring that list a full screen
page later, the variables are simply bound as they are evaluated,
wrapped individually in `eval-when-compile'.
---
 lisp/emacs-lisp/lisp-mode.el | 494 ++++++++++++++++++++++---------------------
 1 file changed, 252 insertions(+), 242 deletions(-)

diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index 108d5cc..2d035a2 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -229,248 +229,258 @@
                              (match-beginning 0)))))
 	  (throw 'found t))))))
 
-(pcase-let
-    ((`(,vdefs ,tdefs
-        ,el-defs-re ,cl-defs-re
-        ,el-kws-re  ,cl-kws-re
-        ,el-errs-re ,cl-errs-re)
-      (eval-when-compile
-        (let ((lisp-fdefs '("defmacro" "defsubst" "defun"))
-              (lisp-vdefs '("defvar"))
-              (lisp-kw '("cond" "if" "while" "let" "let*" "progn" "prog1"
-                         "prog2" "lambda" "unwind-protect" "condition-case"
-                         "when" "unless" "with-output-to-string"
-                         "ignore-errors" "dotimes" "dolist" "declare"))
-              (lisp-errs '("warn" "error" "signal"))
-              ;; Elisp constructs.  Now they are update dynamically
-              ;; from obarray but they are also used for setting up
-              ;; the keywords for Common Lisp.
-              (el-fdefs '("define-advice" "defadvice" "defalias"
-                          "define-derived-mode" "define-minor-mode"
-                          "define-generic-mode" "define-global-minor-mode"
-                          "define-globalized-minor-mode" "define-skeleton"
-                          "define-widget"))
-              (el-vdefs '("defconst" "defcustom" "defvaralias" "defvar-local"
-                          "defface"))
-              (el-tdefs '("defgroup" "deftheme"))
-              (el-kw '("while-no-input" "letrec" "pcase" "pcase-exhaustive"
-                       "pcase-lambda" "pcase-let" "pcase-let*" "save-restriction"
-                       "save-excursion" "save-selected-window"
-                       ;; "eval-after-load" "eval-next-after-load"
-                       "save-window-excursion" "save-current-buffer"
-                       "save-match-data" "combine-after-change-calls"
-                       "condition-case-unless-debug" "track-mouse"
-                       "eval-and-compile" "eval-when-compile" "with-case-table"
-                       "with-category-table" "with-coding-priority"
-                       "with-current-buffer" "with-demoted-errors"
-                       "with-electric-help" "with-eval-after-load"
-                       "with-file-modes"
-                       "with-local-quit" "with-no-warnings"
-                       "with-output-to-temp-buffer" "with-selected-window"
-                       "with-selected-frame" "with-silent-modifications"
-                       "with-syntax-table" "with-temp-buffer" "with-temp-file"
-                       "with-temp-message" "with-timeout"
-                       "with-timeout-handler"))
-              (el-errs '("user-error"))
-              ;; Common-Lisp constructs supported by EIEIO.  FIXME: namespace.
-              (eieio-fdefs '("defgeneric" "defmethod"))
-              (eieio-tdefs '("defclass"))
-              (eieio-kw '("with-slots"))
-              ;; Common-Lisp constructs supported by cl-lib.
-              (cl-lib-fdefs '("defmacro" "defsubst" "defun" "defmethod"))
-              (cl-lib-tdefs '("defstruct" "deftype"))
-              (cl-lib-kw '("progv" "eval-when" "case" "ecase" "typecase"
-                           "etypecase" "ccase" "ctypecase" "loop" "do" "do*"
-                           "the" "locally" "proclaim" "declaim" "letf" "go"
-                           ;; "lexical-let" "lexical-let*"
-                           "symbol-macrolet" "flet" "flet*" "destructuring-bind"
-                           "labels" "macrolet" "tagbody" "multiple-value-bind"
-                           "block" "return" "return-from"))
-              (cl-lib-errs '("assert" "check-type"))
-              ;; Common-Lisp constructs not supported by cl-lib.
-              (cl-fdefs '("defsetf" "define-method-combination"
-                          "define-condition" "define-setf-expander"
-                          ;; "define-function"??
-                          "define-compiler-macro" "define-modify-macro"))
-              (cl-vdefs '("define-symbol-macro" "defconstant" "defparameter"))
-              (cl-tdefs '("defpackage" "defstruct" "deftype"))
-              (cl-kw '("prog" "prog*" "handler-case" "handler-bind"
-                       "in-package" "restart-case" ;; "inline"
-                       "restart-bind" "break" "multiple-value-prog1"
-                       "compiler-let" "with-accessors" "with-compilation-unit"
-                       "with-condition-restarts" "with-hash-table-iterator"
-                       "with-input-from-string" "with-open-file"
-                       "with-open-stream" "with-package-iterator"
-                       "with-simple-restart" "with-standard-io-syntax"))
-              (cl-errs '("abort" "cerror")))
-
-          (list (append lisp-vdefs el-vdefs cl-vdefs)
-                (append el-tdefs eieio-tdefs cl-tdefs cl-lib-tdefs
-                        (mapcar (lambda (s) (concat "cl-" s)) cl-lib-tdefs))
-
-                ;; Elisp and Common Lisp definers.
-                (regexp-opt (append lisp-fdefs lisp-vdefs
-                                    el-fdefs el-vdefs el-tdefs
-                                    (mapcar (lambda (s) (concat "cl-" s))
-                                            (append cl-lib-fdefs cl-lib-tdefs))
-                                    eieio-fdefs eieio-tdefs)
-                            t)
-                (regexp-opt (append lisp-fdefs lisp-vdefs
-                                    cl-lib-fdefs cl-lib-tdefs
-                                    eieio-fdefs eieio-tdefs
-                                    cl-fdefs cl-vdefs cl-tdefs)
-                            t)
-
-                ;; Elisp and Common Lisp keywords.
-                (regexp-opt (append
-                             lisp-kw el-kw eieio-kw
-                             (cons "go" (mapcar (lambda (s) (concat "cl-" s))
-                                                (remove "go" cl-lib-kw))))
-                            t)
-                (regexp-opt (append lisp-kw cl-kw eieio-kw cl-lib-kw)
-                            t)
-
-                ;; Elisp and Common Lisp "errors".
-                (regexp-opt (append (mapcar (lambda (s) (concat "cl-" s))
-                                            cl-lib-errs)
-                                    lisp-errs el-errs)
-                            t)
-                (regexp-opt (append lisp-errs cl-lib-errs cl-errs) t))))))
-
-  (dolist (v vdefs)
-    (put (intern v) 'lisp-define-type 'var))
-  (dolist (v tdefs)
-    (put (intern v) 'lisp-define-type 'type))
-
-  (define-obsolete-variable-alias 'lisp-font-lock-keywords-1
-    'lisp-el-font-lock-keywords-1 "24.4")
-  (defconst lisp-el-font-lock-keywords-1
-    `( ;; Definitions.
-      (,(concat "(" el-defs-re "\\_>"
-                ;; Any whitespace and defined object.
-                "[ \t']*"
-		"\\(([ \t']*\\)?" ;; An opening paren.
-                "\\(\\(setf\\)[ \t]+\\(?:\\sw\\|\\s_\\)+\\|\\(?:\\sw\\|\\s_\\)+\\)?")
-       (1 font-lock-keyword-face)
-       (3 (let ((type (get (intern-soft (match-string 1)) 'lisp-define-type)))
-	    (cond ((eq type 'var) font-lock-variable-name-face)
-		  ((eq type 'type) font-lock-type-face)
-		  ;; If match-string 2 is non-nil, we encountered a
-		  ;; form like (defalias (intern (concat s "-p"))),
-		  ;; unless match-string 4 is also there.  Then its a
-		  ;; defmethod with (setf foo) as name.
-		  ((or (not (match-string 2))  ;; Normal defun.
-		       (and (match-string 2)   ;; Setf method.
-			    (match-string 4))) font-lock-function-name-face)))
-	  nil t))
-      ;; Emacs Lisp autoload cookies.  Supports the slightly different
-      ;; forms used by mh-e, calendar, etc.
-      ("^;;;###\\([-a-z]*autoload\\)" 1 font-lock-warning-face prepend))
-    "Subdued level highlighting for Emacs Lisp mode.")
-
-  (defconst lisp-cl-font-lock-keywords-1
-    `( ;; Definitions.
-      (,(concat "(" cl-defs-re "\\_>"
-                ;; Any whitespace and defined object.
-                "[ \t']*"
-		"\\(([ \t']*\\)?" ;; An opening paren.
-                "\\(\\(setf\\)[ \t]+\\(?:\\sw\\|\\s_\\)+\\|\\(?:\\sw\\|\\s_\\)+\\)?")
-       (1 font-lock-keyword-face)
-       (3 (let ((type (get (intern-soft (match-string 1)) 'lisp-define-type)))
-            (cond ((eq type 'var) font-lock-variable-name-face)
-                  ((eq type 'type) font-lock-type-face)
-                  ((or (not (match-string 2))  ;; Normal defun.
-		       (and (match-string 2)   ;; Setf function.
-			    (match-string 4))) font-lock-function-name-face)))
-          nil t)))
-    "Subdued level highlighting for Lisp modes.")
-
-  (define-obsolete-variable-alias 'lisp-font-lock-keywords-2
-    'lisp-el-font-lock-keywords-2 "24.4")
-  (defconst lisp-el-font-lock-keywords-2
-    (append
-     lisp-el-font-lock-keywords-1
-     `( ;; Regexp negated char group.
-       ("\\[\\(\\^\\)" 1 font-lock-negation-char-face prepend)
-       ;; Control structures.  Common Lisp forms.
-       (lisp--el-match-keyword . 1)
-       ;; Exit/Feature symbols as constants.
-       (,(concat "(\\(catch\\|throw\\|featurep\\|provide\\|require\\)\\_>"
-                 "[ \t']*\\(\\(?:\\sw\\|\\s_\\)+\\)?")
-        (1 font-lock-keyword-face)
-        (2 font-lock-constant-face nil t))
-       ;; Erroneous structures.
-       (,(concat "(" el-errs-re "\\_>")
-        (1 font-lock-warning-face))
-       ;; Words inside \\[] tend to be for `substitute-command-keys'.
-       ("\\\\\\\\\\[\\(\\(?:\\sw\\|\\s_\\)+\\)\\]"
-        (1 font-lock-constant-face prepend))
-       ;; Words inside `' tend to be symbol names.
-       ("`\\(\\(?:\\sw\\|\\s_\\)\\(?:\\sw\\|\\s_\\)+\\)'"
-        (1 font-lock-constant-face prepend))
-       ;; Constant values.
-       ("\\_<:\\(?:\\sw\\|\\s_\\)+\\_>" 0 font-lock-builtin-face)
-       ;; ELisp and CLisp `&' keywords as types.
-       ("\\_<\\&\\(?:\\sw\\|\\s_\\)+\\_>" . font-lock-type-face)
-       ;; ELisp regexp grouping constructs
-       (,(lambda (bound)
-           (catch 'found
-             ;; The following loop is needed to continue searching after matches
-             ;; that do not occur in strings.  The associated regexp matches one
-             ;; of `\\\\' `\\(' `\\(?:' `\\|' `\\)'.  `\\\\' has been included to
-             ;; avoid highlighting, for example, `\\(' in `\\\\('.
-             (while (re-search-forward "\\(\\\\\\\\\\)\\(?:\\(\\\\\\\\\\)\\|\\((\\(?:\\?[0-9]*:\\)?\\|[|)]\\)\\)" bound t)
-               (unless (match-beginning 2)
-                 (let ((face (get-text-property (1- (point)) 'face)))
-                   (when (or (and (listp face)
-                                  (memq 'font-lock-string-face face))
-                             (eq 'font-lock-string-face face))
-                     (throw 'found t)))))))
-        (1 'font-lock-regexp-grouping-backslash prepend)
-        (3 'font-lock-regexp-grouping-construct prepend))
-       ;; This is too general -- rms.
-       ;; A user complained that he has functions whose names start with `do'
-       ;; and that they get the wrong color.
-       ;; ;; CL `with-' and `do-' constructs
-       ;;("(\\(\\(do-\\|with-\\)\\(\\s_\\|\\w\\)*\\)" 1 font-lock-keyword-face)
-       (lisp--match-hidden-arg
-        (0 '(face font-lock-warning-face
-             help-echo "Hidden behind deeper element; move to another line?")))
-       ))
-    "Gaudy level highlighting for Emacs Lisp mode.")
-
-  (defconst lisp-cl-font-lock-keywords-2
-    (append
-     lisp-cl-font-lock-keywords-1
-     `( ;; Regexp negated char group.
-       ("\\[\\(\\^\\)" 1 font-lock-negation-char-face prepend)
-       ;; Control structures.  Common Lisp forms.
-       (,(concat "(" cl-kws-re "\\_>") . 1)
-       ;; Exit/Feature symbols as constants.
-       (,(concat "(\\(catch\\|throw\\|provide\\|require\\)\\_>"
-                 "[ \t']*\\(\\(?:\\sw\\|\\s_\\)+\\)?")
-        (1 font-lock-keyword-face)
-        (2 font-lock-constant-face nil t))
-       ;; Erroneous structures.
-       (,(concat "(" cl-errs-re "\\_>")
-        (1 font-lock-warning-face))
-       ;; Words inside `' tend to be symbol names.
-       ("`\\(\\(?:\\sw\\|\\s_\\)\\(?:\\sw\\|\\s_\\)+\\)'"
-        (1 font-lock-constant-face prepend))
-       ;; Constant values.
-       ("\\_<:\\(?:\\sw\\|\\s_\\)+\\_>" 0 font-lock-builtin-face)
-       ;; ELisp and CLisp `&' keywords as types.
-       ("\\_<\\&\\(?:\\sw\\|\\s_\\)+\\_>" . font-lock-type-face)
-       ;; This is too general -- rms.
-       ;; A user complained that he has functions whose names start with `do'
-       ;; and that they get the wrong color.
-       ;; ;; CL `with-' and `do-' constructs
-       ;;("(\\(\\(do-\\|with-\\)\\(\\s_\\|\\w\\)*\\)" 1 font-lock-keyword-face)
-       (lisp--match-hidden-arg
-        (0 '(face font-lock-warning-face
-             help-echo "Hidden behind deeper element; move to another line?")))
-       ))
-    "Gaudy level highlighting for Lisp modes."))
+(defmacro let-when-compile (bindings &rest body)
+  "Like `let', but allows for compile time optimization.
+\n(fn BINDINGS BODY)"
+  (declare (indent 1) (debug let))
+  (progv (mapcar #'car bindings)
+      (mapcar (lambda (x) (eval (cadr x))) bindings)
+    (funcall
+     `(lambda ()
+        (macroexpand-all
+         '(progn
+            ,@body))))))
+
+(let-when-compile
+    ((lisp-fdefs '("defmacro" "defsubst" "defun"))
+     (lisp-vdefs '("defvar"))
+     (lisp-kw '("cond" "if" "while" "let" "let*" "progn" "prog1"
+                "prog2" "lambda" "unwind-protect" "condition-case"
+                "when" "unless" "with-output-to-string"
+                "ignore-errors" "dotimes" "dolist" "declare"))
+     (lisp-errs '("warn" "error" "signal"))
+     ;; Elisp constructs.  Now they are update dynamically
+     ;; from obarray but they are also used for setting up
+     ;; the keywords for Common Lisp.
+     (el-fdefs '("define-advice" "defadvice" "defalias"
+                 "define-derived-mode" "define-minor-mode"
+                 "define-generic-mode" "define-global-minor-mode"
+                 "define-globalized-minor-mode" "define-skeleton"
+                 "define-widget"))
+     (el-vdefs '("defconst" "defcustom" "defvaralias" "defvar-local"
+                 "defface"))
+     (el-tdefs '("defgroup" "deftheme"))
+     (el-kw '("while-no-input" "letrec" "pcase" "pcase-exhaustive"
+              "pcase-lambda" "pcase-let" "pcase-let*" "save-restriction"
+              "save-excursion" "save-selected-window"
+              ;; "eval-after-load" "eval-next-after-load"
+              "save-window-excursion" "save-current-buffer"
+              "save-match-data" "combine-after-change-calls"
+              "condition-case-unless-debug" "track-mouse"
+              "eval-and-compile" "eval-when-compile" "with-case-table"
+              "with-category-table" "with-coding-priority"
+              "with-current-buffer" "with-demoted-errors"
+              "with-electric-help" "with-eval-after-load"
+              "with-file-modes"
+              "with-local-quit" "with-no-warnings"
+              "with-output-to-temp-buffer" "with-selected-window"
+              "with-selected-frame" "with-silent-modifications"
+              "with-syntax-table" "with-temp-buffer" "with-temp-file"
+              "with-temp-message" "with-timeout"
+              "with-timeout-handler"))
+     (el-errs '("user-error"))
+     ;; Common-Lisp constructs supported by EIEIO.  FIXME: namespace.
+     (eieio-fdefs '("defgeneric" "defmethod"))
+     (eieio-tdefs '("defclass"))
+     (eieio-kw '("with-slots"))
+     ;; Common-Lisp constructs supported by cl-lib.
+     (cl-lib-fdefs '("defmacro" "defsubst" "defun" "defmethod"))
+     (cl-lib-tdefs '("defstruct" "deftype"))
+     (cl-lib-kw '("progv" "eval-when" "case" "ecase" "typecase"
+                  "etypecase" "ccase" "ctypecase" "loop" "do" "do*"
+                  "the" "locally" "proclaim" "declaim" "letf" "go"
+                  ;; "lexical-let" "lexical-let*"
+                  "symbol-macrolet" "flet" "flet*" "destructuring-bind"
+                  "labels" "macrolet" "tagbody" "multiple-value-bind"
+                  "block" "return" "return-from"))
+     (cl-lib-errs '("assert" "check-type"))
+     ;; Common-Lisp constructs not supported by cl-lib.
+     (cl-fdefs '("defsetf" "define-method-combination"
+                 "define-condition" "define-setf-expander"
+                 ;; "define-function"??
+                 "define-compiler-macro" "define-modify-macro"))
+     (cl-vdefs '("define-symbol-macro" "defconstant" "defparameter"))
+     (cl-tdefs '("defpackage" "defstruct" "deftype"))
+     (cl-kw '("prog" "prog*" "handler-case" "handler-bind"
+              "in-package" "restart-case" ;; "inline"
+              "restart-bind" "break" "multiple-value-prog1"
+              "compiler-let" "with-accessors" "with-compilation-unit"
+              "with-condition-restarts" "with-hash-table-iterator"
+              "with-input-from-string" "with-open-file"
+              "with-open-stream" "with-package-iterator"
+              "with-simple-restart" "with-standard-io-syntax"))
+     (cl-errs '("abort" "cerror")))
+  (let ((vdefs (eval-when-compile
+                 (append lisp-vdefs el-vdefs cl-vdefs)))
+        (tdefs (eval-when-compile
+                 (append el-tdefs eieio-tdefs cl-tdefs cl-lib-tdefs
+                         (mapcar (lambda (s) (concat "cl-" s)) cl-lib-tdefs))))
+        ;; Elisp and Common Lisp definers.
+        (el-defs-re (eval-when-compile
+                      (regexp-opt (append lisp-fdefs lisp-vdefs
+                                          el-fdefs el-vdefs el-tdefs
+                                          (mapcar (lambda (s) (concat "cl-" s))
+                                                  (append cl-lib-fdefs cl-lib-tdefs))
+                                          eieio-fdefs eieio-tdefs)
+                                  t)))
+        (cl-defs-re (eval-when-compile
+                      (regexp-opt (append lisp-fdefs lisp-vdefs
+                                          cl-lib-fdefs cl-lib-tdefs
+                                          eieio-fdefs eieio-tdefs
+                                          cl-fdefs cl-vdefs cl-tdefs)
+                                  t)))
+        ;; Elisp and Common Lisp keywords.
+        ;; (el-kws-re (eval-when-compile
+        ;;              (regexp-opt (append
+        ;;                           lisp-kw el-kw eieio-kw
+        ;;                           (cons "go" (mapcar (lambda (s) (concat "cl-" s))
+        ;;                                              (remove "go" cl-lib-kw))))
+        ;;                          t)))
+        (cl-kws-re (eval-when-compile
+                     (regexp-opt (append lisp-kw cl-kw eieio-kw cl-lib-kw)
+                                 t)))
+        ;; Elisp and Common Lisp "errors".
+        (el-errs-re (eval-when-compile
+                      (regexp-opt (append (mapcar (lambda (s) (concat "cl-" s))
+                                                  cl-lib-errs)
+                                          lisp-errs el-errs)
+                                  t)))
+        (cl-errs-re (eval-when-compile
+                      (regexp-opt (append lisp-errs cl-lib-errs cl-errs) t))))
+    (dolist (v vdefs)
+      (put (intern v) 'lisp-define-type 'var))
+    (dolist (v tdefs)
+      (put (intern v) 'lisp-define-type 'type))
+
+    (define-obsolete-variable-alias 'lisp-font-lock-keywords-1
+      'lisp-el-font-lock-keywords-1 "24.4")
+    (defconst lisp-el-font-lock-keywords-1
+      `( ;; Definitions.
+        (,(concat "(" el-defs-re "\\_>"
+                  ;; Any whitespace and defined object.
+                  "[ \t']*"
+                  "\\(([ \t']*\\)?" ;; An opening paren.
+                  "\\(\\(setf\\)[ \t]+\\(?:\\sw\\|\\s_\\)+\\|\\(?:\\sw\\|\\s_\\)+\\)?")
+         (1 font-lock-keyword-face)
+         (3 (let ((type (get (intern-soft (match-string 1)) 'lisp-define-type)))
+              (cond ((eq type 'var) font-lock-variable-name-face)
+                    ((eq type 'type) font-lock-type-face)
+                    ;; If match-string 2 is non-nil, we encountered a
+                    ;; form like (defalias (intern (concat s "-p"))),
+                    ;; unless match-string 4 is also there.  Then its a
+                    ;; defmethod with (setf foo) as name.
+                    ((or (not (match-string 2)) ;; Normal defun.
+                         (and (match-string 2)  ;; Setf method.
+                              (match-string 4))) font-lock-function-name-face)))
+            nil t))
+        ;; Emacs Lisp autoload cookies.  Supports the slightly different
+        ;; forms used by mh-e, calendar, etc.
+        ("^;;;###\\([-a-z]*autoload\\)" 1 font-lock-warning-face prepend))
+      "Subdued level highlighting for Emacs Lisp mode.")
+
+    (defconst lisp-cl-font-lock-keywords-1
+      `( ;; Definitions.
+        (,(concat "(" cl-defs-re "\\_>"
+                  ;; Any whitespace and defined object.
+                  "[ \t']*"
+                  "\\(([ \t']*\\)?" ;; An opening paren.
+                  "\\(\\(setf\\)[ \t]+\\(?:\\sw\\|\\s_\\)+\\|\\(?:\\sw\\|\\s_\\)+\\)?")
+         (1 font-lock-keyword-face)
+         (3 (let ((type (get (intern-soft (match-string 1)) 'lisp-define-type)))
+              (cond ((eq type 'var) font-lock-variable-name-face)
+                    ((eq type 'type) font-lock-type-face)
+                    ((or (not (match-string 2)) ;; Normal defun.
+                         (and (match-string 2)  ;; Setf function.
+                              (match-string 4))) font-lock-function-name-face)))
+            nil t)))
+      "Subdued level highlighting for Lisp modes.")
+
+    (define-obsolete-variable-alias 'lisp-font-lock-keywords-2
+      'lisp-el-font-lock-keywords-2 "24.4")
+    (defconst lisp-el-font-lock-keywords-2
+      (append
+       lisp-el-font-lock-keywords-1
+       `( ;; Regexp negated char group.
+         ("\\[\\(\\^\\)" 1 font-lock-negation-char-face prepend)
+         ;; Control structures.  Common Lisp forms.
+         (lisp--el-match-keyword . 1)
+         ;; Exit/Feature symbols as constants.
+         (,(concat "(\\(catch\\|throw\\|featurep\\|provide\\|require\\)\\_>"
+                   "[ \t']*\\(\\(?:\\sw\\|\\s_\\)+\\)?")
+          (1 font-lock-keyword-face)
+          (2 font-lock-constant-face nil t))
+         ;; Erroneous structures.
+         (,(concat "(" el-errs-re "\\_>")
+          (1 font-lock-warning-face))
+         ;; Words inside \\[] tend to be for `substitute-command-keys'.
+         ("\\\\\\\\\\[\\(\\(?:\\sw\\|\\s_\\)+\\)\\]"
+          (1 font-lock-constant-face prepend))
+         ;; Words inside `' tend to be symbol names.
+         ("`\\(\\(?:\\sw\\|\\s_\\)\\(?:\\sw\\|\\s_\\)+\\)'"
+          (1 font-lock-constant-face prepend))
+         ;; Constant values.
+         ("\\_<:\\(?:\\sw\\|\\s_\\)+\\_>" 0 font-lock-builtin-face)
+         ;; ELisp and CLisp `&' keywords as types.
+         ("\\_<\\&\\(?:\\sw\\|\\s_\\)+\\_>" . font-lock-type-face)
+         ;; ELisp regexp grouping constructs
+         (,(lambda (bound)
+             (catch 'found
+               ;; The following loop is needed to continue searching after matches
+               ;; that do not occur in strings.  The associated regexp matches one
+               ;; of `\\\\' `\\(' `\\(?:' `\\|' `\\)'.  `\\\\' has been included to
+               ;; avoid highlighting, for example, `\\(' in `\\\\('.
+               (while (re-search-forward "\\(\\\\\\\\\\)\\(?:\\(\\\\\\\\\\)\\|\\((\\(?:\\?[0-9]*:\\)?\\|[|)]\\)\\)" bound t)
+                 (unless (match-beginning 2)
+                   (let ((face (get-text-property (1- (point)) 'face)))
+                     (when (or (and (listp face)
+                                    (memq 'font-lock-string-face face))
+                               (eq 'font-lock-string-face face))
+                       (throw 'found t)))))))
+          (1 'font-lock-regexp-grouping-backslash prepend)
+          (3 'font-lock-regexp-grouping-construct prepend))
+         ;; This is too general -- rms.
+         ;; A user complained that he has functions whose names start with `do'
+         ;; and that they get the wrong color.
+         ;; ;; CL `with-' and `do-' constructs
+         ;;("(\\(\\(do-\\|with-\\)\\(\\s_\\|\\w\\)*\\)" 1 font-lock-keyword-face)
+         (lisp--match-hidden-arg
+          (0 '(face font-lock-warning-face
+                    help-echo "Hidden behind deeper element; move to another line?")))
+         ))
+      "Gaudy level highlighting for Emacs Lisp mode.")
+
+    (defconst lisp-cl-font-lock-keywords-2
+      (append
+       lisp-cl-font-lock-keywords-1
+       `( ;; Regexp negated char group.
+         ("\\[\\(\\^\\)" 1 font-lock-negation-char-face prepend)
+         ;; Control structures.  Common Lisp forms.
+         (,(concat "(" cl-kws-re "\\_>") . 1)
+         ;; Exit/Feature symbols as constants.
+         (,(concat "(\\(catch\\|throw\\|provide\\|require\\)\\_>"
+                   "[ \t']*\\(\\(?:\\sw\\|\\s_\\)+\\)?")
+          (1 font-lock-keyword-face)
+          (2 font-lock-constant-face nil t))
+         ;; Erroneous structures.
+         (,(concat "(" cl-errs-re "\\_>")
+          (1 font-lock-warning-face))
+         ;; Words inside `' tend to be symbol names.
+         ("`\\(\\(?:\\sw\\|\\s_\\)\\(?:\\sw\\|\\s_\\)+\\)'"
+          (1 font-lock-constant-face prepend))
+         ;; Constant values.
+         ("\\_<:\\(?:\\sw\\|\\s_\\)+\\_>" 0 font-lock-builtin-face)
+         ;; ELisp and CLisp `&' keywords as types.
+         ("\\_<\\&\\(?:\\sw\\|\\s_\\)+\\_>" . font-lock-type-face)
+         ;; This is too general -- rms.
+         ;; A user complained that he has functions whose names start with `do'
+         ;; and that they get the wrong color.
+         ;; ;; CL `with-' and `do-' constructs
+         ;;("(\\(\\(do-\\|with-\\)\\(\\s_\\|\\w\\)*\\)" 1 font-lock-keyword-face)
+         (lisp--match-hidden-arg
+          (0 '(face font-lock-warning-face
+                    help-echo "Hidden behind deeper element; move to another line?")))
+         ))
+      "Gaudy level highlighting for Lisp modes.")))
 
 (define-obsolete-variable-alias 'lisp-font-lock-keywords
   'lisp-el-font-lock-keywords "24.4")
-- 
1.8.4


^ permalink raw reply related	[flat|nested] 10+ messages in thread

* Re: Use the new let-opt macro in place of pcase-let in lisp-mode.el
  2015-05-19  8:08       ` Oleh Krehel
@ 2015-05-20  2:03         ` Stefan Monnier
  2015-05-20  8:46           ` Oleh Krehel
  0 siblings, 1 reply; 10+ messages in thread
From: Stefan Monnier @ 2015-05-20  2:03 UTC (permalink / raw)
  To: Oleh Krehel; +Cc: emacs-devel

>   (progv (mapcar #'car bindings)
>       (mapcar (lambda (x) (eval (cadr x))) bindings)
>     (funcall
>      `(lambda ()
>         (macroexpand-all
>          '(progn
>             ,@body))))))

Hmm?  Why this funcall+backquote+lambda business?
[ Oh, and be careful to pass macroexpand-all-environment as second arg
  to macroexpand-all.  ]

> The code in lisp-mode.el works fine, but there's still one thing on
> which I'm not sure: what should happen if an `eval-when-compile' wrapper
> is omitted?

Same as what happens in your earlier let-opt when the `opt' is omitted.


        Stefan



^ permalink raw reply	[flat|nested] 10+ messages in thread

* Re: Use the new let-opt macro in place of pcase-let in lisp-mode.el
  2015-05-20  2:03         ` Stefan Monnier
@ 2015-05-20  8:46           ` Oleh Krehel
  2015-05-20 12:58             ` Stefan Monnier
  0 siblings, 1 reply; 10+ messages in thread
From: Oleh Krehel @ 2015-05-20  8:46 UTC (permalink / raw)
  To: Stefan Monnier; +Cc: emacs-devel

[-- Attachment #1: Type: text/plain, Size: 1362 bytes --]

Stefan Monnier <monnier@iro.umontreal.ca> writes:

>>   (progv (mapcar #'car bindings)
>>       (mapcar (lambda (x) (eval (cadr x))) bindings)
>>     (funcall
>>      `(lambda ()
>>         (macroexpand-all
>>          '(progn
>>             ,@body))))))
>
> Hmm?  Why this funcall+backquote+lambda business?
> [ Oh, and be careful to pass macroexpand-all-environment as second arg
>   to macroexpand-all.  ]

No reason, just copied it from `progv' and didn't simplify.  Here's the
final version:

(defmacro let-when-compile (bindings &rest body)
  "Like `let', but allows for compile time optimization.
\n(fn BINDINGS BODY)"
  (declare (indent 1) (debug let))
  (cl-progv (mapcar #'car bindings)
      (mapcar (lambda (x) (eval (cadr x))) bindings)
    (macroexpand-all
     `(progn
        ,@body)
     macroexpand-all-environment)))

>> The code in lisp-mode.el works fine, but there's still one thing on
>> which I'm not sure: what should happen if an `eval-when-compile' wrapper
>> is omitted?
>
> Same as what happens in your earlier let-opt when the `opt' is
> omitted.

So I guess it's fine. The byte compiler will issue a warning about an
unbound variable if `eval-when-compile' is omitted by mistake. I was
thinking maybe something clever could be done, like automatically
leaving a let binding to prevent an error.

Should I install the patch?

Oleh


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Add-let-when-compile-macro-instead-of-using-pcase-le.patch --]
[-- Type: text/x-diff, Size: 27561 bytes --]

From fc87099f956d1c30530840929df7b8b2108cc451 Mon Sep 17 00:00:00 2001
From: Oleh Krehel <ohwoeowho@gmail.com>
Date: Tue, 19 May 2015 09:49:12 +0200
Subject: [PATCH] Add let-when-compile macro instead of using pcase-let

* lisp/emacs-lisp/lisp-mode.el (let-when-compile): New let-like macro
that makes its bindings known to macros like `eval-when-compile' in
the body.

* lisp/emacs-lisp/lisp-mode.el: Change the top-level `pcase-let' to a
  `let-when-compile'. Also comment out the unused lexical var
  `el-kws-re'.

The change greatly improves readability, while providing almost the
same (even shorter) byte code: instead of pre-evaluating 10 variables,
tossing them into a list, and destructuring that list a full screen
page later, the variables are simply bound as they are evaluated,
wrapped individually in `eval-when-compile'.
---
 lisp/emacs-lisp/lisp-mode.el | 493 ++++++++++++++++++++++---------------------
 1 file changed, 251 insertions(+), 242 deletions(-)

diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index 108d5cc..85995c0 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -229,248 +229,257 @@
                              (match-beginning 0)))))
 	  (throw 'found t))))))
 
-(pcase-let
-    ((`(,vdefs ,tdefs
-        ,el-defs-re ,cl-defs-re
-        ,el-kws-re  ,cl-kws-re
-        ,el-errs-re ,cl-errs-re)
-      (eval-when-compile
-        (let ((lisp-fdefs '("defmacro" "defsubst" "defun"))
-              (lisp-vdefs '("defvar"))
-              (lisp-kw '("cond" "if" "while" "let" "let*" "progn" "prog1"
-                         "prog2" "lambda" "unwind-protect" "condition-case"
-                         "when" "unless" "with-output-to-string"
-                         "ignore-errors" "dotimes" "dolist" "declare"))
-              (lisp-errs '("warn" "error" "signal"))
-              ;; Elisp constructs.  Now they are update dynamically
-              ;; from obarray but they are also used for setting up
-              ;; the keywords for Common Lisp.
-              (el-fdefs '("define-advice" "defadvice" "defalias"
-                          "define-derived-mode" "define-minor-mode"
-                          "define-generic-mode" "define-global-minor-mode"
-                          "define-globalized-minor-mode" "define-skeleton"
-                          "define-widget"))
-              (el-vdefs '("defconst" "defcustom" "defvaralias" "defvar-local"
-                          "defface"))
-              (el-tdefs '("defgroup" "deftheme"))
-              (el-kw '("while-no-input" "letrec" "pcase" "pcase-exhaustive"
-                       "pcase-lambda" "pcase-let" "pcase-let*" "save-restriction"
-                       "save-excursion" "save-selected-window"
-                       ;; "eval-after-load" "eval-next-after-load"
-                       "save-window-excursion" "save-current-buffer"
-                       "save-match-data" "combine-after-change-calls"
-                       "condition-case-unless-debug" "track-mouse"
-                       "eval-and-compile" "eval-when-compile" "with-case-table"
-                       "with-category-table" "with-coding-priority"
-                       "with-current-buffer" "with-demoted-errors"
-                       "with-electric-help" "with-eval-after-load"
-                       "with-file-modes"
-                       "with-local-quit" "with-no-warnings"
-                       "with-output-to-temp-buffer" "with-selected-window"
-                       "with-selected-frame" "with-silent-modifications"
-                       "with-syntax-table" "with-temp-buffer" "with-temp-file"
-                       "with-temp-message" "with-timeout"
-                       "with-timeout-handler"))
-              (el-errs '("user-error"))
-              ;; Common-Lisp constructs supported by EIEIO.  FIXME: namespace.
-              (eieio-fdefs '("defgeneric" "defmethod"))
-              (eieio-tdefs '("defclass"))
-              (eieio-kw '("with-slots"))
-              ;; Common-Lisp constructs supported by cl-lib.
-              (cl-lib-fdefs '("defmacro" "defsubst" "defun" "defmethod"))
-              (cl-lib-tdefs '("defstruct" "deftype"))
-              (cl-lib-kw '("progv" "eval-when" "case" "ecase" "typecase"
-                           "etypecase" "ccase" "ctypecase" "loop" "do" "do*"
-                           "the" "locally" "proclaim" "declaim" "letf" "go"
-                           ;; "lexical-let" "lexical-let*"
-                           "symbol-macrolet" "flet" "flet*" "destructuring-bind"
-                           "labels" "macrolet" "tagbody" "multiple-value-bind"
-                           "block" "return" "return-from"))
-              (cl-lib-errs '("assert" "check-type"))
-              ;; Common-Lisp constructs not supported by cl-lib.
-              (cl-fdefs '("defsetf" "define-method-combination"
-                          "define-condition" "define-setf-expander"
-                          ;; "define-function"??
-                          "define-compiler-macro" "define-modify-macro"))
-              (cl-vdefs '("define-symbol-macro" "defconstant" "defparameter"))
-              (cl-tdefs '("defpackage" "defstruct" "deftype"))
-              (cl-kw '("prog" "prog*" "handler-case" "handler-bind"
-                       "in-package" "restart-case" ;; "inline"
-                       "restart-bind" "break" "multiple-value-prog1"
-                       "compiler-let" "with-accessors" "with-compilation-unit"
-                       "with-condition-restarts" "with-hash-table-iterator"
-                       "with-input-from-string" "with-open-file"
-                       "with-open-stream" "with-package-iterator"
-                       "with-simple-restart" "with-standard-io-syntax"))
-              (cl-errs '("abort" "cerror")))
-
-          (list (append lisp-vdefs el-vdefs cl-vdefs)
-                (append el-tdefs eieio-tdefs cl-tdefs cl-lib-tdefs
-                        (mapcar (lambda (s) (concat "cl-" s)) cl-lib-tdefs))
-
-                ;; Elisp and Common Lisp definers.
-                (regexp-opt (append lisp-fdefs lisp-vdefs
-                                    el-fdefs el-vdefs el-tdefs
-                                    (mapcar (lambda (s) (concat "cl-" s))
-                                            (append cl-lib-fdefs cl-lib-tdefs))
-                                    eieio-fdefs eieio-tdefs)
-                            t)
-                (regexp-opt (append lisp-fdefs lisp-vdefs
-                                    cl-lib-fdefs cl-lib-tdefs
-                                    eieio-fdefs eieio-tdefs
-                                    cl-fdefs cl-vdefs cl-tdefs)
-                            t)
-
-                ;; Elisp and Common Lisp keywords.
-                (regexp-opt (append
-                             lisp-kw el-kw eieio-kw
-                             (cons "go" (mapcar (lambda (s) (concat "cl-" s))
-                                                (remove "go" cl-lib-kw))))
-                            t)
-                (regexp-opt (append lisp-kw cl-kw eieio-kw cl-lib-kw)
-                            t)
-
-                ;; Elisp and Common Lisp "errors".
-                (regexp-opt (append (mapcar (lambda (s) (concat "cl-" s))
-                                            cl-lib-errs)
-                                    lisp-errs el-errs)
-                            t)
-                (regexp-opt (append lisp-errs cl-lib-errs cl-errs) t))))))
-
-  (dolist (v vdefs)
-    (put (intern v) 'lisp-define-type 'var))
-  (dolist (v tdefs)
-    (put (intern v) 'lisp-define-type 'type))
-
-  (define-obsolete-variable-alias 'lisp-font-lock-keywords-1
-    'lisp-el-font-lock-keywords-1 "24.4")
-  (defconst lisp-el-font-lock-keywords-1
-    `( ;; Definitions.
-      (,(concat "(" el-defs-re "\\_>"
-                ;; Any whitespace and defined object.
-                "[ \t']*"
-		"\\(([ \t']*\\)?" ;; An opening paren.
-                "\\(\\(setf\\)[ \t]+\\(?:\\sw\\|\\s_\\)+\\|\\(?:\\sw\\|\\s_\\)+\\)?")
-       (1 font-lock-keyword-face)
-       (3 (let ((type (get (intern-soft (match-string 1)) 'lisp-define-type)))
-	    (cond ((eq type 'var) font-lock-variable-name-face)
-		  ((eq type 'type) font-lock-type-face)
-		  ;; If match-string 2 is non-nil, we encountered a
-		  ;; form like (defalias (intern (concat s "-p"))),
-		  ;; unless match-string 4 is also there.  Then its a
-		  ;; defmethod with (setf foo) as name.
-		  ((or (not (match-string 2))  ;; Normal defun.
-		       (and (match-string 2)   ;; Setf method.
-			    (match-string 4))) font-lock-function-name-face)))
-	  nil t))
-      ;; Emacs Lisp autoload cookies.  Supports the slightly different
-      ;; forms used by mh-e, calendar, etc.
-      ("^;;;###\\([-a-z]*autoload\\)" 1 font-lock-warning-face prepend))
-    "Subdued level highlighting for Emacs Lisp mode.")
-
-  (defconst lisp-cl-font-lock-keywords-1
-    `( ;; Definitions.
-      (,(concat "(" cl-defs-re "\\_>"
-                ;; Any whitespace and defined object.
-                "[ \t']*"
-		"\\(([ \t']*\\)?" ;; An opening paren.
-                "\\(\\(setf\\)[ \t]+\\(?:\\sw\\|\\s_\\)+\\|\\(?:\\sw\\|\\s_\\)+\\)?")
-       (1 font-lock-keyword-face)
-       (3 (let ((type (get (intern-soft (match-string 1)) 'lisp-define-type)))
-            (cond ((eq type 'var) font-lock-variable-name-face)
-                  ((eq type 'type) font-lock-type-face)
-                  ((or (not (match-string 2))  ;; Normal defun.
-		       (and (match-string 2)   ;; Setf function.
-			    (match-string 4))) font-lock-function-name-face)))
-          nil t)))
-    "Subdued level highlighting for Lisp modes.")
-
-  (define-obsolete-variable-alias 'lisp-font-lock-keywords-2
-    'lisp-el-font-lock-keywords-2 "24.4")
-  (defconst lisp-el-font-lock-keywords-2
-    (append
-     lisp-el-font-lock-keywords-1
-     `( ;; Regexp negated char group.
-       ("\\[\\(\\^\\)" 1 font-lock-negation-char-face prepend)
-       ;; Control structures.  Common Lisp forms.
-       (lisp--el-match-keyword . 1)
-       ;; Exit/Feature symbols as constants.
-       (,(concat "(\\(catch\\|throw\\|featurep\\|provide\\|require\\)\\_>"
-                 "[ \t']*\\(\\(?:\\sw\\|\\s_\\)+\\)?")
-        (1 font-lock-keyword-face)
-        (2 font-lock-constant-face nil t))
-       ;; Erroneous structures.
-       (,(concat "(" el-errs-re "\\_>")
-        (1 font-lock-warning-face))
-       ;; Words inside \\[] tend to be for `substitute-command-keys'.
-       ("\\\\\\\\\\[\\(\\(?:\\sw\\|\\s_\\)+\\)\\]"
-        (1 font-lock-constant-face prepend))
-       ;; Words inside `' tend to be symbol names.
-       ("`\\(\\(?:\\sw\\|\\s_\\)\\(?:\\sw\\|\\s_\\)+\\)'"
-        (1 font-lock-constant-face prepend))
-       ;; Constant values.
-       ("\\_<:\\(?:\\sw\\|\\s_\\)+\\_>" 0 font-lock-builtin-face)
-       ;; ELisp and CLisp `&' keywords as types.
-       ("\\_<\\&\\(?:\\sw\\|\\s_\\)+\\_>" . font-lock-type-face)
-       ;; ELisp regexp grouping constructs
-       (,(lambda (bound)
-           (catch 'found
-             ;; The following loop is needed to continue searching after matches
-             ;; that do not occur in strings.  The associated regexp matches one
-             ;; of `\\\\' `\\(' `\\(?:' `\\|' `\\)'.  `\\\\' has been included to
-             ;; avoid highlighting, for example, `\\(' in `\\\\('.
-             (while (re-search-forward "\\(\\\\\\\\\\)\\(?:\\(\\\\\\\\\\)\\|\\((\\(?:\\?[0-9]*:\\)?\\|[|)]\\)\\)" bound t)
-               (unless (match-beginning 2)
-                 (let ((face (get-text-property (1- (point)) 'face)))
-                   (when (or (and (listp face)
-                                  (memq 'font-lock-string-face face))
-                             (eq 'font-lock-string-face face))
-                     (throw 'found t)))))))
-        (1 'font-lock-regexp-grouping-backslash prepend)
-        (3 'font-lock-regexp-grouping-construct prepend))
-       ;; This is too general -- rms.
-       ;; A user complained that he has functions whose names start with `do'
-       ;; and that they get the wrong color.
-       ;; ;; CL `with-' and `do-' constructs
-       ;;("(\\(\\(do-\\|with-\\)\\(\\s_\\|\\w\\)*\\)" 1 font-lock-keyword-face)
-       (lisp--match-hidden-arg
-        (0 '(face font-lock-warning-face
-             help-echo "Hidden behind deeper element; move to another line?")))
-       ))
-    "Gaudy level highlighting for Emacs Lisp mode.")
-
-  (defconst lisp-cl-font-lock-keywords-2
-    (append
-     lisp-cl-font-lock-keywords-1
-     `( ;; Regexp negated char group.
-       ("\\[\\(\\^\\)" 1 font-lock-negation-char-face prepend)
-       ;; Control structures.  Common Lisp forms.
-       (,(concat "(" cl-kws-re "\\_>") . 1)
-       ;; Exit/Feature symbols as constants.
-       (,(concat "(\\(catch\\|throw\\|provide\\|require\\)\\_>"
-                 "[ \t']*\\(\\(?:\\sw\\|\\s_\\)+\\)?")
-        (1 font-lock-keyword-face)
-        (2 font-lock-constant-face nil t))
-       ;; Erroneous structures.
-       (,(concat "(" cl-errs-re "\\_>")
-        (1 font-lock-warning-face))
-       ;; Words inside `' tend to be symbol names.
-       ("`\\(\\(?:\\sw\\|\\s_\\)\\(?:\\sw\\|\\s_\\)+\\)'"
-        (1 font-lock-constant-face prepend))
-       ;; Constant values.
-       ("\\_<:\\(?:\\sw\\|\\s_\\)+\\_>" 0 font-lock-builtin-face)
-       ;; ELisp and CLisp `&' keywords as types.
-       ("\\_<\\&\\(?:\\sw\\|\\s_\\)+\\_>" . font-lock-type-face)
-       ;; This is too general -- rms.
-       ;; A user complained that he has functions whose names start with `do'
-       ;; and that they get the wrong color.
-       ;; ;; CL `with-' and `do-' constructs
-       ;;("(\\(\\(do-\\|with-\\)\\(\\s_\\|\\w\\)*\\)" 1 font-lock-keyword-face)
-       (lisp--match-hidden-arg
-        (0 '(face font-lock-warning-face
-             help-echo "Hidden behind deeper element; move to another line?")))
-       ))
-    "Gaudy level highlighting for Lisp modes."))
+(defmacro let-when-compile (bindings &rest body)
+  "Like `let', but allows for compile time optimization.
+\n(fn BINDINGS BODY)"
+  (declare (indent 1) (debug let))
+  (cl-progv (mapcar #'car bindings)
+      (mapcar (lambda (x) (eval (cadr x))) bindings)
+    (macroexpand-all
+     `(progn
+        ,@body)
+     macroexpand-all-environment)))
+
+(let-when-compile
+    ((lisp-fdefs '("defmacro" "defsubst" "defun"))
+     (lisp-vdefs '("defvar"))
+     (lisp-kw '("cond" "if" "while" "let" "let*" "progn" "prog1"
+                "prog2" "lambda" "unwind-protect" "condition-case"
+                "when" "unless" "with-output-to-string"
+                "ignore-errors" "dotimes" "dolist" "declare"))
+     (lisp-errs '("warn" "error" "signal"))
+     ;; Elisp constructs.  Now they are update dynamically
+     ;; from obarray but they are also used for setting up
+     ;; the keywords for Common Lisp.
+     (el-fdefs '("define-advice" "defadvice" "defalias"
+                 "define-derived-mode" "define-minor-mode"
+                 "define-generic-mode" "define-global-minor-mode"
+                 "define-globalized-minor-mode" "define-skeleton"
+                 "define-widget"))
+     (el-vdefs '("defconst" "defcustom" "defvaralias" "defvar-local"
+                 "defface"))
+     (el-tdefs '("defgroup" "deftheme"))
+     (el-kw '("while-no-input" "letrec" "pcase" "pcase-exhaustive"
+              "pcase-lambda" "pcase-let" "pcase-let*" "save-restriction"
+              "save-excursion" "save-selected-window"
+              ;; "eval-after-load" "eval-next-after-load"
+              "save-window-excursion" "save-current-buffer"
+              "save-match-data" "combine-after-change-calls"
+              "condition-case-unless-debug" "track-mouse"
+              "eval-and-compile" "eval-when-compile" "with-case-table"
+              "with-category-table" "with-coding-priority"
+              "with-current-buffer" "with-demoted-errors"
+              "with-electric-help" "with-eval-after-load"
+              "with-file-modes"
+              "with-local-quit" "with-no-warnings"
+              "with-output-to-temp-buffer" "with-selected-window"
+              "with-selected-frame" "with-silent-modifications"
+              "with-syntax-table" "with-temp-buffer" "with-temp-file"
+              "with-temp-message" "with-timeout"
+              "with-timeout-handler"))
+     (el-errs '("user-error"))
+     ;; Common-Lisp constructs supported by EIEIO.  FIXME: namespace.
+     (eieio-fdefs '("defgeneric" "defmethod"))
+     (eieio-tdefs '("defclass"))
+     (eieio-kw '("with-slots"))
+     ;; Common-Lisp constructs supported by cl-lib.
+     (cl-lib-fdefs '("defmacro" "defsubst" "defun" "defmethod"))
+     (cl-lib-tdefs '("defstruct" "deftype"))
+     (cl-lib-kw '("progv" "eval-when" "case" "ecase" "typecase"
+                  "etypecase" "ccase" "ctypecase" "loop" "do" "do*"
+                  "the" "locally" "proclaim" "declaim" "letf" "go"
+                  ;; "lexical-let" "lexical-let*"
+                  "symbol-macrolet" "flet" "flet*" "destructuring-bind"
+                  "labels" "macrolet" "tagbody" "multiple-value-bind"
+                  "block" "return" "return-from"))
+     (cl-lib-errs '("assert" "check-type"))
+     ;; Common-Lisp constructs not supported by cl-lib.
+     (cl-fdefs '("defsetf" "define-method-combination"
+                 "define-condition" "define-setf-expander"
+                 ;; "define-function"??
+                 "define-compiler-macro" "define-modify-macro"))
+     (cl-vdefs '("define-symbol-macro" "defconstant" "defparameter"))
+     (cl-tdefs '("defpackage" "defstruct" "deftype"))
+     (cl-kw '("prog" "prog*" "handler-case" "handler-bind"
+              "in-package" "restart-case" ;; "inline"
+              "restart-bind" "break" "multiple-value-prog1"
+              "compiler-let" "with-accessors" "with-compilation-unit"
+              "with-condition-restarts" "with-hash-table-iterator"
+              "with-input-from-string" "with-open-file"
+              "with-open-stream" "with-package-iterator"
+              "with-simple-restart" "with-standard-io-syntax"))
+     (cl-errs '("abort" "cerror")))
+  (let ((vdefs (eval-when-compile
+                 (append lisp-vdefs el-vdefs cl-vdefs)))
+        (tdefs (eval-when-compile
+                 (append el-tdefs eieio-tdefs cl-tdefs cl-lib-tdefs
+                         (mapcar (lambda (s) (concat "cl-" s)) cl-lib-tdefs))))
+        ;; Elisp and Common Lisp definers.
+        (el-defs-re (eval-when-compile
+                      (regexp-opt (append lisp-fdefs lisp-vdefs
+                                          el-fdefs el-vdefs el-tdefs
+                                          (mapcar (lambda (s) (concat "cl-" s))
+                                                  (append cl-lib-fdefs cl-lib-tdefs))
+                                          eieio-fdefs eieio-tdefs)
+                                  t)))
+        (cl-defs-re (eval-when-compile
+                      (regexp-opt (append lisp-fdefs lisp-vdefs
+                                          cl-lib-fdefs cl-lib-tdefs
+                                          eieio-fdefs eieio-tdefs
+                                          cl-fdefs cl-vdefs cl-tdefs)
+                                  t)))
+        ;; Elisp and Common Lisp keywords.
+        ;; (el-kws-re (eval-when-compile
+        ;;              (regexp-opt (append
+        ;;                           lisp-kw el-kw eieio-kw
+        ;;                           (cons "go" (mapcar (lambda (s) (concat "cl-" s))
+        ;;                                              (remove "go" cl-lib-kw))))
+        ;;                          t)))
+        (cl-kws-re (eval-when-compile
+                     (regexp-opt (append lisp-kw cl-kw eieio-kw cl-lib-kw)
+                                 t)))
+        ;; Elisp and Common Lisp "errors".
+        (el-errs-re (eval-when-compile
+                      (regexp-opt (append (mapcar (lambda (s) (concat "cl-" s))
+                                                  cl-lib-errs)
+                                          lisp-errs el-errs)
+                                  t)))
+        (cl-errs-re (eval-when-compile
+                      (regexp-opt (append lisp-errs cl-lib-errs cl-errs) t))))
+    (dolist (v vdefs)
+      (put (intern v) 'lisp-define-type 'var))
+    (dolist (v tdefs)
+      (put (intern v) 'lisp-define-type 'type))
+
+    (define-obsolete-variable-alias 'lisp-font-lock-keywords-1
+      'lisp-el-font-lock-keywords-1 "24.4")
+    (defconst lisp-el-font-lock-keywords-1
+      `( ;; Definitions.
+        (,(concat "(" el-defs-re "\\_>"
+                  ;; Any whitespace and defined object.
+                  "[ \t']*"
+                  "\\(([ \t']*\\)?" ;; An opening paren.
+                  "\\(\\(setf\\)[ \t]+\\(?:\\sw\\|\\s_\\)+\\|\\(?:\\sw\\|\\s_\\)+\\)?")
+         (1 font-lock-keyword-face)
+         (3 (let ((type (get (intern-soft (match-string 1)) 'lisp-define-type)))
+              (cond ((eq type 'var) font-lock-variable-name-face)
+                    ((eq type 'type) font-lock-type-face)
+                    ;; If match-string 2 is non-nil, we encountered a
+                    ;; form like (defalias (intern (concat s "-p"))),
+                    ;; unless match-string 4 is also there.  Then its a
+                    ;; defmethod with (setf foo) as name.
+                    ((or (not (match-string 2)) ;; Normal defun.
+                         (and (match-string 2)  ;; Setf method.
+                              (match-string 4))) font-lock-function-name-face)))
+            nil t))
+        ;; Emacs Lisp autoload cookies.  Supports the slightly different
+        ;; forms used by mh-e, calendar, etc.
+        ("^;;;###\\([-a-z]*autoload\\)" 1 font-lock-warning-face prepend))
+      "Subdued level highlighting for Emacs Lisp mode.")
+
+    (defconst lisp-cl-font-lock-keywords-1
+      `( ;; Definitions.
+        (,(concat "(" cl-defs-re "\\_>"
+                  ;; Any whitespace and defined object.
+                  "[ \t']*"
+                  "\\(([ \t']*\\)?" ;; An opening paren.
+                  "\\(\\(setf\\)[ \t]+\\(?:\\sw\\|\\s_\\)+\\|\\(?:\\sw\\|\\s_\\)+\\)?")
+         (1 font-lock-keyword-face)
+         (3 (let ((type (get (intern-soft (match-string 1)) 'lisp-define-type)))
+              (cond ((eq type 'var) font-lock-variable-name-face)
+                    ((eq type 'type) font-lock-type-face)
+                    ((or (not (match-string 2)) ;; Normal defun.
+                         (and (match-string 2)  ;; Setf function.
+                              (match-string 4))) font-lock-function-name-face)))
+            nil t)))
+      "Subdued level highlighting for Lisp modes.")
+
+    (define-obsolete-variable-alias 'lisp-font-lock-keywords-2
+      'lisp-el-font-lock-keywords-2 "24.4")
+    (defconst lisp-el-font-lock-keywords-2
+      (append
+       lisp-el-font-lock-keywords-1
+       `( ;; Regexp negated char group.
+         ("\\[\\(\\^\\)" 1 font-lock-negation-char-face prepend)
+         ;; Control structures.  Common Lisp forms.
+         (lisp--el-match-keyword . 1)
+         ;; Exit/Feature symbols as constants.
+         (,(concat "(\\(catch\\|throw\\|featurep\\|provide\\|require\\)\\_>"
+                   "[ \t']*\\(\\(?:\\sw\\|\\s_\\)+\\)?")
+          (1 font-lock-keyword-face)
+          (2 font-lock-constant-face nil t))
+         ;; Erroneous structures.
+         (,(concat "(" el-errs-re "\\_>")
+          (1 font-lock-warning-face))
+         ;; Words inside \\[] tend to be for `substitute-command-keys'.
+         ("\\\\\\\\\\[\\(\\(?:\\sw\\|\\s_\\)+\\)\\]"
+          (1 font-lock-constant-face prepend))
+         ;; Words inside `' tend to be symbol names.
+         ("`\\(\\(?:\\sw\\|\\s_\\)\\(?:\\sw\\|\\s_\\)+\\)'"
+          (1 font-lock-constant-face prepend))
+         ;; Constant values.
+         ("\\_<:\\(?:\\sw\\|\\s_\\)+\\_>" 0 font-lock-builtin-face)
+         ;; ELisp and CLisp `&' keywords as types.
+         ("\\_<\\&\\(?:\\sw\\|\\s_\\)+\\_>" . font-lock-type-face)
+         ;; ELisp regexp grouping constructs
+         (,(lambda (bound)
+             (catch 'found
+               ;; The following loop is needed to continue searching after matches
+               ;; that do not occur in strings.  The associated regexp matches one
+               ;; of `\\\\' `\\(' `\\(?:' `\\|' `\\)'.  `\\\\' has been included to
+               ;; avoid highlighting, for example, `\\(' in `\\\\('.
+               (while (re-search-forward "\\(\\\\\\\\\\)\\(?:\\(\\\\\\\\\\)\\|\\((\\(?:\\?[0-9]*:\\)?\\|[|)]\\)\\)" bound t)
+                 (unless (match-beginning 2)
+                   (let ((face (get-text-property (1- (point)) 'face)))
+                     (when (or (and (listp face)
+                                    (memq 'font-lock-string-face face))
+                               (eq 'font-lock-string-face face))
+                       (throw 'found t)))))))
+          (1 'font-lock-regexp-grouping-backslash prepend)
+          (3 'font-lock-regexp-grouping-construct prepend))
+         ;; This is too general -- rms.
+         ;; A user complained that he has functions whose names start with `do'
+         ;; and that they get the wrong color.
+         ;; ;; CL `with-' and `do-' constructs
+         ;;("(\\(\\(do-\\|with-\\)\\(\\s_\\|\\w\\)*\\)" 1 font-lock-keyword-face)
+         (lisp--match-hidden-arg
+          (0 '(face font-lock-warning-face
+                    help-echo "Hidden behind deeper element; move to another line?")))
+         ))
+      "Gaudy level highlighting for Emacs Lisp mode.")
+
+    (defconst lisp-cl-font-lock-keywords-2
+      (append
+       lisp-cl-font-lock-keywords-1
+       `( ;; Regexp negated char group.
+         ("\\[\\(\\^\\)" 1 font-lock-negation-char-face prepend)
+         ;; Control structures.  Common Lisp forms.
+         (,(concat "(" cl-kws-re "\\_>") . 1)
+         ;; Exit/Feature symbols as constants.
+         (,(concat "(\\(catch\\|throw\\|provide\\|require\\)\\_>"
+                   "[ \t']*\\(\\(?:\\sw\\|\\s_\\)+\\)?")
+          (1 font-lock-keyword-face)
+          (2 font-lock-constant-face nil t))
+         ;; Erroneous structures.
+         (,(concat "(" cl-errs-re "\\_>")
+          (1 font-lock-warning-face))
+         ;; Words inside `' tend to be symbol names.
+         ("`\\(\\(?:\\sw\\|\\s_\\)\\(?:\\sw\\|\\s_\\)+\\)'"
+          (1 font-lock-constant-face prepend))
+         ;; Constant values.
+         ("\\_<:\\(?:\\sw\\|\\s_\\)+\\_>" 0 font-lock-builtin-face)
+         ;; ELisp and CLisp `&' keywords as types.
+         ("\\_<\\&\\(?:\\sw\\|\\s_\\)+\\_>" . font-lock-type-face)
+         ;; This is too general -- rms.
+         ;; A user complained that he has functions whose names start with `do'
+         ;; and that they get the wrong color.
+         ;; ;; CL `with-' and `do-' constructs
+         ;;("(\\(\\(do-\\|with-\\)\\(\\s_\\|\\w\\)*\\)" 1 font-lock-keyword-face)
+         (lisp--match-hidden-arg
+          (0 '(face font-lock-warning-face
+                    help-echo "Hidden behind deeper element; move to another line?")))
+         ))
+      "Gaudy level highlighting for Lisp modes.")))
 
 (define-obsolete-variable-alias 'lisp-font-lock-keywords
   'lisp-el-font-lock-keywords "24.4")
-- 
1.8.4


^ permalink raw reply related	[flat|nested] 10+ messages in thread

* Re: Use the new let-opt macro in place of pcase-let in lisp-mode.el
  2015-05-20  8:46           ` Oleh Krehel
@ 2015-05-20 12:58             ` Stefan Monnier
  2015-05-20 14:28               ` Oleh Krehel
  0 siblings, 1 reply; 10+ messages in thread
From: Stefan Monnier @ 2015-05-20 12:58 UTC (permalink / raw)
  To: Oleh Krehel; +Cc: emacs-devel

> (defmacro let-when-compile (bindings &rest body)
>   "Like `let', but allows for compile time optimization.
> \n(fn BINDINGS BODY)"
>   (declare (indent 1) (debug let))
>   (cl-progv (mapcar #'car bindings)
>       (mapcar (lambda (x) (eval (cadr x))) bindings)
>     (macroexpand-all
>      `(progn
>         ,@body)
>      macroexpand-all-environment)))

You can use `macroexp-progn' to avid adding `progn' when it's not needed,
but other than that, it looks good.

> So I guess it's fine. The byte compiler will issue a warning about an
> unbound variable if `eval-when-compile' is omitted by mistake.  I was
> thinking maybe something clever could be done, like automatically
> leaving a let binding to prevent an error.

Leaving a let-binding behind would kind of defeat the purpose and would
lead to lots of byte-compiler warnings about unused variables.

> Should I install the patch?

Go ahead, yes, but please move let-when-compile to a generic file rather
than lisp-mode.el.  I guess subr.el would make sense.


        Stefan



^ permalink raw reply	[flat|nested] 10+ messages in thread

* Re: Use the new let-opt macro in place of pcase-let in lisp-mode.el
  2015-05-20 12:58             ` Stefan Monnier
@ 2015-05-20 14:28               ` Oleh Krehel
  2015-05-20 18:48                 ` Stefan Monnier
  0 siblings, 1 reply; 10+ messages in thread
From: Oleh Krehel @ 2015-05-20 14:28 UTC (permalink / raw)
  To: Stefan Monnier; +Cc: emacs-devel

Stefan Monnier <monnier@iro.umontreal.ca> writes:
>> Should I install the patch?
>
> Go ahead, yes, but please move let-when-compile to a generic file rather
> than lisp-mode.el.  I guess subr.el would make sense.

Done, I've also added a test to test/automated/subr-tests.el. It was
auto-detected and ran fine. Is there any additional setup required for a
new test file?

Oleh



^ permalink raw reply	[flat|nested] 10+ messages in thread

* Re: Use the new let-opt macro in place of pcase-let in lisp-mode.el
  2015-05-20 14:28               ` Oleh Krehel
@ 2015-05-20 18:48                 ` Stefan Monnier
  0 siblings, 0 replies; 10+ messages in thread
From: Stefan Monnier @ 2015-05-20 18:48 UTC (permalink / raw)
  To: Oleh Krehel; +Cc: emacs-devel

> auto-detected and ran fine. Is there any additional setup required for a
> new test file?

I don't think so.


        Stefan



^ permalink raw reply	[flat|nested] 10+ messages in thread

end of thread, other threads:[~2015-05-20 18:48 UTC | newest]

Thread overview: 10+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2015-05-18 15:16 Use the new let-opt macro in place of pcase-let in lisp-mode.el Oleh Krehel
2015-05-18 16:39 ` Stefan Monnier
2015-05-18 17:26   ` Oleh Krehel
2015-05-19  1:11     ` Stefan Monnier
2015-05-19  8:08       ` Oleh Krehel
2015-05-20  2:03         ` Stefan Monnier
2015-05-20  8:46           ` Oleh Krehel
2015-05-20 12:58             ` Stefan Monnier
2015-05-20 14:28               ` Oleh Krehel
2015-05-20 18:48                 ` Stefan Monnier

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).