Cocoa: support method redefinition

TODO.FACTOR.txt

@@ -1,11 +1,14 @@
 - auto-invoke code gc
 - fix alien-callback/SEH bug on win32
-- x11: scroll up/down wiggles caret
+- live search: timer delay would be nice
+- help responder has no way to access { "foo" "bar" }
+- httpd search tools
+- polish OS X menu bar code
+- list selection broken
 
 + ui:
 
 - completion is not ideal: eg, search for "buttons"
-- live search: timer delay would be nice
 - some way of intercepting all gestures
 - slider needs to be modelized
 - better help result ranking
@@ -28,7 +31,6 @@
     space
 - grid slows down with 2000 lines
 - see if its possible to only repaint dirty regions
-- polish OS X menu bar code
 - structure editor
 
 + module system:
@@ -46,7 +48,6 @@
 + compiler/ffi:
 
 - more compact relocation info
-- cocoa: support real redefinition
 - relocation should not cons at all
 - stdcall callbacks
 - [ [ dup call ] dup call ] infer hangs
@@ -85,6 +86,4 @@
 
 + httpd:
 
-- help responder has no way to access { "foo" "bar" }
-- httpd search tools
 - remaining HTML issues need fixing

library/compiler/alien/objc/subclassing.factor

@@ -19,9 +19,8 @@ libc math namespaces sequences strings words ;
     dup length dup <empty-method-list> -rot
     [ pick method-list@ objc-method-nth init-method ] 2each ;
 
-: <method-lists> ( methods -- lists )
+: define-objc-methods ( class methods -- )
-    <method-list> alien-address
+    <method-list> class_addMethods ;
-    "void*" <malloc-object> [ 0 set-alien-unsigned-cell ] keep ;
 
 : <objc-class> ( name info -- class )
     "objc-class" <malloc-object>
@@ -42,23 +41,23 @@ libc math namespaces sequences strings words ;
     dup objc-class-super-class objc-class-instance-size
     swap set-objc-class-instance-size ;
 
-: <meta-class> ( methods superclass name -- class )
+: <meta-class> ( superclass name -- class )
     CLS_META <objc-class>
     [ >r dup objc-class-isa r> set-objc-class-super-class ] keep
     [ >r meta-meta-class r> set-objc-class-isa ] keep
-    [ >r <method-lists> r> set-objc-class-methodLists ] keep
     dup copy-instance-size ;
 
-: <new-class> ( methods metaclass superclass name -- class )
+: <new-class> ( metaclass superclass name -- class )
     CLS_CLASS <objc-class>
     [ set-objc-class-super-class ] keep
     [ set-objc-class-isa ] keep
-    [ >r <method-lists> r> set-objc-class-methodLists ] keep
     dup copy-instance-size ;
 
-: (define-objc-class) ( imeth cmeth superclass name -- )
+: (define-objc-class) ( superclass name imeth -- )
-    >r objc-class r> [ <meta-class> ] 2keep <new-class>
+    >r
-    objc_addClass ;
+    >r objc-class r>
+    [ <meta-class> ] 2keep <new-class> dup objc_addClass
+    r> <method-list> class_addMethods ;
 
 : encode-types ( return types -- encoding )
     >r 1array r> append
@@ -78,8 +77,11 @@ libc math namespaces sequences strings words ;
 : prepare-methods ( methods -- methods )
     [ first4 prepare-method 3array ] map ;
 
-: define-objc-class ( superclass name imeth cmeth -- )
+: redefine-objc-methods ( name imeth -- )
-    pick >r
+    >r objc_getClass r> define-objc-methods ;
-    [ prepare-methods ] 2apply
+
-    [ 2array % 2array % \ (define-objc-class) , ] [ ] make
+: define-objc-class ( superclass name imeth -- )
-    r> swap import-objc-class ;
+    prepare-methods
+    over class-exists? [ 2dup redefine-objc-methods ] when
+    over >r [ 3array % \ (define-objc-class) , ] [ ] make r>
+    swap import-objc-class ;

library/ui/cocoa/callback.factor

@@ -25,7 +25,7 @@ reset-callbacks
             SUPER-> dealloc
         ]
     }
-} { } define-objc-class
+} define-objc-class
 
 : <FactorCallback> ( quot -- id )
     FactorCallback -> alloc -> init

library/ui/cocoa/services.factor

@@ -39,7 +39,7 @@ parser prettyprint styles gadgets-listener gadgets-workspace ;
         { "id" "SEL" "id" "id" "void*" }
         [ nip [ eval>string ] do-service 2drop ]
     }
-} { } define-objc-class
+} define-objc-class
 
 : register-services ( -- )
     NSApp

library/ui/cocoa/test/cocoa.factor

@@ -7,7 +7,6 @@ USING: cocoa compiler kernel objc namespaces objc-classes test memory ;
 
 "NSObject" "Foo"
 { { "foo:" "void" { "id" "SEL" "NSRect" } [ full-gc "x" set 2drop ] } }
-{ }
 define-objc-class
 
 : test-foo
@@ -24,7 +23,6 @@ test-foo
 
 "NSObject" "Bar"
 { { "bar" "NSRect" { "id" "SEL" } [ 2drop test-foo "x" get ] } }
-{ }
 define-objc-class
 
 Bar [

library/ui/cocoa/ui.factor

@@ -19,7 +19,7 @@ hashtables kernel memory namespaces objc sequences errors freetype ;
     { "application:openFiles:" "void" { "id" "SEL" "id" "id" }
         [ >r 3drop r> finder-run-files ]
     }
-} { } define-objc-class
+} define-objc-class
 
 : install-app-delegate ( -- )
     NSApp FactorApplicationDelegate install-delegate ;

library/ui/cocoa/view-utils.factor

@@ -272,7 +272,7 @@ opengl sequences ;
             SUPER-> dealloc
         ]
     }
-} { } define-objc-class
+} define-objc-class
 
 : <FactorView> ( world -- view )
     FactorView over rect-dim <GLView> [ register-window ] keep ;

library/ui/cocoa/window-utils.factor

@@ -77,7 +77,7 @@ USING: arrays gadgets kernel math objc sequences ;
             2nip -> object -> contentView window unfocus-world
         ]
     }
-} { } define-objc-class
+} define-objc-class
 
 : install-window-delegate ( window -- )
     FactorWindowDelegate install-delegate ;

library/ui/gadgets/lists.factor

@@ -31,7 +31,9 @@ M: list model-changed
 
 M: list draw-gadget*
     dup list-color gl-color
-    selected-rect [ rect-bounds gl-fill-rect ] when* ;
+    selected-rect [
+        rect-bounds >r origin get v+ r> gl-fill-rect
+    ] when* ;
 
 M: list focusable-child* drop t ;