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

Workspace improvements

slava 2006-08-26 21:13:24 +00:00
parent a0aca0e63e
commit e1e213ab18
14 changed files with 80 additions and 97 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
TODO.FACTOR.txt
View File

@ -4,12 +4,10 @@
space
- workspace:
- tool help
- maybe open-window should take a world
- book: request focus on selected gadget
- each workspace page has a toolbar
- selecting walker when no quotation is being walked throws an error
- replacement for call-tool functionality
- status bar showing number of words needing a recompile
- default size is wrong
- new browser:
- show currently selected vocab & words
- scroll to existing won't work

20
library/ui/cocoa/menu-bar.factor
View File

@ -1,8 +1,8 @@
! Copyright (C) 2005, 2006 Kevin Reid.
! See http://factorcode.org/license.txt for BSD license.
USING: cocoa compiler gadgets gadgets-browser gadgets-help
gadgets-listener gadgets-search kernel memory objc objc-classes
sequences strings words io ;
USING: cocoa compiler gadgets gadgets-workspace gadgets-help
gadgets-listener kernel memory objc objc-classes sequences
strings words io help ;
IN: cocoa
! -------------------------------------------------------------------------
@ -91,9 +91,6 @@ DEFER: described-menu
: menu-run-file ( -- )
open-panel [ listener-run-files ] when* ;
: memory-window ( -- )
[ heap-stats. terpri room. ] "Memory" pane-window ;
: default-main-menu
{
"<top>"
@ -113,15 +110,9 @@ DEFER: described-menu
} [ NSApp over -> setAppleMenu: ] }
{ {
"File"
{ "New Listener" listener-window "n" }
{ "New Browser" browser-window "b" }
{ "Apropos" apropos-window "r" }
{ }
{ "New Workspace" workspace-window "n" }
{ "Run..." menu-run-file "o" }
{ }
{ "Globals" globals-window "" }
{ "Memory" memory-window "" }
{ }
{ "Save Image" save "s" }
} }
{ {
@ -147,7 +138,6 @@ DEFER: described-menu
} [ NSApp over -> setWindowsMenu: ] }
{ {
"Help"
{ "Factor Documentation" handbook-window "?" }
{ "Search" search-help-window "" }
{ "Factor Documentation" [ "handbook" <link> help-tool call-tool ] "?" }
} }
} described-menu set-main-menu ;

6
library/ui/cocoa/ui.factor
View File

@ -4,8 +4,8 @@ IN: objc-classes
DEFER: FactorApplicationDelegate
IN: cocoa
USING: arrays gadgets gadgets-listener hashtables kernel memory
namespaces objc sequences errors freetype ;
USING: arrays gadgets gadgets-listener gadgets-workspace
hashtables kernel memory namespaces objc sequences errors freetype ;
: finder-run-files ( alien -- )
#! We filter out the image name since that might be there on
@ -76,7 +76,7 @@ IN: shells
restore-windows
] [
init-ui
listener-window
workspace-window
] if
finish-launching
event-loop

22
library/ui/gadgets/books.factor
View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
IN: gadgets-books
USING: gadgets gadgets-controls gadgets-panes gadgets-scrolling
kernel sequences ;
kernel sequences models ;
TUPLE: book page pages ;
@ -10,21 +10,25 @@ TUPLE: book page pages ;
#! page gadgets are instantiated lazily.
book-pages [ dup quotation? [ call ] when dup ] change-nth ;
: show-page ( n book -- )
dup book-page unparent
M: book model-changed ( book -- )
[ control-model model-value ] keep
[ book-page unparent ] keep
[ get-page ] keep
[ set-book-page ] 2keep
add-gadget ;
[ add-gadget ] keep
dup request-focus ;
C: book ( pages -- book )
dup delegate>gadget
dup 0 <model> delegate>control
dup dup set-control-self
[ set-book-pages ] keep
0 over show-page ;
: <book-control> ( model pages -- book )
<book> [ show-page ] <control> ;
dup model-changed ;
M: book pref-dim* book-page pref-dim ;
M: book layout*
dup rect-dim swap book-page set-layout-dim ;
M: book gadget-title book-page gadget-title ;
M: book focusable-child* gadget-child ;

6
library/ui/gadgets/grids.factor
View File

@ -23,9 +23,11 @@ C: grid ( children -- grid )
: grid-remove ( grid i j -- )
>r >r >r f r> r> r> grid-add ;
: ?pref-dim ( gadget/f -- dim )
[ pref-dim ] [ { 0 0 } ] if* ;
: pref-dim-grid ( -- dims )
grid get grid-children
[ [ [ pref-dim ] [ { 0 0 } ] if* ] map ] map ;
grid get grid-children [ [ ?pref-dim ] map ] map ;
: compute-grid ( -- horiz vert )
pref-dim-grid

