Table hooks now receive the table as an input parameter

db4
Slava Pestov 2009-02-18 21:00:31 -06:00
parent d6a2f9b84b
commit 706fb33e38
4 changed files with 19 additions and 14 deletions

View File

@ -231,11 +231,12 @@ PRIVATE>
[ <radio-button> ] <radio-controls>
{ 5 5 } >>gap ;
: command-button-quot ( gesture command -- quot )
'[ _ _ invoke-command drop ] ;
: command-button-quot ( target command -- quot )
'[ _ _ invoke-command ] ;
: <command-button> ( target gesture command -- button )
[ command-string swap ] keep command-button-quot <border-button> ;
[ command-string swap ] keep command-button-quot
'[ drop @ ] <border-button> ;
: <toolbar> ( target -- toolbar )
<shelf>

View File

@ -33,7 +33,7 @@ TUPLE: table < line-gadget
{ renderer initial: trivial-renderer }
{ action initial: [ drop ] }
single-click?
{ hook initial: [ ] }
{ hook initial: [ drop ] }
{ gap initial: 2 }
column-widths total-width
focus-border-color
@ -274,7 +274,7 @@ PRIVATE>
: row-action ( table -- )
dup selected-row
[ swap [ action>> call ] [ hook>> call ] bi ]
[ swap [ action>> call ] [ dup hook>> call ] bi ]
[ 2drop ]
if ;
@ -336,7 +336,13 @@ PRIVATE>
: show-table-menu ( table -- )
[
[ nip ]
[ [ nth-row drop ] [ renderer>> row-value ] [ hook>> ] tri ] 2bi
[ swap select-row ]
[
[ nth-row drop ]
[ renderer>> row-value ]
[ dup hook>> curry ]
tri
] 2tri
show-operations-menu
] [ drop ] if-mouse-row ;

View File

@ -27,7 +27,7 @@ TUPLE: links-popup < wrapper ;
'[ @ sorted-links ] <filter>
link-renderer [ second ] <search-table>
[ invoke-primary-operation ] >>action
dup '[ _ hide-glass ] >>hook
[ hide-glass ] >>hook
t >>selection-required? ;
: <links-popup> ( model quot title -- gadget )

View File

@ -291,13 +291,11 @@ M: object accept-completion-hook 2drop ;
[ history>> history-add drop ] [ control-value ] [ select-all ] tri
[ parse-lines ] with-compilation-unit ;
:: <debugger-popup> ( interactor error continuation -- popup )
error continuation error compute-restarts
[ interactor hide-glass ] <debugger>
"Error" <labeled-gadget> ;
: <debugger-popup> ( error continuation -- popup )
over compute-restarts [ hide-glass ] <debugger> "Error" <labeled-gadget> ;
: debugger-popup ( interactor error continuation -- )
[ [ drop one-line-elt ] 2keep ] dip <debugger-popup> show-listener-popup ;
[ one-line-elt ] 2dip <debugger-popup> show-listener-popup ;
: handle-parse-error ( interactor error -- )
dup lexer-error? [ 2dup go-to-error error>> ] when
@ -360,7 +358,7 @@ interactor "completion" f {
: listener-thread ( listener -- )
dup listener-streams [
[ com-follow ] help-hook set
[ com-browse ] help-hook set
'[ [ _ input>> ] 2dip debugger-popup ] error-hook set
welcome.
listener
@ -384,7 +382,7 @@ interactor "completion" f {
[ wait-for-listener ]
} cleave ;
: listener-help ( -- ) "ui-listener" com-follow ;
: listener-help ( -- ) "ui-listener" com-browse ;
\ listener-help H{ { +nullary+ t } } define-command