cocoa: CLASS: ; -> <CLASS: ;CLASS>

<CLASS: is a container like <PRIVATE and <FUNCTOR:
modern-harvey2
Doug Coleman 2017-08-05 20:54:02 -05:00
parent 27b3c4cccf
commit 7d47def4c9
7 changed files with 27 additions and 25 deletions

View File

@ -3,11 +3,11 @@ cocoa.types compiler.test core-graphics.types kernel math memory
namespaces tools.test ;
IN: cocoa.tests
CLASS: Foo < NSObject
<CLASS: Foo < NSObject
METHOD: void foo: NSRect rect [
gc rect "x" set
] ;
;
;CLASS>
: test-foo ( -- )
Foo -> alloc -> init
@ -21,9 +21,9 @@ CLASS: Foo < NSObject
{ 101.0 } [ "x" get CGRect-w ] unit-test
{ 102.0 } [ "x" get CGRect-h ] unit-test
CLASS: Bar < NSObject
<CLASS: Bar < NSObject
METHOD: NSRect bar [ test-foo "x" get ] ;
;
;CLASS>
{ } [
Bar [
@ -39,11 +39,11 @@ CLASS: Bar < NSObject
{ 102.0 } [ "x" get CGRect-h ] unit-test
! Make sure that we can add methods
CLASS: Bar < NSObject
<CLASS: Bar < NSObject
METHOD: NSRect bar [ test-foo "x" get ] ;
METHOD: int babb: int x [ x sq ] ;
;
;CLASS>
{ 144 } [
Bar [

View File

@ -1,23 +1,23 @@
USING: help.markup help.syntax strings alien hashtables ;
IN: cocoa.subclassing
HELP: CLASS:
{ $syntax "CLASS: name < superclass protocols... imeth... ;" }
HELP: <CLASS:
{ $syntax "<CLASS: name < superclass protocols... imeth... ;CLASS>" }
{ $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." } ;
{ define-objc-class POSTPONE: CLASS: POSTPONE: METHOD: } 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." } ;
{ $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 parsing words:"
{ $subsections POSTPONE: CLASS: POSTPONE: METHOD: }
{ $subsections POSTPONE: <CLASS: POSTPONE: METHOD: }
"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." ;
ABOUT: "objc-subclassing"

View File

@ -74,11 +74,13 @@ C: <cocoa-protocol> cocoa-protocol
SYNTAX: COCOA-PROTOCOL:
scan-token <cocoa-protocol> suffix! ;
SYNTAX: CLASS:
SYMBOL: ;CLASS>
SYNTAX: <CLASS:
scan-token
"<" expect
scan-token
\ ; parse-until [ cocoa-protocol? ] partition
\ ;CLASS> parse-until [ cocoa-protocol? ] partition
[ [ name>> ] map ] dip define-objc-class ;
: (parse-selector) ( -- )

View File

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

View File

@ -195,14 +195,14 @@ M: cocoa-ui-backend system-alert
} cleave
] [ 2drop ] if* ;
CLASS: FactorApplicationDelegate < NSObject
<CLASS: FactorApplicationDelegate < NSObject
METHOD: void applicationDidUpdate: id obj [ reset-thread-timer ] ;
METHOD: char applicationShouldTerminateAfterLastWindowClosed: id app [
ui-stop-after-last-window? get 1 0 ?
] ;
;
;CLASS>
: install-app-delegate ( -- )
NSApp FactorApplicationDelegate install-delegate ;

View File

@ -21,7 +21,7 @@ IN: ui.backend.cocoa.tools
image-path save-panel [ save-image ] when* ;
! Handle Open events from the Finder
CLASS: FactorWorkspaceApplicationDelegate < FactorApplicationDelegate
<CLASS: FactorWorkspaceApplicationDelegate < FactorApplicationDelegate
METHOD: void application: id app openFiles: id files [ files finder-run-files ] ;
@ -46,7 +46,7 @@ CLASS: FactorWorkspaceApplicationDelegate < FactorApplicationDelegate
METHOD: id switchDarkTheme: id app [ dark-mode f ] ;
METHOD: id refreshAll: id app [ [ refresh-all ] \ refresh-all call-listener f ] ;
;
;CLASS>
: install-app-delegate ( -- )
NSApp FactorWorkspaceApplicationDelegate install-delegate ;
@ -57,7 +57,7 @@ CLASS: FactorWorkspaceApplicationDelegate < FactorApplicationDelegate
dup [ quot call( string -- result/f ) ] when
[ pboard set-pasteboard-string ] when* ;
CLASS: FactorServiceProvider < NSObject
<CLASS: FactorServiceProvider < NSObject
METHOD: void evalInListener: id pboard userData: id userData error: id error
[ pboard error [ eval-listener f ] do-service ] ;
@ -67,7 +67,7 @@ CLASS: FactorServiceProvider < NSObject
pboard error
[ [ (eval>string) ] with-interactive-vocabs ] do-service
] ;
;
;CLASS>
: register-services ( -- )
NSApp

View File

@ -161,7 +161,7 @@ CONSTANT: selector>action H{
selector>action at
[ swap world-focus parents-handle-gesture? t ] [ drop f f ] if* ;
CLASS: FactorView < NSOpenGLView
<CLASS: FactorView < NSOpenGLView
COCOA-PROTOCOL: NSTextInput
METHOD: void prepareOpenGL [
@ -388,7 +388,7 @@ CLASS: FactorView < NSOpenGLView
self remove-observer
self SUPER-> dealloc
] ;
;
;CLASS>
: sync-refresh-to-screen ( GLView -- )
-> openGLContext -> CGLContextObj NSOpenGLCPSwapInterval 1 int <ref>
@ -400,7 +400,7 @@ CLASS: FactorView < NSOpenGLView
: save-position ( world window -- )
-> frame CGRect-top-left 2array >>window-loc drop ;
CLASS: FactorWindowDelegate < NSObject
<CLASS: FactorWindowDelegate < NSObject
METHOD: void windowDidMove: id notification
[
@ -444,7 +444,7 @@ CLASS: FactorWindowDelegate < NSObject
[ 1.0 > retina? set-global ] bi
] [ drop ] if
] ;
;
;CLASS>
: install-window-delegate ( window -- )
FactorWindowDelegate install-delegate ;