Browser tool is now its own window; update help-window usages to open browser instead

db4
Slava Pestov 2009-01-06 13:56:14 -06:00
parent d2fd2d0a8c
commit 24d55cc6a6
9 changed files with 86 additions and 83 deletions

View File

@ -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. ! See http://factorcode.org/license.txt for BSD license.
USING: debugger ui.tools.workspace help help.topics kernel USING: debugger help help.topics kernel models compiler.units
models models.history tools.apropos ui.commands ui.gadgets assocs words vocabs accessors fry combinators.short-circuit
ui.gadgets.panes ui.gadgets.scrollers ui.gadgets.tracks models models.history tools.apropos ui.tools.workspace
ui.gestures ui.gadgets.buttons ui.gadgets.packs ui.commands ui.gadgets ui.gadgets.panes ui.gadgets.scrollers
ui.gadgets.editors ui.gadgets.labels models compiler.units ui.gadgets.tracks ui.gestures ui.gadgets.buttons ui.gadgets.packs
assocs words vocabs accessors fry combinators.short-circuit ; ui.gadgets.editors ui.gadgets.labels ui ;
IN: ui.tools.browser IN: ui.tools.browser
TUPLE: browser-gadget < track pane history ; TUPLE: browser-gadget < track pane scroller search-field ;
: show-help ( link browser-gadget -- ) : show-help ( link browser-gadget -- )
history>> dup add-history model>> dup add-history
[ >link ] dip set-model ; [ >link ] dip set-model ;
: <help-pane> ( browser-gadget -- gadget ) : <help-pane> ( browser-gadget -- gadget )
history>> [ '[ _ print-topic ] try ] <pane-control> ; model>> [ '[ _ print-topic ] try ] <pane-control> ;
: init-history ( browser-gadget -- )
"handbook" >link <history> >>history drop ;
: search-browser ( string browser -- ) : search-browser ( string browser -- )
[ <apropos> ] dip show-help ; [ <apropos> ] dip show-help ;
: <search-field> ( browser -- field ) : <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 ) : <browser-toolbar> ( browser -- toolbar )
<shelf> <shelf>
{ 5 5 } >>gap { 5 5 } >>gap
over <toolbar> add-gadget over <toolbar> add-gadget
"Search:" <label> 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 { 0 1 } browser-gadget new-track
dup init-history swap <history> >>model
dup <search-field> >>search-field
dup <browser-toolbar> f track-add dup <browser-toolbar> f track-add
dup <help-pane> >>pane dup <help-pane> >>pane
dup pane>> <scroller> 1 track-add ; dup <help-pane-scroller> >>scroller
dup scroller>> 1 track-add ;
M: browser-gadget call-tool* show-help ;
M: browser-gadget tool-scroller
pane>> find-scroller ;
M: browser-gadget graft* M: browser-gadget graft*
[ add-definition-observer ] [ call-next-method ] bi ; [ add-definition-observer ] [ call-next-method ] bi ;
@ -59,25 +60,43 @@ M: browser-gadget ungraft*
} 2|| ; } 2|| ;
M: browser-gadget definitions-changed ( assoc browser -- ) M: browser-gadget definitions-changed ( assoc browser -- )
history>> model>> tuck value>> swap showing-definition?
dup value>> rot showing-definition?
[ notify-connections ] [ drop ] if ; [ notify-connections ] [ drop ] if ;
: help-action ( browser-gadget -- link ) M: browser-gadget focusable-child* search-field>> ;
history>> value>> >link ;
: 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 ; : 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 \ 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 { browser-gadget "toolbar" f {
{ T{ key-down f { A+ } "LEFT" } com-back } { T{ key-down f { A+ } "LEFT" } com-back }
{ T{ key-down f { A+ } "RIGHT" } com-forward } { T{ key-down f { A+ } "RIGHT" } com-forward }
@ -89,3 +108,12 @@ browser-gadget "multi-touch" f {
{ T{ left-action } com-back } { T{ left-action } com-back }
{ T{ right-action } com-forward } { T{ right-action } com-forward }
} define-command-map } 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

View File

@ -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. ! See http://factorcode.org/license.txt for BSD license.
USING: ui.gadgets colors kernel ui.render namespaces models USING: colors kernel namespaces models tools.deploy.config
models.mapping sequences ui.gadgets.buttons ui.gadgets.packs tools.deploy.config.editor tools.deploy vocabs
ui.gadgets.labels tools.deploy.config tools.deploy.config.editor namespaces models.mapping sequences system accessors fry
namespaces ui.gadgets.editors ui.gadgets.borders ui.gestures 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 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 IN: ui.tools.deploy
TUPLE: deploy-gadget < pack vocab settings ; TUPLE: deploy-gadget < pack vocab settings ;
@ -81,7 +82,7 @@ TUPLE: deploy-gadget < pack vocab settings ;
close-window ; close-window ;
: com-help ( -- ) : com-help ( -- )
"ui.tools.deploy" help-window ; "ui.tools.deploy" browser-window ;
\ com-help H{ \ com-help H{
{ +nullary+ t } { +nullary+ t }

View File

@ -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. ! 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 ui.gadgets.panes ui.gadgets.scrollers
ui.gadgets.slots ui.gadgets.tracks ui.gestures ui.gadgets.slots ui.gadgets.tracks ui.gestures
ui.gadgets.buttons namespaces ; ui.gadgets.buttons ui.tools.workspace ;
IN: ui.tools.inspector IN: ui.tools.inspector
TUPLE: inspector-gadget < track object pane ; TUPLE: inspector-gadget < track object pane ;
@ -30,7 +31,7 @@ TUPLE: inspector-gadget < track object pane ;
\ &globals H{ { +nullary+ t } { +listener+ t } } define-command \ &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 \ inspector-help H{ { +nullary+ t } } define-command

View File

@ -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. ! See http://factorcode.org/license.txt for BSD license.
USING: inspector help help.markup io io.styles kernel models USING: inspector help help.markup io io.styles kernel models
namespaces parser quotations sequences vocabs words prettyprint namespaces parser quotations sequences vocabs words prettyprint
@ -111,9 +111,6 @@ M: engine-word word-completion-string
[ select-all ] [ select-all ]
2bi ; 2bi ;
: ui-help-hook ( topic -- )
browser-gadget call-tool ;
: ui-error-hook ( error listener -- ) : ui-error-hook ( error listener -- )
find-workspace debugger-popup ; find-workspace debugger-popup ;
@ -123,7 +120,7 @@ M: engine-word word-completion-string
: listener-thread ( listener -- ) : listener-thread ( listener -- )
dup listener-streams [ dup listener-streams [
[ ui-help-hook ] help-hook set [ browser-window ] help-hook set
[ '[ _ ui-error-hook ] error-hook set ] [ '[ _ ui-error-hook ] error-hook set ]
[ '[ _ ui-inspector-hook ] inspector-hook set ] bi [ '[ _ ui-inspector-hook ] inspector-hook set ] bi
welcome. welcome.
@ -164,7 +161,7 @@ M: engine-word word-completion-string
init-listener init-listener
dup <listener-scroller> 1 track-add ; 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 \ listener-help H{ { +nullary+ t } } define-command

View File

@ -1,6 +1,6 @@
! Copyright (C) 2007, 2009 Slava Pestov. ! Copyright (C) 2007, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! 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 assocs present math.order math.vectors arrays locals
models.search models.sort models sequences vocabs models.search models.sort models sequences vocabs
tools.profiler ui ui.commands ui.gadgets ui.gadgets.panes 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 ; 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 \ profiler-help H{ { +nullary+ t } } define-command

View File

@ -54,6 +54,7 @@ $nl
ARTICLE: "ui-browser" "UI browser" ARTICLE: "ui-browser" "UI browser"
"The browser is used to display Factor code, documentation, and vocabularies." "The browser is used to display Factor code, documentation, and vocabularies."
{ $command-map browser-gadget "toolbar" } { $command-map browser-gadget "toolbar" }
{ $command-map browser-gadget "scrolling" }
{ $command-map browser-gadget "multi-touch" } { $command-map browser-gadget "multi-touch" }
"Browsers are instances of " { $link browser-gadget } "." ; "Browsers are instances of " { $link browser-gadget } "." ;

View File

@ -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. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs debugger ui.tools.workspace USING: accessors arrays assocs debugger ui.tools.workspace
ui.tools.operations ui.tools.traceback ui.tools.browser ui.tools.operations ui.tools.traceback ui.tools.browser
@ -20,9 +20,8 @@ IN: ui.tools
: <workspace-book> ( workspace -- gadget ) : <workspace-book> ( workspace -- gadget )
<gadget> <gadget>
<browser-gadget>
<inspector-gadget> <inspector-gadget>
3array 2array
swap model>> <book> ; swap model>> <book> ;
: <workspace> ( -- workspace ) : <workspace> ( -- workspace )
@ -57,14 +56,11 @@ M: workspace model-changed
: com-listener ( workspace -- ) 0 select-tool ; : com-listener ( workspace -- ) 0 select-tool ;
: com-browser ( workspace -- ) 1 select-tool ; : com-inspector ( workspace -- ) 1 select-tool ;
: com-inspector ( workspace -- ) 2 select-tool ;
workspace "tool-switching" f { workspace "tool-switching" f {
{ T{ key-down f { A+ } "1" } com-listener } { T{ key-down f { A+ } "1" } com-listener }
{ T{ key-down f { A+ } "2" } com-browser } { T{ key-down f { A+ } "2" } com-inspector }
{ T{ key-down f { A+ } "3" } com-inspector }
} define-command-map } define-command-map
workspace "multi-touch" f { workspace "multi-touch" f {

View File

@ -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. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel concurrency.messaging inspector USING: accessors kernel concurrency.messaging inspector
ui.tools.listener ui.tools.traceback ui.gadgets.buttons ui.tools.listener ui.tools.traceback ui.gadgets.buttons
ui.gadgets.status-bar ui.gadgets.tracks ui.commands ui.gadgets 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 ui.gadgets.labels ui threads namespaces make tools.walker assocs
combinators fry ; combinators fry ;
IN: ui.tools.walker IN: ui.tools.walker
@ -66,7 +66,7 @@ M: walker-gadget focusable-child*
dup status>> self <thread-status> f track-add dup status>> self <thread-status> f track-add
dup traceback>> 1 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 \ walker-help H{ { +nullary+ t } } define-command

View File

@ -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. ! See http://factorcode.org/license.txt for BSD license.
USING: classes continuations help help.topics kernel models USING: classes continuations help help.topics kernel models
sequences assocs arrays namespaces accessors math.vectors fry ui sequences assocs arrays namespaces accessors math.vectors fry ui
@ -45,16 +45,6 @@ M: gadget tool-scroller drop f ;
: get-tool ( class -- gadget ) : get-tool ( class -- gadget )
get-workspace find-tool nip ; 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 -- ) : hide-popup ( workspace -- )
dup popup>> track-remove dup popup>> track-remove
f >>popup f >>popup
@ -90,15 +80,4 @@ M: workspace focusable-child*
M: workspace tool-scroller ( workspace -- scroller ) M: workspace tool-scroller ( workspace -- scroller )
workspace-page tool-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