application/octet-stream
•
9.09 KB
•
229 lines
;;; Nujel - Copyright (C) 2020-2021 - Benjamin Vincent Schulenburg
;;; This project uses the MIT license, a copy should be included under /LICENSE
;;;
;;; Various functions dealing with strings of all sorts
[defn println [str]
"Print STR on a single line"
[print [cat str "\r\n"]]]
[defn errorln [str]
"Print to stderr STR on a single line"
[error [cat str "\r\n"]]]
[defn br [num]
"Return NUM=1 linebreaks"
[if [or [nil? num] [<= [int num] 1]]
"\n"
[cat "\n" [br [+ -1 num]]]]]
[defn pad-start [text pad-length padding]
"Pad a string to a certain length by prepending another string."
""
"This function will, if necessary, prepend padding on to the beginning of"
"text repeatedly until the desired pad-length is reached."
""
"Because of this the string in padding can be truncated if the amount of"
"characters that need to be added can't be evenly divided through the length of padding."
""
"This means that you have to be careful not to use unicode characters as a padding, or make sure that it can be used without truncation."
""
"text: The input string"
"pad-length: The minimum length of the result"
"padding: A string that will be used to pad text, defaults to a single space"
""
"Returns the padded string"
:cat :string
:related pad-middle
:related pad-end
[deftest " 123" [pad-start "123" 6]]
[deftest "000123" [pad-start 123 6 "0"]]
[deftest "-.-123" [pad-start '123 6 ".-"]]
[when-not padding [set! padding " "]]
[when-not [string? text] [set! text [string text]]]
[when-not [string? padding]
[throw [list :type-error "pad-start needs char as a string, so that one can pad with multiple characters" padding [current-lambda]]]]
[while [< [buffer/length text] pad-length]
[set! text [cat padding text]]]
[if [> [buffer/length text] pad-length]
[string/cut text [- [buffer/length text] pad-length] [buffer/length text]]
text]]
[defn pad-end [text pad-length char]
"Pad a string to a certain length by appending another string."
""
"This function will, if necessary, append padding on to the end of"
"text repeatedly until the desired pad-length is reached."
""
"Because of this the string in padding can be truncated if the amount of"
"characters that need to be added can't be evenly divided through the length of padding."
""
"This means that you have to be careful not to use unicode characters as a padding, or make sure that it can be used without truncation."
""
"text: The input string"
"pad-length: The minimum length of the result"
"padding: A string that will be used to pad text, defaults to a single space"
""
"Returns the padded string"
:cat :string
:related pad-middle
:related pad-start
[deftest "123 " [pad-end "123" 6]]
[deftest "123000" [pad-end 123 6 "0"]]
[deftest "123.-." [pad-end '123 6 ".-"]]
[when-not char [set! char " "]]
[when-not [string? text] [set! text [string text]]]
[when-not [string? char]
[throw [list :type-error "pad-end needs char as a string, so that one can pad with multiple characters" char [current-lambda]]]]
[while [< [buffer/length text] pad-length]
[set! text [cat text char]]]
[if [> [buffer/length text] pad-length]
[string/cut text 0 pad-length]
text]]
[defn pad-middle [text pad-length char]
"Pad a string to a certain length by surrounding it with another string."
""
"This function will, if necessary, append and prepend padding to the"
"beginning and end of text repeatedly until the desired pad-length is reached."
""
"Because of this the string in padding can be truncated if the amount of"
"characters that need to be added can't be evenly divided through the length of padding."
""
"This means that you have to be careful not to use unicode characters as a padding, or make sure that it can be used without truncation."
""
"text: The input string"
"pad-length: The minimum length of the result"
"padding: A string that will be used to pad text, defaults to a single space"
""
"Returns the padded string"
:cat :string
:related pad-start
:related pad-end
[deftest " 123 " [pad-middle "123" 6]]
[deftest "012300" [pad-middle 123 6 "0"]]
[deftest "-123.-" [pad-middle '123 6 ".-"]]
[when-not char [set! char " "]]
[when-not [string? text] [set! text [string text]]]
[when-not [string? char]
[throw [list :type-error "string/pad-middle needs char as a string, so that one can pad with multiple characters" char [current-lambda]]]]
[while [< [buffer/length text] pad-length]
[set! text [cat char text char]]]
[if [> [buffer/length text] pad-length]
[let [[end-overflow [div/int [- [buffer/length text] pad-length] 2]]
[start-overflow [- [- [buffer/length text] pad-length] end-overflow]]]
[string/cut text start-overflow [+ start-overflow pad-length]]]
text]]
[defn string/round [text decimal-digits]
"Round the floating point representation in TEXT to have at most DECIMAL-DIGITS after the period"
[def pos [last-index-of text "."]]
[if [>= pos 0]
[string/cut text 0 [+ pos 1 decimal-digits]]
text]]
[def split [let*
[defn split/empty [str separator]
[def slen [buffer/length str]]
[def start 0]
[def ret #nil]
[while [< start slen]
[set! ret [cons [string/cut str start [+ 1 start]] ret]]
[inc! start]]
[reverse ret]]
[defn split/string [str separator start]
[when-not start [set! start 0]]
[def pos-found [index-of str separator start]]
[if [>= pos-found 0]
[cons [string/cut str start pos-found]
[split/string str separator [+ pos-found [buffer/length separator]]]]
[cons [string/cut str start [buffer/length str]]
#nil]]]
[defn split [str separator]
"Splits STR into a list at every occurunse of SEPARATOR"
[typecheck/only str :string]
[typecheck/only separator :string]
[case [buffer/length separator]
[0 [split/empty str]]
[otherwise [split/string str separator 0]]]]]]
[defn read/single [text]
"Uses the reader and returns the first single value read from string TEXT"
[typecheck/only text :string]
[car [read text]]]
[defn read/int [text]
"Reads the first string from TEXT"
[int [read/single text]]]
[defn read/float [text]
"Reads the first float from TEXT"
[float [read/single text]]]
[defn buffer/length?! [chars]
[fn [a] [= chars [buffer/length a]]]]
[defn from-char-code l
"Turn the provided char codes into a string and return it"
[def buf [buffer/allocate [list/length l]]]
[dotimes [i [buffer/length buf] [buffer->string buf]]
[when [or [not [int? [car l]]]
[> [car l] 255]
[< [car l] 0]]
[exception :type-error "[from-char-code] expects :int arguments from 0 to 255, not: " [car l]]]
[buffer/set! buf i [car l]]
[cdr! l]]]
[defn char/whitespace? [c]
"Return #t if C is a whitespace char"
:inline
[<= c 33]]
[defn trim [s]
"Trim all whitespace off the beginning and end of S"
[def start 0]
[def end [buffer/length s]]
[while [and [< start end] [char/whitespace? [buffer/ref s start]]] [set! start [+ start 1]]]
[while [and [> end 0] [char/whitespace? [buffer/ref s [- end 1]]]] [set! end [- end 1]]]
[string/cut s start end]]
[defn lowercase/char [c]
[if [< c 65]
c
[if [> c 90]
c
[+ c 32]]]]
[defn uppercase/char [c]
[if [< c 97]
c
[if [> c 122]
c
[+ c -32]]]]
[defn uppercase [s]
"Uppercase a string S"
[def ret [buffer/allocate [buffer/length s]]]
[dotimes [i [buffer/length s] [buffer->string ret]]
[buffer/set! ret i [uppercase/char [buffer/ref s i]]]]]
[defn lowercase [s]
"Lowercase a string S"
[def ret [buffer/allocate [buffer/length s]]]
[dotimes [i [buffer/length s] [buffer->string ret]]
[buffer/set! ret i [lowercase/char [buffer/ref s i]]]]]
[defn capitalize [s]
"Capitalize a string S"
[def ret [buffer/allocate [buffer/length s]]]
[def caps? #t]
[dotimes [i [buffer/length s] [buffer->string ret]]
[buffer/set! ret i [[if caps? uppercase/char lowercase/char] [buffer/ref s i]]]
[set! caps? [if [char/whitespace? [buffer/ref s i]] #t #f]]]]
