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

2008-04-26 07:53 UTC+0100 Viktor Szakats (harbour.01 syenar hu)

Browse Source 
* source/rtl/tget.prg
     ! Fixed to not extend ::left(), ::right(), ::backspace(), 
       ::delete() with an internally used (but also externally 
       accessible) extra parameter. This is interface is now 
       made fully C5x compatible.

   * tests/rto_tb.prg
     ! Fixed to override __eInstVar53() (instead of _eInstVar())

   * include/hbextern.ch
   * common.mak
   * source/rdd/Makefile
   + source/rdd/dbcmdhb.c
     + Added non-internal versions of __dbPack() and __dbZap(), 
       named: hb_dbPack() and hb_dbZap(). If group needs it I 
       can add dbPack() and dbZap() too in separate files to 
       lessen the problem of name collision with app code.

   * source/rtl/inkey.c
     * Formatting.
     + HB_KEYPUT(): Now possible to pass an array with string elements.
       (see feature in xhb/__KEYBOARD())
     * HB_KEYPUT(): For string parameter it now uses hb_inkeySetText()
       API, rather than a loop of hb_inkeyPut()s.

   * contrib/xhb/xhbfunc.c
     ! xhb flavour of __KEYBOARD() sync fixed. (hb_inkeySetText() got 
       extended in xhb, so here we're using hb_inkeyPut() for single 
       numeric key codes).
     ; Now same code is used as in HB_KEYPUT().

   * source/vm/memvars.c
   * source/vm/hvm.c
   * source/vm/arrayshb.c
     + Added HB_C52_STRICT branches for the remaining RTEs 
       which produced different results in hbtest.
     ! Fixed HB_C52_STRICT RTE for AFill().
     ; NOTE: It's not possible to build Harbour currently when 
             HB_C52_STRICT, so it's not easy to test these.

   * include/hbclass.ch
     ! Typos.

   * source/rtl/memoedit.prg
   * source/rtl/achoice.prg
   * source/rtl/treport.prg
     * Formatting.

   * source/rtl/tobject.prg
     * Formatting.
     % Minor opt.
This commit is contained in:
Viktor Szakats
2008-04-26 06:39:37 +00:00
parent 1d0c3d4760
commit afe85d8f42
17 changed files with 406 additions and 229 deletions
Download Patch File Download Diff File Expand all files Collapse all files

53
harbour/ChangeLog
View File

@@ -8,6 +8,59 @@
2008-12-31 13:59 UTC+0100 Foo Bar <foo.bar@foobar.org>
*/
2008-04-26 07:53 UTC+0100 Viktor Szakats (harbour.01 syenar hu)
* source/rtl/tget.prg
! Fixed to not extend ::left(), ::right(), ::backspace(),
::delete() with an internally used (but also externally
accessible) extra parameter. This is interface is now
made fully C5x compatible.
* tests/rto_tb.prg
! Fixed to override __eInstVar53() (instead of _eInstVar())
* include/hbextern.ch
* common.mak
* source/rdd/Makefile
+ source/rdd/dbcmdhb.c
+ Added non-internal versions of __dbPack() and __dbZap(),
named: hb_dbPack() and hb_dbZap(). If group needs it I
can add dbPack() and dbZap() too in separate files to
lessen the problem of name collision with app code.
* source/rtl/inkey.c
* Formatting.
+ HB_KEYPUT(): Now possible to pass an array with string elements.
(see feature in xhb/__KEYBOARD())
* HB_KEYPUT(): For string parameter it now uses hb_inkeySetText()
API, rather than a loop of hb_inkeyPut()s.
* contrib/xhb/xhbfunc.c
! xhb flavour of __KEYBOARD() sync fixed. (hb_inkeySetText() got
extended in xhb, so here we're using hb_inkeyPut() for single
numeric key codes).
; Now same code is used as in HB_KEYPUT().
* source/vm/memvars.c
* source/vm/hvm.c
* source/vm/arrayshb.c
+ Added HB_C52_STRICT branches for the remaining RTEs
which produced different results in hbtest.
! Fixed HB_C52_STRICT RTE for AFill().
; NOTE: It's not possible to build Harbour currently when
HB_C52_STRICT, so it's not easy to test these.
* include/hbclass.ch
! Typos.
* source/rtl/memoedit.prg
* source/rtl/achoice.prg
* source/rtl/treport.prg
* Formatting.
* source/rtl/tobject.prg
* Formatting.
% Minor opt.
2008-04-25 12:01 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)
* harbour/source/rtl/tbrowse.prg
* changed internal logic used for vertical movements. Now it should

1
harbour/common.mak
View File

@@ -851,6 +851,7 @@ CODEPAGE_LIB_OBJS = \
RDD_LIB_OBJS = \
$(OBJ_DIR)\dbcmd$(OBJEXT) \
$(OBJ_DIR)\dbcmd53$(OBJEXT) \
$(OBJ_DIR)\dbcmdhb$(OBJEXT) \
$(OBJ_DIR)\dbcmdx$(OBJEXT) \
$(OBJ_DIR)\dbdrop$(OBJEXT) \
$(OBJ_DIR)\dbexists$(OBJEXT) \

