From 13a2891d97dcfb60290d9d566ccd7f0d7860bcfd Mon Sep 17 00:00:00 2001 From: Przemyslaw Czerpak Date: Fri, 31 Aug 2007 01:20:52 +0000 Subject: [PATCH] 2007-08-31 03:20 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) * harbour/include/hbapi.h * harbour/source/vm/dynsym.c + added hb_dynsymIsFunction() * harbour/source/rtl/filehb.c * updated comment * harbour/source/rtl/philes.c * renamed HB_F_EOF() to HB_FEOF() * harbour/source/rtl/scroll.c * harbour/source/rtl/transfrm.c * harbour/source/rtl/file.c * formatting * harbour/source/rtl/substr.c * harbour/source/rtl/trim.c % optimization * harbour/source/rtl/typefile.prg % use HB_ATOKENS() instead of static .prg function * harbour/source/rtl/setkey.c % optimization and protection aganst possible GPF when wrong array is passed to HB_SETKEYSAVE() * harbour/source/rtl/xhelp.c ! do not generate RT error when HELP symbol exist (f.e. after PUBLIC HELP) but HELP() function doesn't ! keep reference in parametes passed by reference to __XHELP() * use only PHB_DYNS instead of PHB_SYMB * harbour/source/rtl/seconds.c + added WIN32 version borrowed from XHARBOUR * harbour/source/rtl/trace.c ! protection against possible GPF when wrong parameters are passed * harbour/source/rtl/samples.c ! protection against possible GPF when wrong parameters are passed Warning! We have in this file few functions without HB_ prefix. Some of them may create conflicts with future functions for TIMEDATE items. * harbour/source/rtl/inkey.c + added support for passing array with key codes as __KEYBOARD() parameter, covered by HB_EXTENSION macro - this is xHarbour compatible extension. I do not like it but we already had extension with numeric parameters and probably it would be hard to remove it now and keep __KEYBOARD() code clean so I decided to add support also for arrays instead of creating new function and adding conditional code covered by HB_COMPAT_XHB macro. * harbour/source/rtl/setfunc.prg * accept extended __KEYBOARD() parameters when HB_EXTENSION macro is set. --- harbour/ChangeLog | 58 +++++++++++++++++++++++++++++++++ harbour/include/hbapi.h | 1 + harbour/source/rtl/file.c | 6 ++-- harbour/source/rtl/filehb.c | 7 ++-- harbour/source/rtl/inkey.c | 11 +++++++ harbour/source/rtl/philes.c | 4 +-- harbour/source/rtl/samples.c | 6 ++-- harbour/source/rtl/scroll.c | 25 +++++++++----- harbour/source/rtl/seconds.c | 13 ++++++++ harbour/source/rtl/setfunc.prg | 21 +++++++----- harbour/source/rtl/setkey.c | 37 ++++++++------------- harbour/source/rtl/substr.c | 2 +- harbour/source/rtl/trace.c | 7 ++-- harbour/source/rtl/transfrm.c | 4 +-- harbour/source/rtl/trim.c | 46 ++++++++++++++++++-------- harbour/source/rtl/typefile.prg | 34 ++++--------------- harbour/source/rtl/xhelp.c | 21 +++++++----- harbour/source/vm/dynsym.c | 11 +++++-- 18 files changed, 205 insertions(+), 109 deletions(-) diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 1f1c6f4e8e..3f0733cb36 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -8,6 +8,64 @@ 2002-12-01 13:30 UTC+0100 Foo Bar */ +2007-08-31 03:20 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) + * harbour/include/hbapi.h + * harbour/source/vm/dynsym.c + + added hb_dynsymIsFunction() + + * harbour/source/rtl/filehb.c + * updated comment + + * harbour/source/rtl/philes.c + * renamed HB_F_EOF() to HB_FEOF() + + * harbour/source/rtl/scroll.c + * harbour/source/rtl/transfrm.c + * harbour/source/rtl/file.c + * formatting + + * harbour/source/rtl/substr.c + * harbour/source/rtl/trim.c + % optimization + + * harbour/source/rtl/typefile.prg + % use HB_ATOKENS() instead of static .prg function + + * harbour/source/rtl/setkey.c + % optimization and protection aganst possible GPF when wrong array + is passed to HB_SETKEYSAVE() + + * harbour/source/rtl/xhelp.c + ! do not generate RT error when HELP symbol exist + (f.e. after PUBLIC HELP) but HELP() function doesn't + ! keep reference in parametes passed by reference to __XHELP() + * use only PHB_DYNS instead of PHB_SYMB + + * harbour/source/rtl/seconds.c + + added WIN32 version borrowed from XHARBOUR + + * harbour/source/rtl/trace.c + ! protection against possible GPF when wrong parameters are passed + + * harbour/source/rtl/samples.c + ! protection against possible GPF when wrong parameters are passed + Warning! We have in this file few functions without HB_ prefix. + Some of them may create conflicts with future functions for TIMEDATE + items. + + * harbour/source/rtl/inkey.c + + added support for passing array with key codes as __KEYBOARD() + parameter, covered by HB_EXTENSION macro - this is xHarbour compatible + extension. I do not like it but we already had extension with numeric + parameters and probably it would be hard to remove it now and keep + __KEYBOARD() code clean so I decided to add support also for arrays + instead of creating new function and adding conditional code covered + by HB_COMPAT_XHB macro. + + * harbour/source/rtl/setfunc.prg + * accept extended __KEYBOARD() parameters when HB_EXTENSION macro + is set. + 2007-08-30 18:30 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) * harbour/bin/hb-func.sh * repeated -ldl at the end of linked library list in linux for diff --git a/harbour/include/hbapi.h b/harbour/include/hbapi.h index 11d82fb7d8..2821a35e9f 100644 --- a/harbour/include/hbapi.h +++ b/harbour/include/hbapi.h @@ -838,6 +838,7 @@ extern HB_EXPORT PHB_SYMB hb_dynsymGetSymbol( const char * szName ); /* finds a extern HB_EXPORT PHB_SYMB hb_dynsymFindSymbol( const char * szName ); /* finds a dynamic symbol and return pointer to its HB_SYMB structure */ extern HB_EXPORT PHB_SYMB hb_dynsymSymbol( PHB_DYNS pDynSym ); extern HB_EXPORT const char * hb_dynsymName( PHB_DYNS pDynSym ); /* return dynamic symbol name */ +extern HB_EXPORT BOOL hb_dynsymIsFunction( PHB_DYNS pDynSym ); extern HB_EXPORT HB_HANDLE hb_dynsymMemvarHandle( PHB_DYNS pDynSym ); /* return memvar handle number bound with given dynamic symbol */ extern HB_EXPORT int hb_dynsymAreaHandle( PHB_DYNS pDynSym ); /* return work area number bound with given dynamic symbol */ extern HB_EXPORT void hb_dynsymSetAreaHandle( PHB_DYNS pDynSym, int iArea ); /* set work area number for a given dynamic symbol */ diff --git a/harbour/source/rtl/file.c b/harbour/source/rtl/file.c index 88877e03c3..c268bed7a2 100644 --- a/harbour/source/rtl/file.c +++ b/harbour/source/rtl/file.c @@ -67,9 +67,9 @@ HB_EXPORT BOOL hb_fsFile( BYTE * pFilename ) hb_xfree(pFilename); return TRUE; } - else - hb_xfree(pFilename); - return FALSE; + + hb_xfree( pFilename ); + return FALSE; } HB_EXPORT BOOL hb_fsIsDirectory( BYTE * pFilename ) diff --git a/harbour/source/rtl/filehb.c b/harbour/source/rtl/filehb.c index bba04e13a4..690454efb2 100644 --- a/harbour/source/rtl/filehb.c +++ b/harbour/source/rtl/filehb.c @@ -59,9 +59,10 @@ /* NOTE: CA-Cl*pper RTrim()s the filename before doing the existence check. This is not multiplatform friendly, so Harbour doesn't do any modification on the filename. [vszakats] - It seems to be rather DOS not Clipper behavior. In Harbour we have - _SET_TRIMFILENAME which can enable emulation of such behavior in - other OS-es. [druzus] */ + For easier portability in Harbour user can optionally enable + leading and trailing spaces stripping by + SET( _SET_TRIMFILENAME, .T. ) + [druzus] */ HB_FUNC( FILE ) { diff --git a/harbour/source/rtl/inkey.c b/harbour/source/rtl/inkey.c index 416d6317d1..9efd30e6de 100644 --- a/harbour/source/rtl/inkey.c +++ b/harbour/source/rtl/inkey.c @@ -575,6 +575,17 @@ HB_FUNC( __KEYBOARD ) { hb_inkeyPut( hb_parni(1) ); } + else if( ISARRAY( 1 ) ) + { + PHB_ITEM pArray = hb_param( 1, HB_IT_ARRAY ); + ULONG ulElements = hb_arrayLen( pArray ), ulIndex; + + for( ulIndex = 1; ulIndex <= ulElements; ulIndex++ ) + { + if( hb_arrayGetType( pArray, ulIndex ) & HB_IT_NUMERIC ) + hb_inkeyPut( hb_arrayGetNI( pArray, ulIndex ) ); + } + } #endif } diff --git a/harbour/source/rtl/philes.c b/harbour/source/rtl/philes.c index 137dd48db7..b796898aa0 100644 --- a/harbour/source/rtl/philes.c +++ b/harbour/source/rtl/philes.c @@ -41,7 +41,7 @@ * CURDIR() * * Copyright 2000 David G. Holm - * HB_F_EOF() + * HB_FEOF() * * See doc/license.txt for licensing terms. * @@ -271,7 +271,7 @@ HB_FUNC( CURDIR ) #ifdef HB_EXTENSION -HB_FUNC( HB_F_EOF ) +HB_FUNC( HB_FEOF ) { USHORT uiError = 6; diff --git a/harbour/source/rtl/samples.c b/harbour/source/rtl/samples.c index 5492999849..88f3f68024 100644 --- a/harbour/source/rtl/samples.c +++ b/harbour/source/rtl/samples.c @@ -104,8 +104,8 @@ HB_FUNC( DAYS ) HB_FUNC( ELAPTIME ) { - ULONG ulStart = hb_TimeStrToSec( hb_parc( 1 ) ); - ULONG ulEnd = hb_TimeStrToSec( hb_parc( 2 ) ); + ULONG ulStart = hb_TimeStrToSec( hb_parcx( 1 ) ); + ULONG ulEnd = hb_TimeStrToSec( hb_parcx( 2 ) ); char szTime[ 9 ]; hb_retc( hb_SecToTimeStr( szTime, ( ulEnd < ulStart ? 86400 : 0 ) + ulEnd - ulStart ) ); @@ -113,7 +113,7 @@ HB_FUNC( ELAPTIME ) HB_FUNC( SECS ) { - hb_retnl( hb_TimeStrToSec( hb_parc( 1 ) ) ); + hb_retnl( hb_TimeStrToSec( hb_parcx( 1 ) ) ); } HB_FUNC( TSTRING ) diff --git a/harbour/source/rtl/scroll.c b/harbour/source/rtl/scroll.c index a71c8c3e3b..34e0fa0f09 100644 --- a/harbour/source/rtl/scroll.c +++ b/harbour/source/rtl/scroll.c @@ -68,18 +68,24 @@ HB_FUNC( SCROLL ) /* Enforce limits of (0,0) to (MAXROW(),MAXCOL()) */ iTop = hb_parni( 1 ); /* Defaults to zero on bad type */ - if( iTop < 0 ) iTop = 0; - else if( iTop > iMaxRow ) iTop = iMaxRow; + if( iTop < 0 ) + iTop = 0; + else if( iTop > iMaxRow ) + iTop = iMaxRow; iLeft = hb_parni( 2 ); /* Defaults to zero on bad type */ - if( iLeft < 0 ) iLeft = 0; - else if( iLeft > iMaxCol ) iLeft = iMaxCol; + if( iLeft < 0 ) + iLeft = 0; + else if( iLeft > iMaxCol ) + iLeft = iMaxCol; if( ISNUM( 3 ) ) { iBottom = hb_parni( 3 ); - if( iBottom < 0 ) iBottom = 0; - else if( iBottom > iMaxRow ) iBottom = iMaxRow; + if( iBottom < 0 ) + iBottom = 0; + else if( iBottom > iMaxRow ) + iBottom = iMaxRow; } else iBottom = iMaxRow; @@ -87,8 +93,10 @@ HB_FUNC( SCROLL ) if( ISNUM( 4 ) ) { iRight = hb_parni( 4 ); - if( iRight < 0 ) iRight = 0; - else if( iRight > iMaxCol ) iRight = iMaxCol; + if( iRight < 0 ) + iRight = 0; + else if( iRight > iMaxCol ) + iRight = iMaxCol; } else iRight = iMaxCol; @@ -100,4 +108,3 @@ HB_FUNC( SCROLL ) hb_parni( 5 ), /* Defaults to zero on bad type */ hb_parni( 6 ) ); /* Defaults to zero on bad type */ } - diff --git a/harbour/source/rtl/seconds.c b/harbour/source/rtl/seconds.c index 1b90dde203..d47434dce0 100644 --- a/harbour/source/rtl/seconds.c +++ b/harbour/source/rtl/seconds.c @@ -70,6 +70,18 @@ HB_EXPORT double hb_dateSeconds( void ) { +#if defined(HB_OS_WIN_32) + SYSTEMTIME SystemTime; + + HB_TRACE(HB_TR_DEBUG, ("hb_dateSeconds()")); + + GetLocalTime( &SystemTime ); + + return ( SystemTime.wHour * 3600 ) + + ( SystemTime.wMinute * 60 ) + + SystemTime.wSecond + + ( ( double ) SystemTime.wMilliseconds / 1000.0 ); +#else #if defined(_MSC_VER) #define timeb _timeb #define ftime _ftime @@ -102,6 +114,7 @@ HB_EXPORT double hb_dateSeconds( void ) ( oTime->tm_min * 60 ) + oTime->tm_sec + ( ( double ) fraction / 1000.0 ); +#endif } HB_FUNC( SECONDS ) diff --git a/harbour/source/rtl/setfunc.prg b/harbour/source/rtl/setfunc.prg index f407ff679b..ca466bffbd 100644 --- a/harbour/source/rtl/setfunc.prg +++ b/harbour/source/rtl/setfunc.prg @@ -53,25 +53,28 @@ #include "inkey.ch" #include "common.ch" -PROCEDURE __SetFunction( nFunctionKey, cString ) +PROCEDURE __SetFunction( nFunctionKey, xKeySeq ) /* NOTE: CA-Cl*pper will not handle F11 and F12 here. This is a Harbour extension. [vszakats] */ DO CASE - CASE nFunctionKey == 1 ; nFunctionKey := K_F1 + CASE nFunctionKey == 1 ; nFunctionKey := K_F1 #ifdef HB_EXTENSION - CASE nFunctionKey == 11 ; nFunctionKey := K_F11 - CASE nFunctionKey == 12 ; nFunctionKey := K_F12 + CASE nFunctionKey == 11 ; nFunctionKey := K_F11 + CASE nFunctionKey == 12 ; nFunctionKey := K_F12 #endif - OTHERWISE ; nFunctionKey := -nFunctionKey + 1 + OTHERWISE ; nFunctionKey := -nFunctionKey + 1 ENDCASE - IF ISCHARACTER( cString ) - SetKey( nFunctionKey, {|| __Keyboard( cString ) } ) +#ifdef HB_EXTENSION + IF ISCHARACTER( xKeySeq ) .OR. ISNUMBER( xKeySeq ) .OR. ISARRAY( xKeySeq ) +#else + IF ISCHARACTER( xKeySeq ) +#endif + SetKey( nFunctionKey, {|| __Keyboard( xKeySeq ) } ) ELSE SetKey( nFunctionKey, NIL ) ENDIF - RETURN - +RETURN diff --git a/harbour/source/rtl/setkey.c b/harbour/source/rtl/setkey.c index 2493253acf..42fbf81457 100644 --- a/harbour/source/rtl/setkey.c +++ b/harbour/source/rtl/setkey.c @@ -114,6 +114,11 @@ static void sk_add( BOOL bReturn, SHORT iKeyCode, PHB_ITEM pAction, PHB_ITEM pIs { PHB_SETKEY sk_list_tmp, sk_list_end; + if( pIsActive && !HB_IS_BLOCK( pIsActive ) ) + pIsActive = NULL; + if( pAction && !HB_IS_BLOCK( pAction ) ) + pAction = NULL; + sk_list_tmp = sk_findkey( iKeyCode, &sk_list_end ); if( sk_list_tmp == NULL ) { @@ -256,7 +261,7 @@ HB_FUNC( HB_SETKEYGET ) HB_FUNC( HB_SETKEYSAVE ) { - PHB_ITEM pKeys, pParam; + PHB_ITEM pKeys, pKeyElements, pParam; PHB_SETKEY sk_list_tmp; ULONG itemcount, nitem; @@ -269,35 +274,21 @@ HB_FUNC( HB_SETKEYSAVE ) ; pKeys = hb_itemArrayNew( itemcount ); + pKeyElements = hb_itemNew( NULL ); for( nitem = 1, sk_list_tmp = s_sk_list; nitem <= itemcount; nitem++, sk_list_tmp = sk_list_tmp->next ) { - PHB_ITEM pKeyElements, pTmp; - - pKeyElements = hb_itemArrayNew( 3 ); - - pTmp = hb_itemPutNI( NULL, sk_list_tmp->iKeyCode ); - hb_itemArrayPut( pKeyElements, 1, pTmp ); - hb_itemRelease( pTmp ); - - pTmp = hb_itemNew( sk_list_tmp->pAction ); - hb_itemArrayPut( pKeyElements, 2, pTmp ); - hb_itemRelease( pTmp ); - + hb_arrayNew( pKeyElements, 3 ); + hb_arraySetNI( pKeyElements, 1, sk_list_tmp->iKeyCode ); + hb_arraySet( pKeyElements, 2, sk_list_tmp->pAction ); if( sk_list_tmp->pIsActive ) - { - pTmp = hb_itemNew( sk_list_tmp->pIsActive ); - hb_itemArrayPut( pKeyElements, 3, pTmp ); - hb_itemRelease( pTmp ); - } - - hb_itemArrayPut( pKeys, nitem, pKeyElements ); - hb_itemRelease( pKeyElements ); + hb_arraySet( pKeyElements, 3, sk_list_tmp->pIsActive ); + hb_arraySetForward( pKeys, nitem, pKeyElements ); } - - hb_itemRelease( hb_itemReturn( pKeys ) ); + hb_itemRelease( pKeyElements ); + hb_itemReturnRelease( pKeys ); pParam = hb_param( 1, HB_IT_ANY ); if( pParam ) diff --git a/harbour/source/rtl/substr.c b/harbour/source/rtl/substr.c index 99044a0adf..1a556c87d6 100644 --- a/harbour/source/rtl/substr.c +++ b/harbour/source/rtl/substr.c @@ -101,7 +101,7 @@ HB_FUNC( SUBSTR ) if( lLen > 0 ) { - if( lPos == 0 && lLen == lSize ) + if( lLen == lSize ) hb_itemReturn( pText ); else hb_retclen( hb_itemGetCPtr( pText ) + lPos, lLen ); diff --git a/harbour/source/rtl/trace.c b/harbour/source/rtl/trace.c index c6fa2f6c57..e1e85bb3b7 100644 --- a/harbour/source/rtl/trace.c +++ b/harbour/source/rtl/trace.c @@ -67,8 +67,11 @@ HB_FUNC( HB_TRACELEVEL ) HB_FUNC( HB_TRACESTRING ) { - HB_TRACE(HB_TR_ALWAYS, (hb_parc( 1 )) ); + char * szMessage = hb_parc( 1 ); + if( szMessage ) + { + HB_TRACE(HB_TR_ALWAYS, (szMessage) ); + } } #endif - diff --git a/harbour/source/rtl/transfrm.c b/harbour/source/rtl/transfrm.c index 5ad035f257..6058e5283d 100644 --- a/harbour/source/rtl/transfrm.c +++ b/harbour/source/rtl/transfrm.c @@ -748,7 +748,7 @@ HB_FUNC( TRANSFORM ) { if( !bDone ) { - szResult[ ulResultPos ] = hb_itemGetL( pValue ) ? ( char ) 'Y' : ( char ) 'N'; + szResult[ ulResultPos ] = hb_itemGetL( pValue ) ? 'Y' : 'N'; bDone = TRUE; /* Logical written */ } else @@ -763,7 +763,7 @@ HB_FUNC( TRANSFORM ) { if( !bDone ) { - szResult[ ulResultPos ] = hb_itemGetL( pValue ) ? ( char ) 'T' : ( char ) 'F'; + szResult[ ulResultPos ] = hb_itemGetL( pValue ) ? 'T' : 'F'; bDone = TRUE; } else diff --git a/harbour/source/rtl/trim.c b/harbour/source/rtl/trim.c index 4be08edf2d..6961bf6797 100644 --- a/harbour/source/rtl/trim.c +++ b/harbour/source/rtl/trim.c @@ -96,10 +96,16 @@ HB_FUNC( LTRIM ) if( pText ) { - ULONG ulLen = hb_itemGetCLen( pText ); - char * szText = hb_strLTrim( hb_itemGetCPtr( pText ), &ulLen ); + ULONG ulLen, ulSrc; + char * szText; - hb_retclen( szText, ulLen ); + ulLen = ulSrc = hb_itemGetCLen( pText ); + szText = hb_strLTrim( hb_itemGetCPtr( pText ), &ulLen ); + + if( ulLen == ulSrc ) + hb_itemReturn( pText ); + else + hb_retclen( szText, ulLen ); } else hb_errRT_BASE_SubstR( EG_ARG, 1101, NULL, "LTRIM", HB_ERR_ARGS_BASEPARAMS ); @@ -115,14 +121,20 @@ HB_FUNC( RTRIM ) if( pText ) { - char * pszText = hb_itemGetCPtr( pText ); + ULONG ulLen, ulSrc; + char * szText = hb_itemGetCPtr( pText ); + ulSrc = hb_itemGetCLen( pText ); #ifdef HB_EXTENSION - hb_retclen( pszText, hb_strRTrimLen( pszText, hb_itemGetCLen( pText ), - ISLOG( 2 ) ? hb_parl( 2 ) : FALSE ) ); + ulLen = hb_strRTrimLen( szText, ulSrc, ISLOG( 2 ) && hb_parl( 2 ) ); #else - hb_retclen( pszText, hb_strRTrimLen( pszText, hb_itemGetCLen( pText ), FALSE ) ); + ulLen = hb_strRTrimLen( szText, ulSrc, FALSE ); #endif + + if( ulLen == ulSrc ) + hb_itemReturn( pText ); + else + hb_retclen( szText, ulLen ); } else /* NOTE: "TRIM" is right here [vszakats] */ @@ -145,12 +157,21 @@ HB_FUNC( ALLTRIM ) if( pText ) { - char * pszText = hb_itemGetCPtr( pText ); - ULONG ulLen = hb_strRTrimLen( pszText, hb_itemGetCLen( pText ), - ISLOG( 2 ) ? hb_parl( 2 ) : FALSE ); + ULONG ulLen, ulSrc; + char * szText = hb_itemGetCPtr( pText ); - pszText = hb_strLTrim( pszText, &ulLen ); - hb_retclen( pszText, ulLen ); + ulSrc = hb_itemGetCLen( pText ); +#ifdef HB_EXTENSION + ulLen = hb_strRTrimLen( szText, ulSrc, ISLOG( 2 ) && hb_parl( 2 ) ); +#else + ulLen = hb_strRTrimLen( szText, ulSrc, FALSE ); +#endif + szText = hb_strLTrim( szText, &ulLen ); + + if( ulLen == ulSrc ) + hb_itemReturn( pText ); + else + hb_retclen( szText, ulLen ); } else #ifdef HB_COMPAT_C53 @@ -159,4 +180,3 @@ HB_FUNC( ALLTRIM ) hb_retc( NULL ); #endif } - diff --git a/harbour/source/rtl/typefile.prg b/harbour/source/rtl/typefile.prg index 1d78c5782f..2f6febfbe4 100644 --- a/harbour/source/rtl/typefile.prg +++ b/harbour/source/rtl/typefile.prg @@ -82,14 +82,13 @@ PROCEDURE __TypeFile( cFile, lPrint ) IF Empty( cDir ) cTmp := SET( _SET_DEFAULT ) + ";" + SET( _SET_PATH ) cTmp := StrTran( cTmp, ",", ";" ) - i := len( cTmp ) - IF substr( cTmp, i, 1 ) == ";" // remove last ";" - cTmp := substr( cTmp, 1, i - 1 ) - ENDIF - aPath := aDvd( cTmp ) + i := Len( cTmp ) + WHILE SubStr( cTmp, i, 1 ) == ";" // remove last ";" + cTmp := LEFT( cTmp, --i ) + ENDDO + aPath := HB_ATOKENS( cTmp, ";" ) FOR i := 1 TO len( aPath ) - cTmp := hb_FNameMerge( aPath[ i ], cName, cExt ) - IF file( cTmp ) + IF File( cTmp := hb_FNameMerge( aPath[ i ], cName, cExt ) ) cFile := cTmp EXIT ENDIF @@ -147,27 +146,6 @@ PROCEDURE __TypeFile( cFile, lPrint ) RETURN -/*----------------------------------------------------------------------------*/ -/* Function aDvd : Divide string to tokens and put tokens into array */ -/* Parameters : cString - String to be splited ( C ) */ -/* cDelim - Delimiter of tokens in string ( C ) */ -/* Return : Array of tokens or empty array */ -/*----------------------------------------------------------------------------*/ - -STATIC FUNCTION aDvd( cString, cDelim ) - LOCAL aProm := {} - LOCAL nPos - - DEFAULT cDelim TO ";" - - DO WHILE ( nPos := at( cDelim, cString ) ) != 0 - AAdd( aProm, substr( cString, 1, nPos - 1 ) ) - cString := substr( cString, nPos + len( cDelim ) ) - ENDDO - AAdd( aProm, cString ) - - RETURN aProm - #ifdef HB_COMPAT_XPP FUNCTION _TypeFile( cFile, lPrint ) diff --git a/harbour/source/rtl/xhelp.c b/harbour/source/rtl/xhelp.c index 79e37adfdb..6f879cf118 100644 --- a/harbour/source/rtl/xhelp.c +++ b/harbour/source/rtl/xhelp.c @@ -52,28 +52,31 @@ #include "hbapi.h" #include "hbvm.h" +#include "hbstack.h" HB_FUNC( __XHELP ) { - PHB_SYMB pSym = hb_dynsymFindSymbol( "HELP" ); + static PHB_DYNS s_pDynSym = NULL; - if( pSym ) + if( s_pDynSym == NULL ) + s_pDynSym = hb_dynsymGetCase( "HELP" ); + + if( hb_dynsymIsFunction( s_pDynSym ) ) { /* awhite: push the existing params after the dyn symbol */ USHORT uiPCount = hb_pcount(); USHORT uiParam; - hb_vmPushSymbol( pSym ); + hb_vmPushDynSym( s_pDynSym ); hb_vmPushNil(); + /* CA-Cl*pper respects references so hb_stackItemFromBase() is + * used insted of hb_param() [druzus] + */ for( uiParam = 1; uiParam <= uiPCount; uiParam++ ) - hb_vmPush( hb_param( uiParam, HB_IT_ANY ) ); + hb_vmPush( hb_stackItemFromBase( uiParam ) ); + hb_vmDo( uiPCount ); -/* - hb_vmPushSymbol( pSym ); - hb_vmPushNil(); - hb_vmDo( 0 ); -*/ /* NOTE: Leave the return value as it is. */ } } diff --git a/harbour/source/vm/dynsym.c b/harbour/source/vm/dynsym.c index 62f1b16a0b..4f3186b0e8 100644 --- a/harbour/source/vm/dynsym.c +++ b/harbour/source/vm/dynsym.c @@ -341,6 +341,13 @@ HB_EXPORT const char * hb_dynsymName( PHB_DYNS pDynSym ) return pDynSym->pSymbol->szName; } +HB_EXPORT BOOL hb_dynsymIsFunction( PHB_DYNS pDynSym ) +{ + HB_TRACE(HB_TR_DEBUG, ("hb_dynsymIsFunction(%p)", pDynSym)); + + return pDynSym->pSymbol->value.pFunPtr != NULL; +} + HB_EXPORT HB_HANDLE hb_dynsymMemvarHandle( PHB_DYNS pDynSym ) { HB_TRACE(HB_TR_DEBUG, ("hb_dynsymMemvarHandle(%p)", pDynSym)); @@ -435,7 +442,7 @@ HB_FUNC( __DYNSISFUN ) /* returns .t. if a symbol has a function/procedure point long lIndex = hb_parnl( 1 ); /* NOTE: This will return zero if the parameter is not numeric */ if( lIndex >= 1 && lIndex <= s_uiDynSymbols ) - hb_retl( s_pDynItems[ lIndex - 1 ].pDynSym->pSymbol->value.pFunPtr != NULL ); + hb_retl( hb_dynsymIsFunction( s_pDynItems[ lIndex - 1 ].pDynSym ) ); else hb_retl( FALSE ); } @@ -455,7 +462,7 @@ HB_FUNC( __DYNSGETPRF ) /* profiler: It returns an array with a function or proc #ifndef HB_NO_PROFILER if( lIndex >= 1 && lIndex <= s_uiDynSymbols ) { - if( s_pDynItems[ lIndex - 1 ].pDynSym->pSymbol->value.pFunPtr ) /* it is a function or procedure */ + if( hb_dynsymIsFunction( s_pDynItems[ lIndex - 1 ].pDynSym ) ) /* it is a function or procedure */ { hb_stornl( s_pDynItems[ lIndex - 1 ].pDynSym->ulCalls, -1, 1 ); hb_stornl( s_pDynItems[ lIndex - 1 ].pDynSym->ulTime, -1, 2 );