REBOL [
	Title: "REBOL Word Browser"
	Author: "Carl Sassenrath"
	Version: 1.2.4
	Date: 2-Jan-2001
	History: [
		"Checks to see if a newer copy is available." 8-May-2001
		"Ignores words that do not have a value." 2-Jan-2001
		"Original" 1-Dec-2000
	]
]

site: http://www.rebol.com/view/docs/
date-file: %ref-date.r
dict-file: %ref-data.r
cmts-file: %ref-cmts.r

;--Keep it up to date:
date: any [modified? %ref-data 1-1-2000]
if now - date > 7 [
	if confirm "Check for Word Reference update?" [
		dates: load-thru/update site/ref-date.r
		if none? dates [alert "Cannot fetch update file. Try again later." quit]
		if dates/1 <> modified? %ref-data [
			if data: request-download site/ref-data [
				write %ref-data.r decompress data
				set-modes %ref-data.r [modification-date: dates/1]
			]
		]
		if dates/2 <> modified? %ref-cmts.r [
			if request-download site/ref-cmts.r [
				set-modes %ref-cmts.r [modification-date: dates/2]
			]
		]
	]
]

if any [not exists? %ref-data.r not exists? %ref-cmts.r] [
	alert "Missing reference data files. Quiting..." quit
]

;-- Function description builder:

tanish: snow - 20.30.50
ref-color: 100.140.227
body-style: code-style: none

style-layout: layout [
	body-style: txt
	code-style: tt ;black tanish
]

xy: none

make-text: func [str style indent /local obj] [
	obj: make-face style
	obj/text: str
	obj/size: 500x600 - (indent * 2x0)
	obj/size/y: obj/para/origin/y + obj/para/margin/y + second size-text obj 
	;obj/color: gold
	xy: xy + 0x6
	obj/offset: indent * 1x0 + xy
	xy/y: xy/y + obj/size/y
	append out-lay obj
]

make-body-text: func [str] [make-text str body-style 0]
make-code-text: func [str] [make-text str code-style 10]

make-arg: func [arg-word arg-info type-info /local obj] [
	obj: layout [
		size 500x44
		style txt txt font-size 11
		origin 0 space 0
		txt mold arg-word 80x40 bold black
			either refinement? arg-word [ref-color][tanish] center middle 
		at 81x0
		txt 420x20 black snow middle
			either arg-info [form arg-info][
				reform ["The" arg-word pick ["refinement." "argument."] refinement? arg-word]]
		txt 420x20 black main-color middle
			either refinement? arg-word ["A refinement."][
				join "Accepts: " either type-info [reform type-info]["anything"]]
	]
	obj/edge: make obj/edge [size: 2x2 color: black]
	obj/color: black
	obj/offset: xy
	xy/y: xy/y + obj/size/y - 2
	append out-lay obj
]

;-- Function description parser:

code: text: none
space: charset " ^-"
chars: complement charset " ^-^/"
rules: [some parts]
parts: [
	  newline
	| example
	| paragraph
]
example: [
	copy text some [indented | some newline indented]
	(make-code-text text)
]
paragraph: [copy text some [chars thru newline] (make-body-text trim/lines text)]
indented:  [some space thru newline]

;-- Function argument specification block parser:

spec-parser: context [
	data: f-cmt: f-atr: a-word: a-types: a-cmt: a-ref: a-ref-cmt: f: h: none
	fun-cmt: [set val string! (f-cmt: val)]
	fun-atr: [set val block!  (f-atr: val)]
	fun-intro: [(f-cmt: f-atr: none) fun-cmt opt fun-atr | fun-atr opt fun-cmt | none (f-cmt: "Undocumented.")]
	arg-word: [
		set a-word [
			word! (f: :to-word)
			| get-word! (f: :to-get-word)
			| lit-word! (f: :to-lit-word)
		]
		(a-word: f a-word)
	]
	arg-types: [set a-types block!]
	arg-cmt: [set a-cmt string!] 
	fun-arg: [
		(a-types: a-cmt: none)
		arg-word opt arg-types opt arg-cmt
		(repend data [a-word a-cmt a-types])
	]
	ref-word: [set a-ref refinement! h: (if a-ref = /local [h: tail h]) :h]
	ref-cmt: [set a-ref-cmt string!]
	fun-spec: [
		opt [fun-intro (repend data [f-cmt f-atr])]
		any fun-arg
		any [ (a-ref-cmt: none)
			ref-word
			opt ref-cmt (if a-ref <> /local [a-ref-cmt repend data [a-ref a-ref-cmt none]])
			any fun-arg
		]
	]
	set 'parse-spec func [word] [
		data: reduce [word]
		parse third get word fun-spec
		data  ; word comment attr  some [arg-word comment type]
	]
]

;---------

this-word: none

append-face: func [face] [
	face/offset/y: xy/y + 8
	xy/y: xy/y + face/size/y + 12
	append out-lay face
]

show-word: func [word /local attr also desc cmts lst args] [
	this-word: word
	set [attr also desc cmts] select ref word
	lst: parse-spec word
	args: copy []
	foreach [word a b] skip lst 3 [
		if refinement? word [break]
		append args word
	]
	f-name/text: word
	f-args/text: trim/lines mold/only args
	f-name/size/x: 400
	f-args/offset/x: f-name/offset/x + 4 + first size-text f-name
	f-comt/text: second lst
	clear out-lay
	xy: 0x0
	foreach [word cmt type] skip lst 3 [make-arg word cmt type]
	parse/all detab desc rules
	append-face cmt-title
	if cmts [
		parse/all detab cmts rules
	]
	if cmts: select ref-cmts word [
		parse/all detab cmts rules
	]
	append-face cmt-btn
	scroll-box/size/y: xy/y
	f-slid/data: 0.0
	f-slid/redrag f-info/size/y / max 1 scroll-box/size/y
	f-info/pane/offset/y: 0
	show main
]

