////
//  This file was generated by VCL Generator
//  Copyright 1998 - Morgan Martinet
//  29/06/1999 12:59:58
//  it declares the content of the module _System
////

unit Python_System;

interface

uses
   Windows,
   Classes,
   SysUtils,
   PythonEngine;

type
  TModule_System = class( TPythonModule )
  public
    procedure Initialize; override;
  end;

  function TObject_ReadAttribute( Self : TObject; argSelf : PPyObject; key : PChar ) : PPyObject;
  function TObject_WriteAttribute( Self : TObject; argSelf : PPyObject; key : PChar; value : PPyObject ) : PPyObject;
  function TInterfacedObject_ReadAttribute( Self : TInterfacedObject; argSelf : PPyObject; key : PChar ) : PPyObject;
  function TInterfacedObject_WriteAttribute( Self : TInterfacedObject; argSelf : PPyObject; key : PChar; value : PPyObject ) : PPyObject;

  procedure Init( AOwner : TComponent; AEngine : TPythonEngine ); 

implementation

uses
   Delphi_System,
   Py_Misc,
   PyRecords,
   PyDelphiAssoc;

var
  IsInitialized : Boolean;
  gSystem : TModule_System;
  gTObject : TMethodsContainer;
  gTInterfacedObject : TMethodsContainer;

procedure Init( AOwner : TComponent; AEngine : TPythonEngine ); 
begin
  if IsInitialized then
    Exit;
  IsInitialized := True;
  gSystem := TModule_System.Create( AOwner );
  with gSystem do
    begin
      Engine := AEngine;
      ModuleName := '_System';
    end;
  gTObject := TMethodsContainer.Create( AOwner );
  gTInterfacedObject := TMethodsContainer.Create( AOwner );
end;

///////////// Functions for class TObject //////////////////

function TObject_Create( Self, Args : PPyObject ) : PPyObject; cdecl; far;
var
  newObj : TPyObject;
  _argSelf : PPyObject;
begin
  with GetPythonEngine do begin
    if PyArg_ParseTuple( Args, 'O:TObject.Create', [ @_argSelf       ] ) = 0 then
      begin
        Result := nil;
        Exit;
      end;
    if PyErr_Occurred <> nil then
      begin
        Result := nil;
        Exit;
      end;
    newObj := TPyObject.Create;
    DefInterfaceObject( newObj, _argSelf, True );
    Result := _argSelf;
    Py_XIncRef( Result );
  end;
end;

function TObject_GetAttr( Self, Args : PPyObject ) : PPyObject; cdecl; far;
var
  argSelf : PPyObject;
  argKey : PChar;
  obj : TObject;
  realObj : TObject;
begin
  Result := nil;
  with GetPythonEngine do begin
    // Extract args
    if PyArg_ParseTuple( Args, 'Os', [@argSelf, @argKey]) = 0 then
      Exit;
    // Check Delphi object
    obj := GetObjectOf( argSelf );
    if not Assigned(obj) then begin
      ErrorNoObject( argSelf );
      Exit;
    end;
    // Check object type
    if not( obj is TObject) then begin
      ErrorWrongExpectedType( argSelf, 'TObject' );
      Exit;
    end;
    realObj := TObject(obj);
    // Check attribute
    Result := TObject_ReadAttribute( realObj, argSelf, argKey );
    // Check result
    if not Assigned(Result) and (PyErr_Occurred = nil) then
      UnknownProperty( argSelf, argKey );
  end;
end;

function TObject_ReadAttribute( Self : TObject; argSelf : PPyObject; key : PChar ) : PPyObject;
begin
  with GetPythonEngine do begin
    if gTObject.MethodCount > 0 then 
      Result := Py_FindMethod( gTObject.MethodsData, argSelf, key)
    else Result := nil;
    if Assigned(Result) then Exit else PyErr_Clear;
    if CompareText( key, 'Properties') = 0 then Result := GetPropList( Self )
    else Result := nil;
  end;
end;

