s.el (26066B)
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 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 791 (provide 's) 792 ;;; s.el ends here