REBOL [
Title: "REBOL browser"
File: %browser.r
Date: 2000-06-10
Author: "Ingo Hohmann"
Email: ingo@2b1.de
Site: http://www.2b1.de/
Rights: "(c) Ingo Hohmann"
Purpose: {A simple WWW Browser}
Based-upon: "Carls text-view"
Category: [view VID networking]
Changes: [
[ 0.0.4
{startmessage displayed correctly}
{mailto: links removed from visitable links}
]
[ 0.0.3
{some more errors corrected}
]
[ 0.0.2
{translates to " "}
{evaluates }
{prelimenary handling}
{corrected some errors}
]
[ 0.0.1
{initial release (the unnumbered one)}
]
]
Version: first first changes
todo: [
{use load-thru ?}
{ handling needs other font}
{let buttons reflect presence of scripts}
{some cleaning}
{testing, of course}
]
]
browser: make object! [
help: {The browser Object}
start-url: form http://www.2b1.de/
html: make object! [
help: {A html parser}
evaluate: false
read-error: none
skip: false
spaces: charset " ^-^/"
non-spaces: complement spaces
delimiters: charset { ^-^/="} ;"
non-delimiters: complement delimiters
html-source: copy ""
get-html: func [][ return html-source ]
find-base: func [ url [url! file!] /local u2][
if #"/" = last url [ return url ]
if exists? u2: to-url rejoin [ url "/" ] [
return u2
]
first split-path url
]
conv-list: [
"&" "&" "<" "<" ">" ">" """ {"}
"ä" "ä" "Ä" "Ä" "ö" "ö" "Ö" "Ö" "ü" "ü"
"Ü" "Ü" "ß" "ß" " " " "]
clean: func [
{Converts html-entities to special-characters}
text [string!]
/local special entity
] [
foreach [special entity] conv-list [
replace/all text special entity
]
text
]
parse-tag: func [
{parses a tag, returns block of tag-name arguments}
tag /local tag-name tag-params] [
name-rule: [ some non-delimiters ]
param-rule: [
any spaces [
copy param-name name-rule (append tag-params param-name)
any spaces [
"=" any spaces [
{"} copy param-val to {"} skip |
{'} copy param-val to {'} skip |
copy param-val some non-delimiters skip
]
(append tag-params param-val) | (append tag-params true)
]
]
]
tag-params: copy []
parse/all tag [ copy tag-name name-rule any param-rule ]
compose [ (tag-name) (tag-params) ]
]
read: func [
{read url and return the page as ...}
url [url! file!]
/html "html source"
/text "text"
/links "link-list"
/local data txt lnk return-block
] [
return-block: copy []
either error? err: try [data: read url] [
read-error: disarm err
] [
read-error: none
if html [ append return-block data ]
if any [ txt links ] [
set [txt lnk] to-text url data
if text [ append return-block txt ]
if links [ append/only return-block lnk ]
]
print dir? url
]
]
to-text: func [
{Convert html to text, url is needed for handling of relative urls}
url [url! file!] html [string!]
/local elem txt links link lfd link-blk pos end-pos the-script script-funcs
] [
script-funcs: make object! [
print: func [val][ insert pos load/markup form join val newline ]
prin: func [val][ insert pos load/markup form val ]
]
url: find-base url
links: copy []
link-blk: copy []
html-source: copy html
html: load/markup html
txt: make string! 500
lfd: 0
parse html [
some [
set elem string! (
if not skip [
if 0 < length? trim/lines elem [
append txt rejoin [ elem " "]
]
]
) |
pos: set elem tag! (
elem: parse-tag elem
switch first elem [
"a" [
lfd: lfd + 1
append txt rejoin [ "(" lfd ")" ]
elem: select elem "href"
if elem [
if all [ not find elem "://" not find elem "mailto:"] [ ; ???
elem: rejoin [ url elem ]
]
append links compose [ (lfd) (elem)]
]
]
"img" [
either elem: select elem "alt" [
append txt rejoin [ "[" elem "]" ]
] [
append txt "[graphic]"
]
]
"p" [append txt "^/^/"]
"br" [append txt newline]
"hr" [append txt "^/------------------------------------^/" ]
"li" [append txt "^/* "]
"ul" [append txt newline]
"/ul" [append txt newline]
"ol" [append txt newline]
"/ol" [append txt newline]
"div" [append txt newline]
"/div" [append txt newline]
"blockquote" [append txt newline]
"/blockquote" [append txt newline]
"style" [skip: true]
"/style" [skip: false]
"pre" [
end-pos: find pos
append txt rejoin [ newline copy/part next pos end-pos ]
pos: end-pos
]
"script" [
either all [ evaluate "rebol" = select elem "language" ] [
end-pos: find pos
the-script: copy/part next pos end-pos
remove/part pos next end-pos
if error? err: try [
do bind load rejoin the-script in script-funcs 'print
] [
inform layout [
title red "Error in script !"
text mold disarm err
]
]
pos: back pos
][
skip: true
]
] ; do bind load rejoin n in t 'print
"/script" [skip: false]
"/title" [append txt "^/^/"]
]
pos: next pos
)
:pos
]
]
txt: clean txt
append txt "^/^/^/The links:^/-------^/^/"
foreach [lfd link] links [ append txt rejoin [ lfd " " link newline]]
foreach [lfd link] links [ if not find link "mailto:" [append link-blk rejoin [ lfd " " link]]]
return compose/deep [ (txt) [(link-blk)]]
]
]
size: 0x0
link-list: copy []
visited-links: copy []
; Browsers GUI
browser: layout [
backdrop effect [gradient -1x-1 0.200.0]
title rejoin [ "Very basic WWW browser ... (Ver: " system/script/header/version ")"]
box 656x4 effect [gradient 1x0 200.0.0]
across space 6
text bold "File:"
f1: field 516x24 start-url [
either all [
not error? try [ url: load f1/text ]
any [ url? url file? url ]
] [
either not error? err: try [ txt: read url ] [
insert visited-links url
set [txt link-list] html/to-text url txt
t3/text: either length? txt [txt][none] show t3
size: size-text t3
c1/text: either empty? link-list ["no links found"]["Goto link"] show c1
true
][
inform layout [
title red "Error"
text mold disarm err
]
]
] [
inform layout [
title red "Error"
text rejoin [ "Not a valid url: " f1/text ]
]
]
]
button "Load" #"^l" [ do f1/action none none]
return
indent 37
c1: button 516x24 #"^g" "No Links found" [
choose link-list func [f a] [f1/text: copy find f/text "http://" show f1] c1
]
button "Back" #"^b" [
remove visited-links
if not empty? visited-links [
f1/text: first visited-links
show f1
]
]
return space 0
t3: text 640x480 with [color: 250.250.250 ]
s1: slider 16x480 [
t3/para/origin/y: s1/data - 1 * size/y / -480 + 2
show t3
]
return
space 6
pad 0x6
button "broWse" #"^w" [ browse f1/text ]
tab
bEval: button "Evaluate" #"^e" [
html/evaluate: not html/evaluate
bEval/text: either html/evaluate ["don't Eval"]["Evaluate"]]
button "Run" #"^r" [
if error? err: try [ do load f1/text 'true ] [
inform layout [
title red rejoin ["Can't 'do " f1/text]
text mold disarm err
]
]
]
tab
button "CloSE" #"^(ESC)" [ unview/all ]
]
t3/text: trim/auto {
Me little Rebol Browser ... ^/
Well, I just couldn't get the time to write a real Reblet, so
I just settled to this one.
You can type in an url, and press return. If the page contains
further links, then the links will be displayed as a link-list,
and can be choosen from the "Goto"-Button.
^^g goto
^^l load
^^w start WWW browser on url
ESC close window
Bugs:
^^b back (doesn't work yet)
AND NOW PRESS LOAD ...
}
view browser
]