function TObject_SetAttr( Self, Args : PPyObject ) : PPyObject; cdecl; far;
var
  argSelf, argValue : PPyObject;
  argKey : PChar;
  obj : TObject;
  realObj : TObject;
begin
  Result := nil;
  with GetPythonEngine do begin
    // Extract args
    if PyArg_ParseTuple( Args, 'OsO', [@argSelf, @argKey, @argValue]) = 0 then
      Exit;
    // Check Delphi object
    obj := GetObjectOf( argSelf );
    if not Assigned(obj) then begin
      ErrorNoObject( argSelf );
      Exit;
    end;
    // Check object type
    if not( obj is TObject) then begin
      ErrorWrongExpectedType( argSelf, 'TObject' );
      Exit;
    end;
    realObj := TObject(obj);
    // Check attribute
    Result := TObject_WriteAttribute( realObj, argSelf, argKey, argValue );
    // Check result
    if not Assigned(Result) and (PyErr_Occurred = nil) then
      Result := AddNewMember( argSelf, argKey, argValue );
  end;
end;

function TObject_WriteAttribute( Self : TObject; argSelf : PPyObject; key : PChar; value : PPyObject ) : PPyObject;
var
  obj : TObject;
begin
  Result := nil;
  obj := nil;
  with GetPythonEngine do begin
    if False then begin
    end;
  end;
end;

function TObject_Free( Self, Args : PPyObject ) : PPyObject; cdecl;
var
  obj : TObject;
  realObj : TObject;
begin
  with GetPythonEngine do begin
    // Parsing of method args
    if PyErr_Occurred <> nil then
      begin
        Result := nil;
        Exit;
      end;
    // Check Delphi object
    obj := GetObjectOf( Self );
    if not Assigned(obj) then begin
      ErrorNoObject( Self );
      Exit;
    end;
    // Check object type
    if not( obj is TObject) then begin
      ErrorWrongExpectedType( Self, 'TObject' );
      Exit;
    end;
    realObj := TObject(obj);
    realObj.Free;
    Result := ReturnNone;
  end;
end;

function TObject_InitInstance( Self, Args : PPyObject ) : PPyObject; cdecl;
begin
  with GetPythonEngine do begin
    Result := ReturnNone;
  end;
end;

function TObject_CleanupInstance( Self, Args : PPyObject ) : PPyObject; cdecl;
var
  obj : TObject;
  realObj : TObject;
begin
  with GetPythonEngine do begin
    // Parsing of method args
    if PyErr_Occurred <> nil then
      begin
        Result := nil;
        Exit;
      end;
    // Check Delphi object
    obj := GetObjectOf( Self );
    if not Assigned(obj) then begin
      ErrorNoObject( Self );
      Exit;
    end;
    // Check object type
    if not( obj is TObject) then begin
      ErrorWrongExpectedType( Self, 'TObject' );
      Exit;
    end;
    realObj := TObject(obj);
    realObj.CleanupInstance;
    Result := ReturnNone;
  end;
end;

function TObject_ClassType( Self, Args : PPyObject ) : PPyObject; cdecl;
var
  obj : TObject;
  realObj : TObject;
  rslt : TClass;
begin
  with GetPythonEngine do begin
    // Parsing of method args
    if PyErr_Occurred <> nil then
      begin
        Result := nil;
        Exit;
      end;
    // Check Delphi object
    obj := GetObjectOf( Self );
    if not Assigned(obj) then begin
      ErrorNoObject( Self );
      Exit;
    end;
    // Check object type
    if not( obj is TObject) then begin
      ErrorWrongExpectedType( Self, 'TObject' );
      Exit;
    end;
    realObj := TObject(obj);
    rslt := realObj.ClassType;
    Result := ReturnNone;
  end;
end;

function TObject_ClassName( Self, Args : PPyObject ) : PPyObject; cdecl;
var
  obj : TObject;
  realObj : TObject;
  rslt : ShortString;
