diff --git a/bindings/pascocoa/examples/statusitem/controller.pas b/bindings/pascocoa/examples/statusitem/controller.pas
index 1336ab187..d90e43a38 100644
--- a/bindings/pascocoa/examples/statusitem/controller.pas
+++ b/bindings/pascocoa/examples/statusitem/controller.pas
@@ -7,7 +7,7 @@
}
unit controller;
-{$mode delphi}
+{$mode delphi}{$STATIC ON}
interface
@@ -22,12 +22,13 @@ type
public
{ Extra binding functions }
constructor Create; override;
+ function getClass: objc.id; override;
procedure AddMethods;
{ Objective-c Methods }
- class procedure doShowStatusitem(_self: objc.id; _cmd: SEL; sender: objc.id); cdecl;
- class procedure doHideStatusitem(_self: objc.id; _cmd: SEL; sender: objc.id); cdecl;
+ class procedure doShowStatusitem(_self: objc.id; _cmd: SEL; sender: objc.id); cdecl; static;
+ class procedure doHideStatusitem(_self: objc.id; _cmd: SEL; sender: objc.id); cdecl; static;
class function applicationShouldTerminateAfterLastWindowClosed(_self: objc.id;
- _cmd: SEL; theApplication: objc.id): cbool; cdecl;
+ _cmd: SEL; theApplication: objc.id): cbool; cdecl; static;
{ Other helper functions }
function GetResourcesDir: string;
function CreateButton(AView: NSView; ATitle: shortstring;
@@ -40,6 +41,8 @@ type
end;
const
+ Str_TMyController = 'TMyController';
+
Str_doShowStatusitem = 'doShowStatusitem:';
Str_doHideStatusitem = 'doHideStatusitem:';
Str_applicationShouldTerminateAfterLastWindowClosed = 'applicationShouldTerminateAfterLastWindowClosed:';
@@ -72,6 +75,8 @@ constructor TMyController.Create;
var
fileName: CFStringRef;
begin
+ if not CreateClassDefinition(Str_TMyController, Str_NSObject) then WriteLn('Failed to create objc class');
+
inherited Create;
AddMethods();
@@ -82,6 +87,11 @@ begin
image := NSImage.initWithContentsOfFile(fileName);
end;
+function TMyController.getClass: objc.id;
+begin
+ Result := objc_getClass(Str_TMyController);
+end;
+
{ Objective-c Methods }
class procedure TMyController.doShowStatusitem(_self: objc.id; _cmd: SEL; sender: objc.id); cdecl;
diff --git a/bindings/pascocoa/examples/statusitem/statusitem.lpi b/bindings/pascocoa/examples/statusitem/statusitem.lpi
index 54f4fda81..4e6a2522d 100644
--- a/bindings/pascocoa/examples/statusitem/statusitem.lpi
+++ b/bindings/pascocoa/examples/statusitem/statusitem.lpi
@@ -26,15 +26,15 @@
-
+
-
-
+
+
-
+
@@ -52,33 +52,30 @@
-
+
-
-
-
+
-
+
-
-
+
+
-
+
-
-
+
@@ -162,19 +159,16 @@
-
+
-
-
+
-
+
-
-
-
+
@@ -222,17 +216,17 @@
-
-
-
+
+
+
+
+
-
+
-
-
-
+
@@ -242,26 +236,26 @@
-
+
-
+
+
+
-
+
-
-
-
+
-
-
+
+
-
+
@@ -273,43 +267,121 @@
-
+
-
-
-
+
-
+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
-
-
@@ -331,6 +403,8 @@
+
diff --git a/bindings/pascocoa/foundation/NSObject.inc b/bindings/pascocoa/foundation/NSObject.inc
index 7369ef9d3..dfd15dfb5 100644
--- a/bindings/pascocoa/foundation/NSObject.inc
+++ b/bindings/pascocoa/foundation/NSObject.inc
@@ -61,6 +61,7 @@ FOUNDATION_EXPORT unsigned NSExtraRefCount(id object);}
function getClass: objc.id; virtual;
{ Class creation methods }
procedure AddMethod(aName, aParameters: string; aPointer: Pointer);
+ function CreateClassDefinition(const name, superclassName: string): Boolean;
public
{+ (void)load;
@@ -185,7 +186,7 @@ end;
destructor NSObject.Destroy;
begin
- release;
+ if Handle <> nil then release;
end;
function NSObject.getClass: objc.id;
@@ -206,6 +207,75 @@ begin
class_addMethods(ClassId, method_list);
end;
+function NSObject.CreateClassDefinition(const name, superclassName: string): Boolean;
+var
+ meta_class, super_class, new_class, root_class: Pobjc_class;
+begin
+ // Ensure that the superclass exists and that someone
+ // hasn't already implemented a class with the same name
+ //
+ super_class := Pobjc_class(objc_lookUpClass (PChar(superclassName)));
+
+ if (super_class = nil) then Exit(False);
+
+ if (objc_lookUpClass (PChar(name)) <> nil) then Exit(False);
+
+ // Find the root class
+ //
+ root_class := super_class;
+ while ( root_class^.super_class <> nil ) do
+ begin
+ root_class := root_class^.super_class;
+ end;
+
+ // Allocate space for the class and its metaclass
+ //
+ new_class := CFAllocatorAllocate(kCFAllocatorMalloc, 2 * SizeOf(objc_class), 0);
+ meta_class := @new_class[1];
+
+ // setup class
+ new_class^.isa := meta_class;
+ new_class^.info := CLS_CLASS;
+ meta_class^.info := CLS_META;
+
+ // Create a copy of the class name.
+ // For efficiency, we have the metaclass and the class itself
+ // to share this copy of the name, but this is not a requirement
+ // imposed by the runtime.
+ //
+ new_class^.name := CFAllocatorAllocate(kCFAllocatorMalloc, Length(name) + 1, 0);
+ SysUtils.strcopy(new_class^.name, PChar(name));
+ meta_class^.name := new_class^.name;
+
+ // Allocate empty method lists.
+ // We can add methods later.
+ //
+ new_class^.methodLists := CFAllocatorAllocate(kCFAllocatorMalloc, sizeof(Pobjc_method_list), 0);
+ new_class^.methodLists^ := Pointer(-1);
+ meta_class^.methodLists := CFAllocatorAllocate(kCFAllocatorMalloc, sizeof(Pobjc_method_list), 0);
+ meta_class^.methodLists^ := Pointer(-1);
+
+ // Connect the class definition to the class hierarchy:
+ // Connect the class to the superclass.
+ // Connect the metaclass to the metaclass of the superclass.
+ // Connect the metaclass of the metaclass to the metaclass of the root class.
+ //
+ new_class^.super_class := super_class;
+ meta_class^.super_class := super_class^.isa;
+ meta_class^.isa := Pointer(root_class^.isa);
+
+ // Set the sizes of the class and the metaclass.
+ //
+ new_class^.instance_size := super_class^.instance_size;
+ meta_class^.instance_size := meta_class^.super_class^.instance_size;
+
+ // Finally, register the class with the runtime.
+ //
+ objc_addClass( new_class );
+
+ Result := True;
+end;
+
{*************** Basic protocols ***************}
function NSObject.retain: objc.id;
diff --git a/bindings/pascocoa/foundation/foundation.pas b/bindings/pascocoa/foundation/foundation.pas
index 161d9e519..4ae4aa8bb 100644
--- a/bindings/pascocoa/foundation/foundation.pas
+++ b/bindings/pascocoa/foundation/foundation.pas
@@ -1,13 +1,13 @@
unit foundation;
{$ifdef fpc}
- {$mode delphi}
+ {$mode objfpc}{$H+}
{$packrecords c}
{$endif}
interface
-uses ctypes, objc, FPCMacOSAll;
+uses SysUtils, ctypes, objc, FPCMacOSAll;
{$define HEADER}
{$include Foundation.inc}