View in color | View documentation | View discussion [3 posts] | License |
Download script | History | Other scripts by: inetw3dm |
25-Jan 16:29 UTC
[0.093] 22.422k
[0.093] 22.422k
rebol-dom.rREBOL [
File: %rebol-dom.r
Date: 02-11-2020
Title: "Dialect Object Model"
Emai: %inetw3--dm--gmail--com
author: daniel murrill
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' ]
]
lua-tbl = {[first] = "fred", [last] = "cougar"}
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-from: func [node-name][
foreach char elem-chars: ["{" "}" {"} "(" ")" "/" "." "[" "]" "," ":" ";" "," "="
] [
replace/all node-name char " "
]
]
strip-obj-chars-from: func [node-name][
trim node-name if #"^"" = node-name/1 [remove node-name]
foreach [-char +char] obj-chars: [
#"^/" " " "," "" {" : "} {: "} {":"} {: "} {":} {:} {" "} {" }
{ " } "" "[" "" "]" "" {""} {"} { "} "" ":" "" { =} {=} {=} " "
] [
replace/all node-name -char +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-from 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-from 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 [
strip-obj-chars-from 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 [
strip-obj-chars-from 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 with-this-data DSL [
if set-word! = type? with-this-data [*name: copy form with-this-data
replace DSL with-this-data node-name: to-word join "." *name
]
if word! = type? with-this-data [*names: copy form with-this-data
either *names = "=" [replace DSL with-this-data ""
][
replace DSL with-this-data node-name: to-word join "." with-this-data]
]
if string! = type? 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 created-data
;foreach [a b][" " " ."][replace/all child a b]
replace DSL with-this-data child
]
if block! = type? with-this-data [
get-data with-this-data
]
if get-word! = type? with-this-data [
replace DSL with-this-data to-tag mold to-refinement *name]
]
][
alert "Need a Dialect Object Model as type! block"
]
]
return-html-dsl: 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]
]
{
**************************************************************************************************
An example of how to use the DOM functions follows. The syntax hopefully should be easy to follow being that it
resembles how you would use javascript with the HTML,XML DOM.
It's just a little bit different, why not just make it the same?
Were not scripting against a DOM, (a Documents Object Modle) but a DOM, (a Dialect Object Modle) because
you may not actually know the syntax of the loaded document or data before it's transcode to a DOM from a DSL.
Plus Rebol wont let you too far off the hook in writing code any way you like. Some *op Words and code/data
has set types that follow a strict syntax. I think the best way around this is to load as type? string!, reformat
and parse as type? block!. Maybe.....
These DOM functions should work very close to the HTML DOM functions:
getElementsByTagName .getAttribute .setAttribute
**************************************************************************************************
}
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-dsl Notes
|