begin
  with GetPythonEngine do begin
    // Parsing of method args
    if PyErr_Occurred <> nil then
      begin
        Result := nil;
        Exit;
      end;
    // Check Delphi object
    obj := GetObjectOf( Self );
    if not Assigned(obj) then begin
      ErrorNoObject( Self );
      Exit;
    end;
    // Check object type
    if not( obj is TObject) then begin
      ErrorWrongExpectedType( Self, 'TObject' );
      Exit;
    end;
    realObj := TObject(obj);
    rslt := realObj.ClassName;
    Result := VariantAsPyObject( rslt );
  end;
end;

function TObject_ClassNameIs( Self, Args : PPyObject ) : PPyObject; cdecl;
var
  obj : TObject;
  realObj : TObject;
  rslt : Boolean;
  _argName : PChar;
begin
  with GetPythonEngine do begin
    // Parsing of method args
    if PyArg_ParseTuple( Args, 's:TObject.ClassNameIs', [ 
                  @_argName       ] ) = 0 then
      begin
        Result := nil;
        Exit;
      end;
    if PyErr_Occurred <> nil then
      begin
        Result := nil;
        Exit;
      end;
    // Check Delphi object
    obj := GetObjectOf( Self );
    if not Assigned(obj) then begin
      ErrorNoObject( Self );
      Exit;
    end;
    // Check object type
    if not( obj is TObject) then begin
      ErrorWrongExpectedType( Self, 'TObject' );
      Exit;
    end;
    realObj := TObject(obj);
    rslt := realObj.ClassNameIs( string(_argName) );
    Result := VariantAsPyObject( rslt );
  end;
end;

function TObject_ClassParent( Self, Args : PPyObject ) : PPyObject; cdecl;
var
  obj : TObject;
  realObj : TObject;
  rslt : TClass;
begin
  with GetPythonEngine do begin
    // Parsing of method args
    if PyErr_Occurred <> nil then
      begin
        Result := nil;
        Exit;
      end;
    // Check Delphi object
    obj := GetObjectOf( Self );
    if not Assigned(obj) then begin
      ErrorNoObject( Self );
      Exit;
    end;
    // Check object type
    if not( obj is TObject) then begin
      ErrorWrongExpectedType( Self, 'TObject' );
      Exit;
    end;
    realObj := TObject(obj);
    rslt := realObj.ClassParent;
    Result := ReturnNone;
  end;
end;

function TObject_ClassInfo( Self, Args : PPyObject ) : PPyObject; cdecl;
var
  obj : TObject;
  realObj : TObject;
  rslt : Pointer;
begin
  with GetPythonEngine do begin
    // Parsing of method args
    if PyErr_Occurred <> nil then
      begin
        Result := nil;
        Exit;
      end;
    // Check Delphi object
    obj := GetObjectOf( Self );
    if not Assigned(obj) then begin
      ErrorNoObject( Self );
      Exit;
    end;
    // Check object type
    if not( obj is TObject) then begin
      ErrorWrongExpectedType( Self, 'TObject' );
      Exit;
    end;
    realObj := TObject(obj);
    rslt := realObj.ClassInfo;
    Result := ReturnNone;
  end;
end;

function TObject_InstanceSize( Self, Args : PPyObject ) : PPyObject; cdecl;
var
  obj : TObject;
  realObj : TObject;
  rslt : Longint;
begin
  with GetPythonEngine do begin
    // Parsing of method args
    if PyErr_Occurred <> nil then
      begin
        Result := nil;
        Exit;
      end;
    // Check Delphi object
    obj := GetObjectOf( Self );
    if not Assigned(obj) then begin
      ErrorNoObject( Self );
      Exit;
    end;
    // Check object type
    if not( obj is TObject) then begin
      ErrorWrongExpectedType( Self, 'TObject' );
      Exit;
    end;
    realObj := TObject(obj);
    rslt := realObj.InstanceSize;
    Result := VariantAsPyObject( rslt );
  end;
end;

function TObject_InheritsFrom( Self, Args : PPyObject ) : PPyObject; cdecl;
begin
  with GetPythonEngine do begin
    Result := ReturnNone;
  end;
end;

function TObject_Dispatch( Self, Args : PPyObject ) : PPyObject; cdecl;
begin
  with GetPythonEngine do begin
    Result := ReturnNone;
  end;
