Merge branch 'master' of git://factorcode.org/git/factor
						commit
						4e393d8d8b
					
				| 
						 | 
					@ -60,11 +60,19 @@ M: cocoa-ui-backend set-title ( string world -- )
 | 
				
			||||||
        drop
 | 
					        drop
 | 
				
			||||||
    ] if ;
 | 
					    ] if ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
M: cocoa-ui-backend (open-world-window) ( world -- )
 | 
					M: cocoa-ui-backend (open-window) ( world -- )
 | 
				
			||||||
    dup gadget-window
 | 
					    dup gadget-window
 | 
				
			||||||
    dup auto-position
 | 
					    dup auto-position
 | 
				
			||||||
    world-handle second f -> makeKeyAndOrderFront: ;
 | 
					    world-handle second f -> makeKeyAndOrderFront: ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					M: cocoa-ui-backend (close-window) ( handle -- )
 | 
				
			||||||
 | 
					    first unregister-window ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					M: cocoa-ui-backend close-window ( gadget -- )
 | 
				
			||||||
 | 
					    find-world [
 | 
				
			||||||
 | 
					        world-handle second f -> performClose:
 | 
				
			||||||
 | 
					    ] when* ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
M: cocoa-ui-backend raise-window ( world -- )
 | 
					M: cocoa-ui-backend raise-window ( world -- )
 | 
				
			||||||
    world-handle [
 | 
					    world-handle [
 | 
				
			||||||
        second dup f -> orderFront: -> makeKeyWindow
 | 
					        second dup f -> orderFront: -> makeKeyWindow
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -3,7 +3,8 @@
 | 
				
			||||||
USING: alien arrays assocs cocoa kernel math cocoa.messages
 | 
					USING: alien arrays assocs cocoa kernel math cocoa.messages
 | 
				
			||||||
cocoa.subclassing cocoa.classes cocoa.views cocoa.application
 | 
					cocoa.subclassing cocoa.classes cocoa.views cocoa.application
 | 
				
			||||||
cocoa.pasteboard cocoa.types cocoa.windows sequences ui
 | 
					cocoa.pasteboard cocoa.types cocoa.windows sequences ui
 | 
				
			||||||
ui.gadgets ui.gadgets.worlds ui.gestures core-foundation ;
 | 
					ui.gadgets ui.gadgets.worlds ui.gestures core-foundation
 | 
				
			||||||
 | 
					threads ;
 | 
				
			||||||
IN: ui.cocoa.views
 | 
					IN: ui.cocoa.views
 | 
				
			||||||
 | 
					
 | 
				
			||||||
: send-mouse-moved ( view event -- )
 | 
					: send-mouse-moved ( view event -- )
 | 
				
			||||||
| 
						 | 
					@ -313,8 +314,6 @@ CLASS: {
 | 
				
			||||||
{ "dealloc" "void" { "id" "SEL" }
 | 
					{ "dealloc" "void" { "id" "SEL" }
 | 
				
			||||||
    [
 | 
					    [
 | 
				
			||||||
        drop
 | 
					        drop
 | 
				
			||||||
        dup window stop-world
 | 
					 | 
				
			||||||
        dup unregister-window
 | 
					 | 
				
			||||||
        dup remove-observer
 | 
					        dup remove-observer
 | 
				
			||||||
        SUPER-> dealloc
 | 
					        SUPER-> dealloc
 | 
				
			||||||
    ]
 | 
					    ]
 | 
				
			||||||
| 
						 | 
					@ -347,6 +346,12 @@ CLASS: {
 | 
				
			||||||
        forget-rollover
 | 
					        forget-rollover
 | 
				
			||||||
        2nip -> object -> contentView window unfocus-world
 | 
					        2nip -> object -> contentView window unfocus-world
 | 
				
			||||||
    ]
 | 
					    ]
 | 
				
			||||||
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					{ "windowShouldClose:" "bool" { "id" "SEL" "id" }
 | 
				
			||||||
 | 
					    [
 | 
				
			||||||
 | 
					        2nip -> contentView window ungraft t
 | 
				
			||||||
 | 
					    ]
 | 
				
			||||||
} ;
 | 
					} ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
: install-window-delegate ( window -- )
 | 
					: install-window-delegate ( window -- )
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -77,7 +77,8 @@ TUPLE: deploy-gadget vocab settings ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
: com-deploy ( gadget -- )
 | 
					: com-deploy ( gadget -- )
 | 
				
			||||||
    dup com-save
 | 
					    dup com-save
 | 
				
			||||||
    find-deploy-vocab [ deploy ] curry call-listener ;
 | 
					    dup find-deploy-vocab [ deploy ] curry call-listener
 | 
				
			||||||
 | 
					    close-window ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
: com-help ( -- )
 | 
					: com-help ( -- )
 | 
				
			||||||
    "ui-deploy" help-window ;
 | 
					    "ui-deploy" help-window ;
 | 
				
			||||||
| 
						 | 
					@ -86,7 +87,11 @@ TUPLE: deploy-gadget vocab settings ;
 | 
				
			||||||
    { +nullary+ t }
 | 
					    { +nullary+ t }
 | 
				
			||||||
} define-command
 | 
					} define-command
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					: com-close ( gadget -- )
 | 
				
			||||||
 | 
					    close-window ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
deploy-gadget "toolbar" f {
 | 
					deploy-gadget "toolbar" f {
 | 
				
			||||||
 | 
					    { f com-close }
 | 
				
			||||||
    { f com-help }
 | 
					    { f com-help }
 | 
				
			||||||
    { f com-revert }
 | 
					    { f com-revert }
 | 
				
			||||||
    { f com-save }
 | 
					    { f com-save }
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -72,7 +72,9 @@ M: world ungraft*
 | 
				
			||||||
    >r [ 1 track, ] { 0 1 } make-track r>
 | 
					    >r [ 1 track, ] { 0 1 } make-track r>
 | 
				
			||||||
    f <world> open-world-window ;
 | 
					    f <world> open-world-window ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
: close-window ( gadget -- )
 | 
					HOOK: close-window ui-backend ( gadget -- )
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					M: object close-window
 | 
				
			||||||
    find-world [ ungraft ] when* ;
 | 
					    find-world [ ungraft ] when* ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
: find-window ( quot -- world )
 | 
					: find-window ( quot -- world )
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Loading…
	
		Reference in New Issue