summaryrefslogtreecommitdiff
path: root/lisp/emacs-lisp/subr-x.el
diff options
context:
space:
mode:
authorVincent Belaïche <vincentb1@users.sourceforge.net>2017-09-15 23:52:24 +0200
committerVincent Belaïche <vincentb1@users.sourceforge.net>2017-09-15 23:52:24 +0200
commit767b3a7429d94d1565256565fda2060c95ca4f73 (patch)
tree51ea759d20769230bd57fd6a93f0c98d261063b0 /lisp/emacs-lisp/subr-x.el
parentd1458d0f40f481e0ac55a55e7567d6e51438b583 (diff)
parent9785d3513741c598ae53aecafacbb9bca3e53e48 (diff)
downloademacs-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.el107
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)."