From bb4dae64f355795dac3851490451d698238e3ab4 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 6 Jul 2010 17:59:35 -0400 Subject: [PATCH] cocoa.subclassing: new METHOD: syntax cleans up class definitions --- basis/cocoa/cocoa-tests.factor | 38 +- .../cocoa/subclassing/subclassing-docs.factor | 25 +- basis/cocoa/subclassing/subclassing.factor | 58 ++- basis/tools/deploy/shaker/strip-cocoa.factor | 6 - basis/tools/deploy/test/14/14.factor | 17 +- basis/ui/backend/cocoa/cocoa.factor | 4 +- basis/ui/backend/cocoa/tools/tools.factor | 69 +--- basis/ui/backend/cocoa/views/views.factor | 370 +++++++----------- basis/ui/ui.factor | 2 - 9 files changed, 237 insertions(+), 352 deletions(-) diff --git a/basis/cocoa/cocoa-tests.factor b/basis/cocoa/cocoa-tests.factor index f35d151ad4..eefc04e2a1 100644 --- a/basis/cocoa/cocoa-tests.factor +++ b/basis/cocoa/cocoa-tests.factor @@ -7,12 +7,11 @@ IN: cocoa.tests CLASS: { { +superclass+ "NSObject" } { +name+ "Foo" } -} { - "foo:" - void - { id SEL NSRect } - [ gc "x" set 2drop ] -} ; +} + +METHOD: void foo: NSRect rect [ + gc rect "x" set +] ; : test-foo ( -- ) Foo -> alloc -> init @@ -29,12 +28,9 @@ test-foo CLASS: { { +superclass+ "NSObject" } { +name+ "Bar" } -} { - "bar" - NSRect - { id SEL } - [ 2drop test-foo "x" get ] -} ; +} + +METHOD: NSRect bar [ test-foo "x" get ] ; Bar [ -> alloc -> init @@ -51,22 +47,16 @@ Bar [ CLASS: { { +superclass+ "NSObject" } { +name+ "Bar" } -} { - "bar" - NSRect - { id SEL } - [ 2drop test-foo "x" get ] -} { - "babb" - int - { id SEL int } - [ 2nip sq ] -} ; +} + +METHOD: NSRect bar [ test-foo "x" get ] + +METHOD: int babb: int x [ x sq ] ; [ 144 ] [ Bar [ -> alloc -> init - dup 12 -> babb + dup 12 -> babb: swap -> release ] compile-call ] unit-test diff --git a/basis/cocoa/subclassing/subclassing-docs.factor b/basis/cocoa/subclassing/subclassing-docs.factor index 0944727e46..2e1d973169 100644 --- a/basis/cocoa/subclassing/subclassing-docs.factor +++ b/basis/cocoa/subclassing/subclassing-docs.factor @@ -24,20 +24,31 @@ HELP: define-objc-class { "the selector naming the message; in most cases this value can be ignored" } "arguments passed to the message, if any" } -"There is no way to define instance variables or class methods using this mechanism. However, instance variables can be simulated by using the receiver to key into a hashtable." } ; +"There is no way to define instance variables or class methods using this mechanism. However, instance variables can be simulated by using the receiver to key into an assoc." } ; HELP: CLASS: { $syntax "CLASS: spec imeth... ;" } -{ $values { "spec" "an array of pairs" } { "name" "a new class name" } { "imeth" "instance method definitions" } } -{ $description "A sugared form of the following:" - { $code "{ imeth... } \"spec\" define-objc-class" } +{ $values { "spec" "an array of pairs" } { "name" "a new class name" } { "imeth" "instance method definitions using " { $link POSTPONE: METHOD: } } } +{ $description "Defines a new Objective C class. The hashtable can contain the following keys:" +{ $list + { { $link +name+ } " - a string naming the new class. Required." } + { { $link +superclass+ } " - a string naming the superclass. Required." } + { { $link +protocols+ } " - an array of strings naming protocols implemented by the superclass. Optional." } +} +"Instance methods are defined with the " { $link POSTPONE: METHOD: } " parsing word." +$nl "This word is preferred to calling " { $link define-objc-class } ", because it creates a class word in the " { $vocab-link "cocoa.classes" } " vocabulary at parse time, allowing code to refer to the class word in the same source file where the class is defined." } ; -{ define-objc-class POSTPONE: CLASS: } related-words +{ define-objc-class POSTPONE: CLASS: POSTPONE: METHOD: } related-words + +HELP: METHOD: +{ $syntax "METHOD: return foo: type1 arg1 bar: type2 arg2 baz: ... [ body ]" } +{ $values { "return" "a C type name" } { "type1" "a C type name" } { "arg1" "a local variable name" } { "body" "arbitrary code" } } +{ $description "Defines a method inside of a " { $link POSTPONE: CLASS: } " form." } ; ARTICLE: "objc-subclassing" "Subclassing Objective C classes" -"Objective C classes can be subclassed, with new methods defined in Factor, using a parsing word:" -{ $subsections POSTPONE: CLASS: } +"Objective C classes can be subclassed, with new methods defined in Factor, using parsing words:" +{ $subsections POSTPONE: CLASS: POSTPONE: METHOD: } "This word is actually syntax sugar for an ordinary word:" { $subsections define-objc-class } "Objective C class definitions are saved in the image. If the image is saved and Factor is restarted with the saved image, custom class definitions are made available to the Objective C runtime when they are first accessed from within Factor." ; diff --git a/basis/cocoa/subclassing/subclassing.factor b/basis/cocoa/subclassing/subclassing.factor index 1accb1e8dc..4c5099e04b 100644 --- a/basis/cocoa/subclassing/subclassing.factor +++ b/basis/cocoa/subclassing/subclassing.factor @@ -1,9 +1,11 @@ -! Copyright (C) 2006, 2008 Slava Pestov, Joe Groff. +! Copyright (C) 2006, 2010 Slava Pestov, Joe Groff. ! See http://factorcode.org/license.txt for BSD license. -USING: alien alien.c-types alien.strings arrays assocs -combinators compiler hashtables kernel libc math namespaces -parser sequences words cocoa.messages cocoa.runtime locals -compiler.units io.encodings.utf8 continuations make fry ; +USING: alien alien.c-types alien.parser alien.strings arrays +assocs combinators compiler hashtables kernel lexer libc +locals.parser locals.types math namespaces parser sequences +words cocoa.messages cocoa.runtime locals compiler.units +io.encodings.utf8 continuations make fry effects stack-checker +stack-checker.errors ; IN: cocoa.subclassing : init-method ( method -- sel imp types ) @@ -49,13 +51,13 @@ IN: cocoa.subclassing ] with-compilation-unit ; :: (redefine-objc-method) ( class method -- ) - method init-method [| sel imp types | - class sel class_getInstanceMethod [ - imp method_setImplementation drop - ] [ - class sel imp types add-method - ] if* - ] call ; + method init-method :> ( sel imp types ) + + class sel class_getInstanceMethod [ + imp method_setImplementation drop + ] [ + class sel imp types add-method + ] if* ; : redefine-objc-methods ( imeth name -- ) dup class-exists? [ @@ -79,3 +81,35 @@ SYMBOL: +superclass+ SYNTAX: CLASS: parse-definition unclip >hashtable define-objc-class ; + +: (parse-selector) ( -- ) + scan-token { + { [ dup "[" = ] [ drop ] } + { [ dup ":" tail? ] [ scan-c-type scan-token 3array , (parse-selector) ] } + [ f f 3array , "[" expect ] + } cond ; + +: parse-selector ( -- selector types names ) + [ (parse-selector) ] { } make + flip first3 + [ concat ] + [ sift { id SEL } prepend ] + [ sift { "self" "selector" } prepend ] tri* ; + +: parse-method-body ( names -- quot ) + [ [ make-local ] map ] H{ } make-assoc + (parse-lambda) ?rewrite-closures first ; + +: method-effect ( quadruple -- effect ) + [ third ] [ second void? { } { "x" } ? ] bi ; + +: check-method ( quadruple -- ) + [ fourth infer ] [ method-effect ] bi + 2dup effect<= [ 2drop ] [ effect-error ] if ; + +SYNTAX: METHOD: + scan-c-type + parse-selector + parse-method-body [ swap ] 2dip 4array + dup check-method + suffix! ; diff --git a/basis/tools/deploy/shaker/strip-cocoa.factor b/basis/tools/deploy/shaker/strip-cocoa.factor index 7bb2f651dc..288d192e3b 100644 --- a/basis/tools/deploy/shaker/strip-cocoa.factor +++ b/basis/tools/deploy/shaker/strip-cocoa.factor @@ -13,12 +13,6 @@ IN: tools.deploy.shaker.cocoa : pool-values ( assoc -- assoc' ) [ pool-array ] assoc-map ; -IN: cocoa.application - -: objc-error ( error -- ) die ; - -[ [ die ] 19 set-special-object ] "cocoa.application" add-startup-hook - H{ } clone \ pool [ global [ ! Only keeps those methods that we actually call diff --git a/basis/tools/deploy/test/14/14.factor b/basis/tools/deploy/test/14/14.factor index 65fd50b5b8..0b98b45d68 100644 --- a/basis/tools/deploy/test/14/14.factor +++ b/basis/tools/deploy/test/14/14.factor @@ -9,16 +9,13 @@ IN: tools.deploy.test.14 CLASS: { { +superclass+ "NSObject" } { +name+ "Bar" } -} { - "bar:" - float - { id SEL NSRect } - [ - [ origin>> [ x>> ] [ y>> ] bi + ] - [ size>> [ w>> ] [ h>> ] bi + ] - bi + - ] -} ; +} + +METHOD: float bar: NSRect rect [ + rect origin>> [ x>> ] [ y>> ] bi + + rect size>> [ w>> ] [ h>> ] bi + + + +] ; : main ( -- ) Bar -> alloc -> init diff --git a/basis/ui/backend/cocoa/cocoa.factor b/basis/ui/backend/cocoa/cocoa.factor index 7982458bb4..65286ab181 100644 --- a/basis/ui/backend/cocoa/cocoa.factor +++ b/basis/ui/backend/cocoa/cocoa.factor @@ -233,9 +233,7 @@ CLASS: { { +name+ "FactorApplicationDelegate" } } -{ "applicationDidUpdate:" void { id SEL id } - [ 3drop reset-run-loop ] -} ; +METHOD: void applicationDidUpdate: id obj [ reset-run-loop ] ; : install-app-delegate ( -- ) NSApp FactorApplicationDelegate install-delegate ; diff --git a/basis/ui/backend/cocoa/tools/tools.factor b/basis/ui/backend/cocoa/tools/tools.factor index 89fd8e7708..e41531b587 100644 --- a/basis/ui/backend/cocoa/tools/tools.factor +++ b/basis/ui/backend/cocoa/tools/tools.factor @@ -26,45 +26,25 @@ CLASS: { { +name+ "FactorWorkspaceApplicationDelegate" } } -{ "application:openFiles:" void { id SEL id id } - [ [ 3drop ] dip finder-run-files ] -} +METHOD: void application: id app openFiles: id files [ files finder-run-files ] -{ "applicationShouldHandleReopen:hasVisibleWindows:" int { id SEL id int } - [ [ 3drop ] dip 0 = [ show-listener ] when 1 ] -} +METHOD: int applicationShouldHandleReopen: id app hasVisibleWindows: int flag [ flag 0 = [ show-listener ] when 1 ] -{ "factorListener:" id { id SEL id } - [ 3drop show-listener f ] -} +METHOD: id factorListener: id app [ show-listener f ] -{ "factorBrowser:" id { id SEL id } - [ 3drop show-browser f ] -} +METHOD: id factorBrowser: id app [ show-browser f ] -{ "newFactorListener:" id { id SEL id } - [ 3drop listener-window f ] -} +METHOD: id newFactorListener: id app [ listener-window f ] -{ "newFactorBrowser:" id { id SEL id } - [ 3drop browser-window f ] -} +METHOD: id newFactorBrowser: id app [ browser-window f ] -{ "runFactorFile:" id { id SEL id } - [ 3drop menu-run-files f ] -} +METHOD: id runFactorFile: id app [ menu-run-files f ] -{ "saveFactorImage:" id { id SEL id } - [ 3drop save f ] -} +METHOD: id saveFactorImage: id app [ save f ] -{ "saveFactorImageAs:" id { id SEL id } - [ 3drop menu-save-image f ] -} +METHOD: id saveFactorImageAs: id app [ menu-save-image f ] -{ "refreshAll:" id { id SEL id } - [ 3drop [ refresh-all ] \ refresh-all call-listener f ] -} ; +METHOD: id refreshAll: id app [ [ refresh-all ] \ refresh-all call-listener f ] ; : install-app-delegate ( -- ) NSApp FactorWorkspaceApplicationDelegate install-delegate ; @@ -78,25 +58,16 @@ CLASS: { CLASS: { { +superclass+ "NSObject" } { +name+ "FactorServiceProvider" } -} { - "evalInListener:userData:error:" - void - { id SEL id id id } - [ - nip - [ eval-listener f ] do-service - 2drop - ] -} { - "evalToString:userData:error:" - void - { id SEL id id id } - [ - nip - [ [ (eval>string) ] with-interactive-vocabs ] do-service - 2drop - ] -} ; +} + +METHOD: void evalInListener: id pboard userData: id userData error: id error +[ pboard error [ eval-listener f ] do-service ] + +METHOD: void evalToString: id pboard userData: id userData error: id error +[ + pboard error + [ [ (eval>string) ] with-interactive-vocabs ] do-service +] ; : register-services ( -- ) NSApp diff --git a/basis/ui/backend/cocoa/views/views.factor b/basis/ui/backend/cocoa/views/views.factor index 163be4e208..6b6e3a32c6 100644 --- a/basis/ui/backend/cocoa/views/views.factor +++ b/basis/ui/backend/cocoa/views/views.factor @@ -148,269 +148,168 @@ CLASS: { } ! Rendering -{ "drawRect:" void { id SEL NSRect } - [ 2drop window draw-world ] -} +METHOD: void drawRect: NSRect rect [ self window draw-world ] ! Events -{ "acceptsFirstMouse:" char { id SEL id } - [ 3drop 1 ] -} +METHOD: char acceptsFirstMouse: id event [ 1 ] -{ "mouseEntered:" void { id SEL id } - [ nip send-mouse-moved ] -} +METHOD: void mouseEntered: id event [ self event send-mouse-moved ] -{ "mouseExited:" void { id SEL id } - [ 3drop forget-rollover ] -} +METHOD: void mouseExited: id event [ forget-rollover ] -{ "mouseMoved:" void { id SEL id } - [ nip send-mouse-moved ] -} +METHOD: void mouseMoved: id event [ self event send-mouse-moved ] -{ "mouseDragged:" void { id SEL id } - [ nip send-mouse-moved ] -} +METHOD: void mouseDragged: id event [ self event send-mouse-moved ] -{ "rightMouseDragged:" void { id SEL id } - [ nip send-mouse-moved ] -} +METHOD: void rightMouseDragged: id event [ self event send-mouse-moved ] -{ "otherMouseDragged:" void { id SEL id } - [ nip send-mouse-moved ] -} +METHOD: void otherMouseDragged: id event [ self event send-mouse-moved ] -{ "mouseDown:" void { id SEL id } - [ nip send-button-down$ ] -} +METHOD: void mouseDown: id event [ self event send-button-down$ ] -{ "mouseUp:" void { id SEL id } - [ nip send-button-up$ ] -} +METHOD: void mouseUp: id event [ self event send-button-up$ ] -{ "rightMouseDown:" void { id SEL id } - [ nip send-button-down$ ] -} +METHOD: void rightMouseDown: id event [ self event send-button-down$ ] -{ "rightMouseUp:" void { id SEL id } - [ nip send-button-up$ ] -} +METHOD: void rightMouseUp: id event [ self event send-button-up$ ] -{ "otherMouseDown:" void { id SEL id } - [ nip send-button-down$ ] -} +METHOD: void otherMouseDown: id event [ self event send-button-down$ ] -{ "otherMouseUp:" void { id SEL id } - [ nip send-button-up$ ] -} +METHOD: void otherMouseUp: id event [ self event send-button-up$ ] -{ "scrollWheel:" void { id SEL id } - [ nip send-scroll$ ] -} +METHOD: void scrollWheel: id event [ self event send-scroll$ ] -{ "keyDown:" void { id SEL id } - [ nip send-key-down-event ] -} +METHOD: void keyDown: id event [ self event send-key-down-event ] -{ "keyUp:" void { id SEL id } - [ nip send-key-up-event ] -} +METHOD: void keyUp: id event [ self event send-key-up-event ] -{ "validateUserInterfaceItem:" char { id SEL id } - [ - nip -> action - 2dup [ window ] [ utf8 alien>string ] bi* validate-action - [ [ 2drop ] dip >c-bool ] [ SUPER-> validateUserInterfaceItem: ] if - ] -} +METHOD: char validateUserInterfaceItem: id event +[ + self window + event -> action utf8 alien>string validate-action + [ >c-bool ] [ drop self event SUPER-> validateUserInterfaceItem: ] if +] -{ "undo:" id { id SEL id } - [ nip undo-action send-action$ ] -} +METHOD: id undo: id event [ self event undo-action send-action$ ] -{ "redo:" id { id SEL id } - [ nip redo-action send-action$ ] -} +METHOD: id redo: id event [ self event redo-action send-action$ ] -{ "cut:" id { id SEL id } - [ nip cut-action send-action$ ] -} +METHOD: id cut: id event [ self event cut-action send-action$ ] -{ "copy:" id { id SEL id } - [ nip copy-action send-action$ ] -} +METHOD: id copy: id event [ self event copy-action send-action$ ] -{ "paste:" id { id SEL id } - [ nip paste-action send-action$ ] -} +METHOD: id paste: id event [ self event paste-action send-action$ ] -{ "delete:" id { id SEL id } - [ nip delete-action send-action$ ] -} +METHOD: id delete: id event [ self event delete-action send-action$ ] -{ "selectAll:" id { id SEL id } - [ nip select-all-action send-action$ ] -} +METHOD: id selectAll: id event [ self event select-all-action send-action$ ] -{ "newDocument:" id { id SEL id } - [ nip new-action send-action$ ] -} +METHOD: id newDocument: id event [ self event new-action send-action$ ] -{ "openDocument:" id { id SEL id } - [ nip open-action send-action$ ] -} +METHOD: id openDocument: id event [ self event open-action send-action$ ] -{ "saveDocument:" id { id SEL id } - [ nip save-action send-action$ ] -} +METHOD: id saveDocument: id event [ self event save-action send-action$ ] -{ "saveDocumentAs:" id { id SEL id } - [ nip save-as-action send-action$ ] -} +METHOD: id saveDocumentAs: id event [ self event save-as-action send-action$ ] -{ "revertDocumentToSaved:" id { id SEL id } - [ nip revert-action send-action$ ] -} +METHOD: id revertDocumentToSaved: id event [ self event revert-action send-action$ ] -! Multi-touch gestures: this is undocumented. -! http://cocoadex.com/2008/02/nsevent-modifications-swipe-ro.html -{ "magnifyWithEvent:" void { id SEL id } - [ - nip - dup -> deltaZ sgn { - { 1 [ zoom-in-action send-action$ ] } - { -1 [ zoom-out-action send-action$ ] } - { 0 [ 2drop ] } - } case - ] -} +! Multi-touch gestures +METHOD: void magnifyWithEvent: id event +[ + self event + dup -> deltaZ sgn { + { 1 [ zoom-in-action send-action$ drop ] } + { -1 [ zoom-out-action send-action$ drop ] } + { 0 [ 2drop ] } + } case +] -{ "swipeWithEvent:" void { id SEL id } - [ - nip - dup -> deltaX sgn { - { 1 [ left-action send-action$ ] } - { -1 [ right-action send-action$ ] } - { 0 - [ - dup -> deltaY sgn { - { 1 [ up-action send-action$ ] } - { -1 [ down-action send-action$ ] } - { 0 [ 2drop ] } - } case - ] - } - } case - ] -} +METHOD: void swipeWithEvent: id event +[ + self event + dup -> deltaX sgn { + { 1 [ left-action send-action$ drop ] } + { -1 [ right-action send-action$ drop ] } + { 0 + [ + dup -> deltaY sgn { + { 1 [ up-action send-action$ drop ] } + { -1 [ down-action send-action$ drop ] } + { 0 [ 2drop ] } + } case + ] + } + } case +] -{ "acceptsFirstResponder" char { id SEL } - [ 2drop 1 ] -} +METHOD: char acceptsFirstResponder [ 1 ] ! Services -{ "validRequestorForSendType:returnType:" id { id SEL id id } - [ - ! We return either self or nil - [ over window-focus ] 2dip - valid-service? [ drop ] [ 2drop f ] if - ] -} +METHOD: id validRequestorForSendType: id sendType returnType: id returnType +[ + ! We return either self or nil + self window world-focus sendType returnType + valid-service? [ self ] [ f ] if +] -{ "writeSelectionToPasteboard:types:" char { id SEL id id } - [ - CF>string-array NSStringPboardType swap member? [ - [ drop window-focus gadget-selection ] dip over - [ set-pasteboard-string 1 ] [ 2drop 0 ] if - ] [ 3drop 0 ] if - ] -} +METHOD: char writeSelectionToPasteboard: id pboard types: id types +[ + NSStringPboardType types CF>string-array member? [ + self window world-focus gadget-selection + [ pboard set-pasteboard-string 1 ] [ 0 ] if* + ] [ 0 ] if +] -{ "readSelectionFromPasteboard:" char { id SEL id } - [ - pasteboard-string dup [ - [ drop window ] dip swap user-input 1 - ] [ 3drop 0 ] if - ] -} +METHOD: char readSelectionFromPasteboard: id pboard +[ + pboard pasteboard-string + [ self window user-input 1 ] [ 0 ] if* +] ! Text input -{ "insertText:" void { id SEL id } - [ nip CF>string swap window user-input ] -} +METHOD: void insertText: id text +[ text CF>string self window user-input ] -{ "hasMarkedText" char { id SEL } - [ 2drop 0 ] -} +METHOD: char hasMarkedText [ 0 ] -{ "markedRange" NSRange { id SEL } - [ 2drop 0 0 ] -} +METHOD: NSRange markedRange [ 0 0 ] -{ "selectedRange" NSRange { id SEL } - [ 2drop 0 0 ] -} +METHOD: NSRange selectedRange [ 0 0 ] -{ "setMarkedText:selectedRange:" void { id SEL id NSRange } - [ 2drop 2drop ] -} +METHOD: void setMarkedText: id text selectedRange: NSRange range [ ] -{ "unmarkText" void { id SEL } - [ 2drop ] -} +METHOD: void unmarkText [ ] -{ "validAttributesForMarkedText" id { id SEL } - [ 2drop NSArray -> array ] -} +METHOD: id validAttributesForMarkedText [ NSArray -> array ] -{ "attributedSubstringFromRange:" id { id SEL NSRange } - [ 3drop f ] -} +METHOD: id attributedSubstringFromRange: NSRange range [ f ] -{ "characterIndexForPoint:" NSUInteger { id SEL NSPoint } - [ 3drop 0 ] -} +METHOD: NSUInteger characterIndexForPoint: NSPoint point [ 0 ] -{ "firstRectForCharacterRange:" NSRect { id SEL NSRange } - [ 3drop 0 0 0 0 ] -} +METHOD: NSRect firstRectForCharacterRange: NSRange range [ 0 0 0 0 ] -{ "conversationIdentifier" NSInteger { id SEL } - [ drop alien-address ] -} +METHOD: NSInteger conversationIdentifier [ self alien-address ] ! Initialization -{ "updateFactorGadgetSize:" void { id SEL id } - [ 2drop [ window ] [ view-dim ] bi >>dim drop yield ] -} +METHOD: void updateFactorGadgetSize: id notification +[ self view-dim self window dim<< yield ] -{ "doCommandBySelector:" void { id SEL SEL } - [ 3drop ] -} +METHOD: void doCommandBySelector: SEL selector [ ] -{ "initWithFrame:pixelFormat:" id { id SEL NSRect id } - [ - [ drop ] 2dip - SUPER-> initWithFrame:pixelFormat: - dup dup add-resize-observer - ] -} +METHOD: id initWithFrame: NSRect frame pixelFormat: id pixelFormat +[ + self frame pixelFormat SUPER-> initWithFrame:pixelFormat: + dup dup add-resize-observer +] -{ "isOpaque" char { id SEL } - [ - 2drop 0 - ] -} +METHOD: char isOpaque [ 0 ] -{ "dealloc" void { id SEL } - [ - drop - [ remove-observer ] - [ SUPER-> dealloc ] - bi - ] -} ; +METHOD: void dealloc +[ + self remove-observer + self SUPER-> dealloc +] ; : sync-refresh-to-screen ( GLView -- ) -> openGLContext -> CGLContextObj NSOpenGLCPSwapInterval 1 @@ -423,44 +322,37 @@ CLASS: { -> frame CGRect-top-left 2array >>window-loc drop ; CLASS: { - { +superclass+ "NSObject" } { +name+ "FactorWindowDelegate" } + { +superclass+ "NSObject" } } -{ "windowDidMove:" void { id SEL id } - [ - 2nip -> object [ -> contentView window ] keep save-position - ] -} +METHOD: void windowDidMove: id notification +[ + notification -> object -> contentView window + notification -> object save-position +] -{ "windowDidBecomeKey:" void { id SEL id } - [ - 2nip -> object -> contentView window focus-world - ] -} +METHOD: void windowDidBecomeKey: id notification +[ + notification -> object -> contentView window + focus-world +] -{ "windowDidResignKey:" void { id SEL id } - [ - forget-rollover - 2nip -> object -> contentView - dup -> isInFullScreenMode 0 = - [ window [ unfocus-world ] when* ] - [ drop ] if - ] -} +METHOD: void windowDidResignKey: id notification +[ + forget-rollover + notification -> object -> contentView + dup -> isInFullScreenMode 0 = + [ window [ unfocus-world ] when* ] [ drop ] if +] -{ "windowShouldClose:" char { id SEL id } - [ - 3drop 1 - ] -} +METHOD: char windowShouldClose: id notification [ 1 ] -{ "windowWillClose:" void { id SEL id } - [ - 2nip -> object -> contentView - [ window ungraft ] [ unregister-window ] bi - ] -} ; +METHOD: void windowWillClose: id notification +[ + notification -> object -> contentView + [ window ungraft ] [ unregister-window ] bi +] ; : install-window-delegate ( window -- ) FactorWindowDelegate install-delegate ; diff --git a/basis/ui/ui.factor b/basis/ui/ui.factor index eaeeb01f03..d65f4725a9 100644 --- a/basis/ui/ui.factor +++ b/basis/ui/ui.factor @@ -16,8 +16,6 @@ SYMBOL: windows : window ( handle -- world ) windows get-global at ; -: window-focus ( handle -- gadget ) window world-focus ; - : register-window ( world handle -- ) #! Add the new window just below the topmost window. Why? #! So that if the new window doesn't actually receive focus