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

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).