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

19990909-21:30 GMT+1

Browse Source
This commit is contained in:
Viktor Szakats
1999-09-09 19:50:15 +00:00
parent 299327dde1
commit a4593fa0e4
42 changed files with 343 additions and 172 deletions
Download Patch File Download Diff File Expand all files Collapse all files

86
harbour/ChangeLog
View File

@@ -1,3 +1,41 @@
19990909-21:30 GMT+1 Victor Szel <info@szelvesz.hu>
* source/rtl/arrays.c
! hb_arrayCopy() fixed. Now it has two methods, one strictly compatible,
and one which fixes buggy behaviour on extreme parameters. Clipper will
copy one item, even it an out-of-range start, or target position is
passed, I've considered that buggy. You can choose with the
HARBOUR_STRICT_CLIPPER_COMPATIBILITY switch anyway.
* tests/working/rtl_test.prg
+ ACOPY() tests added.
* source/rtl/tgetlist.prg
+ Using getexit.ch include file, instead of repeating its content.
* source/debug/tbrwtext.prg
+ CVS header added.
* include/extend.h
! Some Clipper compatibility include files moved to the bottom, it's
better now, but it still doesn't work when
HARBOUR_STRICT_CLIPPER_COMPATIBILITY is defined.
* source/rtl/tget.prg
source/debug/debugger.prg
+ Using common.ch include file, instead of repeating its content.
DEFAULT := form changed to the standard DEFAULT TO form, which is a
bit more efficient anyway, since it only assigns when needed.
* source/tools/fileread.prg
source/tools/dates2.c
source/tools/hb_f.c
source/vm/dynsym.c
source/hbpp/table.c
source/hbpp/hbppint.c
source/hbpp/hbpp.c
source/compiler/fixflex.c
source/rtl/*.c
* Standardization in header format. Note that we should also standardize
the *text* of the copyright message.
* source/vm/hvm.c
* Small formatting correction.
* source/rtl/xsavescr.prg
+ Reformatted.
19990909-18:22 GMT+1 Victor Szel <info@szelvesz.hu>
* source/rtl/arrays.c
! ARRAY() fixed to parse the dimension list in the right order.
@@ -6,7 +44,7 @@
* tests/working/rtl_test.prg
+ Some new ARRAY() tests added.
* tests/working/extend2.c
; Compiled/linked successfully with Cygwin. There's still incompatibility
; Compiled/linked successfully with Cygwin. There's still incompatibility
since Harbour needs all the C functions to be prefixed with "HB_".
* Changed HARBOUR function types to CLIPPER.
* include/clipdefs.h
@@ -28,8 +66,8 @@
* source/rtl/arrays.c
include/extend.h
! hb_arraySize() - Fixed a memory related bug. Now when an array is
resized to zero length, it will free (and not reallocate) the memory
allocated for the item pointer table. ASIZE({ "A", "B" }, 0) could
resized to zero length, it will free (and not reallocate) the memory
allocated for the item pointer table. ASIZE({ "A", "B" }, 0) could
show the problem.
+ ARRAY() now supprt multiple dimensions. Code based on hb_vmArrayNew().
! Array functions error handling behaviour made completely CA-Clipper
@@ -47,12 +85,12 @@
! __RUN() now checks for the parameter type, not the number,
+ __RUN() funtionality enabled for __CYGWIN__
+ __RUN() will now throw an "operation not supported" runtime error on
platforms where it's not supported, this is IMO better than silently
doing nothing. The error has a Default case, so the use can continue
platforms where it's not supported, this is IMO better than silently
doing nothing. The error has a Default case, so the use can continue
running the program.
! __RUN() Standardized the doc header.
* source/rtl/copyfile.c
+ Made completely compatible in order to pass the tests. A small file
+ Made completely compatible in order to pass the tests. A small file
name forming difference is still there.
* tests/working/rtl_test.prg
+ __COPYFILE() tests added.
@@ -73,37 +111,37 @@
19990909-16:05 GMT+2 Ryszard Glab <rglab@imid.med.pl>
*source/rtl/memvarbl.prg
+ corrected to allow setings of NIL value
+ corrected to allow setings of NIL value
19990909-13:00 GMT+2 Ryszard Glab <rglab@imid.med.pl>
*source/runner/stdalone/external.prg
+ added __MVGET, __MVPUT, MEMVARBLOCK
+ added __MVGET, __MVPUT, MEMVARBLOCK
*include/init.h
+ added 'static' declaration for functions used to initialize
symbols table
+ added 'static' declaration for functions used to initialize
symbols table
19990909-12:45 GMT+2 Ryszard Glab <rglab@imid.med.pl>
*source/rtl/memvars.c
* removed unused variables
* removed unused variables
*source/rtl/memvarbl.prg
+ added new file with MEMVARBLOCK() function
+ added new file with MEMVARBLOCK() function
*source/trl/Makefile
+ added memvarbl.prg to PRG_SOURCES
+ added memvarbl.prg to PRG_SOURCES
19990909-12:00 GMT+2 Ryszard Glab <rglab@imid.med.pl>
*source/rtl/memvars.c
+ added __mvGET and __mvPUT functions to set/get the value of
private and public variables
+ added __mvGET and __mvPUT functions to set/get the value of
private and public variables
*doc/subcodes.txt
* updated info for 3009 and 3010 subcodes used in __mvGET/__mvPUT
* updated info for 3009 and 3010 subcodes used in __mvGET/__mvPUT
19990908-21:35 EDT David G. Holm <dholm@jsd-llc.com>
* include/extend.h
* include/hbdefs.h

14
harbour/include/extend.h
View File

@@ -30,12 +30,6 @@
#include "hbdefs.h"
#include "hb_vmpub.h"
#ifdef HARBOUR_STRICT_CLIPPER_COMPATIBILITY
/* Clipper includes these from extend.h */
#include "extend.api"
#include "fm.api"
#endif
/* items types and type checking macros */
#define IT_NIL ( ( WORD ) 0x0000 )
#define IT_INTEGER ( ( WORD ) 0x0002 )
@@ -369,5 +363,13 @@ extern char * hb_consoleGetNewLine( void );
extern char * hb_setColor( char * );
/* Please leave these at the bottom of this file */
#ifdef HARBOUR_STRICT_CLIPPER_COMPATIBILITY
/* Clipper includes these from extend.h */
#include "extend.api"
#include "fm.api"
#endif
#endif /* HB_EXTEND_H_ */

