From 24d55cc6a679988c4249ed4858a1ece64c30b084 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 6 Jan 2009 13:56:14 -0600
Subject: [PATCH] Browser tool is now its own window; update help-window usages
 to open browser instead

---
 basis/ui/tools/browser/browser.factor     | 90 +++++++++++++++--------
 basis/ui/tools/deploy/deploy.factor       | 15 ++--
 basis/ui/tools/inspector/inspector.factor |  9 ++-
 basis/ui/tools/listener/listener.factor   |  9 +--
 basis/ui/tools/profiler/profiler.factor   |  4 +-
 basis/ui/tools/tools-docs.factor          |  1 +
 basis/ui/tools/tools.factor               | 12 +--
 basis/ui/tools/walker/walker.factor       |  6 +-
 basis/ui/tools/workspace/workspace.factor | 23 +-----
 9 files changed, 86 insertions(+), 83 deletions(-)

diff --git a/basis/ui/tools/browser/browser.factor b/basis/ui/tools/browser/browser.factor
index 2018d5b622..094739e8c3 100644
--- a/basis/ui/tools/browser/browser.factor
+++ b/basis/ui/tools/browser/browser.factor
@@ -1,49 +1,50 @@
-! Copyright (C) 2006, 2008 Slava Pestov.
+! Copyright (C) 2006, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: debugger ui.tools.workspace help help.topics kernel
-models models.history tools.apropos 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 models compiler.units
-assocs words vocabs accessors fry combinators.short-circuit ;
+USING: debugger help help.topics kernel models compiler.units
+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 ;
 IN: ui.tools.browser
 
-TUPLE: browser-gadget < track pane history ;
+TUPLE: browser-gadget < track pane scroller search-field ;
 
 : show-help ( link browser-gadget -- )
-    history>> dup add-history
+    model>> dup add-history
     [ >link ] dip set-model ;
 
 : <help-pane> ( browser-gadget -- gadget )
-    history>> [ '[ _ print-topic ] try ] <pane-control> ;
-
-: init-history ( browser-gadget -- )
-    "handbook" >link <history> >>history drop ;
+    model>> [ '[ _ print-topic ] try ] <pane-control> ;
 
 : search-browser ( string browser -- )
     [ <apropos> ] dip show-help ;
 
 : <search-field> ( browser -- field )
-    '[ _ search-browser ] <action-field> 10 >>min-width 10 >>max-width ;
+    '[ _ search-browser ] <action-field>
+        10 >>min-width
+        10 >>max-width ;
 
 : <browser-toolbar> ( browser -- toolbar )
     <shelf>
         { 5 5 } >>gap
         over <toolbar> add-gadget
         "Search:" <label> add-gadget
-        swap <search-field> add-gadget ;
+        swap search-field>> add-gadget ;
 
-: <browser-gadget> ( -- gadget )
+: <help-pane-scroller> ( browser -- scroller )
+    pane>> <limited-scroller>
+        { 550 700 } >>max-dim
+        { 550 700 } >>min-dim ;
+
+: <browser-gadget> ( link -- gadget )
     { 0 1 } browser-gadget new-track
-        dup init-history
+        swap <history> >>model
+        dup <search-field> >>search-field
         dup <browser-toolbar> f track-add
         dup <help-pane> >>pane
-        dup pane>> <scroller> 1 track-add ;
-
-M: browser-gadget call-tool* show-help ;
-
-M: browser-gadget tool-scroller
-    pane>> find-scroller ;
+        dup <help-pane-scroller> >>scroller
+        dup scroller>> 1 track-add ;
 
 M: browser-gadget graft*
     [ add-definition-observer ] [ call-next-method ] bi ;
@@ -59,25 +60,43 @@ M: browser-gadget ungraft*
     } 2|| ;
 
 M: browser-gadget definitions-changed ( assoc browser -- )
-    history>>
-    dup value>> rot showing-definition?
+    model>> tuck value>> swap showing-definition?
     [ notify-connections ] [ drop ] if ;
 
-: help-action ( browser-gadget -- link )
-    history>> value>> >link ;
+M: browser-gadget focusable-child* search-field>> ;
 
-: com-follow ( link -- ) browser-gadget call-tool ;
+: open-browser-window ( link -- )
+    <browser-gadget> "Browser" open-window ;
 
-: com-back ( browser -- ) history>> go-back ;
+: browser-window ( link -- )
+    [ browser-gadget? ] find-window
+    [ [ raise-window ] [ gadget-child show-help ] bi ]
+    [ open-browser-window ] if* ;
 
-: com-forward ( browser -- ) history>> go-forward ;
+: com-follow ( link -- ) browser-window ;
+
+: com-back ( browser -- ) model>> go-back ;
+
+: com-forward ( browser -- ) model>> go-forward ;
 
 : com-documentation ( browser -- ) "handbook" swap show-help ;
 
-: browser-help ( -- ) "ui-browser" help-window ;
+: browser-help ( -- ) "ui-browser" browser-window ;
 
 \ 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 }
