summaryrefslogtreecommitdiff
path: root/src/strings.lisp
diff options
context:
space:
mode:
Diffstat (limited to 'src/strings.lisp')
-rw-r--r--src/strings.lisp55
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
18OUT 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
27OUT 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 "&lt;" out)) 30 (#\< (write-string "&lt;" 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))))