Fix inspector bug
parent
d34d3a6f31
commit
14b5e35a0e
|
@ -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? [
|
||||
2drop
|
||||
] [
|
||||
dup enum? [ +sequence+ on ] when
|
||||
standard-table-style [
|
||||
dup length
|
||||
rot [ -rot describe-row ] curry 2each
|
||||
] tabular-output
|
||||
] if
|
||||
] bind ;
|
||||
: describe* ( obj mirror keys -- )
|
||||
rot summary.
|
||||
dup empty? [
|
||||
2drop
|
||||
] [
|
||||
dup enum? [ +sequence+ on ] when
|
||||
standard-table-style [
|
||||
swap [ -rot describe-row ] curry each-index
|
||||
] tabular-output
|
||||
] 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 ;
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
Loading…
Reference in New Issue