12
harbour/contrib/xhb/xhbfunc.c
View File

@@ -63,14 +63,14 @@ HB_FUNC( XHB__KEYBOARD )
hb_inkeyReset();
}
if( ISCHAR( 1 ) )
if( ISNUM( 1 ) )
{
hb_inkeyPut( hb_parni( 1 ) );
}
else if( ISCHAR( 1 ) )
{
hb_inkeySetText( hb_parc( 1 ), hb_parclen( 1 ) );
}
else if( ISNUM( 1 ) )
{
hb_inkeySetText( NULL, ( ULONG ) hb_parnl( 1 ) );
}
else if( ISARRAY( 1 ) )
{
PHB_ITEM pArray = hb_param( 1, HB_IT_ARRAY );
@@ -83,7 +83,7 @@ HB_FUNC( XHB__KEYBOARD )
if( HB_IS_NUMBER( pItem ) )
{
hb_inkeySetText( NULL, ( ULONG ) hb_itemGetNL( pItem ) );
hb_inkeyPut( hb_itemGetNI( pItem ) );
}
else if( HB_IS_STRING( pItem ) )
{

6
harbour/include/hbclass.ch
View File

@@ -110,7 +110,7 @@
#ifndef HB_CLS_VO
#ifndef HB_CLS_TOP
/* IF NOTHING DECIDED BY THE PROGRAMER USE ALL */
/* IF NOTHING DECIDED BY THE PROGRAMMER USE ALL */
#define HB_CLS_FWO
#define HB_CLS_CSY
#define HB_CLS_VO
@@ -147,7 +147,7 @@
#endif
/*
* I have to enable this definition by default untill we will not fix
* I have to enable this definition by default until we will not fix
* preprocessor. [druzus]
*/
#ifndef HB_CLS_PARAMS_ERR
@@ -163,7 +163,7 @@
#xtranslate __HB_CLS_MTHNAME <ClassName> <MethodName> => <ClassName>_<MethodName>
#endif
/* parameters list passed throw - it's Harbour extnesion */
/* parameters list passed throw - it's Harbour extension */
#ifndef HB_CLS_PARAM_LIST
#define HB_CLS_PARAM_LIST ...
#endif

3
harbour/include/hbextern.ch
View File

@@ -901,6 +901,9 @@ EXTERNAL HB_GETSTDERR
EXTERNAL HB_GETSTDIN
EXTERNAL HB_GETSTDOUT
EXTERNAL HB_DBPACK
EXTERNAL HB_DBZAP
/* Codepage support */
EXTERNAL HB_CODEPAGE_BG866
EXTERNAL HB_CODEPAGE_BGISO

1
harbour/source/rdd/Makefile
View File

@@ -7,6 +7,7 @@ ROOT = ../../
C_SOURCES=\
dbcmd.c \
dbcmd53.c \
dbcmdhb.c \
dbcmdx.c \
dbdrop.c \
dbexists.c \

67
harbour/source/rdd/dbcmdhb.c Normal file
View File

@@ -0,0 +1,67 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* Harbour extension RDD APIs
*
* Copyright 2008 Viktor Szakats <viktor.szakats@syenar.hu>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
#include "hbapi.h"
HB_FUNC_EXTERN( __DBPACK );
HB_FUNC( HB_DBPACK )
{
HB_FUNC_EXEC( __DBPACK );
}
HB_FUNC_EXTERN( __DBZAP );
HB_FUNC( HB_DBZAP )
{
HB_FUNC_EXEC( __DBZAP );
}

45
harbour/source/rtl/achoice.prg
View File

@@ -173,20 +173,20 @@ FUNCTION AChoice( nTop, nLeft, nBottom, nRight, acItems, xSelect, xUserFunc, nPo
nNewPos --
ENDDO
IF INRANGE( nAtTop, nNewPos, nAtTop + nNumRows - 1 )
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ]), .F., nNumCols )
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ] ), .F., nNumCols )
nPos := nNewPos
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ]), .T., nNumCols )
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ] ), .T., nNumCols )
ELSE
DispBegin()
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ]), .F., nNumCols )
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ] ), .F., nNumCols )
Scroll( nTop, nLeft, nBottom, nRight, ( nNewPos - ( nAtTop + nNumRows - 1 ) ) )
nAtTop := nNewPos
nPos := Max( nPos, nAtTop + nNumRows - 1 )
DO WHILE nPos > nNewPos
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ]), .F., nNumCols )
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ] ), .F., nNumCols )
nPos --
ENDDO
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ]), .T., nNumCols )
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ] ), .T., nNumCols )
DispEnd()
ENDIF
ENDIF
@@ -209,20 +209,20 @@ FUNCTION AChoice( nTop, nLeft, nBottom, nRight, acItems, xSelect, xUserFunc, nPo
ENDDO
IF INRANGE( nAtTop, nNewPos, nAtTop + nNumRows - 1 )
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ]), .F., nNumCols )
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ] ), .F., nNumCols )
nPos := nNewPos
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ]), .T., nNumCols )
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ] ), .T., nNumCols )
ELSE
DispBegin()
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ]), .F., nNumCols )
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ] ), .F., nNumCols )
Scroll( nTop, nLeft, nBottom, nRight, ( nNewPos - ( nAtTop + nNumRows - 1 ) ) )
nAtTop := nNewPos - nNumRows + 1
nPos := Max( nPos, nAtTop )
DO WHILE nPos < nNewPos
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ]), .F., nNumCols )
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ] ), .F., nNumCols )
nPos ++
ENDDO
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ]), .T., nNumCols )
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ] ), .T., nNumCols )
DispEnd()
ENDIF
@@ -254,9 +254,9 @@ FUNCTION AChoice( nTop, nLeft, nBottom, nRight, acItems, xSelect, xUserFunc, nPo
ENDIF
ELSE
IF INRANGE( nAtTop, nLastItem, nAtTop + nNumRows - 1 )
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ]), .F., nNumCols )
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ] ), .F., nNumCols )
nPos := nLastItem
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ]), .T., nNumCols )
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ] ), .T., nNumCols )
ELSE
nPos := nLastItem
nAtTop := Max( 1, nPos - nNumRows + 1 )
@@ -279,9 +279,9 @@ FUNCTION AChoice( nTop, nLeft, nBottom, nRight, acItems, xSelect, xUserFunc, nPo
nNewPos++
ENDDO
IF nNewPos != nPos
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ]), .F., nNumCols )
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ] ), .F., nNumCols )
nPos := nNewPos
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ]), .T., nNumCols )
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ] ), .T., nNumCols )
ENDIF
ENDIF
@@ -300,9 +300,9 @@ FUNCTION AChoice( nTop, nLeft, nBottom, nRight, acItems, xSelect, xUserFunc, nPo
nNewPos--
ENDDO
IF nNewPos != nPos
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ]), .F., nNumCols )
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ] ), .F., nNumCols )
nPos := nNewPos
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ]), .T., nNumCols )
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ] ), .T., nNumCols )
ENDIF
ENDIF
@@ -347,9 +347,9 @@ FUNCTION AChoice( nTop, nLeft, nBottom, nRight, acItems, xSelect, xUserFunc, nPo
ELSE
IF INRANGE( nAtTop, nLastItem, nAtTop + nNumRows - 1 )
// On the same page as nLastItem
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ]), .F., nNumCols )
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ] ), .F., nNumCols )
nPos := nLastItem
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ]), .T., nNumCols )
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ] ), .T., nNumCols )
ELSE
nGap := nPos - nAtTop
nPos := Min( nLastItem, nPos + nNumRows - 1 )
@@ -410,9 +410,9 @@ FUNCTION AChoice( nTop, nLeft, nBottom, nRight, acItems, xSelect, xUserFunc, nPo
IF nNewPos != nPos
IF INRANGE( nAtTop, nNewPos, nAtTop + nNumRows - 1 )
// On same page
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ]), .F., nNumCols )
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ] ), .F., nNumCols )
nPos := nNewPos
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ]), .T., nNumCols )
DispLine( acItems[ nPos ], nTop + ( nPos - nAtTop ), nLeft, Eval( bSelect, alSelect[ nPos ] ), .T., nNumCols )
ELSE
// On different page
nPos := nNewPos
@@ -512,7 +512,7 @@ STATIC PROCEDURE DispPage( acItems, alSelect, nTop, nLeft, nRight, nNumRows, nPo
LOCAL nSaveRow := Row() // Position at start of routine
LOCAL nSaveCol := Col() // Position at start of routine
Default nRowsClr to nNumRows
DEFAULT nRowsClr TO nNumRows
DispBegin()
@@ -548,7 +548,8 @@ STATIC PROCEDURE DispLine( cLine, nRow, nCol, lSelect, lHiLite, nNumCols )
STATIC FUNCTION Ach_Limits( nFrstItem, nLastItem, nItems, bSelect, alSelect, acItems )
LOCAL nMode, nCntr
LOCAL nMode
LOCAL nCntr
nItems := 0

80
harbour/source/rtl/inkey.c
View File

@@ -76,8 +76,8 @@
#include "hbset.h"
#include "hbvm.h"
static PHB_ITEM s_inKeyBlockBefore = NULL;
static PHB_ITEM s_inKeyBlockAfter = NULL;
static PHB_ITEM s_inkeyBlockBefore = NULL;
static PHB_ITEM s_inkeyBlockAfter = NULL;
HB_FUNC( INKEY )
{
@@ -85,8 +85,8 @@ HB_FUNC( INKEY )
PHB_ITEM pKey = NULL;
int iKey;
if( s_inKeyBlockBefore )
hb_vmEvalBlock( s_inKeyBlockBefore );
if( s_inkeyBlockBefore )
hb_vmEvalBlock( s_inkeyBlockBefore );
do
{
@@ -94,11 +94,11 @@ HB_FUNC( INKEY )
hb_parnd( 1 ),
ISNUM( 2 ) ? hb_parni( 2 ) : hb_set.HB_SET_EVENTMASK );
if( iKey == 0 || !s_inKeyBlockAfter )
if( iKey == 0 || !s_inkeyBlockAfter )
break;
pKey = hb_itemPutNI( pKey, iKey );
iKey = hb_itemGetNI( hb_vmEvalBlockV( s_inKeyBlockAfter, 1, pKey ) );
iKey = hb_itemGetNI( hb_vmEvalBlockV( s_inkeyBlockAfter, 1, pKey ) );
hb_inkeySetLast( iKey );
}
while( iKey == 0 );
@@ -111,37 +111,38 @@ HB_FUNC( INKEY )
/* temporary disabled */
#if 0
static BOOL s_fInit = FALSE;
static void hb_inKeyBlockFree( void * cargo )
static void hb_inkeyBlockFree( void * cargo )
{
HB_SYMBOL_UNUSED( cargo );
if( s_inKeyBlockBefore )
if( s_inkeyBlockBefore )
{
hb_itemRelease( s_inKeyBlockBefore );
s_inKeyBlockBefore = NULL;
hb_itemRelease( s_inkeyBlockBefore );
s_inkeyBlockBefore = NULL;
}
if( s_inKeyBlockAfter )
if( s_inkeyBlockAfter )
{
hb_itemRelease( s_inKeyBlockAfter );
s_inKeyBlockAfter = NULL;
hb_itemRelease( s_inkeyBlockAfter );
s_inkeyBlockAfter = NULL;
}
}
static void hb_inKeySetDestructor( void )
static void hb_inkeySetDestructor( void )
{
if( !s_fInit )
{
s_fInit = TRUE;
hb_vmAtExit( hb_inKeyBlockFree, NULL );
hb_vmAtExit( hb_inkeyBlockFree, NULL );
}
}
HB_FUNC( HB_SETINKEYBEFOREBLOCK )
{
if( s_inKeyBlockBefore )
hb_itemReturn( s_inKeyBlockBefore );
if( s_inkeyBlockBefore )
hb_itemReturn( s_inkeyBlockBefore );
if( hb_pcount() > 0 )
{
@@ -149,20 +150,20 @@ HB_FUNC( HB_SETINKEYBEFOREBLOCK )
if( pBlock )
{
hb_inKeySetDestructor();
hb_inkeySetDestructor();
pBlock = hb_itemNew( pBlock );
}
if( s_inKeyBlockBefore )
hb_itemRelease( s_inKeyBlockBefore );
s_inKeyBlockBefore = pBlock;
if( s_inkeyBlockBefore )
hb_itemRelease( s_inkeyBlockBefore );
s_inkeyBlockBefore = pBlock;
}
}
HB_FUNC( HB_SETINKEYAFTERBLOCK )
{
if( s_inKeyBlockAfter )
hb_itemReturn( s_inKeyBlockAfter );
if( s_inkeyBlockAfter )
hb_itemReturn( s_inkeyBlockAfter );
if( hb_pcount() > 0 )
{
@@ -170,15 +171,16 @@ HB_FUNC( HB_SETINKEYAFTERBLOCK )
if( pBlock )
{
hb_inKeySetDestructor();
hb_inkeySetDestructor();
pBlock = hb_itemNew( pBlock );
}
if( s_inKeyBlockAfter )
hb_itemRelease( s_inKeyBlockAfter );
s_inKeyBlockAfter = pBlock;
if( s_inkeyBlockAfter )
hb_itemRelease( s_inkeyBlockAfter );
s_inkeyBlockAfter = pBlock;
}
}
#endif
HB_FUNC( __KEYBOARD )
@@ -193,25 +195,31 @@ HB_FUNC( __KEYBOARD )
HB_FUNC( HB_KEYPUT )
{
if( ISNUM( 1 ) )
{
hb_inkeyPut( hb_parni( 1 ) );
}
else if( ISCHAR( 1 ) )
{
PHB_ITEM pText = hb_param( 1, HB_IT_STRING );
char * szText = hb_itemGetCPtr( pText );
ULONG ulLen = hb_itemGetCLen( pText ), ulIndex;
for( ulIndex = 0; ulIndex < ulLen; ulIndex++ )
hb_inkeyPut( ( UCHAR ) szText[ ulIndex ] );
hb_inkeySetText( hb_parc( 1 ), hb_parclen( 1 ) );
}
else if( ISARRAY( 1 ) )
{
PHB_ITEM pArray = hb_param( 1, HB_IT_ARRAY );
ULONG ulElements = hb_arrayLen( pArray ), ulIndex;
ULONG ulIndex;
ULONG ulElements = hb_arrayLen( pArray );
for( ulIndex = 1; ulIndex <= ulElements; ulIndex++ )
{
if( hb_arrayGetType( pArray, ulIndex ) & HB_IT_NUMERIC )
hb_inkeyPut( hb_arrayGetNI( pArray, ulIndex ) );
PHB_ITEM pItem = hb_arrayGetItemPtr( pArray, ulIndex );
if( HB_IS_NUMBER( pItem ) )
{
hb_inkeyPut( hb_itemGetNI( pItem ) );
}
else if( HB_IS_STRING( pItem ) )
{
hb_inkeySetText( ( const char * ) hb_itemGetCPtr( pItem ), hb_itemGetCLen( pItem ) );
}
}
}
}

6
harbour/source/rtl/memoedit.prg
View File

@@ -265,8 +265,10 @@ METHOD MoveCursor( nKey ) CLASS HBMemoEditor
/*----------------------------------------------------------------------------------------*/
FUNCTION MemoEdit( cString,;
nTop, nLeft,;
nBottom, nRight,;
nTop,;
nLeft,;
nBottom,;
nRight,;
lEditMode,;
xUserFunction,;
nLineLength,;

301
harbour/source/rtl/tget.prg
View File

@@ -159,8 +159,8 @@ CREATE CLASS Get
METHOD wordLeft()
METHOD wordRight()
METHOD backSpace( lDisplay ) /* NOTE: lDisplay is an undocumented Harbour parameter. Should not be used by app code. [vszakats] */
METHOD delete( lDisplay ) /* NOTE: lDisplay is an undocumented Harbour parameter. Should not be used by app code. [vszakats] */
METHOD backSpace()
METHOD delete()
METHOD delEnd()
METHOD delLeft()
METHOD delRight()
@@ -212,6 +212,11 @@ CREATE CLASS Get
VAR lPicDecRev INIT .F.
VAR lPicBlankZero INIT .F.
METHOD leftLow()
METHOD rightLow()
METHOD backSpaceLow()
METHOD deleteLow()
METHOD DeleteAll()
METHOD IsEditable( nPos )
METHOD Input( cChar )
@@ -703,7 +708,7 @@ METHOD overStrike( cChar ) CLASS Get
::lChanged := .T.
::right( .F. )
::rightLow()
::display()
@@ -775,80 +780,32 @@ METHOD insert( cChar ) CLASS Get
::lChanged := .T.
::right( .F. )
::rightLow()
::display()
RETURN Self
METHOD right( lDisplay ) CLASS Get
LOCAL nPos
METHOD right() CLASS Get
IF ! ::hasFocus
RETURN Self
ENDIF
DEFAULT lDisplay TO .T.
::typeOut := .F.
::lClear := .F.
IF ::nPos == ::nMaxEdit
::typeOut := .T.
RETURN Self
ENDIF
nPos := ::nPos + 1
DO WHILE ! ::IsEditable( nPos ) .AND. nPos <= ::nMaxEdit
nPos++
ENDDO
IF nPos <= ::nMaxEdit
::Pos := nPos
ELSE
::typeOut := .T.
ENDIF
IF lDisplay
IF ::rightLow()
::lSuppDisplay := .T.
::display()
ENDIF
RETURN Self
METHOD left( lDisplay ) CLASS Get
LOCAL nPos
METHOD left() CLASS Get
IF ! ::hasFocus
RETURN Self
ENDIF
DEFAULT lDisplay TO .T.
::typeOut := .F.
::lClear := .F.
IF ::nPos == ::FirstEditable()
::typeOut := .T.
RETURN Self
ENDIF
nPos := ::nPos - 1
DO WHILE ! ::IsEditable( nPos ) .AND. nPos > 0
nPos--
ENDDO
IF nPos > 0
::Pos := nPos
ELSE
::typeOut := .T.
ENDIF
IF lDisplay
IF ::leftLow()
::lSuppDisplay := .T.
::display()
ENDIF
@@ -961,99 +918,33 @@ METHOD toDecPos() CLASS Get
ENDIF
::display()
ENDIF
RETURN Self
METHOD backSpace( lDisplay ) CLASS Get
LOCAL nPos
LOCAL nMinus
METHOD backSpace() CLASS Get
IF ! ::hasFocus
RETURN Self
ENDIF
nPos := ::nPos
DEFAULT lDisplay TO .T.
IF nPos > 1 .AND. nPos == ::FirstEditable() .AND. ::lMinus2
/* To delete the parenthesis (negative indicator) in a non editable position */
nMinus := At( "(", SubStr( ::cBuffer, 1, nPos-1 ) )
IF nMinus > 0 .AND. !( SubStr( ::cPicMask, nMinus, 1 ) == "(" )
::lEdit := .T.
::cBuffer := SubStr( ::cBuffer, 1, nMinus - 1 ) + " " +;
SubStr( ::cBuffer, nMinus + 1 )
::lChanged := .T.
IF lDisplay
::display()
ENDIF
RETURN Self
ENDIF
ENDIF
::left()
IF ::nPos < nPos
::delete( lDisplay )
ENDIF
RETURN Self
METHOD delete( lDisplay ) CLASS Get
LOCAL nMaxLen
LOCAL n
IF ! ::hasFocus
RETURN Self
ENDIF
nMaxLen := ::nMaxLen
DEFAULT lDisplay TO .T.
::lClear := .F.
::lEdit := .T.
IF ::lPicComplex
/* Calculating different nMaxLen for ::lPicComplex */
FOR n := ::nPos TO nMaxLen
IF !::IsEditable( n )
EXIT
ENDIF
NEXT
nMaxLen := n - 1
ENDIF
IF ::cType == "N" .AND. SubStr( ::cBuffer, ::nPos, 1 ) $ "(-"
::lMinus2 := .F.
ENDIF
::cBuffer := PadR( SubStr( ::cBuffer, 1, ::nPos - 1 ) + ;
SubStr( ::cBuffer, ::nPos + 1, nMaxLen - ::nPos ) + " " +;
SubStr( ::cBuffer, nMaxLen + 1 ), ::nMaxLen )
::lChanged := .T.
IF lDisplay
IF ::backSpaceLow()
::display()
ENDIF
RETURN Self
METHOD delete() CLASS Get
IF ! ::hasFocus
RETURN Self
ENDIF
::deleteLow()
::display()
RETURN Self
METHOD delEnd() CLASS Get
LOCAL nPos
@@ -1065,9 +956,9 @@ METHOD delEnd() CLASS Get
nPos := ::nPos
::Pos := ::nMaxEdit
::delete( .F. )
::deleteLow()
DO WHILE ::nPos > nPos
::backSpace( .F. )
::backSpaceLow()
ENDDO
::display()
@@ -1076,16 +967,16 @@ METHOD delEnd() CLASS Get
METHOD delLeft() CLASS Get
::left( .F. )
::delete( .F. )
::leftLow()
::deleteLow()
::right()
RETURN Self
METHOD delRight() CLASS Get
::right( .F. )
::delete( .F. )
::rightLow()
::deleteLow()
::left()
RETURN Self
@@ -1101,7 +992,7 @@ METHOD delWordLeft() CLASS Get
IF !( SubStr( ::cBuffer, ::nPos, 1 ) == " " )
IF SubStr( ::cBuffer, ::nPos - 1, 1 ) == " "
::backSpace( .F. )
::backSpaceLow()
ELSE
::wordRight()
::left()
@@ -1109,11 +1000,11 @@ METHOD delWordLeft() CLASS Get
ENDIF
IF SubStr( ::cBuffer, ::nPos, 1 ) == " "
::delete( .F. )
::deleteLow()
ENDIF
DO WHILE ::nPos > 1 .AND. !( SubStr( ::cBuffer, ::nPos - 1, 1 ) == " " )
::backSpace( .F. )
::backSpaceLow()
ENDDO
::display()
@@ -1135,11 +1026,11 @@ METHOD delWordRight() CLASS Get
ENDIF
DO WHILE ::nPos <= ::nMaxEdit .AND. !( SubStr( ::cBuffer, ::nPos, 1 ) == " " )
::delete( .F. )
::deleteLow()
ENDDO
IF ::nPos <= ::nMaxEdit
::delete( .F. )
::deleteLow()
ENDIF
::display()
@@ -1564,6 +1455,122 @@ METHOD posInBuffer( nRow, nCol ) CLASS Get
/* ------------------------------------------------------------------------- */
METHOD rightLow() CLASS Get
LOCAL nPos
::typeOut := .F.
::lClear := .F.
IF ::nPos == ::nMaxEdit
::typeOut := .T.
RETURN .F.
ENDIF
nPos := ::nPos + 1
DO WHILE ! ::IsEditable( nPos ) .AND. nPos <= ::nMaxEdit
nPos++
ENDDO
IF nPos <= ::nMaxEdit
::Pos := nPos
ELSE
::typeOut := .T.
ENDIF
RETURN .T.
METHOD leftLow() CLASS Get
LOCAL nPos
::typeOut := .F.
::lClear := .F.
IF ::nPos == ::FirstEditable()
::typeOut := .T.
RETURN .F.
ENDIF
nPos := ::nPos - 1
DO WHILE ! ::IsEditable( nPos ) .AND. nPos > 0
nPos--
ENDDO
IF nPos > 0
::Pos := nPos
ELSE
::typeOut := .T.
ENDIF
RETURN .T.
METHOD backSpaceLow() CLASS Get
LOCAL nPos
LOCAL nMinus
nPos := ::nPos
IF nPos > 1 .AND. nPos == ::FirstEditable() .AND. ::lMinus2
/* To delete the parenthesis (negative indicator) in a non editable position */
nMinus := At( "(", SubStr( ::cBuffer, 1, nPos - 1 ) )
IF nMinus > 0 .AND. !( SubStr( ::cPicMask, nMinus, 1 ) == "(" )
::cBuffer := SubStr( ::cBuffer, 1, nMinus - 1 ) + " " +;
SubStr( ::cBuffer, nMinus + 1 )
::lEdit := .T.
::lChanged := .T.
RETURN .T.
ENDIF
ENDIF
::left()
IF ::nPos < nPos
::deleteLow()
RETURN .T.
ENDIF
RETURN .F.
METHOD deleteLow() CLASS Get
LOCAL nMaxLen := ::nMaxLen
LOCAL n
::lClear := .F.
::lEdit := .T.
IF ::lPicComplex
/* Calculating different nMaxLen for ::lPicComplex */
FOR n := ::nPos TO nMaxLen
IF !::IsEditable( n )
EXIT
ENDIF
NEXT
nMaxLen := n - 1
ENDIF
IF ::cType == "N" .AND. SubStr( ::cBuffer, ::nPos, 1 ) $ "(-"
::lMinus2 := .F.
ENDIF
::cBuffer := PadR( SubStr( ::cBuffer, 1, ::nPos - 1 ) + ;
SubStr( ::cBuffer, ::nPos + 1, nMaxLen - ::nPos ) + " " +;
SubStr( ::cBuffer, nMaxLen + 1 ), ::nMaxLen )
::lChanged := .T.
RETURN NIL
METHOD DeleteAll() CLASS Get
LOCAL xValue

6
harbour/source/rtl/tobject.prg
View File

@@ -165,8 +165,4 @@ STATIC FUNCTION HBObject_Error( cDesc, cClass, cMsg, nCode )
DEFAULT nCode TO 1004
IF nCode == 1005
RETURN __errRT_SBASE( EG_NOVARMETHOD, 1005, cDesc, cClass + ":" + cMsg, 1, QSelf() )
ENDIF
RETURN __errRT_SBASE( EG_NOMETHOD, nCode, cDesc, cClass + ":" + cMsg, 1, QSelf() )
RETURN __errRT_SBASE( iif( nCode == 1005, EG_NOVARMETHOD, EG_NOMETHOD ), nCode, cDesc, cClass + ":" + cMsg, 1, QSelf() )

2
harbour/source/rtl/treport.prg
View File

@@ -248,7 +248,7 @@ METHOD New( cFrmName, lPrinter, cAltFile, lNoConsole, bFor, bWhile, nNext, nReco
::nMaxLinesAvail := ::aReportData[RPT_LINES]
// Modify ::aReportData based on the report parameters
IF lSummary == .T. // Set the summary only flag
IF lSummary // Set the summary only flag
::aReportData[ RPT_SUMMARY ] := lSummary
ENDIF
IF lBEject != NIL .AND. lBEject

10
harbour/source/vm/arrayshb.c
View File

@@ -98,7 +98,11 @@ HB_FUNC( ARRAY )
if( hb_parnl( iParam ) < 0 ) /* || hb_parnl( iParam ) <= 4096 */
{
#ifdef HB_C52_STRICT
hb_errRT_BASE( EG_BOUND, 1131, NULL, hb_langDGetErrorDesc( EG_ARRDIMENSION ), 0 );
#else
hb_errRT_BASE( EG_BOUND, 1131, NULL, hb_langDGetErrorDesc( EG_ARRDIMENSION ), HB_ERR_ARGS_BASEPARAMS );
#endif
bError = TRUE;
break;
}
@@ -154,8 +158,12 @@ HB_FUNC( ASIZE )
}
#ifdef HB_COMPAT_C53 /* From CA-Cl*pper 5.3a */
else
#ifdef HB_C52_STRICT
hb_errRT_BASE( EG_ARG, 2023, NULL, "ASIZE", 0 );
#else
hb_errRT_BASE( EG_ARG, 2023, NULL, "ASIZE", HB_ERR_ARGS_BASEPARAMS );
#endif
#endif
}
HB_FUNC( ATAIL )
@@ -246,7 +254,7 @@ HB_FUNC( AFILL )
/* NOTE: In CA-Cl*pper AFILL() is written in a manner that it will
call AEVAL() to do the job, so the error (if any) will also be
thrown by AEVAL(). [vszakats] */
hb_errRT_BASE( EG_ARG, 2017, NULL, "AEVAL", HB_ERR_ARGS_BASEPARAMS );
hb_errRT_BASE( EG_ARG, 2017, NULL, "AEVAL", 0 );
#else
hb_errRT_BASE( EG_ARG, 6004, NULL, "AFILL", HB_ERR_ARGS_BASEPARAMS );
#endif

20
harbour/source/vm/hvm.c
View File

@@ -4195,7 +4195,11 @@ static void hb_vmArrayPush( void )
hb_objOperatorCall( HB_OO_OP_ARRAYINDEX, pArray, pArray, pIndex, NULL ) )
hb_stackPop();
else
#ifdef HB_C52_STRICT
hb_errRT_BASE( EG_BOUND, 1132, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ), 0 );
#else
hb_errRT_BASE( EG_BOUND, 1132, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ), 2, pArray, pIndex );
#endif
}
else if( hb_objOperatorCall( HB_OO_OP_ARRAYINDEX, pArray, pArray, pIndex, NULL ) )
hb_stackPop();
@@ -4286,7 +4290,11 @@ static void hb_vmArrayPushRef( void )
return;
}
else
#ifdef HB_C52_STRICT
hb_errRT_BASE( EG_BOUND, 1132, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ), 0 );
#else
hb_errRT_BASE( EG_BOUND, 1132, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ), 2, pArray, pIndex );
#endif
}
else if( hb_objHasOperator( pArray, HB_OO_OP_ARRAYINDEX ) )
{
@@ -4382,7 +4390,11 @@ static void hb_vmArrayPop( void )
hb_stackPop();
}
else
#ifdef HB_C52_STRICT
hb_errRT_BASE( EG_BOUND, 1133, NULL, hb_langDGetErrorDesc( EG_ARRASSIGN ), 0 );
#else
hb_errRT_BASE( EG_BOUND, 1133, NULL, hb_langDGetErrorDesc( EG_ARRASSIGN ), 1, pIndex );
#endif
}
else if( hb_objOperatorCall( HB_OO_OP_ARRAYINDEX, pArray, pArray, pIndex, pValue ) )
{
@@ -9098,8 +9110,12 @@ static void hb_vmArrayItemPush( ULONG ulIndex )
hb_stackItemFromTop( -1 ), NULL ) )
hb_stackPop();
else
#ifdef HB_C52_STRICT
hb_errRT_BASE( EG_BOUND, 1132, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ), 0 );
#else
hb_errRT_BASE( EG_BOUND, 1132, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ),
2, pArray, hb_stackItemFromTop( -1 ) );
#endif
}
}
else if( HB_IS_HASH( pArray ) )
@@ -9177,8 +9193,12 @@ static void hb_vmArrayItemPop( ULONG ulIndex )
hb_stackPop();
}
else
#ifdef HB_C52_STRICT
hb_errRT_BASE( EG_BOUND, 1133, NULL, hb_langDGetErrorDesc( EG_ARRASSIGN ), 0 );
#else
hb_errRT_BASE( EG_BOUND, 1133, NULL, hb_langDGetErrorDesc( EG_ARRASSIGN ),
1, hb_stackItemFromTop( -1 ) );
#endif
}
}
else if( HB_IS_HASH( pArray ) )

