steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

90
basis/ui/tools/browser/browser.factor
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.
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

15
basis/ui/tools/deploy/deploy.factor
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.
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 }

9
basis/ui/tools/inspector/inspector.factor
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.
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

9
basis/ui/tools/listener/listener.factor
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.
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

4
basis/ui/tools/profiler/profiler.factor
View File

@ -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

1
basis/ui/tools/tools-docs.factor
View File

@ -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 } "." ;

12
basis/ui/tools/tools.factor
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.
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 {

6
basis/ui/tools/walker/walker.factor
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.
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

23
basis/ui/tools/workspace/workspace.factor
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.
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