diff options
Diffstat (limited to 'src/strings.lisp')
| -rw-r--r-- | src/strings.lisp | 55 |
1 files changed, 10 insertions, 45 deletions
diff --git a/src/strings.lisp b/src/strings.lisp index b1b4f00..eae8ec0 100644 --- a/src/strings.lisp +++ b/src/strings.lisp | |||
| @@ -1,33 +1,30 @@ | |||
| 1 | ;; SPDX-License-Identifier: EUPL-1.2 | 1 | ;; SPDX-License-Identifier: EUPL-1.2 |
| 2 | ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com> | 2 | ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com> |
| 3 | (defpackage :ukkoclot/strings | 3 | (defpackage :ukkoclot/strings |
| 4 | (:documentation "String-oriented utilities.") | ||
| 4 | (:use :c2cl :iterate) | 5 | (:use :c2cl :iterate) |
| 5 | (:import-from :cl-unicode :general-category) | 6 | (:import-from :cl-unicode :general-category) |
| 6 | (:export | 7 | (:export |
| 7 | :ends-with | ||
| 8 | :escape-xml | 8 | :escape-xml |
| 9 | :is-tg-whitespace | 9 | :is-tg-whitespace |
| 10 | :is-tg-whitespace-str | 10 | :is-tg-whitespace-str)) |
| 11 | :lisp->camel-case | ||
| 12 | :lisp->snake-case | ||
| 13 | :snake->lisp-case | ||
| 14 | :starts-with | ||
| 15 | :starts-with-ignore-case)) | ||
| 16 | (in-package :ukkoclot/strings) | 11 | (in-package :ukkoclot/strings) |
| 17 | 12 | ||
| 18 | ;; These are very inefficient but I don't care until I profile | 13 | ;; These are very inefficient but I don't care until I profile |
| 19 | 14 | ||
| 20 | (defun ends-with (str suffix) | ||
| 21 | (and (> (length str) (length suffix)) | ||
| 22 | (string= str suffix :start1 (- (length str) (length suffix))))) | ||
| 23 | |||
| 24 | (defun escape-xml (str &optional out) | 15 | (defun escape-xml (str &optional out) |
| 16 | "Escape special XML characters in the STR. | ||
| 17 | |||
| 18 | OUT is the output stream or `nil' for outputting to a string." | ||
| 25 | (if out | 19 | (if out |
| 26 | (escape-xml% str out) | 20 | (escape-xml% str out) |
| 27 | (with-output-to-string (out) | 21 | (with-output-to-string (out) |
| 28 | (escape-xml% str out)))) | 22 | (escape-xml% str out)))) |
| 29 | 23 | ||
| 30 | (defun escape-xml% (str out) | 24 | (defun escape-xml% (str out) |
| 25 | "See `escape-xml'. | ||
| 26 | |||
| 27 | OUT is always the stream." | ||
| 31 | (loop for ch across str do | 28 | (loop for ch across str do |
| 32 | (case ch | 29 | (case ch |
| 33 | (#\< (write-string "<" out)) | 30 | (#\< (write-string "<" out)) |
| @@ -37,6 +34,7 @@ | |||
| 37 | (otherwise (write-char ch out))))) | 34 | (otherwise (write-char ch out))))) |
| 38 | 35 | ||
| 39 | (defun is-tg-whitespace (ch) | 36 | (defun is-tg-whitespace (ch) |
| 37 | "Checks if CH on its own would be considered whitespace by telegram." | ||
| 40 | (let ((gc (general-category ch))) | 38 | (let ((gc (general-category ch))) |
| 41 | (or (string= gc "Zs") ; Separator, space | 39 | (or (string= gc "Zs") ; Separator, space |
| 42 | (string= gc "Zl") ; Separator, line | 40 | (string= gc "Zl") ; Separator, line |
| @@ -45,39 +43,6 @@ | |||
| 45 | (= (char-code ch) #x2800)))) ; BRAILLE PATTERN BLANK | 43 | (= (char-code ch) #x2800)))) ; BRAILLE PATTERN BLANK |
| 46 | 44 | ||
| 47 | (defun is-tg-whitespace-str (str) | 45 | (defun is-tg-whitespace-str (str) |
| 46 | "Checks if message containing just STR would be considered whitespace by telegram." | ||
| 48 | (iter (for ch in-string str) | 47 | (iter (for ch in-string str) |
| 49 | (always (is-tg-whitespace ch)))) | 48 | (always (is-tg-whitespace ch)))) |
| 50 | |||
| 51 | (defun lisp->camel-case (str) | ||
| 52 | (with-output-to-string (out) | ||
| 53 | (let ((should-caps nil)) | ||
| 54 | (iter (for ch in-string str) | ||
| 55 | (cond ((char= ch #\-) | ||
| 56 | (setf should-caps t)) | ||
| 57 | (should-caps | ||
| 58 | (write-char (char-upcase ch) out) | ||
| 59 | (setf should-caps nil)) | ||
| 60 | (t | ||
| 61 | (write-char (char-downcase ch) out))))))) | ||
| 62 | |||
| 63 | (defun lisp->snake-case (str) | ||
| 64 | (with-output-to-string (out) | ||
| 65 | (loop for ch across str do | ||
| 66 | (case ch | ||
| 67 | (#\- (write-char #\_ out)) | ||
| 68 | (otherwise (write-char ch out)))))) | ||
| 69 | |||
| 70 | (defun snake->lisp-case (str) | ||
| 71 | (with-output-to-string (out) | ||
| 72 | (loop for ch across str do | ||
| 73 | (case ch | ||
| 74 | (#\_ (write-char #\- out)) | ||
| 75 | (otherwise (write-char ch out)))))) | ||
| 76 | |||
| 77 | (defun starts-with (str prefix) | ||
| 78 | (and (> (length str) (length prefix)) | ||
| 79 | (string= str prefix :end1 (length prefix)))) | ||
| 80 | |||
| 81 | (defun starts-with-ignore-case (str prefix) | ||
| 82 | (and (> (length str) (length prefix)) | ||
| 83 | (string-equal str prefix :end1 (length prefix)))) | ||