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

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 )