5
harbour/source/compiler/fixflex.c
View File

@@ -1,5 +1,8 @@
/* $Id$
/*
* $Id$
*/
/*
Harbour Project source code
This file contains an external program that splits the Harbour Flex and

8
harbour/source/debug/debugger.prg
View File

@@ -26,11 +26,7 @@
#include "classes.ch"
#include "inkey.ch"
#include "memvars.ch"
#xcommand DEFAULT <uVar1> := <uVal1> ;
[, <uVarN> := <uValN> ] => ;
<uVar1> := If( <uVar1> == nil, <uVal1>, <uVar1> ) ;;
[ <uVarN> := If( <uVarN> == nil, <uValN>, <uVarN> ); ]
#include "common.ch"
#xcommand MENU [<oMenu>] => [ <oMenu> := ] TDbMenu():New()
#xcommand MENUITEM <cPrompt> [ ACTION <uAction,...> ] => ;
@@ -583,7 +579,7 @@ return nil
METHOD Show( lFocused ) CLASS TDbWindow
DEFAULT lFocused := .f.
DEFAULT lFocused TO .f.
::cBackImage = SaveScreen( ::nTop, ::nLeft, ::nBottom, ::nRight )
SetColor( ::cColor )

4
harbour/source/debug/tbrwtext.prg
View File

@@ -1,3 +1,7 @@
/*
* $Id$
*/
// Browses a text file
#include "classes.ch"

2
harbour/source/hbpp/hbpp.c
View File

