Archive version of: rebol-dom.r ... version: 2 ... inetw3dm 2-Nov-2020

Amendment note: Added library header. || Publicly available? Yes

REBOL [
    	File: %rebol-dom.r
    	Date: 02-11-2020
    	Title: "Dialect Object Model"
        Emai: inetw3.dm@gmail.com
    	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}
    	]

library: [
        level: 'intermediate
        platform: 'all
        type: Dialect
        domain: [html vid css json js array]
        tested-under: 'windows
        support: none
        license: none
        see-also: %HTML-view.r
    ]

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