Workspace improvements
parent
a0aca0e63e
commit
e1e213ab18
|
@ -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
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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 [
|
||||
|
|
|
@ -328,7 +328,7 @@ IN: shells
|
|||
restore-windows
|
||||
] [
|
||||
init-ui
|
||||
listener-window
|
||||
workspace-window
|
||||
] if
|
||||
event-loop
|
||||
] with-freetype
|
||||
|
|
|
@ -184,7 +184,7 @@ IN: shells
|
|||
restore-windows
|
||||
] [
|
||||
init-ui
|
||||
listener-window
|
||||
workspace-window
|
||||
] if
|
||||
event-loop
|
||||
] with-x
|
||||
|
|
Loading…
Reference in New Issue