rebol [Title: "Markup language Dialect parser"
Library: [ level: 'intermediate
platform: 'all
type: 'tool
domain: [xml html markup ]
tested-under: 'windows
support: none
license: none
see-also: none ]
Date: 1-Jan-2001
Name: 'mdlParser
Version: 0.0.2
File: %mdlparser.r
Home: http://www.rebol.org/
Author: "daniel murrill"
Email: inetw3@mindspring.com
Owner: "daniel murrill"
Rights: "Copyright (C) daniel murrill 2000"
Language: 'English Charset: 'ANSI
Purpose: { To personally study the practicallity of Rebol
being used as bridge between browsers and markup languages. }
Comment: { The purpose for this script is to parse xml, xhtml, css, and
html and have it viewable/scriptable in its own document window.
This script has been taken from a larger portion that's used in a Rebol browser.
This script is only prelimanary dialect, there will be lots of changes seeing that
some of it does not work properly at this time. If you would like to share
code to improve the ml parser, email it to the ML (mailing list) so others can learn
about it too. Thanks }
]
macros:[
"&" "&"
"<" "<"
">" ">"
""" {"}
"ä" "ä"
"Ä" "Ä"
"ö" "ö"
"Ö" "Ö"
"ü" "ü"
"Ü" "Ü"
"ß" "ß"
]
histobj: []
clean: func [rgbs][
replace/all rgbs {="Aliceblue"} {="#F0F8FF"}
replace/all rgbs {="Antiquewhite"} {="#FAEBD7"}
replace/all rgbs {="Aqua"} {="#00FFFF"}
replace/all rgbs {="Aquamarine"} {="#7FFFD4"}
replace/all rgbs {="Azure"} {="#F0FFFF"}
replace/all rgbs {="Bisque"} {="#FFE4C4"}
replace/all rgbs {="Black"} {="#000000"}
replace/all rgbs {="Blueviolet"} {="#8A2BE2"}
replace/all rgbs {="Blue"} {="#0000ff"}
replace/all rgbs {="Blanchedalmond"} {="#FFEBCD"}
replace/all rgbs {="Burlywood"} {="#DEB887"}
replace/all rgbs {="Cadetblue"} {="#5F9EA0"}
replace/all rgbs {="Chartreuse"} {="#7FFF00"}
replace/all rgbs {="Chocolate"} {="#D2691E"}
replace/all rgbs {="Coral"} {="#FF7F50"}
replace/all rgbs {="Cornflowerblue"} {="#6495ED"}
replace/all rgbs {="Cornsilk"} {="#FFF8DC"}
replace/all rgbs {="Crimson"} {="#DC143C"}
replace/all rgbs {="Cyan"} {="#00FFFF"}
replace/all rgbs {="Darkblue"} {="#00008B"}
replace/all rgbs {="Darkcyan"} {="#008B8B"}
replace/all rgbs {="Darkgoldenrod"} {="#B8860B"}
replace/all rgbs {="Darkgray"} {="#A9A9A9"}
replace/all rgbs {="Darkgreen"} {="#006400"}
replace/all rgbs {="Darkkhaki"} {="#BDB76B"}
replace/all rgbs {="Darkmagenta"} {="#8B008B"}
replace/all rgbs {="Darkolivegreen"} {="#556B2F"}
replace/all rgbs {="Darkorange"} {="#FF8C00"}
replace/all rgbs {="Darkorchid"} {="#9932CC"}
replace/all rgbs {="Darkred"} {="#8B0000"}
replace/all rgbs {="Darksalmon"} {="#E9967A"}
replace/all rgbs {="Darkseagreen"} {="#8FBC8F"}
replace/all rgbs {="Darkturquoise"} {="#00CED1"}
replace/all rgbs {="Darkslateblue"} {="#483D8B"}
replace/all rgbs {="Darkslategray"} {="#2F4F4F"}
replace/all rgbs {="Darkviolet"} {="#9400D3"}
replace/all rgbs {="Deepskyblue"} {="#00BFFF"}
replace/all rgbs {="Dimgray"} {="#696969"}
replace/all rgbs {="Firebrick"} {="#B22222"}
replace/all rgbs {="Floralwhite"} {="#FFFAF0"}
replace/all rgbs {="Forestgreen"} {="#228B22"}
replace/all rgbs {="Fuchsia"} {="#FF00FF"}
replace/all rgbs {="Gainsboro"} {="#DCDCDC"}
replace/all rgbs {="Ghostwhite"} {="#F8F8FF"}
replace/all rgbs {="Gold"} {="#FFCD28"}
replace/all rgbs {="Goldenrod"} {="#DAA520"}
replace/all rgbs {="Gray"} {="#808080"}
replace/all rgbs {="Green"} {="#008000"}
replace/all rgbs {="Greenyellow"} {="#ADFF2F"}
replace/all rgbs {="Honeydew"} {="#F0FFF0"}
replace/all rgbs {="Hotpink"} {="#FF69B4"}
replace/all rgbs {="Indianred"} {="#CD5C5C"}
replace/all rgbs {="Indigo"} {="#4B0082"}
replace/all rgbs {="Ivory"} {="#FFFFF0"}
replace/all rgbs {="Khaki"} {="#F0E68C"}
replace/all rgbs {="Lavender"} {="#E6E6FA"}
replace/all rgbs {="Lavenderblush"} {="#FFF0F5"}
replace/all rgbs {="Lawngreen"} {="#7CFC00"}
replace/all rgbs {="Lemonchiffon"} {="#FFFACD"}
replace/all rgbs {="Lightblue"} {="#ADD8E6"}
replace/all rgbs {="Lightcoral"} {="#F08080"}
replace/all rgbs {="Lightcyan"} {="#E0FFFF"}
replace/all rgbs {="Lightgoldenrodyellow"} {="#FAFAD2"}
replace/all rgbs {="Lightgreen"} {="#90EE90"}
replace/all rgbs {="Lightgrey"} {="#D3D3D3"}
replace/all rgbs {="Lightpink"} {="#FFB6C1"}
replace/all rgbs {="Lightsalmon"} {="#FFA07A"}
replace/all rgbs {="Lightseagreen"} {="#20B2AA"}
replace/all rgbs {="Lightskyblue"} {="#87CEFA"}
replace/all rgbs {="Lightslategray"} {="#778899"}
replace/all rgbs {="Lightyellow"} {="#FFFFE0"}
replace/all rgbs {="Lime"} {="#00CD00"}
replace/all rgbs {="Limegreen"} {="#32CD32"}
replace/all rgbs {="Linen"} {="#FAF0E6"}
replace/all rgbs {="Magenta"} {="#FF00FF"}
replace/all rgbs {="Maroon"} {="#800000"}
replace/all rgbs {="Mediumauqamarine"} {="#66CDAA"}
replace/all rgbs {="Mediumblue"} {="#0000CD"}
replace/all rgbs {="Mediumorchid"} {="#BA55D3"}
replace/all rgbs {="Mediumpurple"} {="#9370D8"}
replace/all rgbs {="Mediumseagreen"} {="#3CB371"}
replace/all rgbs {="Mediumslateblue"} {="#7B68EE"}
replace/all rgbs {="Mediumspringgreen"} {="#00FA9A"}
replace/all rgbs {="Mediumturquoise"} {="#48D1CC"}
replace/all rgbs {="Mediumvioletred"} {="#C71585"}
replace/all rgbs {="Midnightblue"} {="#191970"}
replace/all rgbs {="Mintcream"} {="#F5FFFA"}
replace/all rgbs {="Mistyrose"} {="#FFE4E1"}
replace/all rgbs {="Moccasin"} {="#FFE4B5"}
replace/all rgbs {="Navajowhite"} {="#FFDEAD"}
replace/all rgbs {="Navy"} {="#000080"}
replace/all rgbs {="Olive"} {="#808000"}
replace/all rgbs {="Olivedrab"} {="#688E23"}
replace/all rgbs {="Orange"} {="#FFA500"}
replace/all rgbs {="Orangepumpkin"} {="#FFA500"}
replace/all rgbs {="Orangered"} {="#FF4500"}
replace/all rgbs {="Orchid"} {="#DA70D6"}
replace/all rgbs {="Palegoldenrod"} {="#EEE8AA"}
replace/all rgbs {="Palegreen"} {="#98FB98"}
replace/all rgbs {="Paleturquoise"} {="#AFEEEE"}
replace/all rgbs {="Palevioletred"} {="#D87093"}
replace/all rgbs {="Papayawhip"} {="#FFEFD5"}
replace/all rgbs {="Peachpuff"} {="#FFDAB9"}
replace/all rgbs {="Peru"} {="#CD853F"}
replace/all rgbs {="Pink"} {="#FFC0CB"}
replace/all rgbs {="Palepink"} {="#FFC0CB"}
replace/all rgbs {="Plum"} {="#DDA0DD"}
replace/all rgbs {="Powderblue"} {="#B0E0E6"}
replace/all rgbs {="Purple"} {="#800080"}
replace/all rgbs {="Red"} {="#FF0000"}
replace/all rgbs {="Rosybrown"} {="#BC8F8F"}
replace/all rgbs {="Royalblue"} {="#4169E1"}
replace/all rgbs {="Saddlebrown"} {="#8B4513"}
replace/all rgbs {="Salmon"} {="#FA8072"}
replace/all rgbs {="Sandybrown"} {="#F4A460"}
replace/all rgbs {="Seagreen"} {="#2E8B57"}
replace/all rgbs {="Seashell"} {="#FFF5EE"}
replace/all rgbs {="Sienna"} {="#A0522D"}
replace/all rgbs {="Silver"} {="#C0C0C0"}
replace/all rgbs {="Skyblue"} {="#87CEEB"}
replace/all rgbs {="Slateblue"} {="#6A5ACD"}
replace/all rgbs {="Slategray"} {="#708090"}
replace/all rgbs {="Snow"} {="#FFFAFA"}
replace/all rgbs {="Springgreen"} {="#00FF7F"}
replace/all rgbs {="Steelblue"} {="#4682B4"}
replace/all rgbs {="Tan"} {="#D2B48C"}
replace/all rgbs {="Teal"} {="#008080"}
replace/all rgbs {="Thistle"} {="#D8BFD8"}
replace/all rgbs {="Tomato"} {="#FF6347"}
replace/all rgbs {="Turquoise"} {="#40E0D0"}
replace/all rgbs {="Violet"} {="#EE82EE"}
replace/all rgbs {="Wheat"} {="#F5DEB3"}
replace/all rgbs {="White"} {="#FFFFFF"}
replace/all rgbs {="Whightsmoke"} {="#F5F5F5"}
replace/all rgbs {="Yellow"} {="#FFFF00"}
replace/all rgbs {="YellowGreen"} {="#9ACD32"}
replace/all rgbs {="Base-color"} {="#8F7F6F"}
replace/all rgbs {="Beige"} {="#FFE4C4"}
replace/all rgbs {="Brick"} {="#B22222"}
replace/all rgbs {="Coal"} {="#404040"}
replace/all rgbs {="Coffee"} {="#4C1A00"}
replace/all rgbs {="Forest"} {="#003000"}
replace/all rgbs {="Leaf"} {="#008000"}
replace/all rgbs {="Maroon"} {="#800000"}
replace/all rgbs {="Mint"} {="#648874"}
replace/all rgbs {="Oldrab"} {="#484810"}
replace/all rgbs {="Papaya"} {="#FF5025"}
replace/all rgbs {="Pewter"} {="#AAAAAA"}
replace/all rgbs {="Rebolor"} {="#8E806E"}
replace/all rgbs {="Sky"} {="#A4C8FF"}
replace/all rgbs {="Water"} {="#506C8E"}
]
obj: func[this me][
either find n this [select this me][none]
]
rgb: func[bin][
if none? bin [bin: copy "#000000"]
clr: copy bin
either clr: find/match/part clr "#" 6 [
replace clr "#" ""
clr: to-issue clr to-tuple debase/base clr 16][
bin: 250.250.250]
]
bgrd: func[bin][
if none? cpybg [cpybg: "#ffffff"]
if none? bin [bin: copy cpybg]
clr: copy bin
either clr: find/match/part clr "#" 6 [
clr: to-issue clr
to-tuple debase/base clr 16][
bin: 250.250.250]
]
prgb: func[bin][if none? bin [bin: copy cpybg]
clr: copy bin
either clr: find/match/part clr "#" 6 [
replace clr "#" ""
clr: to-issue clr to-tuple debase/base clr 16][
clr: copy cpybg
replace clr #"#" ""
reduce clr: to-issue clr
if error? try [to-tuple debase/base clr 16 ][200.200.200]]
]
tdrgb: func[bin][
either none? bin [
if none? bin [ bin: bg]
if none? bin [bin: remove cpybg]
if none? bin [bin: "ffffff"]
clr: to-issue bin to-tuple debase/base clr 16][
either find bin "#" [
clr: remove bin
clr: to-issue clr to-tuple debase/base clr 16][
bin: remove cpybg
clr: to-issue bin to-tuple debase/base clr 16
]
]
]
btnrgb: func[bin][
either none? bin [
if none? bin [bin: copy "#c0c0c0"]
clr: remove bin
clr: to-issue clr to-tuple debase/base clr 16][
if error? try [clr: remove bin
clr: to-issue clr to-tuple debase/base clr 16][]
]
]
tbwdth: func[bin][
checkhd: does [
if nhead = "
40 [psize: psize][psize * 8]]
attr: func[bin][
if none? bin [bin: copy "none" ]
switch bin [
"left" [bin: "left"]
"right" [bin: "right"]
"center" [bin: "center"]
"none" [bin: "center"]
]
bin: to-word bin
]
ids: func[bin][
either none? bin: to-string obj n 'id
[][bin: to-string obj n 'id bin: to-set-word bin
]
]
click: func[] [
action: obj n 'onclick
either none? action [action: ""][
replace/all action #"." " "
replace/all action #"{" " {"
replace/all action #"}" "} "
replace/all action #"[" " ["
replace/all action #"]" "] "
replace/all action #"(" ": "
replace/all action #")" ""
insert action {if error? try [}
append action {] []}
]
]
divw: func [bin][
if error? try [bintop: to-integer obj n 'top][bintop: 0]
if error? try [binlft: to-integer obj n 'left][binlft: 0]
bintl: to-pair reduce [bintop binlft]
either bintl = 0x0 [bintl: "" bins: 'across][
]
binx: tbwdth obj n 'width
if none? binx [binx: length? text binx: binx * 8]
biny: tbwdth obj n 'height
if none? biny [biny: length? text biny: biny * 8]
binxy: to-pair reduce [binx biny]
]
btnw: func [bin][
bin: obj n 'size
tbwdth bin
]
getimg: does [
geto: obj n 'src
if none? geto [geto: ""]
replace/all geto #"=" " "
geto: to-string reduce [{/} geto]
replace geto {//} {/}
if find/match/part html/text "http://" 7 [
either find/match/part geto "http://" 7 [goto: to-string geto ][
parse/all html/text [to {http://} copy nav
thru ".com" (geto: to-string reduce [nav geto]
goto: "" )]
parse/all html/text [to {http://} copy nav
thru ".net" (geto: to-string reduce [nav {/} geto])]
parse/all html/text [to {http://} copy nav
thru ".org" (geto: to-string reduce [nav {/} geto])]
]
]
either geto/1 = #"/"
[replace geto "/" "" if error? try [
goto: load to-file geto][
either gotoalt: obj n 'alt [goto: gotoalt][goto: "image"]
]
][goto: load geto]
img ]
getval: func[bin][
either obj n 'value [
bin: obj n 'value ][
bin: "none"]
]
setnstyle: func[][insert tail n getstyle]
title: func[][insert xmlview reduce [text 'title ]]
body: func[][ insert xmlview reduce [1 'space mnb: bgrd cpybg: obj n 'bgcolor 'backdrop]
]
p: func[][either find text "none" [ insert xmlview reduce['below ]]
[insert xmlview reduce[pcolor: prgb obj n 'bgcolor rgb obj n 'color reduce ['do click ] text 'text ids obj n 'id 'across 0 'space 'below]]]
layer: func[][either text = "none" [insert xmlview reduce [""]][insert xmlview reduce [text txtsize 'text]]]
H1: func[][insert xmlview reduce ['below
prgb obj n 'bgcolor rgb obj n 'color 24 'font-size text 'text 0 'space 'across 'below]]
H2: func[][insert xmlview reduce ['below
prgb obj n 'bgcolor rgb obj n 'color 18 'font-size text 'text 0 'space 'across 'below]]
H3: func[][insert xmlview reduce ['below
prgb obj n 'bgcolor rgb obj n 'color 16 'font-size text 'text 0 'space 'across 'below]]
H4: func[][either text = "none" [""][insert xmlview reduce ['below
prgb obj n 'bgcolor rgb obj n 'color 'bold 11 'font-size text 'text 0 'space 'across 'below]]]
H5: func[][insert xmlview reduce ['below
prgb obj n 'bgcolor rgb obj n 'color 11 'font-size text 'text 0 'space 'across 'below]]
H6: func[][insert xmlview reduce ['below
prgb obj n 'bgcolor rgb obj n 'color 9 'font-size text 'text 0 'space 'across 'below]]
font: func[][either text = "none" [insert xmlview reduce [ ]][insert xmlview reduce [-6x0 'pad attr obj n 'align prgb obj n 'bgcolor rgb obj n 'color text tbwdth obj n 'width 'text 1 'space 'across]]]
nfont: func[][insert xmlview reduce [-8x0 'pad attr obj n 'align prgb obj n 'bgcolor rgb obj n 'color text 'text -8x0 'pad 'across]]
div: func[][divw obj n 'width insert xmlview reduce [prgb obj n 'bgcolor rgb obj n 'color 'font-color attr obj n 'align 'center reduce ['do click]binxy text 'box ids obj n 'id bintl 'at ]]
ahref: func[][ either text = "none" [][
either find goto ".r" [insert xmlview reduce ['underline rgb obj n 'color [] reduce ['do goto] text 'text ids obj n 'id 0 'space 'across]][insert xmlview reduce ['underline rgb obj n 'color [] reduce ['do gohere] rgb obj n 'color 'font-color text 'text ids obj n 'id 0 'space 'across]]]]
btn1: func[][ insert xmlview reduce [btnrgb obj n 'bgcolor reduce ['do click ]
btnw obj n 'size to-file obj n 'src getval obj n 'value 'button ids obj n 'id 'across]]
btn2: func[][insert xmlview reduce [btnrgb obj n 'bgcolor reduce ['do click ] getval obj n 'value btnw obj n 'size 'field ids obj n 'id 'across]]
img: func[][insert xmlview reduce [goto 'image 'across]]
b_: func[][insert xmlview reduce [prgb obj n 'bgcolor 'bold]]
b: func[][either text = "none" [insert xmlview reduce [""]][insert xmlview reduce [prgb obj n 'bgcolor rgb obj n 'color 'bold text 'text 'across]]]
italic: func[][insert xmlview reduce [prgb obj n 'bgcolor rgb obj n 'color 'italic text 'text ]]
br: func[][insert xmlview reduce ['below]]
area: func[][ insert xmlview reduce [200x100 text 'area to-set-word ids obj n 'id 'across]]
hr: func[][insert xmlview reduce ['white tbwdth obj n 'width 'box 0x0 'pad 'gray tbwdth obj n 'width 'box 'below 0 'space]]
table: func[][ spc: to-integer obj n 'cellspacing pd: obj n 'cellpadding tbwdth obj n 'width
insert xmlview reduce ['across 0 'space]]
tr: func[][insert xmlview reduce ['below ]]
td: func[][ either text = "none"
[setnstyle][setnstyle
insert xmlview reduce [attr obj n 'align 'center
prgb obj n 'bgcolor rgb obj n 'color 11 'font-size text 'text 'across]]]
{[size: 1x1 effect: 'bezel] 'edge}
code: func[][replace/all text {<} "<" replace/all text {>} ">" replace/all text {'} {"}
insert xmlview reduce [text 'text ]]
li: func[][insert xmlview reduce [bgrd obj n 'bgcolor rgb obj n 'color text 'text 15x10 '+ 'here 'at 'bold 24 'font-size "." 'text 'guide 'at to-set-word 'here 0x-10 'pad 'across 'below ]]
bq: func[][insert xmlview reduce [prgb obj n 'bgcolor rgb obj n 'color text 'text 0 'space]]
pre: func[][parse markup [thru "" copy pretext to "
" (
oldpretext: copy pretext
replace/all pretext ">" ">" replace/all pretext "<" "<"
parse/all markup [to oldpretext begin: thru oldpretext ending:(change/part begin pretext ending )]
foreach [old new] macros[
parse/all pretext [some[to old begin: thru old ending:(change/part begin new ending )]skip]
]
insert xmlview reduce [pretext 'text ])]
]
nl: func [][either text = "none" [insert xmlview 'across 'below][insert xmlview reduce [prgb obj n 'bgcolor rgb obj n 'color text 'text 'across 'below]]]
 : func [][insert xmlview reduce [prgb cpybg prgb cpybg "&" 'text +8x0 'pad 'across]]
update: does [
xmlview: []
mnb: "#ffffff"
cpybg: "#ffffff"
txtsz: 0
goto: ""
gohere: ""
getstyle: ""
text: ""
inparent: false
n: make block! [] 500
var: []
{replace/all markup "" ""}
replace/all markup " " " "
replace/all markup "
" {
}
replace/all markup "
" {
}
replace/all markup {=submit} {="submit"}
replace/all markup "name=" "id="
replace/all markup "background:" "bgcolor:"
replace/all markup "=#ffffff" {="#ffffff"}
replace/all markup "=#000000" {="#000000"}
replace/all markup {=0} {="0"}
replace/all markup "> <" "><"
replace/all markup " " "< >"
parse/all markup [some[to "" copy pretext to "
" (
pretext: to-string pretext getpretext: copy pretext
thistext: replace/all pretext newline reduce [newline ""]
replace markup getpretext thistext )]
skip]
replace markup {} {}
replace markup {} {}
parse/all markup [any[to "<" copy heads to ">" thru ">" copy text to "<" (
if none? text [text: to-string text] replace/all text {"} {'}
foreach [old new] macros[replace/all text old new ]
this: parse heads "="
nhead: to-string this/1
clear n {n: [bgcolor "" color "#000000" align ""]}
remove this
this: form this
replace/all this ";" " "
replace/all this 'style ""
this: parse this ":"
foreach [key value] this [
insert tail n reduce [attname: to-word key attvalue: value]
]
switch nhead [
"" [ "S" ]
""
replace/all markup {"pre"} ""
replace/all markup "" ""
replace/all markup "< >" " "
editor/text: markup show editor
document: layout/offset/size xmlview 0x0 550x10000
page/pane: document show page
page/color: mnb show page
pagetitle: getnodename "title"
either find histobj pagetitle [][
append histobj pagetitle
append histobj reduce [to-block xmlview]
replace/all histobj false []
replace/all histobj [[]] []
]
clear xmlview
]
tbar: [backdrop silver space 3 pad -15x-20 text "New" [] text "Open" [] text "Save" [] pad -19x-1 space 0
box 115x1 gray pad 0x0
box 115x1 white space 0 below across pad -14x2
text "Properties" []
below
history: text ""
pad -19x10 space 0
box 115x1 gray pad 0x0
box 115x1 white space 0 below across pad -14x2
text "Exit" []] 100x150 35x85
goedit: layout/size/offset tbar 100x150 90x85
goview: layout/size/offset tbar 100x150 125x85
goinsert: layout/size/offset tbar 100x169 165x85
gopreview: layout/size/offset tbar 100x150 216x85
goHelp: layout/size/offset tbar 100x150 277x85
document: []
vide: layout [at 0x0 ID: bck: backdrop gold
across
ID: t1: text "Html" [editor/text: markup: {
Demo page
} show html show editor update]font-size 12 0.0.0
ID: t2: text " " space 9
ID: t3: text "Rebol" [editor/text: markup: {REBOL [
Title: ""
Date:
Author: ""
File: %RT.r
Email: you@www.com
Purpose: {
}
Category: []
]}
show editor if error? try [
do editor/text ][] ]
font-size 12 0.0.0
ID: t4: text "Text" [editor/text: markup: thist4: {} show editor html/text: "" show html]
font-size 12 0.0.0
ID: t5: text "Insert" []font-size 12 0.0.0
ID: t6: text "Preview" []font-size 12 0.0.0
ID: t8: text "Help" []font-size 12 0.0.0 below pad -19x-5 space 0
ID: b1: box 549x1 gray pad 0x0
ID: b2: box 549x1 white space 0 below across pad -14x2
pad 300x0
Go: button "Go" 30x25 [replace html/text "http://" ""
either find html/text "www" [
insert html/text "http://"
either exists? to-url html/text [
markup: read to-url html/text
][
html/text: "Error: File not found" show html markup: " " ]][
either find html/text "/" [
remove html/text "/"
either exists? to-File html/text [
markup: read to-file html/text
][html/text: "Error: File not found" show html markup: " "]
][
either find html/text {: } [if error? try [do html/text markup: " "][]][markup: " "]
]]
clean markup
show html
editor/text: markup show editor
editor/text
update
]
html: field 193
below
pad -19x3
page: box "msgQ/pad" 195.195.195 200.200.0 edge[size: 1x1 effect: 'inbevel ] 547x200
editor: area ivory 547x140 wrap
across
button "Up" 55x20 [if error? try [document/offset/y: document/offset/y + 30 show document][]]
button "Down" 55x20 [if error? try [document/offset/y: document/offset/y - 30 show document][]]
button "View code" 85x20 [clean editor/text markup: copy editor/text
update
]
]
page/pane: ""
getnodename: func [tag][
heads: to-string copy tag insert heads "<"
findtail: parse/all tag " " tails: findtail/1
tails: to-tag join "/" tails
parse/all markup
[
to heads copy nodename to ">" (heads: to-string reduce [nodename">"])
thru ">" copy text to tails (text: to-string text)
(parse nodename
[
some [thru " " copy attname to "=" thru "=" copy attvalue to ">"
] skip
]node: to-string reduce [heads text tails]
)
]
]
selectnodes: func [nodename childnode nodevalue /local getchildnode][
getchildnode: [] text: copy nodevalue
heads: to-string reduce ["<" nodename]
tails: to-string reduce ["" nodename ">"]
nodelist: "" clear getchildnode
parse markup[
some [
to heads copy nodeslist thru tails
( append getchildnode nodeslist)]skip
]
foreach child getchildnode [
getnode: find child childnode
gettails: find child tails
node: find/part getnode nodevalue gettails
either find child node
[
nodelist: [] append nodelist child
newlist: [] append newlist child
][
]
]
]
getnodevalue: func [txt] [
text: txt if find markup text
[
parse/all markup
[
thru "<" copy htag to txt copy text to ""
]
findtag: copy htag
setag: find/last findtag "<"
parse setag [thru "<" copy gethead to ">"]
sethead: copy gethead
hds: parse/all sethead " " gettail: copy hds/1
heads: copy setag
tails: to-tag copy gettail insert tails "/"
parse setag
[
thru " " copy attname to "=" thru "=" copy attvalue
to ">"
]
]
node: to-string reduce [heads text tails]
]
getattribute: func [attrv][
parse/all markup [some [
to "<" copy heads to attrv
copy attname to "=" thru {="} copy attvalue
to {"}
to ">" thru ">" copy text
to ""
]skip
]
hds: find/last heads "<"
parse markup
[
to hds copy heads thru ">"
]
parse hds
[
thru "<" copy gettail to " " (trim/all gettail)
]
tails: to-tag copy gettail insert tails "/"
node: to-string reduce [heads text tails]
]
getid: func[id][
parse markup [
to "<" copy heads
to "id=" thru "id="
to id copy attvalue thru id
copy endhead to ">" thru ">" copy text
to "" (
hds: find/last heads "<"
gettail: parse/all hds " " gettail: gettail/1
remove gettail
tails: to-tag copy gettail insert tails "/"
node: to-string reduce [heads text tails]
print node) ]
]
getattval: func[attrv]
[
parse markup [some [
to "<" copy findheads to attrv thru attrv copy gettails to ">"
thru ">" copy text to ""
(heads: to-string reduce [findheads attrv gettails ">"])
]
]
heads: find/last heads "<"
parse/all heads [some
[
to " " copy attribute to {="} thru {="}
to attrv copy attvalue thru attrv
to {"}
]skip
]
parse heads
[
thru "<" copy gettail to " " (trim/all gettail)
]
tails: to-tag copy gettail insert tails "/"
node: to-string reduce [heads text tails]
]
setnode: func [newhead][
newhead: to-string copy newhead
insert newhead "<"
findtail: parse/all newhead " "
settail: copy findtail/1
remove settail settail/1
newtail: to-tag to-string reduce ["/" settail]
parse markup [to heads copy oldhead thru text to ""]
oldhead: find/last oldhead "<"
size: parse/all heads " "
parse markup
[
to oldhead mark: (replace mark size/1 ""
mark: insert mark newhead) :mark
to tails mark: (replace mark tails ""
mark: insert mark newtail) :mark
]
parse markup
[
to newhead copy heads to text
]
parse newhead
[
thru " " copy attname to "=" thru "=" copy attvalue to end
]clear newhead
]
setnodevalue: func [newtext][
size: length? text
parse/all markup [some
[
to heads thru heads to text mark:
(remove/part mark size
mark: insert mark newtext) :mark
(text: mark)]skip
]
]
setattribute: func [attrvar attrvalue]
[
findhead: parse/all heads " "
thishead: to-string findhead/1
parse markup
[
to thishead thru thishead
to attname mark: (replace mark attname ""
mark: insert mark attrvar) :mark
to attvalue mark: (replace mark attvalue ""
mark: insert mark attrvalue) :mark
]
attname: attrvar
attvalue: attrvalue
]
getchildnode: func [][
parse markup [
to heads copy childnode to tails (
replace childnode heads ""
remove childnode ">"
replace childnode tails ""
parse childnode
[
to "<" copy heads to ">" thru ">" copy text to "<" (text: to-string text)
]
hds: parse/all heads " " gettail: to-string hds/1
gettail: remove head gettail
tails: to-tag copy gettail insert tails "/"
node: to-string reduce [heads ">" text tails]
)]
]
getnextsibling: func [][
oldnode: copy/part (find markup text) (find/last markup "")
either find oldnode heads [
parse oldnode
[
thru text to heads copy nhead thru ">" copy text to "<"
]
parse nhead
[
thru " " copy attributename to "=" thru "=" copy attributevalue to ">"
]
node: to-string reduce [heads text tails]
]
[print reduce
[
heads "has no sibling...."
]
]
]
createnode: func [newnode][
tailnode: newnode
parse markup
[
to text thru text to tails thru tails objtail: to "<"
objtext: (change/part objtail reduce [newline newnode newline] :objtext)
(parse tailnode [some [thru ">" copy text to "" (getnodevalue text)]])
]
]
appendnode: func [newnode][
tailnode: newnode
endnode: find/last markup ""
parse markup
[
objtail: to endnode
objhead: (append objtail reduce [newnode newline] :objhead
parse endnode [to "" copy lastnode thru ">"]
replace markup lastnode ""
append markup lastnode)
(parse newnode [thru ">" copy text to "" (getnodevalue text)])
]
]
removenode: func [][either find markup node [
replace markup node " "
replace markup "^/^/" "^/"
][
print "Node not found"
]
]
vide/size: 550x440
view vide
halt
Copyright © 2018 Rebol Software Foundation