[REBOL] Object viewer
From: jeff:rebol at: 15-Feb-2001 13:11
REBOL [
Title: "Object as Tree"
Author: "Jeff Kreis"
Email: [jeff--rebol--com]
Date: 15-Feb-2001
Purpose: "View an object in tree view"
Comment: "Works with any object"
]
view-obj: func [
'objw "A word that refers to an object"
/local obj data this-parent this-val
this-word expanded? this-depth val new-val
][
if not object? obj: get objw [make error! "View-obj views objects"]
data: make block! 300
;- this-parent this-val this-word expanded? depth
repend data [none obj objw off 0]
cnt: 0
view/offset this-tree: layout [
backdrop 90.90.240
h2 yellow (reform ["Object Viewer:" objw])
across space 0
lst: list 500x430 [
txt 500 [
;-- First find parent and from there
; find this thing
val: pick face/user-data 2
this-spot: find data face/user-data/1
this-spot: skip find next this-spot :val -2
set [this-parent this-val this-word expanded? this-depth] this-spot
either expanded? [
;-- Remove stuff that has me as a parent
spot: skip find/last data :this-val 5
remove/part skip this-spot 5 spot
change at this-spot 4 off
][
either object? :this-val [
;-- Add my stuff to data below me
spot: skip this-spot 5
new-data: make block! 50
foreach word next first this-val [
if unset? set/any 'val get/any in this-val word [val: unset!]
repend new-data [this-val :val word off this-depth + 1]
]
insert spot new-data
change at this-spot 4 on ;- Expanded?
][
;-- Edit my value
this-lay: layout [
backdrop 90.90.240
h2 yellow (reform ["Value of:" this-word])
this-area: area 300x300 (mold :this-val)
across txt yellow "do?" do-check: check off
this-set: button "set"
this-close: button "close"
]
;- Use compose to stick the values in
; there so there can be more than
; one of these windows open and each
; button action will refer to its
; own instance values.
this-set/action: compose [
set this-val: in (this-parent) (to-lit-word this-word) new-val: load (this-area/text)
if get in (do-check) 'data [new-val: set this-val do new-val]
change/only at (reduce [this-spot]) 2 :new-val
unview/only (this-lay)
]
this-close/action: compose [unview/only (this-lay)]
center-face this-lay
view/new this-lay
]
]
show lst
]
] supply [
;-- Set up each face of the
; iterated pane based on what's in data
face/text: none
face/font/color: black
count: count + cnt
face/color: either even? count [200.200.200][ivory]
if tail? spot: skip data ((count - 1) * 5) [return none]
face/user-data: reduce [spot/1 spot/3]
this-val: pick spot 2
face/text: head insert/dup reform [
either object? :this-val [
either spot/4 ["--"]["+-"]
][#] spot/3
] " " spot/5
]
sld: slider 16x430 [
c: to-integer value * ((length? data) / 5)
if c <> cnt [cnt: c show lst]
] return
button "quit" [quit]
] 150x50
]
view-obj system