@@ -1,6 +1,8 @@
/*
* $Id$
*/
/*
Harbour Project source code
This file contains the main part of preprocessor implementation.

2
harbour/source/hbpp/hbppint.c
View File

@@ -1,6 +1,8 @@
/*
* $Id$
*/
/*
Harbour Project source code
This file contains some functions of preprocessor, which provides

2
harbour/source/hbpp/table.c
View File

@@ -1,6 +1,8 @@
/*
* $Id$
*/
/*
Harbour Project source code
This file contains the tables of predefined #define and #command

143
harbour/source/rtl/alert.prg
View File

@@ -1,5 +1,8 @@
/* $Id$
/*
* $Id$
*/
/*
Harbour Project source code
www - http://www.Harbour-Project.org
@@ -23,7 +26,7 @@
// This is fixed.
// ; nDelay parameter is a Harbour addition.
FUNCTION Alert(xMessage, aOptions, cColorNorm, nDelay)
FUNCTION Alert( xMessage, aOptions, cColorNorm, nDelay )
LOCAL nChoice
LOCAL aSay, nPos, nWidth, nOpWidth, nInitRow, nInitCol, iEval
LOCAL nKey, aPos, nCurrent, aHotkey, aOptionsOK
@@ -44,7 +47,7 @@ FUNCTION Alert(xMessage, aOptions, cColorNorm, nDelay)
#ifdef HARBOUR_STRICT_CLIPPER_COMPATIBILITY
// TODO: Enable this when we have a function for querying the command line
// parameters.
// IF "//NOALERT" $ /* Upper(cCommandLine) */
// IF "//NOALERT" $ /* Upper( cCommandLine ) */
// QUIT
// ENDIF
#endif
@@ -53,58 +56,58 @@ FUNCTION Alert(xMessage, aOptions, cColorNorm, nDelay)
#ifdef HARBOUR_STRICT_CLIPPER_COMPATIBILITY
IF !(ValType(xMessage) == "C")
IF !( ValType( xMessage ) == "C" )
RETURN NIL
ENDIF
DO WHILE (nPos := At(';', xMessage)) != 0
AAdd(aSay, Left(xMessage, nPos - 1))
xMessage := SubStr(xMessage, nPos + 1)
DO WHILE ( nPos := At( ';', xMessage ) ) != 0
AAdd( aSay, Left( xMessage, nPos - 1 ) )
xMessage := SubStr( xMessage, nPos + 1 )
ENDDO
AAdd(aSay, xMessage)
AAdd( aSay, xMessage )
#else
IF ValType(xMessage) == "A"
IF ValType( xMessage ) == "A"
FOR iEval := 1 TO Len(xMessage)
FOR iEval := 1 TO Len( xMessage )
IF ValType( xMessage[ iEval ] ) == "C"
AAdd(aSay, xMessage[ iEval ] )
AAdd( aSay, xMessage[ iEval ] )
ENDIF
NEXT
ELSE
DO CASE
CASE ValType(xMessage) $ "CM" /* Do nothing, just speed up things */
CASE ValType(xMessage) == "N" ; xMessage := LTrim( Str( xMessage ) )
CASE ValType(xMessage) == "D" ; xMessage := DToC( xMessage )
CASE ValType(xMessage) == "L" ; xMessage := iif( xMessage, ".T.", ".F." )
CASE ValType(xMessage) == "O" ; xMessage := xMessage:className + " Object"
CASE ValType(xMessage) == "B" ; xMessage := "{||...}"
OTHERWISE ; xMessage := "NIL"
CASE ValType( xMessage ) $ "CM" /* Do nothing, just speed up things */
CASE ValType( xMessage ) == "N" ; xMessage := LTrim( Str( xMessage ) )
CASE ValType( xMessage ) == "D" ; xMessage := DToC( xMessage )
CASE ValType( xMessage ) == "L" ; xMessage := iif( xMessage, ".T.", ".F." )
CASE ValType( xMessage ) == "O" ; xMessage := xMessage:className + " Object"
CASE ValType( xMessage ) == "B" ; xMessage := "{||...}"
OTHERWISE ; xMessage := "NIL"
ENDCASE
DO WHILE (nPos := At(';', xMessage)) != 0
AAdd(aSay, Left(xMessage, nPos - 1))
xMessage := SubStr(xMessage, nPos + 1)
DO WHILE ( nPos := At( ';', xMessage ) ) != 0
AAdd( aSay, Left( xMessage, nPos - 1 ) )
xMessage := SubStr( xMessage, nPos + 1 )
ENDDO
AAdd(aSay, xMessage)
AAdd( aSay, xMessage )
ENDIF
#endif
IF !(ValType(aOptions) == "A")
IF !( ValType( aOptions ) == "A" )
aOptions := {}
ENDIF
IF !(ValType(cColorNorm) == "C")
cColorNorm := 'w+/r'
cColorHigh := 'w+/b'
IF !( ValType( cColorNorm ) == "C" )
cColorNorm := "W+/R"
cColorHigh := "W+/B"
ELSE
cColorHigh := StrTran(StrTran(iif(At("/", cColorNorm) == 0, "N", SubStr(cColorNorm, At("/", cColorNorm) + 1)) + "/" +;
iif(At("/", cColorNorm) == 0, cColorNorm, Left(cColorNorm, At("/", cColorNorm) - 1)), "+", ""), "*", "")
cColorHigh := StrTran( StrTran( iif( At( "/", cColorNorm ) == 0, "N", SubStr( cColorNorm, At( "/", cColorNorm ) + 1 ) ) + "/" +;
iif( At( "/", cColorNorm ) == 0, cColorNorm, Left( cColorNorm, At( "/", cColorNorm ) - 1 ) ), "+", "" ), "*", "" )
ENDIF
IF nDelay == NIL
@@ -113,59 +116,59 @@ FUNCTION Alert(xMessage, aOptions, cColorNorm, nDelay)
/* The longest line */
nWidth := 0
AEval(aSay, { |x| nWidth := Max(Len(x), nWidth) })
AEval( aSay, {| x | nWidth := Max( Len( x ), nWidth ) } )
/* Cleanup the button array */
aOptionsOK := {}
FOR iEval := 1 TO Len(aOptions)
IF ValType(aOptions[iEval]) == "C" .AND. !Empty(aOptions[iEval])
AAdd(aOptionsOK, aOptions[iEval])
FOR iEval := 1 TO Len( aOptions )
IF ValType( aOptions[ iEval ] ) == "C" .AND. !Empty( aOptions[ iEval ] )
AAdd( aOptionsOK, aOptions[ iEval ] )
ENDIF
NEXT
IF Len(aOptionsOK) == 0
IF Len( aOptionsOK ) == 0
aOptionsOK := { 'Ok' }
#ifdef HARBOUR_STRICT_CLIPPER_COMPATIBILITY
// ; Clipper allows only four options
ELSEIF Len(aOptionsOK) > 4
aSize(aOptionsOK, 4)
ELSEIF Len( aOptionsOK ) > 4
aSize( aOptionsOK, 4 )
#endif
ENDIF
/* Total width of the botton line (the one with choices) */
nOpWidth := 0
AEval(aOptionsOK, { |x| nOpWidth += Len(x) + 4 })
AEval( aOptionsOK, {| x | nOpWidth += Len( x ) + 4 } )
/* what's wider ? */
nWidth := Max(nWidth + 2 + iif(Len(aSay) == 1, 4, 0), nOpWidth + 2)
nWidth := Max( nWidth + 2 + iif( Len( aSay ) == 1, 4, 0 ), nOpWidth + 2 )
/* box coordinates */
nInitRow := Int(((MaxRow() - (Len(aSay) + 4)) / 2) + .5)
nInitCol := Int(((MaxCol() - (nWidth + 2)) / 2) + .5)
nInitRow := Int( ( ( MaxRow() - ( Len( aSay ) + 4 ) ) / 2 ) + .5 )
nInitCol := Int( ( ( MaxCol() - ( nWidth + 2 ) ) / 2 ) + .5 )
/* detect prompts positions */
aPos := {}
aHotkey := {}
nCurrent := nInitCol + Int((nWidth - nOpWidth) / 2) + 2
AEval(aOptionsOK, { |x| AAdd(aPos, nCurrent), AAdd(aHotKey, Upper(Left(x, 1))), nCurrent += Len(x) + 4 })
nCurrent := nInitCol + Int( ( nWidth - nOpWidth ) / 2 ) + 2
AEval( aOptionsOK, {| x | AAdd( aPos, nCurrent ), AAdd( aHotKey, Upper( Left( x, 1 ) ) ), nCurrent += Len( x ) + 4 } )
IF lConsole
FOR iEval := 1 TO Len(aSay)
OutStd(aSay[iEval])
IF iEval < Len(aSay)
OutStd(Chr(13) + Chr(10))
FOR iEval := 1 TO Len( aSay )
OutStd( aSay[ iEval ] )
IF iEval < Len( aSay )
OutStd( Chr( 13 ) + Chr( 10 ) )
ENDIF
NEXT
OutStd(" (")
FOR iEval := 1 TO Len(aOptionsOK)
OutStd(aOptionsOK[iEval])
IF iEval < Len(aOptionsOK)
OutStd(", ")
OutStd( " (" )
FOR iEval := 1 TO Len( aOptionsOK )
OutStd( aOptionsOK[ iEval ] )
IF iEval < Len( aOptionsOK )
OutStd( ", " )
ENDIF
NEXT
OutStd(") ")
OutStd( ") " )
ELSE
@@ -179,15 +182,15 @@ FUNCTION Alert(xMessage, aOptions, cColorNorm, nDelay)
/* save status */
nOldRow := Row()
nOldCol := Col()
nOldCursor := SetCursor(0)
cOldScreen := SaveScreen( nInitRow, nInitCol, nInitRow + Len(aSay) + 3, nInitCol + nWidth + 1 )
nOldCursor := SetCursor( 0 )
cOldScreen := SaveScreen( nInitRow, nInitCol, nInitRow + Len( aSay ) + 3, nInitCol + nWidth + 1 )
/* draw box */
@ nInitRow, nInitCol, nInitRow + Len(aSay) + 3, nInitCol + nWidth + 1 ;
@ nInitRow, nInitCol, nInitRow + Len( aSay ) + 3, nInitCol + nWidth + 1 ;
BOX B_SINGLE + ' ' COLOR cColorNorm
FOR iEval := 1 TO Len(aSay)
@ nInitRow + iEval, nInitCol + 1 + Int(((nWidth - Len(aSay[iEval])) / 2) + .5) SAY aSay[iEval] ;
FOR iEval := 1 TO Len( aSay )
@ nInitRow + iEval, nInitCol + 1 + Int( ( ( nWidth - Len( aSay[ iEval ] ) ) / 2 ) + .5 ) SAY aSay[ iEval ] ;
COLOR cColorNorm
NEXT
@@ -199,13 +202,13 @@ FUNCTION Alert(xMessage, aOptions, cColorNorm, nDelay)
DO WHILE .T.
IF !lConsole
FOR iEval := 1 TO Len(aOptionsOK)
@ nInitRow + Len(aSay) + 2, aPos[iEval] SAY " " + aOptionsOK[iEval] + " " ;
COLOR If(iEval == nChoice, cColorHigh, cColorNorm)
FOR iEval := 1 TO Len( aOptionsOK )
@ nInitRow + Len( aSay ) + 2, aPos[ iEval ] SAY " " + aOptionsOK[ iEval ] + " " ;
COLOR iif( iEval == nChoice, cColorHigh, cColorNorm )
NEXT
ENDIF
nKey := Inkey(nDelay)
nKey := Inkey( nDelay )
DO CASE
CASE nKey == K_ENTER .OR. nKey == 0
@@ -217,23 +220,23 @@ FUNCTION Alert(xMessage, aOptions, cColorNorm, nDelay)
nChoice := 0
EXIT
CASE (nKey == K_LEFT .OR. nKey == K_SH_TAB) .AND. Len(aOptionsOK) > 1
CASE ( nKey == K_LEFT .OR. nKey == K_SH_TAB ) .AND. Len( aOptionsOK ) > 1
nChoice--
IF nChoice == 0
nChoice := Len(aOptionsOK)
nChoice := Len( aOptionsOK )
ENDIF
CASE (nKey == K_RIGHT .OR. nKey == K_TAB) .AND. Len(aOptionsOK) > 1
CASE ( nKey == K_RIGHT .OR. nKey == K_TAB ) .AND. Len( aOptionsOK ) > 1
nChoice++
IF nChoice > Len(aOptionsOK)
IF nChoice > Len( aOptionsOK )
nChoice := 1
ENDIF
CASE aScan(aHotkey, {|x| x == Upper(Chr(nKey)) }) > 0
CASE aScan( aHotkey, {| x | x == Upper( Chr( nKey ) ) } ) > 0
nChoice := aScan(aHotkey, {|x| x == Upper(Chr(nKey)) })
nChoice := aScan( aHotkey, {| x | x == Upper( Chr( nKey ) ) } )
EXIT
ENDCASE
@@ -242,14 +245,14 @@ FUNCTION Alert(xMessage, aOptions, cColorNorm, nDelay)
IF lConsole
OutStd(Chr(nKey))
OutStd( Chr( nKey ) )
ELSE
/* Restore status */
RestScreen( nInitRow, nInitCol, nInitRow + Len(aSay) + 3, nInitCol + nWidth + 1, cOldScreen )
SetCursor(nOldCursor)
SetPos(nOldRow, nOldCol)
RestScreen( nInitRow, nInitCol, nInitRow + Len( aSay ) + 3, nInitCol + nWidth + 1, cOldScreen )
SetCursor( nOldCursor )
SetPos( nOldRow, nOldCol )
/* PostExt */
DO WHILE nOldDispCount-- != 0

