summaryrefslogtreecommitdiff
path: root/lisp/emacs-lisp
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/emacs-lisp')
-rw-r--r--lisp/emacs-lisp/lisp-mode.el6
-rw-r--r--lisp/emacs-lisp/pcase.el14
2 files changed, 16 insertions, 4 deletions
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index 31df353321a..435730ae098 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -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"
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index 963d6a44041..94aedd4339a 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -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))))