fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

2014-06-26 18:42 UTC+0200 Przemyslaw Czerpak (druzus/at/poczta.onet.pl)

Browse Source 
* contrib/hbwin/olecore.c
    + added some additional error codes to win_oleErrorText() function

  * contrib/hbwin/hbole.ch
    + added OLE error code definitions with WIN_* prefix for errors returned
      by win_oleErrorText()

  * contrib/xhb/xhb.hbx
  * contrib/xhb/xhbole.prg
    + aded new function OleDefaultArg()
    % minor simplification

  * src/rtl/itemseri.c
    * do not generate RTE when wrong string is deserialized.
      Now RTE 3016 is generated only when compressed data is deserialized
      and ZLIB is not linked with final binaries so users can easy locate
      the source of problem.

  * src/vm/garbage.c
    % added missing static in s_gcSpinLock declaration

  * src/rtl/hbi18n1.c
    * typo in comment

  * src/rdd/dbf1.c
  * src/rdd/dbffpt/dbffpt1.c
  * src/rdd/dbsql.c
    * formatting

  * src/rdd/usrrdd/rdds/logrdd.prg
  * src/rdd/usrrdd/usrrdd.c
  * src/rtl/checkbox.prg
  * src/rtl/getsys.prg
  * src/rtl/listbox.prg
  * src/rtl/menuto.prg
  * src/rtl/pushbtn.prg
  * src/rtl/radiobtn.prg
  * src/rtl/radiogrp.prg
  * src/rtl/scrollbr.prg
  * src/rtl/tbrowse.prg
  * src/rtl/tget.prg
  * src/rtl/tgetint.prg
  * src/rtl/tgetlist.prg
  * src/rtl/tmenuitm.prg
  * src/rtl/errapi.c
  * src/rtl/hbgtcore.c
  * src/rtl/hbi18n1.c
  * src/rtl/hbinet.c
  * src/rtl/idle.c
  * src/rtl/math.c
  * src/rtl/setkey.c
  * src/vm/asort.c
  * src/vm/hashfunc.c
  * src/vm/thread.c
    * accept any EVAL item not only codeblocks. Actually it means that
      also SYMBOL items are accepted but in the future we may extend it
      and accept also objects of classes with :eval() message.

  * src/rtl/tget.prg
    ! fixed GET default PICTURE for TIMESTAMP type
      fixes https://github.com/harbour/core/issues/65
      2014-05-11 00:05 UTC+0200 Viktor Szakats
    ! fixed GET colors when _SET_INTENSITY == .F.
      2014-04-22 02:35 UTC+0200 Viktor Szakats
    % use Stuff() instead of different combinations of Left() and SubStr()

  * include/harbour.hbx
  * src/rtl/left.c
    + added new function to replace "=" operator without the SET EXACT ambiguity
      in its most common pattern of usage:
         hb_LeftEq( <cString1>, <cString2> ) -> <lResult>
      it's equivalent to this expression, but faster and shorter:
         ( Left( <cString1>, Len( <cString2> ) ) == <cString2> )
      2014-01-22 03:09 UTC+0100 Viktor Szakáts
    + added hb_LeftEqI(). Same as hb_LeftEq() but case-insensitive.
         hb_LeftEqI( <cString1>, <cString2> ) -> <lResult>
      2014-02-04 13:38 UTC+0100 Viktor Szakáts

  * include/harbour.hbx
  * src/rtl/chruni.c
    + added hb_BRAt(). Same as hb_RAt() but for raw/binary strings
      2014-06-25 19:54 UTC+0200 Viktor Szakats

  * contrib/sddsqlt3/core.c
    ! fixed missing first record of query
      2013-11-08 21:43 UTC+0100 Viktor Szakats

  ; many of above modification was borrowed directly or try to follow some
    changes in Viktor's branch - thanks.
This commit is contained in:
Przemysław Czerpak
2014-06-26 18:42:13 +02:00
parent 8505ffa043
commit 97a23295d5
39 changed files with 395 additions and 167 deletions
Download Patch File Download Diff File Expand all files Collapse all files

91
ChangeLog.txt
View File

@@ -10,6 +10,97 @@
* Change, ! Fix, % Optimization, + Addition, - Removal, ; Comment
*/
2014-06-26 18:42 UTC+0200 Przemyslaw Czerpak (druzus/at/poczta.onet.pl)
* contrib/hbwin/olecore.c
+ added some additional error codes to win_oleErrorText() function
* contrib/hbwin/hbole.ch
+ added OLE error code definitions with WIN_* prefix for errors returned
by win_oleErrorText()
* contrib/xhb/xhb.hbx
* contrib/xhb/xhbole.prg
+ aded new function OleDefaultArg()
% minor simplification
* src/rtl/itemseri.c
* do not generate RTE when wrong string is deserialized.
Now RTE 3016 is generated only when compressed data is deserialized
and ZLIB is not linked with final binaries so users can easy locate
the source of problem.
* src/vm/garbage.c
% added missing static in s_gcSpinLock declaration
* src/rtl/hbi18n1.c
* typo in comment
* src/rdd/dbf1.c
* src/rdd/dbffpt/dbffpt1.c
* src/rdd/dbsql.c
* formatting
* src/rdd/usrrdd/rdds/logrdd.prg
* src/rdd/usrrdd/usrrdd.c
* src/rtl/checkbox.prg
* src/rtl/getsys.prg
* src/rtl/listbox.prg
* src/rtl/menuto.prg
* src/rtl/pushbtn.prg
* src/rtl/radiobtn.prg
* src/rtl/radiogrp.prg
* src/rtl/scrollbr.prg
* src/rtl/tbrowse.prg
* src/rtl/tget.prg
* src/rtl/tgetint.prg
* src/rtl/tgetlist.prg
* src/rtl/tmenuitm.prg
* src/rtl/errapi.c
* src/rtl/hbgtcore.c
* src/rtl/hbi18n1.c
* src/rtl/hbinet.c
* src/rtl/idle.c
* src/rtl/math.c
* src/rtl/setkey.c
* src/vm/asort.c
* src/vm/hashfunc.c
* src/vm/thread.c
* accept any EVAL item not only codeblocks. Actually it means that
also SYMBOL items are accepted but in the future we may extend it
and accept also objects of classes with :eval() message.
* src/rtl/tget.prg
! fixed GET default PICTURE for TIMESTAMP type
fixes https://github.com/harbour/core/issues/65
2014-05-11 00:05 UTC+0200 Viktor Szakats
! fixed GET colors when _SET_INTENSITY == .F.
2014-04-22 02:35 UTC+0200 Viktor Szakats
% use Stuff() instead of different combinations of Left() and SubStr()
* include/harbour.hbx
* src/rtl/left.c
+ added new function to replace "=" operator without the SET EXACT ambiguity
in its most common pattern of usage:
hb_LeftEq( <cString1>, <cString2> ) -> <lResult>
it's equivalent to this expression, but faster and shorter:
( Left( <cString1>, Len( <cString2> ) ) == <cString2> )
2014-01-22 03:09 UTC+0100 Viktor Szakáts
+ added hb_LeftEqI(). Same as hb_LeftEq() but case-insensitive.
hb_LeftEqI( <cString1>, <cString2> ) -> <lResult>
2014-02-04 13:38 UTC+0100 Viktor Szakáts
* include/harbour.hbx
* src/rtl/chruni.c
+ added hb_BRAt(). Same as hb_RAt() but for raw/binary strings
2014-06-25 19:54 UTC+0200 Viktor Szakats
* contrib/sddsqlt3/core.c
! fixed missing first record of query
2013-11-08 21:43 UTC+0100 Viktor Szakats
; many of above modification was borrowed directly or try to follow some
changes in Viktor's branch - thanks.
2014-06-16 15:38 UTC+0200 Przemyslaw Czerpak (druzus/at/poczta.onet.pl)
* src/rtl/hbgtcore.c
! fixed typo in previous commit

35
contrib/hbwin/hbole.ch
View File

