Initial commit

1 files changed, 59 insertions, 0 deletions

diff --git a/src/strings.lisp b/src/strings.lisp
new file mode 100644
index 0000000..68289aa
--- /dev/null
+++ b/src/strings.lisp
@@ -0,0 +1,59 @@
+;; SPDX-License-Identifier: EUPL-1.2
+;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com>
+(defpackage :ukkoclot/strings
+  (:use :c2cl :iterate)
+  (:import-from :cl-unicode :general-category)
+  (:export :escape-xml :is-tg-whitespace-str :lisp->snake-case :snake->lisp-case :starts-with :starts-with-ignore-case))
+(in-package :ukkoclot/strings)
+
+;; These are very inefficient but I don't care until I profile
+
+(defun escape-xml (str &optional out)
+  (if out
+      (escape-xml% str out)
+      (with-output-to-string (out)
+        (escape-xml% str out))))
+
+(defun escape-xml% (str out)
+  (loop for ch across str do
+    (case ch
+      (#\< (write-string "&lt;" out))
+      (#\> (write-string "&gt;" out))
+      (#\& (write-string "&amp;" out))
+      (#\" (write-string "&quot;" out))
+      (t (write-char ch out)))))
+
+(defun is-tg-whitespace (ch)
+  (let ((gc (general-category ch)))
+    (or (string= gc "Zs")               ; Separator, space
+        (string= gc "Zl")               ; Separator, line
+        (string= gc "Zp")               ; Separator, paragraph
+        (string= gc "Cc")               ; Other, control
+        (= (char-code ch) #x2800)     ; BRAILLE PATTERN BLANK
+        )))
+
+(defun is-tg-whitespace-str (str)
+  (iter (for ch in-string str)
+    (always (is-tg-whitespace ch))))
+
+(defun lisp->snake-case (str)
+  (with-output-to-string (out)
+    (loop for ch across str do
+      (case ch
+        (#\- (write-char #\_ out))
+        (t (write-char ch out))))))
+
+(defun snake->lisp-case (str)
+  (with-output-to-string (out)
+    (loop for ch across str do
+      (case ch
+        (#\_ (write-char #\- out))
+        (t (write-char ch out))))))
+
+(defun starts-with (str prefix)
+  (and (> (length str) (length prefix))
+       (string= str prefix :end1 (length prefix))))
+
+(defun starts-with-ignore-case (str prefix)
+  (and (> (length str) (length prefix))
+       (string-equal str prefix :end1 (length prefix))))