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

Archive version of: rebol-dom-mdlparser ... version: 26 ... inetw3dm 14-Jan

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. This is the somewhat weekly build version}
        ]

library: [
        author: daniel murrill
        level: 'intermediate
        platform: 'all
        type: 'progressive-build
        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" height="50" 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:[
"&" "&" 
"<" "<" 
">" ">" 
""" {"} 
"ä" "ä" 
"Ä" "Ä" 
"ö" "ö" 
"Ö" "Ö" 
"ü" "ü"
"Ü" "Ü" 
"ß" "ß" 
]

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 to-string this-color [(baseclr: "") to "#"
	copy baseclr to end]  
	this-color?: txt-clr
	either find baseclr "#" [remove baseclr get-color][this-color: any [attempt [to-tuple this-color]txt-clr]]
]
   
bgcolor=: func [this-color][
	parse to-string this-color [(baseclr: "") to "#"
	copy baseclr to end] 
	this-color?: bkclr
	either find baseclr "#" [remove baseclr get-color][this-color:  any [attempt [to-tuple this-color]bgclr]]
]

remove-tail-char?: func [in-node element][; =: :equal?
				   foreach char element [
                   if char = back tail to string! in-node[
                   remove back tail in-node]
				   ]
]

remove-head-char?: func [in-node element][; =: :equal?
                  type: type? in-node 
                  foreach char element [
                  all [char = any [first to-string in-node form first in-node]
				  to type trim to-string any [attempt [remove in-node] remove form in-node]]
				  ]	  
]

quote-node-attributes: does [with-these-attributes: copy ""
 
remove-tail-char? in-node-element "/"

this-node: find/match in-node-element node-name: first parse/all in-node-element { =">}
replace/all in-node-element {:"} {"}
			
if find/any this-node " style=" [	
	parse/all this-node [[to {style="} | to "style="]  copy style-obj [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 style-obj: *style.node: none
	)]
	]
	replace node-name "<" ""	
	;replace/all this-node {=""} {=null}
	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 part {,} " "
							replace/all part {__} " " 
							replace/all part "&&" "://"	
							replace part {=null} {=""}
							replace part  "^/" " "
							append with-these-attributes mold part  
							] 
]
 
create-tag-element: func [these-attr][
			replace/all 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 node-name]
			data-node: build-tag in-attribute-blk with-these-attributes: none 
]

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: ""
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-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 [":" " " ";" " " "," " " "=" " "]
            ]
free-up: func [this-data][do this-data]
parent-width: 0
parse-html: func [Dialect][
	markup-DTD Dialect
	bkclr: none 
	return-parent-width: func [children][in-parent-node: none
	these-children: children 
	replace/all replace/all children "^/" "" <newline> " "
	replace/all Dialect "> " ">" 
	in-parent-node: load/markup children str-sz: 0 
	free-up [foreach txt-node in-parent-node [replace/all txt-node "  " " "
	if all [not empty? txt-node string! = type? txt-node find txt-node " "][str-sz: str-sz + string-size? txt-node
	replace in-parent-node txt-node to-block rejoin [{"}strip-obj-chars-from txt-node [" " {" "}]{"}] ] text-face: none]
	free-up 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: 650]	
										 "p" [parent-width: 650]
										 "p" [parent-width: 650]
										 "td" [replace/all in-parent-node "<br" "<span " parent-width: str-sz]
										 "li" [parent-width: str-sz]
										 ]if [parent-width > 650 or parent-width = 0][parent-width: 650]
	
	]
    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 text-face: none
        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 children ]]] 
                        ]
]



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

parse/all Dialect [any[
        [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: </td>)
        ]|
        [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: </td>)
        ]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: </td>)        
        ]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: text-face: 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
                      Dialect: none 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
doc: dom: dialect: editor/text: window: img-url: node-name: page/pane: none 
clear main 
clear face-styles
clear-colors
view/new view-port
 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?: img-url: 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
]

       
document.: func [request-as][
        DOM: head DOM use*=*to-set-values 
        any [ 
        all [not empty? data-node equal? block! type? data-node] insert data-node: [] 
        any [attempt [strip-obj-chars-from request-as] request-as]]
        any [equal? tag! type? node-element: data-node/1
        attempt [node-element: build-tag to-block data-node/1]]
        var .style: = node-element style: *![.style]
                return node-element
]
                
return-tag-node: does [=: :equal? 
        node: either any [attempt [empty? node-name] none = node-name]
        [either any [attempt [empty? node-element] none = node-element]
        [data-node][node-element]][node-name]  
        any [
        equal? tag! type? node-element: node
        attempt [node-element: data-node/1: build-tag 
        reduce to-block strip-obj-chars-from  node]
        set 'node-element node] return 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 trim strip-chars-from form select-this " "]

strip-chars-from: func [node-name][
        foreach char elemt-chars: 
		["<" ">" "{" "}" "(" ")" {"} "/" "." "[" "]" "," ":" ";" "," "="][
        replace/all node-name char " "
        ]   
]

obj-chars: none
strip-obj-chars-from: func [node-name obj-chars][
        trim form node-name if equal? #"^"" node-name/1 [remove node-name]
        foreach [-char +char] obj-chars: any [reduce obj-chars [#"^/" " " 
		"  " " " {" , "} {" } {", "} {" } "," " " {" "} {" } {" : "} {: "}
		{":"} {: "} {":} {:} { " } "" {"[["} {"[[" "} "{" "[" "}" "]" {""}
		{"} {  "} "" " : " ": " ":" " " { =} {=} {=} " " "'" "" "#" " " "'" {"}]
		][
        replace/all node-name -char +char
        ]
]

getnodename: func [node-name][data-node: []
        DOM: head DOM =: :equal?
        either block! = type? node-name [return-tag-node][
        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 [attempt [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 " " = 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 return-tag-node] 
]

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
            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 var node-element *![.style] 
            do compose/deep [.style[(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][
            var node-element *![.style]
            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 all [equal? true use-methods 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 all [tag! = type? child: in-child-node find/any child this][print node-element: child] 
            if block! = type? in-child-node [look-deep-for this in-child-node]
            ]
]
            
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 [look-deep-for id in-parent-node
            ]]
]

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


.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 false != maybe [foreach [-char +char][{" } {" .} ".." "."][replace/all node-element -char +char]
            ]
            replace node-element " " " ."
            use-methods: no
]

node-list: []

*!: func [var][=: :equal? set to-set-word node-name set to-set-word form var :array-obj!]

var: func [var-data][node-element:  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 node-name: variable: to-string variable
            either empty? node-element [any [find node-list variable append node-list reduce 
            [variable node-element: any [attempt [do :variable] " "]]]] 
            [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
]

return.: func [value][
                *value: load value 
                        foreach a *value [if not equal? word! type? a [do *value: a ]]
]

.: func [value][either equal? block! type? *value [
                        any [
                        attempt [*value: to-block select parse node-element: find node-element 
                        form value "<{} =`;,#>" form value] *value: load value] 
                        ][ do compose/deep reduce [*value [(load value)]]]
                        ]
]

get-array-obj!: [
			node-element: select node-list (form variable) 
			|: :array-obj!
			all [
			not find node-element {='} inline: find/any node-element {style*=} 
			replace node-element inline replace/all loop 2[replace inline {"} "'"] "  " ":"] 
            if not find form node-element "1:" [all [(length? parse form node-element ":= ,") < 2 
			insert node-element [#1:]]]
			any [
            if empty? form key [
            return any [
            if equal? tag! type? node-element [node-element]
			attempt [next next find/tail head node-element first parse node-element ":= ,"]
            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 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: value: none  *key: *value: 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 "." "/." "/"]
			foreach [-char +char][":" ":." "@" ":" ".." "."][replace/all key -char +char]
			replace/all from-method: parse key ".:" [""] []
			*value: from-method/1
			foreach key from-method [any [*value: | to-block key . to-block key]]
			]
			any [
			attempt [*value: load select/case parse strip-obj-chars-from copy node-element none "<{} =`,#>" 
			*key: trim head trim tail form key]
			attempt [*value: select/case load strip-obj-chars-from mold to-block node-element none 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: none]] ;[print [*key "called"]]
			
]

`=: func[attr-value][
            any [
            attempt [replace node-element *value *value: 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] 
            ] node-element: head node-element
]  

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  
            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
            ]
]   
             
    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
Notes