*harbour/include/hboo.ch

*harbour/include/hbclass.ch
 Now support MI, scoping, fowarding and delegating
 Also support 10 chars limit by not prefixing the Classname when in 10 chars mode

*harbour/include/hbsetup.ch
 Allow the configuration of Hidden message

*harbour/source/rtl/objfunc.prg
 added function __objDerivedFrom(oSelf, oObj | cClassName)

*harbour/source/rtl/tclass.prg
 Major modification to implement MI & scoping
 Added message :Super to acces frist superclass object instance
 Added message :IsDerivedFrom(oObj | cClassName ) (Xbase++ comp.)

*harbour/source/vm/proc.c
  added char * hb_procname( int iLevel, char * szName )
  extracted from HB_FUNC( PROCNAME ) to allow it to be called from c
  HB_FUNC( PROCNAME ) modified to call the previous'one

*harbour/source/vm/classes.c
  Major modification to implement MI & Scoping
  Added function Sender() used by delegating to allow full polymorphism
  Added function __CLS_PARAM used by the preprocessor
This commit is contained in:
Jean-Francois Lefebvre
2000-05-28 20:09:56 +00:00
parent be81ee127d
commit 937101dd91
9 changed files with 1299 additions and 259 deletions

View File

@@ -1,3 +1,33 @@
2000-05-28 22:16 UTC+0200 Jfl&RaC <jfl@mafact.com>
*harbour/include/hboo.ch
*harbour/include/hbclass.ch
Now support MI, scoping, fowarding and delegating
Also support 10 chars limit by not prefixing the Classname when in 10 chars mode
*harbour/include/hbsetup.ch
Allow the configuration of Hidden message
*harbour/source/rtl/objfunc.prg
added function __objDerivedFrom(oSelf, oObj | cClassName)
*harbour/source/rtl/tclass.prg
Major modification to implement MI & scoping
Added message :Super to acces frist superclass object instance
Added message :IsDerivedFrom(oObj | cClassName ) (Xbase++ comp.)
*harbour/source/vm/proc.c
added char * hb_procname( int iLevel, char * szName )
extracted from HB_FUNC( PROCNAME ) to allow it to be called from c
HB_FUNC( PROCNAME ) modified to call the previous'one
*harbour/source/vm/classes.c
Major modification to implement MI & Scoping
Added function Sender() used by delegating to allow full polymorphism
Added function __CLS_PARAM used by the preprocessor
2000-05-27 23:12 UTC+0100 Victor Szakats <info@szelvesz.hu>
* source/rtl/gtdos/gtdos.c

View File

