Fix inspector bug

db4
Slava Pestov 2008-07-13 23:26:34 -05:00
parent d34d3a6f31
commit 14b5e35a0e
2 changed files with 34 additions and 31 deletions

View File

@ -33,10 +33,10 @@ SYMBOL: +editable+
: write-value ( mirror key -- )
<value-ref> write-slot-editor ;
: describe-row ( obj key n -- )
: describe-row ( mirror key n -- )
[
+number-rows+ get [ pprint-cell ] [ drop ] if
2dup write-key write-value
[ write-key ] [ write-value ] 2bi
] with-row ;
: summary. ( obj -- ) [ summary ] keep write-object nl ;
@ -48,21 +48,19 @@ SYMBOL: +editable+
sort-keys values
] [ keys ] if ;
: describe* ( obj flags -- )
clone [
dup summary.
make-mirror dup sorted-keys dup empty? [
: describe* ( obj mirror keys -- )
rot summary.
dup empty? [
2drop
] [
dup enum? [ +sequence+ on ] when
standard-table-style [
dup length
rot [ -rot describe-row ] curry 2each
swap [ -rot describe-row ] curry each-index
] tabular-output
] if
] bind ;
] if ;
: describe ( obj -- ) H{ } describe* ;
: describe ( obj -- )
dup make-mirror dup sorted-keys describe* ;
M: tuple error. describe ;
@ -78,19 +76,21 @@ M: tuple error. describe ;
SYMBOL: inspector-hook
[ H{ { +number-rows+ t } } describe* ] inspector-hook set-global
[ t +number-rows+ [ describe* ] with-variable ] inspector-hook set-global
SYMBOL: inspector-stack
SYMBOL: me
: reinspect ( obj -- )
dup me set
dup make-mirror dup mirror set keys \ keys set
inspector-hook get call ;
[ me set ]
[
dup make-mirror dup mirror set dup sorted-keys dup \ keys set
inspector-hook get call
] bi ;
: (inspect) ( obj -- )
dup inspector-stack get push reinspect ;
[ inspector-stack get push ] [ reinspect ] bi ;
: key@ ( n -- key ) \ keys get nth ;
@ -123,6 +123,7 @@ SYMBOL: me
"&add ( value key -- ) add new slot" print
"&delete ( n -- ) remove a slot" print
"&rename ( key n -- ) change a slot's key" print
"&globals ( -- ) inspect global namespace" print
"&help -- display this message" print
nl ;
@ -133,3 +134,5 @@ SYMBOL: me
: inspect ( obj -- )
inspector-stack get [ (inspect) ] [ inspector ] if ;
: &globals ( -- ) global inspect ;

View File

@ -1,6 +1,6 @@
! Copyright (C) 2006, 2007 Slava Pestov.
! Copyright (C) 2006, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: ui.tools.workspace inspector kernel ui.commands
USING: accessors ui.tools.workspace inspector kernel ui.commands
ui.gadgets ui.gadgets.panes ui.gadgets.scrollers
ui.gadgets.slots ui.gadgets.tracks ui.gestures
ui.gadgets.buttons namespaces ;
@ -9,8 +9,10 @@ IN: ui.tools.inspector
TUPLE: inspector-gadget < track object pane ;
: refresh ( inspector -- )
dup inspector-gadget-object swap inspector-gadget-pane [
H{ { +editable+ t } { +number-rows+ t } } describe*
[ object>> ] [ pane>> ] bi [
+editable+ on
+number-rows+ on
describe
] with-pane ;
: <inspector-gadget> ( -- gadget )
@ -20,16 +22,14 @@ TUPLE: inspector-gadget < track object pane ;
<pane> g-> set-inspector-gadget-pane <scroller> 1 track,
] make-gadget ;
: inspect-object ( obj inspector -- )
[ set-inspector-gadget-object ] keep refresh ;
: inspect-object ( obj mirror keys inspector -- )
2nip swap >>object refresh ;
\ &push H{ { +nullary+ t } { +listener+ t } } define-command
\ &back H{ { +nullary+ t } { +listener+ t } } define-command
: globals ( -- ) global inspect ;
\ globals H{ { +nullary+ t } { +listener+ t } } define-command
\ &globals H{ { +nullary+ t } { +listener+ t } } define-command
: inspector-help ( -- ) "ui-inspector" help-window ;
@ -39,7 +39,7 @@ inspector-gadget "toolbar" f {
{ T{ update-object } refresh }
{ f &push }
{ f &back }
{ f globals }
{ f &globals }
{ T{ key-down f f "F1" } inspector-help }
} define-command-map