View documentation | View discussion [638 posts] | View script | License |
Download script | History | Other scripts by: inetw3dm |
30-Apr 16:33 UTC
[0.157] 19.805k
[0.157] 19.805k
Archive version of: rebol-dom.r ... version: 1 ... inetw3dm 2-Nov-2020Amendment note: new script || Publicly available? Yes REBOL [ File: %rebol-dom.r Date: 02-11-2020 Title: "Dialect Object Model" Purpose: { Use a recodable rebol function to create easy to follow blocks/series as a Dialect Object Model that allow different program languages to work together and viewed as HTML and VID. A parse alternative} ] my-dialect: [body: [{background-color="blue" text "white"} ] p: [ {color="#0000ff" bgcolor="yellow" width="399" height="100" font-style "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: [ {color = "green"} VID' or plain old rebol ] ] if you like. ] {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: brown; 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. ] ] ] use*=*to-set-values: does [=: func [value][any [value]]] document.: func [request-as][ attempt [ DOM: head DOM if block! != type? data-node [this: copy data-node insert data-node: [] this] if data-node/1 [ data: type? data-node/1 replace/all data-node/1 "=" " " either equal? data tag! [node-element: data-node/1: style: .style: to-block first parent-node: data-node use*=*to-set-values styles: "" ] [node-element: data-node/1: build-tag to-block first parent-node: data-node] ] ] ] return-tag-node: does [=: :equal? if block! != type? data-node [this: copy data-node insert data-node: [] this] if type? block! = node-element: data-node/1 [ replace/all node-element [=] [] node-element: data-node/1: build-tag to-block node-element ] ] .style: [] equal?: := html: window: end-tag: "" data-node: parent-node: node: none .body: .hr: .p: .b: .i: .tr: .ul: .li: .table: .td: .button: .input: .div: .font: .span: 0 node-obj: node-element: node-name: *name: attr-name: attr-value: none check: func [select-this][node-name: select-this any [ if block! = type? select-this [ select-this: first parse/all node-name " "] if string! = type? select-this [select-this: first parse/all node-name " "] if tag! = type? select-this [select-this: first parse/all node-name " "] ] ] strip-chars: func [node-name][ foreach [char] ["{" "}" {"} "(" ")" "/" "." "[" "]" "," ":" ";" "," "="][ replace/all node-name char " " ] ] getnodename: func [node-name][count: [] my-dialect: head my-dialect =: :equal? either block! = type? node-name [data-node: :node-name if error? try [ node-element: data-node/1: build-tag data-node/1][ node-element: data-node/1] ][ node-name: to block! strip-chars form node-name if error? try [count: pick find node-name integer! 1][count: 1] if error? try [nodename: to-word join "." node-name/1 repeat ? count [data-node: first my-dialect: next node: find my-dialect nodename indx: index? data-node] return-tag-node ][print reduce ["node-name:" mold form node-name/1 "not found"] node-element: none ] slf: join node-name/1 count ] ] setnodename: func [old-name new-name][ this-name: check strip-chars old-name node-element-name: check node-element same: this-name = node-element-name if false = same [getnodename old-name] if not find node-element new-name [ 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-name: trim/all form attr-name this-attr: to-block find/any node-element join attr-name "?" either this-attr [print reduce [attr-name attr-value: mold form this-attr/2] ][print reduce ["node-attribute:" mold form attr-name "not found"] ] ] setattribute: func [attr-name new-attr][return-tag-node either attempt [find/any node-element to-string reduce [attr-name "="]] [ replace node-element attr-name new-attr ;get-attributes node-element attempt [set-attributes] ][ either node-element [insert tail node-element reduce [" " new-attr {="null"}] ][ print reduce ["Must get a parent-node with this attribute: " attr-name] ] ] ] setattributevalue: func [attr-name attr-value][return-tag-node either find/any node-element any [to-string reduce [attr-name "="] form attr-name] [ document.(window) any [attempt [.style/:attr-name: = attr-value] attempt [.style/(to-word join "." :attr-name): attr-value]] return-tag-node ;get-attributes node-element attempt [set-attributes] ][ either node-element [insert tail node-element reduce [" " attr-name {="} attr-value {"}] ;get-attributes node-element attempt [set-attributes] ][ print reduce ["Must get a parent-node with this attribute: " attr-name] ] ] ] markup-DOM: func [DSL][DOM: DSL either block! = type? DSL [ get-data: func [data][ find-end-tag: find data get-word! either find-end-tag [ replace data first find-end-tag to-tag mold to-refinement first find-end-tag][insert tail data to-tag join "/" any [*name *node-name] ] repeat in-data data [cnt: 0 if set-word! = type? in-data [*node-name: copy form in-data replace data in-data node-name: to-word join "." *node-name ] if string! = type? in-data [ replace/all in-data "=" " " insert in-data next reform [node-name " "] child: build-tag to-block in-data ;foreach [a b][" " " ."][replace/all child a b] replace data in-data child ] if block! = type? in-data [ set to-word join *node-name cnt: cnt + 1 in-data get-next in-data ] ] ] get-next: func [in-data][ repeat data in-data [ if set-word! = type? data [*name: copy form data replace in-data data node-name: to-word join "." *name ] if string! = type? data [ replace/all data "=" " " insert data next reform [node-name " "] child: build-tag to-block data ;foreach [a b][" " " ."][replace/all child a b] replace in-data data child ] if block! = type? data [get-data data set to-word *node-name data] ] find-end-tag: find in-data get-word! either find-end-tag[ replace in-data first find-end-tag to-tag mold to-refinement first find-end-tag][insert tail in-data to-tag join "/" any [*node-name *name] clear *node-name] ] repeat data-node DSL [ if set-word! = type? data-node [*name: copy form data-node replace DSL data-node node-name: to-word join "." *name ] if string! = type? data-node [ replace/all data-node "=" " " insert data-node next reform [*name " "] child: build-tag to-block data-node ;foreach [a b][" " " ."][replace/all child a b] replace DSL data-node child ] if block! = type? data-node [ get-data data-node this: to-word rejoin [name: join '. *name num: set to-word :name to-integer first reduce [1 + do :name]] getnodename to-block reduce [*name num] =: :equal? set this data-node ] if get-word! = type? data-node [ replace DSL data-node to-tag mold to-refinement *name] ] ][ alert "Need a Dialect Object Model as type! block" ] ] return-html-dom: does [ html: copy form any [find head my-dialect "<body" head my-dialect] replace/all replace/all html "<." "<" "' " ", " replace/all replace/all html "{" "<" "}" ">" foreach n-name [ "[" "]" ".body " ".hr " ".p " ".b " ".i " ".? " ".tr " ".table " ".td " ".button " ".input " ".div " ".ul " ".li " ".font " ".span " ".img " ".a " ".strong " " ." ][replace/all html n-name " " ] append replace/all html </body> "" </body> html: any [find html "<body" html] ] markup-DOM my-dialect getnodename {"b"[1]}getattribute "color" node-element document.(getnodename{("p")[2]}).style/width: = "block-build"setattributevalue('height)"1000" node-element getattribute "height" setnodename {b[1]} "listview" node-element document.(getnodename{("p")[1]}).style/font-style: = "block-build" setattribute('font-style)"whithouse" setattributevalue('boogies)"green-color" data-node: do to-path [DOM .p .b .i] document.(data-node).style/color: = "purple" setattribute('i-style) "silly" data-node probe return-html-dom Notes
|