@@ -6,6 +6,10 @@
* Harbour Project source code:
* Header file for Class commands
*
*
* Copyright 2000 JfL&RaC <jflefebv@mafact.com>
* www - http://www.harbour-project.org
*
* Copyright 1999 Antonio Linares <alinares@fivetech.com>
* www - http://www.harbour-project.org
*
@@ -37,6 +41,13 @@
* The following parts are Copyright of the individual authors.
* www - http://www.harbour-project.org
*
*
* Copyright 2000 JF Lefebvre <jfl@mafact.com> and RA Cuylen <rac@mafact.com>
* Support for Class(y), TopClass and Visual Object compatibility
* Support for MI, Scoping (Protect, Hidden and Readonly)
* Delegating, DATA Shared
* Support of 10 Chars limits
*
* Copyright 2000 Brian Hays <bhays@abacuslaw.com>
* Documentation for the commands
*
@@ -44,69 +55,245 @@
*
*/
#include "hbsetup.ch"
#ifndef HB_OO_CH_
#include "hboo.ch"
#endif
#ifndef HB_CLASS_CH_
#define HB_CLASS_CH_
#xcommand CLASS <ClassName> [ <frm: FROM, INHERIT> <SuperClass> ] => ;
function <ClassName>() ;;
#xtranslate HBCLSCHOICE( <export>, <protect>, <hidde> ) => if( <export>, HBCLSTP_EXPORTED , if( <protect>, HBCLSTP_PROTECTED, if( <hidde>, HBCLSTP_HIDDEN, nScope) ) )
#xtranslate CREATE CLASS => CLASS
#ifndef HB_SHORTNAMES
#xcommand CLASS <ClassName> [ <frm: FROM, INHERIT> <SuperClass1> [,<SuperClassN>] ] [<static: STATIC>] => ;
<static> function <ClassName>() ;;
static oClass ;;
local nScope := HBCLSTP_EXPORTED ;;
if oClass == nil ;;
oClass := TClass():New( <(ClassName)> [,<(SuperClass)>] ) ;;
oClass := TClass():New( <(ClassName)>, __CLS_PARAM([ <(SuperClass1)> ] [ ,<(SuperClassN)> ] ) ) ;;
#undef _CLASS_NAME_ ;;
#define _CLASS_NAME_ <ClassName> ;;
#translate CLSMETH <ClassName> <MethodName>() => @<ClassName>_<MethodName>() ;
[ ; #translate Super : => ::<SuperClass>: ] ;
[ ; extern <SuperClass> ]
[ ; #translate Super( <SuperClassN> ) : => ::<SuperClassN>: ] ;
[ ; #translate Super( <SuperClass1> ) : => ::<SuperClass1>: ] ;
[ ; #translate Super() : => ::<SuperClass1>: ] ;
[ ; #translate Super : => ::<SuperClass1>: ] ;
[ ; extern <SuperClass1> ] [ ,<SuperClassN> ]
#else
#xcommand CLASS <ClassName> [ <frm: FROM, INHERIT> <SuperClass1> [,<SuperClassN>] ] [<static: STATIC>] => ;
<static> function <ClassName>() ;;
static oClass ;;
local nScope := HBCLSTP_EXPORTED ;;
if oClass == nil ;;
oClass := TClass():New( <(ClassName)>, __CLS_PARAM([ <(SuperClass1)> ] [ ,<(SuperClassN)> ] ) ) ;;
#undef _CLASS_NAME_ ;;
#define _CLASS_NAME_ <ClassName> ;;
#translate CLSMETH <ClassName> <MethodName>() => @<MethodName>() ;
[ ; #translate Super( <SuperClassN> ) : => ::<SuperClassN>: ] ;
[ ; #translate Super( <SuperClass1> ) : => ::<SuperClass1>: ] ;
[ ; #translate Super() : => ::<SuperClass1>: ] ;
[ ; #translate Super : => ::<SuperClass1>: ] ;
[ ; extern <SuperClass1> ] [ ,<SuperClassN> ]
#endif /* HB_SHORTNAMES */
//VO compatibility
#xtranslate ( <name>{ [<p,...>] } => ( <name>():New( <p> )
#xtranslate := <name>{ [<p,...>] } => := <name>():New( <p> )
#xtranslate = <name>{ [<p,...>] } => = <name>():New( <p> )
#xtranslate , <name>{ [<p,...>] } => , <name>():New( <p> )
/* Note the use of commas ',' on the following rule to avoid their call
if there are no AS ... or INIT clauses specified. As we just use
those methods first parameter, the second one supplied acts as a dummy one */
#xtranslate EXPORTED: => nScope := HBCLSTP_EXPORTED
#xtranslate VISIBLE: => nScope := HBCLSTP_EXPORTED
#xtranslate HIDDEN: => nScope := HBCLSTP_HIDDEN
#xtranslate PROTECTED: => nScope := HBCLSTP_PROTECTED
#xcommand DATA <DataName1> [,<DataNameN>] [ AS <type> ] [ INIT <uValue> ] => ;
[ oClass:SetType( <(type)> ) ; ][ oClass:SetInit( <uValue> ) ; ] ;
oClass:AddData( <(DataName1)> ) ;
[; oClass:AddData( <(DataNameN)> ) ] ;
[; oClass:SetInit(,<uValue>) ] [ ; oClass:SetType(,<(type)>) ]
#xcommand DATA <DataNames,...> [ AS <type> ] [ INIT <uValue> ] [ <export: EXPORTED, VISIBLE>] [<protect: PROTECTED>] [<hidde: HIDDEN>] [<ro: READONLY, RO>] => ;
oClass:AddMultiData( <(type)>, <uValue>, HBCLSCHOICE( <.export.>, <.protect.>, <.hidde.> ) + if( <.ro.>, HBCLSTP_READONLY, 0 ), \{<(DataNames)>\} ) ;
/* Note the use of commas ',' on the following rule to avoid their call
if there are no AS ... or INIT clauses specified. As we just use
those methods first parameter, the second one supplied acts as a dummy one */
#xcommand VAR <DataNames,...> [ TYPE <type> ] [ ASSIGN <uValue> ] [<export: EXPORTED, VISIBLE>] [<protect: PROTECTED>] [<hidde: HIDDEN>] [<ro: READONLY, RO>] => ;
oClass:AddMultiData( <(type)>, <uValue>, HBCLSCHOICE( <.export.>, <.protect.>, <.hidde.> ) + if( <.ro.>, HBCLSTP_READONLY, 0 ), \{<(DataNames)>\} ) ;
#xcommand CLASSDATA <DataName1> [,<DataNameN>] [ AS <type> ] [ INIT <uValue> ] => ;
[ oClass:SetType( <(type)> ) ; ][ oClass:SetInit( <uValue> ) ; ] ;
oClass:AddClassData( <(DataName1)> ) ;
[; oClass:AddClassData( <(DataNameN)> ) ] ;
[; oClass:SetInit(,<uValue>) ] [ ; oClass:SetType(,<(type)>) ]
#xcommand VAR <DataNames,...> [ AS <type> ] [ INIT <uValue> ] [<export: EXPORTED, VISIBLE>] [<protect: PROTECTED>] [<hidde: HIDDEN>] [<ro: READONLY, RO>] => ;
oClass:AddMultiData( <(type)>, <uValue>, HBCLSCHOICE( <.export.>, <.protect.>, <.hidde.> ) + if( <.ro.>, HBCLSTP_READONLY, 0 ), \{<(DataNames)>\} ) ;
#xcommand METHOD <MethodName>( [<params,...>] ) [ CONSTRUCTOR ] => ;
oClass:AddMethod( <(MethodName)>, CLSMETH _CLASS_NAME_ <MethodName>() )
#xcommand VAR <DataName> IN <SuperClass> => ;
oClass:AddInline( <(DataName)>, {|Self| Self:<SuperClass>:<DataName> }, HBCLSTP_EXPORTED + HBCLSTP_READONLY ) ;;
oClass:AddInline( "_" + <(DataName)>, {|Self, param| Self:<SuperClass>:<DataName> := param }, HBCLSTP_EXPORTED )
#xcommand METHOD <MethodName>( [<params,...>] ) BLOCK <CodeBlock> => ;
oClass:AddInline( <(MethodName)>, <CodeBlock> )
#xcommand VAR <DataName> IS <SprDataName> IN <SuperClass> => ;
oClass:AddInline( <(DataName)>, {|Self| Self:<SuperClass>:<SprDataName> }, HBCLSTP_EXPORTED + HBCLSTP_READONLY ) ;;
oClass:AddInline( "_" + <(DataName)>, {|Self, param| Self:<SuperClass>:<SprDataName> := param }, HBCLSTP_EXPORTED )
#xcommand METHOD <MethodName>( [<params,...>] ) EXTERN <FuncName>( [<params,...>] ) => ;
oClass:AddMethod( <(MethodName)>, @<FuncName>() )
#xcommand VAR <DataName1> IS <DataName2> => ;
oClass:AddInline( <(DataName1)>, {|Self| Self:<DataName2> }, HBCLSTP_EXPORTED + HBCLSTP_READONLY ) ;;
oClass:AddInline( "_" + <(DataName1)>, {|Self, param| Self:<DataName2> := param }, HBCLSTP_EXPORTED )
#xcommand METHOD <MethodName>( [<params,...>] ) INLINE <Code,...> => ;
oClass:AddInline( <(MethodName)>, {|Self [,<params>] | <Code> } )
#xcommand VAR <DataName1> IS <DataName2> TO <oObject> => ;
oClass:AddInline( <(DataName1)>, {|Self| Self:<oObject>:<DataName2> }, HBCLSTP_EXPORTED + HBCLSTP_READONLY ) ;;
oClass:AddInline( "_" + <(DataName1)>, {|Self, param| Self:<oObject>:<DataName2> := param }, HBCLSTP_EXPORTED )
#xcommand EXPORT <DataNames,...> [ AS <type> ] [ INIT <uValue> ] [<ro: READONLY, RO>] => ;
oClass:AddMultiData( <(type)>, <uValue>, HBCLSTP_EXPORTED + if( <.ro.>, HBCLSTP_READONLY, 0 ), \{<(DataNames)>\} ) ;
#xcommand EXPORT <DataNames,...> [ TYPE <type> ] [ ASSIGN <uValue> ] [<ro: READONLY, RO>] => ;
oClass:AddMultiData( <(type)>, <uValue>, HBCLSTP_EXPORTED + if( <.ro.>, HBCLSTP_READONLY, 0 ), \{<(DataNames)>\} ) ;
#xcommand PROTECT <DataNames,...> [ AS <type> ] [ INIT <uValue> ] [<ro: READONLY, RO>] => ;
oClass:AddMultiData( <(type)>, <uValue>, HBCLSTP_PROTECTED + if( <.ro.>, HBCLSTP_READONLY, 0 ), \{<(DataNames)>\} ) ;
#xcommand PROTECT <DataNames,...> [ TYPE <type> ] [ ASSIGN <uValue> ] [<ro: READONLY, RO>] => ;
oClass:AddMultiData( <(type)>, <uValue>, HBCLSTP_PROTECTED + if( <.ro.>, HBCLSTP_READONLY, 0 ), \{<(DataNames)>\} ) ;
#xcommand HIDDE <DataNames,...> [ AS <type> ] [ INIT <uValue> ] [<ro: READONLY, RO>] => ;
oClass:AddMultiData( <(type)>, <uValue>, HBCLSTP_HIDDEN + if( <.ro.>, HBCLSTP_READONLY, 0 ), \{<(DataNames)>\} ) ;
#xcommand HIDDE <DataNames,...> [ TYPE <type> ] [ ASSIGN <uValue> ] [<ro: READONLY, RO>] => ;
oClass:AddMultiData( <(type)>, <uValue>, HBCLSTP_HIDDEN + if( <.ro.>, HBCLSTP_READONLY, 0 ), \{<(DataNames)>\} ) ;
#xcommand CLASSDATA <DataNames,...> [ AS <type> ] [ INIT <uValue> ] [<export: EXPORTED, VISIBLE>] [<protect: PROTECTED>] [<hidde: HIDDEN>] [<ro: READONLY, RO>] [<share: SHARED>] => ;
oClass:AddMultiClsData(<(type)>, <uValue>, HBCLSCHOICE( <.export.>, <.protect.>, <.hidde.> ) + if( <.ro.>, HBCLSTP_READONLY, 0 ) + if( <.share.>, HBCLSTP_SHARED, 0 ), \{<(DataNames)>\} ) ;
#xtranslate CLASS VAR => CLASSVAR
#xcommand CLASSVAR <DataNames,...> [ TYPE <type> ] [ ASSIGN <uValue> ] [<export: EXPORTED, VISIBLE>] [<protect: PROTECTED>] [<hidde: HIDDEN>] [<ro: READONLY, RO>] [<share: SHARED>] => ;
oClass:AddMultiClsData(<(type)>, <uValue>, HBCLSCHOICE( <.export.>, <.protect.>, <.hidde.> ) + if( <.ro.>, HBCLSTP_READONLY, 0 ) + if( <.share.>, HBCLSTP_SHARED, 0 ), \{<(DataNames)>\} ) ;
#xcommand CLASSVAR <DataNames,...> [ AS <type> ] [ INIT <uValue> ] [<export: EXPORTED, VISIBLE>] [<protect: PROTECTED>] [<hidde: HIDDEN>] [<ro: READONLY, RO>] [<share: SHARED>] => ;
oClass:AddMultiClsData(<(type)>, <uValue>, HBCLSCHOICE( <.export.>, <.protect.>, <.hidde.> ) + if( <.ro.>, HBCLSTP_READONLY, 0 ) + if( <.share.>, HBCLSTP_SHARED, 0 ), \{<(DataNames)>\} ) ;
#xtranslate CLASS METHOD => CLASSMETHOD
#xcommand CLASSMETHOD <MethodName> [<export: EXPORTED, VISIBLE>] [<protect: PROTECTED>] [<hidde: HIDDEN>] [<share: SHARED>] => ;
oClass:AddClsMthds( <(MethodName)>, CLSMETH _CLASS_NAME_ <MethodName>(), HBCLSCHOICE( <.export.>, <.protect.>, <.hidde.> ) + if( <.share.>, HBCLSTP_SHARED, 0 ) )
#xcommand CLASSMETHOD <MethodName>() [<export: EXPORTED, VISIBLE>] [<protect: PROTECTED>] [<hidde: HIDDEN>] [<share: SHARED>] => ;
oClass:AddClsMthds( <(MethodName)>, CLSMETH _CLASS_NAME_ <MethodName>(), HBCLSCHOICE( <.export.>, <.protect.>, <.hidde.> ) + if( <.share.>, HBCLSTP_SHARED, 0 ) )
#xcommand CLASSMETHOD <MethodName>( [<params,...>] ) [<export: EXPORTED, VISIBLE>] [<protect: PROTECTED>] [<hidde: HIDDEN>] [<share: SHARED>] => ;
oClass:AddClsMthds( <(MethodName)>, CLSMETH _CLASS_NAME_ <MethodName>(), HBCLSCHOICE( <.export.>, <.protect.>, <.hidde.> ) + if( <.share.>, HBCLSTP_SHARED, 0 ) )
#xcommand CONSTRUCTOR <Name>( [<params,...>] ) => METHOD <Name>( [<params,...>] ) CONSTRUCTOR
//Oups to verify that the word new is not reserved...
//#xcommand CONSTRUCTOR New( [<params,...>] ) => METHOD New( [<params,...>] ) CONSTRUCTOR
#xcommand METHOD <MethodName> [ <ctor: CONSTRUCTOR> ] [ <export: EXPORTED, VISIBLE>] [<protect: PROTECTED>] [<hidde: HIDDEN>] => ;
oClass:AddMethod( <(MethodName)>, CLSMETH _CLASS_NAME_ <MethodName>(), HBCLSCHOICE( <.export.>, <.protect.>, <.hidde.> ) + if( <.ctor.>, HBCLSTP_CTOR, 0 ) )
#xcommand METHOD <MethodName>( [<params,...>] ) [ <ctor: CONSTRUCTOR> ] [ <export: EXPORTED, VISIBLE>] [<protect: PROTECTED>] [<hidde: HIDDEN>] => ;
oClass:AddMethod( <(MethodName)>, CLSMETH _CLASS_NAME_ <MethodName>(), HBCLSCHOICE( <.export.>, <.protect.>, <.hidde.> ) + if( <.ctor.>, HBCLSTP_CTOR, 0 ) )
#xcommand METHOD <MethodName> BLOCK <CodeBlock> [ <ctor: CONSTRUCTOR> ] [ <export: EXPORTED, VISIBLE>] [<protect: PROTECTED>] [<hidde: HIDDEN>] => ;
oClass:AddInline( <(MethodName)>, <CodeBlock>, HBCLSCHOICE( <.export.>, <.protect.>, <.hidde.> ) + if( <.ctor.>, HBCLSTP_CTOR, 0 ) )
#xcommand METHOD <MethodName>( [<params,...>] ) BLOCK <CodeBlock> [ <ctor: CONSTRUCTOR> ] [ <export: EXPORTED, VISIBLE>] [<protect: PROTECTED>] [<hidde: HIDDEN>] => ;
oClass:AddInline( <(MethodName)>, <CodeBlock>, HBCLSCHOICE( <.export.>, <.protect.>, <.hidde.> ) + if( <.ctor.>, HBCLSTP_CTOR, 0 ) )
#xcommand METHOD <MethodName>( [<params,...>] ) EXTERN <FuncName>( [<params,...>] ) [ <ctor: CONSTRUCTOR> ] [ <export: EXPORTED, VISIBLE>] [<protect: PROTECTED>] [<hidde: HIDDEN>] => ;
oClass:AddMethod( <(MethodName)>, @<FuncName>(), HBCLSCHOICE( <.export.>, <.protect.>, <.hidde.> ) + if( <.ctor.>, HBCLSTP_CTOR, 0 ) )
#xcommand METHOD <MethodName> INLINE <Code,...> [ <ctor: CONSTRUCTOR> ] [ <export: EXPORTED, VISIBLE>] [<protect: PROTECTED>] [<hidde: HIDDEN>] => ;
oClass:AddInline( <(MethodName)>, {|Self | <Code> }, HBCLSCHOICE( <.export.>, <.protect.>, <.hidde.> ) + if( <.ctor.>, HBCLSTP_CTOR, 0 ) )
#xcommand METHOD <MethodName>( [<params,...>] ) INLINE <Code,...> [ <ctor: CONSTRUCTOR> ] [ <export: EXPORTED, VISIBLE>] [<protect: PROTECTED>] [<hidde: HIDDEN>] => ;
oClass:AddInline( <(MethodName)>, {|Self [,<params>] | <Code> }, HBCLSCHOICE( <.export.>, <.protect.>, <.hidde.> ) + if( <.ctor.>, HBCLSTP_CTOR, 0 ) )
#xcommand METHOD <MethodName> INLINE [Local <v>,] <Code,...> [<other>] => ;
METHOD <MethodName> BLOCK {|Self [,<v>] | <Code> } [<other>]
#xcommand METHOD <MethodName>( [<params,...>] ) INLINE [Local <v>,] <Code,...> [<other>] => ;
METHOD <MethodName> BLOCK {|Self [,<params>] [,<v>] | <Code> } [<other>]
#xcommand METHOD <MethodName> DEFERRED => ;
oClass:AddVirtual( <(MethodName)> )
#xcommand METHOD <MethodName>( [<params,...>] ) DEFERRED => ;
oClass:AddVirtual( <(MethodName)> )
#xcommand METHOD <MethodName>( [<params,...>] ) VIRTUAL => ;
oClass:AddVirtual( <(MethodName)> )
#xcommand METHOD <MethodName>( [<params>] ) OPERATOR <op> [ <export: EXPORTED, VISIBLE>] [<protect: PROTECTED>] [<hidde: HIDDEN>] => ;
oClass:AddMethod( <(MethodName)>, CLSMETH _CLASS_NAME_ <MethodName>(), HBCLSCHOICE( <.export.>, <.protect.>, <.hidde.> ) ) ;;
oClass:AddInline( <(op)>, {|Self [,<params>] | Self:<MethodName>( [<params>] ) }, HBCLSCHOICE( <.export.>, <.protect.>, <.hidde.> ) )
#xcommand MESSAGE <MessageName> METHOD <MethodName> [ <ctor: CONSTRUCTOR> ] [ <export: EXPORTED, VISIBLE>] [<protect: PROTECTED>] [<hidde: HIDDEN>] => ;
oClass:AddMethod( <(MessageName)>, CLSMETH _CLASS_NAME_ <MethodName>(), HBCLSCHOICE( <.export.>, <.protect.>, <.hidde.> ) + if( <.ctor.>, HBCLSTP_CTOR, 0 ) )
#xcommand MESSAGE <MessageName> METHOD <MethodName>( [<params,...>] ) [ <ctor: CONSTRUCTOR> ] [ <export: EXPORTED, VISIBLE>] [<protect: PROTECTED>] [<hidde: HIDDEN>]=> ;
oClass:AddMethod( <(MessageName)>, CLSMETH _CLASS_NAME_ <MethodName>(), HBCLSCHOICE( <.export.>, <.protect.>, <.hidde.> ) + if( <.ctor.>, HBCLSTP_CTOR, 0 ) )
#xcommand MESSAGE <MessageName>( [<params,...>] ) METHOD <MethodName> [ <ctor: CONSTRUCTOR> ] [ <export: EXPORTED, VISIBLE>] [<protect: PROTECTED>] [<hidde: HIDDEN>] => ;
oClass:AddMethod( <(MessageName)>, CLSMETH _CLASS_NAME_ <MethodName>(), HBCLSCHOICE( <.export.>, <.protect.>, <.hidde.> ) + if( <.ctor.>, HBCLSTP_CTOR, 0 ) )
#xcommand MESSAGE <MessageName>( [<params,...>] ) METHOD <MethodName>( [<dummy,...>] ) [ <ctor: CONSTRUCTOR> ] [ <export: EXPORTED, VISIBLE>] [<protect: PROTECTED>] [<hidde: HIDDEN>] => ;
oClass:AddMethod( <(MessageName)>, CLSMETH _CLASS_NAME_ <MethodName>(), HBCLSCHOICE( <.export.>, <.protect.>, <.hidde.> ) + if( <.ctor.>, HBCLSTP_CTOR, 0 ) )
#xcommand MESSAGE <MessageName> IN <SuperClass> => ;
oClass:AddInline( <(MessageName)>, {|Self| Self:<SuperClass>:<MessageName>() } )
#xcommand MESSAGE <MessageName>( [<params,...>] ) IN <SuperClass> => ;
oClass:AddInline( <(MessageName)>, {|Self [,<params>]| Self:<SuperClass>:<MessageName>( [<params>] ) } )
#xcommand MESSAGE <MessageName> IS <SprMethodName> IN <SuperClass> => ;
oClass:AddInline( <(MessageName)>, {|Self| Self:<SuperClass>:<SprMethodName>() } )
#xcommand MESSAGE <MessageName> IS <SprMethodName>( [<params,...>] ) IN <SuperClass> => ;
oClass:AddInline( <(MessageName)>, {|Self [,<params>]| Self:<SuperClass>:<SprMethodName>( [<params>] ) } )
#xcommand MESSAGE <MessageName>( [<params,...>] ) IS <SprMethodName> IN <SuperClass> => ;
oClass:AddInline( <(MessageName)>, {|Self [,<params>]| Self:<SuperClass>:<SprMethodName>( [<params>] ) } )
#xcommand MESSAGE <MessageName>( [<params,...>] ) IS <SprMethodName>( [<dummy,...>] ) IN <SuperClass> => ;
oClass:AddInline( <(MessageName)>, {|Self [,<params>]| Self:<SuperClass>:<SprMethodName>( [<params>] ) } )
#xcommand MESSAGE <MessageName> IS <MethodName> [ <ctor: CONSTRUCTOR> ] [ <export: EXPORTED, VISIBLE>] [<protect: PROTECTED>] [<hidde: HIDDEN>] => ;
oClass:AddMethod( <(MessageName)>, CLSMETH _CLASS_NAME_ <MethodName>(), HBCLSCHOICE( <.export.>, <.protect.>, <.hidde.> ) + if( <.ctor.>, HBCLSTP_CTOR, 0 ) )
#xcommand MESSAGE <MessageName> IS <MethodName>( [<params,...>] ) [ <ctor: CONSTRUCTOR> ] [ <export: EXPORTED, VISIBLE>] [<protect: PROTECTED>] [<hidde: HIDDEN>]=> ;
oClass:AddMethod( <(MessageName)>, CLSMETH _CLASS_NAME_ <MethodName>(), HBCLSCHOICE( <.export.>, <.protect.>, <.hidde.> ) + if( <.ctor.>, HBCLSTP_CTOR, 0 ) )
#xcommand MESSAGE <MessageName>( [<params,...>] ) IS <MethodName> [ <ctor: CONSTRUCTOR> ] [ <export: EXPORTED, VISIBLE>] [<protect: PROTECTED>] [<hidde: HIDDEN>] => ;
oClass:AddMethod( <(MessageName)>, CLSMETH _CLASS_NAME_ <MethodName>(), HBCLSCHOICE( <.export.>, <.protect.>, <.hidde.> ) + if( <.ctor.>, HBCLSTP_CTOR, 0 ) )
#xcommand MESSAGE <MessageName>( [<params,...>] ) IS <MethodName>( [<dummy,...>] ) [ <ctor: CONSTRUCTOR> ] [ <export: EXPORTED, VISIBLE>] [<protect: PROTECTED>] [<hidde: HIDDEN>] => ;
oClass:AddMethod( <(MessageName)>, CLSMETH _CLASS_NAME_ <MethodName>(), HBCLSCHOICE( <.export.>, <.protect.>, <.hidde.> ) + if( <.ctor.>, HBCLSTP_CTOR, 0 ) )
#xcommand MESSAGE <MessageName> TO <oObject> =>;
oClass:AddInline( <(MessageName)>, {|Self| Self:<oObject>:<MessageName> } )
#xcommand MESSAGE <MessageName>( [<params,...>] ) TO <oObject> =>;
oClass:AddInline( <(MessageName)>, {|Self [,<params>]| Self:<oObject>:<MessageName>( [<params>] ) } )
#xcommand DELEGATE <MessageName> TO <oObject> =>;
oClass:AddInline( <(MessageName)>, {|Self| Self:<oObject>:<MessageName> } )
#xcommand DELEGATE <MessageName>( [<params,...>] ) TO <oObject> =>;
oClass:AddInline( <(MessageName)>, {|Self [,<params>]| Self:<oObject>:<MessageName>( [<params>] ) } )
#xcommand METHOD <MethodName>( [<params,...>] ) SETGET => ;
oClass:AddMethod( <(MethodName)>, CLSMETH _CLASS_NAME_ <MethodName>() ) ;;
oClass:AddMethod( "_" + <(MethodName)>, CLSMETH _CLASS_NAME_ <MethodName>() )
oClass:AddMethod( <(MethodName)>, CLSMETH _CLASS_NAME_ <MethodName>(), HBCLSTP_EXPORTED + HBCLSTP_READONLY ) ;;
oClass:AddMethod( _<(MethodName)>, CLSMETH _CLASS_NAME_ _<MethodName>() )
#xcommand METHOD <MethodName>( [<param>] ) OPERATOR <op> => ;
oClass:AddMethod( <(MethodName)>, CLSMETH _CLASS_NAME_ <MethodName>() ) ;;
oClass:AddInline( <(op)>, {|Self [,<param>] | ::<MethodName>( [<param>] ) } )
#xcommand ACCESS <AccessName> => ;
oClass:AddMethod( <(AccessName)>, CLSMETH _CLASS_NAME_ <AccessName>(), HBCLSTP_EXPORTED + HBCLSTP_READONLY )
#xcommand MESSAGE <MessageName> METHOD <MethodName>( [<params,...>] ) => ;
oClass:AddMethod( <(MessageName)>, CLSMETH _CLASS_NAME_ <MethodName>() )
#xcommand ACCESS <AccessName> INLINE [Local <v>,] <code,...> => ;
oClass:AddInline( <(AccessName)>, {|Self [,<v>] | <code> }, HBCLSTP_EXPORTED + HBCLSTP_READONLY )
#xcommand MESSAGE <MessageName>() METHOD <MethodName>( [<params,...>] ) => ;
oClass:AddMethod( <(MessageName)>, CLSMETH _CLASS_NAME_ <MethodName>() )
#xcommand ACCESS <AccessName> DEFERRED => ;
oClass:AddVirtual( <(AccessName)> )
#xcommand ASSIGN <AssignName>( [<params,...>] ) => ;
oClass:AddMethod( "_" + <(AssignName)>, CLSMETH _CLASS_NAME_ _<AssignName>(), HBCLSTP_EXPORTED )
#xcommand ASSIGN <AssignName>( [<params,...>] ) INLINE [Local <v>,] <Code,...> => ;
oClass:AddInline( "_" + <(AssignName)>, {|Self [,<params>] [,<v>] | <Code> }, HBCLSTP_EXPORTED )
#xcommand ERROR HANDLER <MethodName>( [<params,...>] ) => ;
oClass:SetOnError( CLSMETH _CLASS_NAME_ <MethodName>() )
@@ -114,14 +301,39 @@
#xcommand ON ERROR <MethodName>( [<params,...>] ) => ;
oClass:SetOnError( CLSMETH _CLASS_NAME_ <MethodName>() )
#xtranslate END CLASS => ENDCLASS
#xcommand ENDCLASS => oClass:Create() ;;
endif ;;
return oClass:Instance()
#xcommand END CLASS => ENDCLASS
#xtranslate :Super( <SuperClass> ) : => :<SuperClass>:
#xtranslate :Super() : => :Super:
#xtranslate :Super() => :Super
#ifndef HB_SHORTNAMES
#xcommand METHOD <MethodName>( [<params,...>] ) CLASS <ClassName> => ;
static function <ClassName>_<MethodName>( [<params>] ) ;;
local Self := QSelf()
#endif /* HB_CLASS_CH_ */
#xcommand ACCESS <AccessName>() CLASS <ClassName> => ;
static function <ClassName>_<AccessName>() ;;
local Self := QSelf()
#xcommand ASSIGN <AssignName>( [<params,...>] ) CLASS <ClassName> => ;
static function <ClassName>__<AssignName>( [<params>] ) ;;
local Self := QSelf()
#else
#xcommand METHOD <MethodName>( [<params,...>] ) CLASS <ClassName> => ;
static function <MethodName>( [<params>] ) ;;
local Self := QSelf()
#xcommand ACCESS <AccessName>() CLASS <ClassName> => ;
static function <AccessName>() ;;
local Self := QSelf()
#xcommand ASSIGN <AssignName>( [<params,...>] ) CLASS <ClassName> => ;
static function _<AssignName>( [<params>] ) ;;
local Self := QSelf()
#endif /* HB_SHORTNAMES */
#endif /* HB_CLASS_CH_ */

View File

@@ -6,6 +6,10 @@
* Harbour Project source code:
* The declarations for all harbour defined functions/procedures.
*
*
* Copyright 2000 J. Lefebvre <jfl@mafact.com> & RA. Cuylen <rac@mafact.com>
* www - http://www.harbour-project.org
*
* Copyright 1999 Ryszard Glab <rglab@imid.med.pl>
* www - http://www.harbour-project.org
*
@@ -81,6 +85,9 @@ EXTERNAL __CLASSADD
EXTERNAL __CLASSNAME
EXTERNAL __CLASSSEL
EXTERNAL __GETMESSAGE
EXTERNAL __CLS_PARAM //Added by RaC&JfL
EXTERNAL __CLSPARENT //Added by RaC&JfL
EXTERNAL SENDER //Added by RaC&JfL
//
//symbols from file: vm\cmdarg.c
//
@@ -642,6 +649,7 @@ EXTERNAL __OBJMODINLINE
EXTERNAL __OBJDELMETHOD
EXTERNAL __OBJDELINLINE
EXTERNAL __OBJDELDATA
EXTERNAL __OBJDERIVEDFROM //Added by RaC&JfL
//
//symbols from file: rtl\readkey.prg
//

View File

@@ -6,6 +6,9 @@
* Harbour Project source code:
* Header file for low-level object engine
*
* Copyright 2000 J. Lefebvre <jfl@mafact.com> & RA. Cuylen <rac@mafact.com>
* www - http://www.harbour-project.org
*
* Copyright 1999 Victor Szakats <info@szelvesz.hu>
* www - http://www.harbour-project.org
*
@@ -38,6 +41,19 @@
#ifndef HB_OO_CH_
#define HB_OO_CH_
//Added by RAC&JF
/* Method or Data attribute (nScope)*/
#define HBCLSTP_EXPORTED 1 // No comment, default
#define HBCLSTP_PROTECTED 2 // Only usable from one of the object's method (even sublclassed object)
#define HBCLSTP_HIDDEN 4 // Only usable from one of the object's method (and not from sublclassed one)
#define HBCLSTP_CTOR 8 // Constructor (Not yet used)
#define HBCLSTP_READONLY 16 // No comment
#define HBCLSTP_SHARED 32 // Allow a classvar (or classmethod) to be shared by all the subclasses.
// Not the default behaviour as each subclass will have its own copy by default.
#define HBCLSTP_CLASS 64 // The related message is a superobject call, uidata is the superclass handle
// pInitValue contain one superclass object instance (absolutely needed for Inline msg and class data)
#define HBCLSTP_SUPER 128 // The related message is inherited from a superclass
/* Message types */
#define HB_OO_MSG_METHOD 0
#define HB_OO_MSG_DATA 1
@@ -46,14 +62,29 @@
#define HB_OO_MSG_VIRTUAL 4
#define HB_OO_MSG_SUPER 5
#define HB_OO_MSG_ONERROR 6
#define HB_OO_MSG_CLSMTHD 7 //for the futur ;-) RAC&JF
/* Data */
#define HB_OO_DATA_SYMBOL 1
#define HB_OO_DATA_VALUE 2
#define HB_OO_DATA_TYPE 3
#define HB_OO_DATA_SCOPE 4
/* ClassData */
#define HB_OO_CLSD_SYMBOL 1
#define HB_OO_CLSD_VALUE 2
#define HB_OO_CLSD_TYPE 3
#define HB_OO_CLSD_SCOPE 4
/* Method */
#define HB_OO_MTHD_SYMBOL 1
#define HB_OO_MTHD_PFUNCTION 2
#define HB_OO_MTHD_SCOPE 3
//Added by RAC&JF
/* ClassMethod */ //for the future ;-)
#define HB_OO_CLSM_SYMBOL 1
#define HB_OO_CLSM_PFUNCTION 2
#define HB_OO_CLSM_SCOPE 3
#endif /* HB_OO_CH_ */

View File

@@ -38,7 +38,7 @@
#ifndef HB_SETUP_CH_
#define HB_SETUP_CH_
/* NOTE: You can select here, which features you to include of the different
/* NOTE: You can select here, which features you to include of the different
Clipper implementations. */
#define HB_EXTENSION /* Enable Harbour extensions */
@@ -53,5 +53,8 @@
/* #define HB_COMPAT_FOXPRO */ /* Enable FoxPro extensions */
/* #define HB_COMPAT_DBASE */ /* Enable dBase extensions */
//Added by RaC&JfL
#define HB_CLS_MASKHIDDEN /* Disallow heritence of hidden variables */
#endif /* HB_SETUP_CH_ */

View File

@@ -40,6 +40,9 @@
* Copyright 1999 Antonio Linares <alinares@fivetech.com>
* __objGetMsgList
*
* Copyright 2000 Jf. Lefebvre <jfl@mafact.com> and Ra. Cuylen <rac@mafact.com>
* __objDerivedFrom
*
* See doc/license.txt for licensing terms.
*
*/
@@ -229,3 +232,25 @@ FUNCTION __objDelData( oObject, cSymbol )
ENDIF
RETURN oObject
//Added by RâC&JfL
FUNCTION __objDerivedFrom( oObject, xSuper )
Local lRetVal, cClassName
IF !ISOBJECT( oObject )
__errRT_BASE( EG_ARG, 3101, NIL, ProcName( 0 ) )
ENDIF
IF ISOBJECT( xSuper )
cClassName := xSuper:ClassName()
ELSEIF ISCHARACTER( xSuper )
cClassName := Upper( xSuper )
ELSE
__errRT_BASE( EG_ARG, 3101, NIL, ProcName( 0 ) )
ENDIF
lRetVal := __ClsParent( oObject:ClassH, cClassName )
RETURN lRetVal

View File

@@ -6,6 +6,8 @@
* Harbour Project source code:
* Base Class for internal handling of class creation
*
* Copyright 2000 J. Lefebvre <jfl@mafact.com> & RA. Cuylen <rac@mafact.com>
*
* Copyright 1999 Antonio Linares <alinares@fivetech.com>
* www - http://www.harbour-project.org
*
@@ -37,6 +39,15 @@
* The following parts are Copyright of the individual authors.
* www - http://www.harbour-project.org
*
* Copyright 2000 J. Lefebvre <jfl@mafact.com> & RA. Cuylen <rac@mafact.com>
* Multiple inheritance
* Support shared class DATA
* scoping (hidden, protected, readOnly)
* Use of __cls_param function to allow multiple superclass declaration
* Suppress of SetType and SetInit not more nedded
* Delegation and forwarding
* Reworking of hashing as dicRealloc
*
* Copyright 1999 Eddie Runia <eddie@runia.com>
* Support for inheritance
* Support for default DATA values
@@ -54,23 +65,24 @@
FUNCTION TClass()
STATIC s_hClass
STATIC s_hClass := NIL
IF s_hClass == NIL
s_hClass := __clsNew( "TCLASS", 11 )
s_hClass := __clsNew( "TCLASS", 10 )
__clsAddMsg( s_hClass, "New" , @New() , HB_OO_MSG_METHOD )
__clsAddMsg( s_hClass, "Create" , @Create() , HB_OO_MSG_METHOD )
__clsAddMsg( s_hClass, "AddData" , @AddData() , HB_OO_MSG_METHOD )
__clsAddMsg( s_hClass, "AddMultiData", @AddMultiData(), HB_OO_MSG_METHOD )
__clsAddMsg( s_hClass, "AddClassData", @AddClassData(), HB_OO_MSG_METHOD )
__clsAddMsg( s_hClass, "AddMultiClsData", @AddMultiClsData(), HB_OO_MSG_METHOD )
__clsAddMsg( s_hClass, "AddInline" , @AddInline() , HB_OO_MSG_METHOD )
__clsAddMsg( s_hClass, "AddMethod" , @AddMethod() , HB_OO_MSG_METHOD )
__clsAddMsg( s_hClass, "AddVirtual" , @AddVirtual() , HB_OO_MSG_METHOD )
__clsAddMsg( s_hClass, "Instance" , @Instance() , HB_OO_MSG_METHOD )
__clsAddMsg( s_hClass, "SetInit" , @SetInit() , HB_OO_MSG_METHOD )
__clsAddMsg( s_hClass, "SetOnError" , @SetOnError() , HB_OO_MSG_METHOD )
__clsAddMsg( s_hClass, "SetType" , @SetType() , HB_OO_MSG_METHOD )
__clsAddMsg( s_hClass, "cSuper" , {|Self| iif(::acSuper == NIL .OR. len(::acSuper) == 0, NIL, ::acSuper[1] ) }, HB_OO_MSG_INLINE )
__clsAddMsg( s_hClass, "_cSuper" , {|Self, xVal| iif(::acSuper == NIL .OR. len(::acSuper) == 0, (::acSuper := { xVal} ), ::acSuper[1] := xVal), xVal }, HB_OO_MSG_INLINE )
__clsAddMsg( s_hClass, "hClass" , 1, HB_OO_MSG_DATA )
__clsAddMsg( s_hClass, "_hClass" , 1, HB_OO_MSG_DATA )
__clsAddMsg( s_hClass, "cName" , 2, HB_OO_MSG_DATA )
@@ -85,23 +97,37 @@ FUNCTION TClass()
__clsAddMsg( s_hClass, "_aInlines" , 6, HB_OO_MSG_DATA )
__clsAddMsg( s_hClass, "aVirtuals" , 7, HB_OO_MSG_DATA )
__clsAddMsg( s_hClass, "_aVirtuals" , 7, HB_OO_MSG_DATA )
__clsAddMsg( s_hClass, "cSuper" , 8, HB_OO_MSG_DATA )
__clsAddMsg( s_hClass, "_cSuper" , 8, HB_OO_MSG_DATA )
__clsAddMsg( s_hClass, "uInit" , 9, HB_OO_MSG_DATA )
__clsAddMsg( s_hClass, "_uInit" , 9, HB_OO_MSG_DATA )
__clsAddMsg( s_hClass, "cType" , 10, HB_OO_MSG_DATA )
__clsAddMsg( s_hClass, "_cType" , 10, HB_OO_MSG_DATA )
__clsAddMsg( s_hClass, "nOnError" , 11, HB_OO_MSG_DATA )
__clsAddMsg( s_hClass, "_nOnError" , 11, HB_OO_MSG_DATA )
__clsAddMsg( s_hClass, "acSuper" , 8, HB_OO_MSG_DATA )
__clsAddMsg( s_hClass, "_acSuper" , 8, HB_OO_MSG_DATA )
__clsAddMsg( s_hClass, "nOnError" , 9, HB_OO_MSG_DATA )
__clsAddMsg( s_hClass, "_nOnError" , 9, HB_OO_MSG_DATA )
ENDIF
RETURN __clsInst( s_hClass )
//----------------------------------------------------------------------------//
STATIC FUNCTION New( cClassName, cSuper )
STATIC FUNCTION New( cClassName, xSuper )
// xSuper is used here as the new preprocessor file (HBCLASS.CH) send here
// always an array (if no superclass, this will be an empty one)
// In case of direct class creation (without the help of preprocessor) xSuper can be
// either NIL or contain the name of the superclass.
LOCAL Self := QSelf()
LOCAL nSuper, i
::acSuper := {}
nSuper := 0
If Valtype( xSuper ) == 'A'
If Len( xSuper ) >= 1
::acSuper := xSuper
nSuper := Len( xSuper )
EndIf
ElseIf Valtype( xSuper ) == 'C'
::acSuper := { xSuper }
nSuper := 1
EndIf
::cName := Upper( cClassName )
::aDatas := {}
@@ -109,9 +135,16 @@ STATIC FUNCTION New( cClassName, cSuper )
::aClsDatas := {}
::aInlines := {}
::aVirtuals := {}
IF ISCHARACTER( cSuper )
::cSuper := cSuper
ENDIF
For i := 1 to nSuper
If !ISCHARACTER( ::acSuper[i] )
exit
EndIf
Next
If i < nSuper
nSuper := i - 1
aSize(::acSuper, nSuper)
EndIf
RETURN Self
@@ -121,56 +154,68 @@ STATIC FUNCTION Create()
LOCAL Self := QSelf()
LOCAL n
LOCAL nLen
LOCAL nLenDatas := Len( ::aDatas )
LOCAL nLen := Len( ::acSuper )
LOCAL nLenDatas := Len( ::aDatas ) //Datas local to the class !!
LOCAL nDataBegin := 0
LOCAL nClassBegin := 0
LOCAL hClass
LOCAL hSuper
LOCAL ahSuper := {}
LOCAL ahSuper := array( nLen )
Local aoSuper := array( nLen )
IF ::cSuper == NIL
If nLen == 0
hClass := __clsNew( ::cName, nLenDatas )
Else // Multi inheritance
For n := 1 to nLen
ahSuper[n] := __clsInstSuper( Upper( ::acSuper[n] ) ) // Super handle available
aoSuper[n] := __clsInst( ahSuper[n] )
Next
else // Single inheritance
hSuper := __clsInstSuper( Upper( ::cSuper ) )
hClass := __clsNew( ::cName, nLenDatas, hSuper )
// Add class casts
__clsAddMsg( hClass, Upper( ::cSuper ), hSuper, HB_OO_MSG_SUPER )
__clsAddMsg( hClass, "__SUPER", hSuper, HB_OO_MSG_SUPER )
hClass := __clsNew( ::cName, nLenDatas, ahSuper )
nDataBegin := __cls_CntData( hSuper ) // Get offset for new DATAs
nClassBegin := __cls_CntClsData( hSuper ) // Get offset for new ClassData
ENDIF
__clsAddMsg( hClass, Upper( ::acSuper[1] ), ahSuper[1], HB_OO_MSG_SUPER, aoSuper[1], HBCLSTP_CLASS + 1 )
__clsAddMsg( hClass, "SUPER" , ahSuper[1], HB_OO_MSG_SUPER, aoSuper[1], HBCLSTP_CLASS + 1 )
__clsAddMsg( hClass, "__SUPER" , ahSuper[1], HB_OO_MSG_SUPER, aoSuper[1], HBCLSTP_CLASS + 1 )
nDataBegin += __cls_CntData( ahSuper[1] ) // Get offset for new Datas
nClassBegin += __cls_CntClsData( ahSuper[1] ) // Get offset for new ClassData
For n := 2 to nLen
__clsAddMsg( hClass, Upper( ::acSuper[n] ), ahSuper[n], HB_OO_MSG_SUPER, aoSuper[n], HBCLSTP_CLASS + 1 )
nDataBegin += __cls_CntData( ahSuper[n] ) // Get offset for new DATAs
nClassBegin += __cls_CntClsData( ahSuper[n] ) // Get offset for new ClassData
Next
EndIf
::hClass := hClass
FOR n := 1 TO nLenDatas
__clsAddMsg( hClass, ::aDatas[ n ][ HB_OO_DATA_SYMBOL ], n + nDataBegin, HB_OO_MSG_DATA, ;
::aDatas[ n ][ HB_OO_DATA_VALUE ] )
__clsAddMsg( hClass, "_" + ::aDatas[ n ][ HB_OO_DATA_SYMBOL ], n + nDataBegin,;
HB_OO_MSG_DATA )
__clsAddMsg( hClass, ::aDatas[ n ][ HB_OO_DATA_SYMBOL ] , n + nDataBegin, ;
HB_OO_MSG_DATA, ::aDatas[ n ][ HB_OO_DATA_VALUE ], ::aDatas[ n ][ HB_OO_DATA_SCOPE ] )
__clsAddMsg( hClass, "_" + ::aDatas[ n ][ HB_OO_DATA_SYMBOL ] , n + nDataBegin, ;
HB_OO_MSG_DATA, , ::aDatas[ n ][ HB_OO_DATA_SCOPE ] )
NEXT
nLen := Len( ::aMethods )
FOR n := 1 TO nLen
__clsAddMsg( hClass, ::aMethods[ n ][ 1 ], ::aMethods[ n ][ 2 ], HB_OO_MSG_METHOD )
__clsAddMsg( hClass, ::aMethods[ n ][ HB_OO_MTHD_SYMBOL ], ::aMethods[ n ][ HB_OO_MTHD_PFUNCTION ], HB_OO_MSG_METHOD, , ::aMethods[ n ][ HB_OO_MTHD_SCOPE ] )
NEXT
nLen := Len( ::aClsDatas )
FOR n := 1 TO nLen
__clsAddMsg( hClass, ::aClsDatas[ n ][ HB_OO_CLSD_SYMBOL ], n + nClassBegin,;
HB_OO_MSG_CLASSDATA, ::aClsDatas[ n ][ HB_OO_CLSD_VALUE ] )
__clsAddMsg( hClass, "_" + ::aClsDatas[ n ][ HB_OO_CLSD_SYMBOL ],;
n + nClassBegin, HB_OO_MSG_CLASSDATA )
__clsAddMsg( hClass, ::aClsDatas[ n ][ HB_OO_CLSD_SYMBOL ] , n + nClassBegin,;
HB_OO_MSG_CLASSDATA, ::aClsDatas[ n ][ HB_OO_CLSD_VALUE ], ::aClsDatas[ n ][ HB_OO_CLSD_SCOPE ] )
__clsAddMsg( hClass, "_" + ::aClsDatas[ n ][ HB_OO_CLSD_SYMBOL ], n + nClassBegin,;
HB_OO_MSG_CLASSDATA, , ::aClsDatas[ n ][ HB_OO_CLSD_SCOPE ] )
NEXT
nLen := Len( ::aInlines )
FOR n := 1 TO nLen
__clsAddMsg( hClass, ::aInlines[ n ][ 1 ], ::aInlines[ n ][ 2 ],;
HB_OO_MSG_INLINE )
__clsAddMsg( hClass, ::aInlines[ n ][ HB_OO_MTHD_SYMBOL ], ::aInlines[ n ][ HB_OO_MTHD_PFUNCTION ],;
HB_OO_MSG_INLINE, , ::aInlines[ n ][ HB_OO_MTHD_SCOPE ] )
NEXT
// __clsAddMsg( hClass, Upper( ::cName ), {| self | self }, HB_OO_MSG_INLINE ) // QUESTION: Useful ?
nLen := Len( ::aVirtuals )
FOR n := 1 TO nLen
@@ -178,7 +223,7 @@ STATIC FUNCTION Create()
NEXT
if ::nOnError != nil
__clsAddMsg( hClass, ::nOnError,, HB_OO_MSG_ONERROR )
__clsAddMsg( hClass, ::nOnError, , HB_OO_MSG_ONERROR )
endif
RETURN NIL
@@ -193,49 +238,93 @@ STATIC FUNCTION Instance()
//----------------------------------------------------------------------------//
STATIC FUNCTION AddData( cData, xInit ) /* xInit is initializer */
STATIC FUNCTION AddData( cData, xInit, cType, nScope ) /* xInit is initializer */
LOCAL Self := QSelf()
IF ::uInit != NIL
xInit := ::uInit
ENDIF
AAdd( ::aDatas, { cData, xInit } )
AAdd( ::aDatas, { cData, xInit, cType, nScope } )
RETURN NIL
//----------------------------------------------------------------------------//
STATIC FUNCTION AddClassData( cData, xInit )
STATIC FUNCTION AddMultiData( cType, xInit, nScope, aData )
Local Self := QSelf()
Local i
Local nParam := Len(aData)
For i := 1 to nParam
If !ISCHARACTER( aData[i] )
exit
EndIf
Next i
If i < nParam
nParam := i - 1
aSize(aData, nParam)
Endif
For i := 1 to nParam
::AddData( aData[i], xInit, cType, nScope )
next i
RETURN NIL
//----------------------------------------------------------------------------//
STATIC FUNCTION AddClassData( cData, xInit, cType, nScope )
LOCAL Self := QSelf()
IF ::uInit != NIL
xInit := ::uInit
ENDIF
aAdd( ::aClsDatas, { cData, xInit, cType, nScope } )
aAdd( ::aClsDatas, { cData, xInit } )
RETURN NIL
//----------------------------------------------------------------------------//
STATIC FUNCTION AddMultiClsData( cType, xInit, nScope, aData )
Local Self := QSelf()
Local i
Local nParam := Len(aData)
For i := 1 to nParam
If !ISCHARACTER( aData[i] )
exit
EndIf
Next i
If i < nParam
nParam := i - 1
aSize(aData, nParam)
Endif
For i := 1 to nParam
::AddClassData( aData[i], xInit, cType, nScope )
Next i
RETURN NIL
//----------------------------------------------------------------------------//
STATIC FUNCTION AddInline( cMethod, bCode )
STATIC FUNCTION AddInline( cMethod, bCode, nScope )
LOCAL Self := QSelf()
aAdd( ::aInlines, { cMethod, bCode } )
aAdd( ::aInlines, { cMethod, bCode, nScope } )
RETURN NIL
//----------------------------------------------------------------------------//
STATIC FUNCTION AddMethod( cMethod, nFuncPtr )
STATIC FUNCTION AddMethod( cMethod, nFuncPtr, nScope )
LOCAL Self := QSelf()
aAdd( ::aMethods, { cMethod, nFuncPtr } )
aAdd( ::aMethods, { cMethod, nFuncPtr, nScope } )
RETURN NIL
@@ -251,16 +340,6 @@ STATIC FUNCTION AddVirtual( cMethod )
//----------------------------------------------------------------------------//
STATIC FUNCTION SetInit( uValue )
LOCAL Self := QSelf()
::uInit := uValue
RETURN NIL
//----------------------------------------------------------------------------//
STATIC FUNCTION SetOnError( nFuncPtr )
LOCAL Self := QSelf()
@@ -271,18 +350,3 @@ STATIC FUNCTION SetOnError( nFuncPtr )
//----------------------------------------------------------------------------//
STATIC FUNCTION SetType( cType )
LOCAL Self := QSelf()
::cType := cType
if cType != nil .and. Upper( cType ) == "LOGICAL" .and. ::uInit == nil
::uInit := .f.
else
::uInit := nil
endif
RETURN NIL
//----------------------------------------------------------------------------//

File diff suppressed because it is too large Load Diff

View File

@@ -46,9 +46,24 @@
#include "hbapi.h"
char * hb_procname( int iLevel, char * szName ); //Added by RAC&JF
//Modified by RAC&JF
HB_FUNC( PROCNAME )
{
int iLevel = hb_parni( 1 ) + 1; /* we are already inside ProcName() */
char sName[255];
// Added by RAC&JF
// Extracted to an internal function to allow us to call it from a c hb_internal
hb_procname( iLevel, &sName );
hb_retc( ( char *) &sName );
}
/*
HB_FUNC( PROCNAME )
{
int iLevel = hb_parni( 1 ) + 1; // we are already inside ProcName()
PHB_ITEM pBase = hb_stack.pBase;
while( ( iLevel-- > 0 ) && pBase != hb_stack.pItems )
@@ -56,7 +71,7 @@ HB_FUNC( PROCNAME )
if( ( iLevel == -1 ) )
{
if( ( pBase + 1 )->type == HB_IT_ARRAY ) /* it is a method name */
if( ( pBase + 1 )->type == HB_IT_ARRAY ) // it is a method name
{
char * szProcName;
@@ -74,7 +89,7 @@ HB_FUNC( PROCNAME )
else
hb_retc( "" );
}
*/
HB_FUNC( PROCLINE )
{
int iLevel = hb_parni( 1 ) + 1; /* we are already inside ProcName() */
@@ -100,3 +115,30 @@ HB_FUNC( PROCFILE )
}
#endif
//Added by RAC&JF because we need it from classes.c
char * hb_procname( int iLevel, char * szName )
{
PHB_ITEM pBase = hb_stack.pBase;
while( ( iLevel-- > 0 ) && pBase != hb_stack.pItems )
pBase = hb_stack.pItems + pBase->item.asSymbol.stackbase;
if( ( iLevel == -1 ) )
{
if( ( pBase + 1 )->type == HB_IT_ARRAY ) /* it is a method name */
{
strcpy( szName, hb_objGetClsName( pBase + 1 ) );
strcat( szName, ":" );
strcat( szName, pBase->item.asSymbol.value->szName );
}
else
strcpy( szName, pBase->item.asSymbol.value->szName );
}
else
strcpy( szName, "" );
return( szName );
}