26
harbour/source/rtl/arrays.c
View File

@@ -1,6 +1,8 @@
/*
* $Id$
*/
/*
Copyright(C) 1999 by Antonio Linares.
This program is free software; you can redistribute it and/or modify
@@ -114,6 +116,7 @@ BOOL hb_arraySize( PHB_ITEM pArray, ULONG ulLen )
if( ! pBaseArray->ulLen )
{
pBaseArray->pItems = ( PHB_ITEM ) hb_xgrab( ulLen * sizeof( HB_ITEM ) );
for( ulPos = 0; ulPos < ulLen; ulPos++ )
( pBaseArray->pItems + ulPos )->type = IT_NIL;
}
@@ -142,6 +145,7 @@ BOOL hb_arraySize( PHB_ITEM pArray, ULONG ulLen )
pBaseArray->pItems = ( PHB_ITEM ) hb_xrealloc( pBaseArray->pItems, sizeof( HB_ITEM ) * ulLen );
}
}
pBaseArray->ulLen = ulLen;
return TRUE;
@@ -610,20 +614,36 @@ BOOL hb_arrayCopy( PHB_ITEM pSrcArray, PHB_ITEM pDstArray, ULONG * pulStart,
else
ulTarget = 1;
#ifdef HARBOUR_STRICT_CLIPPER_COMPATIBILITY
if( ulSrcLen > 0 )
#else
if( ulStart <= ulSrcLen )
#endif
{
#ifdef HARBOUR_STRICT_CLIPPER_COMPATIBILITY
if( ulStart > ulSrcLen )
ulStart = ulSrcLen;
#endif
if( pulCount && ( *pulCount <= ulSrcLen - ulStart ) )
ulCount = *pulCount;
else
ulCount = ulSrcLen - ulStart + 1;
#ifdef HARBOUR_STRICT_CLIPPER_COMPATIBILITY
if( ulDstLen > 0 )
#else
if( ulTarget <= ulDstLen )
#endif
{
#ifdef HARBOUR_STRICT_CLIPPER_COMPATIBILITY
if( ulTarget > ulDstLen )
ulTarget = ulDstLen;
#endif
if( ulCount > ulDstLen - ulTarget )
ulCount = ulDstLen - ulTarget;
ulCount = ulDstLen - ulTarget + 1;
for( ulTarget--, ulStart--; ulCount > 0; ulCount--, ulStart++ )
hb_itemCopy( pDstBaseArray->pItems + ( ulTarget + ulStart ), pSrcBaseArray->pItems + ulStart );
for( ulTarget--, ulStart--; ulCount > 0; ulCount--, ulStart++, ulTarget++ )
hb_itemCopy( pDstBaseArray->pItems + ulTarget, pSrcBaseArray->pItems + ulStart );
}
}

4
harbour/source/rtl/codebloc.c
View File

@@ -1,6 +1,8 @@
/*
* $Id$
*
*/
/*
Harbour Project source code
This file is a part of Harbour Runtime Library and it contains code

2
harbour/source/rtl/copyfile.c
View File

@@ -1,6 +1,8 @@
/*
* $Id$
*/
/*
Copyright(C) 1999 by Andi Jahja
This program is free software; you can redistribute it and/or modify

4
harbour/source/rtl/descend.c
View File

@@ -1,6 +1,8 @@
/*
* $Id$
*
*/
/*
Harbour Project source code
Copyright(C) 1999 by Jose Lalin.

13
harbour/source/rtl/devoutp.prg
View File

@@ -1,5 +1,8 @@
/* $Id$
/*
* $Id$
*/
/*
Harbour Project source code
This file contains the Harbour function that outputs expressions
@@ -75,6 +78,8 @@
* $END$
*/
FUNCTION DEVOUTPICT( xValue, cPicture, cColor )
DEVOUT( TRANSFORM( xValue, cPicture ), cColor )
RETURN NIL
FUNCTION DevOutPict( xValue, cPicture, cColor )
DevOut( Transform( xValue, cPicture ), cColor )
RETURN NIL

