Merge branch 'master' of git://factorcode.org/git/factor

diff --git a/basis/cocoa/messages/messages.factor b/basis/cocoa/messages/messages.factor
index 7977485b02c2245a34e0b2c40fcf2b01d88327d2..3d7e1bfd84c1512ca1e1b3c14c0c46377391838a 100755 (executable)
--- a/basis/cocoa/messages/messages.factor
+++ b/basis/cocoa/messages/messages.factor
@@ -3,7 +3,7 @@
 USING: accessors alien alien.c-types alien.strings arrays assocs
 combinators compiler kernel math namespaces make parser
 prettyprint prettyprint.sections quotations sequences strings
-words cocoa.runtime io macros memoize debugger
+words cocoa.runtime io macros memoize debugger fry
 io.encodings.ascii effects compiler.generator libc libc.private ;
 IN: cocoa.messages
 
@@ -107,22 +107,34 @@ H{
     { "c" "char" }
     { "i" "int" }
     { "s" "short" }
-    { "l" "long" }
-    { "q" "longlong" }
     { "C" "uchar" }
     { "I" "uint" }
     { "S" "ushort" }
-    { "L" "ulong" }
-    { "Q" "ulonglong" }
     { "f" "float" }
     { "d" "double" }
     { "B" "bool" }
     { "v" "void" }
     { "*" "char*" }
+    { "?" "unknown_type" }
     { "@" "id" }
-    { "#" "id" }
+    { "#" "Class" }
     { ":" "SEL" }
-} objc>alien-types set-global
+}
+"ptrdiff_t" heap-size {
+    { 4 [ H{
+        { "l" "long" }
+        { "q" "longlong" }
+        { "L" "ulong" }
+        { "Q" "ulonglong" }
+    } ] }
+    { 8 [ H{
+        { "l" "long32" }
+        { "q" "long" }
+        { "L" "ulong32" }
+        { "Q" "ulong" }
+    } ] }
+} case
+assoc-union objc>alien-types set-global
 
 ! The transpose of the above map
 SYMBOL: alien>objc-types
@@ -131,16 +143,22 @@ objc>alien-types get [ swap ] assoc-map
 ! A hack...
 "ptrdiff_t" heap-size {
     { 4 [ H{
-        { "NSPoint" "{_NSPoint=ff}" }
-        { "NSRect" "{_NSRect=ffff}" }
-        { "NSSize" "{_NSSize=ff}" }
-        { "NSRange" "{_NSRange=II}" }
+        { "NSPoint"    "{_NSPoint=ff}" }
+        { "NSRect"     "{_NSRect={_NSPoint=ff}{_NSSize=ff}}" }
+        { "NSSize"     "{_NSSize=ff}" }
+        { "NSRange"    "{_NSRange=II}" }
+        { "NSInteger"  "i" }
+        { "NSUInteger" "I" }
+        { "CGFloat"    "f" }
     } ] }
     { 8 [ H{
-        { "NSPoint" "{_NSPoint=dd}" }
-        { "NSRect" "{_NSRect=dddd}" }
-        { "NSSize" "{_NSSize=dd}" }
-        { "NSRange" "{_NSRange=QQ}" }
+        { "NSPoint"    "{CGPoint=dd}" }
+        { "NSRect"     "{CGRect={CGPoint=dd}{CGSize=dd}}" }
+        { "NSSize"     "{CGSize=dd}" }
+        { "NSRange"    "{_NSRange=QQ}" }
+        { "NSInteger"  "q" }
+        { "NSUInteger" "Q" }
+        { "CGFloat"    "d" }
     } ] }
 } case
 assoc-union alien>objc-types set-global
@@ -183,12 +201,23 @@ assoc-union alien>objc-types set-global
     swap method_getName sel_getName
     objc-methods get set-at ;
 
-: (register-objc-methods) ( methods count -- methods )
-    over [ void*-nth register-objc-method ] curry each ;
+: each-method-in-class ( class quot -- )
+    [ 0 <uint> [ class_copyMethodList ] keep *uint over ] dip
+    '[ _ void*-nth @ ] each (free) ; inline
 
 : register-objc-methods ( class -- )
-    0 <uint> [ class_copyMethodList ] keep *uint 
-    (register-objc-methods) (free) ;
+    [ register-objc-method ] each-method-in-class ;
+
+: method. ( method -- )
+    {
+        [ method_getName sel_getName ]
+        [ method-return-type ]
+        [ method-arg-types ]
+        [ method_getImplementation ]
+    } cleave 4array . ;
+
+: methods. ( class -- )
+    [ method. ] each-method-in-class ;
 
 : class-exists? ( string -- class ) objc_getClass >boolean ;
 