end;

function TObject_MethodAddress( Self, Args : PPyObject ) : PPyObject; cdecl;
var
  obj : TObject;
  realObj : TObject;
  rslt : Pointer;
  _argName : PChar;
begin
  with GetPythonEngine do begin
    // Parsing of method args
    if PyArg_ParseTuple( Args, 's:TObject.MethodAddress', [ 
                  @_argName       ] ) = 0 then
      begin
        Result := nil;
        Exit;
      end;
    if PyErr_Occurred <> nil then
      begin
        Result := nil;
        Exit;
      end;
    // Check Delphi object
    obj := GetObjectOf( Self );
    if not Assigned(obj) then begin
      ErrorNoObject( Self );
      Exit;
    end;
    // Check object type
    if not( obj is TObject) then begin
      ErrorWrongExpectedType( Self, 'TObject' );
      Exit;
    end;
    realObj := TObject(obj);
    rslt := realObj.MethodAddress( ShortString(_argName) );
    Result := ReturnNone;
  end;
end;

function TObject_MethodName( Self, Args : PPyObject ) : PPyObject; cdecl;
begin
  with GetPythonEngine do begin
    Result := ReturnNone;
  end;
end;

function TObject_FieldAddress( Self, Args : PPyObject ) : PPyObject; cdecl;
var
  obj : TObject;
  realObj : TObject;
  rslt : Pointer;
  _argName : PChar;
begin
  with GetPythonEngine do begin
    // Parsing of method args
    if PyArg_ParseTuple( Args, 's:TObject.FieldAddress', [ 
                  @_argName       ] ) = 0 then
      begin
        Result := nil;
        Exit;
      end;
    if PyErr_Occurred <> nil then
      begin
        Result := nil;
        Exit;
      end;
    // Check Delphi object
    obj := GetObjectOf( Self );
    if not Assigned(obj) then begin
      ErrorNoObject( Self );
      Exit;
    end;
    // Check object type
    if not( obj is TObject) then begin
      ErrorWrongExpectedType( Self, 'TObject' );
      Exit;
    end;
    realObj := TObject(obj);
    rslt := realObj.FieldAddress( ShortString(_argName) );
    Result := ReturnNone;
  end;
end;

function TObject_GetInterface( Self, Args : PPyObject ) : PPyObject; cdecl;
begin
  with GetPythonEngine do begin
    Result := ReturnNone;
  end;
end;

function TObject_GetInterfaceEntry( Self, Args : PPyObject ) : PPyObject; cdecl;
begin
  with GetPythonEngine do begin
    Result := ReturnNone;
  end;
end;

function TObject_GetInterfaceTable( Self, Args : PPyObject ) : PPyObject; cdecl;
var
  obj : TObject;
  realObj : TObject;
  rslt : PInterfaceTable;
begin
  with GetPythonEngine do begin
    // Parsing of method args
    if PyErr_Occurred <> nil then
      begin
        Result := nil;
        Exit;
      end;
    // Check Delphi object
    obj := GetObjectOf( Self );
    if not Assigned(obj) then begin
      ErrorNoObject( Self );
      Exit;
    end;
    // Check object type
    if not( obj is TObject) then begin
      ErrorWrongExpectedType( Self, 'TObject' );
      Exit;
    end;
    realObj := TObject(obj);
    rslt := realObj.GetInterfaceTable;
    Result := ReturnNone;
  end;
end;

function TObject_SafeCallException( Self, Args : PPyObject ) : PPyObject; cdecl;
begin
  with GetPythonEngine do begin
    Result := ReturnNone;
  end;
end;

function TObject_DefaultHandler( Self, Args : PPyObject ) : PPyObject; cdecl;
begin
  with GetPythonEngine do begin
    Result := ReturnNone;
  end;
end;

function TObject_NewInstance( Self, Args : PPyObject ) : PPyObject; cdecl;
var
  obj : TObject;
  realObj : TObject;
  rslt : TObject;