@@ -104,4 +104,39 @@
#define WIN_VT_ILLEGALMASKED 0x0fff
#define WIN_VT_TYPEMASK 0x0fff
/* errors explicitly recognized by win_oleErrorText() */
#define WIN_CO_E_CLASSSTRING 0x800401F3
#define WIN_OLE_E_WRONGCOMPOBJ 0x8004000E
#define WIN_REGDB_E_WRITEREGDB 0x80040151
#define WIN_REGDB_E_CLASSNOTREG 0x80040154
#define WIN_E_PENDING 0x8000000A
#define WIN_E_NOTIMPL 0x80004001
#define WIN_E_NOINTERFACE 0x80004002
#define WIN_E_POINTER 0x80004003
#define WIN_E_ABORT 0x80004004
#define WIN_E_FAIL 0x80004005
#define WIN_E_UNEXPECTED 0x8000FFFF
#define WIN_E_ACCESSDENIED 0x80070005
#define WIN_E_HANDLE 0x80070006
#define WIN_E_OUTOFMEMORY 0x8007000E
#define WIN_E_INVALIDARG 0x80070057
#define WIN_DISP_E_UNKNOWNINTERFACE 0x80020001
#define WIN_DISP_E_MEMBERNOTFOUND 0x80020003
#define WIN_DISP_E_PARAMNOTFOUND 0x80020004
#define WIN_DISP_E_TYPEMISMATCH 0x80020005
#define WIN_DISP_E_UNKNOWNNAME 0x80020006
#define WIN_DISP_E_NONAMEDARGS 0x80020007
#define WIN_DISP_E_BADVARTYPE 0x80020008
#define WIN_DISP_E_EXCEPTION 0x80020009
#define WIN_DISP_E_OVERFLOW 0x8002000A
#define WIN_DISP_E_BADINDEX 0x8002000B
#define WIN_DISP_E_UNKNOWNLCID 0x8002000C
#define WIN_DISP_E_ARRAYISLOCKED 0x8002000D
#define WIN_DISP_E_BADPARAMCOUNT 0x8002000E
#define WIN_DISP_E_PARAMNOTOPTIONAL 0x8002000F
#define WIN_DISP_E_BADCALLEE 0x80020010
#define WIN_DISP_E_NOTACOLLECTION 0x80020011
#define WIN_DISP_E_DIVBYZERO 0x80020012
#define WIN_DISP_E_BUFFERTOOSMALL 0x80020013
#endif /* HBOLE_CH_ */

33
contrib/hbwin/olecore.c
View File

@@ -1675,22 +1675,35 @@ HB_FUNC( WIN_OLEERRORTEXT )
case OLE_E_WRONGCOMPOBJ: hb_retc_const( "OLE_E_WRONGCOMPOBJ" ); break;
case REGDB_E_CLASSNOTREG: hb_retc_const( "REGDB_E_CLASSNOTREG" ); break;
case REGDB_E_WRITEREGDB: hb_retc_const( "REGDB_E_WRITEREGDB" ); break;
case E_PENDING: hb_retc_const( "E_PENDING" ); break;
case E_NOTIMPL: hb_retc_const( "E_NOTIMPL" ); break;
case E_NOINTERFACE: hb_retc_const( "E_NOINTERFACE" ); break;
case E_POINTER: hb_retc_const( "E_POINTER" ); break;
case E_ABORT: hb_retc_const( "E_ABORT" ); break;
case E_FAIL: hb_retc_const( "E_FAIL" ); break;
case E_UNEXPECTED: hb_retc_const( "E_UNEXPECTED" ); break;
case E_ACCESSDENIED: hb_retc_const( "E_ACCESSDENIED" ); break;
case E_HANDLE: hb_retc_const( "E_HANDLE" ); break;
case E_OUTOFMEMORY: hb_retc_const( "E_OUTOFMEMORY" ); break;
case E_INVALIDARG: hb_retc_const( "E_INVALIDARG" ); break;
case E_UNEXPECTED: hb_retc_const( "E_UNEXPECTED" ); break;
case E_NOTIMPL: hb_retc_const( "E_NOTIMPL" ); break;
case DISP_E_UNKNOWNNAME: hb_retc_const( "DISP_E_UNKNOWNNAME" ); break;
case DISP_E_UNKNOWNLCID: hb_retc_const( "DISP_E_UNKNOWNLCID" ); break;
case DISP_E_BADPARAMCOUNT: hb_retc_const( "DISP_E_BADPARAMCOUNT" ); break;
case DISP_E_BADVARTYPE: hb_retc_const( "DISP_E_BADVARTYPE" ); break;
case DISP_E_EXCEPTION: hb_retc_const( "DISP_E_EXCEPTION" ); break;
case DISP_E_UNKNOWNINTERFACE: hb_retc_const( "DISP_E_UNKNOWNINTERFACE" ); break;
case DISP_E_MEMBERNOTFOUND: hb_retc_const( "DISP_E_MEMBERNOTFOUND" ); break;
case DISP_E_NONAMEDARGS: hb_retc_const( "DISP_E_NONAMEDARGS" ); break;
case DISP_E_OVERFLOW: hb_retc_const( "DISP_E_OVERFLOW" ); break;
case DISP_E_PARAMNOTFOUND: hb_retc_const( "DISP_E_PARAMNOTFOUND" ); break;
case DISP_E_TYPEMISMATCH: hb_retc_const( "DISP_E_TYPEMISMATCH" ); break;
case DISP_E_UNKNOWNINTERFACE: hb_retc_const( "DISP_E_UNKNOWNINTERFACE" ); break;
case DISP_E_UNKNOWNNAME: hb_retc_const( "DISP_E_UNKNOWNNAME" ); break;
case DISP_E_NONAMEDARGS: hb_retc_const( "DISP_E_NONAMEDARGS" ); break;
case DISP_E_BADVARTYPE: hb_retc_const( "DISP_E_BADVARTYPE" ); break;
case DISP_E_EXCEPTION: hb_retc_const( "DISP_E_EXCEPTION" ); break;
case DISP_E_OVERFLOW: hb_retc_const( "DISP_E_OVERFLOW" ); break;
case DISP_E_BADINDEX: hb_retc_const( "DISP_E_BADINDEX" ); break;
case DISP_E_UNKNOWNLCID: hb_retc_const( "DISP_E_UNKNOWNLCID" ); break;
case DISP_E_ARRAYISLOCKED: hb_retc_const( "DISP_E_ARRAYISLOCKED" ); break;
case DISP_E_BADPARAMCOUNT: hb_retc_const( "DISP_E_BADPARAMCOUNT" ); break;
case DISP_E_PARAMNOTOPTIONAL: hb_retc_const( "DISP_E_PARAMNOTOPTIONAL" ); break;
case DISP_E_BADCALLEE: hb_retc_const( "DISP_E_BADCALLEE" ); break;
case DISP_E_NOTACOLLECTION: hb_retc_const( "DISP_E_NOTACOLLECTION" ); break;
case DISP_E_DIVBYZERO: hb_retc_const( "DISP_E_DIVBYZERO" ); break;
case DISP_E_BUFFERTOOSMALL: hb_retc_const( "DISP_E_BUFFERTOOSMALL" ); break;
default:
{
char buf[ 16 ];

13
contrib/sddsqlt3/core.c
View File

@@ -436,12 +436,6 @@ static HB_ERRCODE sqlite3GoTo( SQLBASEAREAP pArea, HB_ULONG ulRecNo )
PHB_ITEM pArray;
HB_USHORT ui;
if( sqlite3_step( st ) != SQLITE_ROW )
{
pArea->fFetched = HB_TRUE;
break;
}
pArray = hb_itemArrayNew( pArea->area.uiFieldCount );
for( ui = 0; ui < pArea->area.uiFieldCount; ++ui )
@@ -488,6 +482,13 @@ static HB_ERRCODE sqlite3GoTo( SQLBASEAREAP pArea, HB_ULONG ulRecNo )
pArea->ulRecCount++;
pArea->pRow[ pArea->ulRecCount ] = pArray;
pArea->pRowFlags[ pArea->ulRecCount ] = SQLDD_FLAG_CACHED;
if( sqlite3_step( st ) != SQLITE_ROW )
{
pArea->fFetched = HB_TRUE;
break;
}
}
if( ulRecNo == 0 || ulRecNo > pArea->ulRecCount )

1
contrib/xhb/xhb.hbx
View File

@@ -332,6 +332,7 @@ DYNAMIC NumToHex
DYNAMIC NumXorX
DYNAMIC Occurs
DYNAMIC Ole2txtError
DYNAMIC OleDefaultArg
DYNAMIC OleError
DYNAMIC os_IsWin2000
DYNAMIC os_IsWin2000_Or_Later

32
contrib/xhb/xhbole.prg
View File

