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