ref: load dict-file
ref-cmts: either exists? cmts-file [load cmts-file][copy []]

types: []
foreach [word desc] ref [
	if select ref-cmts word [
		if not find desc/1 #Commented [append desc/1 #Commented]
	]
	if block? desc/1 [append types desc/1]
]
types: exclude types [?? object constant util word]
sort types
insert types 'All

filter-words: func [type /local new-words] [ 
	words: sort extract ref 2
	while [not tail? words] [
		either all [value? first words any-function? get first words] [words: next words][remove words]
	]
	words: head words
	if type <> 'all [
		;-- Find words of the given type:
		new-words: copy []
		foreach word words [
			desc: select ref word
			if all [block? desc/1 find desc/1 type] [append new-words word]
		]
		insert clear words new-words
	]
	if value? 'f-funcs [
		f-funcs/texts: f-funcs/lines: f-funcs/data: words
		f-funcs/sn: f-funcs/sld/data: 0
		f-funcs/sld/redrag f-funcs/lc / length? words
		show f-funcs
	]
]

filter-words 'all
lst: none
out-lay: []
h: none

main: layout [
	space 4x0
	style fld txt bold black silver edge [size: 2x2 effect: 'ibevel]
	across

	vh2 reform [system/script/header/title  system/script/header/version]
	pad 200
	text 220 bold right reform ["Updated:" modified? %ref-data.r]
	return
	pad 0x6
	h: at
	choice 130 left data types [filter-words first value] return
	f-funcs: text-list 130x430 data words [show-word value] return
	at h + (f-funcs/size * 1x0) + 10x0 guide
	f-box: box 500x50 snow frame black return
	at f-box/offset guide
	pad 2x2
	f-name: h2 140x24 180.0.0
	f-args: h2 italic 360x24 return
	pad 2x0 f-comt: txt bold 500x24 return
	pad 0x4
	f-info: box 500x400 snow ;edge [size: 0x1 color: coal]
	at f-info/offset + (f-info/size * 1x0)
	f-slid: slider f-info/size/y * 0x1 + 16x0 [
		f-info/pane/offset/y: negate value * (scroll-box/size/y - f-info/size/y) show f-info
	]
	return
	key keycode [up]   [pick-back] 
	key keycode [down] [pick-next] 
	key keycode escape [quit] 
]

pick-next: has [f] [
	f: all [f-funcs/picked f-funcs/picked/1]
	either none? f [f-funcs/picked: reduce [f-funcs/data/1]][
		f: find f-funcs/data f
		if tail? next f [exit]
		f-funcs/picked: reduce [first next f]
	]
	show-word first f-funcs/picked
	show f-funcs
]

pick-back: has [f] [
	f: all [f-funcs/picked f-funcs/picked/1]
	either none? f [f-funcs/picked: reduce [f-funcs/data/1]][
		f: find f-funcs/data f
		f-funcs/picked: reduce [first back f]
	]
	show-word first f-funcs/picked
	show f-funcs
]

cmt-lay: none

;--- Comm code - This is somewhat a hack for right now.

inited: false
initiate: does [
	if not value? 'demo-object [do demo-init]
	init-sync ; open module
	load-prefs
	change-root
	init-server user-prefs/name user-prefs/pass user-prefs/server user-prefs/script
	inited: true
]

read-server: has [msg port][
	forever [
		port: wait []
		if not error? try [msg: rmp-read port] [
			ctx-link-comm/rmp-busy: false
			either found? msg [return to-string msg][print "No message"]
		]
	]
]

post-server: func [data] [
	if not inited [initiate]
	send-server post data
	read-server
]

;-- Post comment:

add-comment: has [] [
	if none? cmt-lay [
		cmt-lay: layout [
			h2 300
			new-cmt: area "" 400x300 wrap
			across
			button "Save" [
				hide-popup
				repend new-cmt/text [newline newline]
				either "ok" <> post-server reduce ['reference this-word new-cmt/text][
					request/ok "Unable to access server. Posting failed."
				][
					entry: select ref-cmts this-word
					insert new-cmt/text reduce ["^/^/-From: " user-prefs/name " [pending]^/^/"]
					either entry [append entry new-cmt/text entry][repend ref-cmts [this-word new-cmt/text]]
				]
				show-word this-word
			]
			button "Cancel" [hide-popup]
		]
	]
	cmt-lay/pane/2/text: reform ["Add comments to:" this-word]
	clear new-cmt/text
	new-cmt/line-list: none
	focus new-cmt
	inform cmt-lay
]

hold-lay: layout [
	origin 2x0
	cmt-btn: button "Add Comment" base-color [add-comment]
	origin 0x0
	cmt-title: h3 "Contributed Comments:" black tanish 500x24 middle
]

cmt-btn/show?: none

f-info/pane: scroll-box: make-face f-info
scroll-box/edge: none
scroll-box/offset: 0x0
scroll-box/pane: out-lay
show-word 'all
center-face main none
view main