Add shortcuts for scrolling up/down to listener

basis/ui/tools/browser/browser.factor

@@ -5,7 +5,8 @@ assocs words vocabs accessors fry combinators.short-circuit
 models models.history tools.apropos ui.tools.workspace
 ui.commands ui.gadgets ui.gadgets.panes ui.gadgets.scrollers
 ui.gadgets.tracks ui.gestures ui.gadgets.buttons ui.gadgets.packs
-ui.gadgets.editors ui.gadgets.labels ui.gadgets.status-bar ui ;
+ui.gadgets.editors ui.gadgets.labels ui.gadgets.status-bar
+ui.tools.common ui ;
 IN: ui.tools.browser
 
 TUPLE: browser-gadget < track pane scroller search-field ;
@@ -83,18 +84,6 @@ M: browser-gadget focusable-child* search-field>> ;
 
 \ browser-help H{ { +nullary+ t } } define-command
 
-: com-page-up ( browser -- )
-    scroller>> scroll-up-page ;
-
-: com-page-down ( browser -- )
-    scroller>> scroll-down-page ;
-
-: com-scroll-up ( browser -- )
-    scroller>> scroll-up-line ;
-
-: com-scroll-down ( browser -- )
-    scroller>> scroll-down-line ;
-
 browser-gadget "toolbar" f {
     { T{ key-down f { A+ } "LEFT" } com-back }
     { T{ key-down f { A+ } "RIGHT" } com-forward }

basis/ui/tools/common/common.factor

@@ -0,0 +1,16 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors ui.gadgets.scrollers ;
+IN: ui.tools.common
+
+: com-page-up ( tool -- )
+    scroller>> scroll-up-page ;
+
+: com-page-down ( tool -- )
+    scroller>> scroll-down-page ;
+
+: com-scroll-up ( tool -- )
+    scroller>> scroll-up-line ;
+
+: com-scroll-down ( tool -- )
+    scroller>> scroll-down-line ;

basis/ui/tools/listener/listener.factor

@@ -3,15 +3,16 @@
 USING: inspector help help.markup io io.styles kernel models strings
 namespaces parser quotations sequences vocabs words prettyprint
 listener debugger threads boxes concurrency.flags math arrays
-generic accessors combinators assocs fry ui.commands ui.gadgets
-ui.gadgets.editors ui.gadgets.labelled ui.gadgets.panes
-ui.gadgets.buttons ui.gadgets.scrollers ui.gadgets.packs
+generic accessors combinators assocs fry generic.standard.engines.tuple
+ui.commands ui.gadgets ui.gadgets.editors ui.gadgets.labelled
+ui.gadgets.panes ui.gadgets.buttons ui.gadgets.scrollers ui.gadgets.packs
 ui.gadgets.tracks ui.gadgets.borders ui.gadgets.frames
 ui.gadgets.grids ui.gestures ui.operations ui.tools.browser
-ui.tools.interactor ui.tools.inspector ui.tools.workspace ;
+ui.tools.interactor ui.tools.inspector ui.tools.workspace
+ui.tools.common ;
 IN: ui.tools.listener
 
-TUPLE: listener-gadget < track input output ;
+TUPLE: listener-gadget < track input output scroller ;
 
 : listener-streams ( listener -- input output )
     [ input>> ] [ output>> <pane-stream> ] bi ;
@@ -85,8 +86,6 @@ M: word word-completion-string
 M: method-body word-completion-string
     "method-generic" word-prop word-completion-string ;
 
-USE: generic.standard.engines.tuple
-
 M: engine-word word-completion-string
     "engine-generic" word-prop word-completion-string ;
 
@@ -152,7 +151,8 @@ M: engine-word word-completion-string
     { 0 1 } listener-gadget new-track
         add-toolbar
         init-listener
-        dup <listener-scroller> 1 track-add ;
+        dup <listener-scroller> >>scroller
+        dup scroller>> 1 track-add ;
 
 : listener-help ( -- ) "ui-listener" com-follow ;
 
@@ -175,6 +175,15 @@ listener-gadget "toolbar" f {
     { T{ key-down f { C+ } "d" } com-end }
 } define-command-map
 
+listener-gadget "scrolling"
+"The listener's scroller can be scrolled from the keyboard."
+{
+    { T{ key-down f { A+ } "UP" } com-scroll-up }
+    { T{ key-down f { A+ } "DOWN" } com-scroll-down }
+    { T{ key-down f { A+ } "PAGE_UP" } com-page-up }
+    { T{ key-down f { A+ } "PAGE_DOWN" } com-page-down }
+} define-command-map
+
 M: listener-gadget graft*
     [ call-next-method ] [ restart-listener ] bi ;
 

basis/ui/tools/tools-docs.factor

@@ -26,6 +26,7 @@ ARTICLE: "ui-listener" "UI listener"
     { "Clickable presentations (see " { $link "ui-presentations" } ")" }
 }
 { $command-map listener-gadget "toolbar" }
+{ $command-map listener-gadget "scrolling" }
 { $command-map interactor "interactor" }
 { $command-map source-editor "word" }
 { $command-map interactor "quotation" }