summaryrefslogtreecommitdiff
path: root/src/strings.lisp
diff options
context:
space:
mode:
Diffstat (limited to 'src/strings.lisp')
-rw-r--r--src/strings.lisp36
1 files changed, 16 insertions, 20 deletions
diff --git a/src/strings.lisp b/src/strings.lisp
index 04a20de..ab9f13c 100644
--- a/src/strings.lisp
+++ b/src/strings.lisp
@@ -4,6 +4,8 @@
4 (:documentation "String-oriented utilities.") 4 (:documentation "String-oriented utilities.")
5 (:use :c2cl :iterate) 5 (:use :c2cl :iterate)
6 (:import-from :cl-unicode :general-category) 6 (:import-from :cl-unicode :general-category)
7 (:import-from :serapeum :->)
8 (:import-from :ukkoclot/src/streams :with-format-like-stream)
7 (:export 9 (:export
8 :escape-xml 10 :escape-xml
9 :is-tg-whitespace 11 :is-tg-whitespace
@@ -12,27 +14,20 @@
12 14
13;; These are very inefficient but I don't care until I profile 15;; These are very inefficient but I don't care until I profile
14 16
15(defun escape-xml (str &optional out) 17(-> escape-xml (string &optional (or stream boolean)) (or string null))
16 "Escape special XML characters in the STR. 18(defun escape-xml (str &optional out-spec)
17 19 "Escape special XML characters in the STR."
18OUT is the output stream or `nil' for outputting to a string." 20 (with-format-like-stream (out out-spec)
19 (if out 21 (iter
20 (escape-xml% str out) 22 (for ch in-string str)
21 (with-output-to-string (out) 23 (case ch
22 (escape-xml% str out)))) 24 (#\< (write-string "&lt;" out))
23 25 (#\> (write-string "&gt;" out))
24(defun escape-xml% (str out) 26 (#\& (write-string "&amp;" out))
25 "See `escape-xml'. 27 (#\" (write-string "&quot;" out))
26 28 (otherwise (write-char ch out))))))
27OUT is always the stream."
28 (loop for ch across str do
29 (case ch
30 (#\< (write-string "&lt;" out))
31 (#\> (write-string "&gt;" out))
32 (#\& (write-string "&amp;" out))
33 (#\" (write-string "&quot;" out))
34 (otherwise (write-char ch out)))))
35 29
30(-> is-tg-whitespace (character) boolean)
36(defun is-tg-whitespace (ch) 31(defun is-tg-whitespace (ch)
37 "Checks if CH on its own would be considered whitespace by telegram." 32 "Checks if CH on its own would be considered whitespace by telegram."
38 (let ((gc (general-category ch))) 33 (let ((gc (general-category ch)))
@@ -42,6 +37,7 @@ OUT is always the stream."
42 (string= gc "Cc") ; Other, control 37 (string= gc "Cc") ; Other, control
43 (= (char-code ch) #x2800)))) ; BRAILLE PATTERN BLANK 38 (= (char-code ch) #x2800)))) ; BRAILLE PATTERN BLANK
44 39
40(-> is-tg-whitespace-str (string) boolean)
45(defun is-tg-whitespace-str (str) 41(defun is-tg-whitespace-str (str)
46 "Checks if message containing just STR would be considered whitespace by telegram." 42 "Checks if message containing just STR would be considered whitespace by telegram."
47 (iter (for ch in-string str) 43 (iter (for ch in-string str)