From 25c792a829b0d1928da26deecd0e7c4069af032d Mon Sep 17 00:00:00 2001 From: Viktor Szakats Date: Mon, 4 Jun 2012 17:16:55 +0000 Subject: [PATCH] 2012-06-04 19:15 UTC+0200 Viktor Szakats (harbour syenar.net) * contrib\hbblink\blinker.prg * contrib\xhb\thtm.prg * contrib\xhb\xcstr.prg * examples\hbvpdf\hbvpdf.prg * examples\hbvpdf\hbvpdft.prg * some exceptions missed in previous commit --- harbour/ChangeLog | 8 + harbour/contrib/hbblink/blinker.prg | 2 +- harbour/contrib/xhb/thtm.prg | 2 +- harbour/contrib/xhb/xcstr.prg | 484 ++++++++++++++-------------- harbour/examples/hbvpdf/hbvpdf.prg | 2 +- harbour/examples/hbvpdf/hbvpdft.prg | 2 +- 6 files changed, 254 insertions(+), 246 deletions(-) diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 4b50d98ea6..b545227eb4 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -16,6 +16,14 @@ The license applies to all entries newer than 2009-04-28. */ +2012-06-04 19:15 UTC+0200 Viktor Szakats (harbour syenar.net) + * contrib\hbblink\blinker.prg + * contrib\xhb\thtm.prg + * contrib\xhb\xcstr.prg + * examples\hbvpdf\hbvpdf.prg + * examples\hbvpdf\hbvpdft.prg + * some exceptions missed in previous commit + 2012-06-04 19:02 UTC+0200 Viktor Szakats (harbour syenar.net) * contrib\gtwvg\wvg3stat.prg * contrib\gtwvg\wvgax.prg diff --git a/harbour/contrib/hbblink/blinker.prg b/harbour/contrib/hbblink/blinker.prg index cf38d61708..d3a7df710b 100644 --- a/harbour/contrib/hbblink/blinker.prg +++ b/harbour/contrib/hbblink/blinker.prg @@ -73,7 +73,7 @@ PROCEDURE HB_BLIVERNUM( cString ) RETURN PROCEDURE HB_BLIDEMDTE( dDate ) - IF ISDATE( dDate ) + IF HB_ISDATE( dDate ) s_cDemoDate := DToS( dDate ) ENDIF RETURN diff --git a/harbour/contrib/xhb/thtm.prg b/harbour/contrib/xhb/thtm.prg index dc1deb4716..d31ae07ab6 100644 --- a/harbour/contrib/xhb/thtm.prg +++ b/harbour/contrib/xhb/thtm.prg @@ -2276,7 +2276,7 @@ FUNCTION HTMLANY2STR( xVal ) ELSEIF HB_ISOBJECT( xVal ) xRet := "<" + xVal:CLASSNAME() + ">" - ELSEIF ISDATE( xVal ) + ELSEIF HB_ISDATE( xVal ) xRet := Dtoc( xVal ) ELSEIF HB_ISLOGICAL( xVal ) diff --git a/harbour/contrib/xhb/xcstr.prg b/harbour/contrib/xhb/xcstr.prg index 3ec88b7611..5cfbb5df17 100644 --- a/harbour/contrib/xhb/xcstr.prg +++ b/harbour/contrib/xhb/xcstr.prg @@ -65,49 +65,49 @@ //--------------------------------------------------------------// FUNCTION CStrToVal( cExp, cType ) - IF ! ISCHAR( cExp ) + IF ! HB_ISSTRING( cExp ) Throw( xhb_ErrorNew( "CSTR", 0, 3101, ProcName(), "Argument error", { cExp, cType } ) ) ENDIF SWITCH cType - CASE 'C' - RETURN cExp + CASE 'C' + RETURN cExp - CASE 'P' - RETURN hb_HexToNum( cExp ) + CASE 'P' + RETURN hb_HexToNum( cExp ) - CASE 'D' - IF cExp[3] >= '0' .AND. cExp[3] <= '9' .AND. cExp[5] >= '0' .AND. cExp[5] <= '9' - RETURN hb_SToD( cExp ) - ELSE - RETURN cToD( cExp ) - ENDIF + CASE 'D' + IF cExp[3] >= '0' .AND. cExp[3] <= '9' .AND. cExp[5] >= '0' .AND. cExp[5] <= '9' + RETURN hb_SToD( cExp ) + ELSE + RETURN cToD( cExp ) + ENDIF - CASE 'L' - RETURN IIF( cExp[1] == 'T' .OR. cExp[1] == 'Y' .OR. cExp[2] == 'T' .OR. cExp[2] == 'Y', .T., .F. ) + CASE 'L' + RETURN IIF( cExp[1] == 'T' .OR. cExp[1] == 'Y' .OR. cExp[2] == 'T' .OR. cExp[2] == 'Y', .T., .F. ) - CASE 'N' - RETURN Val( cExp ) + CASE 'N' + RETURN Val( cExp ) - CASE 'U' - RETURN NIL + CASE 'U' + RETURN NIL - /* - CASE 'A' - Throw( xhb_ErrorNew( "CSTRTOVAL", 0, 3101, ProcName(), "Argument error", { cExp, cType } ) ) + /* + CASE 'A' + Throw( xhb_ErrorNew( "CSTRTOVAL", 0, 3101, ProcName(), "Argument error", { cExp, cType } ) ) - CASE 'B' - Throw( xhb_ErrorNew( "CSTRTOVAL", 0, 3101, ProcName(), "Argument error", { cExp, cType } ) ) + CASE 'B' + Throw( xhb_ErrorNew( "CSTRTOVAL", 0, 3101, ProcName(), "Argument error", { cExp, cType } ) ) - CASE 'O' - Throw( xhb_ErrorNew( "CSTRTOVAL", 0, 3101, ProcName(), "Argument error", { cExp, cType } ) ) - */ + CASE 'O' + Throw( xhb_ErrorNew( "CSTRTOVAL", 0, 3101, ProcName(), "Argument error", { cExp, cType } ) ) + */ - OTHERWISE - Throw( xhb_ErrorNew( "CSTRTOVAL", 0, 3101, ProcName(), "Argument error", { cExp, cType } ) ) + OTHERWISE + Throw( xhb_ErrorNew( "CSTRTOVAL", 0, 3101, ProcName(), "Argument error", { cExp, cType } ) ) ENDSWITCH -RETURN NIL + RETURN NIL //--------------------------------------------------------------// FUNCTION StringToLiteral( cString ) @@ -130,7 +130,7 @@ FUNCTION StringToLiteral( cString ) RETURN "'" + cString + "'" ENDIF -RETURN "[" + cString + "]" + RETURN "[" + cString + "]" //--------------------------------------------------------------// FUNCTION ValToPrg( xVal, cName, nPad, aObjs ) @@ -140,115 +140,115 @@ FUNCTION ValToPrg( xVal, cName, nPad, aObjs ) //TraceLog( xVal, cName, nPad, aObjs ) SWITCH ValType( xVal ) - CASE 'C' - RETURN StringToLiteral( xVal ) + CASE 'C' + RETURN StringToLiteral( xVal ) - CASE 'D' - RETURN "hb_SToD( '" + dToS( xVal ) + "' )" + CASE 'D' + RETURN "hb_SToD( '" + dToS( xVal ) + "' )" - CASE 'L' - RETURN IIF( xVal, ".T.", ".F." ) + CASE 'L' + RETURN IIF( xVal, ".T.", ".F." ) - CASE 'N' - RETURN hb_nToS( xVal ) + CASE 'N' + RETURN hb_nToS( xVal ) - CASE 'A' - IF cName == NIL - nPad := 0 - cName := "M->__ValToPrg_Array" - aObjs := {} - cRet := cName + " := " - ELSE - IF ( nObj := aScan( aObjs, {|a| HB_ArrayID( a[1] ) == HB_ArrayID( xVal ) } ) ) > 0 - RETURN aObjs[ nObj ][2] + " /* Cyclic */" - ENDIF - - cRet := "" + CASE 'A' + IF cName == NIL + nPad := 0 + cName := "M->__ValToPrg_Array" + aObjs := {} + cRet := cName + " := " + ELSE + IF ( nObj := aScan( aObjs, {|a| HB_ArrayID( a[1] ) == HB_ArrayID( xVal ) } ) ) > 0 + RETURN aObjs[ nObj ][2] + " /* Cyclic */" ENDIF - aAdd( aObjs, { xVal, cName } ) + cRet := "" + ENDIF - cRet += "Array(" + hb_ntos( Len( xVal ) ) + ")" + CRLF + aAdd( aObjs, { xVal, cName } ) - nPad += 3 - cPad := Space( nPad ) + cRet += "Array(" + hb_ntos( Len( xVal ) ) + ")" + CRLF + nPad += 3 + cPad := Space( nPad ) + + FOR EACH aVar IN xVal + cRet += cPad + cName + "[" + hb_ntos( aVar:__EnumIndex() ) + "] := " + ValToPrg( aVar, cName + "[" + hb_ntos( aVar:__EnumIndex() ) + "]", nPad, aObjs ) + CRLF + NEXT + + nPad -=3 + + RETURN cRet + + CASE 'H' + IF Empty( xVal ) + cRet := "hb_Hash()" + ELSE + cRet := "{ " FOR EACH aVar IN xVal - cRet += cPad + cName + "[" + hb_ntos( aVar:__EnumIndex() ) + "] := " + ValToPrg( aVar, cName + "[" + hb_ntos( aVar:__EnumIndex() ) + "]", nPad, aObjs ) + CRLF + IF aVar:__enumIndex() != 1 + cRet += ", " + ENDIF + cRet += ValToPrg( aVar:__enumKey() ) + cRet += " => " + cRet += ValToPrg( aVar ) NEXT + cRet += " }" + ENDIF - nPad -=3 - - RETURN cRet - - CASE 'H' - IF Empty( xVal ) - cRet := "hb_Hash()" - ELSE - cRet := "{ " - FOR EACH aVar IN xVal - IF aVar:__enumIndex() != 1 - cRet += ", " - ENDIF - cRet += ValToPrg( aVar:__enumKey() ) - cRet += " => " - cRet += ValToPrg( aVar ) - NEXT - cRet += " }" - ENDIF - - RETURN cRet + RETURN cRet /* There is no support for codeblock serialization */ #if 0 - CASE 'B' - RETURN ValToPrgExp( xVal ) + CASE 'B' + RETURN ValToPrgExp( xVal ) #endif - CASE 'P' - RETURN "0x" + hb_NumToHex( xVal ) + CASE 'P' + RETURN "0x" + hb_NumToHex( xVal ) - CASE 'O' - /* TODO: Use HBPersistent() when avialable! */ - IF cName == NIL - cName := "M->__ValToPrg_Object" - nPad := 0 - aObjs := {} - cRet := cName + " := " - ELSE - IF ( nObj := aScan( aObjs, {|a| HB_ArrayID( a[1] ) == HB_ArrayID( xVal ) } ) ) > 0 - RETURN aObjs[ nObj ][2] + " /* Cyclic */" - ENDIF - - cRet := "" + CASE 'O' + /* TODO: Use HBPersistent() when avialable! */ + IF cName == NIL + cName := "M->__ValToPrg_Object" + nPad := 0 + aObjs := {} + cRet := cName + " := " + ELSE + IF ( nObj := aScan( aObjs, {|a| HB_ArrayID( a[1] ) == HB_ArrayID( xVal ) } ) ) > 0 + RETURN aObjs[ nObj ][2] + " /* Cyclic */" ENDIF - aAdd( aObjs, { xVal, cName } ) + cRet := "" + ENDIF - cRet += xVal:ClassName + "():New()" + CRLF + aAdd( aObjs, { xVal, cName } ) - nPad += 3 - cPad := Space( nPad ) + cRet += xVal:ClassName + "():New()" + CRLF - FOR EACH aVar IN __objGetValueList( xVal ) - cRet += cPad + cName + ":" + aVar[1] + " := " + ValToPrg( aVar[2], cName + ":" + aVar[1], nPad, aObjs ) + CRLF - NEXT + nPad += 3 + cPad := Space( nPad ) - nPad -=3 - RETURN cRet + FOR EACH aVar IN __objGetValueList( xVal ) + cRet += cPad + cName + ":" + aVar[1] + " := " + ValToPrg( aVar[2], cName + ":" + aVar[1], nPad, aObjs ) + CRLF + NEXT - OTHERWISE - //TraceLog( xVal, cName, nPad ) - IF xVal == NIL - cRet := "NIL" - ELSE - Throw( xhb_ErrorNew( "VALTOPRG", 0, 3103, ProcName(), "Unsupported type", { xVal } ) ) - ENDIF + nPad -=3 + RETURN cRet + + OTHERWISE + //TraceLog( xVal, cName, nPad ) + IF xVal == NIL + cRet := "NIL" + ELSE + Throw( xhb_ErrorNew( "VALTOPRG", 0, 3103, ProcName(), "Unsupported type", { xVal } ) ) + ENDIF ENDSWITCH //TraceLog( cRet ) -RETURN cRet + RETURN cRet //--------------------------------------------------------------// FUNCTION PrgExpToVal( cExp ) @@ -261,7 +261,7 @@ FUNCTION ValToArray( xVal ) RETURN xVal ENDIF -RETURN { xVal } + RETURN { xVal } //--------------------------------------------------------------// FUNCTION ValToBlock( xVal ) @@ -270,54 +270,54 @@ FUNCTION ValToBlock( xVal ) RETURN xVal ENDIF -RETURN { || xVal } + RETURN { || xVal } //--------------------------------------------------------------// FUNCTION ValToCharacter( xVal ) - IF ISCHAR( xVal ) + IF HB_ISSTRING( xVal ) RETURN xVal ENDIF -RETURN LTrim( CStr( xVal ) ) + RETURN LTrim( CStr( xVal ) ) //--------------------------------------------------------------// FUNCTION ValToDate( xVal ) SWITCH ValType( xVal ) - CASE 'A' - CASE 'H' - CASE 'L' - CASE 'O' - CASE 'U' - EXIT + CASE 'A' + CASE 'H' + CASE 'L' + CASE 'O' + CASE 'U' + EXIT - CASE 'B' - RETURN ValToDate( Eval( xVal ) ) + CASE 'B' + RETURN ValToDate( Eval( xVal ) ) - CASE 'C' - IF SubStr( DToS( xVal ), 3, 1 ) >= '0' .AND. ; - SubStr( DToS( xVal ), 3, 1 ) <= '9' .AND. ; - SubStr( DToS( xVal ), 5, 1 ) >= '0' .AND. ; - SubStr( DToS( xVal ), 5, 1 ) <= '9' - RETURN hb_SToD( xVal ) - ELSE - RETURN cToD( xVal ) - ENDIF + CASE 'C' + IF SubStr( DToS( xVal ), 3, 1 ) >= '0' .AND. ; + SubStr( DToS( xVal ), 3, 1 ) <= '9' .AND. ; + SubStr( DToS( xVal ), 5, 1 ) >= '0' .AND. ; + SubStr( DToS( xVal ), 5, 1 ) <= '9' + RETURN hb_SToD( xVal ) + ELSE + RETURN cToD( xVal ) + ENDIF - CASE 'D' - RETURN xVal + CASE 'D' + RETURN xVal - CASE 'N' - CASE 'P' - RETURN 0d19000101 + xVal + CASE 'N' + CASE 'P' + RETURN 0d19000101 + xVal - OTHERWISE - Throw( xhb_ErrorNew( "VALTODATE", 0, 3103, ProcName(), "Unsupported type", { xVal } ) ) + OTHERWISE + Throw( xhb_ErrorNew( "VALTODATE", 0, 3103, ProcName(), "Unsupported type", { xVal } ) ) ENDSWITCH -RETURN hb_SToD() + RETURN hb_SToD() //--------------------------------------------------------------// FUNCTION ValToHash( xVal ) @@ -326,169 +326,169 @@ FUNCTION ValToHash( xVal ) RETURN xVal ENDIF -RETURN { ValToCharacter( xVal ) => xVal } + RETURN { ValToCharacter( xVal ) => xVal } //--------------------------------------------------------------// FUNCTION ValToLogical( xVal ) SWITCH ValType( xVal ) - CASE 'A' - CASE 'D' - CASE 'H' - CASE 'N' - CASE 'O' - CASE 'P' + CASE 'A' + CASE 'D' + CASE 'H' + CASE 'N' + CASE 'O' + CASE 'P' + RETURN ! Empty( xVal ) + + CASE 'B' + RETURN ValToLogical( Eval( xVal ) ) + + CASE 'C' + IF Left( xVal, 1 ) == '.' .AND. SubStr( xVal, 3, 1 ) == '.' .AND. Upper( SubStr( xVal, 2, 1 ) ) $ "TFYN" + RETURN Upper( SubStr( xVal, 2, 1 ) ) $ "TY" + ELSEIF Len( xVal ) == 1 .AND. Upper( xVal ) $ "TFYN" + RETURN Upper( xVal ) $ "TY" + ELSE RETURN ! Empty( xVal ) + ENDIF + EXIT - CASE 'B' - RETURN ValToLogical( Eval( xVal ) ) + CASE 'L' + RETURN xVal - CASE 'C' - IF Left( xVal, 1 ) == '.' .AND. SubStr( xVal, 3, 1 ) == '.' .AND. Upper( SubStr( xVal, 2, 1 ) ) $ "TFYN" - RETURN Upper( SubStr( xVal, 2, 1 ) ) $ "TY" - ELSEIF Len( xVal ) == 1 .AND. Upper( xVal ) $ "TFYN" - RETURN Upper( xVal ) $ "TY" - ELSE - RETURN ! Empty( xVal ) - ENDIF - EXIT + CASE 'U' + RETURN .F. - CASE 'L' - RETURN xVal - - CASE 'U' - RETURN .F. - - OTHERWISE - Throw( xhb_ErrorNew( "VALTOLOGICAL", 0, 3103, ProcName(), "Unsupported type", { xVal } ) ) + OTHERWISE + Throw( xhb_ErrorNew( "VALTOLOGICAL", 0, 3103, ProcName(), "Unsupported type", { xVal } ) ) ENDSWITCH -RETURN .F. + RETURN .F. //--------------------------------------------------------------// FUNCTION ValToNumber( xVal ) SWITCH ValType( xVal ) - CASE 'A' - CASE 'H' - RETURN Len( xVal ) + CASE 'A' + CASE 'H' + RETURN Len( xVal ) - CASE 'B' - RETURN ValToNumber( Eval( xVal ) ) + CASE 'B' + RETURN ValToNumber( Eval( xVal ) ) - CASE 'C' - RETURN Val( xVal ) + CASE 'C' + RETURN Val( xVal ) - CASE 'D' - RETURN xVal - 0d19000101 + CASE 'D' + RETURN xVal - 0d19000101 - CASE 'L' - RETURN IIF( xVal, 1, 0 ) + CASE 'L' + RETURN IIF( xVal, 1, 0 ) - CASE 'O' - RETURN xVal:hClass + CASE 'O' + RETURN xVal:hClass - CASE 'N' - RETURN xVal + CASE 'N' + RETURN xVal - CASE 'P' - RETURN xVal - 0 + CASE 'P' + RETURN xVal - 0 - CASE 'U' - RETURN 0 + CASE 'U' + RETURN 0 - OTHERWISE - Throw( xhb_ErrorNew( "VALTONUMBER", 0, 3103, ProcName(), "Unsupported type", { xVal } ) ) + OTHERWISE + Throw( xhb_ErrorNew( "VALTONUMBER", 0, 3103, ProcName(), "Unsupported type", { xVal } ) ) ENDSWITCH -RETURN 0 + RETURN 0 //--------------------------------------------------------------// FUNCTION ValToObject( xVal ) SWITCH ValType( xVal ) - CASE 'A' - ENABLE TYPE CLASS ARRAY - EXIT + CASE 'A' + ENABLE TYPE CLASS ARRAY + EXIT - CASE 'B' - ENABLE TYPE CLASS BLOCK - EXIT + CASE 'B' + ENABLE TYPE CLASS BLOCK + EXIT - CASE 'C' - ENABLE TYPE CLASS CHARACTER - EXIT + CASE 'C' + ENABLE TYPE CLASS CHARACTER + EXIT - CASE 'D' - ENABLE TYPE CLASS DATE - EXIT + CASE 'D' + ENABLE TYPE CLASS DATE + EXIT - CASE 'H' - ENABLE TYPE CLASS HASH - EXIT + CASE 'H' + ENABLE TYPE CLASS HASH + EXIT - CASE 'L' - ENABLE TYPE CLASS LOGICAL - EXIT + CASE 'L' + ENABLE TYPE CLASS LOGICAL + EXIT - CASE 'N' - ENABLE TYPE CLASS NUMERIC - EXIT + CASE 'N' + ENABLE TYPE CLASS NUMERIC + EXIT - CASE 'O' - RETURN xVal + CASE 'O' + RETURN xVal - CASE 'P' - ENABLE TYPE CLASS POINTER - EXIT + CASE 'P' + ENABLE TYPE CLASS POINTER + EXIT - CASE 'U' - ENABLE TYPE CLASS NIL - EXIT + CASE 'U' + ENABLE TYPE CLASS NIL + EXIT - OTHERWISE - Throw( xhb_ErrorNew( "VALTOOBJECT", 0, 3103, ProcName(), "Unsupported type", { xVal } ) ) + OTHERWISE + Throw( xhb_ErrorNew( "VALTOOBJECT", 0, 3103, ProcName(), "Unsupported type", { xVal } ) ) ENDSWITCH -RETURN 0 + RETURN 0 //--------------------------------------------------------------// FUNCTION ValToType( xVal, cType ) SWITCH cType - CASE 'A' - RETURN ValToArray( xVal ) + CASE 'A' + RETURN ValToArray( xVal ) - CASE 'B' - RETURN ValToBlock( xVal ) + CASE 'B' + RETURN ValToBlock( xVal ) - CASE 'C' - RETURN ValToCharacter( xVal ) + CASE 'C' + RETURN ValToCharacter( xVal ) - CASE 'D' - RETURN ValToDate( xVal ) + CASE 'D' + RETURN ValToDate( xVal ) - CASE 'H' - RETURN ValToHash( xVal ) + CASE 'H' + RETURN ValToHash( xVal ) - CASE 'L' - RETURN ValToLogical( xVal ) + CASE 'L' + RETURN ValToLogical( xVal ) - CASE 'N' - RETURN ValToNumber( xVal ) + CASE 'N' + RETURN ValToNumber( xVal ) - CASE 'O' - RETURN ValToObject( xVal ) + CASE 'O' + RETURN ValToObject( xVal ) - CASE 'P' - RETURN ValToNumber( xVal ) + CASE 'P' + RETURN ValToNumber( xVal ) - CASE 'U' - RETURN NIL + CASE 'U' + RETURN NIL - OTHERWISE - Throw( xhb_ErrorNew( "VALTOTYPE", 0, 3103, ProcName(), "Unsupported type", { xVal } ) ) + OTHERWISE + Throw( xhb_ErrorNew( "VALTOTYPE", 0, 3103, ProcName(), "Unsupported type", { xVal } ) ) ENDSWITCH -RETURN NIL + RETURN NIL //--------------------------------------------------------------// diff --git a/harbour/examples/hbvpdf/hbvpdf.prg b/harbour/examples/hbvpdf/hbvpdf.prg index bb721c3ec7..9d6a6623dc 100644 --- a/harbour/examples/hbvpdf/hbvpdf.prg +++ b/harbour/examples/hbvpdf/hbvpdf.prg @@ -2449,7 +2449,7 @@ local cData := valtype(xData) cData += i2bin(len(xData))+xData elseif HB_ISNUMERIC(xData) cData += i2bin(len(alltrim(str(xData))) )+alltrim(str(xData)) - elseif ISDATE(xData) + elseif HB_ISDATE(xData) cData += i2bin(8)+dtos(xData) elseif HB_ISLOGICAL(xData) cData += i2bin(1)+iif(xData,'T','F') diff --git a/harbour/examples/hbvpdf/hbvpdft.prg b/harbour/examples/hbvpdf/hbvpdft.prg index 7a3b173599..7f581346fb 100644 --- a/harbour/examples/hbvpdf/hbvpdft.prg +++ b/harbour/examples/hbvpdf/hbvpdft.prg @@ -2536,7 +2536,7 @@ local cData := valtype(xData) cData += i2bin( len( xData ) ) + xData elseif HB_ISNUMERIC(xData) cData += i2bin( len( alltrim( str( xData ) ) ) ) + alltrim( str( xData ) ) - elseif ISDATE( xData ) + elseif HB_ISDATE( xData ) cData += i2bin( 8 )+dtos(xData) elseif HB_ISLOGICAL(xData) cData += i2bin( 1 )+iif( xData,"T","F" )