steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
basis/ui/gadgets/buttons/buttons.factor
View File

@ -231,11 +231,12 @@ PRIVATE>
[ <radio-button> ] <radio-controls> [ <radio-button> ] <radio-controls>
{ 5 5 } >>gap ; { 5 5 } >>gap ;
: command-button-quot ( gesture command -- quot ) : command-button-quot ( target command -- quot )
'[ _ _ invoke-command drop ] ; '[ _ _ invoke-command ] ;
: <command-button> ( target gesture command -- button ) : <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 ) : <toolbar> ( target -- toolbar )
<shelf> <shelf>

12
basis/ui/gadgets/tables/tables.factor
View File

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

2
basis/ui/tools/browser/popups/popups.factor
View File

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

12
basis/ui/tools/listener/listener.factor
View File

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