2
harbour/source/rtl/do.c
View File

@@ -1,6 +1,8 @@
/*
* $Id$
*/
/*
Harbour Project source code
This file is a part of Harbour Runtime Library and it contains code

2
harbour/source/rtl/errorapi.c
View File

@@ -1,6 +1,8 @@
/*
* $Id$
*/
/*
Copyright(C) 1999 by Antonio Linares.
This program is free software; you can redistribute it and/or modify

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

@@ -1,6 +1,8 @@
/*
* $Id$
*/
/*
Copyright(C) 1999 by Antonio Linares.
This program is free software; you can redistribute it and/or modify

2
harbour/source/rtl/extend.c
View File

@@ -1,6 +1,8 @@
/*
* $Id$
*/
/*
Copyright(C) 1999 by Antonio Linares.
This program is free software; you can redistribute it and/or modify

2
harbour/source/rtl/fm.c
View File

@@ -1,6 +1,8 @@
/*
* $Id$
*/
/*
Copyright(C) 1999 by Antonio Linares.
This program is free software; you can redistribute it and/or modify

4
harbour/source/rtl/hardcr.c
View File

@@ -1,6 +1,8 @@
/*
* $Id$
*
*/
/*
Harbour Project source code
Copyright(C) 1999 by Jose Lalin.

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

@@ -1,5 +1,8 @@
/* $Id$
/*
* $Id$
*/
/*
Harbour Project source code
This module contains the Harbour functions for INKEY management.

2
harbour/source/rtl/itemapi.c
View File

@@ -1,6 +1,8 @@
/*
* $Id$
*/
/*
Copyright(C) 1999 by Antonio Linares.
This program is free software; you can redistribute it and/or modify

1
harbour/source/rtl/math.c
View File

@@ -1,6 +1,7 @@
/*
* $Id$
*/
/* Harbour Project source code
http://www.Harbour-Project.org/
The following function is Copyright 1999 David G. Holm:

1
harbour/source/rtl/memvarbl.prg
View File

@@ -1,6 +1,7 @@
/*
* $Id$
*/
/*
Harbour Project source code

4
harbour/source/rtl/memvars.c
View File

@@ -1,6 +1,8 @@
/*
* $Id$
*
*/
/*
Harbour Project source code
This file is a part of Harbour Runtime Library and it contains code

3
harbour/source/rtl/mtran.c
View File

@@ -1,5 +1,8 @@
/*
* $Id$
*/
/*
Harbour Project source code
Copyright(C) 1999 by Jose Lalin.

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

@@ -34,12 +34,12 @@
*/
FUNCTION ReadVar( cVarName )
STATIC scVarName := ""
STATIC s_cVarName := ""
LOCAL cOldVarName := scVarName
LOCAL cOldVarName := s_cVarName
IF ValType( cVarName ) == "C"
scVarName := cVarName
s_cVarName := cVarName
ENDIF
RETURN cOldVarName

