From 5233edb94ada4192b20dd579d4c36832c7c4bc12 Mon Sep 17 00:00:00 2001
From: inivekin <inivekin@gmail.com>
Date: Sat, 27 Mar 2021 14:54:31 +0800
Subject: [PATCH] Adds keyboard driven link following for the browser

---
 basis/ui/gadgets/buttons/buttons.factor     | 10 +++++++++
 basis/ui/tools/browser/browser.factor       |  1 +
 basis/ui/tools/browser/popups/popups.factor | 23 +++++++++++++++++++++
 3 files changed, 34 insertions(+)

diff --git a/basis/ui/gadgets/buttons/buttons.factor b/basis/ui/gadgets/buttons/buttons.factor
index c7609dbe06..4ced17e86c 100644
--- a/basis/ui/gadgets/buttons/buttons.factor
+++ b/basis/ui/gadgets/buttons/buttons.factor
@@ -11,6 +11,16 @@ IN: ui.gadgets.buttons
 
 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 )
diff --git a/basis/ui/tools/browser/browser.factor b/basis/ui/tools/browser/browser.factor
index 65d567afee..461ee21b5c 100644
--- a/basis/ui/tools/browser/browser.factor
+++ b/basis/ui/tools/browser/browser.factor
@@ -217,6 +217,7 @@ browser-gadget "navigation" "Commands for navigating in the article hierarchy" {
     { 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 }
diff --git a/basis/ui/tools/browser/popups/popups.factor b/basis/ui/tools/browser/popups/popups.factor
index 81f5099440..25114b7f5c 100644
--- a/basis/ui/tools/browser/popups/popups.factor
+++ b/basis/ui/tools/browser/popups/popups.factor
@@ -49,3 +49,26 @@ SLOT: model
 
 : 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 ;
-- 
2.34.1