mirror of https://github.com/Chizi123/.emacs.d.git

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