mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-05 11:45:45 +00:00
Code Issues Releases Activity

* emacs-lisp/lisp-mode.el (lisp-el-font-lock-keywords-2): Add

Browse Source 
pcase-exhaustive.

* emacs-lisp/pcase.el (pcase--dontwarn-upats): New var.
(pcase--expand): Use it.
(pcase-exhaustive): New macro.

Fixes: debbugs:16567
This commit is contained in:
Leo Liu 2014-09-14 00:30:21 +08:00
parent 4d837e510b
commit 85b3d352c7
3 changed files with 25 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
lisp/ChangeLog
View File

@ -1,3 +1,12 @@
2014-09-13 Leo Liu <sdl.web@gmail.com>
* emacs-lisp/pcase.el (pcase--dontwarn-upats): New var.
(pcase--expand): Use it.
(pcase-exhaustive): New macro. (Bug#16567)
* emacs-lisp/lisp-mode.el (lisp-el-font-lock-keywords-2): Add
pcase-exhaustive.
2014-09-13 Eli Zaretskii <eliz@gnu.org>
* mail/rmailmm.el (rmail-mime-insert-html): Decode the HTML part

6
lisp/emacs-lisp/lisp-mode.el
View File

@ -197,9 +197,9 @@ It has `lisp-mode-abbrev-table' as its parent."
(el-vdefs '("defconst" "defcustom" "defvaralias" "defvar-local"
"defface"))
(el-tdefs '("defgroup" "deftheme"))
(el-kw '("while-no-input" "letrec" "pcase" "pcase-let"
"pcase-let*" "save-restriction" "save-excursion"
"save-selected-window"
(el-kw '("while-no-input" "letrec" "pcase" "pcase-exhaustive"
"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"

14
lisp/emacs-lisp/pcase.el
View File

@ -68,6 +68,8 @@
(defconst pcase--dontcare-upats '(t _ pcase--dontcare))
(defvar pcase--dontwarn-upats '(pcase--dontcare))
(def-edebug-spec
pcase-UPAT
(&or symbolp
@ -148,6 +150,15 @@ like `(,a . ,(pred (< a))) or, with more checks:
;; (puthash (car cases) `(,exp ,cases ,@expansion) pcase--memoize-2)
expansion))))
;;;###autoload
(defmacro pcase-exhaustive (exp &rest cases)
"The exhaustive version of `pcase' (which see)."
(declare (indent 1) (debug pcase))
(let* ((x (make-symbol "x"))
(pcase--dontwarn-upats (cons x pcase--dontwarn-upats)))
(pcase--expand
exp (append cases `((,x (error "No clause matching `%S'" ,x)))))))
(defun pcase--let* (bindings body)
(cond
((null bindings) (macroexp-progn body))
@ -280,7 +291,8 @@ of the form (UPAT EXP)."
vars))))
cases))))
(dolist (case cases)
(unless (or (memq case used-cases) (eq (car case) 'pcase--dontcare))
(unless (or (memq case used-cases)
(memq (car case) pcase--dontwarn-upats))
(message "Redundant pcase pattern: %S" (car case))))
(macroexp-let* defs main))))