From 9f0a1ed73033cb86dcad805efed0ec0b49142f15 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 12 Aug 2015 19:44:07 -0500 Subject: [PATCH] cocoa: Syntax is funky, so regularize it by parsing CLASS: ; and METHOD: ; and COCOA-PROTOCOL: token. --- basis/cocoa/cocoa-tests.factor | 17 +-- .../cocoa/subclassing/subclassing-docs.factor | 6 +- basis/cocoa/subclassing/subclassing.factor | 14 +- basis/tools/deploy/test/14/14.factor | 5 +- basis/ui/backend/cocoa/cocoa.factor | 6 +- basis/ui/backend/cocoa/tools/tools.factor | 32 ++--- basis/ui/backend/cocoa/views/views.factor | 128 +++++++++--------- 7 files changed, 104 insertions(+), 104 deletions(-) diff --git a/basis/cocoa/cocoa-tests.factor b/basis/cocoa/cocoa-tests.factor index 59924bc803..466823a5a8 100644 --- a/basis/cocoa/cocoa-tests.factor +++ b/basis/cocoa/cocoa-tests.factor @@ -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 [ diff --git a/basis/cocoa/subclassing/subclassing-docs.factor b/basis/cocoa/subclassing/subclassing-docs.factor index 2c83e60dde..2b7a296055 100644 --- a/basis/cocoa/subclassing/subclassing-docs.factor +++ b/basis/cocoa/subclassing/subclassing-docs.factor @@ -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." } ; diff --git a/basis/cocoa/subclassing/subclassing.factor b/basis/cocoa/subclassing/subclassing.factor index f744a22755..4063ce68da 100644 --- a/basis/cocoa/subclassing/subclassing.factor +++ b/basis/cocoa/subclassing/subclassing.factor @@ -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 + +SYNTAX: COCOA-PROTOCOL: + scan-token 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! ; diff --git a/basis/tools/deploy/test/14/14.factor b/basis/tools/deploy/test/14/14.factor index 95ab68916a..f8dd0db174 100644 --- a/basis/tools/deploy/test/14/14.factor +++ b/basis/tools/deploy/test/14/14.factor @@ -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 diff --git a/basis/ui/backend/cocoa/cocoa.factor b/basis/ui/backend/cocoa/cocoa.factor index 11f3c2a963..c1f68d3cd8 100644 --- a/basis/ui/backend/cocoa/cocoa.factor +++ b/basis/ui/backend/cocoa/cocoa.factor @@ -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 ; diff --git a/basis/ui/backend/cocoa/tools/tools.factor b/basis/ui/backend/cocoa/tools/tools.factor index 860ffe767b..94d522c933 100644 --- a/basis/ui/backend/cocoa/tools/tools.factor +++ b/basis/ui/backend/cocoa/tools/tools.factor @@ -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 diff --git a/basis/ui/backend/cocoa/views/views.factor b/basis/ui/backend/cocoa/views/views.factor index e2ee2ba472..463f70238c 100644 --- a/basis/ui/backend/cocoa/views/views.factor +++ b/basis/ui/backend/cocoa/views/views.factor @@ -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 ] + METHOD: NSRange markedRange [ 0 0 ] ; - METHOD: NSRange selectedRange [ 0 0 ] + METHOD: NSRange selectedRange [ 0 0 ] ; - 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 ] + METHOD: NSRect firstRectForCharacterRange: NSRange range [ 0 0 0 0 ] ; - 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 @@ -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 ;