TUPLE: button < border pressed? selected? quot tooltip ;
+SYMBOL: active-buttons
+active-buttons [ H{ } ] initialize
+
+: label-from-button ( button -- str )
+ children>> [ label? ] find swap [ text>> ] [ drop "unknown" ] if ;
+
+M: button graft* dup label-from-button active-buttons get set-at ;
+
+M: button ungraft* label-from-button active-buttons get delete-at ;
+
<PRIVATE
: find-button ( gadget -- button )
{ T{ key-down f ${ os macosx? M+ A+ ? } "k" } com-show-outgoing-links }
{ T{ key-down f ${ os macosx? M+ A+ ? } "K" } com-show-incoming-links }
{ T{ key-down f ${ os macosx? M+ A+ ? } "f" } browser-focus-search }
+ { T{ key-down f ${ os macosx? C+ A+ ? } "t" } com-show-active-buttons }
} os macosx? [ {
{ T{ key-down f { M+ } "[" } com-back }
{ T{ key-down f { M+ } "]" } com-forward }
: com-show-incoming-links ( browser-gadget -- )
[ usage ] "Incoming links" show-links-popup ;
+
+: <active-buttons-table> ( model -- table )
+ [ keys [ ">" swap 2array ] map ] <arrow> trivial-renderer [ second ] <search-table>
+ dup table>>
+ active-buttons get '[ second _ at invoke-secondary ] >>action
+ [ hide-glass ] >>hook
+ t >>selection-required?
+ 10 >>min-rows
+ 10 >>max-rows
+ 30 >>min-cols
+ 30 >>max-cols drop
+ ;
+
+: <active-buttons-popup> ( model title -- gadget )
+ [ <active-buttons-table> white-interior ] dip
+ popup-color <framed-labeled-gadget> links-popup new-wrapper ;
+
+: show-active-buttons-popup ( browser-gadget model title -- )
+ <active-buttons-popup>
+ [ hand-loc get-global point>rect show-glass ] [ request-focus ] bi ; inline
+
+: com-show-active-buttons ( browser-gadget -- )
+ active-buttons get <model> "Active buttons" show-active-buttons-popup ;