diff options
author | Vincent Belaïche <vincentb1@users.sourceforge.net> | 2017-09-15 23:52:24 +0200 |
---|---|---|
committer | Vincent Belaïche <vincentb1@users.sourceforge.net> | 2017-09-15 23:52:24 +0200 |
commit | 767b3a7429d94d1565256565fda2060c95ca4f73 (patch) | |
tree | 51ea759d20769230bd57fd6a93f0c98d261063b0 /lisp/emacs-lisp/subr-x.el | |
parent | d1458d0f40f481e0ac55a55e7567d6e51438b583 (diff) | |
parent | 9785d3513741c598ae53aecafacbb9bca3e53e48 (diff) | |
download | emacs-767b3a7429d94d1565256565fda2060c95ca4f73.tar.gz emacs-767b3a7429d94d1565256565fda2060c95ca4f73.tar.bz2 emacs-767b3a7429d94d1565256565fda2060c95ca4f73.zip |
Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs
Diffstat (limited to 'lisp/emacs-lisp/subr-x.el')
-rw-r--r-- | lisp/emacs-lisp/subr-x.el | 107 |
1 files changed, 68 insertions, 39 deletions
diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index 849ac19d6a5..077ad22c75d 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -19,7 +19,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: @@ -83,10 +83,13 @@ threading." `(internal--thread-argument nil ,@forms)) (defsubst internal--listify (elt) - "Wrap ELT in a list if it is not one." - (if (not (listp elt)) - (list elt) - elt)) + "Wrap ELT in a list if it is not one. +If ELT is of the form ((EXPR)), listify (EXPR) with a dummy symbol." + (cond + ((symbolp elt) (list elt elt)) + ((null (cdr elt)) + (list (make-symbol "s") (car elt))) + (t elt))) (defsubst internal--check-binding (binding) "Check BINDING is properly formed." @@ -98,7 +101,8 @@ threading." (defsubst internal--build-binding-value-form (binding prev-var) "Build the conditional value form for BINDING using PREV-VAR." - `(,(car binding) (and ,prev-var ,(cadr binding)))) + (let ((var (car binding))) + `(,var (and ,prev-var ,(cadr binding))))) (defun internal--build-binding (binding prev-var) "Check and build a single BINDING with PREV-VAR." @@ -117,44 +121,69 @@ threading." binding)) bindings))) -(defmacro if-let* (bindings then &rest else) +(defmacro if-let* (varlist then &rest else) "Bind variables according to VARLIST and eval THEN or ELSE. -Each binding is evaluated in turn with `let*', and evaluation -stops if a binding value is nil. If all are non-nil, the value -of THEN is returned, or the last form in ELSE is returned. -Each element of VARLIST is a symbol (which is bound to nil) -or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM). -In the special case you only want to bind a single value, -VARLIST can just be a plain tuple. -\n(fn VARLIST THEN ELSE...)" +Each binding is evaluated in turn, and evaluation stops if a +binding value is nil. If all are non-nil, the value of THEN is +returned, or the last form in ELSE is returned. + +Each element of VARLIST is a list (SYMBOL VALUEFORM) which binds +SYMBOL to the value of VALUEFORM). An element can additionally +be of the form (VALUEFORM), which is evaluated and checked for +nil; i.e. SYMBOL can be omitted if only the test result is of +interest." (declare (indent 2) - (debug ([&or (&rest [&or symbolp (symbolp form)]) (symbolp form)] + (debug ((&rest [&or symbolp (symbolp form) (sexp)]) form body))) - (when (and (<= (length bindings) 2) - (not (listp (car bindings)))) - ;; Adjust the single binding case - (setq bindings (list bindings))) - `(let* ,(internal--build-bindings bindings) - (if ,(car (internal--listify (car (last bindings)))) - ,then - ,@else))) + (if varlist + `(let* ,(setq varlist (internal--build-bindings varlist)) + (if ,(caar (last varlist)) + ,then + ,@else)) + `(let* () ,then))) + +(defmacro when-let* (varlist &rest body) + "Bind variables according to VARLIST and conditionally eval BODY. +Each binding is evaluated in turn, and evaluation stops if a +binding value is nil. If all are non-nil, the value of the last +form in BODY is returned. + +VARLIST is the same as in `if-let*'." + (declare (indent 1) (debug if-let*)) + (list 'if-let* varlist (macroexp-progn body))) -(defmacro when-let* (bindings &rest body) +(defmacro and-let* (varlist &rest body) "Bind variables according to VARLIST and conditionally eval BODY. -Each binding is evaluated in turn with `let*', and evaluation -stops if a binding value is nil. If all are non-nil, the value -of the last form in BODY is returned. -Each element of VARLIST is a symbol (which is bound to nil) -or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM). -In the special case you only want to bind a single value, -VARLIST can just be a plain tuple. -\n(fn VARLIST BODY...)" - (declare (indent 1) (debug if-let)) - (list 'if-let bindings (macroexp-progn body))) - -(defalias 'if-let 'if-let*) -(defalias 'when-let 'when-let*) -(defalias 'and-let* 'when-let*) +Like `when-let*', except if BODY is empty and all the bindings +are non-nil, then the result is non-nil." + (declare (indent 1) (debug when-let*)) + (let (res) + (if varlist + `(let* ,(setq varlist (internal--build-bindings varlist)) + (if ,(setq res (caar (last varlist))) + ,@(or body `(,res)))) + `(let* () ,@(or body '(t)))))) + +(defmacro if-let (spec then &rest else) + "Bind variables according to SPEC and eval THEN or ELSE. +Like `if-let*' except SPEC can have the form (SYMBOL VALUEFORM)." + (declare (indent 2) + (debug ([&or (&rest [&or symbolp (symbolp form) (sexp)]) + (symbolp form)] + form body)) + (obsolete "use `if-let*' instead." "26.1")) + (when (and (<= (length spec) 2) + (not (listp (car spec)))) + ;; Adjust the single binding case + (setq spec (list spec))) + (list 'if-let* spec then (macroexp-progn else))) + +(defmacro when-let (spec &rest body) + "Bind variables according to SPEC and conditionally eval BODY. +Like `when-let*' except SPEC can have the form (SYMBOL VALUEFORM)." + (declare (indent 1) (debug if-let) + (obsolete "use `when-let*' instead." "26.1")) + (list 'if-let spec (macroexp-progn body))) (defsubst hash-table-empty-p (hash-table) "Check whether HASH-TABLE is empty (has 0 elements)." |