begin
  with GetPythonEngine do begin
    // Parsing of method args
    if PyErr_Occurred <> nil then
      begin
        Result := nil;
        Exit;
      end;
    // Check Delphi object
    obj := GetObjectOf( Self );
    if not Assigned(obj) then begin
      ErrorNoObject( Self );
      Exit;
    end;
    // Check object type
    if not( obj is TObject) then begin
      ErrorWrongExpectedType( Self, 'TObject' );
      Exit;
    end;
    realObj := TObject(obj);
    rslt := realObj.NewInstance;
    Result := GetPythonObject( rslt, 'System', 'TObject' );
  end;
end;

function TObject_FreeInstance( Self, Args : PPyObject ) : PPyObject; cdecl;
var
  obj : TObject;
  realObj : TObject;
begin
  with GetPythonEngine do begin
    // Parsing of method args
    if PyErr_Occurred <> nil then
      begin
        Result := nil;
        Exit;
      end;
    // Check Delphi object
    obj := GetObjectOf( Self );
    if not Assigned(obj) then begin
      ErrorNoObject( Self );
      Exit;
    end;
    // Check object type
    if not( obj is TObject) then begin
      ErrorWrongExpectedType( Self, 'TObject' );
      Exit;
    end;
    realObj := TObject(obj);
    realObj.FreeInstance;
    Result := ReturnNone;
  end;
end;

///////////// Functions for class TInterfacedObject //////////////////

function TInterfacedObject_Create( Self, Args : PPyObject ) : PPyObject; cdecl; far;
var
  newObj : TPyInterfacedObject;
  _argSelf : PPyObject;
begin
  with GetPythonEngine do begin
    if PyArg_ParseTuple( Args, 'O:TInterfacedObject.Create', [ @_argSelf       ] ) = 0 then
      begin
        Result := nil;
        Exit;
      end;
    if PyErr_Occurred <> nil then
      begin
        Result := nil;
        Exit;
      end;
    newObj := TPyInterfacedObject.Create;
    DefInterfaceObject( newObj, _argSelf, True );
    Result := _argSelf;
    Py_XIncRef( Result );
  end;
end;

function TInterfacedObject_GetAttr( Self, Args : PPyObject ) : PPyObject; cdecl; far;
var
  argSelf : PPyObject;
  argKey : PChar;
  obj : TObject;
  realObj : TInterfacedObject;
begin
  Result := nil;
  with GetPythonEngine do begin
    // Extract args
    if PyArg_ParseTuple( Args, 'Os', [@argSelf, @argKey]) = 0 then
      Exit;
    // Check Delphi object
    obj := GetObjectOf( argSelf );
    if not Assigned(obj) then begin
      ErrorNoObject( argSelf );
      Exit;
    end;
    // Check object type
    if not( obj is TInterfacedObject) then begin
      ErrorWrongExpectedType( argSelf, 'TInterfacedObject' );
      Exit;
    end;
    realObj := TInterfacedObject(obj);
    // Check attribute
    Result := TInterfacedObject_ReadAttribute( realObj, argSelf, argKey );
    // Check result
    if not Assigned(Result) and (PyErr_Occurred = nil) then
      UnknownProperty( argSelf, argKey );
  end;
end;

function TInterfacedObject_ReadAttribute( Self : TInterfacedObject; argSelf : PPyObject; key : PChar ) : PPyObject;
begin
  with GetPythonEngine do begin
    if gTInterfacedObject.MethodCount > 0 then 
      Result := Py_FindMethod( gTInterfacedObject.MethodsData, argSelf, key)
    else Result := nil;
    if Assigned(Result) then Exit else PyErr_Clear;
    if CompareText( key, 'Properties') = 0 then Result := GetPropList( Self )
    else if CompareText( key, 'RefCount' ) = 0 then Result := VariantAsPyObject( Self.RefCount )
    else Result := TObject_ReadAttribute( Self, argSelf, key );
  end;
end;

function TInterfacedObject_SetAttr( Self, Args : PPyObject ) : PPyObject; cdecl; far;
var
  argSelf, argValue : PPyObject;
  argKey : PChar;
  obj : TObject;
  realObj : TInterfacedObject;
