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