1 ;;; subr-x.el --- extra Lisp functions -*- lexical-binding:t -*-
3 ;; Copyright (C) 2013-2017 Free Software Foundation, Inc.
5 ;; Maintainer: emacs-devel@gnu.org
6 ;; Keywords: convenience
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software: you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation, either version 3 of the License, or
14 ;; (at your option) any later version.
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
26 ;; Less commonly used functions that complement basic APIs, often implemented in
27 ;; C code (like hash-tables and strings), and are not eligible for inclusion
30 ;; Do not document these functions in the lispref.
31 ;; https://lists.gnu.org/r/emacs-devel/2014-01/msg01006.html
33 ;; NB If you want to use this library, it's almost always correct to use:
34 ;; (eval-when-compile (require 'subr-x))
38 (eval-when-compile (require 'cl-lib
))
41 (defmacro internal--thread-argument
(first?
&rest forms
)
42 "Internal implementation for `thread-first' and `thread-last'.
43 When Argument FIRST? is non-nil argument is threaded first, else
44 last. FORMS are the expressions to be threaded."
46 (`(,x
(,f .
,args
) .
,rest
)
47 `(internal--thread-argument
48 ,first?
,(if first?
`(,f
,x
,@args
) `(,f
,@args
,x
)) ,@rest
))
49 (`(,x
,f .
,rest
) `(internal--thread-argument ,first?
(,f
,x
) ,@rest
))
52 (defmacro thread-first
(&rest forms
)
53 "Thread FORMS elements as the first argument of their successor.
62 (+ (- (/ (+ 5 20) 25)) 40)
63 Note how the single `-' got converted into a list before
66 (debug (form &rest
[&or symbolp
(sexp &rest form
)])))
67 `(internal--thread-argument t
,@forms
))
69 (defmacro thread-last
(&rest forms
)
70 "Thread FORMS elements as the last argument of their successor.
79 (+ 40 (- (/ 25 (+ 20 5))))
80 Note how the single `-' got converted into a list before
82 (declare (indent 1) (debug thread-first
))
83 `(internal--thread-argument nil
,@forms
))
85 (defsubst internal--listify
(elt)
86 "Wrap ELT in a list if it is not one.
87 If ELT is of the form ((EXPR)), listify (EXPR) with a dummy symbol."
89 ((symbolp elt
) (list elt elt
))
91 (list (make-symbol "s") (car elt
)))
94 (defsubst internal--check-binding
(binding)
95 "Check BINDING is properly formed."
96 (when (> (length binding
) 2)
99 (cons "`let' bindings can have only one value-form" binding
)))
102 (defsubst internal--build-binding-value-form
(binding prev-var
)
103 "Build the conditional value form for BINDING using PREV-VAR."
104 (let ((var (car binding
)))
105 `(,var
(and ,prev-var
,(cadr binding
)))))
107 (defun internal--build-binding (binding prev-var
)
108 "Check and build a single BINDING with PREV-VAR."
112 internal--check-binding
113 (internal--build-binding-value-form prev-var
)))
115 (defun internal--build-bindings (bindings)
116 "Check and build conditional value forms for BINDINGS."
118 (mapcar (lambda (binding)
119 (let ((binding (internal--build-binding binding prev-var
)))
120 (setq prev-var
(car binding
))
124 (defmacro if-let
* (varlist then
&rest else
)
125 "Bind variables according to VARLIST and eval THEN or ELSE.
126 Each binding is evaluated in turn, and evaluation stops if a
127 binding value is nil. If all are non-nil, the value of THEN is
128 returned, or the last form in ELSE is returned.
130 Each element of VARLIST is a list (SYMBOL VALUEFORM) which binds
131 SYMBOL to the value of VALUEFORM. An element can additionally
132 be of the form (VALUEFORM), which is evaluated and checked for
133 nil; i.e. SYMBOL can be omitted if only the test result is of
136 (debug ((&rest
[&or symbolp
(symbolp form
) (form)])
139 `(let* ,(setq varlist
(internal--build-bindings varlist
))
140 (if ,(caar (last varlist
))
145 (defmacro when-let
* (varlist &rest body
)
146 "Bind variables according to VARLIST and conditionally eval BODY.
147 Each binding is evaluated in turn, and evaluation stops if a
148 binding value is nil. If all are non-nil, the value of the last
149 form in BODY is returned.
151 VARLIST is the same as in `if-let*'."
152 (declare (indent 1) (debug if-let
*))
153 (list 'if-let
* varlist
(macroexp-progn body
)))
155 (defmacro and-let
* (varlist &rest body
)
156 "Bind variables according to VARLIST and conditionally eval BODY.
157 Like `when-let*', except if BODY is empty and all the bindings
158 are non-nil, then the result is non-nil."
160 (debug ((&rest
[&or symbolp
(symbolp form
) (form)])
164 `(let* ,(setq varlist
(internal--build-bindings varlist
))
165 (if ,(setq res
(caar (last varlist
)))
166 ,@(or body
`(,res
))))
167 `(let* () ,@(or body
'(t))))))
169 (defmacro if-let
(spec then
&rest else
)
170 "Bind variables according to SPEC and eval THEN or ELSE.
171 Like `if-let*' except SPEC can have the form (SYMBOL VALUEFORM)."
173 (debug ([&or
(&rest
[&or symbolp
(symbolp form
) (form)])
176 (obsolete "use `if-let*' instead." "26.1"))
177 (when (and (<= (length spec
) 2)
178 (not (listp (car spec
))))
179 ;; Adjust the single binding case
180 (setq spec
(list spec
)))
181 (list 'if-let
* spec then
(macroexp-progn else
)))
183 (defmacro when-let
(spec &rest body
)
184 "Bind variables according to SPEC and conditionally eval BODY.
185 Like `when-let*' except SPEC can have the form (SYMBOL VALUEFORM)."
186 (declare (indent 1) (debug if-let
)
187 (obsolete "use `when-let*' instead." "26.1"))
188 (list 'if-let spec
(macroexp-progn body
)))
190 (defsubst hash-table-empty-p
(hash-table)
191 "Check whether HASH-TABLE is empty (has 0 elements)."
192 (zerop (hash-table-count hash-table
)))
194 (defsubst hash-table-keys
(hash-table)
195 "Return a list of keys in HASH-TABLE."
196 (cl-loop for k being the hash-keys of hash-table collect k
))
198 (defsubst hash-table-values
(hash-table)
199 "Return a list of values in HASH-TABLE."
200 (cl-loop for v being the hash-values of hash-table collect v
))
202 (defsubst string-empty-p
(string)
203 "Check whether STRING is empty."
206 (defsubst string-join
(strings &optional separator
)
207 "Join all STRINGS using SEPARATOR."
208 (mapconcat 'identity strings separator
))
210 (define-obsolete-function-alias 'string-reverse
'reverse
"25.1")
212 (defsubst string-trim-left
(string &optional regexp
)
213 "Trim STRING of leading string matching REGEXP.
215 REGEXP defaults to \"[ \\t\\n\\r]+\"."
216 (if (string-match (concat "\\`\\(?:" (or regexp
"[ \t\n\r]+")"\\)") string
)
217 (replace-match "" t t string
)
220 (defsubst string-trim-right
(string &optional regexp
)
221 "Trim STRING of trailing string matching REGEXP.
223 REGEXP defaults to \"[ \\t\\n\\r]+\"."
224 (if (string-match (concat "\\(?:" (or regexp
"[ \t\n\r]+") "\\)\\'") string
)
225 (replace-match "" t t string
)
228 (defsubst string-trim
(string &optional trim-left trim-right
)
229 "Trim STRING of leading and trailing strings matching TRIM-LEFT and TRIM-RIGHT.
231 TRIM-LEFT and TRIM-RIGHT default to \"[ \\t\\n\\r]+\"."
232 (string-trim-left (string-trim-right string trim-right
) trim-left
))
234 (defsubst string-blank-p
(string)
235 "Check whether STRING is either empty or only whitespace."
236 (string-match-p "\\`[ \t\n\r]*\\'" string
))
238 (defsubst string-remove-prefix
(prefix string
)
239 "Remove PREFIX from STRING if present."
240 (if (string-prefix-p prefix string
)
241 (substring string
(length prefix
))
244 (defsubst string-remove-suffix
(suffix string
)
245 "Remove SUFFIX from STRING if present."
246 (if (string-suffix-p suffix string
)
247 (substring string
0 (- (length string
) (length suffix
)))
252 ;;; subr-x.el ends here