forked from rebol/rebol
-
Notifications
You must be signed in to change notification settings - Fork 2
Reword
angerangel edited this page Mar 19, 2013
·
1 revision
REWORD source values /case /only /escape char /into output
Make a string or binary based on a template and substitution values.
REWORD is a function value.
- source -- Template series with escape sequences (any-string! binary!)
- values -- Keyword literals and value expressions (map! object! block!)
- /case -- Characters are case-sensitive
- /only -- Use values as-is, do not reduce the block, insert block values
-
/escape -- Choose your own escape char(s) or [begin end] delimiters
- char -- Default "$" (char! any-string! binary! block! none!)
-
/into -- Insert into a buffer instead (returns position after insert)
- output -- The buffer series (modified) (any-string! binary!)
#SOURCE
reword: make function! [ [
{Make a string or binary based on a template and substitution values.}
source [any-string! binary!] "Template series with escape sequences"
values [map! object! block!] "Keyword literals and value expressions"
/case "Characters are case-sensitive"
/only {Use values as-is, do not reduce the block, insert block values}
/escape {Choose your own escape char(s) or [begin end] delimiters}
char [char! any-string! binary! block! none!] {Default "$"}
/into {Insert into a buffer instead (returns position after insert)}
output [any-string! binary!] "The buffer series (modified)"
/local char-end vals word wtype cword out fout rule a b w v
][
assert/type [local none!]
unless into [output: make source length? source]
wtype: lib/case [case binary! tag? source string! 'else type? source]
lib/case/all [
not escape [char: "$"]
block? char [
rule: [char! | any-string! | binary!]
unless parse c: char [set char rule set char-end opt rule] [
cause-error 'script 'invalid-arg reduce [c]
]
]
char? char [char: to wtype char]
char? char-end [char-end: to wtype char-end]
]
lib/case [
all [
map? values
empty? char-end
foreach [w v] values [
if any [unset? :v wtype <> type? :w] [break/return false]
true
]
] [vals: values]
all [
vals: make map! length? values
not only block? values
] [
while [not tail? values] [
w: first+ values
set/any 'v do/next values 'values
if any [set-word? :w lit-word? :w] [w: to word! :w]
lib/case [
wtype = type? :w none
wtype <> binary! [w: to wtype :w]
any-string? :w [w: to binary! :w]
'else [w: to binary! to string! :w]
]
unless empty? w [
unless empty? char-end [w: append copy w char-end]
poke vals w unless unset? :v [:v]
]
]
]
'else [
foreach [w v] values [
if any [set-word? :w lit-word? :w] [w: to word! :w]
lib/case [
wtype = type? :w none
wtype <> binary! [w: to wtype :w]
any-string? :w [w: to binary! :w]
'else [w: to binary! to string! :w]
]
unless empty? w [
unless empty? char-end [w: append copy w char-end]
poke vals w unless unset? :v [:v]
]
]
]
]
word: make block! 2 * length? vals
foreach w vals [word: reduce/into [w '|] word]
word: head remove back word
cword: pick [(w: to wtype w)] wtype <> type? source
set/any [out: fout:] pick [
[
(output: insert output to string! copy/part a b)
(output: insert output to string! a)
] [
(output: insert/part output a b)
(output: insert output a)
]
] or~ tag? source and~ binary? source not binary? output
escape: [
copy w word cword out (
output: insert output lib/case [
block? v: select vals w [either only [v] :v]
any-function? :v [apply :v [:b] ]
'else :v
]
) a:
]
rule: either empty? char [
[a: any [to word b: [escape | skip] ] to end fout]
] [
if wtype <> type? char [char: to wtype char]
[a: any [to char b: char [escape | none] ] to end fout]
]
either case [parse/case source rule] [parse source rule]
either into [output] [head output]
] ]