5
harbour/source/rtl/set.c
View File

@@ -1,5 +1,8 @@
/* $Id$
/*
* $Id$
*/
/*
Harbour Project source code
This module contains the Harbour functions for SET management.

2
harbour/source/rtl/setcolor.c
View File

@@ -1,6 +1,8 @@
/*
* $Id$
*/
/*
Copyright(C) 1999 by Paul Tucker
This program is free software; you can redistribute it and/or modify

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

@@ -1,6 +1,8 @@
/*
* $Id$
*/
/*
Harbour Project source code - http://www.Harbour-Project.org
By: A White - awhite@user.rose.com

2
harbour/source/rtl/strings.c
View File

@@ -1,6 +1,8 @@
/*
* $Id$
*/
/*
Copyright(C) 1999 by Antonio Linares.
This program is free software; you can redistribute it and/or modify

4
harbour/source/rtl/tclass.prg
View File

@@ -2,8 +2,6 @@
* $Id$
*/
// Harbour Class TClass to build classes
/*
Copyright(C) 1999 by Antonio Linares.
@@ -31,6 +29,8 @@
* Support for default DATA values
*/
// Harbour Class TClass to build classes
#include "hboo.ch"
//----------------------------------------------------------------------------//

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

@@ -1,6 +1,8 @@
/*
* $Id$
*/
/*
Copyright(C) 1999 by Antonio Linares.
This program is free software; you can redistribute it and/or modify

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

@@ -26,11 +26,7 @@
#include "classes.ch"
#include "color.ch"
#xcommand DEFAULT <uVar1> := <uVal1> ;
[, <uVarN> := <uValN> ] => ;
<uVar1> := If( <uVar1> == nil, <uVal1>, <uVar1> ) ;;
[ <uVarN> := If( <uVarN> == nil, <uValN>, <uVarN> ); ]
#include "common.ch"
//----------------------------------------------------------------------------//
@@ -93,11 +89,11 @@ METHOD New(nRow, nCol, bVarBlock, cVarName, cPicture, cColor) CLASS TGet
local cChar
local nAt, nFor
DEFAULT nRow := Row() ,;
nCol := Col() ,;
cVarName := "" ,;
cPicture := "" ,;
cColor := ""
DEFAULT nRow TO Row()
DEFAULT nCol TO Col()
DEFAULT cVarName TO ""
DEFAULT cPicture TO ""
DEFAULT cColor TO ""
::badDate := .f.
::block := bVarBlock
@@ -313,7 +309,7 @@ METHOD Untransform(cBuffer) CLASS TGet
local cChar
local nFor
DEFAULT cBuffer := ::buffer
DEFAULT cBuffer TO ::buffer
do case
case ::type == "C"
@@ -671,8 +667,8 @@ METHOD PutMask(xValue, lEdit) CLASS TGet
local cChar, cBuffer
local nFor, nLen, nAt
DEFAULT xValue := ::VarGet() ,;
lEdit := ::hasfocus
DEFAULT xValue TO ::VarGet()
DEFAULT lEdit TO ::hasfocus
cBuffer := Transform(xValue, Alltrim(::cPicFunc+" "+::cPicMask))

11
harbour/source/rtl/tgetlist.prg
View File

@@ -25,19 +25,10 @@
*/
#include "classes.ch"
#include "getexit.ch"
#include "inkey.ch"
#include "set.ch"
#define GE_NOEXIT 0
#define GE_UP 1
#define GE_DOWN 2
#define GE_TOP 3
#define GE_BOTTOM 4
#define GE_ENTER 5
#define GE_WRITE 6
#define GE_ESCAPE 7
#define GE_WHEN 8
#define SCORE_ROW 0
#define SCORE_COL 60