diff --git a/basis/cocoa/runtime/runtime.factor b/basis/cocoa/runtime/runtime.factor
index 3451ce5e6ef65d33c89691226cdc36479fbc6110..1a741b789ff6c187bf039604226f5994c3e05cfa 100644 (file)
--- a/basis/cocoa/runtime/runtime.factor
+++ b/basis/cocoa/runtime/runtime.factor
@@ -9,7 +9,7 @@ TYPEDEF: void* id
 
 FUNCTION: char* sel_getName ( SEL aSelector ) ;
 
-FUNCTION: bool sel_isMapped ( SEL aSelector ) ;
+FUNCTION: char sel_isMapped ( SEL aSelector ) ;
 
 FUNCTION: SEL sel_registerName ( char* str ) ;
 
@@ -54,6 +54,8 @@ FUNCTION: Method* class_copyMethodList ( Class class, uint* outCount ) ;
 
 FUNCTION: Class class_getSuperclass ( Class cls ) ;
 
+FUNCTION: char* class_getName ( Class cls ) ;
+
 FUNCTION: char class_addMethod ( Class class, SEL name, void* imp, void* types ) ;
 
 FUNCTION: char class_addProtocol ( Class class, Protocol protocol ) ;
@@ -73,5 +75,6 @@ FUNCTION: void* method_getTypeEncoding ( Method method ) ;
 FUNCTION: SEL method_getName ( Method method ) ;
 
 FUNCTION: void* method_setImplementation ( Method method, void* imp ) ; 
+FUNCTION: void* method_getImplementation ( Method method ) ; 
 
 FUNCTION: Class object_getClass ( id object ) ;

diff --git a/basis/cocoa/subclassing/subclassing.factor b/basis/cocoa/subclassing/subclassing.factor
index 3f8e709df0e779dc0d88855aba3177feb0329b0a..fd18c7fa89d738e07c95d3831fd8b238e8e0f6a4 100755 (executable)
--- a/basis/cocoa/subclassing/subclassing.factor
+++ b/basis/cocoa/subclassing/subclassing.factor
@@ -12,12 +12,17 @@ IN: cocoa.subclassing
     [ sel_registerName ] [ execute ] [ ascii string>alien ]
     tri* ;
 
+: throw-if-false ( YES/NO -- )
+    zero? [ "Failed to add method or protocol to class" throw ]
+    when ;
+
 : add-methods ( methods class -- )
     swap
-    [ init-method class_addMethod drop ] with each ;
+    [ init-method class_addMethod throw-if-false ] with each ;
 
 : add-protocols ( protocols class -- )
-    swap [ objc-protocol class_addProtocol drop ] with each ;
+    swap [ objc-protocol class_addProtocol throw-if-false ]
+    with each ;
 
 : (define-objc-class) ( protocols superclass name imeth -- )
     -rot

diff --git a/basis/cocoa/types/types.factor b/basis/cocoa/types/types.factor
index 0bf4257a0b8355c7718b502ecc499858ad0a12fe..a76e74d9aabaeeaa02fbe024136261c89dd14404 100644 (file)
--- a/basis/cocoa/types/types.factor
+++ b/basis/cocoa/types/types.factor
@@ -10,25 +10,6 @@ TYPEDEF: ulong NSUInteger
     { 8 [ "double" ] }
 } case "CGFloat" typedef >>
 
-C-STRUCT: NSRect
-    { "CGFloat" "x" }
-    { "CGFloat" "y" }
-    { "CGFloat" "w" }
-    { "CGFloat" "h" } ;
-
-TYPEDEF: NSRect _NSRect
-TYPEDEF: NSRect CGRect
-
-: <NSRect> ( x y w h -- rect )
-    "NSRect" <c-object>
-    [ set-NSRect-h ] keep
-    [ set-NSRect-w ] keep
-    [ set-NSRect-y ] keep
-    [ set-NSRect-x ] keep ;
-
-: NSRect-x-y ( alien -- origin-x origin-y )
-    [ NSRect-x ] keep NSRect-y ;
-
 C-STRUCT: NSPoint
     { "CGFloat" "x" }
     { "CGFloat" "y" } ;
@@ -47,19 +28,58 @@ C-STRUCT: NSSize
 
 TYPEDEF: NSSize _NSSize
 TYPEDEF: NSSize CGSize
-TYPEDEF: NSPoint CGPoint
 
 : <NSSize> ( w h -- size )
     "NSSize" <c-object>
     [ set-NSSize-h ] keep
     [ set-NSSize-w ] keep ;
 
