config

Personal configuration.
git clone git://code.dwrz.net/config
Log | Files | Refs

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