3
library/ui/gestures.factor
View File

@ -128,7 +128,8 @@ V{ } clone hand-buttons set-global
focus-receiver r> focus-gestures ;
: request-focus ( gadget -- )
dup focusable-child swap find-world request-focus* ;
dup focusable-child swap find-world
[ request-focus* ] [ drop ] if* ;
: modifier ( mod modifiers -- seq )
[ second swap bitand 0 > ] subset-with

2
library/ui/tools/browser.factor
View File

@ -73,8 +73,6 @@ C: browser ( -- gadget )
M: browser gadget-title drop "Browser" <model> ;
: browser-window ( -- ) <browser> open-window ;
: show-word ( word browser -- )
over word-vocabulary over show-vocab
browser-definitions show-definition ;

6
library/ui/tools/help.factor
View File

@ -25,7 +25,6 @@ help-gadget {
C: help-gadget ( -- gadget )
T{ link f "handbook" } <history>
over set-help-gadget-history {
{ [ gadget get <toolbar> ] f f @top }
{ [ <help-pane> <scroller> ] f f @center }
} make-frame* ;
@ -33,11 +32,6 @@ M: help-gadget gadget-title
help-gadget-history
[ "Help - " swap article-title append ] <filter> ;
M: help-gadget pref-dim* drop { 500 600 } ;
: help-tool [ help-gadget? ] [ <help-gadget> ] [ show-help ] ;
: handbook-window ( -- )
T{ link f "handbook" } help-tool call-tool ;
link 1 "Browse" [ help-tool call-tool ] define-operation

12
library/ui/tools/listener.factor
View File

@ -6,7 +6,7 @@ gadgets-panes gadgets-scrolling
gadgets-text gadgets-theme gadgets-tiles gadgets-tracks generic
hashtables inspector io kernel listener math models
namespaces parser prettyprint sequences shells styles threads
words ;
words memory ;
TUPLE: listener-gadget input output stack ;
@ -48,16 +48,11 @@ C: listener-gadget ( -- gadget )
{ [ <listener-input> ] set-listener-gadget-input [ <scroller> ] 1/6 }
} { 0 1 } make-track* dup start-listener ;
M: listener-gadget pref-dim*
delegate pref-dim* { 500 600 } vmax ;
M: listener-gadget focusable-child*
listener-gadget-input ;
M: listener-gadget gadget-title drop "Listener" <model> ;
: listener-window ( -- ) <listener-gadget> open-window ;
: call-listener ( quot/string listener -- )
listener-gadget-input over quotation?
[ interactor-call ] [ set-editor-text ] if ;
@ -81,11 +76,10 @@ M: listener-gadget gadget-title drop "Listener" <model> ;
[ [ run-file ] each ] curry listener-tool call-tool
] if ;
: globals-window ( -- )
[ global inspect ] listener-tool call-tool ;
listener-gadget {
{ f "Clear" T{ key-down f f "CLEAR" } [ dup [ listener-gadget-output pane-clear ] curry listener-tool call-tool ] }
{ f "Globals" f [ [ global inspect ] listener-tool call-tool ] }
{ f "Memory" f [ [ heap-stats. room. ] listener-tool call-tool ] }
} define-commands
object 1 "Inspect" [ [ inspect ] curry listener-tool call-tool ] define-operation

38
library/ui/tools/walker.factor
View File

