diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 88c195d588..d97c1db928 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,9 @@ +19990511-09:55 Eddie Runia + * source/rtl/objfunc.prg, source/tools/stringp.prg + created from tests/working/debugtst.prg + * Makefile.* + files added to list. (Except makefile.vc) + 19990511-09:40 Eddie Runia * source/rtl/asort.prg added a seperate function diff --git a/harbour/makefile.b16 b/harbour/makefile.b16 index 18800f6a13..21ef486445 100644 --- a/harbour/makefile.b16 +++ b/harbour/makefile.b16 @@ -14,7 +14,8 @@ PROJECT: harbour.lib libs\b16\terminal.lib libs\win16\terminal.lib harbour.exe harbour.lib : arrays.obj asort.obj classes.obj codebloc.obj dates.obj datesx.obj \ debug.obj dynsym.obj environ.obj error.obj \ errorapi.obj errorsys.obj extend.obj files.obj itemapi.obj math.obj \ - mathx.obj set.obj strings.obj stringsx.obj strcmp.obj tclass.obj transfrm.obj + mathx.obj objfunc.obj set.obj stringp.obj strings.obj \ + stringsx.obj strcmp.obj tclass.obj transfrm.obj libs\b16\terminal.lib : console.obj @@ -43,8 +44,10 @@ files.obj : extend.c extend.h types.h itemapi.obj : itemapi.c extend.h types.h math.obj : math.c extend.h types.h mathx.obj : mathx.c extend.h types.h +objfunc.obj : objfunc.c extend.h types.h set.obj : set.c extend.h types.h strcmp.obj : strcmp.c extend.h types.h +stringp.obj : stringp.c extend.h types.h strings.obj : strings.c extend.h types.h stringsx.obj : stringsx.c extend.h types.h tclass.obj : tclass.c extend.h types.h @@ -53,6 +56,8 @@ transfrm.obj : transfrm.c extend.h types.h asort.c : asort.prg harbour.exe error.c : error.prg harbour.exe errorsys.c : errorsys.prg harbour.exe +objfunc.c : objfunc.prg harbour.exe +stringp.c : stringp.prg harbour.exe tclass.c : tclass.prg harbour.exe .prg.c: diff --git a/harbour/makefile.b31 b/harbour/makefile.b31 index 0629815856..4527a12703 100644 --- a/harbour/makefile.b31 +++ b/harbour/makefile.b31 @@ -13,10 +13,12 @@ PROJECT: harbour.lib hbtools.lib terminal.lib libs\win16\terminal.lib harbour.ex harbour.lib : arrays.obj asort.obj classes.obj codebloc.obj dates.obj \ dynsym.obj environ.obj error.obj \ - errorapi.obj errorsys.obj extend.obj files.obj itemapi.obj math.obj \ + errorapi.obj errorsys.obj extend.obj files.obj itemapi.obj \ + math.obj objfunc.obj \ set.obj strings.obj strcmp.obj tclass.obj transfrm.obj -hbtools.lib : datesx.obj debug.obj genobj.obj io.obj mathx.obj stringsx.obj +hbtools.lib : datesx.obj debug.obj genobj.obj io.obj mathx.obj \ + stringp.obj stringsx.obj terminal.lib : console.obj @@ -47,8 +49,10 @@ io.obj : source\tools\io.c extend.h types.h itemapi.obj : itemapi.c extend.h types.h math.obj : math.c extend.h types.h mathx.obj : source\tools\mathx.c extend.h types.h +objfunc.obj : objfunc.prg extend.h types.h init.h harbour.exe set.obj : set.c extend.h types.h set.h strcmp.obj : strcmp.c extend.h types.h +stringp.obj : source\tools\stringp.prg extend.h types.h init.h harbour.exe strings.obj : strings.c extend.h types.h stringsx.obj : source\tools\stringsx.c extend.h types.h tclass.obj : tclass.prg extend.h types.h init.h harbour.exe diff --git a/harbour/makefile.b32 b/harbour/makefile.b32 index 58be893b5b..7c7e01dc62 100644 --- a/harbour/makefile.b32 +++ b/harbour/makefile.b32 @@ -15,7 +15,8 @@ PROJECT: harbour.lib libs\b32\terminal.lib libs\win32\terminal.lib harbour.exe harbour.lib : arrays.obj asort.obj classes.obj codebloc.obj dates.obj datesx.obj \ debug.obj dynsym.obj environ.obj error.obj \ errorapi.obj errorsys.obj extend.obj files.obj itemapi.obj math.obj \ - mathx.obj set.obj symbols.obj strings.obj stringsx.obj strcmp.obj \ + mathx.obj objfunc.obj set.obj symbols.obj stringp.obj \ + strings.obj stringsx.obj strcmp.obj \ tclass.obj transfrm.obj libs\b32\terminal.lib : console.obj @@ -47,8 +48,10 @@ files.obj : extend.c extend.h types.h itemapi.obj : itemapi.c extend.h types.h math.obj : math.c extend.h types.h mathx.obj : mathx.c extend.h types.h +objfunc.obj : objfunc.c extend.h types.h set.obj : set.c extend.h types.h strcmp.obj : strcmp.c extend.h types.h +stringp.obj : stringp.c extend.h types.h strings.obj : strings.c extend.h types.h stringsx.obj : stringsx.c extend.h types.h tclass.obj : tclass.c extend.h types.h @@ -57,6 +60,8 @@ transfrm.obj : transfrm.c extend.h types.h asort.c : asort.prg harbour.exe error.c : error.prg harbour.exe errorsys.c : errorsys.prg harbour.exe +objfunc.c : objfunc.prg harbour.exe +stringp.c : stringp.prg harbour.exe tclass.c : tclass.prg harbour.exe .asm.obj: diff --git a/harbour/source/rtl/Makefile b/harbour/source/rtl/Makefile index f2db5262fe..83d0f3dab6 100644 --- a/harbour/source/rtl/Makefile +++ b/harbour/source/rtl/Makefile @@ -25,6 +25,7 @@ PRG_SOURCES=\ asort.prg \ error.prg \ errorsys.prg \ + objfunc.prg \ tclass.prg \ LIB=rtl diff --git a/harbour/source/rtl/objfunc.prg b/harbour/source/rtl/objfunc.prg new file mode 100644 index 0000000000..29e522132d --- /dev/null +++ b/harbour/source/rtl/objfunc.prg @@ -0,0 +1,116 @@ +#define DATA_SYMBOL 1 +#define DATA_VAL 2 + +// +// := IsData( , ) +// +// Is the symbol present in the object as DATA ? +// +function IsData( oObject, cSymbol ) + +return IsMessage( oObject, cSymbol ) .and. IsMessage( oObject, "_" + cSymbol ) + + +// +// := IsMethod( , ) +// +// Is the symbol present in the object as METHOD ? +// +function IsMethod( oObject, cSymbol ) + +return IsMessage( oObject, cSymbol ) .and. !IsMessage( oObject, "_" + cSymbol ) + +// +// aOData( , [lDataMethod] ) +// +// Return an array containing the names of all the data items of oObject. +// +// lDataMethod = .T. (default) Return all DATAs +// .F. Return all METHODs +// +function aOData( oObject, lDataMethod ) + + local aInfo := aSort( oObject:ClassSel() ) + local aData := {} + local n := 1 + local nLen := Len( aInfo ) + local lFoundDM // Found DATA ? + + lDataMethod := Default( lDataMethod, .T. ) + do while n <= nLen .and. Substr( aInfo[ n ], 1, 1 ) != "_" + +/* If in range and no set function found yet ( set functions begin with a */ +/* leading underscore ). */ + + lFoundDM := !Empty( aScan( aInfo, "_" + aInfo[ n ], n + 1 ) ) + +/* Find position of matching set function in array with all symbols */ + + if lFoundDM == lDataMethod // If found -> DATA + // else METHOD + aAdd( aData, aInfo[ n ] ) + endif + n++ + enddo + +return aData + + +// +// aData aOMethod( oObject ) +// +// Return an array containing the names of all the method of oObject. +// +function aOMethod( oObject ) + +return aOData( oObject, .F. ) + + +// +// aOGet( , [] ) +// +// Basically the same as aOData except that it returns a 2D array +// containing : +// +// [x][1] Symbol name +// [x][2] Value of DATA +// +// aExcept is an optional list of DATA you do not want to collect +// +function aOGet( oObject, aExcept ) + + local aDataSymbol := aoData( oObject ) + local nLen := Len( aDataSymbol ) + local aData := {} + local cSymbol + local n + + aExcept := Default( aExcept, {} ) + for n := 1 to nLen + cSymbol := aDataSymbol[ n ] + if Empty( aScan( aExcept, cSymbol ) ) + aAdd( aData, { cSymbol, oSend( oObject, cSymbol ) } ) + endif + next n +return aData + + +// +// aOSet( , ) +// +// The reverse of aOGet. It puts an 2D array of DATA into an object. +// +function aOSet( oObject, aData ) + + local n + local nLen := Len( aData ) + +// aEval( aData, ; // Still losing 2 block +// {|aItem| oSend( oObject, "_"+aItem[DATA_SYMBOL], aItem[DATA_VAL] ) } ) + + for n := 1 to nLen + oSend( oObject, "_" + aData[n][DATA_SYMBOL], aData[n][DATA_VAL] ) + // Send the message + next n +return oObject + diff --git a/harbour/source/tools/Makefile b/harbour/source/tools/Makefile index b234ce8cb0..f376503122 100644 --- a/harbour/source/tools/Makefile +++ b/harbour/source/tools/Makefile @@ -11,6 +11,9 @@ C_SOURCES=\ mathx.c \ stringsx.c \ +PRG_SOURCES=\ + stringp.prg \ + # io.c should be in the list, but it is DOS-specific. LIB=tools diff --git a/harbour/source/tools/stringp.prg b/harbour/source/tools/stringp.prg new file mode 100644 index 0000000000..fb7e695b09 --- /dev/null +++ b/harbour/source/tools/stringp.prg @@ -0,0 +1,273 @@ +/* $Doc$ + * $FuncName$ Default( , ) + * $Description$ If argument is not set, return default + * $End$ */ +function Default( xArg, xDef ) +return if( ValType(xArg) != ValType(xDef), xDef, xArg ) + + +/* $Doc$ + * $FuncName$ ToChar( , [cSeparator], [lDebug] ) + * $Description$ Convert to character + * $Arguments$ : Item to write + * [cSeparator] : Separator for arrays + * [lDebug] : .T. -> Write debug output + * + * In DEBUG mode : + * + * It will show the xItem according to the following format : + * + * Numerical + * dd/mm/yyyy Date + * "" Character + * {, , ...} Array + * NIL NIL + * .T. / .F. Boolean + * ():{:, ... } + * Object + * + * + * $End$ */ +function ToChar( xTxt, cSeparator, lDebug ) + + local cValTxt + local cOut + local n + local nLen + local aData + + cSeparator := Default( cSeparator, " " ) + lDebug := Default( lDebug, .F. ) + cValTxt := ValType( xTxt ) + + do case + case cValTxt=="C" .or. cValTxt=="M" // Character + cOut := if( lDebug, '"'+xTxt+'"', xTxt ) + + case cValTxt=="N" // Numeric + cOut := Alltrim(Str(xTxt)) + + case cValTxt=="U" // Nothing to write + cOut := if( lDebug, "NIL", "" ) + + case cValTxt=="D" // Date + cOut := TransForm(xTxt, "") + + case cValTxt=="L" // Logical + if lDebug + cOut := if( xTxt, ".T.", ".F." ) + else + cOut := if( xTxt, "True", "False" ) + endif + + case cValTxt=="A" // Array + if lDebug + cOut += "{" + else + cOut := "" + endif + nLen := Len( xTxt ) + for n := 1 to nLen // For each item : Recurse ! + cOut += ToChar( xTxt[n], cSeparator, lDebug ) + if n != nLen + cOut += cSeparator + endif + next n + if lDebug + cOut += "}" + endif + + case cValTxt=="B" // Codeblock + if lDebug + cOut := "Block" + else + cOut := Eval( xTxt ) + endif + + case cValTxt=="O" // Object + if lDebug + cOut := xTxt:ClassName() + "(#" + ToChar( xTxt:ClassH() ) + "):{" + aData := aoGet( xTxt ) + nLen := Len( aData ) + for n := 1 to nLen // For each item : Recurse ! + cOut += aData[n][DATA_SYMBOL] + ":" + ; + ToChar( aData[n][DATA_VAL], cSeparator, lDebug ) + if n != nLen + cOut += cSeparator + endif + next n + cOut += "}" + else + cOut := ToChar( xTxt:Run(), cSeparator, lDebug ) + endif + + endcase + +return cOut + +// +// Debug ( ) +// +// Non-volatile debugging function showing contents of xItem and returing +// passed argument. +// +function Debug( xItem ) + + QOut( ToChar( xItem, ", ", .T. ) ) + +return xItem + + +/* $Doc$ + * $FuncName$ TForm() + * $Description$ Returns TForm object + * $End$ */ +function TForm() + + static oClass + + if oClass == nil + oClass = TClass():New( "TFORM" ) // starts a new class definition + + oClass:AddData( "cName" ) // define this class objects datas + oClass:AddData( "nTop" ) + oClass:AddData( "nLeft" ) + oClass:AddData( "nBottom" ) + oClass:AddData( "nRight" ) + + oClass:AddVirtual( "aExcept" ) // Export exceptions + + oClass:AddMethod( "New", @New() ) // define this class objects methods + oClass:AddMethod( "Show", @Show() ) + oClass:AddMethod( "Transfer", @Transfer() ) + + oClass:Create() // builds this class + endif + +return oClass:Instance() // builds an object of this class + + +/* $Doc$ + * $FuncName$ TForm:New() + * $Description$ Constructor + * $End$ */ +static function New() + + local Self := QSelf() + + ::nTop = 10 + ::nLeft = 10 + ::nBottom = 20 + ::nRight = 40 + +return Self + + +/* $Doc$ + * $FuncName$ TForm:Show() + * $Description$ Show a form + * $End$ */ +static function Show() + + local Self := QSelf() + + QOut( "lets show a form from here :-)" ) + +return nil + + +// +// TForm:Transfer( [] ) +// +// Generic object import and export function +// +// is present. +// +// Maximum number of arguments passed is limited to 10 ! +// +// An argument can be one of the following : +// +// { , } Set DATA to +// { { , }, { , }, ... } +// Set a whole list symbols to value +// Normal way of set objects from external +// sources, like memo files. +// Set self according to the DATA +// contained in +// Can be used to transfer info from +// one class to another +// +// If is not present, the current object will be returned as an array +// for description see aoSet / aoGet. +// +// The method aExcept() is called to determine the DATA which should not +// be returned. Eg. hWnd ( do not copy this DATA from external source ) +// +// Say we want to copy oSource into oTarget we say : +// +// oTarget:Transfer( oSource ) +// +// If we do not want 'cName' duplicated we have to use aoGet : +// +// aNewExcept := aClone( oSource:aExcept() ) +// aAdd( aNewExcept, "cName" ) /* Add cName to exception list */ +// oTarget:Transfer( aoGet( oSource, aNewExcept ) ) +// /* Get DATA from oSource with new exceptions */ +// /* Transfer DATA to oTarget */ +// +// To set two DATA of oTarget : +// +// oTarget:Transfer( { "nLeft", 10 }, { "nRight", 5 } ) +// +// or : +// +// aCollect := {} +// aAdd( aCollect, { "nLeft" , 10 } ) +// aAdd( aCollect, { "nRight", 5 } ) +// oTarget:Transfer( aCollect ) +// +// Copy oSource to a memo field : +// +// DbObject->Memo := oSource:Transfer() +// +// (Re)create oTarget from the memo field : +// +// oTarget := TTarget():New() +// oTarget:Transfer( DbObject->Memo ) +// +static function Transfer( x1,x2,x3,x4,x5,x6,x7,x8,x9,x10 /* etc */ ) + + local self := QSelf() + local aParam := __aParam() + local nLen := PCount() + local xRet + local xData + local n + + if nLen == 0 + xRet := aOGet( self, ::aExcept() ) + else + for n := 1 to nLen + + xData := aParam[ n ] + if ValType( xData ) == "A" + + if ValType( xData[1] ) == "A" // 2D array passed + xRet := aOSet( self, xData ) + else // 1D array passed + xRet := aOSet( self, {xData} ) + endif + + elseif ValType( xData ) == "O" // Object passed + xRet := ::Transfer( xData:Transfer() ) + elseif ValType( xData ) != "U" + QOut( "TRANSFER: Incorrect argument(", n, ") ", xData ) + endif + + next n + endif + +return xRet + + + diff --git a/harbour/tests/working/debugtst.prg b/harbour/tests/working/debugtst.prg index a2a2744079..a6413956f2 100644 --- a/harbour/tests/working/debugtst.prg +++ b/harbour/tests/working/debugtst.prg @@ -1,19 +1,12 @@ /* $Doc$ * $Description$ Debug function tests. * Based on classes.prg - * $Requirement$ source\tools\debug.c - * source\rtl\classes.c (1999/05/97) - * source\rtl\itemapi.c (1999/05/04) + * $Requirement$ source\tools\stringp.prg + * source\rtl\objfunc.prg + * source\rtl\asort.prg * $Date$ * $End$ */ -// -// Warning : This program contains abstract high level Harbour Power !!!! -// - -#define DATA_SYMBOL 1 -#define DATA_VAL 2 - function Main() local oForm := TForm():New() @@ -102,390 +95,4 @@ function FuncSecond( nParam, cParam, uParam ) return nil -/* $Doc$ - * $FuncName$ Default( , ) - * $Description$ If argument is not set, return default - * $End$ */ -function Default( xArg, xDef ) -return if( ValType(xArg) != ValType(xDef), xDef, xArg ) - - -/* $Doc$ - * $FuncName$ ToChar( , [cSeparator], [lDebug] ) - * $Description$ Convert to character - * $Arguments$ : Item to write - * [cSeparator] : Separator for arrays - * [lDebug] : .T. -> Write debug output - * - * In DEBUG mode : - * - * It will show the xItem according to the following format : - * - * Numerical - * dd/mm/yyyy Date - * "" Character - * {, , ...} Array - * NIL NIL - * .T. / .F. Boolean - * ():{:, ... } - * Object - * - * - * $End$ */ -function ToChar( xTxt, cSeparator, lDebug ) - - local cValTxt - local cOut - local n - local nLen - local aData - - cSeparator := Default( cSeparator, " " ) - lDebug := Default( lDebug, .F. ) - cValTxt := ValType( xTxt ) - - do case - case cValTxt=="C" .or. cValTxt=="M" // Character - cOut := if( lDebug, '"'+xTxt+'"', xTxt ) - - case cValTxt=="N" // Numeric - cOut := Alltrim(Str(xTxt)) - - case cValTxt=="U" // Nothing to write - cOut := if( lDebug, "NIL", "" ) - - case cValTxt=="D" // Date - cOut := TransForm(xTxt, "") - - case cValTxt=="L" // Logical - if lDebug - cOut := if( xTxt, ".T.", ".F." ) - else - cOut := if( xTxt, "True", "False" ) - endif - - case cValTxt=="A" // Array - if lDebug - cOut += "{" - else - cOut := "" - endif - nLen := Len( xTxt ) - for n := 1 to nLen // For each item : Recurse ! - cOut += ToChar( xTxt[n], cSeparator, lDebug ) - if n != nLen - cOut += cSeparator - endif - next n - if lDebug - cOut += "}" - endif - - case cValTxt=="B" // Codeblock - if lDebug - cOut := "Block" - else - cOut := Eval( xTxt ) - endif - - case cValTxt=="O" // Object - if lDebug - cOut := xTxt:ClassName() + "(#" + ToChar( xTxt:ClassH() ) + "):{" - aData := aoGet( xTxt ) - nLen := Len( aData ) - for n := 1 to nLen // For each item : Recurse ! - cOut += aData[n][DATA_SYMBOL] + ":" + ; - ToChar( aData[n][DATA_VAL], cSeparator, lDebug ) - if n != nLen - cOut += cSeparator - endif - next n - cOut += "}" - else - cOut := ToChar( xTxt:Run(), cSeparator, lDebug ) - endif - - endcase - -return cOut - -// -// Debug ( ) -// -// Non-volatile debugging function showing contents of xItem and returing -// passed argument. -// -function Debug( xItem ) - - QOut( ToChar( xItem, ", ", .T. ) ) - -return xItem - - -/* $Doc$ - * $FuncName$ TForm() - * $Description$ Returns TForm object - * $End$ */ -function TForm() - - static oClass - - if oClass == nil - oClass = TClass():New( "TFORM" ) // starts a new class definition - - oClass:AddData( "cName" ) // define this class objects datas - oClass:AddData( "nTop" ) - oClass:AddData( "nLeft" ) - oClass:AddData( "nBottom" ) - oClass:AddData( "nRight" ) - - oClass:AddVirtual( "aExcept" ) // Export exceptions - - oClass:AddMethod( "New", @New() ) // define this class objects methods - oClass:AddMethod( "Show", @Show() ) - oClass:AddMethod( "Transfer", @Transfer() ) - - oClass:Create() // builds this class - endif - -return oClass:Instance() // builds an object of this class - - -/* $Doc$ - * $FuncName$ TForm:New() - * $Description$ Constructor - * $End$ */ -static function New() - - local Self := QSelf() - - ::nTop = 10 - ::nLeft = 10 - ::nBottom = 20 - ::nRight = 40 - -return Self - - -/* $Doc$ - * $FuncName$ TForm:Show() - * $Description$ Show a form - * $End$ */ -static function Show() - - local Self := QSelf() - - QOut( "lets show a form from here :-)" ) - -return nil - - -// -// TForm:Transfer( [] ) -// -// Generic object import and export function -// -// is present. -// -// Maximum number of arguments passed is limited to 10 ! -// -// An argument can be one of the following : -// -// { , } Set DATA to -// { { , }, { , }, ... } -// Set a whole list symbols to value -// Normal way of set objects from external -// sources, like memo files. -// Set self according to the DATA -// contained in -// Can be used to transfer info from -// one class to another -// -// If is not present, the current object will be returned as an array -// for description see aoSet / aoGet. -// -// The method aExcept() is called to determine the DATA which should not -// be returned. Eg. hWnd ( do not copy this DATA from external source ) -// -// Say we want to copy oSource into oTarget we say : -// -// oTarget:Transfer( oSource ) -// -// If we do not want 'cName' duplicated we have to use aoGet : -// -// aNewExcept := aClone( oSource:aExcept() ) -// aAdd( aNewExcept, "cName" ) /* Add cName to exception list */ -// oTarget:Transfer( aoGet( oSource, aNewExcept ) ) -// /* Get DATA from oSource with new exceptions */ -// /* Transfer DATA to oTarget */ -// -// To set two DATA of oTarget : -// -// oTarget:Transfer( { "nLeft", 10 }, { "nRight", 5 } ) -// -// or : -// -// aCollect := {} -// aAdd( aCollect, { "nLeft" , 10 } ) -// aAdd( aCollect, { "nRight", 5 } ) -// oTarget:Transfer( aCollect ) -// -// Copy oSource to a memo field : -// -// DbObject->Memo := oSource:Transfer() -// -// (Re)create oTarget from the memo field : -// -// oTarget := TTarget():New() -// oTarget:Transfer( DbObject->Memo ) -// -static function Transfer( x1,x2,x3,x4,x5,x6,x7,x8,x9,x10 /* etc */ ) - - local self := QSelf() - local aParam := __aParam() - local nLen := PCount() - local xRet - local xData - local n - - if nLen == 0 - xRet := aOGet( self, ::aExcept() ) - else - for n := 1 to nLen - - xData := aParam[ n ] - if ValType( xData ) == "A" - - if ValType( xData[1] ) == "A" // 2D array passed - xRet := aOSet( self, xData ) - else // 1D array passed - xRet := aOSet( self, {xData} ) - endif - - elseif ValType( xData ) == "O" // Object passed - xRet := ::Transfer( xData:Transfer() ) - elseif ValType( xData ) != "U" - QOut( "TRANSFER: Incorrect argument(", n, ") ", xData ) - endif - - next n - endif - -return xRet - - -// -// aOData( , [lDataMethod] ) -// -// Return an array containing the names of all the data items of oObject. -// -// lDataMethod = .T. (default) Return all DATAs -// .F. Return all METHODs -// -function aOData( oObject, lDataMethod ) - - local aInfo := aSort( oObject:ClassSel() ) - local aData := {} - local n := 1 - local nLen := Len( aInfo ) - local lFoundDM // Found DATA ? - - lDataMethod := Default( lDataMethod, .T. ) - do while n <= nLen .and. Substr( aInfo[ n ], 1, 1 ) != "_" - -/* If in range and no set function found yet ( set functions begin with a */ -/* leading underscore ). */ - - lFoundDM := !Empty( aScan( aInfo, "_" + aInfo[ n ], n + 1 ) ) - -/* Find position of matching set function in array with all symbols */ - - if lFoundDM == lDataMethod // If found -> DATA - // else METHOD - aAdd( aData, aInfo[ n ] ) - endif - n++ - enddo - -return aData - - -// -// aData aOMethod( oObject ) -// -// Return an array containing the names of all the method of oObject. -// -function aOMethod( oObject ) - -return aOData( oObject, .F. ) - - -// -// aOGet( , [] ) -// -// Basically the same as aOData except that it returns a 2D array -// containing : -// -// [x][1] Symbol name -// [x][2] Value of DATA -// -// aExcept is an optional list of DATA you do not want to collect -// -function aOGet( oObject, aExcept ) - - local aDataSymbol := aoData( oObject ) - local nLen := Len( aDataSymbol ) - local aData := {} - local cSymbol - local n - - aExcept := Default( aExcept, {} ) - for n := 1 to nLen - cSymbol := aDataSymbol[ n ] - if Empty( aScan( aExcept, cSymbol ) ) - aAdd( aData, { cSymbol, oSend( oObject, cSymbol ) } ) - endif - next n -return aData - - -// -// aOSet( , ) -// -// The reverse of aOGet. It puts an 2D array of DATA into an object. -// -function aOSet( oObject, aData ) - - local n - local nLen := Len( aData ) - -// aEval( aData, ; // Still losing 2 block -// {|aItem| oSend( oObject, "_"+aItem[DATA_SYMBOL], aItem[DATA_VAL] ) } ) - - for n := 1 to nLen - oSend( oObject, "_" + aData[n][DATA_SYMBOL], aData[n][DATA_VAL] ) - // Send the message - next n -return oObject - - -// -// := IsData( , ) -// -// Is the symbol present in the object as DATA ? -// -function IsData( oObject, cSymbol ) - -return IsMessage( oObject, cSymbol ) .and. IsMessage( oObject, "_" + cSymbol ) - - -// -// := IsMethod( , ) -// -// Is the symbol present in the object as METHOD ? -// -function IsMethod( oObject, cSymbol ) - -return IsMessage( oObject, cSymbol ) .and. !IsMessage( oObject, "_" + cSymbol ) -