cocoa: Syntax is funky, so regularize it by parsing CLASS: ; and METHOD: ; and COCOA-PROTOCOL: token.

db4
Doug Coleman 2015-08-12 19:44:07 -05:00
parent 02008979d9
commit 9f0a1ed730
7 changed files with 104 additions and 104 deletions

View File

@ -5,11 +5,10 @@ core-graphics.types ;
IN: cocoa.tests IN: cocoa.tests
CLASS: Foo < NSObject CLASS: Foo < NSObject
[
METHOD: void foo: NSRect rect [ METHOD: void foo: NSRect rect [
gc rect "x" set gc rect "x" set
] ] ;
] ;
: test-foo ( -- ) : test-foo ( -- )
Foo -> alloc -> init Foo -> alloc -> init
@ -24,9 +23,8 @@ CLASS: Foo < NSObject
{ 102.0 } [ "x" get CGRect-h ] unit-test { 102.0 } [ "x" get CGRect-h ] unit-test
CLASS: Bar < NSObject CLASS: Bar < NSObject
[ METHOD: NSRect bar [ test-foo "x" get ] ;
METHOD: NSRect bar [ test-foo "x" get ] ;
]
{ } [ { } [
Bar [ Bar [
@ -43,11 +41,10 @@ CLASS: Bar < NSObject
! Make sure that we can add methods ! Make sure that we can add methods
CLASS: Bar < NSObject 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 } [ { 144 } [
Bar [ Bar [

View File

@ -2,8 +2,8 @@ USING: help.markup help.syntax strings alien hashtables ;
IN: cocoa.subclassing IN: cocoa.subclassing
HELP: CLASS: HELP: CLASS:
{ $syntax "CLASS: name < superclass protocols... [ imeth... ]" } { $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: } } } { $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." { $description "Defines a new Objective C class. Instance methods are defined with the " { $link POSTPONE: METHOD: } " parsing word."
$nl $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." } ; "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 { define-objc-class POSTPONE: CLASS: POSTPONE: METHOD: } related-words
HELP: METHOD: 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" } } { $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." } ; { $description "Defines a method inside of a " { $link POSTPONE: CLASS: } " form." } ;

View File

@ -1,6 +1,6 @@
! Copyright (C) 2006, 2010 Slava Pestov, Joe Groff. ! Copyright (C) 2006, 2010 Slava Pestov, Joe Groff.
! See http://factorcode.org/license.txt for BSD license. ! 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 cocoa.messages cocoa.runtime combinators compiler.units fry
io.encodings.utf8 kernel lexer locals locals.parser locals.types io.encodings.utf8 kernel lexer locals locals.parser locals.types
make namespaces parser sequences words ; make namespaces parser sequences words ;
@ -68,12 +68,18 @@ IN: cocoa.subclassing
methods name redefine-objc-methods methods name redefine-objc-methods
name [ methods protocols superclass name (define-objc-class) ] import-objc-class ; 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: SYNTAX: CLASS:
scan-token scan-token
"<" expect "<" expect
scan-token scan-token
"[" parse-tokens \ ; parse-until [ cocoa-protocol? ] partition
\ ] parse-until define-objc-class ; [ [ name>> ] map ] dip define-objc-class ;
: (parse-selector) ( -- ) : (parse-selector) ( -- )
scan-token { scan-token {
@ -96,5 +102,5 @@ SYNTAX: CLASS:
SYNTAX: METHOD: SYNTAX: METHOD:
scan-c-type scan-c-type
parse-selector parse-selector
parse-method-body [ swap ] 2dip 4array parse-method-body [ swap ] 2dip 4array ";" expect
suffix! ; suffix! ;

View File

@ -7,13 +7,12 @@ FROM: alien.c-types => float ;
IN: tools.deploy.test.14 IN: tools.deploy.test.14
CLASS: Bar < NSObject CLASS: Bar < NSObject
[
METHOD: float bar: NSRect rect [ METHOD: float bar: NSRect rect [
rect origin>> [ x>> ] [ y>> ] bi + rect origin>> [ x>> ] [ y>> ] bi +
rect size>> [ w>> ] [ h>> ] bi + rect size>> [ w>> ] [ h>> ] bi +
+ +
] ] ;
] ;
: main ( -- ) : main ( -- )
Bar -> alloc -> init Bar -> alloc -> init

View File

@ -232,10 +232,8 @@ M: cocoa-ui-backend system-alert
] [ 2drop ] if* ; ] [ 2drop ] if* ;
CLASS: FactorApplicationDelegate < NSObject CLASS: FactorApplicationDelegate < NSObject
[ METHOD: void applicationDidUpdate: id obj [ reset-thread-timer ] ;
METHOD: void applicationDidUpdate: id obj ;
[ reset-thread-timer ]
]
: install-app-delegate ( -- ) : install-app-delegate ( -- )
NSApp FactorApplicationDelegate install-delegate ; NSApp FactorApplicationDelegate install-delegate ;

View File

@ -22,27 +22,27 @@ IN: ui.backend.cocoa.tools
! Handle Open events from the Finder ! Handle Open events from the Finder
CLASS: FactorWorkspaceApplicationDelegate < FactorApplicationDelegate 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 ( -- ) : install-app-delegate ( -- )
NSApp FactorWorkspaceApplicationDelegate install-delegate ; NSApp FactorWorkspaceApplicationDelegate install-delegate ;
@ -54,16 +54,16 @@ CLASS: FactorWorkspaceApplicationDelegate < FactorApplicationDelegate
[ pboard set-pasteboard-string ] when* ; [ pboard set-pasteboard-string ] when* ;
CLASS: FactorServiceProvider < NSObject CLASS: FactorServiceProvider < NSObject
[
METHOD: void evalInListener: id pboard userData: id userData error: id error 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 METHOD: void evalToString: id pboard userData: id userData error: id error
[ [
pboard error pboard error
[ [ (eval>string) ] with-interactive-vocabs ] do-service [ [ (eval>string) ] with-interactive-vocabs ] do-service
] ] ;
] ;
: register-services ( -- ) : register-services ( -- )
NSApp NSApp

View File

@ -150,8 +150,8 @@ CONSTANT: selector>action H{
selector>action at selector>action at
[ swap world-focus parents-handle-gesture? t ] [ drop f f ] if* ; [ swap world-focus parents-handle-gesture? t ] [ drop f f ] if* ;
CLASS: FactorView < NSOpenGLView NSTextInput CLASS: FactorView < NSOpenGLView
[ COCOA-PROTOCOL: NSTextInput
METHOD: void prepareOpenGL [ METHOD: void prepareOpenGL [
@ -170,43 +170,43 @@ CLASS: FactorView < NSOpenGLView NSTextInput
] [ drop ] if ] [ drop ] if
] when ] when
] ] ;
! Rendering ! Rendering
METHOD: void drawRect: NSRect rect [ self window [ draw-world ] when* ] METHOD: void drawRect: NSRect rect [ self window [ draw-world ] when* ] ;
! Events ! 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 METHOD: char validateUserInterfaceItem: id event
[ [
@ -214,31 +214,31 @@ CLASS: FactorView < NSOpenGLView NSTextInput
event -> action utf8 alien>string validate-action event -> action utf8 alien>string validate-action
[ >c-bool ] [ drop self event SUPER-> validateUserInterfaceItem: ] if [ >c-bool ] [ drop self event SUPER-> validateUserInterfaceItem: ] if
] [ 0 ] 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 ! Multi-touch gestures
METHOD: void magnifyWithEvent: id event METHOD: void magnifyWithEvent: id event
@ -249,7 +249,7 @@ CLASS: FactorView < NSOpenGLView NSTextInput
{ -1 [ zoom-out-action send-action$ ] } { -1 [ zoom-out-action send-action$ ] }
{ 0 [ 2drop ] } { 0 [ 2drop ] }
} case } case
] ] ;
METHOD: void swipeWithEvent: id event METHOD: void swipeWithEvent: id event
[ [
@ -267,9 +267,9 @@ CLASS: FactorView < NSOpenGLView NSTextInput
] ]
} }
} case } case
] ] ;
METHOD: char acceptsFirstResponder [ 1 ] METHOD: char acceptsFirstResponder [ 1 ] ;
! Services ! Services
METHOD: id validRequestorForSendType: id sendType returnType: id returnType METHOD: id validRequestorForSendType: id sendType returnType: id returnType
@ -279,7 +279,7 @@ CLASS: FactorView < NSOpenGLView NSTextInput
world-focus sendType returnType world-focus sendType returnType
valid-service? [ self ] [ f ] if valid-service? [ self ] [ f ] if
] [ f ] if* ] [ f ] if*
] ] ;
METHOD: char writeSelectionToPasteboard: id pboard types: id types METHOD: char writeSelectionToPasteboard: id pboard types: id types
[ [
@ -289,7 +289,7 @@ CLASS: FactorView < NSOpenGLView NSTextInput
[ pboard set-pasteboard-string 1 ] [ 0 ] if* [ pboard set-pasteboard-string 1 ] [ 0 ] if*
] [ 0 ] if* ] [ 0 ] if*
] [ 0 ] if ] [ 0 ] if
] ] ;
METHOD: char readSelectionFromPasteboard: id pboard METHOD: char readSelectionFromPasteboard: id pboard
[ [
@ -298,7 +298,7 @@ CLASS: FactorView < NSOpenGLView NSTextInput
pboard pasteboard-string pboard pasteboard-string
[ window user-input 1 ] [ 0 ] if* [ window user-input 1 ] [ 0 ] if*
] [ 0 ] if ] [ 0 ] if
] ] ;
! Text input ! Text input
METHOD: void insertText: id text METHOD: void insertText: id text
@ -307,27 +307,27 @@ CLASS: FactorView < NSOpenGLView NSTextInput
window [ window [
text CF>string window user-input text CF>string window user-input
] when ] 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 ! Initialization
METHOD: void updateFactorGadgetSize: id notification METHOD: void updateFactorGadgetSize: id notification
@ -336,24 +336,24 @@ CLASS: FactorView < NSOpenGLView NSTextInput
window [ window [
self view-dim window dim<< yield self view-dim window dim<< yield
] when ] when
] ] ;
METHOD: void doCommandBySelector: SEL selector [ ] METHOD: void doCommandBySelector: SEL selector [ ] ;
METHOD: id initWithFrame: NSRect frame pixelFormat: id pixelFormat METHOD: id initWithFrame: NSRect frame pixelFormat: id pixelFormat
[ [
self frame pixelFormat SUPER-> initWithFrame:pixelFormat: self frame pixelFormat SUPER-> initWithFrame:pixelFormat:
dup dup add-resize-observer dup dup add-resize-observer
] ] ;
METHOD: char isOpaque [ 0 ] METHOD: char isOpaque [ 0 ] ;
METHOD: void dealloc METHOD: void dealloc
[ [
self remove-observer self remove-observer
self SUPER-> dealloc self SUPER-> dealloc
] ] ;
] ;
: sync-refresh-to-screen ( GLView -- ) : sync-refresh-to-screen ( GLView -- )
-> openGLContext -> CGLContextObj NSOpenGLCPSwapInterval 1 int <ref> -> openGLContext -> CGLContextObj NSOpenGLCPSwapInterval 1 int <ref>
@ -366,18 +366,18 @@ CLASS: FactorView < NSOpenGLView NSTextInput
-> frame CGRect-top-left 2array >>window-loc drop ; -> frame CGRect-top-left 2array >>window-loc drop ;
CLASS: FactorWindowDelegate < NSObject CLASS: FactorWindowDelegate < NSObject
[
METHOD: void windowDidMove: id notification METHOD: void windowDidMove: id notification
[ [
notification -> object -> contentView window notification -> object -> contentView window
[ notification -> object save-position ] when* [ notification -> object save-position ] when*
] ] ;
METHOD: void windowDidBecomeKey: id notification METHOD: void windowDidBecomeKey: id notification
[ [
notification -> object -> contentView window notification -> object -> contentView window
[ focus-world ] when* [ focus-world ] when*
] ] ;
METHOD: void windowDidResignKey: id notification METHOD: void windowDidResignKey: id notification
[ [
@ -388,15 +388,15 @@ CLASS: FactorWindowDelegate < NSObject
view -> isInFullScreenMode 0 = view -> isInFullScreenMode 0 =
[ window unfocus-world ] when [ window unfocus-world ] when
] when ] when
] ] ;
METHOD: char windowShouldClose: id notification [ 1 ] METHOD: char windowShouldClose: id notification [ 1 ] ;
METHOD: void windowWillClose: id notification METHOD: void windowWillClose: id notification
[ [
notification -> object -> contentView notification -> object -> contentView
[ window ungraft ] [ unregister-window ] bi [ window ungraft ] [ unregister-window ] bi
] ] ;
METHOD: void windowDidChangeBackingProperties: id notification METHOD: void windowDidChangeBackingProperties: id notification
[ [
@ -410,8 +410,8 @@ CLASS: FactorWindowDelegate < NSObject
[ [ 1.0 > ] keep f ? gl-scale-factor set-global ] [ [ 1.0 > ] keep f ? gl-scale-factor set-global ]
[ 1.0 > retina? set-global ] bi [ 1.0 > retina? set-global ] bi
] [ drop ] if ] [ drop ] if
] ] ;
] ;
: install-window-delegate ( window -- ) : install-window-delegate ( window -- )
FactorWindowDelegate install-delegate ; FactorWindowDelegate install-delegate ;