diff options
Diffstat (limited to 'src/strings.lisp')
| -rw-r--r-- | src/strings.lisp | 36 |
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." | |
| 18 | OUT 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 "<" out)) |
| 23 | 25 | (#\> (write-string ">" out)) | |
| 24 | (defun escape-xml% (str out) | 26 | (#\& (write-string "&" out)) |
| 25 | "See `escape-xml'. | 27 | (#\" (write-string """ out)) |
| 26 | 28 | (otherwise (write-char ch out)))))) | |
| 27 | OUT is always the stream." | ||
| 28 | (loop for ch across str do | ||
| 29 | (case ch | ||
| 30 | (#\< (write-string "<" out)) | ||
| 31 | (#\> (write-string ">" out)) | ||
| 32 | (#\& (write-string "&" out)) | ||
| 33 | (#\" (write-string """ 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) |