Script Library: 1238 scripts
  • Home
  • Script library
  • AltME Archive
  • Mailing list
  • Articles Index
  • Site search
 

Archive version of: rebol-dom-mdlparser ... version: 23 ... inetw3dm 2-Jun-2021

Amendment note: Updated: color=() bgcolor=() to use tuples. || Publicly available? Yes

REBOL [
        File: %rebol-dom-mdlparser
        Date: 02-11-2020
        Title: "Dialect Object Model"
        Emai: inetw3.dm@gmail.com
        author: daniel murrill
        Purpose: {
                     
             %Rebol-DOM.r mdlparser.r is a copy
              of the %Rebol-DOM.r mdlparser.
              The first copy would not download
              so i appended the *.r to it, wich 
              seemed to make it able to become
              downloadable now. So...., down
              load it and tell me all about its
              glorious problems so i can make a
              to-do list to go with the one in my 
              head. }
        ]

library: [
        author: daniel murrill
        level: 'intermediate
        platform: 'all
        type: Dialect
        domain: [DOM html vid css json js array]
        tested-under: "windows Rebol2"
        support: "discussions, email me"
        license: shareware
        see-also: %HTML-view.r
    ]


markup: [body: [{background-color="blue" text "white"} ]

p: [
    {id="my-p1" "color":"#0000ff", "bgcolor":"yellow", "width" : "399", "height" : "100" "font-styles": "big" } 
 This is an example of an Dialect Oject Model
b: [
    {color = "Chocolate" bgcolor = "yellow"} 
    
 that can be written to look like json' html' javascript arrays' css'  
i: [
    {id="i-color" color = "green"} 
    
 VID' or plain old rebol ] 
  ] 
 if you like.
  ]


hr: [{color="red" bgcolor="yellow"}]

div: [
    {width="399" bgcolor="orange"}  
b: [
    {color: "purple" bgcolor: "orange"} 
    
 Maybe it would be easier to write  
i: [
    {color: "green"}
    
 MakeDoc.r code but the purpose of this rebol DOM is']  
   ]
]

p: [
    {width "399" height= 200 
    style="color:red;bgcolor:'purple';border:2x2;" 
    } 
b: [     
    {color="red"}

 to read or load as many well known dialects of coding styles as possible
 and write all of it as a single or seperate legible rebol series that's
 quickly manipulated' transcoded as html' and viewed as a VID. ]
  ]
]


macros:[
"&" "&" 
"&lt;" "<" 
"&gt;" ">" 
"&quot;" {"} 
"&auml;" "ä" 
"&Auml;" "Ä" 
"&ouml;" "ö" 
"&Ouml;" "Ö" 
"&uuml;" "ü"
"&Uuml" "Ü" 
"&szlig;" "ß" 
]

histobj: []
markup-hexcolors: func [Dialect-colors] [
	foreach [word-color with-hexcolor] incolor-series [replace/all Dialect-colors word-color :with-hexcolor]
]
incolor-series: to-hash [
   "Aliceblue" "#F0F8FF"  
   "Antiquewhite" "#FAEBD7"
   "Aqua" "#00FFFF"
   "Aquamarine" "#7FFFD4"   
   "Azure" "#F0FFFF"
   "Base-color" "#8F7F6F"
   "Beige" "#FFE4C4"
   "Bisque" "#FFE4C4" 
   "Black" "#000000" 
   "Blueviolet" "#8A2BE2"
   "Blanchedalmond" "#FFEBCD"
   "Brown" "#A52A2A"
   "Brick" "#B22222"
   "Burlywood" "#DEB887"    
   "Cadetblue" "#5F9EA0"  
   "Chartreuse" "#7FFF00" 
   "Coal" "#404040"
   "Coffee" "#4C1A00"
   "Chocolate" "#D2691E"  
   "Coral" "#FF7F50"
   "Cornflowerblue" "#6495ED" 
   "Cornsilk" "#FFF8DC" 
   "Crimson" "#DC143C" 
   "Cyan" "#00FFFF"  
   "Darkblue" "#00008B" 
   "Darkcyan" "#008B8B"
   "Darkgoldenrod" "#B8860B"
   "Darkgray" "#A9A9A9"
   "Darkgreen" "#006400" 
   "Darkkhaki" "#BDB76B"
   "Darkmagenta" "#8B008B"
   "Darkolivegreen" "#556B2F"
   "Darkorange" "#FF8C00"
   "Darkorchid" "#9932CC"
   "Darkred" "#8B0000"
   "Darksalmon" "#E9967A"
   "Darkseagreen" "#8FBC8F"
   "Darkturquoise" "#00CED1"
   "Darkslateblue" "#483D8B"
   "Darkslategray" "#2F4F4F"
   "Darkviolet" "#9400D3"
   "Deepskyblue" "#00BFFF"   
   "Dimgray" "#696969"
   "Firebrick" "#B22222" 
   "Floralwhite" "#FFFAF0"
   "Forest" "#003000"
   "Forestgreen" "#228B22"
   "Fuchsia" "#FF00FF"
   "Gainsboro" "#DCDCDC"
   "Ghostwhite" "#F8F8FF"
   "Gold" "#FFCD28"
   "Goldenrod" "#DAA520"  
   "Gray" "#808080"  
   "Green" "#00FF00"
   "Greenyellow" "#ADFF2F"  
   "Honeydew" "#F0FFF0"  
   "Hotpink" "#FF69B4"  
   "Indianred" "#CD5C5C"  
   "Indigo" "#4B0082"  
   "Ivory" "#FFFFF0"  
   "Khaki" "#F0E68C"  
   "Lavender" "#E6E6FA"  
   "Lavenderblush" "#FFF0F5"  
   "Lawngreen" "#7CFC00"  
   "Lemonchiffon" "#FFFACD"  
   "Lightblue" "#ADD8E6"  
   "Lightcoral" "#F08080"  
   "Lightcyan" "#E0FFFF"  
   "Lightgoldenrodyellow" "#FAFAD2"  
   "Lightgreen" "#90EE90"  
   "Lightgrey" "#D3D3D3"  
   "Lightpink" "#FFB6C1"   
   "Lightsalmon" "#FFA07A"  
   "Lightseagreen" "#20B2AA"  
   "Lightskyblue" "#87CEFA"  
   "Lightslategray" "#778899"  
   "Lightyellow" "#FFFFE0"  
   "Lime" "#00CD00"  
   "Limegreen" "#32CD32"  
   "Linen" "#FAF0E6" 
   "Leaf" "#008000"
   "Magenta" "#FF00FF" 
   "Maroon" "#800000"
   "Mint" "#648874"
   "Mediumauqamarine" "#66CDAA"  
   "Mediumblue" "#0000CD"  
   "Mediumorchid" "#BA55D3"  
   "Mediumpurple" "#9370D8"  
   "Mediumseagreen" "#3CB371"  
   "Mediumslateblue" "#7B68EE"  
   "Mediumspringgreen" "#00FA9A"  
   "Mediumturquoise" "#48D1CC"  
   "Mediumvioletred" "#C71585"  
   "Midnightblue" "#191970"  
   "Mintcream" "#F5FFFA"  
   "Mistyrose" "#FFE4E1"    
   "Moccasin" "#FFE4B5"  
   "Navajowhite" "#FFDEAD"  
   "Navy" "#000080"  
   "Oldrab" "#484810"
   "Olive" "#808000"  
   "Olivedrab" "#688E23"  
   "Orange" "#FFA500"
   "Orangepumpkin" "#FFA500"  
   "Orangered" "#FF4500"  
   "Orchid" "#DA70D6"  
   "Papaya" "#FF5025"
   "Palegoldenrod" "#EEE8AA"  
   "Palegreen" "#98FB98"  
   "Paleturquoise" "#AFEEEE"  
   "Palevioletred" "#D87093"  
   "Papayawhip" "#FFEFD5"  
   "Peachpuff" "#FFDAB9"  
   "Peru" "#CD853F"  
   "Pewter" "#AAAAAA"
   "Pink" "#FFC0CB"  
   "Palepink" "#FFC0CB" 
   "Plum" "#DDA0DD"  
   "Powderblue" "#B0E0E6"  
   "Purple" "#800080" 
   "Rebolor" "#8E806E"
   "red" "#FF0000"  
   "Rosybrown" "#BC8F8F"  
   "Royalblue" "#4169E1"  
   "Saddlebrown" "#8B4513"  
   "Salmon" "#FA8072"  
   "Sandybrown" "#F4A460"  
   "Seagreen" "#2E8B57"  
   "Seashell" "#FFF5EE"  
   "Sienna" "#A0522D"  
   "Silver" "#C0C0C0"  
   "Sky" "#A4C8FF"
   "Skyblue" "#87CEEB"    
   "Slateblue" "#6A5ACD"  
   "Slategray" "#708090"  
   "Snow" "#FFFAFA"  
   "Springgreen" "#00FF7F"  
   "Steelblue" "#4682B4"  
   "Tan" "#D2B48C"  
   "Teal" "#008080"  
   "Thistle" "#D8BFD8"   
   "Tomato" "#FF6347"  
   "Turquoise" "#40E0D0"  
   "Violet" "#EE82EE"  
   "Water" "#506C8E"
   "Wheat" "#F5DEB3"
   "White" "#FFFFFF"
   "Whightsmoke" "#F5F5F5"  
   "Yellow" "#FFFF00"  
   "YellowGreen" "#9ACD32" 
   "Blue" "#0000ff"
   "amp;" "&&" 
    "lt;" "&<" 
	"gt;" "&>" 
	"quot;" {&"} 
	"auml;" "&ä" 
	"Auml;" "&Ä" 
	"ouml;" "&ö" 
	"Ouml;" "&Ö" 
	"uuml;" "&ü"
	"Uuml" "&Ü" 
	"szlig;" "&ß"
	"nbsp;" {&""}
	"&&" "&"
	"!--" ""
	"%100" "%99"
	"100%" "99%"
	<head> <body background-color="#FFFFFF" text="#000000">
	"backdrop-color" "bgcolor"
	"background-color" "bgcolor"
	{a# } <a > { #a} </a>
   ]

   
markup-DTD: func [DTD] [
    foreach [doc-tag with-definition] in-dtd [replace/all DTD doc-tag with-definition]
]

in-dtd: [
    "!--" ""
    "64-" "64 "
    "&#" " "    
    "%100" "%99"
    "100%" "99%"
    <body> <body background-color="#FFFFFF" text="#000000">
    "body bgcolor" "body background-color"
    ]
get-color: does [either error? try [
        baseclr: to-tuple debase/base baseclr 16] [this-color?] [this-color: any [baseclr this-color]]
]

color=: func [this-color][
    parse/all to-string this-color [(baseclr: "") to "#"
    copy baseclr to end]  
    this-color?: txt-clr
    either find baseclr "#" [baseclr: to-issue next baseclr get-color][this-color: any [attempt [to-tuple this-color]txt-clr]]
]
   
bgcolor=: func [this-color][
    parse/all to-string this-color [(baseclr: "") to "#"
    copy baseclr to end] 
    this-color?: bkclr
    either find baseclr "#" [baseclr: to-issue next baseclr get-color][this-color: any [attempt [to-tuple this-color]bgclr]]
]

remove-tail-char?: func [in-node-element element][=: :equal?
                  if element = char: back tail trim/tail in-node-element [remove trim/tail char]
                  ]
remove-head-char?: func [in-node-element element][
                  remove find/match in-node-element element 
                  {replace any [m m/1] first back find/match to-block any [attempt [first first m] m/1] #"p" []}
                  ]
quote-node-attributes: does [with-these-attributes: copy ""

remove-tail-char? in-node-element </>
this-node: form find/match in-node-element node-name: first parse/all in-node-element { =">}

foreach [-char +char][
                      #"^/" " " {:"} {"} ": {" "=true {"  
                      { ="" } {="" } { ="} " " {"=""} " " {="" } {" }][replace/all in-node-element -char +char]
            
if find/any this-node "style=" [    
    parse/all this-node [[to {style="} | to "style="]  copy style-obj [thru {;" } | thru {;">} | thru {;>} | thru {;"} | thru {" }  | thru {>} | thru "}," | to end](*style.node: copy style-obj
    foreach [style-chars found-with-in] tag-tokens/style-obj-chars [replace/all *style.node style-chars found-with-in]
    replace this-node style-obj *style.node
    )]
    ]
    replace node-name "<" ""    
    replace/all this-node "://" "&&"    

foreach part replace/all this-node: parse/all this-node {<{}  =":;[]>} [""] [] [
                            part: any [if find/match part "'" [
                                       replace/all part "'" ""
                                       ]
                                       part
                                  
                            ]
                            replace/all part {,} " "
                            replace/all part {__} " " 
                            replace/all part "&&" "://"  
                            replace/all part ". " "."
                            replace part {=null} {=""}
                            append with-these-attributes mold part  
                            ] 
]
 
create-tag-element: func [these-attr][
            in-attribute-blk: to-block these-attr 
            foreach [attr-name attr-value] in-attribute-blk [
            replace in-attribute-blk attr-name to-word attr-name
            attempt [trim attr-value]
            ]
            attempt [insert in-attribute-blk to-word trim/all strip-chars-from node-name]
            data-node: build-tag in-attribute-blk  
]

this-width: 100

div: prg: tbl: tds: hd: lst: ul: spn: fnt: 0
img: hrl: fld: btn: txt-btn: hdn: chk: rdo: txt-sz: width=: 0
Dialect: "" 

div-x: tbl-x: para-x: hr-x: hr-xy: face-x: tdx: x-size: gt-str-sz: 0x0
slf: child: use-methods: last-node: with-these-attributes: ""
styles: .style: ""
imgurl: go-here: copy [] 
parent-sz: font-size=: str-sz: 0
DOM: face-styles: "" fnt-styles: [] fnt-style: ""
data-node: face-node: node-name: node-type: tag-node: tag-head: text-node:   
in-parent?: in-parent-node: in-node?: end-tag-token?: slf*: none

div_clr: p_clr: tb_clr: tr_clr: td_clr: ul_clr: li_clr: f_clr: b_clr: i_clr: clr: txt-clr: border=: none 

div_bgclr: p_bgclr: tb_bgclr: tr_bgclr: td_bgclr: ul_bgclr: li_bgclr: f_bgclr: b_bgclr: i_bgclr: bgclr: bkclr: none 
fnt-nm: "" 

.border?: border?: does [if not none = border= [
                    border: to-block foreach [a b]["(" "" ". " "." ")" ""] [replace/all border= a b] 
                    append face-styles to-string reduce [ 
                    to-path reduce [slf 'edge 'size] ": " either attempt [pair: first find border pair!][pair][0x0] " "
                    to-path reduce [slf 'edge 'color] ": " clr: first any [find border tuple! 0.0.0] " show " slf " "] ]
                    
            ]
.color?: color?: does [append face-styles to-string reduce ["foreach fclr " to-path reduce [slf 'pane] " [if clr != fclr/effect/draw/pen [fclr/effect/draw/pen: " clr " show fclr]] "]] 
                ] 
.bgcolor?: bgcolor?: does [append face-styles to-string reduce ["foreach clr " this: to-path reduce [slf 'pane] " [if bgclr != " to-path reduce [slf 'color] " [clr/color: " bgclr " ] show clr] " slf "/color: " bgclr " show " slf " "]
                ] 
.font-size?: font-size?: does [if none != font-size= [append face-styles to-string reduce [
" foreach fnt " to-path reduce [slf 'pane] { [ if error? try [fnt-style: to-word fnt/effect/draw/font][][fnt-style: font_] }
join fnt-style font-size= {: make face/font any [attempt [font_]attempt[b.]] fnt/effect/draw/font: } join fnt-style font-size= " "
join fnt-style font-size= {/size: } 
font-size= " show fnt ]" ] ]
] 
.font-style?: font-style?: does [if font-style= [append face-styles to-string reduce [" foreach fnt " to-path reduce [slf 'pane] " [fnt-style: font_ *fnt: fnt/effect/draw replace *fnt select *fnt fnt-style/style " font-style= " show fnt ]"]]font_/style: none]         
    
.width?: width?: does [attempt [append face-styles to-string reduce [" " width=: to-path reduce [slf 'size 'x] ": " face-x/x: any [face-x width=] " show " slf " "]]]           
            `


            
select-this: func [this-token][
            do select tag-tokens reduce this-token
            ]

              
tag-tokens: to-hash [
            body [bgclr: clr: none clear-colors in-parent?: false][{ backcolor } bkclr { backdrop } imgurl " effect [merge] " {below across } ]
            /body [][{}]
            div [parent-sz: div-x: face-x div_clr  div_clr: clr div_bgclr: bgclr divs: divs + 1][{ below across space 10 }]
            /div [face-x: div_clr: div_bgclr: none ][{ close. } div-x " " div_bgclr { edge [] below }] 
            area [ar-x: any [face-x 100x50]][{ below across area #text } ar-x " "]
            /area [ar-x: face-x: none][{ close. } bgclr " "]
            textarea [ar-x: any [face-x 100x50]][{ below across area #text } ar-x " "]
            /textarea [ar-x: face-x: none][]
            p [parent-sz: para-x: face-x p_bgclr: bgclr p_clr: clr append main { below across } prg: prg + 1][{ below across } ]
            /p [p_bgclr: p_clr: face-x: none border?][{ close. } para-x " " p_bgclr { edge [] }]
            li [face-x: any [size= none] li_clr: any [clr ul_clr] li_bgclr: any [bgclr ul_bgclr txt-clr] lst: lst + 1][{ space 0 across box 16x20 } li_bgclr { effect [draw [fill-pen } li_clr { pen } li_clr { circle 3x8 2]] }]
            /li [face-x: li_clr: li_bgclr: bgclr: clr: none ][{ close. below across }]  
            ul [in-parent?: false ul_bgclr: bgclr ul_clr: clr bgclr: clr: none ul: ul + 1][" across "]
            /ul [ul_bgclr: ul_clr: bgclr: clr: none clear-colors][{ close. }] 
            tbody [tbl: tbl + 1][]
            /tbody [][{}]
            /table [parent-sz: tbl-x: tb_clr: tb_bgclr: none][{ close. }  " " tb_bgclr " edge [] "]
            table [parent-sz: tbl-x: face-x face-x: none get-colors tb_clr: clr tb_bgclr: bgclr tbl: tbl + 1][{ guide }]
            td [parent-sz: tdx: any [face-x tbl-x] td_bgclr: bgclr td_clr: clr get-colors tds: tds + 1][{ across }]
            /td [td_bgclr: td_clr: parent-sz: tdx: none][{] } tdx " " td_bgclr { edge [color: silver size: 1x1 effect [ibezel]] }]
            tr [tr_bgclr: bgclr tr_clr: clr get-colors][{ across space 0 }]
            /tr [tdx: tb_clr: td_clr: tr_clr: clr: none][{ return }]
            b [to-font 'b. get-colors b_bgclr: bgclr b_clr: clr][face-node: { space 0 box #bgclr #string-size effect [draw [pen #clr font #font text #text ]] }]
            i [to-font 'i. get-colors i_bgclr: bgclr i_clr: clr][face-node: { space 0 box #bgclr #string-size effect [draw [pen #clr font #font text #text ]] }]
            a [to-font 'u. get-colors attempt [go-here: to-url styles/href=]][]
            /b [remove-font 'b. b_clr: b_bgclr: none][]
            /i [remove-font 'i. i_clr: i_bgclr: none][]
            /a [remove-font 'u. remove-style ][{ [attempt [markup: read } go-here { update clear Dialect html/text: } go-here { show html] ] }]
            font [f_bgclr: bgclr f_clr: clr get-colors][{ space 0 box #bgclr #string-size effect [draw [pen #clr font #font text #text ]] }]
            /font [f_clr: f_bgclr: none remove-style][{ }]
            span [f_clr: any [clr txt-clr]bgclr: any [bgclr bkclr]][{ space 0x20 box #bgclr #string-size effect [draw [pen #clr font #font text #text ]] }]
            /span [face-x: f_clr: f_bgclr: none remove-style][]
            br [face-x: none clear styles clear-colors ][{ below across }]
            button [btn-sz: size= btn: btn + 1][{ button } btn-sz " " value= " font-color " clr " " bgclr " [" onclick= "] "]
            btn [ btn-sz: size= btn: btn + 1][{ btn } btn-sz " " value= " font-color " clr " " bgclr " [" onclick= "] "]
            text [txt-sz: size= fld: fld + 1][{ field } value= { edge [size: 1] effect [draw [pen silver line-width 1 box ]]  font-color } clr " "]
            field [fld: fld + 1][{ field } value= { edge [size: 1] effect [draw [pen silver line-width 1 box ]]  font-color } clr " "]
            search [btn-sz: size= ][{ field } value= " " btn-sz " edge [size: 1] effect [draw [pen silver line-width 1 box ]]  font-color " clr " "]
            select [btn-sz: size= in-parent?: false][{ choice }]
            submit [btn-sz: size= btn: btn + 1][{ button } btn-sz " " value= " " clr " [" onclick= "] "]
            password [btn-sz: size= fld: fld + 1][{ field } value= " " btn-sz " edge [size: 1] effect [draw [pen silver line-width 1 box ]]  font-color " clr " "]
            option [][{ #text }]
            /option [][]       
            hidden [hdn: hdn + 1][""]
            input [size=: any [size= []] fld: fld + 1]['field " " value= { font-color } clr " " ]
            check [chk: chk + 1][{ space 12 check }]                       
            checkbox [chk: chk + 1][{ space 12 check }]                       
            radio [rdo: rdo + 1][{ radio space 12 } ]
            H1 [in-parent?: false hd: hd + 1][{ below text }]
            H2 [in-parent?: false hd: hd + 1][{ below text }]
            H3 [in-parent?: false hd: hd + 1][{ below H2 }]
            H4 [in-parent?: false hd: hd + 1][{ below H3 }]
            H5 [in-parent?: false hd: hd + 1][{ below H4 }]
            H6 [in-parent?: false hd: hd + 1]{ below text }
            /H1 [ remove-style]{ font-size 32 below across }
            /H2 [ remove-style]{ font-size 24 below across }
            /H3 [ remove-style]{ below across }
            /H4 [ remove-style]{ below across }
            /H5 [ remove-style]{ below across }
            /H6 [ remove-style]{ font-size 10 below across }
            hr [ hrl: hrl + 1][{ panel [ box } clr " " (as-pair hr-x - .5 1) { bevel 2 pad 0x-11 box } bgclr " " (as-pair hr-x - .5 2){] below across }]
            /hr [in-parent?: false ][{ close. below across } ]
            strong [to-font 'b. get-colors b_clr: clr b_bgclr: bgclr][{ space 0 box #bgclr #string-size effect [draw [pen #clr font #font text #text ]] }]
            /strong [remove-font 'b. b_clr: b_bgclr: none][]
            img [img: img + 1][{ image } img-url " " face-x " "]
            newline [""][{ below across }]
            style-obj-chars ["<" "" {style="} " " {style=} " " " : " { "} ": " { "} ":" {*"} " " {__} {=""} { " " }  "=" {*"} ";" {"*} {""} {"} { "} {"} {*"} { "} {"*} {" } " >" "" ">" "" "rgb" "" {__"} {"} {" "} {"} "," "."]
            elemt-chars ["{" "}" {"} "(" ")" "/" "." "[" "]" "," ":" ";" "," "="]
            obj-chars [":" " " ";" " " "," " " "=" " "]
            ]


parse-html: func [Dialect][
    markup-DTD Dialect
    bkclr: none 
    return-parent-width: does [
    these-children: copy children 
    replace/all replace/all children "^/" "" <newline> " "
    replace/all Dialect "> " ">"
    in-parent-node: load/markup children str-sz: 0
    foreach txt-node in-parent-node [
    if string! = type? txt-node [str-sz: str-sz + string-size? txt-node
    replace in-parent-node txt-node txt-node*: parse txt-node " "  
    ]
    ]if str-sz = 0 [parent-width: 615]
    quote-node-attributes   
    create-tag-element with-these-attributes 
    parent-width: get-size select in-attribute-blk 'width 
    if parent-width = 0 [switch node-name [
                                         "div" [parent-width: 800]  
                                         "p" [parent-width: 800]
                                         "p" [parent-width: 800]
                                         "td" [replace/all in-parent-node "<br" "<span " parent-width: str-sz]
                                         "li" [parent-width: 800]
                                         ]
                                         if parent-width = 0 [parent-width: 800]
    
    ]
    replace Dialect in-node-element data-node 
        
txt-sz: 0        
foreach child-element in-parent-node [ 
        with-these-children: [] each-node: type? child-element 
        either string! = each-node [string-size? child-element face-x: face-x + 9 
        txt-sz: txt-sz + face-x
        either txt-sz <= parent-width [append with-these-children child-element][
        txt-sz: face-x append with-these-children reduce [<newline> child-element]] 
        ][append with-these-children child-element if find child-element "br" [txt-sz: 0]]
]       
        size-x: txt-sz: 0 
        replace Dialect these-children form with-these-children

        ;replace/all replace/all Dialect "<<" "<" ">>" ">"
]
replace/all Dialect "> " ">"

    
validate-or-remove: func [with-end-tag][
                         
                        either none = children [replace Dialect in-node-element " "][
                        if children [if not find children with-end-tag [replace Dialect children children: join children with-end-tag
                         ] if </td> != end-tag [attempt [return-parent-width]]]
                        ]
]



in?: ["<div" | "</div" | </body>]

parse/all Dialect [any[
        [to "<div" copy in-node-element thru ">" 
        copy children [to "<div" | to </body>]
        (validate-or-remove end-tag: </div>)
        ]|      
        [to "<div" copy in-node-element thru ">" 
        copy children thru </div>
        (validate-or-remove end-tag: </div>)
        ]| 
        [to "<div" copy bad-node-element thru ">" 
        copy children [any in?] 
        (if none != children [replace Dialect bad-node-element ""])
        ]
        ]skip       
]

in-node?: []
in-node?: [ "<table" | "</table" | "</body"]        
        

parse/all Dialect [any[
        [to "<table" copy in-node-element thru ">"
        copy children to "<table" 
        (validate-or-remove end-tag: </table>)
        ]|
        [to "<table" copy in-node-element thru ">"
        copy children thru </table> 
        (validate-or-remove end-tag: </table>)
        ]
        ]skip   
]   
        
parse/all Dialect [some[to
        "<table" copy bad-node-element thru ">"
        copy children any in-node? 
        (if none != children [replace Dialect bad-node-element ""])
        ]skip   
]

insert replace in?: copy in-parent_elem-type! [| "<ul" | "<li"] [] 'to

        parse/all Dialect [some[
        to "<ul" copy in-node-element thru ">"  
        copy children [thru "</ul>" | to "<ul" | in? | to "<br" | to "</body>"] 
        (validate-or-remove </ul> end-tag: </ul>)
        ]skip
]       

parse/all Dialect [some[to
        "<tr" thru ">"
        copy children thru "</td>" copy ending to "<tr"
        (append children ending validate-or-remove end-tag: </tr>)
        ]skip   
]


    
 
in-node?: [] append append insert in-node? in-parent_elem-type! [| "<h" | "</" |] out-parent_elem-type!
in?: [] append append insert in? [to] in-node? [| "<fieldset"] replace/all in? [|] [| to] 

replace/all Dialect "<p><p" "<p"

parse/all Dialect [some[to 
        "<p" copy bad-node-element thru ">" 
        copy invalid-node [any in-node?]
        (if invalid-node [replace Dialect bad-node-element ""])
        ]skip       
]
            
parse Dialect [some[to                  
        "<p" copy in-node-element thru ">" 
        copy children to "<p" 
        (validate-or-remove end-tag: </p>)        
        ]skip         
]       
    
parse Dialect [some[to                  
        "<p" copy in-node-element thru ">" 
        copy children thru </p>  
        (validate-or-remove end-tag: </p>)        
        ]skip         
]           
    
    
parse/all Dialect [any[to 
        "<li " copy in-node-element thru ">" 
        copy children thru "</li>" 
        (validate-or-remove end-tag: </li>)
        ]skip
]

parse/all Dialect [some[to 
        "<li" copy in-node-element thru ">" 
        copy children [thru "</li>" | "<li>" |"</UL>"] 
        (validate-or-remove end-tag: </li>)
        ]skip
]



parse/all Dialect [any[
        [to "<td" copy bad-node-element thru ">"
        copy children any ["</" | "<td" | "<table" | "<div"] 
        (if none != children [replace Dialect bad-node-element ""])
        ]|
        [to "<td" copy in-node-element  thru ">"
        copy children to "<td" 
        (replace children "<br" "<span" validate-or-remove end-tag: </td>)
        ]|
        ["<td" copy in-node-element  thru ">"
        copy children [thru "</td>" | [any "</tr" | "<tr" | "<table"]]
        (replace children "<br" "<span" validate-or-remove end-tag: </td>)
        ]
        ]skip   
]

    
{parse/all Dialect [some[to 
        "<a " copy element thru ">" 
        (this: copy element 
        foreach [a b][
            "?" {" } "-" "_" "=" {="} "&" { " } "+" "_" "%25" "_" ">" {">} {" ">}  {">} {""} {"}][replace/all this a b
            ]
    replace Dialect element this)
        ]skip   
]}
    
]

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! ["<div" | "<p" | "<table" | "<ul" | "<li" | "<td" | "<area"]
out-parent_elem-type!: make hash! ["</div" | "</p" | "</table" | "</ul" | "</li" | "</td" | "</area"]
in-style_elem-type!: make hash! ["body" "tbody" "h1" "h2" "h3" "h4" "h5" "h6" "strong" "br" "span" "tr" "a" "font" "b" "i" "newline" "option"]
out-style_elem-type!: make hash! ["/h1" "/h2" "/h3" "/h4" "/h5" "/h6" "/strong" "/body" "/tbody" "/span" "/tr" "/a" "/font" "/b" "/i"]
input_elem-type!: make hash! ["button" | "input" | "img" | "hr" | "select"]
as-block_elem-type!: make hash! [ "address"  "article"  "aside"  "blockquote"  "canvas"  "dd"  "div"  "dl"  "dt"  
 "fieldset"  "figcaption"  "figure"  "footer"  "form" "h1" "h2" "h3" "h4" "h5" "h6"   
 "header"  "hr"  "li"  "main"  "nav"  "noscript"  "ol"  "p"  "pre"  "section"  
 "table"  "tfoot"  "ul"  "video"]

input-as: func [DSL Dialect][
    ;replace/all Dialect #"^/" "" 
    replace/all Dialect { <} "<"
    replace/all Dialect {> } ">"
    
    switch DSL [html [markup-DOM Dialect parse-html markup layout-html markup
                      replace html-markup? "}" "}]"
                      markup-DOM load join "[" html-markup?] clear html-markup?
                     ]
]

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

 input-as 'html markup
    replace/all main "none" ""
    replace/all main "font #font" " "
            window: load main
            

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?: {}
close-parent: func [][close-parent: reduce first skip find tag-tokens end-tag-token?  2 
            insert tail main close-parent ]
            
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-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
]

        {face-text: foreach face p1/pane [either face/text [print face/text] [print face/effect/draw/text]]
         face-length: foreach face p1/pane [if face [faces: 0 do faces: faces + 1] ]
}


use*=*to-set-values: does [=: func [value][any [value]]]

document.: func [request-as][
        DOM: head DOM use*=*to-set-values styles: "" 
        any [equal? block! type? data-node data-node: node: reduce [to-block data-node]]
        either equal? tag! type? data-node/1 [node-element: data-node/1
        ][
        node-element: data-node/1: build-tag to-block first parent-node: data-node
        ]
        var .style: = node-element style: :array-obj! .style: :array-obj!
        return node-element
]
                
return-tag-node: does [=: :equal? 
        any [equal? block! type? data-node 
        data-node: node: reduce [to-block strip-obj-chars-from data-node]]
        any [equal? tag! type? node-element: data-node/1 attempt [
        replace/all node-element [=] [] 
        node-element: data-node/1: build-tag to-block node-element]
    ]
]
 
            
.style: []
equal?: :=
DOM: DSL: html: window: end-tag: ""
data-node: parent-node: node: none

.body: .hr: .p: .b: .i: .tr: .ul: .li: .area: .table: .td: .button: .input: .div: .font: .span: 0
node-obj: node-element: node-name: *name: use-methods: attr-name: attr-value: none

check: func [select-this][return first parse select-this none]
         
strip-chars-from: func [node-name][
            foreach char select tag-tokens 'elemt-chars [
            replace/all node-name char " "] 
]

strip-obj-chars-from: func [node-name][
            foreach [-char +char] select tag-tokens 'obj-chars [
            replace/all node-name -char +char]
]

getnodename: func [node-name][data-node: [""]
        DOM: head DOM =: :equal?
		either block! = type? node-name [
		insert/only data-node: [] node-name 
		any [attempt [node-element: data-node/1: build-tag data-node/1] node-element: data-node/1]
		][
		node-name: to block! strip-chars-from form node-name
		count: any [attempt [count: pick find node-name integer! 1]1]
		nodename: to-word join  "." array-obj!: node-name/1 
		any [repeat ? count [data-node: first DOM: next node: find DOM nodename]
		print reduce ["node-name:" mold form node-name/1 "not found"]
		]
		slf*: join node-name/1 count
		]
		if '= = first DOM [data-node: first next DOM]
		return either tag! = type? data-node/1 [node-element: data-node/1][format-this return-tag-node as-js-object!] 
]

setnodename: func [old-name new-name][
		any [equal? this-name: check strip-chars-from 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
			do compose/deep [attr-value: array-obj![(attr-name)]]
			print any [[attr-name attr-value] ["node-attribute:" mold form attr-name "not found"]
			]
] 

setattribute: func [attr-name new-attr][
            *key: *value: none 
            do compose/deep [.style[(form attr-name )]]
            any [
            if *value [replace node-element attr-name new-attr]
            array-obj![repend [" " new-attr {="undefined"}]""]
            print ["Must get a parent-node with this attribute: " attr-name]]
			get-attributes node-element attempt [set-attributes]
            ]		

setattributevalue: func [attr-name attr-value][
            any [
            if find node-element key: form attr-name [
			do compose/deep [.style[(key)] `= (attr-value)]]	
			array-obj![repend [" " attr-name {="}attr-value {"}]""]
			print ["Must get a parent-node with this attribute: " attr-name]] 
			get-attributes node-element attempt [set-attributes]
]

getElementByTagName: func [Tag-Name selection [block!]][
            dom: head dom 
            repeat this first selection [
            node-element: first data-node: first dom: next find dom to-word join "." Tag-Name]
            if [use-methods and not find node-element " ."][use-attr-as-methods yes]
            use-methods: off        
]

look-deep-for: func [this in-node][
			foreach in-child-node in-node [
			if find/any mold node-element: in-child-node this [return node-element break]
			]
]

getElementById: func [my-id][in-child-node: none 
			id: copy join "id*" form my-id =: :equal?
			foreach in-parent-node dom [
		if block! = type? in-parent-node [any [look-deep-for id in-parent-node
			foreach in-sibling in-parent-node [
		if block! = type? in-sibling [look-deep-for id in-sibling 
			]]]]]
]

querySelecter: func [css-Selecter][in-child-node: none 
			id: rejoin [css-Selecter "*="] =: :equal?
			foreach in-parent-node dom [
		if block! = type? in-parent-node [any [look-deep-for id in-parent-node
			foreach in-sibling in-parent-node [
		if block! = type? in-sibling [look-deep-for id in-sibling 
			]]]]]
]

.innerHTML: func [element][
			children: copy/part next data-node find/last data-node tag!
			either equal? tag! type? node-element [
			any [empty? element replace data-node children element]
			][print "The node-element has no innerHTML"]
]
			
use*=*to-set-values: does [=: func [value][any [value]]]

use-attr-as-methods: func [maybe [logic!]][
			if maybe [foreach [-char +char][{" } {" .} ".." "."][replace/all node-element -char +char]
			]
			replace node-element " " " ."
			use-methods: yes
]

node-list: []

*!: func [var][set to-word check form node-element none set to-set-word form var :array-obj!]

var: func [var-data][node-element:  variable: "" node-name: :variable
			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 variable: to-string variable
			any [
			not empty? node-element any [find node-list variable append node-list reduce 
            [variable node-element: any [attempt [do :variable] " "]]]] 
            any [equal? tag! type? node-element append node-list reduce [form variable node-element]] 
            set to-word variable array-obj!: func [key ] node: compose/deep copy get-array-obj!
			attempt [if not find variable "." [do load to-string reduce ["set " #"'" variable ". :array-obj!"]]]
			use-methods: off
]

.: func [value][ do compose/deep reduce [*value reduce [(value)]]]

get-array-obj!: [
			if not equal? tag! type? node-element [node-element: select node-list  
            (form variable) ] 
			if inline: find/any node-element { style*=*"} [
			replace node-element inline replace inline {"} " "]
			any [
            if empty? form key [ 
            return any [
            if equal? tag! type? node-element [node-element]
			attempt [trim next find/tail node-element first parse node-element ":= ,"]
            next node-element]
            ]
			any [
			if find ["url!" "email!"] mold type? key [ 
			replace/all key "@" ":" from-method: parse/all key "." 
			*value: load first next find parse mold node-element "[]{}`;=" from-method/1
			remove from-method
			foreach element from-method [. load element]
			]			
			attempt [*value: load select parse strip-obj-chars-from copy node-element "[]{}`:;= " *key: form key]
			attempt [*value: select node-element *key: load key] 
			]
            attempt [do head insert next copy key [node-element join]] 
            attempt [do form key] 
			if not find node-element key [none]] ;[print [*key "called"]]
]

`=: func[attr-value][
			any [
			attempt [replace node-element *value do reform load attr-value]
			replace node-element form *value form attr-value
			replace node-element mold form *value mold attr-value
			]
]  

node-element: *node-name: *name: array-obj!: key: *key: *value: ""
            
markup-DOM: func [Dialect][
use-methods: no
			either find Dialect [rebol-DOM: [{DSL-type="html/block" type="text/html"}]] [DOM: copy/deep Dialect]
			[insert Dialect [rebol-DOM: [{DSL-type="html/block" type="text/html"}]]
			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  
			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 </body> "" </body>
        markup: any [find markup "<body" markup]
		]
]           

old-mrkp: none

view-port: layout [ID: bck: backdrop 241.241.241
across at 0x0 
box black 805x40 
pad -805x10  
text 240x50 black "Click to load demo page" left font-size 12 241.241.241 effect [draw [pen black line-width 4.5
 fill-pen 241.241.241 box -3x-2 240x50 7]][editor/text: any [old-mrkp markup]
show html markup: editor/text 
clear face-styles
update
old-mrkp: copy markup
recycle/on recycle/off
]  pad -250x30 box 700x50 241.241.241
below across
pad -4x-56  
box 241.241.241 30x31 effect [draw[fill-pen 245.245.245 pen white circle 14x16 pen gray line-width 3 line 6x16 22x16 pen gray font back. text "<" 4x0]]
space 10
box 241.241.241 30x31 effect [draw[fill-pen 245.245.245 pen white circle 14x16 pen gray font back. text ">" 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] {<h6>404</h6>}]
     ]]
]
 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]
   gogo: does [document.(getnodename{p.1}).style[color]`= "yellow" setattributevalue 'bgcolor "Mediumvioletred"]

view-port/size: 805x800

view center-face view-port

foreach m dom [any [m != '.p first dom: next find dom m]]
document. getnodename{"div"[1]}getattribute "bgcolor"	
	
document. getnodename{("p")[3]}.style[width]`= "block-build"
	
	node-element

setattributevalue('height)"1000"
	
	node-element

    getattribute "height"

setnodename {hr[1]} "listview"
	node-element	
		
document. getnodename{("p")[1]}.style[bgcolor]`= "block-build"
	
	setattribute('bgcolor)"whithouse"
	
	node-element	
	setattributevalue("boogies")"green-color"
	 
node-element	
	data-node: do to-path [DOM .p .b] 

document.(data-node).style[color]`= "bluberry" 

	setattribute('i-style) "silly" 
node-element


;foreach m dom [any [m != '.p probe first dom: next find dom m]]
Notes