28
harbour/source/rtl/xsavescr.prg
View File

@@ -1,15 +1,21 @@
/* $Id$
*
/*
* $Id$
*/
STATIC cScrn
STATIC s_cScrn
Procedure __XSAVESCREEN()
cScrn := {Row(), Col(), SaveScreen()}
PROCEDURE __XSAVESCREEN()
procedure __XRESTSCREEN()
IF cScrn <> NIL
RestScreen( ,,,,cScrn[3] )
SetPos( cScrn[1], cScrn[2] )
ENDIF
cScrn := NIL
s_cScrn := { Row(), Col(), SaveScreen() }
RETURN
PROCEDURE __XRESTSCREEN()
IF s_cScrn != NIL
RestScreen( , , , , s_cScrn[ 3 ] )
SetPos( s_cScrn[ 1 ], s_cScrn[ 2 ] )
s_cScrn := NIL
ENDIF
RETURN

4
harbour/source/tools/dates2.c
View File

@@ -1,6 +1,8 @@
/*
* $Id$
*
*/
/*
Harbour Project source code
Copyright(C) 1999 by Jose Lalin.

5
harbour/source/tools/fileread.prg
View File

@@ -1,5 +1,8 @@
/* $Id$
/*
* $Id$
*/
/*
Harbour Project source code
A class that reads a file one line at a time

2
harbour/source/tools/hb_f.c
View File

@@ -1,6 +1,8 @@
/*
* $Id$
*/
/*
Copyright(C) 1999 by Andi Jahja
This program is free software; you can redistribute it and/or modify

4
harbour/source/vm/dynsym.c
View File

@@ -2,8 +2,8 @@
* $Id$
*/
/* Harbour dynamic symbol table management
*
/*
* Harbour dynamic symbol table management
* Copyright(C) 1999 by Antonio Linares.
*
* This program is free software; you can redistribute it and/or modify

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

@@ -67,7 +67,7 @@ static void hb_vmReleaseLocalSymbols( void ); /* releases the memory of the
static void hb_vmDebuggerShowLine( WORD wLine ); /* makes the debugger shows a specific source code line */
static void hb_vmDebuggerEndProc( void ); /* notifies the debugger for an endproc */
static void hb_vmArrayNew( HB_ITEM_PTR, WORD ); /* creates array */
static void hb_vmArrayNew( HB_ITEM_PTR, WORD ); /* creates array */
#ifdef HARBOUR_OBJ_GENERATION
static void hb_vmProcessObjSymbols ( void ); /* process Harbour generated OBJ symbols */

69
harbour/tests/working/rtl_test.prg
View File