begin
  Result := nil;
  with GetPythonEngine do begin
    // Extract args
    if PyArg_ParseTuple( Args, 'OsO', [@argSelf, @argKey, @argValue]) = 0 then
      Exit;
    // Check Delphi object
    obj := GetObjectOf( argSelf );
    if not Assigned(obj) then begin
      ErrorNoObject( argSelf );
      Exit;
    end;
    // Check object type
    if not( obj is TInterfacedObject) then begin
      ErrorWrongExpectedType( argSelf, 'TInterfacedObject' );
      Exit;
    end;
    realObj := TInterfacedObject(obj);
    // Check attribute
    Result := TInterfacedObject_WriteAttribute( realObj, argSelf, argKey, argValue );
    // Check result
    if not Assigned(Result) and (PyErr_Occurred = nil) then
      Result := AddNewMember( argSelf, argKey, argValue );
  end;
end;

function TInterfacedObject_WriteAttribute( Self : TInterfacedObject; argSelf : PPyObject; key : PChar; value : PPyObject ) : PPyObject;
var
  obj : TObject;
begin
  Result := nil;
  obj := nil;
  with GetPythonEngine do begin
    if False then begin
    end else if CompareText( key, 'RefCount' ) = 0 then begin
      ErrorPropReadOnly( argSelf, key );
    end else Result := TObject_WriteAttribute( Self, argSelf, key, value );
  end;
end;

///////////// Initialization of the module ///////////

procedure TModule_System.Initialize;
begin
  // class TObject
  AddMethod( 'CreateObject', TObject_Create, '' );
  AddMethod( 'Object_GetAttr', TObject_GetAttr, '' );
  AddMethod( 'Object_SetAttr', TObject_SetAttr, '' );
  gTObject.AddMethod( 'Create', TObject_Create, '' );
  gTObject.AddMethod( 'Free', TObject_Free, '' );
  gTObject.AddMethod( 'InitInstance', TObject_InitInstance, '' );
  gTObject.AddMethod( 'CleanupInstance', TObject_CleanupInstance, '' );
  gTObject.AddMethod( 'ClassType', TObject_ClassType, '' );
  gTObject.AddMethod( 'ClassName', TObject_ClassName, '' );
  gTObject.AddMethod( 'ClassNameIs', TObject_ClassNameIs, '' );
  gTObject.AddMethod( 'ClassParent', TObject_ClassParent, '' );
  gTObject.AddMethod( 'ClassInfo', TObject_ClassInfo, '' );
  gTObject.AddMethod( 'InstanceSize', TObject_InstanceSize, '' );
  gTObject.AddMethod( 'InheritsFrom', TObject_InheritsFrom, '' );
  gTObject.AddMethod( 'Dispatch', TObject_Dispatch, '' );
  gTObject.AddMethod( 'MethodAddress', TObject_MethodAddress, '' );
  gTObject.AddMethod( 'MethodName', TObject_MethodName, '' );
  gTObject.AddMethod( 'FieldAddress', TObject_FieldAddress, '' );
  gTObject.AddMethod( 'GetInterface', TObject_GetInterface, '' );
  gTObject.AddMethod( 'GetInterfaceEntry', TObject_GetInterfaceEntry, '' );
  gTObject.AddMethod( 'GetInterfaceTable', TObject_GetInterfaceTable, '' );
  gTObject.AddMethod( 'SafeCallException', TObject_SafeCallException, '' );
  gTObject.AddMethod( 'DefaultHandler', TObject_DefaultHandler, '' );
  gTObject.AddMethod( 'NewInstance', TObject_NewInstance, '' );
  gTObject.AddMethod( 'FreeInstance', TObject_FreeInstance, '' );
  // class TInterfacedObject
  AddMethod( 'CreateInterfacedObject', TInterfacedObject_Create, '' );
  AddMethod( 'InterfacedObject_GetAttr', TInterfacedObject_GetAttr, '' );
  AddMethod( 'InterfacedObject_SetAttr', TInterfacedObject_SetAttr, '' );
  inherited;
end;

end.
