Table hooks now receive the table as an input parameter

diff --git a/basis/ui/gadgets/buttons/buttons.factor b/basis/ui/gadgets/buttons/buttons.factor
index c8eeb62579a1e9b867a64bfd88964529ffe2ef00..ebac290f4bdfc4fc4152d29bbdc912d9bfe1ded7 100644 (file)
--- a/basis/ui/gadgets/buttons/buttons.factor
+++ b/basis/ui/gadgets/buttons/buttons.factor
@@ -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>

diff --git a/basis/ui/gadgets/tables/tables.factor b/basis/ui/gadgets/tables/tables.factor
index 073268e58d38dee93d961a4548da13b050f387fe..003346ca252491872648a84452bb628570a7afb8 100644 (file)
--- a/basis/ui/gadgets/tables/tables.factor
+++ b/basis/ui/gadgets/tables/tables.factor
@@ -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 ;
 

diff --git a/basis/ui/tools/browser/popups/popups.factor b/basis/ui/tools/browser/popups/popups.factor
index 8150dc1a08bf5cfa58718b1180dab0b0dc496b17..a759971a009315be88568d7c34031b00f6eac75a 100644 (file)
--- a/basis/ui/tools/browser/popups/popups.factor
+++ b/basis/ui/tools/browser/popups/popups.factor
@@ -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 )

diff --git a/basis/ui/tools/listener/listener.factor b/basis/ui/tools/listener/listener.factor
index a1bf5ce20d7b32fcf914d6cdca0e4f79a37aa82a..f5974686b6a971f968d39b0d72daee05e91965b5 100644 (file)
--- a/basis/ui/tools/listener/listener.factor
+++ b/basis/ui/tools/listener/listener.factor
@@ -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