@@ -52,6 +52,12 @@
#translate TEST_LINE( <x>, <result> ) => TEST_CALL( <(x)>, {|| <x> }, <result> )
#define TEST_RESULT_COL1_WIDTH 1
#define TEST_RESULT_COL2_WIDTH 4
#define TEST_RESULT_COL3_WIDTH 40
#define TEST_RESULT_COL4_WIDTH 55
#define TEST_RESULT_COL5_WIDTH 40
STATIC s_nPass
STATIC s_nFail
STATIC s_cFileName
@@ -1653,6 +1659,7 @@ STATIC FUNCTION Main_MISC()
TEST_LINE( aSize( NIL, -1 ) , NIL )
TEST_LINE( aSize( {}, -1 ) , "{.[0].}" )
TEST_LINE( aSize( { 1 }, -1 ) , "{.[0].}" )
TEST_LINE( aSize( { 1 }, 5000 ) , "{.[1].}" )
TEST_LINE( aSize( ErrorNew(), -1 ) , "ERROR Object" )
TEST_LINE( aSize( ErrorNew(), 100 ) , "ERROR Object" )
TEST_LINE( aAdd( NIL, NIL ) , "E BASE 1123 Argument error AADD F:S" )
@@ -1708,6 +1715,42 @@ STATIC FUNCTION Main_MISC()
TEST_LINE( TAStr(aFill(TANew(),"X", 21, 3)) , ".........." )
TEST_LINE( TAStr(aFill(TANew(),"X", 21,20)) , ".........." )
/* ACOPY() */
TEST_LINE( TAStr(aCopy(TARng(),TANew(), 1 )) , "ABCDEFGHIJ" )
TEST_LINE( TAStr(aCopy(TARng(),TANew(), 1, 0 )) , ".........." )
TEST_LINE( TAStr(aCopy(TARng(),TANew(), 1, 3 )) , "ABC......." )
TEST_LINE( TAStr(aCopy(TARng(),TANew(), 1, 20 )) , "ABCDEFGHIJ" )
TEST_LINE( TAStr(aCopy(TARng(),TANew(), 3 )) , "CDEFGHIJ.." )
TEST_LINE( TAStr(aCopy(TARng(),TANew(), 3, 0 )) , ".........." )
TEST_LINE( TAStr(aCopy(TARng(),TANew(), 3, 3 )) , "CDE......." )
TEST_LINE( TAStr(aCopy(TARng(),TANew(), 3, 20 )) , "CDEFGHIJ.." )
TEST_LINE( TAStr(aCopy(TARng(),TANew(), 21 )) , ".........." ) /* Bug in CA-Cl*pper, it returns: "J........." */
TEST_LINE( TAStr(aCopy(TARng(),TANew(), 21, 0 )) , ".........." )
TEST_LINE( TAStr(aCopy(TARng(),TANew(), 21, 3 )) , ".........." ) /* Bug in CA-Cl*pper, it returns: "J........." */
TEST_LINE( TAStr(aCopy(TARng(),TANew(), 21, 20 )) , ".........." ) /* Bug in CA-Cl*pper, it returns: "J........." */
TEST_LINE( TAStr(aCopy(TARng(),TANew(), 1,NIL, 1)) , "ABCDEFGHIJ" )
TEST_LINE( TAStr(aCopy(TARng(),TANew(), 1, 0, 1)) , ".........." )
TEST_LINE( TAStr(aCopy(TARng(),TANew(), 1, 3, 0)) , "ABC......." )
TEST_LINE( TAStr(aCopy(TARng(),TANew(), 1, 3, 2)) , ".ABC......" )
TEST_LINE( TAStr(aCopy(TARng(),TANew(), 1, 3, 8)) , ".......ABC" )
TEST_LINE( TAStr(aCopy(TARng(),TANew(), 1, 3, 20)) , ".........." ) /* Bug in CA-Cl*pper, it returns: ".........A" */
TEST_LINE( TAStr(aCopy(TARng(),TANew(), 1, 20, 1)) , "ABCDEFGHIJ" )
TEST_LINE( TAStr(aCopy(TARng(),TANew(), 3,NIL, 3)) , "..CDEFGHIJ" )
TEST_LINE( TAStr(aCopy(TARng(),TANew(), 3, 0, 3)) , ".........." )
TEST_LINE( TAStr(aCopy(TARng(),TANew(), 3, 3, 0)) , "CDE......." )
TEST_LINE( TAStr(aCopy(TARng(),TANew(), 3, 3, 2)) , ".CDE......" )
TEST_LINE( TAStr(aCopy(TARng(),TANew(), 3, 3, 8)) , ".......CDE" )
TEST_LINE( TAStr(aCopy(TARng(),TANew(), 3, 3, 20)) , ".........." ) /* Bug in CA-Cl*pper, it returns: ".........C" */
TEST_LINE( TAStr(aCopy(TARng(),TANew(), 3, 20, 3)) , "..CDEFGHIJ" )
TEST_LINE( TAStr(aCopy(TARng(),TANew(), 21,NIL, 21)) , ".........." ) /* Bug in CA-Cl*pper, it returns: ".........J" */
TEST_LINE( TAStr(aCopy(TARng(),TANew(), 21, 0, 21)) , ".........." )
TEST_LINE( TAStr(aCopy(TARng(),TANew(), 21, 3, 0)) , ".........." ) /* Bug in CA-Cl*pper, it returns: "J........." */
TEST_LINE( TAStr(aCopy(TARng(),TANew(), 21, 3, 2)) , ".........." ) /* Bug in CA-Cl*pper, it returns: ".J........" */
TEST_LINE( TAStr(aCopy(TARng(),TANew(), 21, 3, 8)) , ".........." ) /* Bug in CA-Cl*pper, it returns: ".......J.." */
TEST_LINE( TAStr(aCopy(TARng(),TANew(), 21, 3, 20)) , ".........." ) /* Bug in CA-Cl*pper, it returns: ".........J" */
TEST_LINE( TAStr(aCopy(TARng(),TANew(), 21, 20, 21)) , ".........." ) /* Bug in CA-Cl*pper, it returns: ".........J" */
/* ASCAN() */
TEST_LINE( aScan() , 0 )
@@ -1756,12 +1799,6 @@ STATIC FUNCTION Main_MISC()
RETURN NIL
#define TEST_RESULT_COL1_WIDTH 1
#define TEST_RESULT_COL2_WIDTH 4
#define TEST_RESULT_COL3_WIDTH 30
#define TEST_RESULT_COL4_WIDTH 55
#define TEST_RESULT_COL5_WIDTH 40
STATIC FUNCTION TEST_BEGIN( cParam )
LOCAL cOs
@@ -2070,7 +2107,7 @@ STATIC FUNCTION ListToNArray( cString )
RETURN aArray
STATIC FUNCTION TANew( nLen, cChar )
STATIC FUNCTION TANew( cChar, nLen )
LOCAL aArray
LOCAL tmp
@@ -2087,7 +2124,23 @@ STATIC FUNCTION TANew( nLen, cChar )
/* Intentionally not using aFill() here, since this function is
involved in testing aFill() itself. */
FOR tmp := 1 TO nLen
aArray[ tmp ] := "."
aArray[ tmp ] := cChar
NEXT
RETURN aArray
STATIC FUNCTION TARng( nLen )
LOCAL aArray
LOCAL tmp
IF nLen == NIL
nLen := 10
ENDIF
aArray := Array( nLen )
FOR tmp := 1 TO nLen
aArray[ tmp ] := Chr( Asc( "A" ) + tmp - 1 )
NEXT
RETURN aArray