Add slot editing to UI inspector, remove slot editing from TTY inspector
Slava Pestov
parent
51232b4451
commit
723626a9d2
|
|
@ -1,4 +1,5 @@
|
|||
USING: help.markup help.syntax kernel classes io io.styles mirrors ;
|
||||
USING: help.markup help.syntax kernel classes io io.styles mirrors
|
||||
inspector.private ;
|
||||
IN: inspector
|
||||
|
||||
ARTICLE: "inspector" "The inspector"
|
||||
|
|
@ -16,23 +17,11 @@ $nl
|
|||
{ $subsection &delete }
|
||||
"A variable holding the current object:"
|
||||
{ $subsection me }
|
||||
"A variable holding inspector history:"
|
||||
{ $subsection inspector-stack }
|
||||
"A customization hook:"
|
||||
{ $subsection inspector-hook }
|
||||
"A description of an object can be printed without starting the inspector:"
|
||||
{ $subsection describe }
|
||||
{ $subsection describe* } ;
|
||||
{ $subsection describe } ;
|
||||
|
||||
ABOUT: "inspector"
|
||||
|
||||
HELP: value-editor
|
||||
{ $values { "path" "a sequence of keys" } }
|
||||
{ $description "Prettyprints the value at a path, and if the output stream supports it, a graphical gadget for editing the object." }
|
||||
{ $notes "To learn about paths, see " { $link "mirrors" } "." } ;
|
||||
|
||||
{ presented-path presented-printer value-editor } related-words
|
||||
|
||||
HELP: describe
|
||||
{ $values { "obj" object } }
|
||||
{ $description "Print a tabular overview of the object."
|
||||
|
|
@ -40,11 +29,6 @@ $nl
|
|||
"For sequences and hashtables, this outputs the entries of the collection. For all other object types, slot names and values are shown." }
|
||||
{ $examples { $code "global describe" } } ;
|
||||
|
||||
HELP: describe*
|
||||
{ $values { "obj" object } { "mirror" mirror } { "keys" "a sequence of objects" } }
|
||||
{ $description "Print a tabular overview of the object." }
|
||||
{ $notes "This word is a factor of " { $link describe } " and " { $link inspect } "." } ;
|
||||
|
||||
HELP: inspector-stack
|
||||
{ $var-description "If the inspector is running, this variable holds previously-inspected objects." } ;
|
||||
|
||||
|
|
@ -91,8 +75,3 @@ HELP: &back
|
|||
|
||||
HELP: me
|
||||
{ $var-description "The currently inspected object." } ;
|
||||
|
||||
HELP: inspector-hook
|
||||
{ $var-description "A quotation with stack effect " { $snippet "( obj -- )" } ", called by the inspector to display an overview of an object."
|
||||
$nl
|
||||
"The default implementation calls " { $link describe } " which outputs on " { $link output-stream } ", but the graphical listener sets this variable so that calling " { $link inspect } " in the UI opens the graphical inspector." } ;
|
||||
|
|
|
|||
|
|
@ -10,8 +10,6 @@ H{ } describe
|
|||
|
||||
[ "fixnum instance\n" ] [ [ 3 describe ] with-string-writer ] unit-test
|
||||
|
||||
[ ] [ inspector-hook get-global inspector-hook set ] unit-test
|
||||
|
||||
[ ] [ H{ } clone inspect ] unit-test
|
||||
|
||||
[ ] [ "a" "b" &add ] unit-test
|
||||
|
|
|
|||
|
|
@ -1,64 +1,53 @@
|
|||
! Copyright (C) 2005, 2008 Slava Pestov.
|
||||
! Copyright (C) 2005, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays generic hashtables io kernel assocs math
|
||||
namespaces prettyprint sequences strings io.styles vectors words
|
||||
quotations mirrors splitting math.parser classes vocabs refs
|
||||
sets sorting summary debugger continuations fry ;
|
||||
namespaces prettyprint prettyprint.custom prettyprint.sections
|
||||
sequences strings io.styles vectors words quotations mirrors
|
||||
splitting math.parser classes vocabs sets sorting summary
|
||||
debugger continuations fry combinators ;
|
||||
IN: inspector
|
||||
|
||||
: value-editor ( path -- )
|
||||
[
|
||||
[ pprint-short ] presented-printer set
|
||||
dup presented-path set
|
||||
] H{ } make-assoc
|
||||
[ get-ref pprint-short ] with-nesting ;
|
||||
|
||||
SYMBOL: +sequence+
|
||||
SYMBOL: +number-rows+
|
||||
SYMBOL: +editable+
|
||||
|
||||
: write-slot-editor ( path -- )
|
||||
[
|
||||
+editable+ get [
|
||||
value-editor
|
||||
] [
|
||||
get-ref pprint-short
|
||||
] if
|
||||
] with-cell ;
|
||||
|
||||
: write-key ( mirror key -- )
|
||||
+sequence+ get
|
||||
[ 2drop ] [ <key-ref> write-slot-editor ] if ;
|
||||
|
||||
: write-value ( mirror key -- )
|
||||
<value-ref> write-slot-editor ;
|
||||
|
||||
: describe-row ( mirror key n -- )
|
||||
[
|
||||
+number-rows+ get [ pprint-cell ] [ drop ] if
|
||||
[ write-key ] [ write-value ] 2bi
|
||||
] with-row ;
|
||||
|
||||
: summary. ( obj -- ) [ summary ] keep write-object nl ;
|
||||
|
||||
: sorted-keys ( assoc -- alist )
|
||||
dup hashtable? [
|
||||
keys
|
||||
[ [ unparse-short ] keep ] { } map>assoc
|
||||
sort-keys values
|
||||
] [ keys ] if ;
|
||||
<PRIVATE
|
||||
|
||||
: describe* ( obj mirror keys -- )
|
||||
[ summary. ] 2dip
|
||||
[ drop ] [
|
||||
dup enum? [ +sequence+ on ] when
|
||||
standard-table-style [
|
||||
swap '[ [ _ ] 2dip describe-row ] each-index
|
||||
] tabular-output
|
||||
] if-empty ;
|
||||
: sort-unparsed-keys ( assoc -- alist )
|
||||
>alist dup keys
|
||||
[ unparse-short ] map
|
||||
zip sort-values keys ;
|
||||
|
||||
: describe ( obj -- )
|
||||
dup make-mirror dup sorted-keys describe* ;
|
||||
GENERIC: add-numbers ( alist -- table' )
|
||||
|
||||
M: enum add-numbers ;
|
||||
|
||||
M: assoc add-numbers
|
||||
+number-rows+ get [
|
||||
dup length [ prefix ] 2map
|
||||
] when ;
|
||||
|
||||
TUPLE: slot-name name ;
|
||||
|
||||
M: slot-name pprint* name>> text ;
|
||||
|
||||
GENERIC: fix-slot-names ( assoc -- assoc )
|
||||
|
||||
M: assoc fix-slot-names >alist ;
|
||||
|
||||
M: mirror fix-slot-names
|
||||
[ [ slot-name boa ] dip ] { } assoc-map-as ;
|
||||
|
||||
: (describe) ( obj assoc -- keys )
|
||||
pprint-string-cells? on
|
||||
[ summary. ] [
|
||||
dup hashtable? [ sort-unparsed-keys ] when
|
||||
[ fix-slot-names add-numbers simple-table. ] [ keys ] bi
|
||||
] bi* ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: describe ( obj -- ) dup make-mirror (describe) drop ;
|
||||
|
||||
M: tuple error. describe ;
|
||||
|
||||
|
|
@ -72,25 +61,28 @@ M: tuple error. describe ;
|
|||
: :vars ( -- )
|
||||
error-continuation get name>> namestack. ;
|
||||
|
||||
SYMBOL: inspector-hook
|
||||
SYMBOL: me
|
||||
|
||||
[ t +number-rows+ [ describe* ] with-variable ] inspector-hook set-global
|
||||
<PRIVATE
|
||||
|
||||
SYMBOL: inspector-stack
|
||||
|
||||
SYMBOL: me
|
||||
SYMBOL: sorted-keys
|
||||
|
||||
: reinspect ( obj -- )
|
||||
[ me set ]
|
||||
[
|
||||
dup make-mirror dup mirror set dup sorted-keys dup \ keys set
|
||||
inspector-hook get call
|
||||
dup make-mirror dup mirror set
|
||||
t +number-rows+ [ (describe) ] with-variable
|
||||
sorted-keys set
|
||||
] bi ;
|
||||
|
||||
: (inspect) ( obj -- )
|
||||
[ inspector-stack get push ] [ reinspect ] bi ;
|
||||
|
||||
: key@ ( n -- key ) \ keys get nth ;
|
||||
PRIVATE>
|
||||
|
||||
: key@ ( n -- key ) sorted-keys get nth ;
|
||||
|
||||
: &push ( -- obj ) me get ;
|
||||
|
||||
|
|
@ -98,7 +90,7 @@ SYMBOL: me
|
|||
|
||||
: &back ( -- )
|
||||
inspector-stack get
|
||||
dup length 1 <= [ drop ] [ dup pop* peek reinspect ] if ;
|
||||
dup length 1 <= [ drop ] [ [ pop* ] [ peek reinspect ] bi ] if ;
|
||||
|
||||
: &add ( value key -- ) mirror get set-at &push reinspect ;
|
||||
|
||||
|
|
|
|||
|
|
@ -106,12 +106,6 @@ HELP: font-style
|
|||
HELP: presented
|
||||
{ $description "Character and paragraph style. An object associated with the text. In the Factor UI, this is shown as a clickable presentation of the object; left-clicking invokes a default command, and right-clicking shows a menu of commands." } ;
|
||||
|
||||
HELP: presented-path
|
||||
{ $description "Character and paragraph style. An editable object associated with the text. In the Factor UI, this is shown as a clickable presentation of the object path together with an expander button which displays an object editor; left-clicking invokes a default command, and right-clicking shows a menu of commands." } ;
|
||||
|
||||
HELP: presented-printer
|
||||
{ $description "Character and paragraph style. A quotation with stack effect " { $snippet "( obj -- )" } " which is applied to the value at the " { $link presented-path } " if the presentation needs to be re-displayed after the object has been edited." } ;
|
||||
|
||||
HELP: page-color
|
||||
{ $description "Paragraph style. Background color of the paragraph block, denoted by a sequence of four numbers between 0 and 1 (red, green, blue and alpha)." }
|
||||
{ $examples
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
! Copyright (C) 2005, 2008 Slava Pestov.
|
||||
! Copyright (C) 2005, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: hashtables io colors summary make accessors splitting
|
||||
kernel ;
|
||||
|
|
@ -18,8 +18,6 @@ SYMBOL: font-style
|
|||
|
||||
! Presentation
|
||||
SYMBOL: presented
|
||||
SYMBOL: presented-path
|
||||
SYMBOL: presented-printer
|
||||
|
||||
SYMBOL: href
|
||||
|
||||
|
|
|
|||
|
|
@ -149,14 +149,16 @@ PRIVATE>
|
|||
|
||||
: .c ( -- ) callstack callstack. ;
|
||||
|
||||
: pprint-cell ( obj -- ) [ pprint ] with-cell ;
|
||||
: pprint-cell ( obj -- ) [ pprint-short ] with-cell ;
|
||||
|
||||
SYMBOL: pprint-string-cells?
|
||||
|
||||
: simple-table. ( values -- )
|
||||
standard-table-style [
|
||||
[
|
||||
[
|
||||
[
|
||||
dup string?
|
||||
dup string? pprint-string-cells? get not and
|
||||
[ [ write ] with-cell ]
|
||||
[ pprint-cell ]
|
||||
if
|
||||
|
|
|
|||
|
|
@ -27,8 +27,6 @@ GENERIC: flush-gl-context ( handle -- )
|
|||
|
||||
HOOK: offscreen-pixels ui-backend ( world -- alien w h )
|
||||
|
||||
HOOK: beep ui-backend ( -- )
|
||||
|
||||
: with-gl-context ( handle quot -- )
|
||||
swap [ select-gl-context call ] keep
|
||||
glFlush flush-gl-context gl-error ; inline
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
! Copyright (C) 2005, 2008 Slava Pestov.
|
||||
! Copyright (C) 2005, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays ui.gadgets ui.gadgets.borders ui.gadgets.buttons
|
||||
ui.gadgets.labels ui.gadgets.scrollers ui.gadgets.paragraphs
|
||||
|
|
@ -7,7 +7,7 @@ ui.gadgets.menus ui.clipboards ui.gestures ui.traverse ui.render
|
|||
hashtables io kernel namespaces sequences io.styles strings
|
||||
quotations math opengl combinators math.vectors sorting
|
||||
splitting io.streams.nested assocs ui.gadgets.presentations
|
||||
ui.gadgets.slots ui.gadgets.grids ui.gadgets.grid-lines
|
||||
ui.gadgets.grids ui.gadgets.grid-lines
|
||||
classes.tuple models continuations destructors accessors
|
||||
math.geometry.rect fry ;
|
||||
IN: ui.gadgets.panes
|
||||
|
|
@ -221,22 +221,14 @@ M: pane-stream make-span-stream
|
|||
: apply-page-color-style ( style gadget -- style gadget )
|
||||
page-color [ solid-interior ] apply-style ;
|
||||
|
||||
: apply-path-style ( style gadget -- style gadget )
|
||||
presented-path [ <editable-slot> ] apply-style ;
|
||||
|
||||
: apply-border-width-style ( style gadget -- style gadget )
|
||||
border-width [ <border> ] apply-style ;
|
||||
|
||||
: apply-printer-style ( style gadget -- style gadget )
|
||||
presented-printer [ '[ _ make-pane ] >>printer ] apply-style ;
|
||||
|
||||
: style-pane ( style pane -- pane )
|
||||
apply-border-width-style
|
||||
apply-border-color-style
|
||||
apply-page-color-style
|
||||
apply-presentation-style
|
||||
apply-path-style
|
||||
apply-printer-style
|
||||
nip ;
|
||||
|
||||
TUPLE: nested-pane-stream < pane-stream style parent ;
|
||||
|
|
|
|||
|
|
@ -1,10 +1,10 @@
|
|||
! Copyright (C) 2007, 2008 Slava Pestov.
|
||||
! Copyright (C) 2007, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors namespaces kernel parser prettyprint
|
||||
sequences arrays io math definitions math.vectors assocs refs
|
||||
ui.gadgets ui.gestures ui.commands ui.gadgets.scrollers
|
||||
ui.gadgets.buttons ui.gadgets.borders ui.gadgets.tracks
|
||||
ui.gadgets.editors eval ;
|
||||
ui.gadgets.editors eval continuations ;
|
||||
IN: ui.gadgets.slots
|
||||
|
||||
TUPLE: update-object ;
|
||||
|
|
@ -13,40 +13,44 @@ TUPLE: update-slot ;
|
|||
|
||||
TUPLE: edit-slot ;
|
||||
|
||||
TUPLE: slot-editor < track ref text ;
|
||||
TUPLE: slot-editor < track ref close-hook update-hook text ;
|
||||
|
||||
: revert ( slot-editor -- )
|
||||
dup ref>> get-ref unparse-use
|
||||
swap text>> set-editor-string ;
|
||||
[ ref>> get-ref unparse-use ] [ text>> ] bi set-editor-string ;
|
||||
|
||||
\ revert H{
|
||||
{ +description+ "Revert any uncomitted changes." }
|
||||
} define-command
|
||||
|
||||
GENERIC: finish-editing ( slot-editor ref -- )
|
||||
: close ( slot-editor -- )
|
||||
dup close-hook>> call ;
|
||||
|
||||
M: key-ref finish-editing
|
||||
drop T{ update-object } swap propagate-gesture ;
|
||||
\ close H{
|
||||
{ +description+ "Close the slot editor without saving changes." }
|
||||
} define-command
|
||||
|
||||
M: value-ref finish-editing
|
||||
drop T{ update-slot } swap propagate-gesture ;
|
||||
: close-and-update ( slot-editor -- )
|
||||
[ update-hook>> call ] [ close ] bi ;
|
||||
|
||||
: slot-editor-value ( slot-editor -- object )
|
||||
text>> control-value parse-fresh ;
|
||||
text>> control-value parse-fresh first ;
|
||||
|
||||
: commit ( slot-editor -- )
|
||||
dup text>> control-value parse-fresh first
|
||||
over ref>> set-ref
|
||||
dup ref>> finish-editing ;
|
||||
[ [ slot-editor-value ] [ ref>> ] bi set-ref ]
|
||||
[ close-and-update ]
|
||||
bi ;
|
||||
|
||||
\ commit H{
|
||||
{ +description+ "Parse the object being edited, and store the result back into the edited slot." }
|
||||
} define-command
|
||||
|
||||
: eval-1 ( string -- object )
|
||||
1array [ eval ] with-datastack first ;
|
||||
|
||||
: com-eval ( slot-editor -- )
|
||||
[ text>> editor-string eval ] keep
|
||||
[ ref>> set-ref ] keep
|
||||
dup ref>> finish-editing ;
|
||||
[ [ text>> editor-string eval-1 ] [ ref>> ] bi set-ref ]
|
||||
[ close-and-update ]
|
||||
bi ;
|
||||
|
||||
\ com-eval H{
|
||||
{ +listener+ t }
|
||||
|
|
@ -54,23 +58,17 @@ M: value-ref finish-editing
|
|||
} define-command
|
||||
|
||||
: delete ( slot-editor -- )
|
||||
dup ref>> delete-ref
|
||||
T{ update-object } swap propagate-gesture ;
|
||||
[ ref>> delete-ref ] [ close-and-update ] bi ;
|
||||
|
||||
\ delete H{
|
||||
{ +description+ "Delete the slot and close the slot editor." }
|
||||
} define-command
|
||||
|
||||
: close ( slot-editor -- )
|
||||
T{ update-slot } swap propagate-gesture ;
|
||||
|
||||
\ close H{
|
||||
{ +description+ "Close the slot editor without saving changes." }
|
||||
} define-command
|
||||
|
||||
: <slot-editor> ( ref -- gadget )
|
||||
: <slot-editor> ( close-hook update-hook ref -- gadget )
|
||||
{ 0 1 } slot-editor new-track
|
||||
swap >>ref
|
||||
swap >>update-hook
|
||||
swap >>close-hook
|
||||
add-toolbar
|
||||
<source-editor> >>text
|
||||
dup text>> <scroller> 1 track-add
|
||||
|
|
@ -87,39 +85,3 @@ slot-editor "toolbar" f {
|
|||
{ f delete }
|
||||
{ T{ key-down f f "ESC" } close }
|
||||
} define-command-map
|
||||
|
||||
TUPLE: editable-slot < track printer ref ;
|
||||
|
||||
: <edit-button> ( -- gadget )
|
||||
"..."
|
||||
[ T{ edit-slot } swap propagate-gesture ]
|
||||
<roll-button> ;
|
||||
|
||||
: display-slot ( gadget editable-slot -- )
|
||||
dup clear-track
|
||||
swap 1 track-add
|
||||
<edit-button> f track-add
|
||||
drop ;
|
||||
|
||||
: update-slot ( editable-slot -- )
|
||||
[ [ ref>> get-ref ] [ printer>> ] bi call ] keep
|
||||
display-slot ;
|
||||
|
||||
: edit-slot ( editable-slot -- )
|
||||
[ clear-track ]
|
||||
[
|
||||
dup ref>> <slot-editor>
|
||||
[ 1 track-add drop ]
|
||||
[ [ scroll>gadget ] [ request-focus ] bi* ] 2bi
|
||||
] bi ;
|
||||
|
||||
\ editable-slot H{
|
||||
{ T{ update-slot } [ update-slot ] }
|
||||
{ T{ edit-slot } [ edit-slot ] }
|
||||
} set-gestures
|
||||
|
||||
: <editable-slot> ( gadget ref -- editable-slot )
|
||||
{ 1 0 } editable-slot new-track
|
||||
swap >>ref
|
||||
[ drop <gadget> ] >>printer
|
||||
[ display-slot ] keep ;
|
||||
|
|
|
|||
|
|
@ -183,15 +183,22 @@ M: table pref-dim*
|
|||
[ control-value length ]
|
||||
bi * 2array ;
|
||||
|
||||
: nth-row ( row table -- value/f )
|
||||
over [ control-value nth ] [ 2drop f ] if ;
|
||||
: nth-row ( row table -- value/f ? )
|
||||
over [ control-value nth t ] [ 2drop f f ] if ;
|
||||
|
||||
: selected-row ( table -- value/f )
|
||||
[ selected-index>> ] keep [ nth-row ] keep
|
||||
over [ renderer>> row-value ] [ drop ] if ;
|
||||
PRIVATE>
|
||||
|
||||
: (selected-row) ( table -- value/f ? )
|
||||
[ selected-index>> ] keep nth-row ;
|
||||
|
||||
: selected-row ( table -- value/f ? )
|
||||
[ (selected-row) ] keep
|
||||
swap [ renderer>> row-value t ] [ 2drop f f ] if ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: update-selected-value ( table -- )
|
||||
[ selected-row ] [ selected-value>> ] bi set-model ;
|
||||
[ selected-row drop ] [ selected-value>> ] bi set-model ;
|
||||
|
||||
M: table model-changed
|
||||
nip
|
||||
|
|
@ -219,8 +226,7 @@ M: table model-changed
|
|||
] if ;
|
||||
|
||||
: row-action ( table -- )
|
||||
dup selected-row dup
|
||||
[ swap action>> call ] [ 2drop ] if ;
|
||||
dup selected-row [ swap action>> call ] [ 2drop ] if ;
|
||||
|
||||
: table-button-up ( table -- )
|
||||
hand-click# get 2 =
|
||||
|
|
@ -259,13 +265,13 @@ M: table model-changed
|
|||
[ swap >>mouse-index relayout-1 ]
|
||||
[
|
||||
[ nth-row ] keep
|
||||
over [ show-row-summary ] [ 2drop ] if
|
||||
swap [ show-row-summary ] [ 2drop ] if
|
||||
] 2bi
|
||||
] [ hide-mouse-help ] if-mouse-row ;
|
||||
|
||||
: table-operations-menu ( table -- )
|
||||
[
|
||||
[ nth-row ] keep [ renderer>> row-value ] keep
|
||||
[ nth-row drop ] keep [ renderer>> row-value ] keep
|
||||
swap show-operations-menu
|
||||
] [ drop ] if-mouse-row ;
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,6 @@
|
|||
IN: ui.tools.inspector.tests
|
||||
USING: tools.test ui.tools.inspector math ;
|
||||
|
||||
\ <inspector-gadget> must-infer
|
||||
|
||||
[ ] [ \ + <inspector-gadget> com-edit-slot ] unit-test
|
||||
|
|
@ -1,12 +1,12 @@
|
|||
! Copyright (C) 2006, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors inspector namespaces kernel models
|
||||
USING: accessors inspector namespaces kernel models fry
|
||||
models.filter prettyprint sequences mirrors assocs classes
|
||||
io io.styles arrays hashtables math.order sorting
|
||||
io io.styles arrays hashtables math.order sorting refs
|
||||
ui.tools.browser ui.commands ui.gadgets ui.gadgets.panes
|
||||
ui.gadgets.scrollers ui.gadgets.slots ui.gadgets.tracks
|
||||
ui.gestures ui.gadgets.buttons ui.gadgets.tables
|
||||
ui.gadgets.status-bar ui.gadgets.theme ui.gadgets.labelled ;
|
||||
ui.gadgets.status-bar ui.gadgets.theme ui.gadgets.labelled ui ;
|
||||
IN: ui.tools.inspector
|
||||
|
||||
TUPLE: inspector-gadget < track table ;
|
||||
|
|
@ -86,6 +86,19 @@ M: inspector-gadget pref-dim*
|
|||
|
||||
\ com-push H{ { +listener+ t } } define-command
|
||||
|
||||
: slot-editor-window ( close-hook update-hook assoc key key-string -- )
|
||||
[ <value-ref> <slot-editor> ] [ "Slot editor: " prepend ] bi*
|
||||
open-window ;
|
||||
|
||||
: com-edit-slot ( inspector -- )
|
||||
[ close-window ] swap
|
||||
[ '[ _ com-refresh ] ]
|
||||
[ control-value make-mirror ]
|
||||
[ table>> (selected-row) ] tri [
|
||||
[ key>> ] [ key-string>> ] bi
|
||||
slot-editor-window
|
||||
] [ 2drop 2drop ] if ;
|
||||
|
||||
: inspector-help ( -- ) "ui-inspector" com-follow ;
|
||||
|
||||
\ inspector-help H{ { +nullary+ t } } define-command
|
||||
|
|
@ -93,6 +106,7 @@ M: inspector-gadget pref-dim*
|
|||
inspector-gadget "toolbar" f {
|
||||
{ T{ update-object } com-refresh }
|
||||
{ T{ key-down f f "p" } com-push }
|
||||
{ T{ key-down f f "e" } com-edit-slot }
|
||||
{ T{ key-down f f "F1" } inspector-help }
|
||||
} define-command-map
|
||||
|
||||
|
|
|
|||
|
|
@ -59,6 +59,9 @@ HELP: with-ui
|
|||
{ $notes "This combinator should be used in the " { $link POSTPONE: MAIN: } " word of a vocabulary, in order for the vocabulary to work when run from the UI listener (" { $snippet "\"my-app\" run" } " and the command line (" { $snippet "./factor -run=my-app" } ")." }
|
||||
{ $examples "The " { $vocab-link "hello-ui" } " vocabulary implements a simple UI application which uses this combinator." } ;
|
||||
|
||||
HELP: beep
|
||||
{ $description "Plays the system beep sound." } ;
|
||||
|
||||
ARTICLE: "ui-glossary" "UI glossary"
|
||||
{ $table
|
||||
{ "color" { "an instance of " { $link color } } }
|
||||
|
|
|
|||
|
|
@ -192,4 +192,6 @@ HOOK: (with-ui) ui-backend ( quot -- )
|
|||
windows get empty? not ;
|
||||
|
||||
: with-ui ( quot -- )
|
||||
ui-running? [ call ] [ '[ init-ui @ ] (with-ui) ] if ;
|
||||
ui-running? [ call ] [ '[ init-ui @ ] (with-ui) ] if ;
|
||||
|
||||
HOOK: beep ui-backend ( -- )
|
||||
Loading…
Reference in New Issue