/usr/share/common-lisp/source/metatilities-base/dev/l0-strings.lisp is in cl-metatilities-base 20120909-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 | (in-package #:metatilities)
;;; whitespace-p
(defparameter +whitespace-characters+
(list #\Space #\Newline #\Tab #\Page #\Null #\Linefeed #\Return)
"A list of characters that should be treated as whitespace. See,
for example, [whitespacep][].")
(defun whitespacep (char)
"Returns true if `char` is an element of [+whitespace-characters+][]
and nil otherwise."
(not (null (find char +whitespace-characters+ :test #'char=))))
(defun string-starts-with (string prefix &key test)
"Returns true if `string` starts with `prefix`.
Use the keyword argument `test` (which defaults to `char=`) to check
each character."
(setf test (or (and test (ensure-function test)) #'char=))
(let ((mismatch (mismatch prefix string :test test)))
(or (not mismatch) (= mismatch (length prefix)))))
(defun string-ends-with (string suffix &key test)
"Returns true if `string` starts with `prefix`.
Use the keyword argument `test` (which defaults to `eql`) to check
each character."
(setf test (or (and test (ensure-function test)) #'char=))
(let ((mm 0))
(loop for end1 from (1- (length string)) downto 0
for end2 from (1- (length suffix)) downto 0
while (funcall test (aref string end1) (aref suffix end2)) do
(incf mm))
(= mm (length suffix))))
(defun string-trim-if (predicate string &key (start 0) (end (length string)))
(let ((end (1- end)))
(loop for ch across string
while (funcall predicate ch) do (incf start))
(when (< start end)
(loop for ch = (aref string end)
while (funcall predicate ch) do (decf end)))
(subseq string start (1+ end))))
(defun strip-whitespace (string &key (start 0) (end (length string)))
(string-trim-if
#'whitespacep string :start start :end end))
#| OR
(defun string-starts-with (string prefix &key ignore-case-p)
(declare (type string string prefix))
(let ((prelen (length prefix)))
(when (<= prelen (length string))
(if ignore-case-p
(string-equal string prefix :end1 prelen)
(string= string prefix :end1 prelen)))))
;; not cribbed from Wilbur --cas
(defun string-ends-with (string suffix &key ignore-case-p)
(declare (type string string suffix))
(let ((suflen (length suffix))
(strlen (length string)))
(when (< suflen (length string))
(if ignore-case-p
(string-equal string suffix :start1 (- strlen suflen))
(string= string suffix :start1 (- strlen suflen))))))
|#
|