[REBOL] Re: Object viewer
From: gjones05:mail:orion at: 15-Feb-2001 17:59
This is neat. The pop-ups sometimes need to scroll, so I changed to a
text-list. I threw in some version numbers. But I also discovered a bug when
I click on 'view (and a few others) in any of the versions so far. Maybe
I'm tired, but I can't seem to locate the bug. Help?!
Thanks Jeff and Allen.
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"
History: [
0.1.0 [15-Feb-2001 {Script created and placed on list} "Jeff Kreis"]
0.1.1 [16-Feb-2001 {Cosmetic changes, coloured text,
removed bg alt-rows} "Allen K"]
0.1.2 [15-Feb-2001 {Changed pop up to a scrollable list,
cosmetic changes to sizes, reordered header
history to standard. ?? Bug when click on view
and a few others.} "G Scott Jones"]
]
]
; modification based on original by Sterling
; updates the bar on the side of a text-list or group of text-lists
fix-slider: func [faces [object! block!]] [
foreach list to-block faces [
; either 0 = length? list/data [
either 0 = length? list/lines [
list/sld/redrag 1
][
; list/sld/redrag list/lc / length? list/data
list/sld/redrag list/lc / length? list/lines
]
]
]
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 350x430 [
txt 500 black ivory [
;-- 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: text-list 500x300 data (parse/all
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)]
fix-slider this-area
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
set-font face 'color leaf
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 [
set-font face 'color blue
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
