Merge branch 'master' of git://repo.or.cz/factor/jcg

Conflicts:

	basis/cocoa/messages/messages.factor

diff --combined basis/cocoa/messages/messages.factor
index 09601ef8cc739af0a6c3d6afb293815c7b530993,3d7e1bfd84c1512ca1e1b3c14c0c46377391838a..3d7e1bfd84c1512ca1e1b3c14c0c46377391838a
mode 100644,100755..100644
--- 1/basis/cocoa/messages/messages.factor
--- 2/basis/cocoa/messages/messages.factor
+++ b/basis/cocoa/messages/messages.factor
@@@ -3,9 -3,8 +3,8 @@@
  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
- io.encodings.ascii effects compiler.generator libc libc.private
- parser lexer init core-foundation ;
+ words cocoa.runtime io macros memoize debugger fry
+ io.encodings.ascii effects compiler.generator libc libc.private ;
  IN: cocoa.messages
  
  : make-sender ( method function -- quot )
@@@ -108,22 -107,34 +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
@@@ -132,16 -143,22 +143,22 @@@ objc>alien-types get [ swap ] assoc-ma
  ! 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
@@@ -184,12 -201,23 +201,23 @@@
      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 --combined basis/cocoa/subclassing/subclassing.factor
index 3f8e709df0e779dc0d88855aba3177feb0329b0a,fd18c7fa89d738e07c95d3831fd8b238e8e0f6a4..fd18c7fa89d738e07c95d3831fd8b238e8e0f6a4
mode 100644,100755..100644
--- 1/basis/cocoa/subclassing/subclassing.factor
--- 2/basis/cocoa/subclassing/subclassing.factor
+++ b/basis/cocoa/subclassing/subclassing.factor
@@@ -12,12 -12,17 +12,17 @@@ IN: cocoa.subclassin
      [ 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 --combined basis/ui/cocoa/views/views.factor
index 45ab8ac0ce26b4cf0edf7a1dda3702d5e462386e,c6942a815836b282d727a202014bcb28552f6157..c6942a815836b282d727a202014bcb28552f6157
mode 100644,100755..100644
--- 1/basis/ui/cocoa/views/views.factor
--- 2/basis/ui/cocoa/views/views.factor
+++ b/basis/ui/cocoa/views/views.factor
@@@ -128,12 -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 +251,7 @@@
  
  ! "rotateWithEvent:" "void" { "id" "SEL" "id" }}
  
- { "acceptsFirstResponder" "bool" { "id" "SEL" }
+ { "acceptsFirstResponder" "char" { "id" "SEL" }
      [ 2drop 1 ]
  }
  
@@@ -264,26 -264,26 +264,26 @@@
      ]
  }
  
- { "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 +293,7 @@@
      [ [ nip send-user-input ] ui-try ]
  }
  
- { "hasMarkedText" "bool" { "id" "SEL" }
+ { "hasMarkedText" "char" { "id" "SEL" }
      [ 2drop 0 ]
  }
  
@@@ -321,7 -321,7 +321,7 @@@
      [ 3drop f ]
  }
  
- { "characterIndexForPoint:" "uint" { "id" "SEL" "NSPoint" }
+ { "characterIndexForPoint:" "NSUInteger" { "id" "SEL" "NSPoint" }
      [ 3drop 0 ]
  }
  
@@@ -329,7 -329,7 +329,7 @@@
      [ 3drop 0 0 0 0 <NSRect> ]
  }
  
- { "conversationIdentifier" "long" { "id" "SEL" }
+ { "conversationIdentifier" "NSInteger" { "id" "SEL" }
      [ drop alien-address ]
  }
  
@@@ -394,9 -394,9 +394,9 @@@ CLASS: 
      ]
  }
  
- { "windowShouldClose:" "bool" { "id" "SEL" "id" }
+ { "windowShouldClose:" "char" { "id" "SEL" "id" }
      [
-         3drop t
+         3drop 1
      ]
  }