14
harbour/source/vm/memvars.c
View File

@@ -1397,10 +1397,17 @@ HB_FUNC( __MVSAVE )
{
fhnd = hb_fsCreate( ( BYTE * ) szFileName, FC_NORMAL );
}
#ifdef HB_C52_STRICT
while( fhnd == FS_ERROR &&
hb_errRT_BASE_Ext1( EG_CREATE, 2006, NULL, szFileName,
hb_fsError(), EF_CANDEFAULT | EF_CANRETRY,
0 ) == E_RETRY );
#else
while( fhnd == FS_ERROR &&
hb_errRT_BASE_Ext1( EG_CREATE, 2006, NULL, szFileName,
hb_fsError(), EF_CANDEFAULT | EF_CANRETRY,
HB_ERR_ARGS_BASEPARAMS ) == E_RETRY );
#endif
if( fhnd != FS_ERROR )
{
@@ -1471,10 +1478,17 @@ HB_FUNC( __MVRESTORE )
{
fhnd = hb_fsOpen( ( BYTE * ) szFileName, FO_READ | FO_DENYWRITE | FO_PRIVATE );
}
#ifdef HB_C52_STRICT
while( fhnd == FS_ERROR &&
hb_errRT_BASE_Ext1( EG_OPEN, 2005, NULL, szFileName,
hb_fsError(), EF_CANDEFAULT | EF_CANRETRY,
0 ) == E_RETRY );
#else
while( fhnd == FS_ERROR &&
hb_errRT_BASE_Ext1( EG_OPEN, 2005, NULL, szFileName,
hb_fsError(), EF_CANDEFAULT | EF_CANRETRY,
HB_ERR_ARGS_BASEPARAMS ) == E_RETRY );
#endif
if( fhnd != FS_ERROR )
{

8
harbour/tests/rto_tb.prg
View File

@@ -811,11 +811,9 @@ PROCEDURE OBJ_CREATE()
RETURN
#ifdef __HARBOUR__
/* We use this to wash out a small incompatibility in Harbour's built-in __eInstVar53(). */
/* We use this to wash out a small incompatibility in Harbour's built-in _eInstVar(). */
FUNCTION _eInstVar( oVar, cMethod, xValue, cType, nSubCode, bValid )
FUNCTION __eInstVar53( oVar, cMethod, xValue, cType, nSubCode, bValid )
LOCAL oError
@@ -837,5 +835,3 @@ FUNCTION _eInstVar( oVar, cMethod, xValue, cType, nSubCode, bValid )
ENDIF
RETURN xValue
#endif