@@ -89,3 +108,12 @@ browser-gadget "multi-touch" f {
     { T{ left-action } com-back }
     { T{ right-action } com-forward }
 } define-command-map
+
+browser-gadget "scrolling"
+"The browser's scroll pane can be scrolled from the keyboard."
+{
+    { T{ key-down f f "UP" } com-scroll-up }
+    { T{ key-down f f "DOWN" } com-scroll-down }
+    { T{ key-down f f "PAGE_UP" } com-page-up }
+    { T{ key-down f f "PAGE_DOWN" } com-page-down }
+} define-command-map
\ No newline at end of file
diff --git a/basis/ui/tools/deploy/deploy.factor b/basis/ui/tools/deploy/deploy.factor
index afb1e4e8b5..d3d2c5c9fb 100644
--- a/basis/ui/tools/deploy/deploy.factor
+++ b/basis/ui/tools/deploy/deploy.factor
@@ -1,11 +1,12 @@
-! Copyright (C) 2007, 2008 Slava Pestov.
+! Copyright (C) 2007, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: ui.gadgets colors kernel ui.render namespaces models
-models.mapping sequences ui.gadgets.buttons ui.gadgets.packs
-ui.gadgets.labels tools.deploy.config tools.deploy.config.editor
-namespaces ui.gadgets.editors ui.gadgets.borders ui.gestures
+USING: colors kernel namespaces models tools.deploy.config
+tools.deploy.config.editor tools.deploy vocabs
+namespaces models.mapping sequences system accessors fry
+ui.gadgets ui.render ui.gadgets.buttons ui.gadgets.packs
+ui.gadgets.labels ui.gadgets.editors ui.gadgets.borders ui.gestures
 ui.commands assocs ui.gadgets.tracks ui ui.tools.listener
-tools.deploy vocabs ui.tools.workspace system accessors fry ;
+ui.tools.browser ;
 IN: ui.tools.deploy
 
 TUPLE: deploy-gadget < pack vocab settings ;
@@ -81,7 +82,7 @@ TUPLE: deploy-gadget < pack vocab settings ;
     close-window ;
 
 : com-help ( -- )