@ -33,16 +33,6 @@ namespaces sequences shells threads vectors ;
: <quotation-display> ( quot -- gadget )
[ [ first2 callframe. ] when* ] <pane-control> <scroller> ;
: <walker-track> ( model quot -- gadget )
{
{ [ <quotation-display> ] f f 1/6 }
{ [ dup <callstack-display> ] f f 1/6 }
{ [ dup <datastack-display> ] f f 1/6 }
{ [ dup <retainstack-display> ] f f 1/6 }
{ [ dup <namestack-display> ] f f 1/6 }
{ [ <catchstack-display> ] f f 1/6 }
} { 0 1 } make-track ;
TUPLE: walker-gadget model quot ns ;
: update-stacks ( walker -- )
@ -67,20 +57,13 @@ walker-gadget {
{ f "Continue" T{ key-down f f "c" } [ walker-step-all ] }
} define-commands
: init-walker-models ( walker -- )
f <model> over set-walker-gadget-model
f <model> swap set-walker-gadget-quot ;
: walker-models ( -- model quot )
gadget get walker-gadget-model
gadget get walker-gadget-quot ;
: init-walker-models ( walker -- model quot )
f <model> over set-walker-gadget-quot
f <model> swap set-walker-gadget-model ;
M: walker-gadget gadget-title
drop "Single stepper" <model> ;
M: walker-gadget pref-dim*
delegate pref-dim { 500 600 } vmax ;
: (walk) ( quot continuation walker -- )
H{ } clone over set-walker-gadget-ns [
V{ } clone meta-history set
@ -88,12 +71,19 @@ M: walker-gadget pref-dim*
(meta-call)
] with-walker ;
: walker-gadget-quot$ gadget get walker-gadget-quot ;
: walker-gadget-model$ gadget get walker-gadget-model ;
C: walker-gadget ( -- gadget )
dup init-walker-models {
{ [ gadget get <toolbar> ] f f @top }
{ [ walker-models <walker-track> ] f f @center }
} make-frame* ;
{ [ walker-gadget-quot$ <quotation-display> ] f f 1/6 }
{ [ walker-gadget-model$ <callstack-display> ] f f 1/6 }
{ [ walker-gadget-model$ <datastack-display> ] f f 1/6 }
{ [ walker-gadget-model$ <retainstack-display> ] f f 1/6 }
{ [ walker-gadget-model$ <namestack-display> ] f f 1/6 }
{ [ walker-gadget-model$ <catchstack-display> ] f f 1/6 }
} { 0 1 } make-track* ;
: walk ( quot -- )
continuation dup continuation-data pop*
<walker-gadget> [ (walk) ] keep open-window stop ;
<walker-gadget> [ (walk) ] keep <world> open-window stop ;

41
library/ui/tools/workspace.factor
View File

@ -3,8 +3,20 @@
IN: gadgets-workspace
USING: arrays gadgets gadgets-listener gadgets-buttons
gadgets-walker gadgets-help gadgets-walker sequences
gadgets-browser gadgets-books gadgets-frames kernel models
namespaces ;
gadgets-browser gadgets-books gadgets-frames gadgets-controls
gadgets-grids gadgets-presentations kernel models namespaces ;
TUPLE: tool ;
C: tool ( gadget -- tool )
{
{ [ dup <toolbar> ] f f @top }
{ [ ] f f @center }
} make-frame* ;
M: tool gadget-title gadget-child gadget-title ;
M: tool focusable-child* gadget-child ;
TUPLE: workspace model ;
@ -16,17 +28,22 @@ TUPLE: workspace model ;
{ "Documentation" help-gadget [ <help-gadget> ] }
} ;
: <workspace-book> ( workspace -- book )
workspace-model
workspace-tabs [ third ] map <book-control> ;
: <workspace> ( -- book )
workspace-tabs [ third [ <tool> ] append ] map <book> ;
: <workspace-tabs> ( workspace -- tabs )
workspace-model
: <workspace-tabs> ( book -- tabs )
control-model
workspace-tabs dup length [ swap first 2array ] 2map
<radio-box> ;
C: workspace
0 <model> over set-workspace-model {
{ [ gadget get <workspace-tabs> ] f f @top }
{ [ gadget get <workspace-book> ] f f @center }
} make-frame* ;
: init-status ( world -- )
dup world-status <presentation-help> swap @bottom grid-add ;
: init-tabs ( workspace world -- )
swap <workspace-tabs> swap @top grid-add ;
: workspace-window ( -- )
<workspace> dup <world>
[ init-status ] keep
[ init-tabs ] keep
open-window ;

13
library/ui/ui.factor
View File

@ -69,24 +69,19 @@ C: titled-gadget ( gadget title -- )
[ set-titled-gadget-title ] keep
{ { f f f @center } } make-frame* ;
: init-status ( world -- )
dup world-status <presentation-help> swap @bottom grid-add ;
: open-window ( gadget -- )
<world> dup init-status
: open-window ( world -- )
dup pref-dim over set-gadget-dim
dup open-window*
draw-world ;
dup open-window* draw-world ;
: open-titled-window ( gadget title -- )
<model> <titled-gadget> open-window ;
<model> <titled-gadget> <world> open-window ;
: find-window ( quot -- world )
windows get [ second ] map
[ world-gadget swap call ] find-last-with nip ; inline
: open-tool ( arg cons setter -- )
>r call dup open-window r> call ; inline
>r call dup <world> open-window r> call ; inline
: call-tool ( arg pred cons setter -- )
rot find-window [

2
library/ui/windows/ui.factor
View File

@ -328,7 +328,7 @@ IN: shells
restore-windows
] [
init-ui
listener-window
workspace-window
] if
event-loop
] with-freetype

2
library/ui/x11/ui.factor
View File

@ -184,7 +184,7 @@ IN: shells
restore-windows
] [
init-ui
listener-window
workspace-window
] if
event-loop
] with-x