+C-STRUCT: NSRect
+    { "NSPoint" "origin" }
+    { "NSSize"  "size"   } ;
+
+TYPEDEF: NSRect _NSRect
+TYPEDEF: NSRect CGRect
+
+: NSRect-x ( NSRect -- x )
+    NSRect-origin NSPoint-x ; inline
+: NSRect-y ( NSRect -- y )
+    NSRect-origin NSPoint-y ; inline
+: NSRect-w ( NSRect -- w )
+    NSRect-size NSSize-w ; inline
+: NSRect-h ( NSRect -- h )
+    NSRect-size NSSize-h ; inline
+
+: set-NSRect-x ( x NSRect -- )
+    NSRect-origin set-NSPoint-x ; inline
+: set-NSRect-y ( y NSRect -- )
+    NSRect-origin set-NSPoint-y ; inline
+: set-NSRect-w ( w NSRect -- )
+    NSRect-size set-NSSize-w ; inline
+: set-NSRect-h ( h NSRect -- )
+    NSRect-size set-NSSize-h ; inline
+
+: <NSRect> ( x y w h -- rect )
+    "NSRect" <c-object>
+    [ set-NSRect-h ] keep
+    [ set-NSRect-w ] keep
+    [ set-NSRect-y ] keep
+    [ set-NSRect-x ] keep ;
+
+: NSRect-x-y ( alien -- origin-x origin-y )
+    [ NSRect-x ] keep NSRect-y ;
+
 C-STRUCT: NSRange
     { "NSUInteger" "location" }
     { "NSUInteger" "length" } ;
 
 TYPEDEF: NSRange _NSRange
 
+! The "lL" type encodings refer to 32-bit values even in 64-bit mode
+TYPEDEF: int long32
+TYPEDEF: uint ulong32
+TYPEDEF: void* unknown_type
+
 : <NSRange> ( length location -- size )
     "NSRange" <c-object>
     [ set-NSRange-length ] keep

diff --git a/basis/ui/cocoa/views/views.factor b/basis/ui/cocoa/views/views.factor
index 45ab8ac0ce26b4cf0edf7a1dda3702d5e462386e..c6942a815836b282d727a202014bcb28552f6157 100755 (executable)
--- a/basis/ui/cocoa/views/views.factor
+++ b/basis/ui/cocoa/views/views.factor
@@ -128,12 +128,12 @@ CLASS: {
 }
 
 ! Rendering
-{ "drawRect:" "void" { "id" "SEL" "id" "NSRect" }
-    [ 3drop window relayout-1 ]
+{ "drawRect:" "void" { "id" "SEL" "NSRect" }
+    [ 2drop window relayout-1 ]
 }
 
 ! Events
-{ "acceptsFirstMouse:" "bool" { "id" "SEL" "id" }
+{ "acceptsFirstMouse:" "char" { "id" "SEL" "id" }
     [ 3drop 1 ]
 }
 
@@ -251,7 +251,7 @@ CLASS: {
 
 ! "rotateWithEvent:" "void" { "id" "SEL" "id" }}
 
-{ "acceptsFirstResponder" "bool" { "id" "SEL" }
+{ "acceptsFirstResponder" "char" { "id" "SEL" }
     [ 2drop 1 ]
 }
 
@@ -264,26 +264,26 @@ CLASS: {
     ]
 }
 
-{ "writeSelectionToPasteboard:types:" "bool" { "id" "SEL" "id" "id" }
+{ "writeSelectionToPasteboard:types:" "char" { "id" "SEL" "id" "id" }
     [
         CF>string-array NSStringPboardType swap member? [
             >r drop window-focus gadget-selection dup [
-                r> set-pasteboard-string t
+                r> set-pasteboard-string 1
             ] [
-                r> 2drop f
+                r> 2drop 0
             ] if
         ] [
-            3drop f
+            3drop 0
         ] if
     ]
 }
 
-{ "readSelectionFromPasteboard:" "bool" { "id" "SEL" "id" }
+{ "readSelectionFromPasteboard:" "char" { "id" "SEL" "id" }
     [
         pasteboard-string dup [
-            >r drop window-focus r> swap user-input t
+            >r drop window-focus r> swap user-input 1
         ] [
-            3drop f
+            3drop 0
         ] if
     ]
 }
@@ -293,7 +293,7 @@ CLASS: {
     [ [ nip send-user-input ] ui-try ]
 }
 
-{ "hasMarkedText" "bool" { "id" "SEL" }
+{ "hasMarkedText" "char" { "id" "SEL" }
     [ 2drop 0 ]
 }
 
@@ -321,7 +321,7 @@ CLASS: {
     [ 3drop f ]
 }
 
-{ "characterIndexForPoint:" "uint" { "id" "SEL" "NSPoint" }
+{ "characterIndexForPoint:" "NSUInteger" { "id" "SEL" "NSPoint" }
     [ 3drop 0 ]
 }
 
@@ -329,7 +329,7 @@ CLASS: {
     [ 3drop 0 0 0 0 <NSRect> ]
 }
 
-{ "conversationIdentifier" "long" { "id" "SEL" }
+{ "conversationIdentifier" "NSInteger" { "id" "SEL" }
     [ drop alien-address ]
 }
 
@@ -394,9 +394,9 @@ CLASS: {
     ]
 }
 
-{ "windowShouldClose:" "bool" { "id" "SEL" "id" }
+{ "windowShouldClose:" "char" { "id" "SEL" "id" }
     [
-        3drop t
+        3drop 1
     ]
 }