@@ -61,6 +61,9 @@ FUNCTION GetActiveObject()
FUNCTION CreateOleObject()
RETURN NIL
FUNCTION OleDefaultArg()
RETURN NIL
#else
@@ -70,6 +73,8 @@ FUNCTION CreateOleObject()
#include "error.ch"
#include "hbole.ch"
#define EG_OLEEXCEPTION 1001
#define DISPID_VALUE 0
@@ -181,13 +186,11 @@ METHOD New( xOle, cClass, cLicense ) CLASS TOleAuto
LOCAL hOle
IF HB_ISSTRING( xOle )
hOle := __oleCreateObject( xOle,, cLicense )
IF ! Empty( hOle )
::__hObj := hOle
::cClassName := xOle
ELSE
IF Empty( hOle := __oleCreateObject( xOle,, cLicense ) )
RETURN Throw( s_oleError() )
ENDIF
::__hObj := hOle
::cClassName := xOle
ELSE
::hObj := xOle
IF ::__hObj == NIL
@@ -204,11 +207,10 @@ METHOD New( xOle, cClass, cLicense ) CLASS TOleAuto
METHOD GetActiveObject( cClass ) CLASS TOleAuto
IF HB_ISSTRING( cClass )
IF ! Empty( ::__hObj := __oleGetActiveObject( cClass ) )
::cClassName := cClass
ELSE
IF Empty( ::__hObj := __oleGetActiveObject( cClass ) )
RETURN Throw( s_oleError() )
ENDIF
::cClassName := cClass
ELSE
wapi_MessageBox( , "Invalid parameter type to constructor TOleAuto():GetActiveObject()!", ;
"OLE Interface", )
@@ -234,28 +236,17 @@ METHOD _OleValue( xValue ) CLASS TOleAuto
RETURN xRet
OLE OPERATOR "==" METHOD OleValueExactEqual WITH xArg IS ::OleValue == xArg
OLE OPERATOR "=" METHOD OleValueEqual WITH xArg IS ::OleValue = xArg
OLE OPERATOR "!=" METHOD OleValueNotEqual WITH xArg IS ::OleValue != xArg /* Intentionally using != operator */
OLE OPERATOR "+" METHOD OleValuePlus WITH xArg IS ::OleValue + xArg
OLE OPERATOR "-" METHOD OleValueMinus WITH xArg IS ::OleValue - xArg
OLE OPERATOR "*" METHOD OleValueMultiply WITH xArg IS ::OleValue * xArg
OLE OPERATOR "/" METHOD OleValueDivide WITH xArg IS ::OleValue / xArg
OLE OPERATOR "%" METHOD OleValueModulus WITH xArg IS ::OleValue % xArg
OLE OPERATOR "^" METHOD OleValuePower WITH xArg IS ::OleValue ^ xArg
OLE OPERATOR "++" METHOD OleValueInc IS ++::OleValue
OLE OPERATOR "--" METHOD OleValueDec IS --::OleValue
FUNCTION CreateObject( xOle, cLicense )
RETURN TOleAuto():New( xOle,, cLicense )
@@ -265,4 +256,7 @@ FUNCTION GetActiveObject( cString )
FUNCTION CreateOleObject( ... )
RETURN __oleCreateObject( ... )
FUNCTION OleDefaultArg()
RETURN __oleVariantNew( WIN_VT_ERROR, WIN_DISP_E_PARAMNOTFOUND )
#endif /* __PLATFORM__WINDOWS */

5
include/harbour.hbx
View File

@@ -325,6 +325,7 @@ DYNAMIC hb_blowfishEncrypt_CFB
DYNAMIC hb_blowfishKey
DYNAMIC hb_BPeek
DYNAMIC hb_BPoke
DYNAMIC hb_BRAt
DYNAMIC hb_BRight
DYNAMIC hb_BSubStr
DYNAMIC hb_BuildDate
@@ -648,6 +649,8 @@ DYNAMIC hb_langErrMsg
DYNAMIC hb_langMessage
DYNAMIC hb_langName
DYNAMIC hb_langNew
DYNAMIC hb_LeftEq
DYNAMIC hb_LeftEqI
DYNAMIC hb_langSelect
DYNAMIC hb_libError
DYNAMIC hb_libExt
@@ -1332,7 +1335,7 @@ DYNAMIC __dbArrange
DYNAMIC __dbClearIndex
DYNAMIC __dbClearRelation
DYNAMIC __dbClose
DYNAMIC __dbClosearea
DYNAMIC __dbCloseArea
DYNAMIC __dbCommit
DYNAMIC __dbCommitAll
DYNAMIC __dbContinue

2
src/rdd/dbf1.c
View File

