Add macro pcase-lambda

Fixes: debbugs:19814

* emacs-lisp/lisp-mode.el (el-kws-re): Include `pcase-lambda'.

* emacs-lisp/macroexp.el (macroexp-parse-body): New function.

* emacs-lisp/pcase.el (pcase-lambda): New Macro.

4 files changed, 39 insertions, 1 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index ce381315b40..cd40ac7a259 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,11 @@
+2015-02-09  Leo Liu  <sdl.web@gmail.com>
+
+        * emacs-lisp/pcase.el (pcase-lambda): New Macro.  (Bug#19814)
+
+        * emacs-lisp/lisp-mode.el (el-kws-re): Include `pcase-lambda'.
+
+        * emacs-lisp/macroexp.el (macroexp-parse-body): New function.
+
 2015-02-08  Paul Eggert  <eggert@cs.ucla.edu>
 
         Port to platforms lacking test -a and -o
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index 868a9578b0d..5d912097838 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -204,7 +204,7 @@
                           "defface"))
               (el-tdefs '("defgroup" "deftheme"))
               (el-kw '("while-no-input" "letrec" "pcase" "pcase-exhaustive"
-                       "pcase-let" "pcase-let*" "save-restriction"
+                       "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"
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index 797de9abb5b..b75c8cc50a7 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -297,6 +297,16 @@ definitions to shadow the loaded ones for use in file byte-compilation."
 
 ;;; Handy functions to use in macros.
 
+(defun macroexp-parse-body (exps)
+  "Parse EXPS into ((DOC DECLARE-FORM INTERACTIVE-FORM) . BODY)."
+  `((,(and (stringp (car exps))
+           (pop exps))
+     ,(and (eq (car-safe (car exps)) 'declare)
+           (pop exps))
+     ,(and (eq (car-safe (car exps)) 'interactive)
+           (pop exps)))
+    ,@exps))
+
 (defun macroexp-progn (exps)
   "Return an expression equivalent to `(progn ,@EXPS)."
   (if (cdr exps) `(progn ,@exps) (car exps)))
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index b495793bee0..057b12894f9 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -164,6 +164,26 @@ like `(,a . ,(pred (< a))) or, with more checks:
      ;; FIXME: Could we add the FILE:LINE data in the error message?
      exp (append cases `((,x (error "No clause matching `%S'" ,x)))))))
 
+;;;###autoload
+(defmacro pcase-lambda (lambda-list &rest body)
+  "Like `lambda' but allow each argument to be a pattern.
+`&rest' argument is supported."
+  (declare (doc-string 2) (indent defun)
+           (debug ((&rest pcase-UPAT &optional ["&rest" pcase-UPAT]) body)))
+  (let ((args (make-symbol "args"))
+        (pats (mapcar (lambda (u)
+                        (unless (eq u '&rest)
+                          (if (eq (car-safe u) '\`) (cadr u) (list '\, u))))
+                      lambda-list))
+        (body (macroexp-parse-body body)))
+    ;; Handle &rest
+    (when (eq nil (car (last pats 2)))
+      (setq pats (append (butlast pats 2) (car (last pats)))))
+    `(lambda (&rest ,args)
+       ,@(remq nil (car body))
+       (pcase ,args
+         (,(list '\` pats) . ,(cdr body))))))
+
 (defun pcase--let* (bindings body)
   (cond
    ((null bindings) (macroexp-progn body))