diff --git a/harbour/ChangeLog b/harbour/ChangeLog index f9cc0e777b..e4ffd10b1b 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -16,6 +16,28 @@ The license applies to all entries newer than 2009-04-28. */ +2012-10-05 18:08 UTC+0200 Viktor Szakats (vszakats syenar.net) + * contrib/xhb/arrayblk.prg + * contrib/xhb/dbgfx.prg + * contrib/xhb/dumpvar.prg + * contrib/xhb/hblognet.prg + * contrib/xhb/hjwindow.prg + * contrib/xhb/hterrsys.prg + * contrib/xhb/htjlist.prg + * contrib/xhb/htmutil.prg + * contrib/xhb/tcgi.prg + * contrib/xhb/tfile.prg + * contrib/xhb/trpc.prg + * contrib/xhb/trpccli.prg + * contrib/xhb/ttable.prg + * contrib/xhb/txml.prg + * contrib/xhb/xcstr.prg + * contrib/xhb/xdbmodst.prg + * contrib/xhb/xhberr.prg + * contrib/xhb/xhbtedit.prg + * hbformatted, manually corrected + * few corrections to use constants, hb_BChar() + 2012-10-05 12:55 UTC+0200 Viktor Szakats (vszakats syenar.net) * contrib/hbct/tests/ctwtest.prg * contrib/hbwin/tests/testole.prg diff --git a/harbour/contrib/xhb/arrayblk.prg b/harbour/contrib/xhb/arrayblk.prg index 9eaff056c1..01dda1f568 100644 --- a/harbour/contrib/xhb/arrayblk.prg +++ b/harbour/contrib/xhb/arrayblk.prg @@ -53,4 +53,4 @@ FUNCTION HB_ARRAYBLOCK( aArray, nIndex ) - RETURN {| x | iif( PCount() == 0, aArray[ nIndex ], aArray[ nIndex ] := x )} + RETURN {| x | iif( PCount() == 0, aArray[ nIndex ], aArray[ nIndex ] := x ) } diff --git a/harbour/contrib/xhb/dbgfx.prg b/harbour/contrib/xhb/dbgfx.prg index d5eedc6851..b2e29f0a37 100644 --- a/harbour/contrib/xhb/dbgfx.prg +++ b/harbour/contrib/xhb/dbgfx.prg @@ -58,33 +58,45 @@ STATIC s_lToLogFile := .T. STATIC s_lEmptyLogFile := .T. FUNCTION HB_ToOutDebugOnOff( lOnOff ) + LOCAL lOld := s_lToOutDebug + IF HB_ISLOGICAL( lOnOff ) s_lToOutDebug := lOnOff ENDIF -RETURN lOld + + RETURN lOld PROCEDURE HB_ToOutDebug( ... ) + IF s_lToOutDebug hb_OutDebug( sprintf( ... ) ) ENDIF -RETURN + + RETURN FUNCTION HB_ToLogFileOnOff( lOnOff ) + LOCAL lOld := s_lToLogFile + IF HB_ISLOGICAL( lOnOff ) s_lToLogFile := lOnOff ENDIF -RETURN lOld + + RETURN lOld FUNCTION HB_EmptyLogFileOnOff( lOnOff ) + LOCAL lOld := s_lEmptyLogFile + IF HB_ISLOGICAL( lOnOff ) s_lEmptyLogFile := lOnOff ENDIF -RETURN lOld + + RETURN lOld PROCEDURE HB_ToLogFile( cLogFile, ... ) + LOCAL nHandle IF !s_lToLogFile @@ -115,4 +127,5 @@ PROCEDURE HB_ToLogFile( cLogFile, ... ) FClose( nHandle ) ENDIF ENDIF -RETURN + + RETURN diff --git a/harbour/contrib/xhb/dumpvar.prg b/harbour/contrib/xhb/dumpvar.prg index 4c4b8ca8ed..e7d516eeff 100644 --- a/harbour/contrib/xhb/dumpvar.prg +++ b/harbour/contrib/xhb/dumpvar.prg @@ -61,10 +61,13 @@ */ PROCEDURE __OutDebug( ... ) + LOCAL xVal - FOR EACH xVal IN hb_aParams() - hb_OutDebug( hb_DumpVar( xVal ) ) + + FOR EACH xVal IN hb_AParams() + hb_OutDebug( hb_DumpVar( xVal ) ) NEXT + RETURN /* @@ -79,16 +82,18 @@ PROCEDURE __OutDebug( ... ) */ FUNCTION HB_DumpVar( xVar, lRecursive, nMaxRecursionLevel ) + LOCAL nRecursionLevel := 1 LOCAL nIndent := 0 - //TraceLog( "HB_DumpVariable: xVar, lAssocAsObj, lRecursive", xVar, lAssocAsObj, lRecursive ) +// TraceLog( "HB_DumpVariable: xVar, lAssocAsObj, lRecursive", xVar, lAssocAsObj, lRecursive ) DEFAULT nMaxRecursionLevel TO 0 - RETURN __HB_DumpVar( xVar,, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel ) + RETURN __HB_DumpVar( xVar, , lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel ) STATIC FUNCTION __HB_DumpVar( xVar, lAssocAsObj, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel ) + LOCAL cType := ValType( xVar ) LOCAL cString := "", cKey LOCAL nEolLen @@ -96,77 +101,78 @@ STATIC FUNCTION __HB_DumpVar( xVar, lAssocAsObj, lRecursive, nIndent, nRecursion DEFAULT lAssocAsObj TO .F. DEFAULT lRecursive TO .F. - //TraceLog( "Recursion: xVar, nRecursionLevel, nMaxRecursionLevel", xVar, nRecursionLevel, nMaxRecursionLevel ) +// TraceLog( "Recursion: xVar, nRecursionLevel, nMaxRecursionLevel", xVar, nRecursionLevel, nMaxRecursionLevel ) // return if there is limit in recursion IF nMaxRecursionLevel > 0 .AND. ; - nRecursionLevel > nMaxRecursionLevel + nRecursionLevel > nMaxRecursionLevel RETURN AsString( xVar ) ENDIF DO CASE CASE cType == "O" - IF !lAssocAsObj .AND. xVar:ClassName == "TASSOCIATIVEARRAY" - cString += Space( nIndent ) + "Type='Associative' -> " + hb_eol() - // Keys extraction. - IF Len( xVar:Keys ) > 0 - nEolLen := Len( hb_eol() ) - cString += Space( nIndent ) + "{" + hb_eol() - FOR EACH cKey IN xVar:Keys - cString += Space( nIndent ) + " '" + cKey + "' => " + asString( xVar:SendKey( cKey ) ) + ", " + hb_eol() - IF lRecursive .AND. ValType( xVar:SendKey( cKey ) ) $ "AOH" - cString := SubStr( cString, 1, Len( cString )-2-nEolLen ) + hb_eol() - cString += __HB_DumpVar( xVar:SendKey( cKey ),, lRecursive, nIndent+3, nRecursionLevel + 1, nMaxRecursionLevel ) - cString := SubStr( cString, 1, Len( cString )-nEolLen ) + ", " + hb_eol() - ENDIF - NEXT - cString := SubStr( cString, 1, Len( cString )-2-nEolLen ) + hb_eol() - cString += Space( nIndent ) + "}" + hb_eol() - ENDIF - ELSE - cString += Space( nIndent ) + "<" + xVar:ClassName + " Object>" + hb_eol() - cString += Space( nIndent ) + " | " + hb_eol() - cString += Space( nIndent ) + " +- PRIVATE/HIDDEN:" + hb_eol() - cString += DShowProperties( xVar, HB_OO_CLSTP_HIDDEN, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel ) - cString += Space( nIndent ) + " +- PROTECTED:" + hb_eol() - cString += DShowProperties( xVar, HB_OO_CLSTP_PROTECTED, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel ) - cString += Space( nIndent ) + " +- EXPORTED/VISIBLE/PUBLIC:" + hb_eol() - cString += DShowProperties( xVar, HB_OO_CLSTP_EXPORTED, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel ) + IF !lAssocAsObj .AND. xVar:ClassName == "TASSOCIATIVEARRAY" + cString += Space( nIndent ) + "Type='Associative' -> " + hb_eol() + // Keys extraction. + IF Len( xVar:Keys ) > 0 + nEolLen := Len( hb_eol() ) + cString += Space( nIndent ) + "{" + hb_eol() + FOR EACH cKey IN xVar:Keys + cString += Space( nIndent ) + " '" + cKey + "' => " + asString( xVar:SendKey( cKey ) ) + ", " + hb_eol() + IF lRecursive .AND. ValType( xVar:SendKey( cKey ) ) $ "AOH" + cString := SubStr( cString, 1, Len( cString ) - 2 - nEolLen ) + hb_eol() + cString += __HB_DumpVar( xVar:SendKey( cKey ), , lRecursive, nIndent + 3, nRecursionLevel + 1, nMaxRecursionLevel ) + cString := SubStr( cString, 1, Len( cString ) - nEolLen ) + ", " + hb_eol() + ENDIF + NEXT + cString := SubStr( cString, 1, Len( cString ) - 2 - nEolLen ) + hb_eol() + cString += Space( nIndent ) + "}" + hb_eol() + ENDIF + ELSE + cString += Space( nIndent ) + "<" + xVar:ClassName + " Object>" + hb_eol() + cString += Space( nIndent ) + " | " + hb_eol() + cString += Space( nIndent ) + " +- PRIVATE/HIDDEN:" + hb_eol() + cString += DShowProperties( xVar, HB_OO_CLSTP_HIDDEN, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel ) + cString += Space( nIndent ) + " +- PROTECTED:" + hb_eol() + cString += DShowProperties( xVar, HB_OO_CLSTP_PROTECTED, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel ) + cString += Space( nIndent ) + " +- EXPORTED/VISIBLE/PUBLIC:" + hb_eol() + cString += DShowProperties( xVar, HB_OO_CLSTP_EXPORTED, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel ) #ifdef __XHARBOUR__ - cString += Space( nIndent ) + " +- PUBLISHED:" + hb_eol() - cString += DShowProperties( xVar, HB_OO_CLSTP_PUBLISHED, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel ) + cString += Space( nIndent ) + " +- PUBLISHED:" + hb_eol() + cString += DShowProperties( xVar, HB_OO_CLSTP_PUBLISHED, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel ) #endif - cString += Space( nIndent ) + " +----------->" + hb_eol() - ENDIF + cString += Space( nIndent ) + " +----------->" + hb_eol() + ENDIF CASE cType == "A" - IF nRecursionLevel == 1 - cString += Space( nIndent ) + "Type='A' -> { Array of " + hb_ntos( Len( xVar ) ) + " Items }" + hb_eol() - ENDIF - IF nMaxRecursionLevel > 0 .AND. nRecursionLevel > nMaxRecursionLevel - cString += AsString( xVar ) - ELSE - cString += DShowArray( xVar, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel ) - ENDIF + IF nRecursionLevel == 1 + cString += Space( nIndent ) + "Type='A' -> { Array of " + hb_ntos( Len( xVar ) ) + " Items }" + hb_eol() + ENDIF + IF nMaxRecursionLevel > 0 .AND. nRecursionLevel > nMaxRecursionLevel + cString += AsString( xVar ) + ELSE + cString += DShowArray( xVar, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel ) + ENDIF CASE cType == "H" - IF nRecursionLevel == 1 - cString += Space( nIndent ) + "Type='H' -> { Hash of " + hb_ntos( Len( xVar ) ) + " Items }" + hb_eol() - ENDIF - IF nMaxRecursionLevel > 0 .AND. nRecursionLevel > nMaxRecursionLevel - cString += AsString( xVar ) - ELSE - cString += DShowHash( xVar, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel ) - ENDIF + IF nRecursionLevel == 1 + cString += Space( nIndent ) + "Type='H' -> { Hash of " + hb_ntos( Len( xVar ) ) + " Items }" + hb_eol() + ENDIF + IF nMaxRecursionLevel > 0 .AND. nRecursionLevel > nMaxRecursionLevel + cString += AsString( xVar ) + ELSE + cString += DShowHash( xVar, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel ) + ENDIF OTHERWISE - cString += Space( nIndent ) + AsString( xVar ) + hb_eol() + cString += Space( nIndent ) + AsString( xVar ) + hb_eol() ENDCASE RETURN cString STATIC FUNCTION DShowProperties( oVar, nScope, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel ) + LOCAL xProp, aProps LOCAL aMethods, aMth LOCAL cString := "" @@ -174,18 +180,18 @@ STATIC FUNCTION DShowProperties( oVar, nScope, lRecursive, nIndent, nRecursionLe DEFAULT nIndent TO 0 IF HB_ISOBJECT( oVar ) -// lOldScope := __SetClassScope( .F. ) - aMethods := __objGetMsgFullList( oVar, .F., HB_MSGLISTALL, nScope ) +// lOldScope := __SetClassScope( .F. ) + aMethods := __objGetMsgFullList( oVar, .F. , HB_MSGLISTALL, nScope ) aProps := __objGetValueFullList( oVar, NIL, nScope ) -// __SetClassScope( lOldScope ) +// __SetClassScope( lOldScope ) IF Len( aProps ) > 0 cString += Space( nIndent ) + " | +- >> Begin Data ------" + hb_eol() FOR EACH xProp IN aProps - cString += Space( nIndent ) + " | +- " + PadR( xProp[ HB_OO_DATA_SYMBOL ], 20 ) + " [" + DecodeType( xProp[ HB_OO_DATA_TYPE ] ) + "] [" + DecodeScope( xProp[ HB_OO_DATA_SCOPE ] ) + "] " + ValType( xProp[ HB_OO_DATA_VALUE ] ) + " => " + AsString( xProp[ HB_OO_DATA_VALUE ] ) + hb_eol() - IF lRecursive .AND. ValType( xProp[ HB_OO_DATA_VALUE ] ) $ "AO" - cString += __HB_DumpVar( xProp[ HB_OO_DATA_VALUE ],, lRecursive, nIndent + 3, nRecursionLevel + 1, nMaxRecursionLevel ) + hb_eol() - ENDIF + cString += Space( nIndent ) + " | +- " + PadR( xProp[ HB_OO_DATA_SYMBOL ], 20 ) + " [" + DecodeType( xProp[ HB_OO_DATA_TYPE ] ) + "] [" + DecodeScope( xProp[ HB_OO_DATA_SCOPE ] ) + "] " + ValType( xProp[ HB_OO_DATA_VALUE ] ) + " => " + AsString( xProp[ HB_OO_DATA_VALUE ] ) + hb_eol() + IF lRecursive .AND. ValType( xProp[ HB_OO_DATA_VALUE ] ) $ "AO" + cString += __HB_DumpVar( xProp[ HB_OO_DATA_VALUE ], , lRecursive, nIndent + 3, nRecursionLevel + 1, nMaxRecursionLevel ) + hb_eol() + ENDIF NEXT cString += Space( nIndent ) + " | +- >> End Data ------" + hb_eol() cString += Space( nIndent ) + " | " + hb_eol() @@ -193,7 +199,7 @@ STATIC FUNCTION DShowProperties( oVar, nScope, lRecursive, nIndent, nRecursionLe IF Len( aMethods ) > 0 cString += Space( nIndent ) + " | +- >> Begin Methods ------" + hb_eol() FOR EACH aMth IN aMethods - cString += Space( nIndent ) + " | +- " + PadR( aMth[HB_OO_DATA_SYMBOL], 20 ) + " [" + DecodeType( aMth[HB_OO_DATA_TYPE] ) + "]" + " [" + DecodeScope( aMth[HB_OO_DATA_SCOPE] ) + "] " + hb_eol() + cString += Space( nIndent ) + " | +- " + PadR( aMth[HB_OO_DATA_SYMBOL], 20 ) + " [" + DecodeType( aMth[HB_OO_DATA_TYPE] ) + "]" + " [" + DecodeScope( aMth[HB_OO_DATA_SCOPE] ) + "] " + hb_eol() NEXT cString += Space( nIndent ) + " | +- >> End Methods ------" + hb_eol() cString += Space( nIndent ) + " | " + hb_eol() @@ -202,9 +208,11 @@ STATIC FUNCTION DShowProperties( oVar, nScope, lRecursive, nIndent, nRecursionLe IF Empty( cString ) cString := Space( nIndent ) + " | " + hb_eol() ENDIF + RETURN cString STATIC FUNCTION DShowArray( aVar, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel ) + LOCAL xVal, nChar, nEolLen LOCAL cString := "" @@ -215,18 +223,18 @@ STATIC FUNCTION DShowArray( aVar, lRecursive, nIndent, nRecursionLevel, nMaxRecu IF HB_ISARRAY( aVar ) nEolLen := Len( hb_eol() ) nChar := Len( hb_ntos( Len( aVar ) ) ) // return number of chars to display that value - // i.e. if Len( aVar ) == 99, then nChar := 2 + // i.e. if Len( aVar ) == 99, then nChar := 2 cString += Space( nIndent ) + "{" + hb_eol() FOR EACH xVal IN aVar - cString += Space( nIndent ) + " ["+ LTrim( StrZero( xVal:__EnumIndex(), nChar ) ) + "] => " + AsString( xVal ) + ", " + hb_eol() - IF lRecursive .AND. ValType( xVal ) $ "AOH" - cString := SubStr( cString, 1, Len( cString )-2-nEolLen ) + hb_eol() - cString += __HB_DumpVar( xVal,, lRecursive, nIndent+3, nRecursionLevel + 1, nMaxRecursionLevel ) - cString := SubStr( cString, 1, Len( cString )-nEolLen ) + ", " + hb_eol() - ENDIF + cString += Space( nIndent ) + " [" + LTrim( StrZero( xVal:__EnumIndex(), nChar ) ) + "] => " + AsString( xVal ) + ", " + hb_eol() + IF lRecursive .AND. ValType( xVal ) $ "AOH" + cString := SubStr( cString, 1, Len( cString ) - 2 - nEolLen ) + hb_eol() + cString += __HB_DumpVar( xVal, , lRecursive, nIndent + 3, nRecursionLevel + 1, nMaxRecursionLevel ) + cString := SubStr( cString, 1, Len( cString ) - nEolLen ) + ", " + hb_eol() + ENDIF NEXT IF Len( aVar ) > 0 - cString := SubStr( cString, 1, Len( cString )-2-nEolLen ) + hb_eol() + cString := SubStr( cString, 1, Len( cString ) - 2 - nEolLen ) + hb_eol() ENDIF cString += Space( nIndent ) + "}" + hb_eol() ENDIF @@ -234,6 +242,7 @@ STATIC FUNCTION DShowArray( aVar, lRecursive, nIndent, nRecursionLevel, nMaxRecu RETURN cString STATIC FUNCTION DShowHash( hVar, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel ) + LOCAL xVal LOCAL nEolLen LOCAL cString := "" @@ -246,15 +255,15 @@ STATIC FUNCTION DShowHash( hVar, lRecursive, nIndent, nRecursionLevel, nMaxRecur nEolLen := Len( hb_eol() ) cString += Space( nIndent ) + "{" + hb_eol() FOR EACH xVal IN hVar - cString += Space( nIndent ) + " ["+ LTrim( AsString( xVal:__enumKey() ) ) + "] => " + AsString( xVal ) + ", " + hb_eol() + cString += Space( nIndent ) + " [" + LTrim( AsString( xVal:__enumKey() ) ) + "] => " + AsString( xVal ) + ", " + hb_eol() IF lRecursive .AND. ValType( xVal ) $ "AOH" - cString := SubStr( cString, 1, Len( cString )-2-nEolLen ) + hb_eol() - cString += __HB_DumpVar( xVal,, lRecursive, nIndent+3, nRecursionLevel + 1, nMaxRecursionLevel ) - cString := SubStr( cString, 1, Len( cString )-nEolLen ) + ", " + hb_eol() + cString := SubStr( cString, 1, Len( cString ) - 2 - nEolLen ) + hb_eol() + cString += __HB_DumpVar( xVal, , lRecursive, nIndent + 3, nRecursionLevel + 1, nMaxRecursionLevel ) + cString := SubStr( cString, 1, Len( cString ) - nEolLen ) + ", " + hb_eol() ENDIF NEXT IF Len( hVar ) > 0 - cString := SubStr( cString, 1, Len( cString )-2-nEolLen ) + hb_eol() + cString := SubStr( cString, 1, Len( cString ) - 2 - nEolLen ) + hb_eol() ENDIF cString += Space( nIndent ) + "}" + hb_eol() ENDIF @@ -262,93 +271,95 @@ STATIC FUNCTION DShowHash( hVar, lRecursive, nIndent, nRecursionLevel, nMaxRecur RETURN cString STATIC FUNCTION DecodeScope( nScope AS NUMERIC ) + LOCAL cString := "" - IF hb_BitAnd( nScope, HB_OO_CLSTP_EXPORTED ) # 0 // 1 + IF hb_bitAnd( nScope, HB_OO_CLSTP_EXPORTED ) # 0 // 1 cString += "Ex," ENDIF #ifdef __XHARBOUR__ - IF hb_BitAnd( nScope, HB_OO_CLSTP_PUBLISHED ) # 0 // 2 + IF hb_bitAnd( nScope, HB_OO_CLSTP_PUBLISHED ) # 0 // 2 cString += "Pu," ENDIF #endif - IF hb_BitAnd( nScope, HB_OO_CLSTP_PROTECTED ) # 0 // 4 + IF hb_bitAnd( nScope, HB_OO_CLSTP_PROTECTED ) # 0 // 4 cString += "Pr," ENDIF - IF hb_BitAnd( nScope, HB_OO_CLSTP_HIDDEN ) # 0 // 8 + IF hb_bitAnd( nScope, HB_OO_CLSTP_HIDDEN ) # 0 // 8 cString += "Hi," ENDIF - IF hb_BitAnd( nScope, HB_OO_CLSTP_CTOR ) # 0 // 16 + IF hb_bitAnd( nScope, HB_OO_CLSTP_CTOR ) # 0 // 16 cString += "Ct," ENDIF - IF hb_BitAnd( nScope, HB_OO_CLSTP_READONLY ) # 0 // 32 + IF hb_bitAnd( nScope, HB_OO_CLSTP_READONLY ) # 0 // 32 cString += "Ro," ENDIF - IF hb_BitAnd( nScope, HB_OO_CLSTP_SHARED ) # 0 // 64 + IF hb_bitAnd( nScope, HB_OO_CLSTP_SHARED ) # 0 // 64 cString += "Sh," ENDIF - IF hb_BitAnd( nScope, HB_OO_CLSTP_CLASS ) # 0 // 128 + IF hb_bitAnd( nScope, HB_OO_CLSTP_CLASS ) # 0 // 128 cString += "Cl," ENDIF - IF hb_BitAnd( nScope, HB_OO_CLSTP_SUPER ) # 0 // 256 + IF hb_bitAnd( nScope, HB_OO_CLSTP_SUPER ) # 0 // 256 cString += "Su," ENDIF IF Right( cString, 1 ) == "," - cString := SubStr( cString, 1, Len(cString)-1 ) + cString := SubStr( cString, 1, Len( cString ) - 1 ) ENDIF RETURN PadR( cString, 18 ) STATIC FUNCTION DecodeType( nType AS NUMERIC ) + LOCAL cString := "" DO CASE CASE nType == HB_OO_MSG_METHOD // 0 - cString += "Method" + cString += "Method" CASE nType == HB_OO_MSG_DATA // 1 - cString += "Data" + cString += "Data" CASE nType == HB_OO_MSG_CLASSDATA // 2 - cString += "Clsdata" + cString += "Clsdata" CASE nType == HB_OO_MSG_INLINE // 3 - cString += "Inline" + cString += "Inline" CASE nType == HB_OO_MSG_VIRTUAL // 4 - cString += "Virtual" + cString += "Virtual" CASE nType == HB_OO_MSG_SUPER // 5 - cString += "Super" + cString += "Super" CASE nType == HB_OO_MSG_ONERROR // 6 - cString += "OnError" + cString += "OnError" CASE nType == HB_OO_MSG_DESTRUCTOR // 7 - cString += "Destructor" + cString += "Destructor" CASE nType == HB_OO_PROPERTY // 8 - cString += "Property" + cString += "Property" CASE nType == HB_OO_MSG_PROPERTY // 9 - cString += "MsgPrp" + cString += "MsgPrp" CASE nType == HB_OO_MSG_CLASSPROPERTY // 10 - cString += "ClsPrp" + cString += "ClsPrp" CASE nType == HB_OO_MSG_REALCLASS - cString += "RealCls" + cString += "RealCls" CASE nType == HB_OO_MSG_DELEGATE - cString += "Delegate" + cString += "Delegate" CASE nType == HB_OO_MSG_PERFORM - cString += "Perform" + cString += "Perform" ENDCASE RETURN PadR( cString, 7 ) STATIC FUNCTION asString( x ) + LOCAL v := ValType( x ) DO CASE CASE v == "C" RETURN '"' + x + '"' OTHERWISE - RETURN hb_cStr( x ) + RETURN hb_CStr( x ) ENDCASE RETURN x - #include "error.ch" /* @@ -356,7 +367,9 @@ STATIC FUNCTION asString( x ) * * return all informations about classes, included type and scope */ + STATIC FUNCTION __objGetMsgFullList( oObject, lData, nRange, nScope, nNoScope ) + LOCAL aMessages LOCAL aReturn LOCAL nFirstProperty, aMsg @@ -375,32 +388,34 @@ STATIC FUNCTION __objGetMsgFullList( oObject, lData, nRange, nScope, nNoScope ) // nRange is already defaulted in ClassFullSel in classes.c - aMessages := ASort( oObject:ClassSel( nRange, nScope, .T. ),,, {| x, y | x[HB_OO_DATA_SYMBOL] < y[HB_OO_DATA_SYMBOL] } ) + aMessages := ASort( oObject:ClassSel( nRange, nScope, .T. ), , , {| x, y | x[ HB_OO_DATA_SYMBOL ] < y[ HB_OO_DATA_SYMBOL ] } ) aReturn := {} - nFirstProperty := aScan( aMessages, {| aElement | Left( aElement[HB_OO_DATA_SYMBOL], 1 ) == '_' } ) + nFirstProperty := AScan( aMessages, {| aElement | Left( aElement[ HB_OO_DATA_SYMBOL ], 1 ) == "_" } ) FOR EACH aMsg IN aMessages - IF Left( aMsg[HB_OO_DATA_SYMBOL], 1 ) == '_' + IF Left( aMsg[ HB_OO_DATA_SYMBOL ], 1 ) == "_" LOOP ENDIF - IF ( AScan( aMessages, {| aElement | aElement[HB_OO_DATA_SYMBOL] == "_" + aMsg[HB_OO_DATA_SYMBOL] }, nFirstProperty ) != 0 ) == lData - IF nNoScope == 0 .OR. HB_BITAND( aMsg[HB_OO_DATA_SCOPE], nNoScope ) == 0 + IF ( AScan( aMessages, {| aElement | aElement[ HB_OO_DATA_SYMBOL ] == "_" + aMsg[ HB_OO_DATA_SYMBOL ] }, nFirstProperty ) != 0 ) == lData + IF nNoScope == 0 .OR. hb_bitAnd( aMsg[ HB_OO_DATA_SCOPE ], nNoScope ) == 0 AAdd( aReturn, aMsg ) ENDIF ENDIF NEXT -RETURN aReturn + RETURN aReturn /* * (C) 2003 - Francesco Saverio Giudice * * return all values from classes, included type and scope */ + STATIC FUNCTION __objGetValueFullList( oObject, aExcept, nScope, nNoScope ) + LOCAL aVars LOCAL aReturn LOCAL aVar @@ -413,13 +428,13 @@ STATIC FUNCTION __objGetValueFullList( oObject, aExcept, nScope, nNoScope ) aExcept := {} ENDIF - aVars := __objGetMsgFullList( oObject, .T., HB_MSGLISTALL, nScope, nNoScope ) + aVars := __objGetMsgFullList( oObject, .T. , HB_MSGLISTALL, nScope, nNoScope ) aReturn := {} FOR EACH aVar IN aVars - IF hb_aScan( aExcept, aVar[HB_OO_DATA_SYMBOL],,, .T. ) == 0 - //TraceLog( "__objGetValueFullList(): aVar[HB_OO_DATA_SYMBOL]", aVar[HB_OO_DATA_SYMBOL] ) - AAdd( aReturn, { aVar[HB_OO_DATA_SYMBOL], __SendRawMsg( oObject, aVar[HB_OO_DATA_SYMBOL] ), aVar[HB_OO_DATA_TYPE], aVar[HB_OO_DATA_SCOPE] } ) + IF hb_AScan( aExcept, aVar[HB_OO_DATA_SYMBOL], , , .T. ) == 0 + //TraceLog( "__objGetValueFullList(): aVar[HB_OO_DATA_SYMBOL]", aVar[ HB_OO_DATA_SYMBOL ] ) + AAdd( aReturn, { aVar[ HB_OO_DATA_SYMBOL ], __SendRawMsg( oObject, aVar[ HB_OO_DATA_SYMBOL ] ), aVar[ HB_OO_DATA_TYPE ], aVar[ HB_OO_DATA_SCOPE ] } ) ENDIF NEXT -RETURN aReturn + RETURN aReturn diff --git a/harbour/contrib/xhb/hblognet.prg b/harbour/contrib/xhb/hblognet.prg index 8e37cda00a..738c5b25a7 100644 --- a/harbour/contrib/xhb/hblognet.prg +++ b/harbour/contrib/xhb/hblognet.prg @@ -57,6 +57,7 @@ #define HB_THREAD_SUPPORT CLASS HB_LogEmail FROM HB_LogChannel + DATA cServer DATA cAddress INIT "log@xharbour.org" DATA cSubject INIT "Log message from xharbour application" @@ -71,24 +72,25 @@ CLASS HB_LogEmail FROM HB_LogChannel METHOD Open( cName ) METHOD Close( cName ) -PROTECTED: + PROTECTED: METHOD Send( nStyle, cMessage, cName, nPriority ) -HIDDEN: + HIDDEN: METHOD GetOk( skCon ) METHOD Prepare( nStyle, cMessage, cName, nPriority ) ENDCLASS METHOD New( nLevel, cHelo, cServer, cSendTo, cSubject, cFrom ) CLASS HB_LogEmail + LOCAL nPos ::Super:New( nLevel ) nPos := At( ":", cServer ) IF nPos > 0 - ::nPort := Val(Substr( cServer, nPos + 1 ) ) - cServer := Substr( cServer , 1, nPos -1 ) + ::nPort := Val( SubStr( cServer, nPos + 1 ) ) + cServer := SubStr( cServer, 1, nPos - 1 ) ENDIF ::cServer := cServer @@ -106,23 +108,29 @@ METHOD New( nLevel, cHelo, cServer, cSendTo, cSubject, cFrom ) CLASS HB_LogEmai ::cAddress := cFrom ENDIF -RETURN SELF + RETURN SELF /** * Inet init must be called here */ + METHOD Open( cName ) CLASS HB_LogEmail + HB_SYMBOL_UNUSED( cName ) hb_inetInit() -RETURN .T. + + RETURN .T. /** * InetCleanup to be called here */ + METHOD Close( cName ) CLASS HB_LogEmail + HB_SYMBOL_UNUSED( cName ) hb_inetCleanup() -RETURN .T. + + RETURN .T. /** @@ -130,14 +138,14 @@ RETURN .T. */ METHOD Send( nStyle, cMessage, cName, nPriority ) CLASS HB_LogEmail - LOCAL skCon := hb_inetCreate() + LOCAL skCon := hb_inetCreate() hb_inetTimeout( skCon, 10000 ) hb_inetConnect( ::cServer, ::nPort, skCon ) - IF hb_inetErrorCode( skCon ) != 0 .or. ! ::GetOk( skCon ) + IF hb_inetErrorCode( skCon ) != 0 .OR. ! ::GetOk( skCon ) RETURN .F. ENDIF @@ -146,12 +154,12 @@ METHOD Send( nStyle, cMessage, cName, nPriority ) CLASS HB_LogEmail RETURN .F. ENDIF - hb_inetSendAll( skCon, "MAIL FROM: <" + ::cAddress +">" + CRLF ) + hb_inetSendAll( skCon, "MAIL FROM: <" + ::cAddress + ">" + CRLF ) IF ! ::GetOk( skCon ) RETURN .F. ENDIF - hb_inetSendAll( skCon, "RCPT TO: <" + ::cSendTo +">" + CRLF ) + hb_inetSendAll( skCon, "RCPT TO: <" + ::cSendTo + ">" + CRLF ) IF ! ::GetOk( skCon ) RETURN .F. ENDIF @@ -170,26 +178,30 @@ METHOD Send( nStyle, cMessage, cName, nPriority ) CLASS HB_LogEmail hb_inetSendAll( skCon, "QUIT" + CRLF ) -RETURN ::GetOk( skCon ) // if quit fails, the mail does not go! + RETURN ::GetOk( skCon ) // if quit fails, the mail does not go! /** * Get the reply and returns true if it is allright */ METHOD GetOk( skCon ) CLASS HB_LogEmail + LOCAL nLen, cReply cReply := hb_inetRecvLine( skCon, @nLen, 128 ) - IF hb_inetErrorCode( skcon ) != 0 .or. Substr( cReply, 1, 1 ) == '5' + IF hb_inetErrorCode( skcon ) != 0 .OR. SubStr( cReply, 1, 1 ) == "5" RETURN .F. ENDIF -RETURN .T. + + RETURN .T. METHOD Prepare( nStyle, cMessage, cName, nPriority ) CLASS HB_LogEmail + LOCAL cPre + cPre := "FROM: " + ::cAddress + CRLF + ; - "TO: " + ::cSendTo + CRLF +; - "Subject:" + ::cSubject + CRLF + CRLF + "TO: " + ::cSendTo + CRLF + ; + "Subject:" + ::cSubject + CRLF + CRLF IF ! Empty( ::cPrefix ) cPre += ::cPrefix + CRLF + CRLF @@ -198,10 +210,10 @@ METHOD Prepare( nStyle, cMessage, cName, nPriority ) CLASS HB_LogEmail cPre += ::Format( nStyle, cMessage, cName, nPriority ) IF ! Empty( ::cPostfix ) - cPre += CRLF +CRLF + ::cPostfix + CRLF + cPre += CRLF + CRLF + ::cPostfix + CRLF ENDIF -RETURN cPre + RETURN cPre @@ -210,6 +222,7 @@ RETURN cPre *************************************************/ CLASS HB_LogInetPort FROM HB_LogChannel + DATA nPort INIT 7761 DATA aListeners INIT {} DATA skIn @@ -224,17 +237,16 @@ CLASS HB_LogInetPort FROM HB_LogChannel METHOD Open( cName ) METHOD Close( cName ) -PROTECTED: + PROTECTED: METHOD Send( nStyle, cMessage, cName, nPriority ) #ifdef HB_THREAD_SUPPORT -HIDDEN: + HIDDEN: METHOD AcceptCon() #endif ENDCLASS - METHOD New( nLevel, nPort ) CLASS HB_LogInetPort ::Super:New( nLevel ) @@ -243,8 +255,7 @@ METHOD New( nLevel, nPort ) CLASS HB_LogInetPort ::nPort := nPort ENDIF -RETURN Self - + RETURN Self METHOD Open( cName ) CLASS HB_LogInetPort @@ -259,18 +270,18 @@ METHOD Open( cName ) CLASS HB_LogInetPort ENDIF #ifdef HB_THREAD_SUPPORT - ::mtxBusy := HB_MutexCreate() - ::nThread := HB_ThreadStart( Self, "AcceptCon" ) + ::mtxBusy := hb_mutexCreate() + ::nThread := hb_threadStart( Self, "AcceptCon" ) #else - // If we have not threads, we have to sync accept incoming connection - // when we log a message +// If we have not threads, we have to sync accept incoming connection +// when we log a message hb_inetTimeout( ::skIn, 50 ) #endif -RETURN .T. - + RETURN .T. METHOD Close( cName ) CLASS HB_LogInetPort + LOCAL sk HB_SYMBOL_UNUSED( cName ) @@ -280,14 +291,14 @@ METHOD Close( cName ) CLASS HB_LogInetPort ENDIF #ifdef HB_THREAD_SUPPORT - // kind termination request +// kind termination request ::bTerminate := .T. - hb_ThreadJoin( ::nThread ) + hb_threadJoin( ::nThread ) #endif hb_inetClose( ::skIn ) - // we now are sure that incoming thread index is not used. +// we now are sure that incoming thread index is not used. DO WHILE Len( ::aListeners ) > 0 sk := ATail( ::aListeners ) @@ -296,25 +307,27 @@ METHOD Close( cName ) CLASS HB_LogInetPort ENDDO hb_inetCleanup() -RETURN .T. + RETURN .T. METHOD Send( nStyle, cMessage, cName, nPriority ) CLASS HB_LogInetPort + LOCAL sk, nCount #ifdef HB_THREAD_SUPPORT - // be sure thread is not busy now - HB_MutexLock( ::mtxBusy ) + +// be sure thread is not busy now + hb_mutexLock( ::mtxBusy ) #else - // IF we have not a thread, we must see if there is a new connection +// IF we have not a thread, we must see if there is a new connection sk := hb_inetAccept( ::skIn ) //timeout should be short IF sk != NIL - Aadd( ::aListeners, sk ) + AAdd( ::aListeners, sk ) ENDIF #endif - // now we transmit the message to all the available channels +// now we transmit the message to all the available channels cMessage := ::Format( nStyle, cMessage, cName, nPriority ) nCount := 1 @@ -324,21 +337,22 @@ METHOD Send( nStyle, cMessage, cName, nPriority ) CLASS HB_LogInetPort // if there is an error, we remove the listener IF hb_inetErrorCode( sk ) != 0 ADel( ::aListeners, nCount ) - ASize( ::aListeners , Len( ::aListeners ) - 1) + ASize( ::aListeners , Len( ::aListeners ) - 1 ) ELSE - nCount ++ + nCount++ ENDIF ENDDO #ifdef HB_THREAD_SUPPORT - HB_MutexUnlock( ::mtxBusy ) + hb_mutexUnlock( ::mtxBusy ) #endif -RETURN .T. - + RETURN .T. #ifdef HB_THREAD_SUPPORT + METHOD AcceptCon() CLASS HB_LogInetPort + LOCAL sk hb_inetTimeout( ::skIn, 250 ) @@ -346,11 +360,12 @@ METHOD AcceptCon() CLASS HB_LogInetPort sk := hb_inetAccept( ::skIn ) // A gentle termination request, or an error IF sk != NIL - HB_MutexLock( ::mtxBusy ) + hb_mutexLock( ::mtxBusy ) AAdd( ::aListeners, sk ) - HB_MutexUnlock( ::mtxBusy ) + hb_mutexUnlock( ::mtxBusy ) ENDIF ENDDO -RETURN .T. + + RETURN .T. #endif diff --git a/harbour/contrib/xhb/hjwindow.prg b/harbour/contrib/xhb/hjwindow.prg index cee6d2a61b..80cd235bc4 100644 --- a/harbour/contrib/xhb/hjwindow.prg +++ b/harbour/contrib/xhb/hjwindow.prg @@ -94,7 +94,7 @@ CLASS TJsWindow METHOD Paragraph() INLINE ::QOut( "
" ) - METHOD CENTER( l ) INLINE ::QOut( iif( l, "