.emacs.d.git - Gitblit

Chizi123

2018-11-18 21067e7cbe6d7a0f65ff5c317a96b5c337b0b3d8

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