]>
Commit | Line | Data |
---|---|---|
53e6db90 DC |
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. | |
63 | BOL 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. | |
71 | If OMIT-NULLS is non-nil, zero-length substrings are omitted. | |
72 | ||
73 | This 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 | ||
81 | If OMIT-NULLS is non-nil, zero-length substrings are omitted. | |
82 | ||
83 | See 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. | |
132 | 0 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 | ||
219 | The resulting string, including ellipsis, will be LEN characters | |
220 | long. | |
221 | ||
222 | When 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 | ||
295 | If IGNORE-CASE is non-nil, the comparison is done without paying | |
296 | attention to case differences. | |
297 | ||
298 | Alias: `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 | ||
308 | If IGNORE-CASE is non-nil, the comparison is done without paying | |
309 | attention to case differences. | |
310 | ||
311 | Alias: `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 | ||
323 | If IGNORE-CASE is non-nil, the comparison is done without paying | |
324 | attention 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 | ||
332 | This 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 | ||
339 | This 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? | |
345 | If START is non-nil the search starts at that index. | |
346 | ||
347 | This 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 | ||
426 | This 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 | ||
433 | This 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 | ||
445 | This 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 | |
451 | in the first form, making a list of it if it is not a list | |
452 | already. If there are more forms, inserts the first form as the | |
453 | last 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 | ||
466 | If IGNORE-CASE is non-nil, the comparison is done without paying | |
467 | attention 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 | ||
492 | Each element itself is a list of matches, as per | |
493 | `match-string'. Multiple matches at the same position will be | |
494 | ignored 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. | |
513 | SUBEXP-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 | |
527 | of the whole matching string and a string for each matched subexpressions. | |
528 | Subexpressions that didn't match are represented by nil elements | |
529 | in the list, except that non-matching subexpressions at the end | |
530 | of REGEXP might not appear at all in the list. That is, the | |
531 | returned list can be shorter than the number of subexpressions in | |
532 | REGEXP plus one. If REGEXP did not match the returned value is | |
533 | an empty list (nil). | |
534 | ||
535 | When 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 | ||
636 | REPLACER takes an argument of the format variable and optionally | |
637 | an extra argument which is the EXTRA value from the call to | |
638 | `s-format'. | |
639 | ||
640 | Several standard `s-format' helper functions are recognized and | |
641 | adapted for this: | |
642 | ||
643 | (s-format \"${name}\" \\='gethash hash-table) | |
644 | (s-format \"${name}\" \\='aget alist) | |
645 | (s-format \"$0\" \\='elt sequence) | |
646 | ||
647 | The REPLACER function may be used to do any other kind of | |
648 | transformation." | |
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 | ||
705 | FORMAT-STR may use the `s-format' variable reference to refer to | |
706 | any variable: | |
707 | ||
708 | (let ((x 1)) | |
709 | (s-lex-format \"x is: ${x}\")) | |
710 | ||
711 | The values of the variables are interpolated with \"%s\" unless | |
712 | the variable `s-lex-value-as-lisp' is `t' and then they are | |
713 | interpolated 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 | |
721 | match. `start' and `end' are both indexed starting at 1; the initial | |
722 | character in `s' is index 1. | |
723 | ||
724 | This function starts looking for the next match from the end of the | |
725 | previous match. Hence, it ignores matches that overlap a previously | |
726 | found 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 | |
739 | match. `start' and `end' are both indexed starting at 1; the initial | |
740 | character in `s' is index 1. | |
741 | ||
742 | This function starts looking for the next match from the second | |
743 | character of the previous match. Hence, it counts matches that | |
744 | overlap a previously found match. To ignore matches that overlap a | |
745 | previously 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 | ||
762 | Return string S with PREFIX prepended. If SUFFIX is present, it | |
763 | is appended, otherwise PREFIX is used as both prefix and | |
764 | suffix." | |
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 |