cocoa: Syntax is funky, so regularize it by parsing CLASS: ; and METHOD: ; and COCOA-PROTOCOL: token.
Doug Coleman
parent
02008979d9
commit
9f0a1ed730
|
|
@ -5,11 +5,10 @@ core-graphics.types ;
|
|||
IN: cocoa.tests
|
||||
|
||||
CLASS: Foo < NSObject
|
||||
[
|
||||
METHOD: void foo: NSRect rect [
|
||||
gc rect "x" set
|
||||
]
|
||||
]
|
||||
] ;
|
||||
;
|
||||
|
||||
: test-foo ( -- )
|
||||
Foo -> alloc -> init
|
||||
|
|
@ -24,9 +23,8 @@ CLASS: Foo < NSObject
|
|||
{ 102.0 } [ "x" get CGRect-h ] unit-test
|
||||
|
||||
CLASS: Bar < NSObject
|
||||
[
|
||||
METHOD: NSRect bar [ test-foo "x" get ]
|
||||
]
|
||||
METHOD: NSRect bar [ test-foo "x" get ] ;
|
||||
;
|
||||
|
||||
{ } [
|
||||
Bar [
|
||||
|
|
@ -43,11 +41,10 @@ CLASS: Bar < NSObject
|
|||
|
||||
! Make sure that we can add methods
|
||||
CLASS: Bar < NSObject
|
||||
[
|
||||
METHOD: NSRect bar [ test-foo "x" get ]
|
||||
METHOD: NSRect bar [ test-foo "x" get ] ;
|
||||
|
||||
METHOD: int babb: int x [ x sq ]
|
||||
]
|
||||
METHOD: int babb: int x [ x sq ] ;
|
||||
;
|
||||
|
||||
{ 144 } [
|
||||
Bar [
|
||||
|
|
|
|||
|
|
@ -2,8 +2,8 @@ USING: help.markup help.syntax strings alien hashtables ;
|
|||
IN: cocoa.subclassing
|
||||
|
||||
HELP: CLASS:
|
||||
{ $syntax "CLASS: name < superclass protocols... [ imeth... ]" }
|
||||
{ $values { "name" "a new class name" } { "superclass" "a superclass name" } { "protocols" "zero or more protocol names" } { "name" "a new class name" } { "imeth" "instance method definitions using " { $link POSTPONE: METHOD: } } }
|
||||
{ $syntax "CLASS: name < superclass protocols... imeth... ;" }
|
||||
{ $values { "name" "a new class name" } { "superclass" "a superclass name" } { "protocols" "zero or more protocol names" } { "imeth" "instance method definitions using " { $link POSTPONE: METHOD: } } }
|
||||
{ $description "Defines a new Objective C class. 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." } ;
|
||||
|
|
@ -11,7 +11,7 @@ $nl
|
|||
{ define-objc-class POSTPONE: CLASS: POSTPONE: METHOD: } related-words
|
||||
|
||||
HELP: METHOD:
|
||||
{ $syntax "METHOD: return foo: type1 arg1 bar: type2 arg2 baz: ... [ body ]" }
|
||||
{ $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." } ;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2006, 2010 Slava Pestov, Joe Groff.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien alien.parser alien.strings arrays assocs
|
||||
USING: accessors alien alien.parser alien.strings arrays assocs
|
||||
cocoa.messages cocoa.runtime combinators compiler.units fry
|
||||
io.encodings.utf8 kernel lexer locals locals.parser locals.types
|
||||
make namespaces parser sequences words ;
|
||||
|
|
@ -68,12 +68,18 @@ IN: cocoa.subclassing
|
|||
methods name redefine-objc-methods
|
||||
name [ methods protocols superclass name (define-objc-class) ] import-objc-class ;
|
||||
|
||||
TUPLE: cocoa-protocol name ;
|
||||
C: <cocoa-protocol> cocoa-protocol
|
||||
|
||||
SYNTAX: COCOA-PROTOCOL:
|
||||
scan-token <cocoa-protocol> suffix! ;
|
||||
|
||||
SYNTAX: CLASS:
|
||||
scan-token
|
||||
"<" expect
|
||||
scan-token
|
||||
"[" parse-tokens
|
||||
\ ] parse-until define-objc-class ;
|
||||
\ ; parse-until [ cocoa-protocol? ] partition
|
||||
[ [ name>> ] map ] dip define-objc-class ;
|
||||
|
||||
: (parse-selector) ( -- )
|
||||
scan-token {
|
||||
|
|
@ -96,5 +102,5 @@ SYNTAX: CLASS:
|
|||
SYNTAX: METHOD:
|
||||
scan-c-type
|
||||
parse-selector
|
||||
parse-method-body [ swap ] 2dip 4array
|
||||
parse-method-body [ swap ] 2dip 4array ";" expect
|
||||
suffix! ;
|
||||
|
|
|
|||
|
|
@ -7,13 +7,12 @@ FROM: alien.c-types => float ;
|
|||
IN: tools.deploy.test.14
|
||||
|
||||
CLASS: Bar < NSObject
|
||||
[
|
||||
METHOD: float bar: NSRect rect [
|
||||
rect origin>> [ x>> ] [ y>> ] bi +
|
||||
rect size>> [ w>> ] [ h>> ] bi +
|
||||
+
|
||||
]
|
||||
]
|
||||
] ;
|
||||
;
|
||||
|
||||
: main ( -- )
|
||||
Bar -> alloc -> init
|
||||
|
|
|
|||
|
|
@ -232,10 +232,8 @@ M: cocoa-ui-backend system-alert
|
|||
] [ 2drop ] if* ;
|
||||
|
||||
CLASS: FactorApplicationDelegate < NSObject
|
||||
[
|
||||
METHOD: void applicationDidUpdate: id obj
|
||||
[ reset-thread-timer ]
|
||||
]
|
||||
METHOD: void applicationDidUpdate: id obj [ reset-thread-timer ] ;
|
||||
;
|
||||
|
||||
: install-app-delegate ( -- )
|
||||
NSApp FactorApplicationDelegate install-delegate ;
|
||||
|
|
|
|||
|
|
@ -22,27 +22,27 @@ IN: ui.backend.cocoa.tools
|
|||
|
||||
! Handle Open events from the Finder
|
||||
CLASS: FactorWorkspaceApplicationDelegate < FactorApplicationDelegate
|
||||
[
|
||||
METHOD: void application: id app openFiles: id files [ files finder-run-files ]
|
||||
|
||||
METHOD: int applicationShouldHandleReopen: id app hasVisibleWindows: int flag [ flag 0 = [ show-listener ] when 1 ]
|
||||
METHOD: void application: id app openFiles: id files [ files finder-run-files ] ;
|
||||
|
||||
METHOD: id factorListener: id app [ show-listener f ]
|
||||
METHOD: int applicationShouldHandleReopen: id app hasVisibleWindows: int flag [ flag 0 = [ show-listener ] when 1 ] ;
|
||||
|
||||
METHOD: id factorBrowser: id app [ show-browser f ]
|
||||
METHOD: id factorListener: id app [ show-listener f ] ;
|
||||
|
||||
METHOD: id newFactorListener: id app [ listener-window f ]
|
||||
METHOD: id factorBrowser: id app [ show-browser f ] ;
|
||||
|
||||
METHOD: id newFactorBrowser: id app [ browser-window f ]
|
||||
METHOD: id newFactorListener: id app [ listener-window f ] ;
|
||||
|
||||
METHOD: id runFactorFile: id app [ menu-run-files f ]
|
||||
METHOD: id newFactorBrowser: id app [ browser-window f ] ;
|
||||
|
||||
METHOD: id saveFactorImage: id app [ save f ]
|
||||
METHOD: id runFactorFile: id app [ menu-run-files f ] ;
|
||||
|
||||
METHOD: id saveFactorImageAs: id app [ menu-save-image f ]
|
||||
METHOD: id saveFactorImage: id app [ save f ] ;
|
||||
|
||||
METHOD: id refreshAll: id app [ [ refresh-all ] \ refresh-all call-listener f ]
|
||||
]
|
||||
METHOD: id saveFactorImageAs: id app [ menu-save-image f ] ;
|
||||
|
||||
METHOD: id refreshAll: id app [ [ refresh-all ] \ refresh-all call-listener f ] ;
|
||||
;
|
||||
|
||||
: install-app-delegate ( -- )
|
||||
NSApp FactorWorkspaceApplicationDelegate install-delegate ;
|
||||
|
|
@ -54,16 +54,16 @@ CLASS: FactorWorkspaceApplicationDelegate < FactorApplicationDelegate
|
|||
[ pboard set-pasteboard-string ] when* ;
|
||||
|
||||
CLASS: FactorServiceProvider < NSObject
|
||||
[
|
||||
|
||||
METHOD: void evalInListener: id pboard userData: id userData error: id error
|
||||
[ pboard error [ eval-listener f ] do-service ]
|
||||
[ 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
|
||||
|
|
|
|||
|
|
@ -150,8 +150,8 @@ CONSTANT: selector>action H{
|
|||
selector>action at
|
||||
[ swap world-focus parents-handle-gesture? t ] [ drop f f ] if* ;
|
||||
|
||||
CLASS: FactorView < NSOpenGLView NSTextInput
|
||||
[
|
||||
CLASS: FactorView < NSOpenGLView
|
||||
COCOA-PROTOCOL: NSTextInput
|
||||
|
||||
METHOD: void prepareOpenGL [
|
||||
|
||||
|
|
@ -170,43 +170,43 @@ CLASS: FactorView < NSOpenGLView NSTextInput
|
|||
] [ drop ] if
|
||||
|
||||
] when
|
||||
]
|
||||
] ;
|
||||
|
||||
! Rendering
|
||||
METHOD: void drawRect: NSRect rect [ self window [ draw-world ] when* ]
|
||||
METHOD: void drawRect: NSRect rect [ self window [ draw-world ] when* ] ;
|
||||
|
||||
! Events
|
||||
METHOD: char acceptsFirstMouse: id event [ 0 ]
|
||||
METHOD: char acceptsFirstMouse: id event [ 0 ] ;
|
||||
|
||||
METHOD: void mouseEntered: id event [ self event send-mouse-moved ]
|
||||
METHOD: void mouseEntered: id event [ self event send-mouse-moved ] ;
|
||||
|
||||
METHOD: void mouseExited: id event [ forget-rollover ]
|
||||
METHOD: void mouseExited: id event [ forget-rollover ] ;
|
||||
|
||||
METHOD: void mouseMoved: id event [ self event send-mouse-moved ]
|
||||
METHOD: void mouseMoved: id event [ self event send-mouse-moved ] ;
|
||||
|
||||
METHOD: void mouseDragged: id event [ self event send-mouse-moved ]
|
||||
METHOD: void mouseDragged: id event [ self event send-mouse-moved ] ;
|
||||
|
||||
METHOD: void rightMouseDragged: id event [ self event send-mouse-moved ]
|
||||
METHOD: void rightMouseDragged: id event [ self event send-mouse-moved ] ;
|
||||
|
||||
METHOD: void otherMouseDragged: id event [ self event send-mouse-moved ]
|
||||
METHOD: void otherMouseDragged: id event [ self event send-mouse-moved ] ;
|
||||
|
||||
METHOD: void mouseDown: id event [ self event send-button-down$ ]
|
||||
METHOD: void mouseDown: id event [ self event send-button-down$ ] ;
|
||||
|
||||
METHOD: void mouseUp: id event [ self event send-button-up$ ]
|
||||
METHOD: void mouseUp: id event [ self event send-button-up$ ] ;
|
||||
|
||||
METHOD: void rightMouseDown: id event [ self event send-button-down$ ]
|
||||
METHOD: void rightMouseDown: id event [ self event send-button-down$ ] ;
|
||||
|
||||
METHOD: void rightMouseUp: id event [ self event send-button-up$ ]
|
||||
METHOD: void rightMouseUp: id event [ self event send-button-up$ ] ;
|
||||
|
||||
METHOD: void otherMouseDown: id event [ self event send-button-down$ ]
|
||||
METHOD: void otherMouseDown: id event [ self event send-button-down$ ] ;
|
||||
|
||||
METHOD: void otherMouseUp: id event [ self event send-button-up$ ]
|
||||
METHOD: void otherMouseUp: id event [ self event send-button-up$ ] ;
|
||||
|
||||
METHOD: void scrollWheel: id event [ self event send-scroll$ ]
|
||||
METHOD: void scrollWheel: id event [ self event send-scroll$ ] ;
|
||||
|
||||
METHOD: void keyDown: id event [ self event send-key-down-event ]
|
||||
METHOD: void keyDown: id event [ self event send-key-down-event ] ;
|
||||
|
||||
METHOD: void keyUp: id event [ self event send-key-up-event ]
|
||||
METHOD: void keyUp: id event [ self event send-key-up-event ] ;
|
||||
|
||||
METHOD: char validateUserInterfaceItem: id event
|
||||
[
|
||||
|
|
@ -214,31 +214,31 @@ CLASS: FactorView < NSOpenGLView NSTextInput
|
|||
event -> action utf8 alien>string validate-action
|
||||
[ >c-bool ] [ drop self event SUPER-> validateUserInterfaceItem: ] if
|
||||
] [ 0 ] if*
|
||||
]
|
||||
] ;
|
||||
|
||||
METHOD: id undo: id event [ self event undo-action send-action$ f ]
|
||||
METHOD: id undo: id event [ self event undo-action send-action$ f ] ;
|
||||
|
||||
METHOD: id redo: id event [ self event redo-action send-action$ f ]
|
||||
METHOD: id redo: id event [ self event redo-action send-action$ f ] ;
|
||||
|
||||
METHOD: id cut: id event [ self event cut-action send-action$ f ]
|
||||
METHOD: id cut: id event [ self event cut-action send-action$ f ] ;
|
||||
|
||||
METHOD: id copy: id event [ self event copy-action send-action$ f ]
|
||||
METHOD: id copy: id event [ self event copy-action send-action$ f ] ;
|
||||
|
||||
METHOD: id paste: id event [ self event paste-action send-action$ f ]
|
||||
METHOD: id paste: id event [ self event paste-action send-action$ f ] ;
|
||||
|
||||
METHOD: id delete: id event [ self event delete-action send-action$ f ]
|
||||
METHOD: id delete: id event [ self event delete-action send-action$ f ] ;
|
||||
|
||||
METHOD: id selectAll: id event [ self event select-all-action send-action$ f ]
|
||||
METHOD: id selectAll: id event [ self event select-all-action send-action$ f ] ;
|
||||
|
||||
METHOD: id newDocument: id event [ self event new-action send-action$ f ]
|
||||
METHOD: id newDocument: id event [ self event new-action send-action$ f ] ;
|
||||
|
||||
METHOD: id openDocument: id event [ self event open-action send-action$ f ]
|
||||
METHOD: id openDocument: id event [ self event open-action send-action$ f ] ;
|
||||
|
||||
METHOD: id saveDocument: id event [ self event save-action send-action$ f ]
|
||||
METHOD: id saveDocument: id event [ self event save-action send-action$ f ] ;
|
||||
|
||||
METHOD: id saveDocumentAs: id event [ self event save-as-action send-action$ f ]
|
||||
METHOD: id saveDocumentAs: id event [ self event save-as-action send-action$ f ] ;
|
||||
|
||||
METHOD: id revertDocumentToSaved: id event [ self event revert-action send-action$ f ]
|
||||
METHOD: id revertDocumentToSaved: id event [ self event revert-action send-action$ f ] ;
|
||||
|
||||
! Multi-touch gestures
|
||||
METHOD: void magnifyWithEvent: id event
|
||||
|
|
@ -249,7 +249,7 @@ CLASS: FactorView < NSOpenGLView NSTextInput
|
|||
{ -1 [ zoom-out-action send-action$ ] }
|
||||
{ 0 [ 2drop ] }
|
||||
} case
|
||||
]
|
||||
] ;
|
||||
|
||||
METHOD: void swipeWithEvent: id event
|
||||
[
|
||||
|
|
@ -267,9 +267,9 @@ CLASS: FactorView < NSOpenGLView NSTextInput
|
|||
]
|
||||
}
|
||||
} case
|
||||
]
|
||||
] ;
|
||||
|
||||
METHOD: char acceptsFirstResponder [ 1 ]
|
||||
METHOD: char acceptsFirstResponder [ 1 ] ;
|
||||
|
||||
! Services
|
||||
METHOD: id validRequestorForSendType: id sendType returnType: id returnType
|
||||
|
|
@ -279,7 +279,7 @@ CLASS: FactorView < NSOpenGLView NSTextInput
|
|||
world-focus sendType returnType
|
||||
valid-service? [ self ] [ f ] if
|
||||
] [ f ] if*
|
||||
]
|
||||
] ;
|
||||
|
||||
METHOD: char writeSelectionToPasteboard: id pboard types: id types
|
||||
[
|
||||
|
|
@ -289,7 +289,7 @@ CLASS: FactorView < NSOpenGLView NSTextInput
|
|||
[ pboard set-pasteboard-string 1 ] [ 0 ] if*
|
||||
] [ 0 ] if*
|
||||
] [ 0 ] if
|
||||
]
|
||||
] ;
|
||||
|
||||
METHOD: char readSelectionFromPasteboard: id pboard
|
||||
[
|
||||
|
|
@ -298,7 +298,7 @@ CLASS: FactorView < NSOpenGLView NSTextInput
|
|||
pboard pasteboard-string
|
||||
[ window user-input 1 ] [ 0 ] if*
|
||||
] [ 0 ] if
|
||||
]
|
||||
] ;
|
||||
|
||||
! Text input
|
||||
METHOD: void insertText: id text
|
||||
|
|
@ -307,27 +307,27 @@ CLASS: FactorView < NSOpenGLView NSTextInput
|
|||
window [
|
||||
text CF>string window user-input
|
||||
] when
|
||||
]
|
||||
] ;
|
||||
|
||||
METHOD: char hasMarkedText [ 0 ]
|
||||
METHOD: char hasMarkedText [ 0 ] ;
|
||||
|
||||
METHOD: NSRange markedRange [ 0 0 <NSRange> ]
|
||||
METHOD: NSRange markedRange [ 0 0 <NSRange> ] ;
|
||||
|
||||
METHOD: NSRange selectedRange [ 0 0 <NSRange> ]
|
||||
METHOD: NSRange selectedRange [ 0 0 <NSRange> ] ;
|
||||
|
||||
METHOD: void setMarkedText: id text selectedRange: NSRange range [ ]
|
||||
METHOD: void setMarkedText: id text selectedRange: NSRange range [ ] ;
|
||||
|
||||
METHOD: void unmarkText [ ]
|
||||
METHOD: void unmarkText [ ] ;
|
||||
|
||||
METHOD: id validAttributesForMarkedText [ NSArray -> array ]
|
||||
METHOD: id validAttributesForMarkedText [ NSArray -> array ] ;
|
||||
|
||||
METHOD: id attributedSubstringFromRange: NSRange range [ f ]
|
||||
METHOD: id attributedSubstringFromRange: NSRange range [ f ] ;
|
||||
|
||||
METHOD: NSUInteger characterIndexForPoint: NSPoint point [ 0 ]
|
||||
METHOD: NSUInteger characterIndexForPoint: NSPoint point [ 0 ] ;
|
||||
|
||||
METHOD: NSRect firstRectForCharacterRange: NSRange range [ 0 0 0 0 <CGRect> ]
|
||||
METHOD: NSRect firstRectForCharacterRange: NSRange range [ 0 0 0 0 <CGRect> ] ;
|
||||
|
||||
METHOD: NSInteger conversationIdentifier [ self alien-address ]
|
||||
METHOD: NSInteger conversationIdentifier [ self alien-address ] ;
|
||||
|
||||
! Initialization
|
||||
METHOD: void updateFactorGadgetSize: id notification
|
||||
|
|
@ -336,24 +336,24 @@ CLASS: FactorView < NSOpenGLView NSTextInput
|
|||
window [
|
||||
self view-dim window dim<< yield
|
||||
] when
|
||||
]
|
||||
] ;
|
||||
|
||||
METHOD: void doCommandBySelector: SEL selector [ ]
|
||||
METHOD: void doCommandBySelector: SEL selector [ ] ;
|
||||
|
||||
METHOD: id initWithFrame: NSRect frame pixelFormat: id pixelFormat
|
||||
[
|
||||
self frame pixelFormat SUPER-> initWithFrame:pixelFormat:
|
||||
dup dup add-resize-observer
|
||||
]
|
||||
] ;
|
||||
|
||||
METHOD: char isOpaque [ 0 ]
|
||||
METHOD: char isOpaque [ 0 ] ;
|
||||
|
||||
METHOD: void dealloc
|
||||
[
|
||||
self remove-observer
|
||||
self SUPER-> dealloc
|
||||
]
|
||||
]
|
||||
] ;
|
||||
;
|
||||
|
||||
: sync-refresh-to-screen ( GLView -- )
|
||||
-> openGLContext -> CGLContextObj NSOpenGLCPSwapInterval 1 int <ref>
|
||||
|
|
@ -366,18 +366,18 @@ CLASS: FactorView < NSOpenGLView NSTextInput
|
|||
-> frame CGRect-top-left 2array >>window-loc drop ;
|
||||
|
||||
CLASS: FactorWindowDelegate < NSObject
|
||||
[
|
||||
|
||||
METHOD: void windowDidMove: id notification
|
||||
[
|
||||
notification -> object -> contentView window
|
||||
[ notification -> object save-position ] when*
|
||||
]
|
||||
] ;
|
||||
|
||||
METHOD: void windowDidBecomeKey: id notification
|
||||
[
|
||||
notification -> object -> contentView window
|
||||
[ focus-world ] when*
|
||||
]
|
||||
] ;
|
||||
|
||||
METHOD: void windowDidResignKey: id notification
|
||||
[
|
||||
|
|
@ -388,15 +388,15 @@ CLASS: FactorWindowDelegate < NSObject
|
|||
view -> isInFullScreenMode 0 =
|
||||
[ window unfocus-world ] when
|
||||
] when
|
||||
]
|
||||
] ;
|
||||
|
||||
METHOD: char windowShouldClose: id notification [ 1 ]
|
||||
METHOD: char windowShouldClose: id notification [ 1 ] ;
|
||||
|
||||
METHOD: void windowWillClose: id notification
|
||||
[
|
||||
notification -> object -> contentView
|
||||
[ window ungraft ] [ unregister-window ] bi
|
||||
]
|
||||
] ;
|
||||
|
||||
METHOD: void windowDidChangeBackingProperties: id notification
|
||||
[
|
||||
|
|
@ -410,8 +410,8 @@ CLASS: FactorWindowDelegate < NSObject
|
|||
[ [ 1.0 > ] keep f ? gl-scale-factor set-global ]
|
||||
[ 1.0 > retina? set-global ] bi
|
||||
] [ drop ] if
|
||||
]
|
||||
]
|
||||
] ;
|
||||
;
|
||||
|
||||
: install-window-delegate ( window -- )
|
||||
FactorWindowDelegate install-delegate ;
|
||||
|
|
|
|||
Loading…
Reference in New Issue