-    "ui.tools.deploy" help-window ;
+    "ui.tools.deploy" browser-window ;
 
 \ com-help H{
     { +nullary+ t }
diff --git a/basis/ui/tools/inspector/inspector.factor b/basis/ui/tools/inspector/inspector.factor
index 579210325b..fbd0855d01 100644
--- a/basis/ui/tools/inspector/inspector.factor
+++ b/basis/ui/tools/inspector/inspector.factor
@@ -1,9 +1,10 @@
-! Copyright (C) 2006, 2008 Slava Pestov.
+! Copyright (C) 2006, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors ui.tools.workspace inspector kernel ui.commands
+USING: accessors inspector namespaces kernel
+ui.tools.browser ui.commands
 ui.gadgets ui.gadgets.panes ui.gadgets.scrollers
 ui.gadgets.slots ui.gadgets.tracks ui.gestures
-ui.gadgets.buttons namespaces ;
+ui.gadgets.buttons ui.tools.workspace ;
 IN: ui.tools.inspector
 
 TUPLE: inspector-gadget < track object pane ;
@@ -30,7 +31,7 @@ TUPLE: inspector-gadget < track object pane ;
 
 \ &globals H{ { +nullary+ t } { +listener+ t } } define-command
 
-: inspector-help ( -- ) "ui-inspector" help-window ;
+: inspector-help ( -- ) "ui-inspector" browser-window ;
 
 \ inspector-help H{ { +nullary+ t } } define-command
 
diff --git a/basis/ui/tools/listener/listener.factor b/basis/ui/tools/listener/listener.factor
index bdaf985d3a..74f0fd4b6d 100644
--- a/basis/ui/tools/listener/listener.factor
+++ b/basis/ui/tools/listener/listener.factor
@@ -1,4 +1,4 @@
-! Copyright (C) 2005, 2008 Slava Pestov.
+! Copyright (C) 2005, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: inspector help help.markup io io.styles kernel models
 namespaces parser quotations sequences vocabs words prettyprint
@@ -111,9 +111,6 @@ M: engine-word word-completion-string
     [ select-all ]
     2bi ;
 
-: ui-help-hook ( topic -- )
-    browser-gadget call-tool ;
-
 : ui-error-hook ( error listener -- )
     find-workspace debugger-popup ;
 
@@ -123,7 +120,7 @@ M: engine-word word-completion-string
 
 : listener-thread ( listener -- )
     dup listener-streams [
-        [ ui-help-hook ] help-hook set
+        [ browser-window ] help-hook set
         [ '[ _ ui-error-hook ] error-hook set ]
         [ '[ _ ui-inspector-hook ] inspector-hook set ] bi
         welcome.
@@ -164,7 +161,7 @@ M: engine-word word-completion-string
         init-listener
         dup <listener-scroller> 1 track-add ;
 
-: listener-help ( -- ) "ui-listener" help-window ;
+: listener-help ( -- ) "ui-listener" browser-window ;
 
 \ listener-help H{ { +nullary+ t } } define-command
 
diff --git a/basis/ui/tools/profiler/profiler.factor b/basis/ui/tools/profiler/profiler.factor
index 3c6dfefe1f..a916be5316 100644
--- a/basis/ui/tools/profiler/profiler.factor
+++ b/basis/ui/tools/profiler/profiler.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2007, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: ui.tools.workspace kernel quotations accessors fry
+USING: ui.tools.browser kernel quotations accessors fry
 assocs present math.order math.vectors arrays locals
 models.search models.sort models sequences vocabs
 tools.profiler ui ui.commands ui.gadgets ui.gadgets.panes
@@ -136,7 +136,7 @@ M: method-renderer row-columns
 
 M: profiler-gadget pref-dim* call-next-method { 700 400 } vmax ;
 
-: profiler-help ( -- ) "ui-profiler" help-window ;
+: profiler-help ( -- ) "ui-profiler" browser-window ;
 
 \ profiler-help H{ { +nullary+ t } } define-command
 
diff --git a/basis/ui/tools/tools-docs.factor b/basis/ui/tools/tools-docs.factor
index 2b20b8fbff..c0f911ecf7 100644
--- a/basis/ui/tools/tools-docs.factor
+++ b/basis/ui/tools/tools-docs.factor
@@ -54,6 +54,7 @@ $nl
 ARTICLE: "ui-browser" "UI browser"
 "The browser is used to display Factor code, documentation, and vocabularies."
 { $command-map browser-gadget "toolbar" }
+{ $command-map browser-gadget "scrolling" }
 { $command-map browser-gadget "multi-touch" }
 "Browsers are instances of " { $link browser-gadget } "." ;
 
diff --git a/basis/ui/tools/tools.factor b/basis/ui/tools/tools.factor
index 45cb67ba73..f5bb8e64a6 100644
--- a/basis/ui/tools/tools.factor
+++ b/basis/ui/tools/tools.factor
@@ -1,4 +1,4 @@
-! Copyright (C) 2006, 2008 Slava Pestov.
+! Copyright (C) 2006, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays assocs debugger ui.tools.workspace
 ui.tools.operations ui.tools.traceback ui.tools.browser
@@ -20,9 +20,8 @@ IN: ui.tools
 
 : <workspace-book> ( workspace -- gadget )
         <gadget>
-        <browser-gadget>
         <inspector-gadget>
-    3array
+    2array
     swap model>> <book> ;
   
 : <workspace> ( -- workspace )
@@ -57,14 +56,11 @@ M: workspace model-changed
 
 : com-listener ( workspace -- ) 0 select-tool ;
 
-: com-browser ( workspace -- ) 1 select-tool ;
-
-: com-inspector ( workspace -- ) 2 select-tool ;
+: com-inspector ( workspace -- ) 1 select-tool ;
 
 workspace "tool-switching" f {
     { T{ key-down f { A+ } "1" } com-listener }
-    { T{ key-down f { A+ } "2" } com-browser }
-    { T{ key-down f { A+ } "3" } com-inspector }
+    { T{ key-down f { A+ } "2" } com-inspector }
 } define-command-map
 
 workspace "multi-touch" f {
diff --git a/basis/ui/tools/walker/walker.factor b/basis/ui/tools/walker/walker.factor
index e6643698c7..d4683ab292 100644
--- a/basis/ui/tools/walker/walker.factor
+++ b/basis/ui/tools/walker/walker.factor
@@ -1,9 +1,9 @@
-! Copyright (C) 2006, 2008 Slava Pestov.
+! Copyright (C) 2006, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel concurrency.messaging inspector
 ui.tools.listener ui.tools.traceback ui.gadgets.buttons
 ui.gadgets.status-bar ui.gadgets.tracks ui.commands ui.gadgets
-models models.filter ui.tools.workspace ui.gestures
+models models.filter ui.tools.browser ui.gestures
 ui.gadgets.labels ui threads namespaces make tools.walker assocs
 combinators fry ;
 IN: ui.tools.walker
@@ -66,7 +66,7 @@ M: walker-gadget focusable-child*
         dup status>> self <thread-status> f track-add
         dup traceback>> 1 track-add ;
     
-: walker-help ( -- ) "ui-walker" help-window ;
+: walker-help ( -- ) "ui-walker" browser-window ;
 
 \ walker-help H{ { +nullary+ t } } define-command
 
diff --git a/basis/ui/tools/workspace/workspace.factor b/basis/ui/tools/workspace/workspace.factor
index 3b689eee39..9c696ba60f 100644
--- a/basis/ui/tools/workspace/workspace.factor
+++ b/basis/ui/tools/workspace/workspace.factor
@@ -1,4 +1,4 @@
-! Copyright (C) 2006, 2008 Slava Pestov.
+! Copyright (C) 2006, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: classes continuations help help.topics kernel models
 sequences assocs arrays namespaces accessors math.vectors fry ui
@@ -45,16 +45,6 @@ M: gadget tool-scroller drop f ;
 : get-tool ( class -- gadget )
     get-workspace find-tool nip ;
 
-: <help-pane> ( topic -- pane )
-    <pane> [ [ help ] with-pane ] keep ;
-
-: help-window ( topic -- )
-    [
-        <help-pane> <limited-scroller>
-            { 550 700 } >>max-dim
-    ] [ article-title ] bi
-    open-window ;
-
 : hide-popup ( workspace -- )
     dup popup>> track-remove
     f >>popup
@@ -90,15 +80,4 @@ M: workspace focusable-child*
 M: workspace tool-scroller ( workspace -- scroller )
     workspace-page tool-scroller ;
 
-: com-scroll-up ( workspace -- )
-    tool-scroller [ scroll-up-page ] when* ;
 
-: com-scroll-down ( workspace -- )
-    tool-scroller [ scroll-down-page ] when* ;
-
-workspace "scrolling"
-"The current tool's scroll pane can be scrolled from the keyboard."
-{
-    { T{ key-down f { C+ } "PAGE_UP" } com-scroll-up }
-    { T{ key-down f { C+ } "PAGE_DOWN" } com-scroll-down }
-} define-command-map