]> crepu.dev Git - config.git/blame_incremental - djavu-asus/elpa/s-20220902.1511/s.el
Archivo de configuración de la terminal
[config.git] / djavu-asus / elpa / s-20220902.1511 / s.el
... / ...
CommitLineData
1;;; s.el --- The long lost Emacs string manipulation library. -*- lexical-binding: t -*-
2
3;; Copyright (C) 2012-2022 Magnar Sveen
4
5;; Author: Magnar Sveen <magnars@gmail.com>
6;; Maintainer: Jason Milkins <jasonm23@gmail.com>
7;; Version: 1.13.1
8;; Keywords: strings
9
10;; This program is free software; you can redistribute it and/or modify
11;; it under the terms of the GNU General Public License as published by
12;; the Free Software Foundation, either version 3 of the License, or
13;; (at your option) any later version.
14
15;; This program is distributed in the hope that it will be useful,
16;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18;; GNU General Public License for more details.
19
20;; You should have received a copy of the GNU General Public License
21;; along with this program. If not, see <http://www.gnu.org/licenses/>.
22
23;;; Commentary:
24
25;; The long lost Emacs string manipulation library.
26;;
27;; See documentation on https://github.com/magnars/s.el#functions
28
29;;; Code:
30
31;; Silence byte-compiler
32(defvar ucs-normalize-combining-chars) ; Defined in `ucs-normalize'
33(autoload 'slot-value "eieio")
34
35(defun s-trim-left (s)
36 "Remove whitespace at the beginning of S."
37 (declare (pure t) (side-effect-free t))
38 (save-match-data
39 (if (string-match "\\`[ \t\n\r]+" s)
40 (replace-match "" t t s)
41 s)))
42
43(defun s-trim-right (s)
44 "Remove whitespace at the end of S."
45 (declare (pure t) (side-effect-free t))
46 (save-match-data
47 (if (string-match "[ \t\n\r]+\\'" s)
48 (replace-match "" t t s)
49 s)))
50
51(defun s-trim (s)
52 "Remove whitespace at the beginning and end of S."
53 (declare (pure t) (side-effect-free t))
54 (s-trim-left (s-trim-right s)))
55
56(defun s-collapse-whitespace (s)
57 "Convert all adjacent whitespace characters to a single space."
58 (declare (pure t) (side-effect-free t))
59 (replace-regexp-in-string "[ \t\n\r]+" " " s))
60
61(defun s-unindent (s &optional bol)
62 "Unindent S which has BOL (beginning of line) indicators.
63BOL will default to pipe. You can optionally supply your own."
64 (declare (pure t) (side-effect-free t))
65 (let ((case-fold-search nil)
66 (bol (or bol "|")))
67 (s-replace-regexp (concat "^[[:space:]]*" (regexp-quote bol)) "" s)))
68
69(defun s-split (separator s &optional omit-nulls)
70 "Split S into substrings bounded by matches for regexp SEPARATOR.
71If OMIT-NULLS is non-nil, zero-length substrings are omitted.
72
73This is a simple wrapper around the built-in `split-string'."
74 (declare (side-effect-free t))
75 (save-match-data
76 (split-string s separator omit-nulls)))
77
78(defun s-split-up-to (separator s n &optional omit-nulls)
79 "Split S up to N times into substrings bounded by matches for regexp SEPARATOR.
80
81If OMIT-NULLS is non-nil, zero-length substrings are omitted.
82
83See also `s-split'."
84 (declare (side-effect-free t))
85 (save-match-data
86 (let ((op 0)
87 (r nil))
88 (with-temp-buffer
89 (insert s)
90 (setq op (goto-char (point-min)))
91 (while (and (re-search-forward separator nil t)
92 (< 0 n))
93 (let ((sub (buffer-substring op (match-beginning 0))))
94 (unless (and omit-nulls
95 (equal sub ""))
96 (push sub r)))
97 (setq op (goto-char (match-end 0)))
98 (setq n (1- n)))
99 (let ((sub (buffer-substring op (point-max))))
100 (unless (and omit-nulls
101 (equal sub ""))
102 (push sub r))))
103 (nreverse r))))
104
105(defun s-lines (s)
106 "Splits S into a list of strings on newline characters."
107 (declare (pure t) (side-effect-free t))
108 (s-split "\\(\r\n\\|[\n\r]\\)" s))
109
110(defun s-join (separator strings)
111 "Join all the strings in STRINGS with SEPARATOR in between."
112 (declare (pure t) (side-effect-free t))
113 (mapconcat 'identity strings separator))
114
115(defun s-concat (&rest strings)
116 "Join all the string arguments into one string."
117 (declare (pure t) (side-effect-free t))
118 (apply 'concat strings))
119
120(defun s-prepend (prefix s)
121 "Concatenate PREFIX and S."
122 (declare (pure t) (side-effect-free t))
123 (concat prefix s))
124
125(defun s-append (suffix s)
126 "Concatenate S and SUFFIX."
127 (declare (pure t) (side-effect-free t))
128 (concat s suffix))
129
130(defun s-splice (needle n s)
131 "Splice NEEDLE into S at position N.
1320 is the beginning of the string, -1 is the end."
133 (if (< n 0)
134 (let ((left (substring s 0 (+ 1 n (length s))))
135 (right (s-right (- -1 n) s)))
136 (concat left needle right))
137 (let ((left (s-left n s))
138 (right (substring s n (length s))))
139 (concat left needle right))))
140
141
142(defun s-repeat (num s)
143 "Make a string of S repeated NUM times."
144 (declare (pure t) (side-effect-free t))
145 (let (ss)
146 (while (> num 0)
147 (setq ss (cons s ss))
148 (setq num (1- num)))
149 (apply 'concat ss)))
150
151(defun s-chop-suffix (suffix s)
152 "Remove SUFFIX if it is at end of S."
153 (declare (pure t) (side-effect-free t))
154 (let ((pos (- (length suffix))))
155 (if (and (>= (length s) (length suffix))
156 (string= suffix (substring s pos)))
157 (substring s 0 pos)
158 s)))
159
160(defun s-chop-suffixes (suffixes s)
161 "Remove SUFFIXES one by one in order, if they are at the end of S."
162 (declare (pure t) (side-effect-free t))
163 (while suffixes
164 (setq s (s-chop-suffix (car suffixes) s))
165 (setq suffixes (cdr suffixes)))
166 s)
167
168(defun s-chop-prefix (prefix s)
169 "Remove PREFIX if it is at the start of S."
170 (declare (pure t) (side-effect-free t))
171 (let ((pos (length prefix)))
172 (if (and (>= (length s) (length prefix))
173 (string= prefix (substring s 0 pos)))
174 (substring s pos)
175 s)))
176
177(defun s-chop-prefixes (prefixes s)
178 "Remove PREFIXES one by one in order, if they are at the start of S."
179 (declare (pure t) (side-effect-free t))
180 (while prefixes
181 (setq s (s-chop-prefix (car prefixes) s))
182 (setq prefixes (cdr prefixes)))
183 s)
184
185(defun s-shared-start (s1 s2)
186 "Returns the longest prefix S1 and S2 have in common."
187 (declare (pure t) (side-effect-free t))
188 (let ((cmp (compare-strings s1 0 (length s1) s2 0 (length s2))))
189 (if (eq cmp t) s1 (substring s1 0 (1- (abs cmp))))))
190
191(defun s-shared-end (s1 s2)
192 "Returns the longest suffix S1 and S2 have in common."
193 (declare (pure t) (side-effect-free t))
194 (let* ((l1 (length s1))
195 (l2 (length s2))
196 (search-length (min l1 l2))
197 (i 0))
198 (while (and (< i search-length)
199 (= (aref s1 (- l1 i 1)) (aref s2 (- l2 i 1))))
200 (setq i (1+ i)))
201 ;; If I is 0, then it means that there's no common suffix between
202 ;; S1 and S2.
203 ;;
204 ;; However, since (substring s (- 0)) will return the whole
205 ;; string, `s-shared-end' should simply return the empty string
206 ;; when I is 0.
207 (if (zerop i)
208 ""
209 (substring s1 (- i)))))
210
211(defun s-chomp (s)
212 "Remove one trailing `\\n`, `\\r` or `\\r\\n` from S."
213 (declare (pure t) (side-effect-free t))
214 (s-chop-suffixes '("\n" "\r") s))
215
216(defun s-truncate (len s &optional ellipsis)
217 "If S is longer than LEN, cut it down and add ELLIPSIS to the end.
218
219The resulting string, including ellipsis, will be LEN characters
220long.
221
222When not specified, ELLIPSIS defaults to ‘...’."
223 (declare (pure t) (side-effect-free t))
224 (unless ellipsis
225 (setq ellipsis "..."))
226 (if (> (length s) len)
227 (format "%s%s" (substring s 0 (- len (length ellipsis))) ellipsis)
228 s))
229
230(defun s-word-wrap (len s)
231 "If S is longer than LEN, wrap the words with newlines."
232 (declare (side-effect-free t))
233 (save-match-data
234 (with-temp-buffer
235 (insert s)
236 (let ((fill-column len))
237 (fill-region (point-min) (point-max)))
238 (buffer-substring (point-min) (point-max)))))
239
240(defun s-center (len s)
241 "If S is shorter than LEN, pad it with spaces so it is centered."
242 (declare (pure t) (side-effect-free t))
243 (let ((extra (max 0 (- len (length s)))))
244 (concat
245 (make-string (ceiling extra 2) ?\s)
246 s
247 (make-string (floor extra 2) ?\s))))
248
249(defun s-pad-left (len padding s)
250 "If S is shorter than LEN, pad it with PADDING on the left."
251 (declare (pure t) (side-effect-free t))
252 (let ((extra (max 0 (- len (length s)))))
253 (concat (make-string extra (string-to-char padding))
254 s)))
255
256(defun s-pad-right (len padding s)
257 "If S is shorter than LEN, pad it with PADDING on the right."
258 (declare (pure t) (side-effect-free t))
259 (let ((extra (max 0 (- len (length s)))))
260 (concat s
261 (make-string extra (string-to-char padding)))))
262
263(defun s-left (len s)
264 "Returns up to the LEN first chars of S."
265 (declare (pure t) (side-effect-free t))
266 (if (> (length s) len)
267 (substring s 0 len)
268 s))
269
270(defun s-right (len s)
271 "Returns up to the LEN last chars of S."
272 (declare (pure t) (side-effect-free t))
273 (let ((l (length s)))
274 (if (> l len)
275 (substring s (- l len) l)
276 s)))
277
278(defun s-chop-left (len s)
279 "Remove the first LEN chars from S."
280 (let ((l (length s)))
281 (if (> l len)
282 (substring s len l)
283 "")))
284
285(defun s-chop-right (len s)
286 "Remove the last LEN chars from S."
287 (let ((l (length s)))
288 (if (> l len)
289 (substring s 0 (- l len))
290 "")))
291
292(defun s-ends-with? (suffix s &optional ignore-case)
293 "Does S end with SUFFIX?
294
295If IGNORE-CASE is non-nil, the comparison is done without paying
296attention to case differences.
297
298Alias: `s-suffix?'"
299 (declare (pure t) (side-effect-free t))
300 (let ((start-pos (- (length s) (length suffix))))
301 (and (>= start-pos 0)
302 (eq t (compare-strings suffix nil nil
303 s start-pos nil ignore-case)))))
304
305(defun s-starts-with? (prefix s &optional ignore-case)
306 "Does S start with PREFIX?
307
308If IGNORE-CASE is non-nil, the comparison is done without paying
309attention to case differences.
310
311Alias: `s-prefix?'. This is a simple wrapper around the built-in
312`string-prefix-p'."
313 (declare (pure t) (side-effect-free t))
314 (string-prefix-p prefix s ignore-case))
315
316(defun s--truthy? (val)
317 (declare (pure t) (side-effect-free t))
318 (not (null val)))
319
320(defun s-contains? (needle s &optional ignore-case)
321 "Does S contain NEEDLE?
322
323If IGNORE-CASE is non-nil, the comparison is done without paying
324attention to case differences."
325 (declare (pure t) (side-effect-free t))
326 (let ((case-fold-search ignore-case))
327 (s--truthy? (string-match-p (regexp-quote needle) s))))
328
329(defun s-equals? (s1 s2)
330 "Is S1 equal to S2?
331
332This is a simple wrapper around the built-in `string-equal'."
333 (declare (pure t) (side-effect-free t))
334 (string-equal s1 s2))
335
336(defun s-less? (s1 s2)
337 "Is S1 less than S2?
338
339This is a simple wrapper around the built-in `string-lessp'."
340 (declare (pure t) (side-effect-free t))
341 (string-lessp s1 s2))
342
343(defun s-matches? (regexp s &optional start)
344 "Does REGEXP match S?
345If START is non-nil the search starts at that index.
346
347This is a simple wrapper around the built-in `string-match-p'."
348 (declare (side-effect-free t))
349 (s--truthy? (string-match-p regexp s start)))
350
351(defun s-blank? (s)
352 "Is S nil or the empty string?"
353 (declare (pure t) (side-effect-free t))
354 (or (null s) (string= "" s)))
355
356(defun s-blank-str? (s)
357 "Is S nil or the empty string or string only contains whitespace?"
358 (declare (pure t) (side-effect-free t))
359 (or (s-blank? s) (s-blank? (s-trim s))))
360
361(defun s-present? (s)
362 "Is S anything but nil or the empty string?"
363 (declare (pure t) (side-effect-free t))
364 (not (s-blank? s)))
365
366(defun s-presence (s)
367 "Return S if it's `s-present?', otherwise return nil."
368 (declare (pure t) (side-effect-free t))
369 (and (s-present? s) s))
370
371(defun s-lowercase? (s)
372 "Are all the letters in S in lower case?"
373 (declare (side-effect-free t))
374 (let ((case-fold-search nil))
375 (not (string-match-p "[[:upper:]]" s))))
376
377(defun s-uppercase? (s)
378 "Are all the letters in S in upper case?"
379 (declare (side-effect-free t))
380 (let ((case-fold-search nil))
381 (not (string-match-p "[[:lower:]]" s))))
382
383(defun s-mixedcase? (s)
384 "Are there both lower case and upper case letters in S?"
385 (let ((case-fold-search nil))
386 (s--truthy?
387 (and (string-match-p "[[:lower:]]" s)
388 (string-match-p "[[:upper:]]" s)))))
389
390(defun s-capitalized? (s)
391 "In S, is the first letter upper case, and all other letters lower case?"
392 (declare (side-effect-free t))
393 (let ((case-fold-search nil))
394 (s--truthy?
395 (string-match-p "^[[:upper:]][^[:upper:]]*$" s))))
396
397(defun s-numeric? (s)
398 "Is S a number?"
399 (declare (pure t) (side-effect-free t))
400 (s--truthy?
401 (string-match-p "^[0-9]+$" s)))
402
403(defun s-replace (old new s)
404 "Replaces OLD with NEW in S."
405 (declare (pure t) (side-effect-free t))
406 (replace-regexp-in-string (regexp-quote old) new s t t))
407
408(defalias 's-replace-regexp 'replace-regexp-in-string)
409
410(defun s--aget (alist key)
411 "Get the value of KEY in ALIST."
412 (declare (pure t) (side-effect-free t))
413 (cdr (assoc-string key alist)))
414
415(defun s-replace-all (replacements s)
416 "REPLACEMENTS is a list of cons-cells. Each `car` is replaced with `cdr` in S."
417 (declare (pure t) (side-effect-free t))
418 (let ((case-fold-search nil))
419 (replace-regexp-in-string (regexp-opt (mapcar 'car replacements))
420 (lambda (it) (s--aget replacements it))
421 s t t)))
422
423(defun s-downcase (s)
424 "Convert S to lower case.
425
426This is a simple wrapper around the built-in `downcase'."
427 (declare (side-effect-free t))
428 (downcase s))
429
430(defun s-upcase (s)
431 "Convert S to upper case.
432
433This is a simple wrapper around the built-in `upcase'."
434 (declare (side-effect-free t))
435 (upcase s))
436
437(defun s-capitalize (s)
438 "Convert S first word's first character to upper and the rest to lower case."
439 (declare (side-effect-free t))
440 (concat (upcase (substring s 0 1)) (downcase (substring s 1))))
441
442(defun s-titleize (s)
443 "Convert in S each word's first character to upper and the rest to lower case.
444
445This is a simple wrapper around the built-in `capitalize'."
446 (declare (side-effect-free t))
447 (capitalize s))
448
449(defmacro s-with (s form &rest more)
450 "Threads S through the forms. Inserts S as the last item
451in the first form, making a list of it if it is not a list
452already. If there are more forms, inserts the first form as the
453last item in second form, etc."
454 (declare (debug (form &rest [&or (function &rest form) fboundp])))
455 (if (null more)
456 (if (listp form)
457 `(,(car form) ,@(cdr form) ,s)
458 (list form s))
459 `(s-with (s-with ,s ,form) ,@more)))
460
461(put 's-with 'lisp-indent-function 1)
462
463(defun s-index-of (needle s &optional ignore-case)
464 "Returns first index of NEEDLE in S, or nil.
465
466If IGNORE-CASE is non-nil, the comparison is done without paying
467attention to case differences."
468 (declare (pure t) (side-effect-free t))
469 (let ((case-fold-search ignore-case))
470 (string-match-p (regexp-quote needle) s)))
471
472(defun s-reverse (s)
473 "Return the reverse of S."
474 (declare (pure t) (side-effect-free t))
475 (save-match-data
476 (if (multibyte-string-p s)
477 (let ((input (string-to-list s))
478 output)
479 (require 'ucs-normalize)
480 (while input
481 ;; Handle entire grapheme cluster as a single unit
482 (let ((grapheme (list (pop input))))
483 (while (memql (car input) ucs-normalize-combining-chars)
484 (push (pop input) grapheme))
485 (setq output (nconc (nreverse grapheme) output))))
486 (concat output))
487 (concat (nreverse (string-to-list s))))))
488
489(defun s-match-strings-all (regex string)
490 "Return a list of matches for REGEX in STRING.
491
492Each element itself is a list of matches, as per
493`match-string'. Multiple matches at the same position will be
494ignored after the first."
495 (declare (side-effect-free t))
496 (save-match-data
497 (let ((all-strings ())
498 (i 0))
499 (while (and (< i (length string))
500 (string-match regex string i))
501 (setq i (1+ (match-beginning 0)))
502 (let (strings
503 (num-matches (/ (length (match-data)) 2))
504 (match 0))
505 (while (/= match num-matches)
506 (push (match-string match string) strings)
507 (setq match (1+ match)))
508 (push (nreverse strings) all-strings)))
509 (nreverse all-strings))))
510
511(defun s-matched-positions-all (regexp string &optional subexp-depth)
512 "Return a list of matched positions for REGEXP in STRING.
513SUBEXP-DEPTH is 0 by default."
514 (declare (side-effect-free t))
515 (if (null subexp-depth)
516 (setq subexp-depth 0))
517 (save-match-data
518 (let ((pos 0) result)
519 (while (and (string-match regexp string pos)
520 (< pos (length string)))
521 (push (cons (match-beginning subexp-depth) (match-end subexp-depth)) result)
522 (setq pos (match-end 0)))
523 (nreverse result))))
524
525(defun s-match (regexp s &optional start)
526 "When the given expression matches the string, this function returns a list
527of the whole matching string and a string for each matched subexpressions.
528Subexpressions that didn't match are represented by nil elements
529in the list, except that non-matching subexpressions at the end
530of REGEXP might not appear at all in the list. That is, the
531returned list can be shorter than the number of subexpressions in
532REGEXP plus one. If REGEXP did not match the returned value is
533an empty list (nil).
534
535When START is non-nil the search will start at that index."
536 (declare (side-effect-free t))
537 (save-match-data
538 (if (string-match regexp s start)
539 (let ((match-data-list (match-data))
540 result)
541 (while match-data-list
542 (let* ((beg (car match-data-list))
543 (end (cadr match-data-list))
544 (subs (if (and beg end) (substring s beg end) nil)))
545 (setq result (cons subs result))
546 (setq match-data-list
547 (cddr match-data-list))))
548 (nreverse result)))))
549
550(defun s-slice-at (regexp s)
551 "Slices S up at every index matching REGEXP."
552 (declare (side-effect-free t))
553 (if (s-blank? s)
554 (list s)
555 (let (ss)
556 (while (not (s-blank? s))
557 (save-match-data
558 (let ((i (string-match regexp s 1)))
559 (if i
560 (setq ss (cons (substring s 0 i) ss)
561 s (substring s i))
562 (setq ss (cons s ss)
563 s "")))))
564 (nreverse ss))))
565
566(defun s-split-words (s)
567 "Split S into list of words."
568 (declare (side-effect-free t))
569 (s-split
570 "[^[:word:]0-9]+"
571 (let ((case-fold-search nil))
572 (replace-regexp-in-string
573 "\\([[:lower:]]\\)\\([[:upper:]]\\)" "\\1 \\2"
574 (replace-regexp-in-string "\\([[:upper:]]\\)\\([[:upper:]][0-9[:lower:]]\\)" "\\1 \\2" s)))
575 t))
576
577(defun s--mapcar-head (fn-head fn-rest list)
578 "Like MAPCAR, but applies a different function to the first element."
579 (if list
580 (cons (funcall fn-head (car list)) (mapcar fn-rest (cdr list)))))
581
582(defun s-lower-camel-case (s)
583 "Convert S to lowerCamelCase."
584 (declare (side-effect-free t))
585 (s-join "" (s--mapcar-head 'downcase 'capitalize (s-split-words s))))
586
587(defun s-upper-camel-case (s)
588 "Convert S to UpperCamelCase."
589 (declare (side-effect-free t))
590 (s-join "" (mapcar 'capitalize (s-split-words s))))
591
592(defun s-snake-case (s)
593 "Convert S to snake_case."
594 (declare (side-effect-free t))
595 (s-join "_" (mapcar 'downcase (s-split-words s))))
596
597(defun s-dashed-words (s)
598 "Convert S to dashed-words."
599 (declare (side-effect-free t))
600 (s-join "-" (mapcar 'downcase (s-split-words s))))
601
602(defun s-spaced-words (s)
603 "Convert S to spaced words."
604 (declare (side-effect-free t))
605 (s-join " " (s-split-words s)))
606
607(defun s-capitalized-words (s)
608 "Convert S to Capitalized words."
609 (declare (side-effect-free t))
610 (let ((words (s-split-words s)))
611 (s-join " " (cons (capitalize (car words)) (mapcar 'downcase (cdr words))))))
612
613(defun s-titleized-words (s)
614 "Convert S to Titleized Words."
615 (declare (side-effect-free t))
616 (s-join " " (mapcar 's-titleize (s-split-words s))))
617
618(defun s-word-initials (s)
619 "Convert S to its initials."
620 (declare (side-effect-free t))
621 (s-join "" (mapcar (lambda (ss) (substring ss 0 1))
622 (s-split-words s))))
623
624;; Errors for s-format
625(progn
626 (put 's-format-resolve
627 'error-conditions
628 '(error s-format s-format-resolve))
629 (put 's-format-resolve
630 'error-message
631 "Cannot resolve a template to values"))
632
633(defun s-format (template replacer &optional extra)
634 "Format TEMPLATE with the function REPLACER.
635
636REPLACER takes an argument of the format variable and optionally
637an extra argument which is the EXTRA value from the call to
638`s-format'.
639
640Several standard `s-format' helper functions are recognized and
641adapted for this:
642
643 (s-format \"${name}\" \\='gethash hash-table)
644 (s-format \"${name}\" \\='aget alist)
645 (s-format \"$0\" \\='elt sequence)
646
647The REPLACER function may be used to do any other kind of
648transformation."
649 (let ((saved-match-data (match-data)))
650 (unwind-protect
651 (replace-regexp-in-string
652 "\\$\\({\\([^}]+\\)}\\|[0-9]+\\)"
653 (lambda (md)
654 (let ((var
655 (let ((m (match-string 2 md)))
656 (if m m
657 (string-to-number (match-string 1 md)))))
658 (replacer-match-data (match-data)))
659 (unwind-protect
660 (let ((v
661 (cond
662 ((eq replacer 'gethash)
663 (funcall replacer var extra))
664 ((eq replacer 'aget)
665 (funcall 's--aget extra var))
666 ((eq replacer 'elt)
667 (funcall replacer extra var))
668 ((eq replacer 'oref)
669 (funcall #'slot-value extra (intern var)))
670 (t
671 (set-match-data saved-match-data)
672 (if extra
673 (funcall replacer var extra)
674 (funcall replacer var))))))
675 (if v (format "%s" v) (signal 's-format-resolve md)))
676 (set-match-data replacer-match-data))))
677 template
678 ;; Need literal to make sure it works
679 t t)
680 (set-match-data saved-match-data))))
681
682(defvar s-lex-value-as-lisp nil
683 "If `t' interpolate lisp values as lisp.
684
685`s-lex-format' inserts values with (format \"%S\").")
686
687(defun s-lex-fmt|expand (fmt)
688 "Expand FMT into lisp."
689 (declare (side-effect-free t))
690 (list 's-format fmt (quote 'aget)
691 (append '(list)
692 (mapcar
693 (lambda (matches)
694 (list
695 'cons
696 (cadr matches)
697 `(format
698 (if s-lex-value-as-lisp "%S" "%s")
699 ,(intern (cadr matches)))))
700 (s-match-strings-all "${\\([^}]+\\)}" fmt)))))
701
702(defmacro s-lex-format (format-str)
703 "`s-format` with the current environment.
704
705FORMAT-STR may use the `s-format' variable reference to refer to
706any variable:
707
708 (let ((x 1))
709 (s-lex-format \"x is: ${x}\"))
710
711The values of the variables are interpolated with \"%s\" unless
712the variable `s-lex-value-as-lisp' is `t' and then they are
713interpolated with \"%S\"."
714 (declare (debug (form)))
715 (s-lex-fmt|expand format-str))
716
717(defun s-count-matches (regexp s &optional start end)
718 "Count occurrences of `regexp' in `s'.
719
720`start', inclusive, and `end', exclusive, delimit the part of `s' to
721match. `start' and `end' are both indexed starting at 1; the initial
722character in `s' is index 1.
723
724This function starts looking for the next match from the end of the
725previous match. Hence, it ignores matches that overlap a previously
726found match. To count overlapping matches, use
727`s-count-matches-all'."
728 (declare (side-effect-free t))
729 (save-match-data
730 (with-temp-buffer
731 (insert s)
732 (goto-char (point-min))
733 (count-matches regexp (or start 1) (or end (point-max))))))
734
735(defun s-count-matches-all (regexp s &optional start end)
736 "Count occurrences of `regexp' in `s'.
737
738`start', inclusive, and `end', exclusive, delimit the part of `s' to
739match. `start' and `end' are both indexed starting at 1; the initial
740character in `s' is index 1.
741
742This function starts looking for the next match from the second
743character of the previous match. Hence, it counts matches that
744overlap a previously found match. To ignore matches that overlap a
745previously found match, use `s-count-matches'."
746 (declare (side-effect-free t))
747 (let* ((anchored-regexp (format "^%s" regexp))
748 (match-count 0)
749 (i 0)
750 (narrowed-s (substring s (if start (1- start) 0)
751 (when end (1- end)))))
752 (save-match-data
753 (while (< i (length narrowed-s))
754 (when (s-matches? anchored-regexp (substring narrowed-s i))
755 (setq match-count (1+ match-count)))
756 (setq i (1+ i))))
757 match-count))
758
759(defun s-wrap (s prefix &optional suffix)
760 "Wrap string S with PREFIX and optionally SUFFIX.
761
762Return string S with PREFIX prepended. If SUFFIX is present, it
763is appended, otherwise PREFIX is used as both prefix and
764suffix."
765 (declare (pure t) (side-effect-free t))
766 (concat prefix s (or suffix prefix)))
767
768\f
769;;; Aliases
770
771(defalias 's-blank-p 's-blank?)
772(defalias 's-blank-str-p 's-blank-str?)
773(defalias 's-capitalized-p 's-capitalized?)
774(defalias 's-contains-p 's-contains?)
775(defalias 's-ends-with-p 's-ends-with?)
776(defalias 's-equals-p 's-equals?)
777(defalias 's-less-p 's-less?)
778(defalias 's-lowercase-p 's-lowercase?)
779(defalias 's-matches-p 's-matches?)
780(defalias 's-mixedcase-p 's-mixedcase?)
781(defalias 's-numeric-p 's-numeric?)
782(defalias 's-prefix-p 's-starts-with?)
783(defalias 's-prefix? 's-starts-with?)
784(defalias 's-present-p 's-present?)
785(defalias 's-starts-with-p 's-starts-with?)
786(defalias 's-suffix-p 's-ends-with?)
787(defalias 's-suffix? 's-ends-with?)
788(defalias 's-uppercase-p 's-uppercase?)
789
790\f
791(provide 's)
792;;; s.el ends here