Browser tool is now its own window; update help-window usages to open browser instead
parent
d2fd2d0a8c
commit
24d55cc6a6
|
@ -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
|
|
@ -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 }
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
|
@ -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 } "." ;
|
||||||
|
|
||||||
|
|
|
@ -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 {
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
|
@ -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
|
|
||||||
|
|
Loading…
Reference in New Issue