"
copy invalid-node inP?
(if invalid-node [replace Dialect bad-node-element ""])
]skip
]
parse Dialect [some[(children: none)to
"
"
copy children to "
validate-or-remove "
")
]skip
]
parse Dialect [some[(children: none)to
""
copy children thru "
"
(end-tag: validate-or-remove end-tag)
]skip
]
parse Dialect [some[(children: none)to
""
copy children [thru "
" | to ]
(end-tag: validate-or-remove end-tag)
]skip
]
parse/all Dialect [some[(children: none)to
""
copy children thru ""
(end-tag: validate-or-remove end-tag)
]skip
]
parse/all Dialect [some[(children: none)to
""
copy children [thru "" | to "" | to ""]
(end-tag: validate-or-remove end-tag)
]skip
]
parse/all Dialect [any[(children: none)
to ""
copy children any ["" | " | "
copy children [thru " | " | [to "" return-parent-width)
]
]skip
]
{
|
[to ""
copy children to " | replace children " "
(this: copy element
foreach [a b][
"?" {" } "-" "_" "=" {="} "&" { " } "+" "_" "%25" "_" ">" {">} {" ">} {">} {""} {"}][replace/all this a b
]
replace Dialect element this)
]skip
]}
recycle/off recycle/on
]
make-face-obj: func [][
self: mold to set-word! to string! reduce [last-node: copy node-name select-this tag-token: to word! node-name]
face-obj: reduce first skip find tag-tokens tag-token 2
slf: to word! first slf: parse self ":"
foreach style-request [font-style? border?][attempt [do style-request]]
]
get-size: func [this.width][in-size: none this.width: form this.width
*y: 20 attempt [*y: face-x/y]
attempt [parent-x: face-x/x]
attempt [parent-y: face-x/y]
hr-x: any [attempt[hr-xy/x]hr-xy]
parse this.width [[(unit-type: "none") to #"%" (unit-type: "%") | to "px" (unit-type: "px") | to "pt" (unit-type: "pt")]to end]
if error? try [to-integer replace this.width unit-type ""][this.width: 0 unit-type: "none"]
switch unit-type [
"%" [replace in-size: parse this.width "%" "" []
if empty? in-size [in-size: to-block mold form length? value=]
either 1 = length? in-size/1 [insert in-size/1 ".0" percent-size: to-decimal load in-size/1][insert in-size/1 "." percent-size: to-decimal load in-size/1]
this.width: as-pair to-integer percent-size * either find/any ["button" "submit"] node-name [
any [parent-x string-size? value=]][any [600 - 10]] *y]
"px" [replace/all in-size: parse this.width "px" "" [] this.width: attempt [to-integer in-size/1]]
"pt" [replace/all in-size: parse this.width "pt" "" [] this.width: attempt [to-integer in-size/1]]
"none" [if in-size: attempt [to-integer this.width] [this.width: in-size]]
]
]
get-attributes: func [element-node][
in-node-element: node-element: element-node
quote-node-attributes
create-tag-element with-these-attributes
markup-hexcolors styles: next node: to-block child: data-node
if all [use-methods not find child "." ][use-attr-as-methods yes]
slf: to-word any [slf* node/1]
bkclr: any [bkclr bkclr: bgcolor= any [select styles 'background-color= "#ffffff"]]
attempt [get-image styles/background-image= imgurl: img-url]
bgclr: bgcolor= any [select styles 'bgcolor= select styles '.bgcolor=]
txt-clr: any [ color= select styles 'text= txt-clr 0.0.0]
clr: color= any [select styles '.color= select styles 'color= ]
value=: form mold any [select styles 'value= ""]
either parent-sz [parent-sz][parent-sz: as-pair 10 / string-size? value= 0]
size=: hr-xy: any [get-size select styles 'size= 99.2]
border=: attempt [styles/border=]
font-size=: any [get-size select styles 'font-size= ]
font-style=: any [select styles 'font-style= ]
either 0 != size= [size= ][size=: none]
valign=: any [select styles 'valign= ""]
width=: any [get-size select styles 'width= 0]
height=: any [get-size select styles 'height= 20]
either not find reduce [width= height=] 0 [face-x: as-pair width= height= ][
either 0 != width= [face-x: width=][face-x: width=: height=: none]]
alt=: any [select styles 'alt= ""]
onclick=: any [attempt [to-word select styles 'onclick= ]]
get-image select styles 'src= styles: head styles
]
set-attributes: does [
either empty? styles [
=: :equal? get-attributes node-element
foreach [attr attrv] next styles [(attempt [do load replace form attr "=" "?"])]
do face-styles show page clear face-styles
][
parse styles [some[ to word! attr: to string! (attempt [do load replace form copy attr "=" "?"])]skip]
]
replace/all face-styles "node-elementjoin" ""
do face-styles show page clear face-styles =: :equal?
]
get-colors: does [
clr: any [clr f_clr i_clr b_clr div_clr p_clr td_clr tr_clr tb_clr li_clr ul_clr txt-clr]
bgclr: any [bgclr f_bgclr i_bgclr b_bgclr div_bgclr p_bgclr td_bgclr tr_bgclr tb_bgclr li_bgclr ul_bgclr bkclr]
]
clear-colors: does [
div_clr: p_clr: tb_clr: tr_clr: td_clr: ul_clr: li_clr: f_clr: b_clr: i_clr: clr: none
div_bgclr: p_bgclr: tb_bgclr: tr_bgclr: td_bgclr: ul_bgclr: li_bgclr: f_bgclr: b_bgclr: i_bgclr: bgclr: none
remove-font remove-style
]
get-input-type: func [in-form-element][
if "button" = node-name [node-name: 'btn]
if "input" = node-name [node-name: first to block! node-type: find/match in-form-element {input type=}]
if "" = node-name [node-name: "input"]
node-name: form any [node-name "input"]
]
to-font: func [style?][
insert fnt-styles style?
]
get-fnt-styles: func [][either not empty? fnt-styles [fnt-style: trim/all form sort unique fnt-styles][fnt-style: "font_"]
replace main "#font" fnt-style
]
string-size?: func [txt-string][text-face: layout/tight [text txt-string] face-x: text-face/size/x]
get-string-size: func [txt-string][txt-string: form txt-string
any [attempt [face-x: face-x/x] face-x face-x: none]
any [
if "b." = fnt-style [text-face: layout/tight [text txt-string bold font-size 16]
either face-x [replace main "#string-size" as-pair face-x 20][
replace main "#string-size" as-pair text-face/size/x - 18 20 text-face: ""]
]
if "i." = fnt-style [text-face: layout/tight [text txt-string italic font-size 16]
either face-x [replace main "#string-size" as-pair face-x 20][
replace main "#string-size" as-pair text-face/size/x - 18 20 text-face: ""]
]
if "u." = fnt-style [text-face: layout/tight [text txt-string underline font-size 16 ]
either face-x [replace main "#string-size" as-pair face-x 20][
replace main "#string-size" as-pair text-face/size/x - 18 20 text-face: ""]
]
if "i.u." = fnt-style [text-face: layout/tight [text txt-string italic underline font-size 16]
i./valign: 'top
either face-x [replace main "#string-size" as-pair face-x 20][
replace main "#string-size" as-pair text-face/size/x - 18 20 text-face: ""]
]
if "b.i." = fnt-style [text-face: layout/tight [text txt-string bold italic font-size 16 ]
b.i./valign: 'top
either face-x [replace main "#string-size" as-pair face-x 20][
replace main "#string-size" as-pair text-face/size/x - 18 20 text-face: ""]
]
if "b.u." = fnt-style [text-face: layout/tight [text txt-string bold underline font-size 16 ]
b.i./valign: 'top
either face-x [replace main "#string-size" as-pair face-x 20][
replace main "#string-size" as-pair text-face/size/x - 18 20 text-face: ""]
]
if "b.i.u." = fnt-style [text-face: layout/tight [text txt-string bold italic underline font-size 16]
b.i./valign: 'top
either face-x [replace main "#string-size" as-pair face-x 20][
replace main "#string-size" as-pair text-face/size/x - 18 20 text-face: ""]
]
]
any [attempt [face-x: face-x/x] face-x face-x: none]
if find main "#string-size" [text-face: layout/tight [text txt-string font-size 16]
replace main "#string-size" as-pair text-face/size/x - 12 20 text-face: ""]
face-x: none
]
remove-style: does [
border=: parent-sz: width=: height=: div-x: para-x: font-size=: face-x: none bgclr: any [i_bgclr b_bgclr li_bgclr ul_bgclr td_bgclr tr_bgclr tb_bgclr p_bgclr div_bgclr bkclr]
clr: any [b_clr i_clr li_clr ul_clr td_clr tr_clr tb_clr p_clr div_clr txt-clr]replace main "#text" ""
]
remove-font: func [style?][
replace/all fnt-styles style? []
]
url-address: "http://www.rebol.com"
get-image: func [img-src] [the.image: ""
img-src: any [img-src img-src: "image"]
switch img-src/1 [
#"h" [replace img-src "p/" "p:/" the.image: to string! reduce img-src]
#"/" [either img-src/2 = #"/" [the.image: to string! reduce ["http:" img-src]][the.image: to string! reduce [url-address img-src]]]
#"w" [the.image: to string! reduce ["http://" img-src]]
#"%" [the.image: to-file img-src ]
]
image-type: [".png" ".jpg" ".gif"]
either find the.image any image-type [img-url: load the.image] [img-url: the.image]
]
font_: make face/font [style: [] size: 16]
b.: make face/font [style: 'bold size: 16 align: 'center]
i.: make face/font [style: 'italic size: 16 align: 'center]
u.: make face/font [style: 'underline size: 16 valign: "top"]
b.i.u.: make face/font [style: [bold italic underline] size: 16 align: 'center valign: "top"]
b.i.: make face/font [style: [bold italic] size: 16 align: 'center]
b.u.: make face/font [style: [bold underline] size: 16 align: 'center valign: "top"]
i.u.: make face/font [style: [italic underline] size: 16 align: 'center valign: "top"]
back.: make face/font [ size: 25 align: 'top valign: 'top color: silver]
in-parent_elem-type!: make hash! [" } ">"]
switch DSL [html [markup-DOM Dialect parse-html markup layout-html markup
markup-DOM load join "[" replace html-markup? "}" "}]"
] html-markup?: none
]
]
update: does [
html/text: "http://www.rebol.com"
url-address: url: ""
main: ""
url-type: ["com" "net" "org"]
foreach url.type url-type [
if find html/text url.type [
parse/all html/text [to "h" copy url-address thru url.type ]]
]
divs: prg: tbl: td: hd: lst: ul: spn: fnt:
img: hrl: fld: btn: txt-btn: hdn: chk: rdo: 0
width=: txt-sz: x-size: 0x0
clear main
clear face-styles
clear-colors
recycle/off recycle/on
view/new view-port
input-as 'html markup
replace/all main "none" ""
replace/all main "font #font" " "
replace/all main "9400D3"
window: load main main: none
doc: ""
doc: layout/offset/size window 0x0 800x2000 attempt [clear do face-styles]
page/pane: doc page/pane/size/x: 1000
update-panel page s1 s2
page/color: bkclr show page
editor/text: markup show editor
{pagetitle: getnodename "title"
either find histobj pagetitle [][
append histobj reduce [pagetitle url]
]
}
]
layout-html: func [Dialect][
markup-DTD Dialect
replace/all in-html-markup: to-hash load/markup trim/lines Dialect [" "] []
foreach data-node in-html-markup [of-data-node: data-node
if string! = type? of-data-node [
foreach [old new]["," "_." ";" "._" ][replace/all data-node old new]
text-node: mold form trim data-node bgclr: clr: none
foreach part-of-node node: parse/all of-data-node " " [
either none = attempt [load part-of-node][append html-markup? to-word rejoin ["<" part-of-node ">"]
][append html-markup? rejoin [" " part-of-node " "]]
]
foreach [old new]["_." "," "._" ";" ][replace/all text-node old new]
get-colors
either true = in-parent? [
either find main "#text" [
replace main "#text" text-node replace replace main "#bgclr" bgclr "#clr" clr
get-fnt-styles gt-str-sz: get-string-size text-node
][
append main reduce [" space 0 box " bgclr " " "#string-size effect[draw[pen " clr " font #font text " text-node "]] "]
face-x: none get-fnt-styles get-string-size text-node text-node: none
]
][
if find main "#text" [replace main "#text" reduce [" " text-node " "]
get-fnt-styles get-string-size text-node text-node: none
]
if all [text-node fnt-styles] [append main reduce [" box " bgclr " " "#string-size effect[draw[pen " clr " font #font text " text-node "]] "]
get-fnt-styles get-string-size text-node text-node: none
]
if text-node [append main reduce [" " text-node " font-size 16 " clr " " bgclr " "]]
replace/all replace/all main "#bgclr" bgclr "#clr" clr
face-x: text-node: node: none
]
]
out-parent?: []
out-style?: []
html-markup?: end-tag-token?: {}
make-dom-element: does [append html-markup? reduce [" "
mold to-set-word node-name { [}]
if find data-node " " [
attributes: find data-node select data-node node-name
append html-markup? reduce [mold to-string attributes " "]
]
]
close-parent: func [][
closed: reduce first skip find tag-tokens end-tag-token? 2
insert tail main closed]
close-dom-element: does [append html-markup? reduce [mold end-tag-token? {] }]]
if tag! = type? of-data-node [
either (length? parse/all of-data-node " ") > 1 [
get-attributes of-data-node
get-colors][node-name: to string! data-node]
if find in-parent_elem-type! join "<" node-name [
make-dom-element
insert out-parent? to-refinement copy node-name
in-parent?: true make-face-obj
insert tail main reduce [" " self " panel [ pad 1 " face-obj " "]
]
]
if find input_elem-type! node-name [
make-dom-element
get-input-type of-data-node
{if found? this-parent: find/any [/p /li /ul] out-parent? [
close-parent
select-this end-tag-token?: this-parent
replace out-parent? first this-parent []
replace main "close." {] }
remove-style in-parent?: false
]}
in-parent?: false make-face-obj
insert tail main reduce [ 'space " " 12 " " self " " face-obj]
append html-markup? {] }
remove-style
token?: end-tag-token?: none
]
if find out-parent_elem-type! join "<" node-name [
in-parent?: false
clear fnt-styles
either find out-parent? end-tag-token?: load node-name [
close-dom-element
close-parent
select-this end-tag-token?
replace/all main "close." {] }
remove-style replace out-parent? end-tag-token? []
]["replace in-html-markup pick in-html-markup node []"]
if find as-block_elem-type! form end-tag-token? [insert tail main { below across }]
end-tag-token?: none
]
if find in-style_elem-type! node-name [
either any ["br" = node-name "newline" = node-name][][make-dom-element]
insert out-style? to-refinement node-name
select-this style-token?: to word! node-name
either find main "#font" [][
insert tail main reduce first skip find tag-tokens style-token? 2
]
replace replace out-style? /br [] /newline []
node-name: ""
]
if find out-style_elem-type! node-name [
in-style?: false
if find out-style? style-token?: load node-name [
select-this style-token?
insert tail main reduce first skip find tag-tokens style-token? 2
append html-markup? { ]}
replace out-style? style-token? []
style-token?: []
]
]
] replace html-markup? "}]" "}"
replace/all main "none" ""
clear in-html-markup
]
node-list: .style: []
equal?: :=
DOM: DSL: html: window: end-tag: ""
data-node: parent-node: slf*: node: key: *key: *value: k: v: none
.body: .hr: .p: .b: .i: .tr: .ul: .li: .area: .table: .td: .button: .input: .div: .font: .span: count: 0
array-obj!: node-obj: node-element: *variable: *node-name: node-name: *name: use-methods: attr-name: attr-value: none
check: func [select-this][return pick parse trim strip-chars-from form select-this none " " 1]
*get: func[this][ attempt [this]]
affix: func [code][*get insert code [clear] | code]
reappend: func [with this-data][append with to-block mold rejoin this-data]
rescind: func [variable][var form variable]
imply: func [with][do load strip-obj-chars-from mold with inferred]
insert-this: func [put-this at-here][do head insert here: find copy key at-here put-this]
void: does [data-node: node-element: none slf*: "" count: 0]
as-data-node*: func [data-node][to block! data-node]
as-series*: func [series with-chars][to block! strip-obj-chars-from form series with-chars]
as-sequence*: func [series with-this][
to-block mold to-block strip-obj-chars-from strip-obj-chars-from form series with-this none
]
clear-node-list: does [foreach [var node] node-list [
attempt [set to-set-word var none]]clear node-list]
use*=*to-set-values: does [=: func [value][any [value]]]
use-attr-as-methods: func [maybe [logic!]][
if no != maybe [
strip-obj-chars-from node-element [{" } {" .} ".." "."]]
replace node-element " " " ." use-methods: off
]
elemt-chars: none
strip-chars-from: func [node-name elemt-chars][
foreach char elemt-chars: any [elemt-chars
["<" ">" "{" "}" "(" ")" {"} "/" "." "[" "]" "," ":" ";" "," "=" "`"]
][
replace/all node-name char " "
]
]
obj-chars: +char: none
strip-obj-chars-from: func [node-name obj-chars][
attempt [replace replace node-element "={" {="} ";}" {;"}]
attempt [trim form node-name if equal? #"^"" node-name/1 [remove node-name]
foreach [-char +char] obj-chars: any [obj-chars [#"^/" " "
" " " " {" , "} {" } {", "} {" } "," " " {" "} {" } {" : "} {: "}
{":"} {: "} {":} {:} { " } "" {"[["} {"[[" "} "{" "[" "}" "]" {""}
{"} { "} "" " : " ": " ":" " " { =} {=} {=} " " "'" "" "#" ""
"<" "" ">" "" "`" "" "_" " "]
][
replace/all node-name -char +char
]]
]
document.getnodename: func [request][document. getnodename request]
document.: func [request-as][
DOM: head DOM use*=*to-set-values
any [
all [data-node node-name: check node-element: data-node/1]
all [insert data-node: [] node-element: request-as node-name: check data-node/1
]]
any [all [equal? tag! type? node-element
strip-obj-chars-from node-element ["{" "" "[" "" "}" "" "]" ""]]
node-element]
either count >= 1 [me: parse slf* ":"
var replace node-element node-name any [
attempt [first to-block me] slf*]]
[var node-element] me: parse slf* join ":" count .style: :array-obj!
attempt [replace node-element first parse node-element " :"
last to-block me]
return node-element count: 0
]
.return-tag-node: func [node-name][DOM: head DOM
node: either equal? word! type? node-name [
either any [attempt [empty? node-element] equal? none node-element]
[select node-list form node-name][node-name]][node-name]
any [
all [equal? node none print rejoin [{node-name: (} node-name ") not in node-list."]]
equal? tag! type? node-element: node
attempt [node-element: data-node: build-tag
to-block strip-obj-chars-from form node none]
set 'node-element node]node-name: check node-element
return probe node-element
]
getnodename: func [node-name][
DOM: head DOM =: :equal? slf*: data-node: [] node-element: none
either block! = type? node-name[.return-tag-node node-name][
node-name: to block! strip-chars-from form node-name none
count: any [attempt [count: pick find node-name integer! 1]1]
nodename: to-word join "." array-obj!: node-name/1
any [attempt [repeat ? count [data-node: first DOM: next node: find DOM nodename]]
all [print rejoin [{node-name: (} node-name/1 "." count ") not found."]count: 0]
]
slf*: join node-name/1 count
]
if " " = data-node [data-node: form first DOM: next DOM]
return either tag! = type? data-node/1 [node-element: data-node/1][node-element: data-node]
]
getElementByTagName: func [Tag-Name selection [block!]][
dom: head dom
repeat this count: first selection [
node-element: first data-node: first dom: next find dom to-word join "." Tag-Name]
if all [equal? true use-methods not find node-element " ."][use-attr-as-methods yes]
use-methods: off slf*: join Tag-name count
]
setnodename: func [old-name new-name][
any [equal? this-name: check old-name check node-element getnodename old-name]
any [equal? none not find node-element new-name try [
replace node-element to string! this-name new-name
replace data-node to-tag join "/" this-name to-tag join "/" new-name]
]
]
getattribute: func [attr-name][
attr-value: none
print any [all [attr-value: array-obj!(attr-name)
[attr-name " " attr-value]
]["attribute: " attr-name " not found"]
]
]
setattribute: func [attr-name new-attr][
*key: *value: none .style: array-obj!:
|: func [key] do compose/deep [body-of (to-get-word variable)]
any [
all [.style((attr-name)) *value: *key `= (new-attr)]
| [reappend [" " new-attr{="undefined"}]]
print ["Must get a parent-node with this attribute: " attr-name]]
obj-chars: [=[`=]]
replace node-element form next parse variable reform ["*" count] next variable
get-attributes node-element attempt [set-attributes]=: :equal?
]
setattributevalue: func [attr-name attr-value][
*key: *value: none .style: array-obj!:
|: func [key] do compose/deep [body-of (to-get-word variable)]
any [
all [.style((attr-name)) if *value [`= (attr-value)]]
| [reappend [" " attr-name{="}attr-value{"}]]
print ["Must get a parent-node with this attribute: " attr-name]]
obj-chars: [=[`=]]
replace node-element form next parse variable reform ["*" count] next variable
get-attributes node-element attempt [set-attributes]=: :equal?
]
look-deep-for: func [this from-this-parent][
foreach in-child-tag-node from-this-parent [
if all [tag! = type? child: in-child-tag-node find/any child this][
insert data-node: [] node
node-element: child slf*: rejoin [slf* ":" *name: first parse node-element " "]]
if block! = type? node: in-child-tag-node [look-deep-for this in-child-tag-node]
]
]
getElementById: func [my-id][in-child-node: none count: 1
id: copy join "id*" slf*: form my-id =: :equal?
foreach in-parent-node dom [
if block! = type? node: in-parent-node [look-deep-for id in-parent-node
]]
]
querySelecter: func [css-Selecter][in-child-node: none count: 1
id: rejoin [slf*: css-Selecter "*"] =: :equal?
foreach in-parent-node dom [
if block! = type? node: in-parent-node [look-deep-for id in-parent-node
]]
]
.innerHTML: func [with-html][
some-children: copy/part next data-node find/last data-node tag!
either equal? tag! type? node-element [
any [all [empty? with-html some-children] replace data-node some-children with-html]
][print "The node-element has no innerHTML"]
]
var: func [var-data][node-element: variable: "" .style: none
any [
attempt [variable: first parse node-element: var-data "=:, "]
attempt [if equal? block! type? var-data [variable: first node-element: var-data]]
attempt [variable: var-data node-element: ""]
]
use*=*to-set-values node-name: variable: join "*" to-string variable obj-chars: []
replace node-element node-name nodename: first parse form node-name form count
either empty? node-element [any [find node-list variable append node-list reduce
[variable node-element: any [attempt [do :variable] ""]]]]
[any [find node-list node-name append node-list reduce [form variable node-element]]]
set to-word variable array-obj!: func [key] compose/deep copy get-array-obj!
any [find variable "." set to-word trim/all reform [variable "."] :array-obj!]
use-methods: off *variable: none if equal? word! type? var-data [clear node-element]()
]
get-array-obj!: [
node-element: select node-list variable: (form variable)
|: &.: :array-obj! strip-obj-chars-from node-element ["={" {="} ";}" {;"}]
attempt [all [inline: find/any node-element { style=*"}
replace node-element inline
replace/all replace replace inline {"} "{" {"} "}" " " ": "]]
if all [not find form node-element "1:" tag! != type? node-element][
all [equal? (length? parse form node-element ":= ,") 1
node-element: join {#1: } node-element ]]
any [
if empty? form key [strip-obj-chars-from node-element ["={" {="} ";}" {;"}]
array-obj!: replace body-of :array-obj! select body-of :array-obj! [variable:] variable
|: array-obj!: func[key] array-obj!
return any [
if equal? tag! type? node-element [node-element]
attempt [trim find/tail copy head node-element first parse node-element " ,"]
next node-element]*key: key: *value: value: none
]
if all [*key: first to-block key not find node-element rejoin [" " *key " "]
equal? integer! type? *key][
values: any [attempt [parse head node-element "<=;,`#: []>"]
load strip-obj-chars-from mold node-element none]
keys: length? replace/all values [""][]
if odd? length? values [remove values]
any [equal? 1 *key *key: *key + *key - 1]
*value: any [*value: select values *key: pick values *key *value ]
if *value [print ["*key:" *key " *value: " *value: *value ]]
node-name: keys: none
]
if equal? path! type? key[]
if equal? refinement! type? key[attempt [do replace/all form key "." "/."]]
if find ["url!" "email!" "tag!" "refinement!"] mold type? key [
attempt [key: to-string parse replace/all to-string key "." "/." "/"]
strip-obj-chars-from key [":" ":." "@" ": " ".." "."]
replace/all from-method: parse key ".:" [""] []
foreach key from-method [any [attempt [| to-block key] | mold key]]
]
any [
attempt [*value: load select/case parse strip-obj-chars-from copy node-element none none
*key: trim head trim tail form key]
attempt [*value: select/case load strip-obj-chars-from mold to-block node-element none *key: key]]
any [
attempt [do head append insert next copy key [node-element join] ""]
attempt [if equal? string! type? key [do head replace copy key " " { node-element }]]]
attempt [do load key] attempt [*get-methods key] attempt [do *get-expressions key none]
if not find node-element key [*key: value: none obj-chars]]
]
new: func [previuos-node][as-variable: form copy variable
with-element: do reform [previuos-node {""}]
any [
if find node-list double-variables: reduce [as-variable as-variable]
[replace node-list double-variables []
var reform [join as-variable ": " next load with-element]
do reform [variable {""}]]
if find node-list double-variables: reduce [as-variable to-word as-variable]
[replace node-list double-variables []
var reform [join as-variable ": " next load with-element]
do reform [variable {""}]]
if *variable [attempt [var reform [join *variable ": " next load with-element]
do reform [*variable {""}]]]
all [replace node-list [""] reform [join as-variable ":" next load with-element]
do reform [as-variable {""}]]]
]
proto-type: func [as-object new-name][
old-name: check as-object
append :as-object parent-url!: to-string reduce [new-name "::" new-name]
var append replace replace node: copy head as-object
old-name new-name parent-url! " " to-string reduce [" parent::" old-name]()
]
*!: func [new-var][use*=*to-set-values
either find node-list this: any [
reduce [variable variable]
reduce [variable to-word variable]]
[replace node-list this [] count: 0
var var-data: reform [new-var last this]
][strip-obj-chars-from node-element reduce [variable new-var " " " "]
slf*: rejoin [
form new-var ":" node-name: new-var]
data-node: none document. node-element]
]
.: func [value /local *val][either equal? block! type? *value [*val: copy *value
any [
if equal? integer! type? *key: first to-block value [
any [equal? 1 *key *key: *key + *key - 1]
attempt [do [value: select *value *key: pick *value *key *value: to-block value]]]
attempt [*value: first next *value: find *value value]
attempt [*value: head *value *value: next find *value value]
attempt [*value: *val load value]]
][ do compose/deep reduce [*value [(load value)]]]
]
some: func [next-key][
either obj-chars [translate next-key][
foreach try-this next-key [
all [equal? tag! type? try-this insert try-this "'"]
any [find-with: all [equal? block! type? try-this go-to: *key ]
find-with: *key: *value: none]
any [all [equal? *value none | try-this
find node-element *key: any [try-this form try-this]
function! != type? *key
print ["*key: " *key " *value: " *value: form *value ]]
any [all [find-with key: first back find next-key reduce [
go-to try-this] find [url! email! tag! refinement!] to word! type? go-to
| key key: *value do try-this]]] key: any [key *key try-this]]
()]
]
translate: func [transitive][intransitive: []
any [all [
equal? [] obj-chars/2 clear intransitive ]insert clear intransitive [|]]
all [obj-chars strip-obj-chars-from transitive obj-chars]
foreach next-key transitive [
any [
if equal? '. next-key [next-key: []]
all [equal? word! type? next-key '`= != next-key
append intransitive reduce ['| form next-key]]
all [equal? block! type? next-key attempt [append intransitive do compose/deep [
(load form strip-obj-chars-from next-key obj-chars)]]] append intransitive next-key]]
replace/all intransitive [`= |] [`=] attempt [| append intransitive [return. 0]]
probe strip-obj-chars-from intransitive reduce [|[] [] '| [] [return. 0] []]
obj-chars: none()
]
into-any: :strip-obj-chars-from
*negate: :negate
negate: func [seq][any [attempt [*negate seq] into-any seq reduce [*variable 'get]()]]
delegate: func [seq with [email!] define action][
any [
all [equal? word! type? seq do reform [seq {""}] negate action
set to-word skip form with 2 :|
any [into-any (attempt [back back find action [get[]]])
reduce ['get *variable: to-word variable]
| insert action compose [(*variable: to-word variable) []]]
]
all [equal? tag! type? seq var to-word skip form with 2
affix [|[reappend [variable " " action]]]]
all [do reform [action {""}] negate seq
set to-word skip form with 2 :|
any [into-any (attempt [back back find seq [get[]]])
reduce ['get *variable: to-word variable]
| insert seq compose [(*variable: to-word variable) []]]
]]
]
int: does [replace node-element *value *value: *value nil #]
string: does [replace node-element *value *value: mold mold form *value nil #]
char: does [replace node-element *value *value: mold mold form *value nil #]
*word: [replace replace node-element *value *value: join "'`" form as-sequence* *value ["@" ""]"'`'`" "'`" nil #]
nil: does [replace node-element [nil] {"unset!"} #]
of: func [this][ either equal? type? block! this [first attempt [do this]][attempt [do this]]]
destruct: func [*value][load find/match *value "'`"]
struc: []
`=: func[attr-value][
any [
attempt [if *key [replace find node-element *key *value *value: form do load form attr-value]]
replace node-element form *value form *value: attr-value
replace node-element mold form *value mold *value: attr-value
attempt [*value: select node-element *key: load key]
]all [not empty? struc do first back find struc load *key] node-element: head node-element
]
return.: func [value][
any [
attempt [*value: to-block value
foreach a *value [if not equal? word! type? a [do *value: a ]]]
attempt [*value: do form reduce load value]
]
]
rel-xprsn: to-hash [
" " " " "*va" "-va" " ." "_$" "." " #" { = "} {:== "} {: "} ":::" " *" " set '" "};" {%>"}
"] [" "]|[" "}}" "},}" "}," {%>"} "," " " ": " " 1 `= " ":::" {: "} {- "} {- ."} " = " " `= "
" {" " .{" " ${" { build-markup "<%} "* " "[] " "()" {("")} "==" " =" "function " "function '"
"_$" " ." "var " "var reform " "-va" "*va" "= ." "= " ": ." ": " " #log" ".log" "&" ""
]
*get-expressions: func[this expressions][
attempt [
find this: mold this "return 0"
strip-obj-chars-from this [{."} {"-} "1." "1-" "2." "2-" "3." "3-" "4." "4-" "5." "5-"
"6." "6-" "7." "7-" "8." "8-" "9." "9-" "0." "0-" "\." "~escp"]
strip-obj-chars-from this expressions: any [expressions rel-xprsn]
strip-obj-chars-from this [{"-} {."} "1-" "1." "2-" "2." "3-" "3." "4-" "4." "5-" "5."
"6-" "6." "7-" "7." "8-" "8." "9-" "9." "0-" "0." "~escp" "."]
all [
;| is exspressive, using Do won't eval sequence methods but is simpler and faster.
any [attempt [| reduce . this] do this]
]]
]
*get-methods: func[this][
attempt [
this: mold this
if not find this: next find this "." "return 0" [
| this: do strip-obj-chars-from head this [
"[" "" "]" "" "." "@" {"} "" "ame@" "ame join form '"
"ent@" "ent. " "&" { join " " } "=" "`="]]
]
]
node-element: *node-name: *name: array-obj!: key: *key: *value: ""
markup-DOM: func [Dialect][
use-methods: no
DOM: copy/deep load replace/all mold Dialect "__" " "
get-data: func [data][
end-tag: none
any [
if end-tag: find data refinement! [
end-tag/1: to-tag join "/" end-tag/1
]
if end-tag: find data get-word! [
end-tag/1: to-tag join "/" end-tag/1
]
insert tail data to-tag join "/" any [*name *node-name]
]
if string! != type? data/1 [insert data to-tag node-name]
repeat in-data data [
if set-word! = type? in-data [
replace data in-data node-name: to-word join "." *node-name: form in-data
]
if string! = type? in-data [
in-node-element: rejoin [remove form node-name " " in-data]
quote-node-attributes create-tag-element with-these-attributes
foreach [a b][{=" } "={" {" "} "*}" "*" {"}][replace/all child a b]
replace data in-data data-node
]
if block! = type? in-data [get-next in-data]
]
]
get-next: func [in-data][
end-tag: none
any [
if end-tag: find in-data refinement! [
end-tag/1: to-tag join "/" end-tag/1
]
if end-tag: find in-data get-word! [
end-tag/1: to-tag join "/" end-tag/1
]
insert tail in-data to-tag join "/" any [*node-name *name]
]
if string! != type? in-data/1 [insert in-data to-tag node-name]
repeat data in-data [
if set-word! = type? data [
replace in-data data node-name: to-word join "." *name: form data
]
if string! = type? data [
in-node-element: rejoin [remove form node-name " " data]
quote-node-attributes create-tag-element with-these-attributes
foreach [a b][{=" } "={" {" "} "*}" "*" {"}][replace/all child a b]
replace in-data data data-node
]
if block! = type? data [get-data data]
]
]
repeat with-this-data Dialect [
if issue! = type? with-this-data [
node-name: to-word join "." *name: copy form with-this-data
]
if set-word! = type? with-this-data [
replace Dialect with-this-data node-name: to-word join "." *name: copy form with-this-data
]
if word! = type? with-this-data [
either '= = with-this-data [string-is-data: yes replace Dialect with-this-data ""
][
*name: copy form with-this-data
replace Dialect with-this-data node-name: to-word join "." with-this-data]
replace Dialect reduce [node-name node-name] node-name
]
if string! = type? with-this-data [
either string-is-data [
replace Dialect with-this-data rejoin [node-name " " with-this-data]
][
created-data: copy with-this-data
strip-obj-chars-from created-data none
insert created-data reduce [node-name " "]
child: build-tag to-block remove created-data
foreach [a b][{=" } "={" {" "} "*}" "*" {"}][replace/all child a b]
replace Dialect with-this-data child
]
string-is-data: no
]
if block! = type? with-this-data [
get-data with-this-data
]
if get-word! = type? with-this-data [
replace Dialect with-this-data to-tag mold to-refinement *name
]
]
DOM: copy Dialect
markup: form Dialect
foreach [-char +char]["{" "<" "}" ">" "<." "<" "_. " ","][replace/all markup -char +char]
foreach n-name [
".body " ".hr " ".p " ".b " ".i " ".? "
".tr " ".table " ".td " ".button " ".input "
".div " ".ul " ".li " ".font " ".span " ".hr "
".area " ".img " ".a " ".strong " " ."
][replace/all markup n-name " "
]
append replace/all markup ""
markup: any [find markup "" 10x0 pen gray line-width 3 line 5x16 20x16]]
pad 0x6
Go: button "Go" white 30x24 [
txt-clr: none attempt [
case [
if find/match html/text "www" [insert html/text "http://" markup: read to-url html/text update]
if find/match html/text "http://" [markup: read to-url html/text update]
if find html/text {/rebol } [attempt [do html/text]]
;markup: mold any [attempt [load html/text] { 404}]
]]
]
edge [size: 0x0 effect: 'none ]
html: field 500 edge [size: 1x1 color: blue ]
below
pad -20x28 box 805x1 gray /20 edge: ['none]
across pad -20x-10 page: box 241.241.241 edge[size: 0x0 effect: 'none ] 783x508
pad -10 s1: scroller 241.241.241 16x494 [attempt[scroll-panel-vert page s1]]
below pad -20x-24 s2: scroller 241.241.241 788x16 [attempt [scroll-panel-horz page s2]]
pad -10 editor: area white 805x130 wrap
pad 7
below across
pad -10x-10
btn "Up" 55 [if error? try [page/pane/offset/y: page/pane/offset/y + 100 show page
page/pane/offset/y: page/pane/offset/y - 2 show page][]]
btn "Down" 55 [if error? try [page/pane/offset/y: page/pane/offset/y - 100 show page
page/pane/offset/y: page/pane/offset/y + 1 show page][]]
btn "View code" 85 [markup: copy editor/text update
]
]
page/pane: ""
scroll-panel-vert: func [pnl bar][
pnl/pane/offset/y: negate bar/data *
(max 0 pnl/pane/size/y - pnl/size/y)
show pnl pnl/pane/size/y - 1 show pnl
]
scroll-panel-horz: func [pnl bar][
pnl/pane/offset/x: negate bar/data *
(max 0 pnl/pane/size/x - pnl/size/x)
show pnl
]
update-panel: func [pnl vbar hbar] [
pnl/pane/offset: 0x0
s1/data: s2/data: 0
vbar/redrag pnl/size/y / pnl/pane/size/y
hbar/redrag pnl/size/x / pnl/pane/size/x
show [pnl vbar hbar]
]
goo: does [get-attributes {p1 font-size "15" color "pink" bgcolor "blue"} set-attributes] ;declarative
gogo: does [document.(getnodename{p.1}).style[color]`= "blue" setattributevalue "bgcolor" "orange"] ;functional
view-port/size: 805x800
view center-face view-port
|