@@ -4200,7 +4200,7 @@ static HB_ERRCODE hb_dbfOpen( DBFAREAP pArea, LPDBOPENINFO pOpenInfo )
for( uiCount = 0; uiCount < uiFields + uiSkip; uiCount++ )
{
pField = ( LPDBFFIELD ) ( pBuffer + uiCount * sizeof( DBFFIELD ) );
pField->bName[10] = '\0';
pField->bName[ 10 ] = '\0';
/* hb_strupp( ( char * ) pField->bName ); */
dbFieldInfo.atomName = ( const char * ) pField->bName;
dbFieldInfo.uiLen = pField->bLen;

2
src/rdd/dbffpt/dbffpt1.c
View File

@@ -2465,7 +2465,7 @@ static HB_ERRCODE hb_fptReadFlexItem( FPTAREAP pArea, HB_BYTE ** pbMemoBuf, HB_B
}
break;
default:
/* fprintf(stderr,"Uknown FLEX array item: 0x%x = %d\n", usType, usType); fflush(stderr); */
/* fprintf( stderr, "Uknown FLEX array item: 0x%x = %d\n", usType, usType ); fflush( stderr ); */
errCode = EDBF_CORRUPT;
hb_itemClear( pItem );
break;

6
src/rdd/dbsql.c
View File

@@ -171,11 +171,11 @@ static HB_BOOL hb_exportBufSqlVar( PHB_FILEBUF pFileBuf, PHB_ITEM pValue,
}
else
{
hb_addStrnToFBuffer( pFileBuf, &szDate[0], 4 );
hb_addStrnToFBuffer( pFileBuf, &szDate[ 0 ], 4 );
hb_addToFBuffer( pFileBuf, '-' );
hb_addStrnToFBuffer( pFileBuf, &szDate[4], 2 );
hb_addStrnToFBuffer( pFileBuf, &szDate[ 4 ], 2 );
hb_addToFBuffer( pFileBuf, '-' );
hb_addStrnToFBuffer( pFileBuf, &szDate[6], 2 );
hb_addStrnToFBuffer( pFileBuf, &szDate[ 6 ], 2 );
}
hb_addStrToFBuffer( pFileBuf, szDelim );
break;

8
src/rdd/usrrdd/rdds/logrdd.prg
View File

@@ -315,7 +315,7 @@ FUNCTION hb_LogRddMsgLogBlock( bMsgLogBlock )
bOldMsgLogBlock := aRDDData[ ARRAY_MSGLOGBLOCK ]
IF HB_ISBLOCK( bMsgLogBlock )
IF HB_ISEVALITEM( bMsgLogBlock )
aRDDData[ ARRAY_MSGLOGBLOCK ] := bMsgLogBlock
ENDIF
@@ -334,7 +334,7 @@ FUNCTION hb_LogRddUserLogBlock( bUserLogBlock )
bOldUserLogBlock := aRDDData[ ARRAY_MSGLOGBLOCK ]
IF HB_ISBLOCK( bUserLogBlock )
IF HB_ISEVALITEM( bUserLogBlock )
aRDDData[ ARRAY_USERLOGBLOCK ] := bUserLogBlock
ENDIF
@@ -455,7 +455,7 @@ STATIC PROCEDURE ToLog( cCmd, nWA, xPar1, xPar2, xPar3 )
bUserLogBlock := aRDDData[ ARRAY_USERLOGBLOCK ]
// If not defined a User codeblock
IF ! HB_ISBLOCK( bUserLogBlock )
IF ! HB_ISEVALITEM( bUserLogBlock )
nHandle := aRDDData[ ARRAY_FHANDLE ]
@@ -470,7 +470,7 @@ STATIC PROCEDURE ToLog( cCmd, nWA, xPar1, xPar2, xPar3 )
// If defined a codeblock I send to user infos and he has to return a formatted string
// Look at local ToString() function for details
IF HB_ISBLOCK( bMsgLogBlock )
IF HB_ISEVALITEM( bMsgLogBlock )
cLog := Eval( bMsgLogBlock, cTag, cRDDName, cCmd, nWA, xPar1, xPar2, xPar3 )
ELSE
cLog := DToS( Date() ) + " " + Time() + " " + cTag + ": " + PadR( cRDDName + "_" + cCmd, 20 ) + " - " + ToString( cCmd, nWA, xPar1, xPar2, xPar3 )

2
src/rdd/usrrdd/usrrdd.c
View File

@@ -90,7 +90,7 @@ static HB_BOOL hb_usrIsMethod( PHB_ITEM pMethods, HB_USHORT uiMethod )
{
PHB_ITEM pItem = hb_arrayGetItemPtr( pMethods, uiMethod );
return pItem && ( HB_IS_SYMBOL( pItem ) || HB_IS_BLOCK( pItem ) );
return pItem && HB_IS_EVALITEM( pItem );
}
static HB_BOOL hb_usrPushMethod( PHB_ITEM pMethods, HB_USHORT uiMethod )

6
src/rtl/checkbox.prg
View File

@@ -117,7 +117,7 @@ METHOD setFocus() CLASS CheckBox
::lHasFocus := .T.
::display()
IF HB_ISBLOCK( ::bFBlock )
IF HB_ISEVALITEM( ::bFBlock )
Eval( ::bFBlock )
ENDIF
ENDIF
@@ -133,7 +133,7 @@ METHOD select( lState ) CLASS CheckBox
IF lOldState != ::lBuffer
::display()
IF HB_ISBLOCK( ::bSBlock )
IF HB_ISEVALITEM( ::bSBlock )
Eval( ::bSBlock )
ENDIF
ENDIF
@@ -145,7 +145,7 @@ METHOD killFocus() CLASS CheckBox
IF ::lHasFocus
::lHasFocus := .F.
IF HB_ISBLOCK( ::bFBlock )
IF HB_ISEVALITEM( ::bFBlock )
Eval( ::bFBlock )
ENDIF

54
src/rtl/chruni.c
View File

@@ -559,3 +559,57 @@ HB_FUNC( HB_BAT )
else
hb_errRT_BASE_SubstR( EG_ARG, 1108, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
}
/* hb_BRAt( <cSubString>, <cString>, [<nFrom>], [<nTo>] ) -> <nAt>
*/
HB_FUNC( HB_BRAT )
{
HB_SIZE nSubLen = hb_parclen( 1 );
HB_SIZE nPos = 0;
if( nSubLen )
{
HB_SIZE nLen = hb_parclen( 2 );
HB_ISIZ nTo = nLen - nSubLen;
if( nTo >= 0 )
{
const char * pszSub = hb_parc( 1 );
const char * pszText = hb_parc( 2 );
HB_ISIZ nStart = hb_parns( 3 );
HB_ISIZ nFrom;
if( nStart <= 1 )
nFrom = 0;
else
nFrom = --nStart;
if( nTo >= nFrom )
{
if( HB_ISNUM( 4 ) )
{
HB_ISIZ nEnd = hb_parns( 4 ) - nSubLen;
if( nEnd < nTo )
nTo = nEnd;
}
if( nTo >= nFrom )
{
do
{
if( pszText[ nTo ] == *pszSub &&
memcmp( pszSub, pszText + nTo, nSubLen ) == 0 )
{
nPos = nTo + 1;
break;
}
}
while( --nTo >= nFrom );
}
}
}
}
hb_retns( nPos );
}

6
src/rtl/errapi.c
View File

@@ -454,7 +454,7 @@ HB_FUNC( __ERRINHANDLER )
HB_FUNC( ERRORBLOCK )
{
PHB_ITEM pNewErrorBlock = hb_param( 1, HB_IT_BLOCK );
PHB_ITEM pNewErrorBlock = hb_param( 1, HB_IT_EVALITEM );
PHB_ITEM pErrorBlock = hb_errorBlock();
hb_itemReturn( pErrorBlock );
@@ -543,7 +543,7 @@ HB_USHORT hb_errLaunch( PHB_ITEM pError )
PHB_ITEM pResult;
/* Check if we have a valid error handler */
if( ! pErrData->errorBlock || hb_itemType( pErrData->errorBlock ) != HB_IT_BLOCK )
if( ! pErrData->errorBlock || ! HB_IS_EVALITEM( pErrData->errorBlock ) )
hb_errInternal( HB_EI_ERRNOBLOCK, NULL, NULL, NULL );
/* Check if the error launcher was called too many times recursively */
@@ -637,7 +637,7 @@ PHB_ITEM hb_errLaunchSubst( PHB_ITEM pError )
HB_USHORT uiFlags = hb_errGetFlags( pError );
/* Check if we have a valid error handler */
if( ! pErrData->errorBlock || hb_itemType( pErrData->errorBlock ) != HB_IT_BLOCK )
if( ! pErrData->errorBlock || ! HB_IS_EVALITEM( pErrData->errorBlock ) )
hb_errInternal( HB_EI_ERRNOBLOCK, NULL, NULL, NULL );
/* Check if the error launcher was called too many times recursively */

2
src/rtl/getsys.prg
View File

@@ -287,7 +287,7 @@ PROCEDURE __SetFormat( bFormat )
LOCAL oGetList := __GetListActive()
IF oGetList != NIL
IF HB_ISBLOCK( bFormat )
IF HB_ISEVALITEM( bFormat )
oGetList:SetFormat( bFormat )
ELSE
oGetList:SetFormat()

2
src/rtl/hbgtcore.c
View File

@@ -1780,7 +1780,7 @@ static void hb_gt_def_SetBlock( PHB_ITEM * pItemPtr, PHB_GT_INFO pInfo )
hb_itemRelease( *pItemPtr );
*pItemPtr = NULL;
}
if( hb_itemType( pInfo->pNewVal ) & HB_IT_BLOCK )
if( HB_IS_EVALITEM( pInfo->pNewVal ) )
{
*pItemPtr = hb_itemNew( pInfo->pNewVal );
hb_gcUnlock( *pItemPtr );

6
src/rtl/hbi18n1.c
View File

@@ -596,7 +596,7 @@ static HB_BOOL hb_i18n_setpluralform( PHB_I18N_TRANS pI18N, PHB_ITEM pForm,
if( pI18N && pForm )
{
if( HB_IS_BLOCK( pForm ) )
if( HB_IS_EVALITEM( pForm ) )
{
if( fBase )
{
@@ -993,7 +993,7 @@ HB_FUNC( HB_I18N_PLURALFORM )
if( pI18N )
{
PHB_ITEM pOldForm = hb_itemNew( NULL );
PHB_ITEM pForm = hb_param( iParam, HB_IT_STRING | HB_IT_BLOCK );
PHB_ITEM pForm = hb_param( iParam, HB_IT_STRING | HB_IT_EVALITEM );
HB_BOOL fBase = hb_parl( iParam + 1 );
if( hb_i18n_getpluralform( pI18N, pOldForm, fBase ) )
@@ -1121,7 +1121,7 @@ HB_FUNC( HB_I18N_CHECK )
hb_retl( hb_i18n_headercheck( hb_parc( 1 ), hb_parclen( 1 ) ) );
}
/* unoffical function to access ineternal hash table used by i18n set */
/* unofficial function to access internal hash table used by i18n set */
HB_FUNC( __I18N_HASHTABLE )
{
PHB_I18N_TRANS pI18N;

2
src/rtl/hbinet.c
View File

@@ -499,7 +499,7 @@ HB_FUNC( HB_INETPERIODCALLBACK )
if( socket )
{
PHB_ITEM pExec = hb_param( 2, HB_IT_ARRAY | HB_IT_BLOCK | HB_IT_SYMBOL );
PHB_ITEM pExec = hb_param( 2, HB_IT_ARRAY | HB_IT_EVALITEM );
if( socket->pPeriodicBlock )
hb_itemReturn( socket->pPeriodicBlock );

2
src/rtl/idle.c
View File

@@ -182,7 +182,7 @@ HB_FUNC( HB_IDLESLEEP )
/* add a new background task and return its handle */
HB_FUNC( HB_IDLEADD )
{
PHB_ITEM pBlock = hb_param( 1, HB_IT_BLOCK );
PHB_ITEM pBlock = hb_param( 1, HB_IT_EVALITEM );
if( pBlock )
{

39
src/rtl/itemseri.c
View File

@@ -1471,24 +1471,33 @@ static HB_SIZE hb_deserializeItem( PHB_ITEM pItem,
nLen = HB_GET_LE_UINT32( &pBuffer[ nOffset ] );
nOffset += 4;
szVal = ( char * ) hb_xgrab( nLen + 1 );
if( hb_zlibUncompress( szVal, &nLen, ( const char * ) &pBuffer[ nOffset ],
nSize ) == HB_ZLIB_RES_OK )
switch( hb_zlibUncompress( szVal, &nLen,
( const char * ) &pBuffer[ nOffset ], nSize ) )
{
PHB_CYCLIC_REF pRefZ = NULL;
pBuffer = ( const HB_UCHAR * ) szVal;
if( hb_deserializeTest( &pBuffer, &nLen, 0, &pRefZ ) )
hb_deserializeItem( pItem, cdpIn, cdpOut, ( const HB_UCHAR * ) szVal, 0, pRefZ );
else
case HB_ZLIB_RES_OK:
{
PHB_CYCLIC_REF pRefZ = NULL;
pBuffer = ( const HB_UCHAR * ) szVal;
if( hb_deserializeTest( &pBuffer, &nLen, 0, &pRefZ ) )
hb_deserializeItem( pItem, cdpIn, cdpOut, ( const HB_UCHAR * ) szVal, 0, pRefZ );
else
hb_itemClear( pItem );
hb_itemSerialRefFree( pRefZ );
break;
}
case HB_ZLIB_RES_UNSUPPORTED:
if( hb_vmRequestQuery() == 0 )
{
hb_itemPutCLPtr( pItem, szVal, nLen );
hb_errRT_BASE_Ext1( EG_ARG, 3016, NULL, HB_ERR_FUNCNAME, 0, EF_CANDEFAULT, 1, pItem );
szVal = NULL;
}
/* no break; */
default:
hb_itemClear( pItem );
hb_itemSerialRefFree( pRefZ );
}
else if( hb_vmRequestQuery() == 0 )
{
hb_itemPutCLPtr( pItem, szVal, nLen );
hb_errRT_BASE_Ext1( EG_ARG, 3012, NULL, HB_ERR_FUNCNAME, 0, EF_CANDEFAULT, 1, pItem );
hb_itemClear( pItem );
szVal = NULL;
}
if( szVal )
hb_xfree( szVal );
nOffset += nSize;

24
src/rtl/left.c
View File

@@ -81,3 +81,27 @@ HB_FUNC( LEFT )
else
hb_errRT_BASE_SubstR( EG_ARG, 1124, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
}
HB_FUNC( HB_LEFTEQ )
{
PHB_ITEM pItem1 = hb_param( 1, HB_IT_STRING );
PHB_ITEM pItem2 = hb_param( 2, HB_IT_STRING );
if( pItem1 && pItem2 )
hb_retl( hb_cdpcmp( hb_itemGetCPtr( pItem1 ), hb_itemGetCLen( pItem1 ),
hb_itemGetCPtr( pItem2 ), hb_itemGetCLen( pItem2 ), hb_vmCDP(), HB_FALSE ) == 0 );
else
hb_errRT_BASE_SubstR( EG_ARG, 1071, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
}
HB_FUNC( HB_LEFTEQI )
{
PHB_ITEM pItem1 = hb_param( 1, HB_IT_STRING );
PHB_ITEM pItem2 = hb_param( 2, HB_IT_STRING );
if( pItem1 && pItem2 )
hb_retl( hb_cdpicmp( hb_itemGetCPtr( pItem1 ), hb_itemGetCLen( pItem1 ),
hb_itemGetCPtr( pItem2 ), hb_itemGetCLen( pItem2 ), hb_vmCDP(), HB_FALSE ) == 0 );
else
hb_errRT_BASE_SubstR( EG_ARG, 1071, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
}

14
src/rtl/listbox.prg
View File

@@ -188,7 +188,7 @@ METHOD close() CLASS ListBox
RETURN Self
METHOD delItem( nPos )
METHOD delItem( nPos ) CLASS ListBox
IF nPos >= 1 .AND. nPos <= ::nItemCount
@@ -485,7 +485,7 @@ METHOD hitTest( nMRow, nMCol ) CLASS ListBox
RETURN 0
METHOD insItem( nPos, cText, cData )
METHOD insItem( nPos, cText, cData ) CLASS ListBox
IF HB_ISSTRING( cText ) .AND. ;
HB_ISNUMERIC( nPos ) .AND. ;
@@ -512,7 +512,7 @@ METHOD killFocus() CLASS ListBox
IF ::lHasFocus
::lHasFocus := .F.
IF HB_ISBLOCK( ::bFBlock )
IF HB_ISEVALITEM( ::bFBlock )
Eval( ::bFBlock )
ENDIF
@@ -732,7 +732,7 @@ METHOD select( xPos ) CLASS ListBox
::display()
IF HB_ISBLOCK( ::bSBlock )
IF HB_ISEVALITEM( ::bSBlock )
Eval( ::bSBlock )
ENDIF
@@ -755,7 +755,7 @@ METHOD setFocus() CLASS ListBox
::display()
IF HB_ISBLOCK( ::bFBlock )
IF HB_ISEVALITEM( ::bFBlock )
Eval( ::bFBlock )
ENDIF
@@ -818,7 +818,7 @@ METHOD changeItem( nOldPos, nNewPos ) CLASS ListBox
::display()
IF HB_ISBLOCK( ::bSBlock )
IF HB_ISEVALITEM( ::bSBlock )
Eval( ::bSBlock )
ENDIF
ENDIF
@@ -1043,7 +1043,7 @@ METHOD vScroll( oVScroll ) CLASS ListBox
/* -------------------------------------------- */
METHOD New( nTop, nLeft, nBottom, nRight, lDropDown )
METHOD New( nTop, nLeft, nBottom, nRight, lDropDown ) CLASS ListBox
LOCAL cColor

2
src/rtl/math.c
View File

@@ -606,7 +606,7 @@ HB_FUNC( HB_MATHERBLOCK ) /* ([<nNewErrorBlock>]) -> <nOldErrorBlock> */
if( hb_pcount() > 0 )
{
/* set new error block */
PHB_ITEM pNewErrorBlock = hb_param( 1, HB_IT_BLOCK );
PHB_ITEM pNewErrorBlock = hb_param( 1, HB_IT_EVALITEM );
if( pNewErrorBlock )
{

2
src/rtl/menuto.prg
View File

@@ -126,7 +126,7 @@ FUNCTION __MenuTo( bBlock, cVariable )
xMsg := t_aLevel[ nPointer - 1, n, 4 ]
// Code Block messages ( yes, they are documented! )
IF HB_ISBLOCK( xMsg )
IF HB_ISEVALITEM( xMsg )
xMsg := Eval( xMsg )
ENDIF

8
src/rtl/pushbtn.prg
View File

@@ -118,7 +118,7 @@ METHOD setFocus() CLASS PushButton
::lHasFocus := .T.
::display()
IF HB_ISBLOCK( ::bFBlock )
IF HB_ISEVALITEM( ::bFBlock )
Eval( ::bFBlock )
ENDIF
ENDIF
@@ -147,7 +147,7 @@ METHOD select( nPos ) CLASS PushButton
ENDIF
ENDIF
IF HB_ISBLOCK( ::bSBlock )
IF HB_ISEVALITEM( ::bSBlock )
Eval( ::bSBlock )
ENDIF
@@ -162,7 +162,7 @@ METHOD killFocus() CLASS PushButton
IF ::lHasFocus
::lHasFocus := .F.
IF HB_ISBLOCK( ::bFBlock )
IF HB_ISEVALITEM( ::bFBlock )
Eval( ::bFBlock )
ENDIF
@@ -281,7 +281,7 @@ METHOD col( nCol ) CLASS PushButton
METHOD colorSpec( cColorSpec ) CLASS PushButton
IF cColorSpec != NIL
::cColorSpec := __eInstVar53( Self, "COLORSPEC", cColorSpec, "C", 1001,;
::cColorSpec := __eInstVar53( Self, "COLORSPEC", cColorSpec, "C", 1001, ;
{|| ! Empty( hb_ColorIndex( cColorSpec, 3 ) ) .AND. Empty( hb_ColorIndex( cColorSpec, 5 ) ) } )
ENDIF

6
src/rtl/radiobtn.prg
View File

@@ -113,7 +113,7 @@ METHOD setFocus() CLASS RadioButtn
::lHasFocus := .T.
::display()
IF HB_ISBLOCK( ::bFBlock )
IF HB_ISEVALITEM( ::bFBlock )
Eval( ::bFBlock )
ENDIF
ENDIF
@@ -127,7 +127,7 @@ METHOD select( lState ) CLASS RadioButtn
::lBuffer := iif( HB_ISLOGICAL( lState ), lState, ! ::lBuffer )
IF lOldState != ::lBuffer .AND. ;
HB_ISBLOCK( ::bSBlock )
HB_ISEVALITEM( ::bSBlock )
Eval( ::bSBlock )
ENDIF
@@ -139,7 +139,7 @@ METHOD killFocus() CLASS RadioButtn
IF ::lHasFocus
::lHasFocus := .F.
IF HB_ISBLOCK( ::bFBlock )
IF HB_ISEVALITEM( ::bFBlock )
Eval( ::bFBlock )
ENDIF

4
src/rtl/radiogrp.prg
View File

@@ -313,7 +313,7 @@ METHOD killFocus() CLASS RadioGroup
::lHasFocus := .F.
IF HB_ISBLOCK( ::bFBlock )
IF HB_ISEVALITEM( ::bFBlock )
Eval( ::bFBlock )
ENDIF
@@ -361,7 +361,7 @@ METHOD setFocus() CLASS RadioGroup
MSetCursor( nOldMCur )
IF HB_ISBLOCK( ::bFBlock )
IF HB_ISEVALITEM( ::bFBlock )
Eval( ::bFBlock )
ENDIF
ENDIF

4
src/rtl/scrollbr.prg
View File

@@ -158,7 +158,7 @@ METHOD update() CLASS ScrollBar
LOCAL nOldThumbPos := ::nThumbPos
IF HB_ISBLOCK( ::bSBlock )
IF HB_ISEVALITEM( ::bSBlock )
Eval( ::bSBlock )
ENDIF
@@ -312,7 +312,7 @@ METHOD orient( nOrient ) CLASS ScrollBar
METHOD sBlock( bSBlock ) CLASS ScrollBar
IF HB_ISBLOCK( bSBlock )
IF HB_ISEVALITEM( bSBlock )
::bSBlock := bSBlock
ENDIF

12
src/rtl/setkey.c
View File

@@ -113,9 +113,9 @@ static void sk_add( PHB_SETKEY * sk_list_ptr, HB_BOOL bReturn,
{
PHB_SETKEY sk_list_tmp, sk_list_end;
if( pIsActive && ! HB_IS_BLOCK( pIsActive ) )
if( pIsActive && ! HB_IS_EVALITEM( pIsActive ) )
pIsActive = NULL;
if( pAction && ! HB_IS_BLOCK( pAction ) )
if( pAction && ! HB_IS_EVALITEM( pAction ) )
pAction = NULL;
sk_list_tmp = sk_findkey( iKeyCode, *sk_list_ptr, &sk_list_end );
@@ -198,7 +198,7 @@ HB_FUNC( SETKEY )
{
/* Set a SETKEY value */
sk_add( &sk_data->sk_list, HB_TRUE, hb_itemGetNI( pKeyCode ),
hb_param( 2, HB_IT_BLOCK ), NULL );
hb_param( 2, HB_IT_EVALITEM ), NULL );
}
}
}
@@ -231,7 +231,7 @@ HB_FUNC( HB_SETKEY )
{
/* Set a SETKEY value */
sk_add( &sk_data->sk_list, HB_TRUE, hb_itemGetNI( pKeyCode ),
hb_param( 2, HB_IT_BLOCK ), hb_param( 3, HB_IT_BLOCK ) );
hb_param( 2, HB_IT_EVALITEM ), hb_param( 3, HB_IT_EVALITEM ) );
}
}
}
@@ -241,12 +241,12 @@ HB_FUNC( HB_SETKEY )
HB_FUNC( HB_SETKEYARRAY )
{
PHB_ITEM pKeyCodeArray = hb_param( 1, HB_IT_ARRAY );
PHB_ITEM pAction = hb_param( 2, HB_IT_BLOCK );
PHB_ITEM pAction = hb_param( 2, HB_IT_EVALITEM );
if( pKeyCodeArray && pAction )
{
PHB_SK_DATA sk_data = ( PHB_SK_DATA ) hb_stackGetTSD( &s_skData );
PHB_ITEM pIsActive = hb_param( 3, HB_IT_BLOCK );
PHB_ITEM pIsActive = hb_param( 3, HB_IT_EVALITEM );
HB_SIZE nLen = hb_arrayLen( pKeyCodeArray );
HB_SIZE nPos;

4
src/rtl/tbrowse.prg
View File

@@ -2649,11 +2649,11 @@ METHOD setKey( nKey, bBlock ) CLASS TBrowse
ENDIF
IF ( nPos := AScan( ::keys, {| x | x[ _TBC_SETKEY_KEY ] == nKey } ) ) == 0
IF HB_ISBLOCK( bBlock )
IF HB_ISEVALITEM( bBlock )
AAdd( ::keys, { nKey, bBlock } )
ENDIF
bReturn := bBlock
ELSEIF HB_ISBLOCK( bBlock )
ELSEIF HB_ISEVALITEM( bBlock )
::keys[ nPos ][ _TBC_SETKEY_BLOCK ] := bBlock
bReturn := bBlock
ELSEIF PCount() == 1

75
src/rtl/tget.prg
View File

@@ -273,7 +273,7 @@ METHOD display() CLASS Get
/* Display "-." only in case when value on the left side of
the decimal point is equal 0 */
cBuffer := SubStr( cBuffer, 1, ::decPos - 2 ) + "-." + SubStr( cBuffer, ::decPos + 1 )
cBuffer := Stuff( cBuffer, ::decPos - 1, 2, "-." )
ENDIF
IF ::nDispLen != ::nMaxLen .AND. ::nPos != 0 /* has scroll? */
@@ -324,7 +324,7 @@ METHOD display() CLASS Get
IF ! ::lSuppDisplay .OR. nDispPos != ::nOldPos
hb_DispOutAt( ::nRow, ::nCol, ;
iif( ::lHideInput, PadR( Replicate( SubStr( ::cStyle, 1, 1 ), Len( RTrim( cBuffer ) ) ), ::nDispLen ), SubStr( cBuffer, nDispPos, ::nDispLen ) ), ;
iif( ::lHideInput, PadR( Replicate( Left( ::cStyle, 1 ), Len( RTrim( cBuffer ) ) ), ::nDispLen ), SubStr( cBuffer, nDispPos, ::nDispLen ) ), ;
hb_ColorIndex( ::cColorSpec, iif( ::hasFocus, GET_CLR_ENHANCED, GET_CLR_UNSELECTED ) ) )
nRowPos := ::nRow
@@ -501,7 +501,7 @@ METHOD varPut( xValue ) CLASS Get
LOCAL i
LOCAL aValue
IF HB_ISBLOCK( ::bBlock ) .AND. ValType( xValue ) $ "CNDTLU"
IF HB_ISEVALITEM( ::bBlock ) .AND. ValType( xValue ) $ "CNDTLU"
aSubs := ::xSubScript
IF HB_ISARRAY( aSubs ) .AND. ! Empty( aSubs )
nLen := Len( aSubs )
@@ -534,7 +534,7 @@ METHOD varGet() CLASS Get
LOCAL i
LOCAL xValue
IF HB_ISBLOCK( ::bBlock )
IF HB_ISEVALITEM( ::bBlock )
aSubs := ::xSubScript
IF HB_ISARRAY( aSubs ) .AND. ! Empty( aSubs )
nLen := Len( aSubs )
@@ -594,7 +594,7 @@ METHOD overStrike( cChar ) CLASS Get
IF ::nPos > ::nMaxEdit
::pos := ::FirstEditable()
ENDIF
::cBuffer := SubStr( ::cBuffer, 1, ::nPos - 1 ) + cChar + SubStr( ::cBuffer, ::nPos + 1 )
::cBuffer := Stuff( ::cBuffer, ::nPos, 1, cChar )
::lChanged := .T.
@@ -659,11 +659,10 @@ METHOD insert( cChar ) CLASS Get
ENDIF
NEXT
nMaxEdit := nFor
::cBuffer := Left( SubStr( ::cBuffer, 1, ::nPos - 1 ) + cChar +;
SubStr( ::cBuffer, ::nPos, nMaxEdit - 1 - ::nPos ) +;
SubStr( ::cBuffer, nMaxEdit ), ::nMaxLen )
::cBuffer := Left( Stuff( Left( ::cBuffer, nMaxEdit - 2 ), ::nPos, 0, cChar ) + ;
SubStr( ::cBuffer, nMaxEdit ), ::nMaxLen )
ELSE
::cBuffer := Left( SubStr( ::cBuffer, 1, ::nPos - 1 ) + cChar + SubStr( ::cBuffer, ::nPos ), ::nMaxEdit )
::cBuffer := Left( Stuff( ::cBuffer, ::nPos, 0, cChar ), ::nMaxEdit )
ENDIF
::lChanged := .T.
@@ -1024,7 +1023,7 @@ METHOD picture( cPicture ) CLASS Get
cNum := ""
IF Left( cPicture, 1 ) == "@"
IF hb_LeftEq( cPicture, "@" )
nAt := At( " ", cPicture )
@@ -1032,7 +1031,7 @@ METHOD picture( cPicture ) CLASS Get
::cPicFunc := hb_asciiUpper( cPicture )
::cPicMask := ""
ELSE
::cPicFunc := hb_asciiUpper( SubStr( cPicture, 1, nAt - 1 ) )
::cPicFunc := hb_asciiUpper( Left( cPicture, nAt - 1 ) )
::cPicMask := SubStr( cPicture, nAt + 1 )
ENDIF
@@ -1063,7 +1062,7 @@ METHOD picture( cPicture ) CLASS Get
IF Val( cNum ) > 0
::nPicLen := Val( cNum )
ENDIF
::cPicFunc := SubStr( ::cPicFunc, 1, nAt - 1 ) + SubStr( ::cPicFunc, nFor )
::cPicFunc := Left( ::cPicFunc, nAt - 1 ) + SubStr( ::cPicFunc, nFor )
ENDIF
IF "Z" $ ::cPicFunc
@@ -1101,7 +1100,7 @@ METHOD picture( cPicture ) CLASS Get
CASE "T"
::cPicMask := Set( _SET_TIMEFORMAT )
::cPicMask := Set( _SET_DATEFORMAT ) + " " + Set( _SET_TIMEFORMAT )
FOR EACH cChar IN "yYmMdDhHsSfF"
::cPicMask := StrTran( ::cPicMask, cChar, "9" )
NEXT
@@ -1172,15 +1171,15 @@ METHOD PutMask( xValue, lEdit ) CLASS Get
IF lEdit .AND. ::lEdit
IF "*" $ cPicMask .OR. ;
"$" $ cPicMask
cPicMask := StrTran( StrTran( cPicMask, "*", "9" ), "$", "9" )
cPicMask := hb_StrReplace( cPicMask, "*$", "99" )
ENDIF
ENDIF
cBuffer := Transform( xValue, ;
iif( Empty( cPicFunc ), ;
iif( ::lPicBlankZero .AND. ! ::hasFocus, "@Z ", "" ), ;
cPicFunc + iif( ::lPicBlankZero .AND. ! ::hasFocus, "Z" , "" ) + " " ) ;
+ cPicMask )
iif( Empty( cPicFunc ), ;
iif( ::lPicBlankZero .AND. ! ::hasFocus, "@Z ", "" ), ;
cPicFunc + iif( ::lPicBlankZero .AND. ! ::hasFocus, "Z" , "" ) + " " ) + ;
cPicMask )
IF ::cType == "N"
IF ( "(" $ cPicFunc .OR. ")" $ cPicFunc ) .AND. xValue >= 0
@@ -1206,7 +1205,7 @@ METHOD PutMask( xValue, lEdit ) CLASS Get
IF "E" $ cPicFunc
cChar := iif( cChar == ",", ".", "," )
ENDIF
cBuffer := SubStr( cBuffer, 1, nFor - 1 ) + cChar + SubStr( cBuffer, nFor + 1 )
cBuffer := Stuff( cBuffer, nFor, 1, cChar )
ENDIF
NEXT
IF ::lEdit .AND. Empty( xValue )
@@ -1263,10 +1262,8 @@ METHOD unTransform() CLASS Get
CASE "N"
lMinus := .F.
IF "X" $ ::cPicFunc
IF Right( cBuffer, 2 ) == "DB"
lMinus := .T.
ENDIF
IF "X" $ ::cPicFunc .AND. Right( cBuffer, 2 ) == "DB"
lMinus := .T.
ENDIF
IF ! lMinus
FOR nFor := 1 TO ::nMaxLen
@@ -1296,11 +1293,11 @@ METHOD unTransform() CLASS Get
ELSE
IF "E" $ ::cPicFunc
cBuffer := Left( cBuffer, ::FirstEditable() - 1 ) + ;
StrTran( StrTran( SubStr( cBuffer, ::FirstEditable(), ::LastEditable() - ::FirstEditable() + 1 ), ".", " " ), ",", "." ) + ;
hb_StrReplace( SubStr( cBuffer, ::FirstEditable(), ::LastEditable() - ::FirstEditable() + 1 ), ".,", " ." ) + ;
SubStr( cBuffer, ::LastEditable() + 1 )
ELSE
cBuffer := Left( cBuffer, ::FirstEditable() - 1 ) + ;
StrTran( SubStr( cBuffer, ::FirstEditable(), ::LastEditable() - ::FirstEditable() + 1 ), ",", " " ) + ;
StrTran( SubStr( cBuffer, ::FirstEditable(), ::LastEditable() - ::FirstEditable() + 1 ), ",", " " ) + ;
SubStr( cBuffer, ::LastEditable() + 1 )
ENDIF
@@ -1600,8 +1597,7 @@ METHOD backSpaceLow() CLASS Get
IF nMinus > 0 .AND. !( SubStr( ::cPicMask, nMinus, 1 ) == "(" )
::cBuffer := SubStr( ::cBuffer, 1, nMinus - 1 ) + " " + ;
SubStr( ::cBuffer, nMinus + 1 )
::cBuffer := Stuff( ::cBuffer, nMinus, 1, " " )
::lEdit := .T.
::lChanged := .T.
@@ -1641,9 +1637,8 @@ METHOD deleteLow() CLASS Get
::lMinus2 := .F.
ENDIF
::cBuffer := PadR( SubStr( ::cBuffer, 1, ::nPos - 1 ) + ;
SubStr( ::cBuffer, ::nPos + 1, nMaxLen - ::nPos ) + " " + ;
SubStr( ::cBuffer, nMaxLen + 1 ), ::nMaxLen )
::cBuffer := PadR( Stuff( Stuff( ::cBuffer, ::nPos, 1, "" ), nMaxLen, 0, " " ), ;
::nMaxLen )
::lChanged := .T.
@@ -1945,21 +1940,21 @@ METHOD New( nRow, nCol, bVarBlock, cVarName, cPicture, cColorSpec ) CLASS Get
IF bVarBlock == NIL
bVarBlock := iif( HB_ISSTRING( cVarName ), MemVarBlock( cVarName ), NIL )
ENDIF
IF cColorSpec == NIL
cColorSpec := SetColor()
#ifdef HB_COMPAT_C53
IF cColorSpec == NIL
cColorSpec := ;
hb_ColorIndex( SetColor(), CLR_UNSELECTED ) + "," + ;
hb_ColorIndex( SetColor(), CLR_ENHANCED ) + "," + ;
hb_ColorIndex( SetColor(), CLR_STANDARD ) + "," + ;
iif( IsDefColor(), iif( Set( _SET_INTENSITY ), "W+/N", "W/N" ), hb_ColorIndex( SetColor(), CLR_BACKGROUND ) )
ENDIF
hb_ColorIndex( cColorSpec, iif( Set( _SET_INTENSITY ), CLR_UNSELECTED, CLR_STANDARD ) ) + "," + ;
hb_ColorIndex( cColorSpec, iif( Set( _SET_INTENSITY ), CLR_ENHANCED, CLR_STANDARD ) ) + "," + ;
hb_ColorIndex( cColorSpec, CLR_STANDARD ) + "," + ;
iif( IsDefColor(), iif( Set( _SET_INTENSITY ), "W+/N", "W/N" ), ;
hb_ColorIndex( cColorSpec, iif( Set( _SET_INTENSITY ), CLR_BACKGROUND, CLR_STANDARD ) ) )
#else
IF cColorSpec == NIL
cColorSpec := ;
hb_ColorIndex( SetColor(), CLR_UNSELECTED ) + "," + ;
hb_ColorIndex( SetColor(), CLR_ENHANCED )
ENDIF
hb_ColorIndex( cColorSpec, iif( Set( _SET_INTENSITY ), CLR_UNSELECTED, CLR_STANDARD ) ) + "," + ;
hb_ColorIndex( cColorSpec, iif( Set( _SET_INTENSITY ), CLR_ENHANCED, CLR_STANDARD ) )
#endif
ENDIF
::nRow := nRow
::nCol := nCol

4
src/rtl/tgetint.prg
View File

@@ -56,7 +56,7 @@ FUNCTION __Get( bSetGet, cVarName, cPicture, bValid, bWhen )
RETURN NIL
ENDIF
IF ! HB_ISBLOCK( bSetGet )
IF ! HB_ISEVALITEM( bSetGet )
IF FieldPos( cVarName ) > 0
bSetGet := FieldWBlock( cVarName, Select() )
ELSEIF ( bSetGet := MemVarBlock( cVarName ) ) == NIL
@@ -90,7 +90,7 @@ FUNCTION __GetA( bGetArray, cVarName, cPicture, bValid, bWhen, aIndex )
RETURN NIL
ENDIF
IF ! HB_ISBLOCK( bGetArray )
IF ! HB_ISEVALITEM( bGetArray )
/* CA-Cl*pper creates standard SET/GET block here */
IF FieldPos( cVarName ) > 0
bGetArray := FieldWBlock( cVarName, Select() )

38
src/rtl/tgetlist.prg
View File

@@ -65,8 +65,6 @@
#include "setcurs.ch"
#include "tbrowse.ch"
#define IS_IN( str, list ) ( "|" + str + "|" $ "|" + list + "|" )
#define SCORE_ROW 0
#define SCORE_COL 60
@@ -204,13 +202,13 @@ METHOD ReadModal() CLASS HBGetList
::PostActiveGet()
#ifdef HB_COMPAT_C53
IF HB_ISBLOCK( ::oGet:reader )
IF HB_ISEVALITEM( ::oGet:reader )
Eval( ::oGet:reader, ::oGet, Self, oMenu, aMsg )
ELSE
::Reader( oMenu, aMsg )
ENDIF
#else
IF HB_ISBLOCK( ::oGet:reader )
IF HB_ISEVALITEM( ::oGet:reader )
Eval( ::oGet:reader, ::oGet )
ELSE
::Reader()
@@ -776,7 +774,7 @@ METHOD SetFormat( bFormat ) CLASS HBGetList
LOCAL bSavFormat := ::bFormat
IF HB_ISBLOCK( bFormat )
IF HB_ISEVALITEM( bFormat )
::bFormat := bFormat
ENDIF
@@ -913,11 +911,16 @@ METHOD GUIReader( oGet, oMenu, aMsg ) CLASS HBGetList
ENDDO
// De-activate the GET
IF IS_IN( oGUI:ClassName(), "LISTBOX|RADIOGROUP" ) .AND. HB_ISNUMERIC( oGet:varGet() )
oGet:varPut( oGUI:value )
ELSE
oGet:varPut( oGUI:buffer )
ENDIF
SWITCH oGUI:ClassName()
CASE "LISTBOX"
CASE "RADIOGROUP"
IF HB_ISNUMERIC( oGet:varGet() )
oGet:varPut( oGUI:value )
EXIT
ENDIF
OTHERWISE
oGet:varPut( oGUI:buffer )
ENDSWITCH
oGUI:killFocus()
::EraseGetMsg( aMsg )
@@ -1182,11 +1185,16 @@ METHOD GUIPostValidate( oGet, oGUI, aMsg ) CLASS HBGetList
IF !( oGUI:ClassName() == "TBROWSE" )
xOldValue := oGet:varGet()
IF IS_IN( oGUI:ClassName(), "LISTBOX|RADIOGROUP" ) .AND. HB_ISNUMERIC( oGet:varGet() )
xNewValue := oGUI:Value
ELSE
xNewValue := oGUI:Buffer
ENDIF
SWITCH oGUI:ClassName()
CASE "LISTBOX"
CASE "RADIOGROUP"
IF HB_ISNUMERIC( oGet:varGet() )
xNewValue := oGUI:value
EXIT
ENDIF
OTHERWISE
xNewValue := oGUI:buffer
ENDSWITCH
ENDIF
IF !( xOldValue == xNewValue )

2
src/rtl/tmenuitm.prg
View File

@@ -121,7 +121,7 @@ METHOD checked( lChecked ) CLASS MenuItem
METHOD data( boData ) CLASS MenuItem
IF boData != NIL
IF HB_ISBLOCK( boData )
IF HB_ISEVALITEM( boData )
::boData := boData
ELSE
::boData := __eInstVar53( Self, "DATA", boData, "O", 1001, {|| IS_IN( boData:ClassName(), "POPUPMENU|HB_POPUPMENU" ) } )

2
src/vm/asort.c
View File

@@ -260,7 +260,7 @@ HB_FUNC( ASORT )
hb_arraySort( pArray,
HB_ISNUM( 2 ) ? &nStart : NULL,
HB_ISNUM( 3 ) ? &nCount : NULL,
hb_param( 4, HB_IT_BLOCK ) );
hb_param( 4, HB_IT_EVALITEM ) );
hb_itemReturn( pArray ); /* ASort() returns the array itself */
}

2
src/vm/garbage.c
View File

@@ -71,7 +71,7 @@
# if defined( HB_SPINLOCK_INIT ) && ! defined( HB_HELGRIND_FRIENDLY )
HB_SPINLOCK_T s_gcSpinLock = HB_SPINLOCK_INIT;
static HB_SPINLOCK_T s_gcSpinLock = HB_SPINLOCK_INIT;
# define HB_GC_LOCK() HB_SPINLOCK_ACQUIRE( &s_gcSpinLock )
# define HB_GC_UNLOCK() HB_SPINLOCK_RELEASE( &s_gcSpinLock )

8
src/vm/hashfunc.c
View File

@@ -379,11 +379,11 @@ HB_FUNC( HB_HMERGE )
{
PHB_ITEM pDest = hb_param( 1, HB_IT_HASH );
PHB_ITEM pSource = hb_param( 2, HB_IT_HASH );
PHB_ITEM pAction = hb_param( 3, HB_IT_BLOCK | HB_IT_NUMERIC );
PHB_ITEM pAction = hb_param( 3, HB_IT_EVALITEM | HB_IT_NUMERIC );
if( pDest && pSource )
{
if( pAction && HB_IS_BLOCK( pAction ) )
if( pAction && HB_IS_EVALITEM( pAction ) )
{
HB_SIZE nLen = hb_hashLen( pSource ), nPos = 0;
while( ++nPos <= nLen )
@@ -420,7 +420,7 @@ HB_FUNC( HB_HMERGE )
HB_FUNC( HB_HEVAL )
{
PHB_ITEM pHash = hb_param( 1, HB_IT_HASH );
PHB_ITEM pBlock = hb_param( 2, HB_IT_BLOCK );
PHB_ITEM pBlock = hb_param( 2, HB_IT_EVALITEM );
if( pHash && pBlock )
{
@@ -470,7 +470,7 @@ HB_FUNC( HB_HSCAN )
++nStart;
nCount = HB_ISNUM( 4 ) ? ( HB_SIZE ) hb_parns( 4 ) : nLen - nStart + 1;
if( HB_IS_BLOCK( pValue ) )
if( HB_IS_EVALITEM( pValue ) )
{
while( nCount-- )
{

2
src/vm/thread.c
View File

@@ -1581,7 +1581,7 @@ HB_FUNC( HB_THREADONCE )
HB_BOOL fFirstCall = HB_FALSE;
if( HB_IS_NIL( pItem ) || ! hb_itemGetL( pItem ) )
{
PHB_ITEM pAction = hb_param( 2, HB_IT_BLOCK | HB_IT_SYMBOL );
PHB_ITEM pAction = hb_param( 2, HB_IT_EVALITEM );
#if defined( HB_MT_VM )
if( ! s_pOnceMutex )