Script Library: 1238 scripts
 

rebol-dom-mdlparser

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:[ "&" "&" "<" "<" ">" ">" """ {"} "ä" "ä" "Ä" "Ä" "ö" "ö" "Ö" "Ö" "ü" "ü" "Ü" "Ü" "ß" "ß" ] 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][ if element = attempt [back tail form to-block in-node ][remove back tail in-node] ] remove-head-char?: func [in-node element][ type: type? in-node if element = any [first form first in-node first form in-node][ in-node: to type remove any [attempt [to-tag in-node] form in-node]] ] 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 ] 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 " " ] ] strip-obj-chars-from: func [node-name][ trim node-name if equal? #"^"" node-name/1 [remove node-name] foreach [-char +char] 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!: [ if not equal? tag! type? node-element [node-element: select node-list (form variable) ] all [inline: find/any node-element { style*=*"} replace node-element inline replace/all replace replace inline {"} "{" {"} "}" " " ": "] any [1 <> length? parse form node-element ":= ," insert node-element [#1:]] any [ if empty? form key [ return any [ if equal? tag! type? node-element [node-element] attempt [trim next find/tail head node-element first parse node-element ":= ,"] next node-element]*key: key: *value: value: none ] if all [*key: first to-block key not find node-element rejoin [" " *key " "] equal? integer! type? *key][ remove value: any [attempt [parse node-element "<=;,`# []>"] parse mold node-element "<=;,`# []>"] keys: length? value if odd? length? value [remove value] any [equal? 1 *key if equal? 2 *key [*key: *key + 1] *key: *key + 2] *value: select value *key: pick value *key print [" *key:" *key " *value: " *value] node-name: keys: 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/all replace/all to-string key "." "/." "/"] foreach [-char +char][":" ":." "@" ":." ".." "."][replace/all key -char +char] from-method: parse/all key "." attempt [*value: load first next find parse mold node-element "<{}=;,`#. []>" from-method/1 foreach element next from-method [array-obj! element]] ] any [ attempt [*value: load select parse strip-obj-chars-from mold load mold node-element "<{} =`,#>" *key: trim head trim tail form key] attempt [*value: select load strip-obj-chars-from mold to-block node-element key] ] attempt [do head append insert next copy key [node-element join] ""] attempt [do load key] if not find node-element key [*key: *value: 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 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]]
halt ;; to terminate script if DO'ne from webpage
Notes
  • rebol-dom-mdlparser has a discussion thread. Posts: 14. Most recent: 20-Sep
  • email address(es) have been munged to protect them from spam harvesters. If you are a Library member, you can log on and view this script without the munging.
  • (inetw3:dm:gmail:com)