From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Oleh Krehel Newsgroups: gmane.emacs.devel Subject: Use the new let-opt macro in place of pcase-let in lisp-mode.el Date: Mon, 18 May 2015 17:16:44 +0200 Message-ID: <87egmdncf7.fsf@gmail.com> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: ger.gmane.org 1431962593 6246 80.91.229.3 (18 May 2015 15:23:13 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Mon, 18 May 2015 15:23:13 +0000 (UTC) To: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Mon May 18 17:23:08 2015 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1YuMsj-0003yn-US for ged-emacs-devel@m.gmane.org; Mon, 18 May 2015 17:23:06 +0200 Original-Received: from localhost ([::1]:41300 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1YuMsj-0003Le-82 for ged-emacs-devel@m.gmane.org; Mon, 18 May 2015 11:23:05 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:56390) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1YuMsc-0003LE-F4 for emacs-devel@gnu.org; Mon, 18 May 2015 11:23:01 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1YuMsX-0004Lw-CU for emacs-devel@gnu.org; Mon, 18 May 2015 11:22:58 -0400 Original-Received: from mail-wi0-x22f.google.com ([2a00:1450:400c:c05::22f]:33643) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1YuMsW-0004LA-L5 for emacs-devel@gnu.org; Mon, 18 May 2015 11:22:53 -0400 Original-Received: by wicmx19 with SMTP id mx19so91675772wic.0 for ; Mon, 18 May 2015 08:22:50 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20120113; h=from:to:subject:date:message-id:mime-version:content-type; bh=j9Mym4meLH48tQhD98BknA7BkUL3Kzy2467sbFZqYvM=; b=IeyqXvBWYV31MPJV4jTIspqfUvK2TFGQxjecDxFZPDjGbqpCAx+lUAZ2Gup9vQUEUw 3vkqIA4K3h9F7tJK+smqkdgqe3J561gRU7NAXFgzny8KCkNueYcgAGKfuSR3eLiYRHFg PqgMDWlOF1WcBsHTLb7aNYL6iDC25TFWn37hyw4kaMgfVmnqvel+1p8vEbhNNq9SXvr6 pVwRXR33vBjKKehrVp3Do+0VSannTSwbPhYydN/XFXqSG8ISSNH6Xmkr56GsFf9Jk3No WFCemFS9Q0Svtat80Y2yYGtzlhr9XpDKwxkcf13L6KPdgFHpDwNRSadEeiMAct/HgegX P+tQ== X-Received: by 10.194.95.41 with SMTP id dh9mr46072761wjb.55.1431962570811; Mon, 18 May 2015 08:22:50 -0700 (PDT) Original-Received: from firefly (dyn069045.nbw.tue.nl. [131.155.69.45]) by mx.google.com with ESMTPSA id f8sm12963247wiy.7.2015.05.18.08.22.49 for (version=TLSv1.2 cipher=RC4-SHA bits=128/128); Mon, 18 May 2015 08:22:50 -0700 (PDT) X-detected-operating-system: by eggs.gnu.org: Error: Malformed IPv6 address (bad octet value). X-Received-From: 2a00:1450:400c:c05::22f X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:186578 Archived-At: --=-=-= Content-Type: text/plain 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 --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0001-Add-let-opt-macro-instead-of-using-pcase-let.patch >From e0caf6118392e712b2af72e9973f7404ff05be4a Mon Sep 17 00:00:00 2001 From: Oleh Krehel 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 --=-=-=--