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

19991025-12:37 GMT+1 Victor Szel <info@szelvesz.hu>

Browse Source
This commit is contained in:
Viktor Szakats
1999-10-25 11:25:54 +00:00
parent 4202930381
commit 521ffcf660
78 changed files with 2577 additions and 1036 deletions
Download Patch File Download Diff File Expand all files Collapse all files

376
harbour/ChangeLog
View File

@@ -1,3 +1,188 @@
19991025-12:37 GMT+1 Victor Szel <info@szelvesz.hu>
+ source/tools/ctcrypt.c
+ source/tools/ctchrmix.c
+ CA-Tools compatible CRYPT() function added. (named CT_CRYPT())
+ CA-Tools compatible CHARMIX() function added. (named CT_CHARMIX())
* source/rtl/fm.c
! hb_xfree() fixed, so that it will not GPF when a NULL pointer is
passed.
% Some cleanup, one variable eliminated and code optimized out when
the STATISTICS mode is turned off.
! Non-STATISTICS mode fixed in hb_xquery()
* source/rdd/dbcmd.c
! hb_rddSelectWorkAreaAlias() fixed to handle workarea numbers as strings
(exm: "1") and single character workarea aliases ("A"-"K")
! hb_rddSelectWorkAreaSymbol() fixed to handle the single character
workarea aliases ("A"-"K")
Bruno, please review these.
! SELECT(), DBSELECTAREA() fixed handling of workarea numbers passed as
strings, and workarea numbers passed as single characters ("A"-"K")
* include/gtapi.h
source/rtl/console.c
source/rtl/gtapi.c
source/rtl/gt/*.c
% hb_gt_DrawShadow() moved to the high level API, the whole process
got cleaned up. Simpler, less redundant and more compatible now.
! hb_gtDrawShadow() off-screen situations fixed.
* All functions with "ptucker" mark moved to the copyright section.
+ HB_SYMBOL_UNUSED() added to gt_tpl.c
- hb_gt_GetCursorSize() removed from the template gt_tpl.c
* source/rtl/gt/gtwin.c
* Small cleanups, variable names standardized, scopes adjusted.
! Fixed Scroll() in fill mode for Win9x OS.
* source/rtl/oldclear.c
source/rtl/oldbox.c
! #ifdef HARBOUR_USE_GTAPI guards added.
* include/hboo.ch
source/rtl/classes.c
source/rtl/objfunc.prg
source/rtl/tclass.prg
source/tools/stringp.prg
tests/dynobj.prg
tests/objects.prg
tests/overload.prg
* #define names prefixed with HB_ to avoid collision with user programs.
Some other slight changes applied to the name prefixes.
+ include/hbmemory.ch
include/Makefile
source/rtl/fm.c
source/vm/hvm.c
+ New header file for MEMORY() parameters.
+ #include "hbmemory.ch" added
+ Using HB_MEM_ constants.
* include/hbmemvar.ch
source/debug/debugger.prg
source/rtl/memvarbl.prg
source/rtl/menuto.prg
source/rtl/memvars.c
* #define names prefixed with HB_ to avoid collision with user programs.
* source/rtl/memvarbl.prg
! Non-STRICT COMPATIBLE branch removed.
- #include "hbsetup.ch" removed
* tests/begin.prg
tests/inherit.prg (bugfix)
tests/statinit.prg
tests/strip.prg (bugfix)
tests/tstcolor.prg (bugfix from today)
! Warning and bug fixed showed by the /w switch.
* source/tools/charmix.c
source/tools/chareven.c
source/tools/charmix.c
! GT_CHARMIX(), GT_CHAREVEN(), GT_CHARODD()
Fixed to use hb_retclen() instead of hb_retc().
* include/hbdefs.h
+ Cleaner namings for some macro arguments.
+ HB_MKULONG() macro added.
+ source/rdd/dbstrux.prg
source/rdd/Makefile
source/rtl/dummy.prg
doc/funclist.txt
+ __DBCOPYSTRUCT(), __DBCOPYXSTRUCT(), __DBCREATE() functions added.
WARNING ! Please update non-GNU make files.
* source/rtl/dir.c
! DIRECTORY() *very* small compatibility fix for the order of returned
attribute chars.
* source/vm/hvm.c
! hb_vmForTest() error handler value substitution support added.
* source/rtl/browdb.prg
* Small formatting.
* source/rtl/tget.prg
source/rtl/memoline.c
source/rtl/mlcount.c
* Typo (char with different codepage) corrected.
* source/rtl/tget.prg
! SAY/DevPos() converted to SetPos(), DispOutAt().
+ End() made more compatible.
% Display() optimized, variable removed, cursor setting removed.
* source/rtl/tgetlist.prg
% Cursor setting on/off removed from ShowScoreBoard().
* source/rtl/strings.c
! UPPER(), LOWER() were modifying the item buffer directly. Fixed.
! UPPER(), LOWER() some internal item access changed to Item API calls.
+ UPPER(), LOWER(), LEFT(), SUBSTR(), VAL(), AT(), ALLTRIM(), LTRIM(),
RTRIM()/TRIM(), STRTRAN() value substitution on error added.
! SUBSTR() made compatible in a rare error case. (SubStr(C,N,C))
! AT() GPFd on passed types other than string.
! Fixed the small difference between RTRIM() and TRIM(), they are
100% identical since the same pcode is generated for both in Clipper.
; Now all error substitutions are covered in STRINGS.C
* ALLTRIM() is now launching a Clipper 5.3 compatible error by default
instead of returning an empty string.
! hb_strAt() now returns 0 when an empty string is searched, this matches
the Clipper behaviour, but the regression test was fooled by the
(buggy) compiler optimalization.
* tests/rtl_test.prg
tests/strings3.prg
+ UPPER(), LOWER(), TRIM(), RTRIM(), LTRIM(), ALLTRIM() regression tests
added. Some Upper() tests are failing. Some STRTRAN() fail tests added,
Clipper 5.2e STRTRAN() error recovering bug discovered.
+ SUBSTR(), LEFT(), RIGHT(), AT(), RAT(), VAL() tests added for
error conditions.
* ALLTRIM() error condition results updated to reflect the change above.
* "" $ and AT("", test results corrected, CA-Cl*pper behaviour documented.
+ STRINGS3.PRG moved to RTL_TEST (some)
+ ACOPY() expected test results adjusted accordging to the stricter ACOPY()
compatibility.
* source/rtl/arrays.c
! hb_arrayCopy()/ACOPY() is now 100% Clipper compatible, the STRICT option
removed, it's always strict now.
* source/rtl/binnum.c
+ BIN2U(), U2BIN(), W2BIN() XBase++ compatible functions added. All
guarded with HB_COMPAT_XPP (defined by default) (not tested)
* source/rtl/dates.c
include/hbextern.ch
source/runner/stdalone/external.prg
+ STOD() put between HB_COMPAT_XPP guards, since it belongs to XBase++
and is not part of base Clipper.
+ HB_STOD() Harbour extension function added, same as STOD() but with
consistent naming.
* source/rtl/dircmd.prg
* STOD() -> HB_STOD()
* source/rtl/mouse/mousewin.c
+ hb_mouse_CountButton() added for Win32.
* source/rtl/mouseapi.c
source/rtl/filesys.c
+ Clipper 5.3 functions put between HB_COMPAT_C53 guards.
+ One function added to the proper Copyright holder.
* include/hbsetup.h
source/rtl/mousexxx.c
* HARBOUR_USE_MSAPI setup #define removed, from now on the USE_GTAPI
setting will choose the mouse driver, too, since the mouse handling
is highly related to the output (GT) driver.
+ HARBOUR_USE_STD_GTAPI #define added as a start for the std stream IO
GT API, which is currently called "non-GT" mode.
* source/rtl/console.c
include/hbextern.ch
source/runner/stdalone/external.prg
source/rtl/tbrowse.prg
source/rtl/tget.prg
tests/rtl_test.prg
* __COLORINDEX() function renamed to HB_COLORINDEX()
+ source/rtl/isprint.c
+ source/rtl/net.c
source/rtl/Makefile
source/rtl/dummy.prg
doc/funclist.txt
+ ISPRINTER() function first draft.
+ NETNAME() implemented for the Win32 platform. Implementation note
for DOS added.
WARNING ! Please update non-GNU make files.
* include/fileio.ch
include/filesys.h
! FO_INHERITED and FO_PRIVATE flags moved to the .H file for better
Clipper compatibility.
* source/rtl/tone.c
* __DJGPP -> __DJGPP__ (cosmetic only __DJGPP was also valid)
* source/rtl/mouse/mousetpl.c
! Small correction (0->FALSE)
+ source/rtl/gt/gtstd.c
+ source/rtl/mouse/mousestd.c
source/rtl/gtxxx.c
source/rtl/mousexxx.c
+ Standard ANSI C GT/MOUSE drivers added. GT needs some more work.
* source/rtl/inkey.c
% Win32 local variables made static, name prefixed with "s_"
19991022-16:21 GMT+1 Victor Szel <info@szelvesz.hu>
* source/rtl/strings.c
! REPLICATE(), SPACE() error value substitution support added.
@@ -148,91 +333,91 @@
Thu Oct 21 14:09:07 1999 Gonzalo A. Diethelm <Gonzalo.Diethelm@jda.cl>
* source/rtl/gt/gtlin.c:
A first, very basic, implementation of GT for Linux using
curses. At this point, all I have tested is that tests/hello.prg
works acceptably well when compiled with -DHARBOUR_USE_LIN_GTAPI.
There are LOTS of functionality missing still.
* source/rtl/gt/gtlin.c:
A first, very basic, implementation of GT for Linux using
curses. At this point, all I have tested is that tests/hello.prg
works acceptably well when compiled with -DHARBOUR_USE_LIN_GTAPI.
There are LOTS of functionality missing still.
Thu Oct 21 14:02:53 1999 Gonzalo A. Diethelm <Gonzalo.Diethelm@jda.cl>
* config/linux/gcc.cf:
Added linking against ncurses.
* config/linux/gcc.cf:
Added linking against ncurses.
* include/gtapi.h:
Added hb_gtReadKey() and hb_gt_ReadKey() functions.
* include/gtapi.h:
Added hb_gtReadKey() and hb_gt_ReadKey() functions.
* include/hbsetup.h:
* source/rtl/gtxxx.c:
Made sure LIN_GTAPI is taken into account.
* include/hbsetup.h:
* source/rtl/gtxxx.c:
Made sure LIN_GTAPI is taken into account.
* source/rtl/console.c:
* source/rtl/filesys.c:
* source/rtl/gtapi.c:
* source/rtl/inkey.c:
* source/rtl/gt/gtwin.c:
Fixed several warnings.
* source/rtl/console.c:
* source/rtl/filesys.c:
* source/rtl/gtapi.c:
* source/rtl/inkey.c:
* source/rtl/gt/gtwin.c:
Fixed several warnings.
Thu Oct 21 11:56:55 1999 Gonzalo A. Diethelm <Gonzalo.Diethelm@jda.cl>
* source/common/hbtrace.c:
Modified the TRACE function so that it does no superfluous copying
anymore.
* source/common/hbtrace.c:
Modified the TRACE function so that it does no superfluous copying
anymore.
* source/compiler/Makefile:
* source/runner/stdalone/Makefile:
* tests/Makefile:
Added the common library to the list of dependencies.
* source/compiler/Makefile:
* source/runner/stdalone/Makefile:
* tests/Makefile:
Added the common library to the list of dependencies.
* source/pp/hbpp.c:
* source/pp/hbppint.c:
* source/pp/hbpplib.c:
* source/pp/table.c:
* source/pp/stdalone/hbpp.c:
Made sure tracing is enabled only when both HB_DO_TRACE and
HB_REALLY_DO_TRACE are defined; this way, the user can just set
HB_DO_TRACE to enable tracing in harbour, but not see all the
tracing output while compiling harbour itself.
* source/pp/hbpp.c:
* source/pp/hbppint.c:
* source/pp/hbpplib.c:
* source/pp/table.c:
* source/pp/stdalone/hbpp.c:
Made sure tracing is enabled only when both HB_DO_TRACE and
HB_REALLY_DO_TRACE are defined; this way, the user can just set
HB_DO_TRACE to enable tracing in harbour, but not see all the
tracing output while compiling harbour itself.
* source/rtl/arrays.c:
* source/rtl/classes.c:
* source/rtl/codebloc.c:
* source/rtl/console.c:
* source/rtl/copyfile.c:
* source/rtl/dates.c:
* source/rtl/descend.c:
* source/rtl/dir.c:
* source/rtl/environ.c:
* source/rtl/errorapi.c:
* source/rtl/extend.c:
* source/rtl/filesys.c:
* source/rtl/fm.c:
* source/rtl/gtapi.c:
* source/rtl/hardcr.c:
* source/rtl/inkey.c:
* source/rtl/itemapi.c:
* source/rtl/langapi.c:
* source/rtl/math.c:
* source/rtl/memvars.c:
* source/rtl/mouseapi.c:
* source/rtl/mtran.c:
* source/rtl/natmsg.c:
* source/rtl/samples.c:
* source/rtl/set.c:
* source/rtl/setcolor.c:
* source/rtl/strings.c:
* source/rtl/tone.c:
* source/rtl/transfrm.c:
Added tracing to all functions.
* source/rtl/arrays.c:
* source/rtl/classes.c:
* source/rtl/codebloc.c:
* source/rtl/console.c:
* source/rtl/copyfile.c:
* source/rtl/dates.c:
* source/rtl/descend.c:
* source/rtl/dir.c:
* source/rtl/environ.c:
* source/rtl/errorapi.c:
* source/rtl/extend.c:
* source/rtl/filesys.c:
* source/rtl/fm.c:
* source/rtl/gtapi.c:
* source/rtl/hardcr.c:
* source/rtl/inkey.c:
* source/rtl/itemapi.c:
* source/rtl/langapi.c:
* source/rtl/math.c:
* source/rtl/memvars.c:
* source/rtl/mouseapi.c:
* source/rtl/mtran.c:
* source/rtl/natmsg.c:
* source/rtl/samples.c:
* source/rtl/set.c:
* source/rtl/setcolor.c:
* source/rtl/strings.c:
* source/rtl/tone.c:
* source/rtl/transfrm.c:
Added tracing to all functions.
19991021-15:35 GMT+2 Ryszard Glab <rglab@imid.med.pl>
*include/extend.h
*source/rtl/memvars.c
*source/vm/hvm.c
* new function hb_memvarNewParameter() used to create a variable
listed on PARAMETER statement (corrected bug - private variables
are created instead of reusing existing ones)
* new function hb_memvarNewParameter() used to create a variable
listed on PARAMETER statement (corrected bug - private variables
are created instead of reusing existing ones)
19991021-16:02 GMT+3 Alexander Kresin
* contrib/odbc/todbc.prg
@@ -292,39 +477,39 @@ Thu Oct 21 11:56:55 1999 Gonzalo A. Diethelm <Gonzalo.Diethelm@jda.cl>
Wed Oct 20 19:28:51 1999 Gonzalo A. Diethelm <Gonzalo.Diethelm@jda.cl>
* source/Makefile:
* source/common/Makefile:
* source/common/hbtrace.c:
* include/hbtrace.h:
Added a common/ library where all "common" stuff should be
implemented. For starters, I placed here a rudimentary tracing
facility. Basically, all functions should be of the form:
* source/Makefile:
* source/common/Makefile:
* source/common/hbtrace.c:
* include/hbtrace.h:
Added a common/ library where all "common" stuff should be
implemented. For starters, I placed here a rudimentary tracing
facility. Basically, all functions should be of the form:
int foo(char* name /* other parameters */)
{
HB_TRACE(("foo(%s)", name));
int foo(char* name /* other parameters */)
{
HB_TRACE(("foo(%s)", name));
/* implementation */
}
/* implementation */
}
If harbour is compiled with HB_DO_TRACE defined, then this will
generate a trace on stderr of all functions being called (caution:
it generates LOTS of output!!!). If HB_DO_TRACE is not defined,
the HB_TRACE() lines are defined out and there is no performance
hit.
If harbour is compiled with HB_DO_TRACE defined, then this will
generate a trace on stderr of all functions being called (caution:
it generates LOTS of output!!!). If HB_DO_TRACE is not defined,
the HB_TRACE() lines are defined out and there is no performance
hit.
* include/hbdefs.h:
Included hbtrace.h.
* include/hbdefs.h:
Included hbtrace.h.
* source/pp/hbpp.c:
* source/pp/hbppint.c:
* source/pp/hbpplib.c:
* source/pp/stdalone/Makefile:
* source/pp/stdalone/hbpp.c:
Added tracing calls as a "proof of concept".
* source/pp/hbpp.c:
* source/pp/hbppint.c:
* source/pp/hbpplib.c:
* source/pp/stdalone/Makefile:
* source/pp/stdalone/hbpp.c:
Added tracing calls as a "proof of concept".
* source/rtl/gt/gtwin.c:
Fixed two minor typos.
* source/rtl/gt/gtwin.c:
Fixed two minor typos.
19991020-21:30 GMT+1 Victor Szel <info@szelvesz.hu>
* source/rtl/achoice.prg
@@ -3733,7 +3918,8 @@ NOTE: You have to recompile all PRG sources!
* ChangeLog
ChangeLog.003
* Old ChangeLog renamed to ChangeLog.003
* New ChangeLog created. * source/pp/pragma.c
* New ChangeLog created.
* source/pp/pragma.c
* contrib/dot/pp_harb.ch
* tests/inline_c.prg
* STOPDUMP renamed as ENDDUMP (with Ron permission)

16
harbour/doc/funclist.txt
View File

@@ -9,9 +9,9 @@
;
; Where:
; <state> - R[eady], S[tarted], N[ot Started]
; <platform> - dos[-bcc31][+T]
; dos[-djgpp][+T]
; dos[-watcom][+T]
; <platform> - dos[-bcc31]
; dos[-djgpp]
; dos[-watcom]
; w32[-bcc32][+T]
; w32[-gcc][+T]
; w32[-icc][+T]
@@ -159,7 +159,7 @@ ISALPHA ;R;
ISCOLOR ;S;
ISDIGIT ;R;
ISLOWER ;R;
ISPRINTER ;N;
ISPRINTER ;S;dos
ISUPPER ;R;
L2BIN ;R;
LASTKEY ;S;
@@ -188,7 +188,7 @@ MOD ;R;
MONTH ;R;
MPOSTOLC ;N;
NETERR ;R;
NETNAME ;N;
NETNAME ;S;w32+T
NEXTKEY ;S;
NOSNOW ;R;
OS ;S;
@@ -283,9 +283,9 @@ __CopyFile ;R;
__dbApp ;N;
__dbContinue ;N;
__dbCopy ;N;
__dbCopyStruct ;N;
__dbCopyXStruct ;N;
__dbCreate ;N;
__dbCopyStruct ;R;
__dbCopyXStruct ;R;
__dbCreate ;R;
__dbDelim ;N;
__dbJoin ;N;
__dbList ;N;

1
harbour/include/Makefile
View File

@@ -48,6 +48,7 @@ PRG_HEADERS=\
hboo.ch \
hbclass.ch \
hbextern.ch \
hbmemory.ch \
hbmemvar.ch \
hbsetup.ch \
inkey.ch \

4
harbour/include/fileio.ch
View File

@@ -70,10 +70,6 @@
#define FO_DENYNONE 0x0040 /* Do not deny any further attempts to open the file */
#define FO_SHARED FO_DENYNONE
/* File inheritance flags */
#define FO_INHERITED 0x0000 /* Spawned processes can inherit this file handle */
#define FO_PRIVATE 0x0080 /* Spawned processes can not inherit this file handle */
/* File seek mode flags */
#define FS_SET 0x0000 /* Seek from beginning of file */
#define FS_RELATIVE 0x0001 /* Seek from current file poitner */

4
harbour/include/filesys.h
View File

@@ -65,6 +65,10 @@ typedef int FHANDLE;
#define FL_LOCK 0x0000 /* Lock a region */
#define FL_UNLOCK 0x0001 /* Unlock a region */
/* File inheritance flags */
#define FO_INHERITED 0x0000 /* Spawned processes can inherit this file handle */
#define FO_PRIVATE 0x0080 /* Spawned processes can not inherit this file handle */
/* Extended file open mode flags */
#define FXO_TRUNCATE 0x0100 /* Create (truncate if exists) */
#define FXO_APPEND 0x0200 /* Create (append if exists) */

2
harbour/include/gtapi.h
View File

@@ -56,6 +56,7 @@ extern USHORT hb_gtColorSelect( USHORT uiColorIndex );
extern USHORT hb_gtDispBegin( void );
extern USHORT hb_gtDispCount( void );
extern USHORT hb_gtDispEnd( void );
extern USHORT hb_gtDrawShadow( USHORT uiTop, USHORT uiLeft, USHORT uiBottom, USHORT uiRight, BYTE byAttr );
extern USHORT hb_gtGetBlink( BOOL * pbBlink );
extern USHORT hb_gtGetColorStr( char * pszColorString );
extern USHORT hb_gtGetCursor( USHORT * puiCursorShape );
@@ -99,7 +100,6 @@ extern void hb_gt_Puts( USHORT uiRow, USHORT uiCol, BYTE byAttr, BYTE * pbyStr
extern void hb_gt_GetText( USHORT uiTop, USHORT uiLeft, USHORT uiBottom, USHORT uiRight, BYTE * pbyDst );
extern void hb_gt_PutText( USHORT uiTop, USHORT uiLeft, USHORT uiBottom, USHORT uiRight, BYTE * pbySrc );
extern void hb_gt_SetAttribute( USHORT uiTop, USHORT uiLeft, USHORT uiBottom, USHORT uiRight, BYTE byAttr );
extern void hb_gt_DrawShadow( USHORT uiTop, USHORT uiLeft, USHORT uiBottom, USHORT uiRight, BYTE byAttr );
extern void hb_gt_DispBegin( void );
extern void hb_gt_DispEnd( void );
extern BOOL hb_gt_SetMode( USHORT uiRows, USHORT uiCols );

13
harbour/include/hbdefs.h
View File

@@ -98,11 +98,14 @@ typedef unsigned long ULONG;
#define HB_LOBYTE( w ) ( ( BYTE ) ( w ) )
#define HB_HIBYTE( w ) ( ( BYTE ) ( ( ( USHORT ) ( w ) >> 8 ) & 0xFF ) )
#define HB_MKSHORT( b1, b2 ) ( ( SHORT ) ( ( ( SHORT ) b2 ) << 8 ) | b1 )
#define HB_MKUSHORT( b1, b2 ) ( ( USHORT ) ( ( ( USHORT ) b2 ) << 8 ) | b1 )
#define HB_MKLONG( b1, b2, b3, b4 ) ( ( ( long ) b4 ) << 24 ) | \
( ( ( long ) b3 ) << 16 ) | \
( ( ( long ) b2 ) << 8 ) | b1
#define HB_MKSHORT( lo, hi ) ( ( SHORT ) ( ( ( SHORT ) hi ) << 8 ) | lo )
#define HB_MKUSHORT( lo, hi ) ( ( USHORT ) ( ( ( USHORT ) hi ) << 8 ) | lo )
#define HB_MKLONG( b1, b2, b3, b4 ) ( ( ( LONG ) b4 ) << 24 ) | \
( ( ( LONG ) b3 ) << 16 ) | \
( ( ( LONG ) b2 ) << 8 ) | b1
#define HB_MKULONG( b1, b2, b3, b4 ) ( ( ( ULONG ) b4 ) << 24 ) | \
( ( ( ULONG ) b3 ) << 16 ) | \
( ( ( ULONG ) b2 ) << 8 ) | b1
#define HB_SYMBOL_UNUSED( symbol ) ( void ) symbol

3
harbour/include/hbextern.ch
View File

@@ -171,7 +171,7 @@ EXTERNAL SETBLINK
EXTERNAL SETMODE
EXTERNAL __ACCEPT
EXTERNAL __ACCEPTSTR
EXTERNAL __COLORINDEX
EXTERNAL HB_COLORINDEX
//
//symbols from file: rtl\copyfile.c
//
@@ -183,6 +183,7 @@ EXTERNAL CTOD
EXTERNAL DTOC
EXTERNAL DTOS
EXTERNAL STOD
EXTERNAL HB_STOD
EXTERNAL DAY
EXTERNAL MONTH
EXTERNAL YEAR

63
harbour/include/hbmemory.ch Normal file
View File

@@ -0,0 +1,63 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* Header file for MEMORY() function
*
* Copyright 1999 Victor Szel <info@szelvesz.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 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) 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 HRL
* and/or HVM code into it.
*
* 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 program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
/* NOTE: This file is also used by C code. */
#ifndef HB_MEMORY_CH_
#define HB_MEMORY_CH_
/* Parameters for Memory() function */
/* Standard */
#define HB_MEM_CHAR 0 /* Free Variable Space (KB) */
#define HB_MEM_BLOCK 1 /* Largest String (KB) */
#define HB_MEM_RUN 2 /* RUN Memory (KB) */
/* CA-Cl*pper undocumented */
#define HB_MEM_VM 3 /* Virtual Memory (KB) */
#define HB_MEM_EMS 4 /* Free Expanded Memory (KB) (?) */
#define HB_MEM_FM 101 /* Fixed Memory/Heap (KB) (?) */
#define HB_MEM_FMSEGS 102 /* Segments in Fixed Memory/Heap (?) */
#define HB_MEM_SWAP 103 /* Free Swap Memory (KB) */
#define HB_MEM_CONV 104 /* Free Conventional (KB) */
#define HB_MEM_EMSUSED 105 /* Used Expanded Memory (KB) (?) */
/* Harbour extensions */
#define HB_MEM_USED 1001 /* Memory used (bytes) */
#define HB_MEM_USEDMAX 1002 /* Maximum memory used (bytes) */
#define HB_MEM_STACKITEMS 1003 /* Total items on the stack */
#define HB_MEM_STACK 1004 /* Total memory size used by the stack (bytes) */
#endif /* HB_MEMORY_CH_ */

16
harbour/include/hbmemvar.ch
View File

@@ -38,13 +38,13 @@
#ifndef HB_MEMVAR_CH_
#define HB_MEMVAR_CH_
/* Values returned from __MVSCOPE() function */
#define MV_NOT_FOUND -2 /* not found in the symbols table */
#define MV_UNKNOWN -1 /* not created yet */
#define MV_ERROR 0 /* information cannot be obtained */
#define MV_PUBLIC 1 /* PUBLIC variable */
#define MV_PRIVATE_GLOBAL 2 /* PRIVATE created outside of current function/procedure */
#define MV_PRIVATE_LOCAL 4 /* PRIVATE created in current function/procedure */
#define MV_PRIVATE 6 /* PRIVATE variable */
/* Values returned from __mvScope() function */
#define HB_MV_NOT_FOUND -2 /* not found in the symbols table */
#define HB_MV_UNKNOWN -1 /* not created yet */
#define HB_MV_ERROR 0 /* information cannot be obtained */
#define HB_MV_PUBLIC 1 /* PUBLIC variable */
#define HB_MV_PRIVATE_GLOBAL 2 /* PRIVATE created outside of current function/procedure */
#define HB_MV_PRIVATE_LOCAL 4 /* PRIVATE created in current function/procedure */
#define HB_MV_PRIVATE 6 /* PRIVATE variable */
#endif /* HB_MEMVAR_CH_ */

23
harbour/include/hboo.ch
View File

@@ -38,17 +38,20 @@
#ifndef HB_OO_CH_
#define HB_OO_CH_
#define MET_METHOD 0
#define MET_DATA 1
#define MET_CLASSDATA 2
#define MET_INLINE 3
#define MET_VIRTUAL 4
#define MET_SUPER 5
/* Message types */
#define HB_OO_MSG_METHOD 0
#define HB_OO_MSG_DATA 1
#define HB_OO_MSG_CLASSDATA 2
#define HB_OO_MSG_INLINE 3
#define HB_OO_MSG_VIRTUAL 4
#define HB_OO_MSG_SUPER 5
#define DATA_SYMBOL 1
#define DATA_VALUE 2
/* Data */
#define HB_OO_DATA_SYMBOL 1
#define HB_OO_DATA_VALUE 2
#define CLASSDATA_SYMBOL 1
#define CLASSDATA_VALUE 2
/* ClassData */
#define HB_OO_CLSD_SYMBOL 1
#define HB_OO_CLSD_VALUE 2
#endif /* HB_OO_CH_ */

19
harbour/include/hbsetup.h
View File

@@ -152,34 +152,21 @@
*
* By default they are disabled (symbols are not defined)
*/
/*#define HARBOUR_USE_STD_GTAPI*/
/*#define HARBOUR_USE_DOS_GTAPI*/
/*#define HARBOUR_USE_OS2_GTAPI*/
/*#define HARBOUR_USE_WIN_GTAPI*/
/*#define HARBOUR_USE_LIN_GTAPI*/
/* Indicate that one of the GTAPIs is defined */
#if defined(HARBOUR_USE_DOS_GTAPI) || \
#if defined(HARBOUR_USE_STD_GTAPI) || \
defined(HARBOUR_USE_DOS_GTAPI) || \
defined(HARBOUR_USE_OS2_GTAPI) || \
defined(HARBOUR_USE_WIN_GTAPI) || \
defined(HARBOUR_USE_LIN_GTAPI)
#define HARBOUR_USE_GTAPI
#endif
/* ***********************************************************************
* These symbols defined if we want to use the MOUSE API (and which platform
* to build the MOUSE API for, if using the GNU Make System).
*
* By default they are disabled (symbols are not defined)
*/
/*#define HARBOUR_USE_DOS_MSAPI*/
/*#define HARBOUR_USE_OS2_MSAPI*/
/*#define HARBOUR_USE_WIN_MSAPI*/
/* Indicate that one of the GTAPIs is defined */
#if defined(HARBOUR_USE_DOS_MSAPI) || defined(HARBOUR_USE_OS2_MSAPI) || defined(HARBOUR_USE_WIN_MSAPI)
#define HARBOUR_USE_MSAPI
#endif
/* ***********************************************************************
* Operating system specific definitions
*/

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

@@ -368,14 +368,14 @@ METHOD ShowVars() CLASS TDebugger
::oBrwVars:ForceStable() ), nil ), If( nKey == K_UP, ( ::oBrwVars:Up(),;
::oBrwVars:ForceStable() ), nil ) }
nCount = __mvDBGINFO( MV_PUBLIC )
nCount = __mvDBGINFO( HB_MV_PUBLIC )
for i = 1 to nCount
xValue = __mvDBGINFO( MV_PUBLIC, i, @cName )
xValue = __mvDBGINFO( HB_MV_PUBLIC, i, @cName )
AAdd( ::aVars, { cName, "Public" } )
next
nCount = __mvDBGINFO( MV_PRIVATE )
nCount = __mvDBGINFO( HB_MV_PRIVATE )
for i = 1 to nCount
xValue = __mvDBGINFO( MV_PRIVATE, i, @cName )
xValue = __mvDBGINFO( HB_MV_PRIVATE, i, @cName )
AAdd( ::aVars, { cName, "Private" } )
next

1
harbour/source/rdd/Makefile
View File

@@ -13,6 +13,7 @@ C_SOURCES=\
PRG_SOURCES=\
dbf0.prg \
dbstrux.prg \
sdf0.prg \
delim0.prg \
rddord.prg \

137
harbour/source/rdd/dbcmd.c
View File

@@ -897,65 +897,81 @@ ERRCODE hb_rddSelectWorkAreaSymbol( PHB_SYMB pSymAlias )
bResult = hb_rddSelectWorkAreaNumber( pSymAlias->pDynSym->hArea );
else
{
/* generate an error with retry possibility
* (user created error handler can open a missing database)
*/
USHORT uiAction = E_RETRY;
HB_ITEM_PTR pError;
char * szName = pSymAlias->pDynSym->pSymbol->szName;
pError = hb_errRT_New( ES_ERROR, NULL, EG_NOALIAS, 1002,
NULL, pSymAlias->szName, 0, EF_CANRETRY );
bResult = FAILURE;
while( uiAction == E_RETRY )
if( strlen( szName ) == 1 && toupper( szName[ 0 ] ) >= 'A' && toupper( szName[ 0 ] ) <= 'K' )
bResult = hb_rddSelectWorkAreaNumber( toupper( szName[ 0 ] ) - 'A' + 1 );
else
{
uiAction = hb_errLaunch( pError );
if( uiAction == E_RETRY )
if( pSymAlias->pDynSym->hArea )
{
bResult = hb_rddSelectWorkAreaNumber( pSymAlias->pDynSym->hArea );
uiAction = E_DEFAULT;
}
/* generate an error with retry possibility
* (user created error handler can open a missing database)
*/
USHORT uiAction = E_RETRY;
HB_ITEM_PTR pError;
pError = hb_errRT_New( ES_ERROR, NULL, EG_NOALIAS, 1002,
NULL, pSymAlias->szName, 0, EF_CANRETRY );
bResult = FAILURE;
while( uiAction == E_RETRY )
{
uiAction = hb_errLaunch( pError );
if( uiAction == E_RETRY )
if( pSymAlias->pDynSym->hArea )
{
bResult = hb_rddSelectWorkAreaNumber( pSymAlias->pDynSym->hArea );
uiAction = E_DEFAULT;
}
}
hb_errRelease( pError );
}
hb_errRelease( pError );
}
return bResult;
}
ERRCODE hb_rddSelectWorkAreaAlias( char * szName )
{
PHB_DYNS pSymArea;
ERRCODE bResult;
ULONG ulLen = strlen( szName );
pSymArea = hb_dynsymFindName( szName );
if( pSymArea && pSymArea->hArea )
bResult = hb_rddSelectWorkAreaNumber( pSymArea->hArea );
if( ulLen >= 1 && toupper( szName[ 0 ] ) > '0' && toupper( szName[ 0 ] ) <= '9' )
bResult = hb_rddSelectWorkAreaNumber( atoi( szName ) );
else if( ulLen == 1 && toupper( szName[ 0 ] ) >= 'A' && toupper( szName[ 0 ] ) <= 'K' )
bResult = hb_rddSelectWorkAreaNumber( toupper( szName[ 0 ] ) - 'A' + 1 );
else
{
/* generate an error with retry possibility
* (user created error handler can open a missing database)
*/
USHORT uiAction = E_RETRY;
HB_ITEM_PTR pError;
PHB_DYNS pSymArea;
pError = hb_errRT_New( ES_ERROR, NULL, EG_NOALIAS, 1002,
NULL, szName, 0, EF_CANRETRY );
bResult = FAILURE;
while( uiAction == E_RETRY )
pSymArea = hb_dynsymFindName( szName );
if( pSymArea && pSymArea->hArea )
bResult = hb_rddSelectWorkAreaNumber( pSymArea->hArea );
else
{
uiAction = hb_errLaunch( pError );
if( uiAction == E_RETRY )
/* generate an error with retry possibility
* (user created error handler can open a missing database)
*/
USHORT uiAction = E_RETRY;
HB_ITEM_PTR pError;
pError = hb_errRT_New( ES_ERROR, NULL, EG_NOALIAS, 1002,
NULL, szName, 0, EF_CANRETRY );
bResult = FAILURE;
while( uiAction == E_RETRY )
{
pSymArea = hb_dynsymFindName( szName );
if( pSymArea && pSymArea->hArea )
uiAction = hb_errLaunch( pError );
if( uiAction == E_RETRY )
{
bResult = hb_rddSelectWorkAreaNumber( pSymArea->hArea );
uiAction = E_DEFAULT;
pSymArea = hb_dynsymFindName( szName );
if( pSymArea && pSymArea->hArea )
{
bResult = hb_rddSelectWorkAreaNumber( pSymArea->hArea );
uiAction = E_DEFAULT;
}
}
}
hb_errRelease( pError );
}
hb_errRelease( pError );
}
return bResult;
@@ -1364,7 +1380,7 @@ HARBOUR HB_DBCREATE( void )
uiLen = hb_parclen( 3 );
if( uiLen > 0 )
{
hb_strncpyUpper( cDriverBuffer, hb_parc( 3 ), uiLen );
hb_strncpyUpper( cDriverBuffer, hb_parc( 3 ), uiLen );
szDriver = cDriverBuffer;
}
else
@@ -1406,7 +1422,7 @@ HARBOUR HB_DBCREATE( void )
}
/* Create a new WorkArea node */
pCurrArea = ( LPAREANODE ) hb_xgrab( sizeof( AREANODE ) );
if( pRddNode->uiAreaSize == 0 ) /* Calculate the size of WorkArea */
@@ -1901,11 +1917,23 @@ HARBOUR HB_DBSELECTAREA( void )
if( ISCHAR( 1 ) )
{
ULONG ulLen;
szAlias = hb_parc( 1 );
if( ( uiNewArea = hb_rddSelect( szAlias ) ) == 0 )
ulLen = strlen( szAlias );
if( ulLen >= 1 && szAlias[ 0 ] >= '0' && szAlias[ 0 ] <= '9' )
uiNewArea = atoi( szAlias );
else if( ulLen == 1 && toupper( szAlias[ 0 ] ) >= 'A' && toupper( szAlias[ 0 ] ) <= 'K' )
uiNewArea = toupper( szAlias[ 0 ] ) - 'A' + 1;
else
{
hb_errRT_BASE( EG_NOALIAS, 1002, NULL, szAlias );
return;
if( ( uiNewArea = hb_rddSelect( szAlias ) ) == 0 )
{
hb_errRT_BASE( EG_NOALIAS, 1002, NULL, szAlias );
return;
}
}
}
else
@@ -2146,7 +2174,7 @@ HARBOUR HB_DBUSEAREA( void )
{
if( uiLen > HARBOUR_MAX_RDD_DRIVERNAME_LENGTH )
uiLen = HARBOUR_MAX_RDD_DRIVERNAME_LENGTH;
hb_strncpyUpper( szDriverBuffer, hb_parc( 2 ), uiLen );
hb_strncpyUpper( szDriverBuffer, hb_parc( 2 ), uiLen );
szDriver = szDriverBuffer;
}
else
@@ -2338,13 +2366,13 @@ HARBOUR HB_FIELDPOS( void )
if( pCurrArea )
{
char szName[ HARBOUR_MAX_RDD_FIELDNAME_LENGTH ];
hb_strncpyUpper( szName, hb_parc( 1 ), hb_parclen( 1 ) );
uiCount = 0;
pField = ( ( AREAP ) pCurrArea->pArea )->lpFields;
while( pField )
{
++uiCount;
++uiCount;
if( strcmp( szName, ( ( PHB_DYNS ) pField->sym )->pSymbol->szName ) == 0 )
{
hb_retni( uiCount );
@@ -2501,7 +2529,7 @@ HARBOUR HB_RDDREGISTER( void )
uiLen = hb_parclen( 1 );
if( uiLen > 0 )
{
hb_strncpyUpper( szDriver, hb_parc( 1 ), uiLen );
hb_strncpyUpper( szDriver, hb_parc( 1 ), uiLen );
/*
* hb_rddRegister returns:
*
@@ -2522,7 +2550,7 @@ HARBOUR HB_RDDSETDEFAULT( void )
hb_rddCheck();
hb_retc( szDefDriver );
uiLen = hb_parclen( 1 );
if( uiLen > 0 )
{
@@ -2598,9 +2626,14 @@ HARBOUR HB_RLOCK( void )
HARBOUR HB_SELECT( void )
{
char * szAlias;
ULONG ulLen;
szAlias = hb_parc( 1 );
if( strlen( szAlias ) > 0 )
ulLen = strlen( szAlias );
if( ulLen == 1 && toupper( szAlias[ 0 ] ) >= 'A' && toupper( szAlias[ 0 ] ) <= 'K' )
hb_retni( toupper( szAlias[ 0 ] ) - 'A' + 1 );
else if( ulLen > 0 )
hb_retni( hb_rddSelect( szAlias ) );
else
hb_retni( uiCurrArea );
@@ -2612,7 +2645,7 @@ HARBOUR HB_USED( void )
}
/* NOTE: Same as dbSetDriver() and rddSetDefault(), but doesn't
throw any error if the driver doesn't exist, this is
throw any error if the driver doesn't exist, this is
required in the RDDSYS INIT function, since it's not guaranteed
that the RDD is already registered at that point. */
@@ -2627,7 +2660,7 @@ HARBOUR HB___RDDSETDEFAULT( void )
szNewDriver = hb_parc( 1 );
if( ( uiLen = strlen( szNewDriver ) ) > 0 )
{
hb_strncpyUpper( cDriverBuffer, szNewDriver, uiLen );
hb_strncpyUpper( cDriverBuffer, szNewDriver, uiLen );
szDefDriver = ( char * ) hb_xrealloc( szDefDriver, uiLen + 1 );
strcpy( szDefDriver, cDriverBuffer );
}

169
harbour/source/rdd/dbstrux.prg Normal file
View File

@@ -0,0 +1,169 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* __DBCOPYSTRUCT(), __DBCOPYXSTRUCT(), __DBCREATE() functions
*
* Copyright 1999 {list of individual authors and e-mail addresses}
* 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 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) 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 HRL
* and/or HVM code into it.
*
* 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 program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
#include "common.ch"
#include "dbstruct.ch"
FUNCTION __dbCopyStruct( cFileName, aFieldList )
RETURN dbCreate( cFileName, __dbStructFilter( dbStruct(), aFieldList ) )
FUNCTION __dbCopyXStruct( cFileName )
LOCAL nOldArea
LOCAL lError := .F.
LOCAL oError
LOCAL aStruct
IF Empty( aStruct := dbStruct() )
RETURN .F.
ENDIF
nOldArea := Select()
BEGIN SEQUENCE
dbSelectArea( 0 )
__dbCreate( cFileName, NIL, NIL, .F., NIL )
aEval( aStruct, {| aField | iif( aField[ DBS_TYPE ] == "C" .AND. aField[ DBS_LEN ] > 255, ;
( aField[ DBS_DEC ] := Int( aField[ DBS_LEN ] / 256 ), aField[ DBS_LEN ] := aField[ DBS_LEN ] % 256 ), NIL ) } )
aEval( aStruct, {| aField | dbAppend(),;
FIELD->FIELD_NAME := aField[ DBS_NAME ],;
FIELD->FIELD_TYPE := aField[ DBS_TYPE ],;
FIELD->FIELD_LEN := aField[ DBS_LEN ], ;
FIELD->FIELD_DEC := aField[ DBS_DEC ] } )
/* NOTE: CA-Cl*pper has a bug, where only a plain RECOVER statement is
used here, so oError will always be NIL. */
RECOVER USING oError
lError := .T.
END SEQUENCE
IF Select() != nOldArea
dbCloseArea()
dbSelectArea( nOldArea )
ENDIF
IF lError
Break( oError )
ENDIF
RETURN .T.
FUNCTION __dbCreate( cFileName, cFileFrom, cRDDName, lNew, cAlias )
LOCAL nOldArea := Select()
LOCAL aStruct := {}
LOCAL oError
DEFAULT lNew TO .F.
DEFAULT cAlias TO cFileName
IF Used() .AND. !lNew
dbCloseArea()
ENDIF
hb_FNameSplit( cAlias, NIL, @cAlias )
BEGIN SEQUENCE
IF Empty( cFileFrom )
dbCreate( cFileName, {;
{ "FIELD_NAME", "C", 10, 0 },;
{ "FIELD_TYPE", "C", 1, 0 },;
{ "FIELD_LEN" , "N", 3, 0 },;
{ "FIELD_DEC" , "N", 3, 0 } }, cRDDName )
dbUseArea( .F., cRDDName, cFileName, cAlias )
ELSE
IF lNew
USE ( cFileFrom ) NEW
ELSE
USE ( cFileFrom )
ENDIF
dbEval( {|| aAdd( aStruct, { FIELD->FIELD_NAME ,;
FIELD->FIELD_TYPE ,;
FIELD->FIELD_LEN ,;
FIELD->FIELD_DEC } ) } )
dbCloseArea()
IF lNew
dbSelectArea( nOldArea )
ENDIF
aEval( aStruct, {| aField | iif( aField[ DBS_TYPE ] == "C" .AND. aField[ DBS_DEC ] != 0, ;
aField[ DBS_LEN ] := aField[ DBS_LEN ] + aField[ DBS_DEC ] * 256, NIL ) } )
dbCreate( cFileName, aStruct, cRDDName )
dbUseArea( lNew, cRDDName, cFileName, cAlias )
ENDIF
RECOVER USING oError
dbCloseArea()
Break( oError )
END SEQUENCE
RETURN Used()
/* NOTE: Internal helper function, CA-Cl*pper name is: __FLEDIT() */
FUNCTION __dbStructFilter( aStruct, aFieldList )
LOCAL aStructFiltered
LOCAL bFindName
LOCAL cName
IF Empty( aFieldList )
RETURN aStruct
ENDIF
/* Convert field list to uppercase. */
aStructFiltered := Array( Len( aFieldList ) )
aEval( aFieldList, {| cField, nIndex | aStructFiltered[ nIndex ] := RTrim( Upper( cField ) ) } )
aFieldList := aStructFiltered
/* Build a filtered list of the requested fields. */
aStructFiltered := {}
bFindName := {| aField | aField[ DBS_NAME ] == cName }
aEval( aFieldList, {| cFieldName, nIndex | cName := cFieldName, nIndex := aScan( aStruct, bFindName ),;
iif( nIndex == 0, NIL, aAdd( aStructFiltered, aStruct[ nIndex ] ) ) } )
RETURN aStructFiltered

2
harbour/source/rtl/Makefile
View File

@@ -23,6 +23,7 @@ C_SOURCES=\
gtapi.c \
hardcr.c \
inkey.c \
isprint.c \
itemapi.c \
langapi.c \
math.c \
@@ -33,6 +34,7 @@ C_SOURCES=\
mouseapi.c \
mtran.c \
natmsg.c \
net.c \
oldbox.c \
oldclear.c \
samples.c \

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

@@ -682,31 +682,21 @@ 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 + 1;

104
harbour/source/rtl/binnum.c
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* BIN2W(), BIN2I(), BIN2L(), I2BIN(), L2BIN() functions
* BIN2W(), BIN2I(), BIN2L(), BIN2U(), I2BIN(), L2BIN(), W2BIN(), U2BIN() functions
*
* Copyright 1999 {list of individual authors and e-mail addresses}
* www - http://www.harbour-project.org
@@ -33,6 +33,19 @@
*
*/
/*
* The following parts are Copyright of the individual authors.
* www - http://www.harbour-project.org
*
* Copyright 1999 Victor Szel <info@szelvesz.hu>
* BIN2U()
* W2BIN()
* U2BIN()
*
* See doc/license.txt for licensing terms.
*
*/
#include "extend.h"
#include "itemapi.h"
@@ -100,13 +113,43 @@ HARBOUR HB_BIN2L( void )
hb_retnl( 0 );
}
#ifdef HB_COMPAT_XPP
/* NOTE: XBase++ compatible function */
HARBOUR HB_BIN2U( void )
{
PHB_ITEM pItem = hb_param( 1, IT_STRING );
if( pItem )
{
char * pszString = hb_itemGetCPtr( pItem );
ULONG ulLen = hb_itemGetCLen( pItem );
BYTE byBuffer[ 4 ];
byBuffer[ 0 ] = ( ulLen >= 1 ) ? ( BYTE ) pszString[ 0 ] : 0;
byBuffer[ 1 ] = ( ulLen >= 2 ) ? ( BYTE ) pszString[ 1 ] : 0;
byBuffer[ 2 ] = ( ulLen >= 3 ) ? ( BYTE ) pszString[ 2 ] : 0;
byBuffer[ 3 ] = ( ulLen >= 4 ) ? ( BYTE ) pszString[ 3 ] : 0;
hb_retnl( HB_MKULONG( byBuffer[ 0 ],
byBuffer[ 1 ],
byBuffer[ 2 ],
byBuffer[ 3 ] ) );
}
else
hb_retnl( 0 );
}
#endif
HARBOUR HB_I2BIN( void )
{
char szString[ 2 ];
if( ISNUM( 1 ) )
{
int iValue = hb_parni( 1 );
SHORT iValue = hb_parni( 1 );
szString[ 0 ] = iValue & 0x00FF;
szString[ 1 ] = ( iValue & 0xFF00 ) >> 8;
@@ -120,13 +163,39 @@ HARBOUR HB_I2BIN( void )
hb_retclen( szString, 2 );
}
#ifdef HB_COMPAT_XPP
/* NOTE: XBase++ compatible function */
HARBOUR HB_W2BIN( void )
{
char szString[ 2 ];
if( ISNUM( 1 ) )
{
USHORT uiValue = ( USHORT ) hb_parni( 1 );
szString[ 0 ] = uiValue & 0x00FF;
szString[ 1 ] = ( uiValue & 0xFF00 ) >> 8;
}
else
{
szString[ 0 ] =
szString[ 1 ] = '\0';
}
hb_retclen( szString, 2 );
}
#endif
HARBOUR HB_L2BIN( void )
{
char szString[ 4 ];
if( ISNUM( 1 ) )
{
long lValue = hb_parnl( 1 );
LONG lValue = hb_parnl( 1 );
szString[ 0 ] = lValue & 0x000000FF;
szString[ 1 ] = ( lValue & 0x0000FF00 ) >> 8;
@@ -144,3 +213,32 @@ HARBOUR HB_L2BIN( void )
hb_retclen( szString, 4 );
}
#ifdef HB_COMPAT_XPP
/* NOTE: XBase++ compatible function */
HARBOUR HB_U2BIN( void )
{
char szString[ 4 ];
if( ISNUM( 1 ) )
{
ULONG ulValue = ( ULONG ) hb_parnl( 1 );
szString[ 0 ] = ulValue & 0x000000FF;
szString[ 1 ] = ( ulValue & 0x0000FF00 ) >> 8;
szString[ 2 ] = ( ulValue & 0x00FF0000 ) >> 16;
szString[ 3 ] = ( ulValue & 0xFF000000 ) >> 24;
}
else
{
szString[ 0 ] =
szString[ 1 ] =
szString[ 2 ] =
szString[ 3 ] = '\0';
}
hb_retclen( szString, 4 );
}
#endif

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

@@ -63,24 +63,25 @@ STATIC FUNCTION Skipped( nRecs )
IF LastRec() != 0
IF nRecs == 0
dbSkip( 0 )
ELSEIF nRecs > 0 .AND. Recno() != LastRec() + 1
WHILE nSkipped < nRecs
ELSEIF nRecs > 0 .AND. RecNo() != LastRec() + 1
DO WHILE nSkipped < nRecs
dbSkip( 1 )
IF Eof()
dbSkip( -1 )
EXIT
ENDIF
++nSkipped
nSkipped++
ENDDO
ELSEIF nRecs < 0
WHILE nSkipped > nRecs
DO WHILE nSkipped > nRecs
dbSkip( -1 )
IF Bof()
EXIT
ENDIF
--nSkipped
nSkipped--
ENDDO
ENDIF
ENDIF
RETURN nSkipped

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

@@ -374,12 +374,12 @@ ULONG hb_objHasMsg( PHB_ITEM pObject, char *szString )
*
* <hClass> Class handle
* <cMessage> Message
* <pFunction> MET_METHOD : Pointer to function
* MET_DATA : Index number in array
* MET_CLASSDATA : Index number in array
* MET_INLINE : Code block
* MET_SUPER : Handle of super class
* <nType> see MET_*
* <pFunction> HB_OO_MSG_METHOD : Pointer to function
* HB_OO_MSG_DATA : Index number in array
* HB_OO_MSG_CLASSDATA : Index number in array
* HB_OO_MSG_INLINE : Code block
* HB_OO_MSG_SUPER : Handle of super class
* <nType> see HB_OO_MSG_*
* <xInit> Optional initializer for DATA
*/
HARBOUR HB___CLSADDMSG( void )
@@ -395,7 +395,7 @@ HARBOUR HB___CLSADDMSG( void )
USHORT uiMask = pClass->uiHashKey * BUCKET;
PMETHOD pNewMeth;
if( wType == MET_INLINE && hb_param( 3, IT_BLOCK ) == NULL )
if( wType == HB_OO_MSG_INLINE && hb_param( 3, IT_BLOCK ) == NULL )
{
hb_errRT_BASE( EG_ARG, 3000, NULL, "__CLSADDMSG" );
}
@@ -418,11 +418,11 @@ HARBOUR HB___CLSADDMSG( void )
switch( wType )
{
case MET_METHOD:
case HB_OO_MSG_METHOD:
pNewMeth->pFunction = ( PHB_FUNC ) hb_parnl( 3 );
break;
case MET_DATA:
case HB_OO_MSG_DATA:
pNewMeth->uiData = hb_parnl( 3 );
if( pMessage->pSymbol->szName[ 0 ] == '_' )
pNewMeth->pFunction = hb___msgSetData;
@@ -440,7 +440,7 @@ HARBOUR HB___CLSADDMSG( void )
}
break;
case MET_CLASSDATA:
case HB_OO_MSG_CLASSDATA:
pNewMeth->uiData = hb_parnl( 3 );
if( ( USHORT ) hb_arrayLen( pClass->pClassDatas ) < pNewMeth->uiData )
@@ -462,7 +462,7 @@ HARBOUR HB___CLSADDMSG( void )
}
break;
case MET_INLINE:
case HB_OO_MSG_INLINE:
pNewMeth->uiData = hb_arrayLen( pClass->pInlines ) + 1;
hb_arraySize( pClass->pInlines, pNewMeth->uiData );
hb_arraySet( pClass->pInlines, pNewMeth->uiData,
@@ -470,11 +470,11 @@ HARBOUR HB___CLSADDMSG( void )
pNewMeth->pFunction = hb___msgEvalInline;
break;
case MET_VIRTUAL:
case HB_OO_MSG_VIRTUAL:
pNewMeth->pFunction = hb___msgVirtual;
break;
case MET_SUPER:
case HB_OO_MSG_SUPER:
pNewMeth->uiData = hb_parnl( 3 );
pNewMeth->pFunction = hb___msgSuper;
break;

20
harbour/source/rtl/console.c
View File

@@ -58,7 +58,7 @@
* HB_ISCOLOR()
* HB_NOSNOW()
* HB___ACCEPTSTR()
* HB___COLORINDEX()
* HB_HB_COLORINDEX()
*
* See doc/license.txt for licensing terms.
*
@@ -1019,11 +1019,11 @@ HARBOUR HB___SHADOW( void )
#ifdef HARBOUR_USE_GTAPI
if( hb_pcount() >= 4 )
{
hb_gt_DrawShadow( hb_parni( 1 ) + 1,
hb_parni( 2 ) + 1,
hb_parni( 3 ) + 1,
hb_parni( 4 ) + 1,
ISNUM( 5 ) ? hb_parni( 5 ) : 7 );
hb_gtDrawShadow( hb_parni( 1 ),
hb_parni( 2 ),
hb_parni( 3 ),
hb_parni( 4 ),
ISNUM( 5 ) ? hb_parni( 5 ) : 7 );
}
#endif
}
@@ -1191,13 +1191,13 @@ HARBOUR HB___ACCEPTSTR( void )
/* $DOC$
* $FUNCNAME$
* __ColorIndex
* hb_ColorIndex
* $CATEGORY$
* GT
* $ONELINER$
* Extract one color from a full Clipper colorspec string.
* $SYNTAX$
* __ColorIndex( <cColorSpec>, <nIndex> )
* hb_ColorIndex( <cColorSpec>, <nIndex> )
* $ARGUMENTS$
* <cColorSpec> is a Clipper color list
* <nIndex> is the position of the color item to be extracted, the first
@@ -1211,7 +1211,7 @@ HARBOUR HB___ACCEPTSTR( void )
* a given item from this list. You may use the manifest constants
* defined in color.ch to extract common Clipper colors.
* $EXAMPLES$
* ? __ColorIndex( "W/N, N/W", CLR_ENHANCED ) // "N/W"
* ? hb_ColorIndex( "W/N, N/W", CLR_ENHANCED ) // "N/W"
* $TESTS$
* see in rtl_test.prg for a comprehensive regression test suit.
* $STATUS$
@@ -1223,7 +1223,7 @@ HARBOUR HB___ACCEPTSTR( void )
* $END$
*/
HARBOUR HB___COLORINDEX( void )
HARBOUR HB_HB_COLORINDEX( void )
{
if( ISCHAR( 1 ) && ISNUM( 2 ) )
{

13
harbour/source/rtl/dates.c
View File

@@ -60,6 +60,7 @@
* hb_dateDecStr()
* hb_dateStrPut()
* hb_dateStrGet()
* HB_HB_STOD()
*
* See doc/license.txt for licensing terms.
*
@@ -549,6 +550,9 @@ HARBOUR HB_DTOS( void )
#endif
}
#ifdef HB_COMPAT_XPP
/* NOTE: XBase++ compatible function */
/* NOTE: XBase++ checks for the parameter count at compile time */
HARBOUR HB_STOD( void )
@@ -556,6 +560,15 @@ HARBOUR HB_STOD( void )
hb_retds( hb_parc( 1 ) );
}
#endif
/* NOTE: Harbour extension, exactly the same as STOD(). */
HARBOUR HB_HB_STOD( void )
{
hb_retds( hb_parc( 1 ) );
}
HARBOUR HB_DAY( void )
{
if( hb_pcount() == 1 )

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

@@ -401,12 +401,12 @@ static BYTE * HarbourMaskToAttributes( USHORT usMask, BYTE * byAttrib )
*cAttrib = '\0';
if( usMask & FA_RDONLY )
strcat( cAttrib, "R" );
if( usMask & FA_DIREC )
strcat( cAttrib, "D" );
if( usMask & FA_HIDDEN )
strcat( cAttrib, "H" );
if( usMask & FA_SYSTEM )
strcat( cAttrib, "S" );
if( usMask & FA_DIREC )
strcat( cAttrib, "D" );
if( usMask & FA_ARCH )
strcat( cAttrib, "A" );
if( usMask & FA_LABEL )

8
harbour/source/rtl/dircmd.prg
View File

@@ -70,7 +70,7 @@ STATIC PROCEDURE PutDBF( aDirEntry )
LOCAL fhnd
LOCAL buffer
LOCAL nRecCount := 0
LOCAL dLastUpdate := SToD( "" )
LOCAL dLastUpdate := hb_SToD( "" )
IF ( fhnd := fOpen( aDirEntry[ F_NAME ] ) ) != F_ERROR
@@ -81,9 +81,9 @@ STATIC PROCEDURE PutDBF( aDirEntry )
Bin2W( Left( buffer, 1 ) ) == 131 )
nRecCount := Bin2L( SubStr( buffer, 5, 4 ) )
dLastUpdate := SToD( StrZero( Bin2W( SubStr( buffer, 2, 1 ) ) + 1900, 4 ) +;
StrZero( Bin2W( SubStr( buffer, 3, 1 ) ), 2 ) +;
StrZero( Bin2W( SubStr( buffer, 4, 1 ) ), 2 ) )
dLastUpdate := hb_SToD( StrZero( Bin2W( SubStr( buffer, 2, 1 ) ) + 1900, 4 ) +;
StrZero( Bin2W( SubStr( buffer, 3, 1 ) ), 2 ) +;
StrZero( Bin2W( SubStr( buffer, 4, 1 ) ), 2 ) )
ENDIF

5
harbour/source/rtl/dummy.prg
View File

@@ -68,9 +68,6 @@ FUNCTION MPosToLC() ; RETURN 0
FUNCTION __dbApp() ; RETURN NIL
FUNCTION __dbCopy() ; RETURN NIL
FUNCTION __dbCopyStruct() ; RETURN NIL
FUNCTION __dbCopyXStruct() ; RETURN NIL
FUNCTION __dbCreate() ; RETURN NIL
FUNCTION __dbDelim() ; RETURN NIL
FUNCTION __dbJoin() ; RETURN NIL
FUNCTION __dbList() ; RETURN NIL
@@ -90,8 +87,6 @@ FUNCTION __dbTransRec() ; RETURN NIL
FUNCTION __FLEdit ; RETURN {}
FUNCTION dbEdit() ; RETURN NIL
FUNCTION IsPrinter() ; RETURN .T.
FUNCTION NetName() ; RETURN ""
FUNCTION __TypeFile() ; RETURN NIL
FUNCTION __LabelForm() ; RETURN NIL
FUNCTION __ReportForm() ; RETURN NIL

17
harbour/source/rtl/filesys.c
View File

@@ -58,6 +58,7 @@
* hb_fsCurDrv()
* hb_fsIsDrv()
* hb_fsIsDevice()
* HB_FSETDEVMOD()
*
* See doc/license.txt for licensing terms.
*
@@ -1401,6 +1402,8 @@ HARBOUR HB_FREADSTR( void )
hb_retc( "" );
}
#ifdef HB_COMPAT_C53
/* NOTE: This function should not return the leading and trailing */
/* (back)slashes. */
@@ -1484,6 +1487,8 @@ HARBOUR HB_DIRREMOVE( void )
s_uiErrorLast = uiErrorOld;
}
#endif
HARBOUR HB_DISKSPACE( void )
{
ULONG ulSpaceFree = 0;
@@ -1517,6 +1522,8 @@ HARBOUR HB_DISKSPACE( void )
hb_retnl( ( LONG ) ulSpaceFree );
}
#ifdef HB_COMPAT_C53
/* NOTE: Clipper 5.3 undocumented */
HARBOUR HB_ISDISK()
@@ -1530,6 +1537,8 @@ HARBOUR HB_ISDISK()
s_uiErrorLast = uiErrorOld;
}
/* NOTE: Clipper 5.3 only */
HARBOUR HB_DISKCHANGE( void )
{
USHORT uiErrorOld = s_uiErrorLast;
@@ -1541,6 +1550,8 @@ HARBOUR HB_DISKCHANGE( void )
s_uiErrorLast = uiErrorOld;
}
/* NOTE: Clipper 5.3 only */
HARBOUR HB_DISKNAME( void )
{
USHORT uiErrorOld = s_uiErrorLast;
@@ -1553,6 +1564,8 @@ HARBOUR HB_DISKNAME( void )
s_uiErrorLast = uiErrorOld;
}
#endif
#define IS_PATH_SEP( c ) ( strchr( OS_PATH_DELIMITER_LIST, ( c ) ) != NULL )
/* Split given filename into path, name and extension */
@@ -1754,6 +1767,8 @@ HARBOUR HB_HB_FNAMEMERGE( void )
hb_retc( hb_fsFNameMerge( szFileName, &pFileName ) );
}
#ifdef HB_COMPAT_C53
/* NOTE: Clipper 5.3 undocumented */
HARBOUR HB_FSETDEVMOD( void )
@@ -1761,3 +1776,5 @@ HARBOUR HB_FSETDEVMOD( void )
if( ISNUM( 1 ) && ISNUM( 2 ) )
hb_fsSetDevMode( hb_parni( 1 ), hb_parni( 2 ) );
}
#endif

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

@@ -65,6 +65,7 @@
#include "extend.h"
#include "errorapi.h"
#include "hbmemory.ch"
#ifdef HB_FM_STATISTICS
static ULONG s_ulMemoryBlocks = 0; /* memory blocks used */
@@ -82,18 +83,16 @@ void * hb_xalloc( ULONG ulSize ) /* allocates fixed memory, returns NULL
pMem = malloc( ulSize + sizeof( ULONG ) );
if( ! pMem )
{
return pMem;
}
* ( ( ULONG * ) pMem ) = ulSize; /* we store the block size into it */
#ifdef HB_FM_STATISTICS
s_ulMemoryConsumed += ulSize;
if( s_ulMemoryConsumed > s_ulMemoryMaxConsumed )
if( s_ulMemoryMaxConsumed < s_ulMemoryConsumed )
s_ulMemoryMaxConsumed = s_ulMemoryConsumed;
s_ulMemoryBlocks++;
if( s_ulMemoryBlocks > s_ulMemoryMaxBlocks )
if( s_ulMemoryMaxBlocks < s_ulMemoryBlocks )
s_ulMemoryMaxBlocks = s_ulMemoryBlocks;
#endif
@@ -109,18 +108,16 @@ void * hb_xgrab( ULONG ulSize ) /* allocates fixed memory, exits on fail
pMem = malloc( ulSize + sizeof( ULONG ) );
if( ! pMem )
{
hb_errInternal( 9999, "hb_xgrab can't allocate memory", NULL, NULL );
}
* ( ( ULONG * ) pMem ) = ulSize; /* we store the block size into it */
#ifdef HB_FM_STATISTICS
s_ulMemoryConsumed += ulSize;
if( s_ulMemoryConsumed > s_ulMemoryMaxConsumed )
if( s_ulMemoryMaxConsumed < s_ulMemoryConsumed )
s_ulMemoryMaxConsumed = s_ulMemoryConsumed;
s_ulMemoryBlocks++;
if( s_ulMemoryBlocks > s_ulMemoryMaxBlocks )
if( s_ulMemoryMaxBlocks < s_ulMemoryBlocks )
s_ulMemoryMaxBlocks = s_ulMemoryBlocks;
#endif
@@ -129,18 +126,20 @@ void * hb_xgrab( ULONG ulSize ) /* allocates fixed memory, exits on fail
void * hb_xrealloc( void * pMem, ULONG ulSize ) /* reallocates memory */
{
#ifdef HB_FM_STATISTICS
ULONG ulMemSize;
#endif
void * pResult;
HB_TRACE(("hb_xrealloc(%p, %lu)", pMem, ulSize));
#ifdef HB_FM_STATISTICS
ulMemSize = * ( ULONG * ) ( ( char * ) pMem - sizeof( ULONG ) );
#endif
pResult = realloc( ( char * ) pMem - sizeof( ULONG ), ulSize + sizeof( ULONG ) );
if( ! pResult )
{
hb_errInternal( 9999, "hb_xrealloc can't reallocate memory", NULL, NULL );
}
* ( ( ULONG * ) pResult ) = ulSize; /* we store the block size into it */
@@ -149,7 +148,7 @@ void * hb_xrealloc( void * pMem, ULONG ulSize ) /* reallocates memory */
s_ulMemoryBlocks--;
s_ulMemoryConsumed += ( ulSize - ulMemSize );
if( s_ulMemoryConsumed > s_ulMemoryMaxConsumed )
if( s_ulMemoryMaxConsumed < s_ulMemoryConsumed )
s_ulMemoryMaxConsumed = s_ulMemoryConsumed;
#endif
@@ -158,21 +157,19 @@ void * hb_xrealloc( void * pMem, ULONG ulSize ) /* reallocates memory */
void hb_xfree( void * pMem ) /* frees fixed memory */
{
ULONG ulMemSize;
HB_TRACE(("hb_xfree(%p)", pMem));
ulMemSize = * ( ULONG * ) ( ( char * ) pMem - sizeof( ULONG ) );
if( pMem )
{
#ifdef HB_FM_STATISTICS
s_ulMemoryConsumed -= * ( ULONG * ) ( ( char * ) pMem - sizeof( ULONG ) );
s_ulMemoryBlocks--;
#endif
free( ( char * ) pMem - sizeof( ULONG ) );
}
else
hb_errInternal( 9999, "hb_xfree called with a null pointer", NULL, NULL );
#ifdef HB_FM_STATISTICS
s_ulMemoryConsumed -= ulMemSize;
s_ulMemoryBlocks--;
#endif
}
ULONG hb_xsize( void * pMem ) /* returns the size of an allocated memory block */
@@ -290,7 +287,7 @@ ULONG hb_xquery( USHORT uiMode )
switch( uiMode )
{
case 0: /* (Free Variable Space [KB]) */
case HB_MEM_CHAR: /* (Free Variable Space [KB]) */
#if defined(_Windows) || defined(WINNT)
{
MEMORYSTATUS memorystatus;
@@ -302,7 +299,7 @@ ULONG hb_xquery( USHORT uiMode )
#endif
break;
case 1: /* (Largest String [KB]) */
case HB_MEM_BLOCK: /* (Largest String [KB]) */
#if defined(_Windows) || defined(WINNT)
{
MEMORYSTATUS memorystatus;
@@ -314,7 +311,7 @@ ULONG hb_xquery( USHORT uiMode )
#endif
break;
case 2: /* (RUN Memory [KB]) */
case HB_MEM_RUN: /* (RUN Memory [KB]) */
#if defined(_Windows) || defined(WINNT)
{
MEMORYSTATUS memorystatus;
@@ -326,7 +323,7 @@ ULONG hb_xquery( USHORT uiMode )
#endif
break;
case 3: /* UNDOCUMENTED! (Virtual Memory [KB]) */
case HB_MEM_VM: /* UNDOCUMENTED! (Virtual Memory [KB]) */
#if defined(_Windows) || defined(WINNT)
{
MEMORYSTATUS memorystatus;
@@ -338,7 +335,7 @@ ULONG hb_xquery( USHORT uiMode )
#endif
break;
case 4: /* UNDOCUMENTED! (Free Expanded Memory [KB]) (?) */
case HB_MEM_EMS: /* UNDOCUMENTED! (Free Expanded Memory [KB]) (?) */
#if defined(_Windows) || defined(WINNT)
ulResult = 0;
#else
@@ -346,7 +343,7 @@ ULONG hb_xquery( USHORT uiMode )
#endif
break;
case 101: /* UNDOCUMENTED! (Fixed Memory/Heap [KB]) (?) */
case HB_MEM_FM: /* UNDOCUMENTED! (Fixed Memory/Heap [KB]) (?) */
#if defined(_Windows) || defined(WINNT)
{
MEMORYSTATUS memorystatus;
@@ -358,7 +355,7 @@ ULONG hb_xquery( USHORT uiMode )
#endif
break;
case 102: /* UNDOCUMENTED! (Segments in Fixed Memory/Heap) (?) */
case HB_MEM_FMSEGS: /* UNDOCUMENTED! (Segments in Fixed Memory/Heap) (?) */
#if defined(_Windows) || defined(WINNT)
ulResult = 1;
#else
@@ -366,7 +363,7 @@ ULONG hb_xquery( USHORT uiMode )
#endif
break;
case 103: /* UNDOCUMENTED! (Free Swap Memory [KB]) */
case HB_MEM_SWAP: /* UNDOCUMENTED! (Free Swap Memory [KB]) */
#if defined(_Windows) || defined(WINNT)
{
MEMORYSTATUS memorystatus;
@@ -378,7 +375,7 @@ ULONG hb_xquery( USHORT uiMode )
#endif
break;
case 104: /* UNDOCUMENTED! (Free Conventional [KB]) */
case HB_MEM_CONV: /* UNDOCUMENTED! (Free Conventional [KB]) */
#if defined(_Windows) || defined(WINNT)
ulResult = 0;
#else
@@ -386,23 +383,31 @@ ULONG hb_xquery( USHORT uiMode )
#endif
break;
case 105: /* UNDOCUMENTED! (Used Expanded Memory [KB]) (?) */
case HB_MEM_EMSUSED: /* UNDOCUMENTED! (Used Expanded Memory [KB]) (?) */
ulResult = 0;
break;
case 1001: /* Harbour extension (Memory used [bytes]) */
case HB_MEM_USED: /* Harbour extension (Memory used [bytes]) */
#ifdef HB_FM_STATISTICS
ulResult = s_ulMemoryConsumed;
#else
ulResult = 0;
#endif
break;
case 1002: /* Harbour extension (Maximum memory used [bytes]) */
case HB_MEM_USEDMAX: /* Harbour extension (Maximum memory used [bytes]) */
#ifdef HB_FM_STATISTICS
ulResult = s_ulMemoryMaxConsumed;
#else
ulResult = 0;
#endif
break;
case 1003: /* Harbour extension (Total items on the stack) */
case HB_MEM_STACKITEMS: /* Harbour extension (Total items on the stack) */
ulResult = hb_stack.wItems;
break;
case 1004: /* Harbour extension (Total memory size used by the stack [bytes]) */
case HB_MEM_STACK: /* Harbour extension (Total memory size used by the stack [bytes]) */
ulResult = hb_stack.wItems * sizeof( HB_ITEM );
break;

76
harbour/source/rtl/gt/gt_tpl.c
View File

@@ -70,6 +70,9 @@ USHORT hb_gt_GetScreenHeight( void )
void hb_gt_SetPos( USHORT uiRow, USHORT uiCol )
{
/* TODO: How to reposition the cursor? */
HB_SYMBOL_UNUSED( uiRow );
HB_SYMBOL_UNUSED( uiCol );
}
USHORT hb_gt_Col( void )
@@ -84,24 +87,16 @@ USHORT hb_gt_Row( void )
return 0;
}
static void hb_gt_GetCursorSize( char * start, char * end )
{
/* TODO: if your system supports the concept of cursor scan lines,
fill this in - otherwise, you need some way to detect the
size of the current screen cursor. */
*start = 0;
*end = 0;
}
USHORT hb_gt_GetCursorStyle( void )
{
/* TODO: What shape is the cursor? */
USHORT rc = 0;
USHORT uiStyle = 0;
/*
char start, end;
if( !visible )
{
rc = SC_NONE;
uiStyle = SC_NONE;
}
else
{
@@ -110,23 +105,23 @@ USHORT hb_gt_GetCursorStyle( void )
/*
hb_gt_GetCursorSize( &start, &end )
if( ( start == 32 ) && ( end == 32 ) )
rc = SC_NONE;
if( start == 32 && end == 32 )
uiStyle = SC_NONE;
else if( ( start == 6 ) && ( end == 7 ) )
rc = SC_NORMAL;
else if( start == 6 && end == 7 )
uiStyle = SC_NORMAL;
else if( ( start == 4 ) && ( end == 7 ) )
rc = SC_INSERT;
else if( start == 4 && end == 7 )
uiStyle = SC_INSERT;
else if( ( start == 0 ) && ( end == 7 ) )
rc = SC_SPECIAL1;
else if( start == 0 && end == 7 )
uiStyle = SC_SPECIAL1;
else if( ( start == 0 ) && ( end == 3 ) )
rc = SC_SPECIAL2;
else if( start == 0 && end == 3 )
uiStyle = SC_SPECIAL2;
}
*/
return rc;
return uiStyle;
}
void hb_gt_SetCursorStyle( USHORT uiStyle )
@@ -158,14 +153,29 @@ void hb_gt_SetCursorStyle( USHORT uiStyle )
void hb_gt_Puts( USHORT uiRow, USHORT uiCol, BYTE byAttr, BYTE * pbyStr, ULONG ulLen )
{
HB_SYMBOL_UNUSED( uiRow );
HB_SYMBOL_UNUSED( uiCol );
HB_SYMBOL_UNUSED( byAttr );
HB_SYMBOL_UNUSED( pbyStr );
HB_SYMBOL_UNUSED( ulLen );
}
void hb_gt_GetText( USHORT uiTop, USHORT uiLeft, USHORT uiBottom, USHORT uiRight, BYTE * pbyDst )
{
HB_SYMBOL_UNUSED( uiTop );
HB_SYMBOL_UNUSED( uiLeft );
HB_SYMBOL_UNUSED( uiBottom );
HB_SYMBOL_UNUSED( uiRight );
HB_SYMBOL_UNUSED( pbyDst );
}
void hb_gt_PutText( USHORT uiTop, USHORT uiLeft, USHORT uiBottom, USHORT uiRight, BYTE * pbySrc )
{
HB_SYMBOL_UNUSED( uiTop );
HB_SYMBOL_UNUSED( uiLeft );
HB_SYMBOL_UNUSED( uiBottom );
HB_SYMBOL_UNUSED( uiRight );
HB_SYMBOL_UNUSED( pbySrc );
}
void hb_gt_SetAttribute( USHORT uiTop, USHORT uiLeft, USHORT uiBottom, USHORT uiRight, BYTE byAttr )
@@ -174,15 +184,22 @@ void hb_gt_SetAttribute( USHORT uiTop, USHORT uiLeft, USHORT uiBottom, USHORT ui
and change the attributes only for a section of the screen
to white on black.
*/
}
void hb_gt_DrawShadow( USHORT uiTop, USHORT uiLeft, USHORT uiBottom, USHORT uiRight, BYTE byAttr )
{
/* TODO: similar to above - see gtwin.c for an idea */
HB_SYMBOL_UNUSED( uiTop );
HB_SYMBOL_UNUSED( uiLeft );
HB_SYMBOL_UNUSED( uiBottom );
HB_SYMBOL_UNUSED( uiRight );
HB_SYMBOL_UNUSED( byAttr );
}
void hb_gt_Scroll( USHORT uiTop, USHORT uiLeft, USHORT uiBottom, USHORT uiRight, BYTE byAttr, SHORT iRows, SHORT iCols )
{
HB_SYMBOL_UNUSED( uiTop );
HB_SYMBOL_UNUSED( uiLeft );
HB_SYMBOL_UNUSED( uiBottom );
HB_SYMBOL_UNUSED( uiRight );
HB_SYMBOL_UNUSED( iRows );
HB_SYMBOL_UNUSED( iCols );
}
void hb_gt_DispBegin( void )
@@ -202,6 +219,9 @@ void hb_gt_DispEnd()
BOOL hb_gt_SetMode( USHORT uiRows, USHORT uiCols )
{
/* TODO: How to change the size of the screen? */
HB_SYMBOL_UNUSED( uiRows );
HB_SYMBOL_UNUSED( uiCols );
}
void hb_gt_Replicate( BYTE byChar, ULONG ulLen )
@@ -212,6 +232,8 @@ void hb_gt_Replicate( BYTE byChar, ULONG ulLen )
already handled in a generic way by higher level functions.
*/
HB_SYMBOL_UNUSED( byChar );
HB_SYMBOL_UNUSED( ulLen );
}
BOOL hb_gt_GetBlink()
@@ -226,4 +248,6 @@ BOOL hb_gt_GetBlink()
void hb_gt_SetBlink( BOOL bBlink )
{
/* TODO: set the bit if it's supported */
HB_SYMBOL_UNUSED( bBlink );
}

23
harbour/source/rtl/gt/gtdos.c
View File

@@ -424,29 +424,6 @@ void hb_gt_SetAttribute( USHORT usTop, USHORT usLeft, USHORT usBottom, USHORT us
}
}
void hb_gt_DrawShadow( USHORT usTop, USHORT usLeft, USHORT usBottom, USHORT usRight, BYTE attr )
{
USHORT x, y;
for( y = usTop; y <= usBottom; y++ )
{
BYTE scratchattr;
BYTE ch;
hb_gt_xGetXY( y, usRight, &scratchattr, &ch );
hb_gt_xPutch( y, usRight, attr, ch );
if( y == usBottom )
{
for( x = usLeft; x <= usRight; x++ )
{
hb_gt_xGetXY( y, x, &scratchattr, &ch );
hb_gt_xPutch( y, x, attr, ch );
}
}
}
}
USHORT hb_gt_Col( void )
{
#if defined(__TURBOC__)

11
harbour/source/rtl/gt/gtlin.c
View File

@@ -197,17 +197,6 @@ void hb_gt_SetAttribute( USHORT uiTop,
*/
}
void hb_gt_DrawShadow( USHORT uiTop,
USHORT uiLeft,
USHORT uiBottom,
USHORT uiRight,
BYTE byAttr )
{
HB_TRACE(("hb_gt_DrawShadow(%hu, %hu, %hu, %hu, %d)", uiTop, uiLeft, uiBottom, uiRight, (int) byAttr));
/* TODO: similar to above - see gtwin.c for an idea */
}
void hb_gt_Scroll( USHORT uiTop,
USHORT uiLeft,
USHORT uiBottom,

8
harbour/source/rtl/gt/gtos2.c
View File

@@ -294,14 +294,6 @@ void hb_gt_SetAttribute( USHORT usTop, USHORT usLeft, USHORT usBottom, USHORT us
VioWrtNAttr( &attr, width, y, usLeft, 0 );
}
void hb_gt_DrawShadow( USHORT usTop, USHORT usLeft, USHORT usBottom, USHORT usRight, BYTE attr )
{
/* Chen Kedem <niki@actcom.co.il> */
hb_gt_SetAttribute( usBottom + 1, usLeft + 1, usBottom + 1, usRight + 1, attr );
hb_gt_SetAttribute( usTop + 1, usRight + 1, usBottom + 1, usRight + 1, attr );
}
void hb_gt_DispBegin( void )
{
/* TODO: Is there a way to change screen buffers?

193
harbour/source/rtl/gt/gtstd.c Normal file
View File

@@ -0,0 +1,193 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* Video subsystem for plain ANSI C stream IO
*
* Copyright 1999 Victor Szel <info@szelvesz.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 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) 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 HRL
* and/or HVM code into it.
*
* 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 program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
/* NOTE: User programs should never call this layer directly! */
/* TODO: include any standard headers here */
#include "gtapi.h"
static SHORT s_iRow;
static SHORT s_iCol;
static USHORT s_uiMaxRow;
static USHORT s_uiMaxCol;
static USHORT s_uiCursorStyle;
static BOOL s_bBlink;
void hb_gt_Init( void )
{
s_iRow = 0;
s_iCol = 0;
#if defined(HB_OS_UNIX_COMPATIBLE)
s_uiMaxRow = 24;
#else
s_uiMaxRow = 25;
#endif
s_uiMaxCol = 80;
s_uiCursorStyle = SC_NONE;
s_bBlink = FALSE;
}
void hb_gt_Done( void )
{
;
}
BOOL hb_gt_IsColor( void )
{
return FALSE;
}
USHORT hb_gt_GetScreenWidth( void )
{
return s_uiMaxCol;
}
USHORT hb_gt_GetScreenHeight( void )
{
return s_uiMaxRow;
}
void hb_gt_SetPos( USHORT uiRow, USHORT uiCol )
{
s_iCol = ( SHORT ) uiCol;
s_iRow = ( SHORT ) uiRow;
}
USHORT hb_gt_Col( void )
{
return s_iCol;
}
USHORT hb_gt_Row( void )
{
return s_iRow;
}
USHORT hb_gt_GetCursorStyle( void )
{
return s_uiCursorStyle;
}
void hb_gt_SetCursorStyle( USHORT uiCursorStyle )
{
s_uiCursorStyle = uiCursorStyle;
}
void hb_gt_Puts( USHORT uiRow, USHORT uiCol, BYTE byAttr, BYTE * pbyStr, ULONG ulLen )
{
/* TODO: */
HB_SYMBOL_UNUSED( uiRow );
HB_SYMBOL_UNUSED( uiCol );
HB_SYMBOL_UNUSED( byAttr );
HB_SYMBOL_UNUSED( pbyStr );
HB_SYMBOL_UNUSED( ulLen );
}
void hb_gt_GetText( USHORT uiTop, USHORT uiLeft, USHORT uiBottom, USHORT uiRight, BYTE * pbyDst )
{
HB_SYMBOL_UNUSED( uiTop );
HB_SYMBOL_UNUSED( uiLeft );
HB_SYMBOL_UNUSED( uiBottom );
HB_SYMBOL_UNUSED( uiRight );
HB_SYMBOL_UNUSED( pbyDst );
}
void hb_gt_PutText( USHORT uiTop, USHORT uiLeft, USHORT uiBottom, USHORT uiRight, BYTE * pbySrc )
{
/* TODO: */
HB_SYMBOL_UNUSED( uiTop );
HB_SYMBOL_UNUSED( uiLeft );
HB_SYMBOL_UNUSED( uiBottom );
HB_SYMBOL_UNUSED( uiRight );
HB_SYMBOL_UNUSED( pbySrc );
}
void hb_gt_SetAttribute( USHORT uiTop, USHORT uiLeft, USHORT uiBottom, USHORT uiRight, BYTE byAttr )
{
HB_SYMBOL_UNUSED( uiTop );
HB_SYMBOL_UNUSED( uiLeft );
HB_SYMBOL_UNUSED( uiBottom );
HB_SYMBOL_UNUSED( uiRight );
HB_SYMBOL_UNUSED( byAttr );
}
void hb_gt_Scroll( USHORT uiTop, USHORT uiLeft, USHORT uiBottom, USHORT uiRight, BYTE byAttr, SHORT iRows, SHORT iCols )
{
/* TODO: */
HB_SYMBOL_UNUSED( uiTop );
HB_SYMBOL_UNUSED( uiLeft );
HB_SYMBOL_UNUSED( uiBottom );
HB_SYMBOL_UNUSED( uiRight );
HB_SYMBOL_UNUSED( iRows );
HB_SYMBOL_UNUSED( iCols );
}
void hb_gt_DispBegin( void )
{
; /* Do nothing */
}
void hb_gt_DispEnd()
{
; /* Do nothing */
}
BOOL hb_gt_SetMode( USHORT uiMaxRow, USHORT uiMaxCol )
{
s_uiMaxRow = uiMaxRow;
s_uiMaxCol = uiMaxCol;
}
void hb_gt_Replicate( BYTE byChar, ULONG ulLen )
{
/* TODO: */
HB_SYMBOL_UNUSED( byChar );
HB_SYMBOL_UNUSED( ulLen );
}
BOOL hb_gt_GetBlink()
{
return s_bBlink;
}
void hb_gt_SetBlink( BOOL bBlink )
{
s_bBlink = bBlink;
}

209
harbour/source/rtl/gt/gtwin.c
View File

@@ -73,11 +73,12 @@ typedef WORD far * LPWORD;
#endif /* __GNUC__ */
static BOOL hb_gt_SetScreenBuffer( HANDLE HNew, HANDLE HOld );
static HANDLE HOsave;
/* static HANDLE HSsave; */
static HANDLE HDOutput = INVALID_HANDLE_VALUE;
/* static HANDLE HDStealth = INVALID_HANDLE_VALUE; */
HANDLE hb_gtHInput = INVALID_HANDLE_VALUE;
HANDLE hb_gtHInput = INVALID_HANDLE_VALUE;
static HANDLE HOutput = INVALID_HANDLE_VALUE;
static HANDLE HStealth = INVALID_HANDLE_VALUE; /* DispBegin buffer */
static HANDLE HOriginal; /* used to restore before quit */
@@ -107,7 +108,7 @@ void hb_gt_Init( void )
HOriginal = HOutput = HCursor = CreateFile( "CONOUT$", /* filename */
GENERIC_READ | GENERIC_WRITE, /* Access flag */
FILE_SHARE_READ | FILE_SHARE_WRITE, /* share mode */
NULL, /* security attributes */
NULL, /* security attributes */
OPEN_EXISTING, /* create mode */
0, 0 );
}
@@ -173,21 +174,22 @@ USHORT hb_gt_GetScreenHeight( void )
return max( csbi.dwSize.Y, 25 );
}
void hb_gt_SetPos( USHORT cRow, USHORT cCol )
void hb_gt_SetPos( USHORT uiRow, USHORT uiCol )
{
COORD dwCursorPosition;
HB_TRACE(("hb_gt_SetPos(%hu, %hu)", cRow, cCol));
HB_TRACE(("hb_gt_SetPos(%hu, %hu)", uiRow, uiCol));
dwCursorPosition.X = ( SHORT ) uiCol;
dwCursorPosition.Y = ( SHORT ) uiRow;
dwCursorPosition.X = ( SHORT ) cCol;
dwCursorPosition.Y = ( SHORT ) cRow;
SetConsoleCursorPosition( HCursor, dwCursorPosition );
}
USHORT hb_gt_GetCursorStyle( void )
{
CONSOLE_CURSOR_INFO cci;
int rc;
USHORT uiCursorShape;
HB_TRACE(("hb_gt_GetCursorStyle()"));
@@ -195,33 +197,33 @@ USHORT hb_gt_GetCursorStyle( void )
if( ! cci.bVisible )
{
rc = SC_NONE;
uiCursorShape = SC_NONE;
}
else
{
switch( cci.dwSize )
{
case 50:
rc = SC_INSERT; /* half block in clipper */
uiCursorShape = SC_INSERT; /* half block in clipper */
break;
case 99:
rc = SC_SPECIAL1; /* full block in clipper */
uiCursorShape = SC_SPECIAL1; /* full block in clipper */
break;
case 66:
rc = SC_SPECIAL2; /* upper half block in clipper */
uiCursorShape = SC_SPECIAL2; /* upper half block in clipper */
break;
/* TODO: cannot tell if the block is upper or lower for cursor */
/* Answer: Supposed to be upper third, but ms don't support it. */
default:
rc = SC_NORMAL; /* anything else, we'll call it normal */
uiCursorShape = SC_NORMAL; /* anything else, we'll call it normal */
break;
}
}
return rc;
return uiCursorShape;
}
void hb_gt_SetCursorStyle( USHORT style )
@@ -231,68 +233,77 @@ void hb_gt_SetCursorStyle( USHORT style )
HB_TRACE(("hb_gt_SetCursorStyle(%hu)", style));
GetConsoleCursorInfo( HCursor, &cci );
cci.bVisible = 1; /* always visible unless explicitly request off */
switch( style )
{
case SC_NONE:
cci.bVisible = 0;
cci.bVisible = FALSE;
break;
case SC_INSERT:
cci.bVisible = TRUE;
cci.dwSize = 50;
break;
case SC_SPECIAL1:
cci.bVisible = TRUE;
cci.dwSize = 99;
break;
case SC_SPECIAL2:
cci.bVisible = TRUE;
cci.dwSize = 66;
/* In their infinite wisdom, MS doesn't support cursors that
don't start at the bottom of the cell */
break;
case SC_NORMAL:
default: /* traps for invalid values */
cci.bVisible = TRUE;
cci.dwSize = 25; /* this was 12, but when used in full screen dos window
cursor state is erratic - doesn't turn off, etc. */
cursor state is erratic - doesn't turn off, etc. */
break;
}
SetConsoleCursorInfo( HCursor, &cci );
}
void hb_gt_Puts( USHORT cRow, USHORT cCol, BYTE attr, BYTE *str, ULONG len )
void hb_gt_Puts( USHORT uiRow, USHORT uiCol, BYTE attr, BYTE * str, ULONG len )
{
DWORD dwlen;
DWORD dwWritten;
COORD coord;
HB_TRACE(("hb_gt_Puts(%hu, %hu, %d, %p, %lu)", cRow, cCol, (int) attr, str, len));
HB_TRACE(("hb_gt_Puts(%hu, %hu, %d, %p, %lu)", uiRow, uiCol, (int) attr, str, len));
coord.X = ( DWORD ) cCol;
coord.Y = ( DWORD ) cRow;
FillConsoleOutputAttribute( HOutput, ( WORD )( attr & 0xFF ), ( DWORD ) len, coord, &dwlen );
WriteConsoleOutputCharacterA( HOutput, ( char * ) str, ( DWORD ) len, coord, &dwlen );
coord.X = ( DWORD ) uiCol;
coord.Y = ( DWORD ) uiRow;
FillConsoleOutputAttribute( HOutput, ( WORD )( attr & 0xFF ), ( DWORD ) len, coord, &dwWritten );
WriteConsoleOutputCharacterA( HOutput, ( char * ) str, ( DWORD ) len, coord, &dwWritten );
}
void hb_gt_GetText( USHORT usTop, USHORT usLeft, USHORT usBottom, USHORT usRight, BYTE * dest )
void hb_gt_GetText( USHORT uiTop, USHORT uiLeft, USHORT uiBottom, USHORT uiRight, BYTE * dest )
{
DWORD len;
COORD coord;
LPWORD pwattr;
BYTE * pstr;
USHORT width, i, y;
USHORT width;
HB_TRACE(("hb_gt_GetText(%hu, %hu, %hu, %hu, %p)", usTop, usLeft, usBottom, usRight, dest));
HB_TRACE(("hb_gt_GetText(%hu, %hu, %hu, %hu, %p)", uiTop, uiLeft, uiBottom, uiRight, dest));
width = ( usRight - usLeft + 1 );
width = ( uiRight - uiLeft + 1 );
pwattr = ( LPWORD ) hb_xgrab( width * sizeof( *pwattr ) );
pstr = ( BYTE * ) hb_xgrab( width );
for( y = usTop; y <= usBottom; y++ )
for( ; uiTop <= uiBottom; uiTop++ )
{
coord.X = ( DWORD ) usLeft;
coord.Y = ( DWORD ) y;
ReadConsoleOutputCharacterA( HOutput, ( char * ) pstr, width, coord, &len );
ReadConsoleOutputAttribute( HOutput, pwattr, width, coord, &len );
COORD coord;
USHORT i;
DWORD dwWritten;
coord.X = ( DWORD ) uiLeft;
coord.Y = ( DWORD ) uiTop;
ReadConsoleOutputCharacterA( HOutput, ( char * ) pstr, width, coord, &dwWritten );
ReadConsoleOutputAttribute( HOutput, pwattr, width, coord, &dwWritten );
for( i = 0; i < width; i++ )
{
*dest = *( pstr + i );
@@ -306,22 +317,24 @@ void hb_gt_GetText( USHORT usTop, USHORT usLeft, USHORT usBottom, USHORT usRight
hb_xfree( pwattr );
}
void hb_gt_PutText( USHORT usTop, USHORT usLeft, USHORT usBottom, USHORT usRight, BYTE * srce )
void hb_gt_PutText( USHORT uiTop, USHORT uiLeft, USHORT uiBottom, USHORT uiRight, BYTE * srce )
{
DWORD len;
COORD coord;
LPWORD pwattr;
BYTE * pstr;
USHORT width, i, y;
USHORT width;
HB_TRACE(("hb_gt_PutText(%hu, %hu, %hu, %hu, %p)", usTop, usLeft, usBottom, usRight, srce));
HB_TRACE(("hb_gt_PutText(%hu, %hu, %hu, %hu, %p)", uiTop, uiLeft, uiBottom, uiRight, srce));
width = ( usRight - usLeft + 1 );
width = ( uiRight - uiLeft + 1 );
pwattr = ( LPWORD ) hb_xgrab( width * sizeof( *pwattr ) );
pstr = ( BYTE * ) hb_xgrab( width );
for( y = usTop; y <= usBottom; y++ )
for( ; uiTop <= uiBottom; uiTop++ )
{
COORD coord;
USHORT i;
DWORD dwWritten;
for( i = 0; i < width; i++ )
{
*( pstr + i ) = *srce;
@@ -329,54 +342,36 @@ void hb_gt_PutText( USHORT usTop, USHORT usLeft, USHORT usBottom, USHORT usRight
*( pwattr + i ) = ( ( WORD )( ( BYTE ) *srce ) & 0xFF );
srce++;
}
coord.X = ( DWORD ) usLeft;
coord.Y = ( DWORD ) y;
WriteConsoleOutputAttribute( HOutput, pwattr, width, coord, &len );
WriteConsoleOutputCharacterA( HOutput, ( char * ) pstr, width, coord, &len );
coord.X = ( DWORD ) uiLeft;
coord.Y = ( DWORD ) uiTop;
WriteConsoleOutputAttribute( HOutput, pwattr, width, coord, &dwWritten );
WriteConsoleOutputCharacterA( HOutput, ( char * ) pstr, width, coord, &dwWritten );
}
hb_xfree( pstr );
hb_xfree( pwattr );
}
void hb_gt_SetAttribute( USHORT usTop, USHORT usLeft, USHORT usBottom, USHORT usRight, BYTE attr )
void hb_gt_SetAttribute( USHORT uiTop, USHORT uiLeft, USHORT uiBottom, USHORT uiRight, BYTE attr )
{
/* ptucker */
DWORD len;
COORD coord;
USHORT width, y;
HB_TRACE(("hb_gt_SetAttribute(%hu, %hu, %hu, %hu, %d)", usTop, usLeft, usBottom, usRight, (int) attr));
width = ( usRight - usLeft + 1 );
coord.X = ( DWORD ) usLeft;
for( y = usTop; y <= usBottom; y++ )
{
coord.Y = y;
FillConsoleOutputAttribute( HOutput, ( WORD )( attr & 0xFF ), width, coord, &len );
}
}
void hb_gt_DrawShadow( USHORT usTop, USHORT usLeft, USHORT usBottom, USHORT usRight, BYTE attr )
{
/* ptucker */
DWORD len;
COORD coord;
USHORT width;
HB_TRACE(("hb_gt_DrawShadow(%hu, %hu, %hu, %hu, %d)", usTop, usLeft, usBottom, usRight, (int) attr));
HB_TRACE(("hb_gt_SetAttribute(%hu, %hu, %hu, %hu, %d)", uiTop, uiLeft, uiBottom, uiRight, (int) attr));
width = ( usRight - usLeft + 1 );
width = uiRight - uiLeft + 1;
coord.X = ( DWORD ) usLeft;
coord.Y = ( DWORD ) usBottom;
coord.X = ( DWORD ) uiLeft;
FillConsoleOutputAttribute( HOutput, ( WORD )( attr & 0xFF ), width, coord, &len );
hb_gt_SetAttribute( usTop, usRight, usBottom, usRight, attr );
for( ; uiTop <= uiBottom; uiTop++ )
{
DWORD dwWritten;
coord.Y = uiTop;
FillConsoleOutputAttribute( HOutput, ( WORD )( attr & 0xFF ), width, coord, &dwWritten );
}
}
USHORT hb_gt_Col( void )
@@ -386,6 +381,7 @@ USHORT hb_gt_Col( void )
HB_TRACE(("hb_gt_Col()"));
GetConsoleScreenBufferInfo( HCursor, &csbi );
return csbi.dwCursorPosition.X;
}
@@ -396,40 +392,53 @@ USHORT hb_gt_Row( void )
HB_TRACE(("hb_gt_Row()"));
GetConsoleScreenBufferInfo( HCursor, &csbi );
return csbi.dwCursorPosition.Y;
}
void hb_gt_Scroll( USHORT usTop, USHORT usLeft, USHORT usBottom, USHORT usRight, BYTE attr, SHORT sVert, SHORT sHoriz )
void hb_gt_Scroll( USHORT uiTop, USHORT uiLeft, USHORT uiBottom, USHORT uiRight, BYTE attr, SHORT iVert, SHORT iHoriz )
{
/* ptucker */
SMALL_RECT Source, Clip;
COORD Target;
CHAR_INFO FillChar;
HB_TRACE(("hb_gt_Scroll(%hu, %hu, %hu, %hu, %d, %hd, %hd)", uiTop, uiLeft, uiBottom, uiRight, (int) attr, iVert, iHoriz));
HB_TRACE(("hb_gt_Scroll(%hu, %hu, %hu, %hu, %d, %hd, %hd)", usTop, usLeft, usBottom, usRight, (int) attr, sVert, sHoriz));
Source.Top = usTop;
Source.Left = usLeft;
Source.Bottom = usBottom;
Source.Right = usRight;
memcpy( &Clip, &Source, sizeof( Clip ) );
if( ( sHoriz | sVert ) == 0 ) /* both zero? */
if( ( iHoriz | iVert ) == 0 ) /* both zero? */
{
Target.Y = usBottom+1; /* set outside the clipping region */
Target.X = usRight+1;
COORD coord;
USHORT width = uiRight - uiLeft + 1;
coord.X = ( DWORD ) uiLeft;
for( ; uiTop <= uiBottom; uiTop++ )
{
DWORD dwWritten;
coord.Y = uiTop;
FillConsoleOutputAttribute( HOutput, ( WORD )( attr & 0xFF ), width, coord, &dwWritten );
FillConsoleOutputCharacter( HOutput, ' ', width, coord, &dwWritten );
}
}
else
{
Target.Y = usTop-sVert;
Target.X = usLeft-sHoriz;
}
FillChar.Char.AsciiChar = ' ';
FillChar.Attributes = ( WORD )( attr & 0xFF );
SMALL_RECT Source, Clip;
COORD Target;
CHAR_INFO FillChar;
ScrollConsoleScreenBuffer( HOutput, &Source, &Clip, Target, &FillChar );
Source.Top = uiTop;
Source.Left = uiLeft;
Source.Bottom = uiBottom;
Source.Right = uiRight;
memcpy( &Clip, &Source, sizeof( SMALL_RECT ) );
Target.Y = uiTop - iVert;
Target.X = uiLeft - iHoriz;
FillChar.Char.AsciiChar = ' ';
FillChar.Attributes = ( WORD )( attr & 0xFF );
ScrollConsoleScreenBuffer( HOutput, &Source, &Clip, Target, &FillChar );
}
}
void hb_gt_DispBegin( void )
@@ -550,7 +559,7 @@ BOOL hb_gt_SetMode( USHORT uiRows, USHORT uiCols )
/* console window first, then the buffer */
if( ( DWORD ) csbi.dwSize.X * csbi.dwSize.Y > ( DWORD ) uiCols * uiRows )
{
if( !SetConsoleWindowInfo( HOutput, TRUE, &srWin ) ||
if( !SetConsoleWindowInfo( HOutput, TRUE, &srWin ) ||
!SetConsoleScreenBufferSize( HOutput, coBuf ) )
bRetVal = FALSE;
}
@@ -600,13 +609,13 @@ void hb_gt_SetBlink( BOOL bBlink )
HB_SYMBOL_UNUSED( bBlink );
}
void hb_gt_DebugScreen( BOOL activate )
void hb_gt_DebugScreen( BOOL bActivate )
{
HB_TRACE(("hb_gt_DebugScreen(%d)", (int) activate));
HB_TRACE(("hb_gt_DebugScreen(%d)", (int) bActivate));
/* ptucker */
/* TODO: This is not used and is still a work in progress */
if( activate )
if( bActivate )
{
if( HDOutput == INVALID_HANDLE_VALUE )
{

81
harbour/source/rtl/gtapi.c
View File

@@ -99,6 +99,28 @@
* changed to allow unlimited color pairs.
*/
/*
* The following parts are Copyright of the individual authors.
* www - http://www.harbour-project.org
*
* Copyright 1999 Paul Tucker <ptucker@sympatico.ca>
* hb_gtInit()
* hb_gtExit()
* hb_gtDispBegin()
* hb_gtDispEnd()
* hb_gtPreExt()
* hb_gtPostExt()
* hb_gtGetColorStr()
* hb_gtSetColorStr()
* hb_gtSetMode()
*
* Copyright 1999 Victor Szel <info@szelvesz.hu>
* hb_gtDrawShadow()
*
* See doc/license.txt for licensing terms.
*
*/
#include <ctype.h>
#include "set.h"
#include "gtapi.h"
@@ -124,9 +146,7 @@ static int s_ColorCount;
void hb_gtInit( void )
{
HB_TRACE(("hb_gtInit()"));
/* ptucker */
HB_TRACE(("hb_gtInit()"));
s_Color = ( int * ) hb_xgrab( 5 * sizeof( int ) );
s_ColorCount = 5;
@@ -137,9 +157,7 @@ void hb_gtInit( void )
void hb_gtExit( void )
{
HB_TRACE(("hb_gtExit()"));
/* ptucker */
HB_TRACE(("hb_gtExit()"));
while( s_uiDispCount )
hb_gtDispEnd();
@@ -150,7 +168,7 @@ void hb_gtExit( void )
int hb_gtReadKey( void )
{
HB_TRACE(("hb_gtReadKey()"));
HB_TRACE(("hb_gtReadKey()"));
#if defined(OS_UNIX_COMPATIBLE)
return hb_gt_ReadKey();
@@ -174,7 +192,7 @@ USHORT hb_gtBox( USHORT uiTop, USHORT uiLeft, USHORT uiBottom, USHORT uiRight, B
USHORT uiMaxRow;
USHORT uiMaxCol;
HB_TRACE(("hb_gtBox(%hu, %hu, %hu, %hu, %p)", uiTop, uiLeft, uiBottom, uiRight, pbyFrame));
HB_TRACE(("hb_gtBox(%hu, %hu, %hu, %hu, %p)", uiTop, uiLeft, uiBottom, uiRight, pbyFrame));
uiTopBak = uiTop;
uiLeftBak = uiLeft;
@@ -293,8 +311,6 @@ USHORT hb_gtDispBegin( void )
{
HB_TRACE(("hb_gtDispBegin()"));
/* ptucker */
if( s_uiPreCount == 0 )
{
++s_uiDispCount;
@@ -317,8 +333,6 @@ USHORT hb_gtDispEnd( void )
{
HB_TRACE(("hb_gtDispEnd()"));
/* ptucker */
if( s_uiPreCount == 0 )
{
hb_gt_DispEnd();
@@ -334,8 +348,6 @@ USHORT hb_gtPreExt( void )
{
HB_TRACE(("hb_gtPreExt()"));
/* ptucker */
/* an external (printf...) write is about to take place */
if( s_uiPreCNest == 0 )
@@ -365,8 +377,6 @@ USHORT hb_gtPostExt( void )
{
HB_TRACE(("hb_gtPostExt()"));
/* ptucker */
if( s_uiPreCNest == 1 )
{
USHORT uidc = s_uiPreCount;
@@ -392,7 +402,6 @@ USHORT hb_gtGetColorStr( char * fpColorString )
HB_TRACE(("hb_gtGetColorStr(%s)", fpColorString));
/* ptucker */
sColors = ( char * ) hb_xgrab( s_ColorCount * 8 + 1 ); /* max possible */
for( i = 0; i < s_ColorCount; i++ )
@@ -464,8 +473,6 @@ USHORT hb_gtSetColorStr( char * fpColorString )
HB_TRACE(("hb_gtSetColorStr(%s)", fpColorString));
/* ptucker */
if( !fpColorString )
return 1;
if( ! *fpColorString )
@@ -694,28 +701,28 @@ USHORT hb_gtSetPos( SHORT iRow, SHORT iCol )
BOOL hb_gtIsColor( void )
{
HB_TRACE(("hb_gtIsColor()"));
HB_TRACE(("hb_gtIsColor()"));
return hb_gt_IsColor();
}
USHORT hb_gtMaxCol( void )
{
HB_TRACE(("hb_gtMaxCol()"));
HB_TRACE(("hb_gtMaxCol()"));
return hb_gt_GetScreenWidth() - 1;
}
USHORT hb_gtMaxRow( void )
{
HB_TRACE(("hb_gtMaxRow()"));
HB_TRACE(("hb_gtMaxRow()"));
return hb_gt_GetScreenHeight() - 1;
}
USHORT hb_gtRectSize( USHORT uiTop, USHORT uiLeft, USHORT uiBottom, USHORT uiRight, USHORT * uipBuffSize )
{
HB_TRACE(("hb_gtRectSize(%hu, %hu, %hu, %hu, %p)", uiTop, uiLeft, uiBottom, uiRight, uipBuffSize));
HB_TRACE(("hb_gtRectSize(%hu, %hu, %hu, %hu, %p)", uiTop, uiLeft, uiBottom, uiRight, uipBuffSize));
*uipBuffSize = ( uiBottom - uiTop + 1 ) * ( uiRight - uiLeft + 1 ) * 2;
@@ -788,7 +795,6 @@ USHORT hb_gtSetMode( USHORT uiRows, USHORT uiCols )
{
HB_TRACE(("hb_gtSetMode(%hu, %hu)", uiRows, uiCols));
/* ptucker */
return hb_gt_SetMode( uiRows, uiCols ) ? 0 : 1;
}
@@ -957,6 +963,33 @@ USHORT hb_gtScroll( USHORT uiTop, USHORT uiLeft, USHORT uiBottom, USHORT uiRight
return 0;
}
/* NOTE: It would be better if the clipping was done by the low level API */
USHORT hb_gtDrawShadow( USHORT uiTop, USHORT uiLeft, USHORT uiBottom, USHORT uiRight, BYTE byAttr )
{
USHORT uiMaxRow = hb_gtMaxRow();
USHORT uiMaxCol = hb_gtMaxCol();
uiLeft += 2;
uiBottom++;
/* Draw the bottom edge */
if( uiBottom <= uiMaxRow && uiLeft <= uiMaxCol )
hb_gt_SetAttribute( uiBottom, uiLeft, uiBottom, HB_MIN_( uiRight, uiMaxCol ), byAttr );
uiRight++;
uiTop++;
/* Draw the right edge */
if( uiTop <= uiMaxRow && uiRight <= uiMaxCol )
hb_gt_SetAttribute( uiTop, uiRight, uiBottom, HB_MIN_( uiRight + 1, uiMaxCol ), byAttr );
return 0;
}
#ifdef TEST
void main( void )
{

6
harbour/source/rtl/gtxxx.c
View File

@@ -35,7 +35,9 @@
#include "hbsetup.h"
#if defined(HARBOUR_USE_DOS_GTAPI)
#if defined(HARBOUR_USE_STD_GTAPI)
#include "gt/gtstd.c"
#elif defined(HARBOUR_USE_DOS_GTAPI)
#include "gt/gtdos.c"
#elif defined(HARBOUR_USE_OS2_GTAPI)
#include "gt/gtos2.c"
@@ -43,4 +45,6 @@
#include "gt/gtwin.c"
#elif defined(HARBOUR_USE_LIN_GTAPI)
#include "gt/gtlin.c"
#else
#include "gt/gtstd.c"
#endif

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

@@ -89,9 +89,9 @@
#ifdef HARBOUR_USE_WIN
#define INPUT_BUFFER_LEN 128
extern HANDLE hb_gtHInput; /* This variable is located in source/rtl/gt/gtwin.c */
DWORD cNumRead = 0; /* Ok to use DWORD here, because this is specific... */
DWORD cNumIndex = 0; /* ...to the Windows API, which defines DWORD, etc. */
INPUT_RECORD irInBuf[INPUT_BUFFER_LEN];
static DWORD s_cNumRead = 0; /* Ok to use DWORD here, because this is specific... */
static DWORD s_cNumIndex = 0; /* ...to the Windows API, which defines DWORD, etc. */
static INPUT_RECORD s_irInBuf[ INPUT_BUFFER_LEN ];
#endif
#include "extend.h"
@@ -308,43 +308,43 @@ void hb_inkeyPoll( void ) /* Poll the console keyboard to stuff the Harbour
int ch = 0;
#if defined(_Windows) || defined(WINNT)
/* Check for events only when the event buffer is exhausted. */
if( cNumRead <= cNumIndex )
if( s_cNumRead <= s_cNumIndex )
{
/* Check for keyboard input */
cNumRead = 0;
GetNumberOfConsoleInputEvents( hb_gtHInput, &cNumRead );
if( cNumRead )
s_cNumRead = 0;
GetNumberOfConsoleInputEvents( hb_gtHInput, &s_cNumRead );
if( s_cNumRead )
{
/* Read keyboard input */
ReadConsoleInput(
hb_gtHInput, /* input buffer handle */
irInBuf, /* buffer to read into */
s_irInBuf, /* buffer to read into */
INPUT_BUFFER_LEN, /* size of read buffer */
&cNumRead); /* number of records read */
&s_cNumRead); /* number of records read */
/* Set up to process the first input event */
cNumIndex = 0;
s_cNumIndex = 0;
}
}
/* Only process one keyboard event at a time. */
if( cNumRead > cNumIndex )
if( s_cNumRead > s_cNumIndex )
{
/* Only process keyboard events for now... */
if( irInBuf[cNumIndex].EventType == KEY_EVENT )
if( s_irInBuf[ s_cNumIndex ].EventType == KEY_EVENT )
{
/* Only process key down events */
if( irInBuf[cNumIndex].Event.KeyEvent.bKeyDown )
if( s_irInBuf[ s_cNumIndex ].Event.KeyEvent.bKeyDown )
{
/* Save the keyboard state and ASCII key code */
DWORD dwState = irInBuf[cNumIndex].Event.KeyEvent.dwControlKeyState;
ch = irInBuf[cNumIndex].Event.KeyEvent.uChar.AsciiChar;
DWORD dwState = s_irInBuf[ s_cNumIndex ].Event.KeyEvent.dwControlKeyState;
ch = s_irInBuf[ s_cNumIndex ].Event.KeyEvent.uChar.AsciiChar;
if( ch == 0 || ( dwState & ( ENHANCED_KEY | LEFT_ALT_PRESSED | LEFT_CTRL_PRESSED | RIGHT_ALT_PRESSED | RIGHT_CTRL_PRESSED | SHIFT_PRESSED ) ) )
{
/* Process non-ASCII key codes */
WORD wKey;
if( s_eventmask & INKEY_EXTENDED )
wKey = irInBuf[cNumIndex].Event.KeyEvent.wVirtualKeyCode;
wKey = s_irInBuf[ s_cNumIndex ].Event.KeyEvent.wVirtualKeyCode;
else
wKey = irInBuf[cNumIndex].Event.KeyEvent.wVirtualScanCode;
wKey = s_irInBuf[ s_cNumIndex ].Event.KeyEvent.wVirtualScanCode;
/* Discard standalone state key presses for normal mode only */
if( ( s_eventmask & INKEY_EXTENDED ) == 0 ) switch( wKey )
{
@@ -615,16 +615,16 @@ printf("\nhb_inkeyPoll: wKey is %d, dwState is %d, ch is %d", wKey, dwState, ch)
WORD wKey;
if( s_eventmask & INKEY_EXTENDED )
wKey = irInBuf[cNumIndex].Event.KeyEvent.wVirtualKeyCode;
wKey = s_irInBuf[ s_cNumIndex ].Event.KeyEvent.wVirtualKeyCode;
else
wKey = irInBuf[cNumIndex].Event.KeyEvent.wVirtualScanCode;
wKey = s_irInBuf[ s_cNumIndex ].Event.KeyEvent.wVirtualScanCode;
printf("\nhb_inkeyPoll: wKey is %d", wKey);
}
*/
}
}
/* Set up to process the next input event (if any) */
cNumIndex++;
s_cNumIndex++;
}
#elif defined(OS_DOS_COMPATIBLE) || defined(HARBOUR_GCC_OS2) || defined(__IBMCPP__)
/* The reason for including _Windows here is that kbhit() and getch() appear

113
harbour/source/rtl/isprint.c Normal file
View File

@@ -0,0 +1,113 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* ISPRINTER() function
*
* Copyright 1999 Victor Szel <info@szelvesz.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 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) 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 HRL
* and/or HVM code into it.
*
* 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 program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
#include "extend.h"
#include "filesys.h"
#if defined(__TURBOC__) || defined(__BORLANDC__) || defined(_MSC_VER) || defined(__DJGPP__)
#include <dos.h>
#endif
#ifdef __WATCOMC__
#include <i86.h>
#if defined(__386__) && !defined(__WINDOWS_386__)
#define INT_86 int386
#else
#define INT_86 int86
#endif
#else
#if defined(__EMX__)
#define INT_86 _int86
#else
#define INT_86 int86
#endif
#endif
#if defined(__TURBOC__) || defined(__BORLANDC__) || defined(_MSC_VER) || defined(__DJGPP__)
#if !defined(_Windows) && !defined(WINNT)
#define HB_LOCAL_DOS
#endif
#endif
/* NOTE: The parameter is an extension over CA-Cl*pper, it's also supported
by XBase++ */
HARBOUR HB_ISPRINTER( void )
{
char * pszDOSPort = ( ISCHAR( 1 ) && hb_parclen( 1 ) >= 4 ) ? hb_parc( 1 ) : "LPT1";
USHORT uiPort = atoi( pszDOSPort + 3 );
BOOL bIsPrinter = FALSE;
#ifdef HB_LOCAL_DOS
/* NOTE: DOS specific solution, using BIOS interrupt */
if( hb_strnicmp( pszDOSPort, "LPT", 3 ) == 0 && uiPort > 0 )
{
union REGS regs;
regs.h.ah = 2;
regs.w.dx = uiPort - 1;
INT_86( 0x17, &regs, &regs );
bIsPrinter = ( regs.h.ah == 0x90 );
}
else if( hb_strnicmp( pszDOSPort, "COM", 3 ) == 0 && uiPort > 0 )
{
/* TODO: Proper COM port checking */
bIsPrinter = TRUE;
}
#else
/* NOTE: Platform independent method, at least it will compiler
and run on any platform, the result may not the expected one,
since Unix/Linux doesn't support LPT/COM by nature, other OSs
may not reflect the actual physical presence of the printer when
trying to open it, since we are talking to the spooler. */
if( ( hb_strnicmp( pszDOSPort, "LPT", 3 ) == 0 ||
hb_strnicmp( pszDOSPort, "COM", 3 ) == 0 ) && uiPort > 0 )
{
FHANDLE fhnd = hb_fsOpen( pszDOSPort, FO_WRITE | FO_SHARED | FO_PRIVATE );
bIsPrinter = ( fhnd != FS_ERROR );
hb_fsClose( fhnd );
}
#endif
hb_retl( bIsPrinter );
}

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

@@ -6,7 +6,7 @@
* Harbour Project source code:
* MEMOLINE() function
*
* Copyright 1999 Ignacio Ortiz de Zúniga <ignacio@fivetech.com>
* Copyright 1999 Ignacio Ortiz de Z£niga <ignacio@fivetech.com>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify

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

@@ -33,7 +33,6 @@
*
*/
#include "hbsetup.ch"
#include "hbmemvar.ch"
#include "common.ch"
@@ -82,12 +81,8 @@
FUNCTION MEMVARBLOCK( cMemvar )
IF ISCHARACTER( cMemvar ) .AND. __mvSCOPE( cMemvar ) > MV_ERROR
#ifdef HARBOUR_STRICT_CLIPPER_COMPATIBILITY
IF ISCHARACTER( cMemvar ) .AND. __mvSCOPE( cMemvar ) > HB_MV_ERROR
RETURN {| x | iif( x == NIL, __mvGET( cMemvar ), __mvPUT( cMemvar, x ) ) }
#else
RETURN {| x | iif( PCount() == 0, __mvGET( cMemvar ), __mvPUT( cMemvar, x ) ) }
#endif
ENDIF
RETURN NIL

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

@@ -529,7 +529,7 @@ void hb_memvarNewParameter( PHB_SYMB pSymbol, PHB_ITEM pValue )
{
HB_TRACE(("hb_memvarNewParameter(%p, %p)", pSymbol, pValue));
hb_memvarCreateFromDynSymbol( pSymbol->pDynSym, MV_PRIVATE, pValue );
hb_memvarCreateFromDynSymbol( pSymbol->pDynSym, HB_MV_PRIVATE, pValue );
}
@@ -690,11 +690,11 @@ static int hb_memvarScopeGet( PHB_DYNS pDynVar )
HB_TRACE(("hb_memvarScopeGet(%p)", pDynVar));
if( pDynVar->hMemvar == 0 )
return MV_UNKNOWN;
return HB_MV_UNKNOWN;
else
{
ULONG ulBase = s_privateStackCnt; /* start from the top of the stack */
int iMemvar = MV_PUBLIC;
int iMemvar = HB_MV_PUBLIC;
while( ulBase )
{
@@ -702,9 +702,9 @@ static int hb_memvarScopeGet( PHB_DYNS pDynVar )
if( pDynVar == s_privateStack[ ulBase ] )
{
if( ulBase >= s_privateStackBase )
iMemvar = MV_PRIVATE_LOCAL;
iMemvar = HB_MV_PRIVATE_LOCAL;
else
iMemvar = MV_PRIVATE_GLOBAL;
iMemvar = HB_MV_PRIVATE_GLOBAL;
ulBase = 0;
}
}
@@ -716,7 +716,7 @@ static int hb_memvarScopeGet( PHB_DYNS pDynVar )
*/
static int hb_memvarScope( char * szVarName, ULONG ulLength )
{
int iMemvar = MV_ERROR;
int iMemvar = HB_MV_ERROR;
char * szName;
HB_TRACE(("hb_memvarScope(%s, %lu)", szVarName, ulLength));
@@ -731,7 +731,7 @@ static int hb_memvarScope( char * szVarName, ULONG ulLength )
if( pDynVar )
iMemvar = hb_memvarScopeGet( pDynVar );
else
iMemvar = MV_NOT_FOUND;
iMemvar = HB_MV_NOT_FOUND;
hb_xfree( szName );
}
@@ -759,7 +759,7 @@ static HB_DYNS_FUNC( hb_memvarClear )
*/
static HB_DYNS_FUNC( hb_memvarCountPublics )
{
if( hb_memvarScopeGet( pDynSymbol ) == MV_PUBLIC )
if( hb_memvarScopeGet( pDynSymbol ) == HB_MV_PUBLIC )
( * ( ( int * )Cargo ) )++;
return TRUE;
@@ -771,7 +771,7 @@ static int hb_memvarCount( int iScope )
{
HB_TRACE(("hb_memvarCount(%d)", iScope));
if( iScope == MV_PUBLIC )
if( iScope == HB_MV_PUBLIC )
{
int iPublicCnt = 0;
@@ -789,7 +789,7 @@ static HB_DYNS_FUNC( hb_memvarFindPublicByPos )
{
BOOL bCont = TRUE;
if( hb_memvarScopeGet( pDynSymbol ) == MV_PUBLIC )
if( hb_memvarScopeGet( pDynSymbol ) == HB_MV_PUBLIC )
{
struct mv_PUBLIC_var_info *pStruPub = (struct mv_PUBLIC_var_info *) Cargo;
if( pStruPub->iPos-- == 0 )
@@ -818,7 +818,7 @@ static HB_ITEM_PTR hb_memvarDebugVariable( int iScope, int iPos, char * *pszName
if( iPos > 0 )
{
--iPos;
if( iScope == MV_PUBLIC )
if( iScope == HB_MV_PUBLIC )
{
struct mv_PUBLIC_var_info struPub;
@@ -1208,12 +1208,12 @@ HARBOUR HB___MVRELEASE( void )
* <cVarName> = a string with a variable name to check
* $RETURNS$
* The symbolic values are defined in include/hbmemvar.ch
* MV_NOT_FOUND =variable is not declared (not found in symbol table)
* MV_UNKNOWN =if variable doesn't exist (but found in symbol table)
* MV_ERROR =if information cannot be obtained (memory error or argument error)
* MV_PUBLIC =for public variables
* MV_PRIVATE_GLOBAL =for private variables declared outside of current function/procedure
* MV_PRIVATE_LOCAL =for private variables declared in current function/procedure
* HB_MV_NOT_FOUND =variable is not declared (not found in symbol table)
* HB_MV_UNKNOWN =if variable doesn't exist (but found in symbol table)
* HB_MV_ERROR =if information cannot be obtained (memory error or argument error)
* HB_MV_PUBLIC =for public variables
* HB_MV_PRIVATE_GLOBAL =for private variables declared outside of current function/procedure
* HB_MV_PRIVATE_LOCAL =for private variables declared in current function/procedure
* $DESCRIPTION$
*
* $EXAMPLES$
@@ -1223,19 +1223,19 @@ HARBOUR HB___MVRELEASE( void )
* PRIVATE mPrivateGlobal
*
* CallProc()
* ? __mvScope( "mPrivateLocal" ) //MV_UNKNOWN
* ? __mvScope( "mPrivateLocal" ) //HB_MV_UNKNOWN
*
* RETURN
*
* PROCEDURE CallProc()
* PRIVATE mPrivateLocal
*
* ? __mvScope( "mPublic" ) //MV_PUBLIC
* ? __mvScope( "mPrivateGlobal" ) //MV_PRIVATE_GLOBAL
* ? __mvScope( "mPrivateLocal" ) //MV_PRIVATE_LOCAL
* ? __mvScope( "mFindMe" ) //MV_NOT_FOUND
* ? __mvScope( "mPublic" ) //HB_MV_PUBLIC
* ? __mvScope( "mPrivateGlobal" ) //HB_MV_PRIVATE_GLOBAL
* ? __mvScope( "mPrivateLocal" ) //HB_MV_PRIVATE_LOCAL
* ? __mvScope( "mFindMe" ) //HB_MV_NOT_FOUND
*
* IF( __mvScope( "mPublic" ) > MV_ERROR )
* IF( __mvScope( "mPublic" ) > HB_MV_ERROR )
* ? "Variable exists"
* ELSE
* ? "Variable not created yet"
@@ -1255,7 +1255,7 @@ HARBOUR HB___MVRELEASE( void )
*/
HARBOUR HB___MVSCOPE( void )
{
int iMemvar = MV_ERROR;
int iMemvar = HB_MV_ERROR;
if( hb_pcount() )
{
@@ -1315,8 +1315,8 @@ HARBOUR HB___MVCLEAR( void )
* $ARGUMENTS$
* <nScope> = the scope of variables for which an information is asked
* Supported values (defined in hbmemvar.ch)
* MV_PUBLIC
* MV_PRIVATE (or any other value)
* HB_MV_PUBLIC
* HB_MV_PRIVATE (or any other value)
* <nPosition> = the position of asked variable on the list of variables
* with specified scope - it should start from position 1
* <cVarName> = the value is filled with a variable name if passed by
@@ -1349,9 +1349,9 @@ HARBOUR HB___MVCLEAR( void )
*
* LOCAL nCount, i, xValue, cName
*
* nCount =_mvDBGINFO( MV_PUBLIC )
* nCount =_mvDBGINFO( HB_MV_PUBLIC )
* FOR i:=1 TO nCount
* xValue =__mvDBGINFO( MV_PUBLIC, i, @cName )
* xValue =__mvDBGINFO( HB_MV_PUBLIC, i, @cName )
* ? i, cName, xValue
* NEXT
*
@@ -1360,24 +1360,24 @@ HARBOUR HB___MVCLEAR( void )
* #include <hbmemvar.ch>
* PROCEDURE MAIN()
*
* ? 'PUBLIC=', __mvDBGINFO( MV_PUBLIC )
* ? 'PRIVATE=', __mvDBGINFO( MV_PRIVATE )
* ? 'PUBLIC=', __mvDBGINFO( HB_MV_PUBLIC )
* ? 'PRIVATE=', __mvDBGINFO( HB_MV_PRIVATE )
*
* PUBLIC cPublic:='cPublic in MAIN'
*
* ? 'PUBLIC=', __mvDBGINFO( MV_PUBLIC )
* ? 'PRIVATE=', __mvDBGINFO( MV_PRIVATE )
* ? 'PUBLIC=', __mvDBGINFO( HB_MV_PUBLIC )
* ? 'PRIVATE=', __mvDBGINFO( HB_MV_PRIVATE )
*
* PRIVATE cPrivate:='cPrivate in MAIN'
*
* ? 'PUBLIC=', __mvDBGINFO( MV_PUBLIC )
* ? 'PRIVATE=', __mvDBGINFO( MV_PRIVATE )
* ? 'PUBLIC=', __mvDBGINFO( HB_MV_PUBLIC )
* ? 'PRIVATE=', __mvDBGINFO( HB_MV_PRIVATE )
*
* CountMemvars()
*
* ? 'Back in Main'
* ? 'PUBLIC=', __mvDBGINFO( MV_PUBLIC )
* ? 'PRIVATE=', __mvDBGINFO( MV_PRIVATE )
* ? 'PUBLIC=', __mvDBGINFO( HB_MV_PUBLIC )
* ? 'PRIVATE=', __mvDBGINFO( HB_MV_PRIVATE )
*
*
* RETURN
@@ -1388,23 +1388,23 @@ HARBOUR HB___MVCLEAR( void )
* PRIVATE ccPrivate:='ccPrivate'
*
* ? 'In CountMemvars'
* ? 'PUBLIC=', __mvDBGINFO( MV_PUBLIC )
* ? 'PRIVATE=', __mvDBGINFO( MV_PRIVATE )
* ? 'PUBLIC=', __mvDBGINFO( HB_MV_PUBLIC )
* ? 'PRIVATE=', __mvDBGINFO( HB_MV_PRIVATE )
*
* PRIVATE cPublic:='cPublic'
*
* ? 'PUBLIC=', __mvDBGINFO( MV_PUBLIC )
* ? 'PRIVATE=', __mvDBGINFO( MV_PRIVATE )
* ? 'PUBLIC=', __mvDBGINFO( HB_MV_PUBLIC )
* ? 'PRIVATE=', __mvDBGINFO( HB_MV_PRIVATE )
*
* nCnt =__mvDBGINFO( MV_PRIVATE ) +1
* nCnt =__mvDBGINFO( HB_MV_PRIVATE ) +1
* FOR i:=1 TO nCnt
* xVal =__mvDBGINFO( MV_PRIVATE, i, @cName )
* xVal =__mvDBGINFO( HB_MV_PRIVATE, i, @cName )
* ? i, '=', cName, xVal
* NEXT
*
* nCnt =__mvDBGINFO( MV_PUBLIC ) +1
* nCnt =__mvDBGINFO( HB_MV_PUBLIC ) +1
* FOR i:=1 TO nCnt
* xVal =__mvDBGINFO( MV_PUBLIC, i, @cName )
* xVal =__mvDBGINFO( HB_MV_PUBLIC, i, @cName )
* ? i, '=', cName, xVal
* NEXT
*

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

@@ -72,7 +72,7 @@ function __MenuTo( bBlock, cVariable )
// Detect if a memvar was passed
if __mvSCOPE( cVariable ) <= MV_ERROR
if __mvSCOPE( cVariable ) <= HB_MV_ERROR
__mvPUBLIC( cVariable )
lDeclared := .T.
else

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

@@ -6,7 +6,7 @@
* Harbour Project source code:
* MLCOUNT() function
*
* Copyright 1999 Ignacio Ortiz de Zúniga <ignacio@fivetech.com>
* Copyright 1999 Ignacio Ortiz de Z£niga <ignacio@fivetech.com>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify

111
harbour/source/rtl/mouse/mousestd.c Normal file
View File

@@ -0,0 +1,111 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* Mouse subsystem for plain ANSI C stream IO (stub)
*
* Copyright 1999 Victor Szel <info@szelvesz.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 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) 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 HRL
* and/or HVM code into it.
*
* 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 program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
#include "mouseapi.h"
/* NOTE: This file is a simple stub for those platforms which don't have
any kind of mouse support. */
/* C callable low-level interface */
void hb_mouse_Init( void )
{
;
}
void hb_mouse_Exit( void )
{
;
}
BOOL hb_mouse_IsPresent( void )
{
return FALSE;
}
void hb_mouse_Show( void )
{
;
}
void hb_mouse_Hide( void )
{
;
}
int hb_mouse_Col( void )
{
return 0;
}
int hb_mouse_Row( void )
{
return 0;
}
void hb_mouse_SetPos( int iRow, int iCol )
{
HB_SYMBOL_UNUSED( iRow );
HB_SYMBOL_UNUSED( iCol );
}
BOOL hb_mouse_IsButtonPressed( int iButton )
{
HB_SYMBOL_UNUSED( iButton );
return FALSE;
}
int hb_mouse_CountButton( void )
{
return 0;
}
void hb_mouse_SetBounds( int iTop, int iLeft, int iBottom, int iRight )
{
HB_SYMBOL_UNUSED( iTop );
HB_SYMBOL_UNUSED( iLeft );
HB_SYMBOL_UNUSED( iBottom );
HB_SYMBOL_UNUSED( iRight );
}
void hb_mouse_GetBounds( int * piTop, int * piLeft, int * piBottom, int * piRight )
{
HB_SYMBOL_UNUSED( piTop );
HB_SYMBOL_UNUSED( piLeft );
HB_SYMBOL_UNUSED( piBottom );
HB_SYMBOL_UNUSED( piRight );
}

2
harbour/source/rtl/mouse/mousetpl.c
View File

@@ -51,7 +51,7 @@ BOOL hb_mouse_IsPresent( void )
{
/* TODO: */
return 0;
return FALSE;
}
void hb_mouse_Show( void )

32
harbour/source/rtl/mouse/mousewin.c
View File

@@ -33,8 +33,34 @@
*
*/
#define WIN32_LEAN_AND_MEAN
#if defined(__GNUC__)
#define HB_DONT_DEFINE_BASIC_TYPES
#endif /* __GNUC__ */
#include <windows.h>
#include "mouseapi.h"
#if defined(__IBMCPP__)
#undef WORD /* 2 bytes unsigned */
typedef unsigned short int WORD;
#else
#if ! defined(HB_DONT_DEFINE_BASIC_TYPES)
#undef WORD /* 2 bytes unsigned */
typedef unsigned short int WORD;
#undef DWORD /* 4 bytes unsigned */
typedef unsigned long DWORD;
#endif
#endif
#if ! defined(__GNUC__)
#ifdef __CYGWIN__
typedef WORD far * LPWORD;
#endif
#endif /* __GNUC__ */
/* C callable low-level interface */
void hb_mouse_Init( void )
@@ -97,9 +123,11 @@ BOOL hb_mouse_IsButtonPressed( int iButton )
int hb_mouse_CountButton( void )
{
/* TODO: */
DWORD dwCount = 0;
return 0;
GetNumberOfConsoleMouseButtons( &dwCount );
return dwCount;
}
void hb_mouse_SetBounds( int iTop, int iLeft, int iBottom, int iRight )

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

@@ -163,6 +163,8 @@ void hb_mouseGetBounds( int * piTop, int * piLeft, int * piBottom, int * piRight
/* HARBOUR callable interface */
#ifdef HB_COMPAT_C53
HARBOUR MPRESENT( void )
{
hb_retl( hb_mouseIsPresent() );
@@ -304,3 +306,5 @@ HARBOUR MSETBOUNDS( void )
hb_mouseSetBounds( iTop, iLeft, iBottom, iRight );
}
#endif

10
harbour/source/rtl/mousexxx.c
View File

@@ -35,10 +35,14 @@
#include "hbsetup.h"
#if defined(HARBOUR_USE_DOS_MSAPI)
#if defined(HARBOUR_USE_STD_GTAPI)
#include "mouse/mousestd.c"
#elif defined(HARBOUR_USE_DOS_GTAPI)
#include "mouse/mousedos.c"
#elif defined(HARBOUR_USE_OS2_MSAPI)
#elif defined(HARBOUR_USE_OS2_GTAPI)
#include "mouse/mouseos2.c"
#elif defined(HARBOUR_USE_WIN_MSAPI)
#elif defined(HARBOUR_USE_WIN_GTAPI)
#include "mouse/mousewin.c"
#else
#include "mouse/mousestd.c"
#endif

80
harbour/source/rtl/net.c Normal file
View File

@@ -0,0 +1,80 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* NETNAME() function
*
* Copyright 1999 Victor Szel <info@szelvesz.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 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) 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 HRL
* and/or HVM code into it.
*
* 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 program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
/* NOTE: The following #include "hbwinapi.h" must
be ahead of any other #include statements! */
#include "hbwinapi.h"
#include "extend.h"
/* TODO: Implement NETNAME() for other platforms */
/* NOTE: Clipper will only return a maximum of 15 bytes from this function. */
/* NOTE: DOS instructions:
On entry: AH 5Eh
AL 00h
DS:DX Pointer to a memory buffer (16 bytes) where
computer name will be returned
Returns: CH 0 name not defined
not 0 name is defined
CL NETBIOS name number (if CH not 0)
DS:DX Pointer to computer name (ASCIIZ string)
AX Error code, if CF is set
*/
HARBOUR HB_NETNAME( void )
{
#if defined(_Windows) || defined(WINNT)
{
HKEY hKey;
DWORD ulLen = 128;
char * pszValue = hb_xgrab( ulLen );
pszValue[ 0 ] = '\0';
RegOpenKey( HKEY_LOCAL_MACHINE, "SYSTEM\\CurrentControlSet\\Control\\ComputerName\\ComputerName", &hKey );
RegQueryValueEx( hKey, "ComputerName", NULL, NULL, pszValue, &ulLen );
RegCloseKey( hKey );
hb_retc( pszValue );
hb_xfree( pszValue );
}
#else
hb_retc( "" )
#endif
}

14
harbour/source/rtl/objfunc.prg
View File

@@ -147,8 +147,8 @@ return __objGetMsgList( oObject, .F. )
// Basically the same as __objGetMsgList except that it returns a 2D array
// containing :
//
// [x][DATA_SYMBOL] Symbol name
// [x][DATA_VALUE] Value of DATA
// [x][HB_OO_DATA_SYMBOL] Symbol name
// [x][HB_OO_DATA_VALUE] Value of DATA
//
// aExcept is an optional list of DATA you do not want to collect
//
@@ -195,7 +195,7 @@ function __objSetValueList( oObject, aData )
endif
aEval( aData,;
{|aItem| __objSendMsg( oObject, "_" + aItem[DATA_SYMBOL], aItem[DATA_VALUE] ) } )
{| aItem | __objSendMsg( oObject, "_" + aItem[ HB_OO_DATA_SYMBOL ], aItem[ HB_OO_DATA_VALUE ] ) } )
return oObject
@@ -214,7 +214,7 @@ function __objAddMethod( oObject, cSymbol, nFuncPtr )
endif
if !__objHasMsg( oObject, cSymbol )
__clsAddMsg( oObject:ClassH, cSymbol, nFuncPtr, MET_METHOD )
__clsAddMsg( oObject:ClassH, cSymbol, nFuncPtr, HB_OO_MSG_METHOD )
else
__errRT_BASE(EG_ARG, 3103, "Already existing symbol in class", ProcName( 0 ) )
endif
@@ -235,7 +235,7 @@ function __objAddInline( oObject, cSymbol, bInline )
endif
if !__objHasMsg( oObject, cSymbol )
__clsAddMsg( oObject:ClassH, cSymbol, bInline, MET_INLINE )
__clsAddMsg( oObject:ClassH, cSymbol, bInline, HB_OO_MSG_INLINE )
else
__errRT_BASE(EG_ARG, 3103, "Already existing symbol in class", ProcName( 0 ) )
endif
@@ -261,8 +261,8 @@ function __objAddData( oObject, cSymbol )
!__objHasMsg( oObject, "_" + cSymbol )
nSeq := __cls_IncData( oObject:ClassH ) // Allocate new Seq#
__clsAddMsg( oObject:ClassH, cSymbol, nSeq, MET_DATA )
__clsAddMsg( oObject:ClassH, "_" + cSymbol, nSeq, MET_DATA )
__clsAddMsg( oObject:ClassH, cSymbol, nSeq, HB_OO_MSG_DATA )
__clsAddMsg( oObject:ClassH, "_" + cSymbol, nSeq, HB_OO_MSG_DATA )
else
__errRT_BASE(EG_ARG, 3103, "Already existing symbol in class", ProcName( 0 ) )
endif

6
harbour/source/rtl/oldbox.c
View File

@@ -37,24 +37,30 @@
HARBOUR HB___BOX( void )
{
#ifdef HARBOUR_USE_GTAPI
char * frame = hb_parc( 5 );
if( ISNUM( 1 ) && ISNUM( 2 ) && ISNUM( 3 ) && ISNUM( 4 ) && ISCHAR( 5 ) )
hb_gtBox( hb_parni( 1 ), hb_parni( 2 ),
hb_parni( 3 ), hb_parni( 4 ),
( BYTE * ) ( frame ? frame : " " ) );
#endif
}
HARBOUR HB___BOXD( void )
{
#ifdef HARBOUR_USE_GTAPI
if( ISNUM( 1 ) && ISNUM( 2 ) && ISNUM( 3 ) && ISNUM( 4 ) )
hb_gtBoxD( hb_parni( 1 ), hb_parni( 2 ),
hb_parni( 3 ), hb_parni( 4 ) );
#endif
}
HARBOUR HB___BOXS( void )
{
#ifdef HARBOUR_USE_GTAPI
if( ISNUM( 1 ) && ISNUM( 2 ) && ISNUM( 3 ) && ISNUM( 4 ) )
hb_gtBoxS( hb_parni( 1 ), hb_parni( 2 ),
hb_parni( 3 ), hb_parni( 4 ) );
#endif
}

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

@@ -37,16 +37,20 @@
HARBOUR HB___ATCLEAR( void )
{
#ifdef HARBOUR_USE_GTAPI
if( hb_pcount() == 4 )
{
hb_gtSetPos( hb_parni( 1 ), hb_parni( 2 ) );
hb_gtScroll( hb_parni( 1 ), hb_parni( 2 ), hb_parni( 3 ), hb_parni( 4 ), 0, 0 );
}
#endif
}
HARBOUR HB___CLEAR( void )
{
#ifdef HARBOUR_USE_GTAPI
hb_gtScroll( 0, 0, hb_gtMaxRow(), hb_gtMaxCol(), 0, 0 );
hb_gtSetPos( 0, 0 );
#endif
}

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

@@ -177,7 +177,7 @@ int hb_strnicmp( const char * s1, const char * s2, ULONG count )
return rc;
}
static BOOL hb_strMatchDOS( char *pszString, char *pszMask )
static BOOL hb_strMatchDOS( char * pszString, char * pszMask )
{
HB_TRACE(("hb_strMatchDOS(%s, %s)", pszString, pszMask));
@@ -225,7 +225,7 @@ static BOOL hb_strMatchDOS( char *pszString, char *pszMask )
/* TODO: Replace it with a code that supports real regular expressions
*
*/
BOOL hb_strMatchRegExp( char *szString, char *szMask )
BOOL hb_strMatchRegExp( char * szString, char * szMask )
{
HB_TRACE(("hb_strMatchRegExp(%s, %s)", szString, szMask));
@@ -267,7 +267,7 @@ HARBOUR HB_ISLOWER( void )
/* trims from the left, and returns a new pointer to szText */
/* also returns the new length in lLen */
char *hb_strLTrim( char *szText, ULONG *lLen )
char * hb_strLTrim( char * szText, ULONG * lLen )
{
HB_TRACE(("hb_strLTrim(%s, %p)", szText, lLen));
@@ -291,19 +291,27 @@ HARBOUR HB_LTRIM( void )
if( pText )
{
ULONG lLen = pText->item.asString.length;
char *szText = hb_strLTrim( pText->item.asString.value, &lLen );
char * szText = hb_strLTrim( pText->item.asString.value, &lLen );
hb_retclen( szText, lLen );
}
else
hb_errRT_BASE( EG_ARG, 1101, NULL, "LTRIM" );
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1101, NULL, "LTRIM" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "LTRIM" ); /* NOTE: Clipper catches this at compile time! */
}
/* returns szText and the new length in lLen */
ULONG hb_strRTrimLen( char *szText, ULONG lLen, BOOL bAnySpace )
ULONG hb_strRTrimLen( char * szText, ULONG lLen, BOOL bAnySpace )
{
HB_TRACE(("hb_strRTrimLen(%s, %lu. %d)", szText, lLen, (int) bAnySpace));
@@ -337,15 +345,20 @@ HARBOUR HB_RTRIM( void )
hb_retclen( pText->item.asString.value, hb_strRTrimLen( pText->item.asString.value, pText->item.asString.length, bAnySpace ) );
}
else
#ifdef HARBOUR_STRICT_CLIPPER_COMPATIBILITY
/* Clipper doesn't error, but only in RTRIM. TRIM() throws an error, though */
hb_retc( "" );
#else
hb_errRT_BASE( EG_ARG, 1100, NULL, "RTRIM" );
#endif
{
/* NOTE: "TRIM" is right here */
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1100, NULL, "TRIM" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "RTRIM" ); /* NOTE: Clipper catches this at compile time! */
/* NOTE: "TRIM" is right here */
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "TRIM" ); /* NOTE: Clipper catches this at compile time! */
}
/* NOTE: The second parameter is a Harbour extension */
@@ -353,20 +366,7 @@ HARBOUR HB_RTRIM( void )
/* synonymn for RTRIM */
HARBOUR HB_TRIM( void )
{
if( hb_pcount() >= 1 && hb_pcount() <= 2 )
{
PHB_ITEM pText = hb_param( 1, IT_STRING );
if( pText )
{
BOOL bAnySpace = ( ISLOG( 2 ) ? hb_parl( 2 ) : FALSE );
hb_retclen( pText->item.asString.value, hb_strRTrimLen( pText->item.asString.value, pText->item.asString.length, bAnySpace ) );
}
else
hb_errRT_BASE( EG_ARG, 1100, NULL, "TRIM" );
}
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "TRIM" ); /* NOTE: Clipper catches this at compile time! */
HB_RTRIM();
}
/* NOTE: The second parameter is a Harbour extension */
@@ -377,7 +377,7 @@ HARBOUR HB_ALLTRIM( void )
{
if( ISCHAR( 1 ) )
{
char *szText = hb_parc( 1 );
char * szText = hb_parc( 1 );
BOOL bAnySpace = ( ISLOG( 2 ) ? hb_parl( 2 ) : FALSE );
ULONG lLen;
@@ -388,8 +388,16 @@ HARBOUR HB_ALLTRIM( void )
hb_retclen( szText, lLen );
}
else
#ifdef HB_COMPATIBILITY_CLIPPER_53
hb_errRT_BASE( EG_ARG, 2022, NULL, "ALLTRIM" );
#ifdef HB_COMPAT_C53
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 2022, NULL, "ALLTRIM" ); /* NOTE: This appeared in CA-Cl*pper 5.3 */
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
#else
hb_retc( "" );
#endif
@@ -449,7 +457,7 @@ HARBOUR HB_PADR( void )
{
ULONG ulSize;
char buffer[ 128 ];
char *szText = hb_itemPadConv( hb_param( 1, IT_ANY ), buffer, &ulSize );
char * szText = hb_itemPadConv( hb_param( 1, IT_ANY ), buffer, &ulSize );
if( szText && ISNUM( 2 ) )
{
@@ -457,7 +465,7 @@ HARBOUR HB_PADR( void )
if( lLen > ( LONG ) ulSize )
{
char *szResult = ( char * ) hb_xgrab( lLen + 1 );
char * szResult = ( char * ) hb_xgrab( lLen + 1 );
LONG lPos;
char cPad;
@@ -503,7 +511,7 @@ HARBOUR HB_PADL( void )
if( lLen > ( LONG ) ulSize )
{
char *szResult = ( char * ) hb_xgrab( lLen + 1 );
char * szResult = ( char * ) hb_xgrab( lLen + 1 );
LONG lPos = lLen - ( LONG ) ulSize;
char cPad;
@@ -537,7 +545,7 @@ HARBOUR HB_PADC( void )
{
ULONG ulSize;
char buffer[ 128 ];
char *szText = hb_itemPadConv( hb_param( 1, IT_ANY ), buffer, &ulSize );
char * szText = hb_itemPadConv( hb_param( 1, IT_ANY ), buffer, &ulSize );
if( szText && ISNUM( 2 ) )
{
@@ -545,7 +553,7 @@ HARBOUR HB_PADC( void )
if( lLen > ( LONG ) ulSize )
{
char *szResult = ( char * ) hb_xgrab( lLen + 1 );
char * szResult = ( char * ) hb_xgrab( lLen + 1 );
char cPad;
LONG w, lPos = ( lLen - ( LONG ) ulSize ) / 2;
@@ -580,31 +588,26 @@ ULONG hb_strAt( char * szSub, ULONG ulSubLen, char * szText, ULONG ulLen )
{
HB_TRACE(("hb_strAt(%s, %lu, %s, %lu)", szSub, ulSubLen, szText, ulLen));
if( ulSubLen )
if( ulSubLen > 0 && ulLen >= ulSubLen )
{
if( ulLen >= ulSubLen )
{
ULONG ulPos = 0, ulSubPos = 0;
ULONG ulPos = 0, ulSubPos = 0;
while( ulPos < ulLen && ulSubPos < ulSubLen )
while( ulPos < ulLen && ulSubPos < ulSubLen )
{
if( *( szText + ulPos ) == *( szSub + ulSubPos ) )
{
if( *( szText + ulPos ) == *( szSub + ulSubPos ) )
{
ulSubPos++;
ulPos++;
}
else if( ulSubPos )
ulSubPos = 0;
else
ulPos++;
ulSubPos++;
ulPos++;
}
return ( ulSubPos < ulSubLen ) ? 0 : ( ulPos - ulSubLen + 1 );
else if( ulSubPos )
ulSubPos = 0;
else
ulPos++;
}
else
return 0;
return ( ulSubPos < ulSubLen ) ? 0 : ( ulPos - ulSubLen + 1 );
}
else
return 1;
return 0;
}
/* locates a substring in a string */
@@ -616,12 +619,21 @@ HARBOUR HB_AT( void )
PHB_ITEM pSub = hb_param( 1, IT_STRING );
PHB_ITEM pText = hb_param( 2, IT_STRING );
if( IS_STRING( pText ) && IS_STRING( pSub ) )
if( pText && pSub )
{
hb_retnl( hb_strAt( pSub->item.asString.value, pSub->item.asString.length, pText->item.asString.value, pText->item.asString.length ) );
hb_retnl( hb_strAt( pSub->item.asString.value, pSub->item.asString.length,
pText->item.asString.value, pText->item.asString.length ) );
}
else
hb_errRT_BASE( EG_ARG, 1108, NULL, "AT" );
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1108, NULL, "AT" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "AT" ); /* NOTE: Clipper catches this at compile time! */
@@ -640,8 +652,8 @@ HARBOUR HB_RAT( void )
if( lPos >= 0 )
{
char *szSub = hb_parc( 1 );
char *szText = hb_parc( 2 );
char * szSub = hb_parc( 1 );
char * szText = hb_parc( 2 );
BOOL bFound = FALSE;
while( lPos >= 0 && !bFound )
@@ -751,7 +763,15 @@ HARBOUR HB_LEFT( void )
hb_retclen( pText->item.asString.value, lLen );
}
else
hb_errRT_BASE( EG_ARG, 1124, NULL, "LEFT" );
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1124, NULL, "LEFT" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "LEFT" ); /* NOTE: Clipper catches this at compile time! */
@@ -807,12 +827,27 @@ HARBOUR HB_SUBSTR( void )
{
LONG lLen;
if( ISNUM( 3 ) )
if( hb_pcount() >= 3 )
{
lLen = hb_parnl( 3 );
if( ISNUM( 3 ) )
{
lLen = hb_parnl( 3 );
if( lLen > ( LONG ) pText->item.asString.length - lPos )
lLen = ( LONG ) pText->item.asString.length - lPos;
if( lLen > ( LONG ) pText->item.asString.length - lPos )
lLen = ( LONG ) pText->item.asString.length - lPos;
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1110, NULL, "SUBSTR" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
/* NOTE: Exit from inside */
return;
}
}
}
else
lLen = ( LONG ) pText->item.asString.length - lPos;
@@ -826,14 +861,22 @@ HARBOUR HB_SUBSTR( void )
hb_retc( "" );
}
else
hb_errRT_BASE( EG_ARG, 1110, NULL, "SUBSTR" );
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1110, NULL, "SUBSTR" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "SUBSTR" ); /* NOTE: Clipper catches this at compile time! */
}
/* converts szText to lower case. Does not create a new string! */
char *hb_strLower( char *szText, ULONG ulLen )
char * hb_strLower( char * szText, ULONG ulLen )
{
ULONG i;
@@ -854,12 +897,23 @@ HARBOUR HB_LOWER( void )
if( pText )
{
ULONG ulLen = pText->item.asString.length;
char * pszBuffer = hb_itemGetC( pText );
ULONG ulLen = hb_itemGetCLen( pText );
hb_retclen( hb_strLower( pText->item.asString.value, ulLen ), ulLen );
hb_retclen( hb_strLower( pszBuffer, ulLen ), ulLen );
hb_itemFreeC( pszBuffer );
}
else
hb_errRT_BASE( EG_ARG, 1103, NULL, "LOWER" );
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1103, NULL, "LOWER" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "LOWER" ); /* NOTE: Clipper catches this at compile time! */
@@ -867,7 +921,7 @@ HARBOUR HB_LOWER( void )
void hb_strupr( char * szText )
{
char *p;
char * p;
HB_TRACE(("hb_strupr(%s)", szText));
@@ -876,7 +930,7 @@ void hb_strupr( char * szText )
}
/* converts szText to upper case. Does not create a new string! */
char *hb_strUpper( char *szText, ULONG ulLen )
char * hb_strUpper( char * szText, ULONG ulLen )
{
ULONG i;
@@ -890,9 +944,9 @@ char *hb_strUpper( char *szText, ULONG ulLen )
/* This function copies and converts szText to upper case.
*/
char *hb_strncpyUpper( char * pDest, char *pSource, ULONG ulLen )
char * hb_strncpyUpper( char * pDest, char * pSource, ULONG ulLen )
{
char *pStart = pDest;
char * pStart = pDest;
HB_TRACE(("hb_strncpyUpper(%s, %s, %lu)", pDest, pSource, ulLen));
@@ -913,12 +967,23 @@ HARBOUR HB_UPPER( void )
if( pText )
{
ULONG ulLen = pText->item.asString.length;
char * pszBuffer = hb_itemGetC( pText );
ULONG ulLen = hb_itemGetCLen( pText );
hb_retclen( hb_strUpper( pText->item.asString.value, ulLen ), ulLen );
hb_retclen( hb_strUpper( pszBuffer, ulLen ), ulLen );
hb_itemFreeC( pszBuffer );
}
else
hb_errRT_BASE( EG_ARG, 1102, NULL, "UPPER" );
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1102, NULL, "UPPER" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "UPPER" ); /* NOTE: Clipper catches this at compile time! */
@@ -940,9 +1005,9 @@ HARBOUR HB_REPLICATE( void )
if( ( double ) ( ( double ) ulLen * ( double ) lTimes ) < ( double ) ULONG_MAX )
{
char *szText = hb_parc( 1 );
char *szResult = ( char * ) hb_xgrab( ( ulLen * lTimes ) + 1 );
char *szPtr = szResult;
char * szText = hb_parc( 1 );
char * szResult = ( char * ) hb_xgrab( ( ulLen * lTimes ) + 1 );
char * szPtr = szResult;
LONG i;
for( i = 0; i < lTimes; i++ )
@@ -995,7 +1060,7 @@ HARBOUR HB_SPACE( void )
if( lLen > 0 )
{
char *szResult = ( char * ) hb_xgrab( lLen + 1 );
char * szResult = ( char * ) hb_xgrab( lLen + 1 );
/* NOTE: String overflow could never occure since a string can */
/* be as large as ULONG_MAX, and the maximum length that */
@@ -1029,7 +1094,7 @@ HARBOUR HB_STUFF( void )
{
if( ISCHAR( 1 ) && ISNUM( 2 ) && ISNUM( 3 ) && ISCHAR( 4 ) )
{
char *szText = hb_parc( 1 );
char * szText = hb_parc( 1 );
ULONG ulText = hb_parclen( 1 );
ULONG ulPos = hb_parnl( 2 );
ULONG ulDel = hb_parnl( 3 );
@@ -1081,12 +1146,12 @@ HARBOUR HB_STRTRAN( void )
if( pSeek )
{
char *szText = pText->item.asString.value;
char * szText = pText->item.asString.value;
if( pSeek->item.asString.length && pSeek->item.asString.length <= pText->item.asString.length )
{
char *szSeek = pSeek->item.asString.value;
char *szReplace;
char * szSeek = pSeek->item.asString.value;
char * szReplace;
ULONG ulStart;
ulStart = ( ISNUM( 4 ) ? hb_parnl( 4 ) : 1 );
@@ -1152,8 +1217,8 @@ HARBOUR HB_STRTRAN( void )
if( ulFound )
{
char *szResult = ( char * ) hb_xgrab( ulLength + 1 );
char *szPtr = szResult;
char * szResult = ( char * ) hb_xgrab( ulLength + 1 );
char * szPtr = szResult;
ulFound = 0;
i = 0;
@@ -1199,14 +1264,30 @@ HARBOUR HB_STRTRAN( void )
hb_retclen( szText, pText->item.asString.length );
}
else
hb_errRT_BASE( EG_ARG, 1126, NULL, "STRTRAN" ); /* NOTE: Undocumented but existing Clipper Run-time error */
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1126, NULL, "STRTRAN" ); /* NOTE: Undocumented but existing Clipper Run-time error */
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
else
hb_errRT_BASE( EG_ARG, 1126, NULL, "STRTRAN" ); /* NOTE: Undocumented but existing Clipper Run-time error */
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1126, NULL, "STRTRAN" ); /* NOTE: Undocumented but existing Clipper Run-time error */
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
/* returns the numeric value of a character string representation of a number */
double hb_strVal( char *szText )
double hb_strVal( char * szText )
{
HB_TRACE(("hb_strVal(%s)", szText));
@@ -1240,7 +1321,15 @@ HARBOUR HB_VAL( void )
hb_retnlen( hb_strVal( pText->item.asString.value ), iWidth, iDec );
}
else
hb_errRT_BASE( EG_ARG, 1098, NULL, "VAL" );
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1098, NULL, "VAL" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "VAL" ); /* NOTE: Clipper catches this at compile time! */

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

@@ -411,7 +411,7 @@ METHOD DeHilite() CLASS TBrowse
local nColor := If( ::aColumns[ ::ColPos ]:ColorBlock != nil,;
Eval( ::aColumns[ ::ColPos ]:ColorBlock )[ 1 ], 1 )
local cColor := __ColorIndex( ::ColorSpec, nColor - 1 )
local cColor := hb_ColorIndex( ::ColorSpec, nColor - 1 )
local ftmp := Eval( ::aColumns[ ::ColPos ]:block )
if valtype( ftmp ) == "L"
@@ -436,7 +436,7 @@ METHOD Hilite() CLASS TBrowse
local nColor := If( ::aColumns[ ::ColPos ]:ColorBlock != nil,;
Eval( ::aColumns[ ::ColPos ]:ColorBlock )[ 2 ], 2 )
local cColor := __ColorIndex( ::ColorSpec, nColor - 1 )
local cColor := hb_ColorIndex( ::ColorSpec, nColor - 1 )
local ftmp := Eval( ::aColumns[ ::ColPos ]:block )
if valtype( ftmp ) == "L"
@@ -629,7 +629,7 @@ METHOD Stabilize() CLASS TBrowse
endif
if lDisplay
cColColor = If( ::aColumns[ n ]:ColorBlock != nil,;
__ColorIndex( ::ColorSpec,;
hb_ColorIndex( ::ColorSpec,;
Eval( ::aColumns[ n ]:ColorBlock )[ 1 ] - 1 ),;
::ColorSpec )
ftmp = Eval( ::aColumns[ n ]:block )

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

@@ -59,37 +59,37 @@ FUNCTION TClass()
IF s_hClass == NIL
s_hClass := __clsNew( "TCLASS", 10 )
__clsAddMsg( s_hClass, "New" , @New() , MET_METHOD )
__clsAddMsg( s_hClass, "Create" , @Create() , MET_METHOD )
__clsAddMsg( s_hClass, "AddData" , @AddData() , MET_METHOD )
__clsAddMsg( s_hClass, "AddClassData", @AddClassData(), MET_METHOD )
__clsAddMsg( s_hClass, "AddInline" , @AddInline() , MET_METHOD )
__clsAddMsg( s_hClass, "AddMethod" , @AddMethod() , MET_METHOD )
__clsAddMsg( s_hClass, "AddVirtual" , @AddVirtual() , MET_METHOD )
__clsAddMsg( s_hClass, "Instance" , @Instance() , MET_METHOD )
__clsAddMsg( s_hClass, "SetInit" , @SetInit() , MET_METHOD )
__clsAddMsg( s_hClass, "SetType" , @SetType() , MET_METHOD )
__clsAddMsg( s_hClass, "New" , @New() , HB_OO_MSG_METHOD )
__clsAddMsg( s_hClass, "Create" , @Create() , HB_OO_MSG_METHOD )
__clsAddMsg( s_hClass, "AddData" , @AddData() , HB_OO_MSG_METHOD )
__clsAddMsg( s_hClass, "AddClassData", @AddClassData(), HB_OO_MSG_METHOD )
__clsAddMsg( s_hClass, "AddInline" , @AddInline() , HB_OO_MSG_METHOD )
__clsAddMsg( s_hClass, "AddMethod" , @AddMethod() , HB_OO_MSG_METHOD )
__clsAddMsg( s_hClass, "AddVirtual" , @AddVirtual() , HB_OO_MSG_METHOD )
__clsAddMsg( s_hClass, "Instance" , @Instance() , HB_OO_MSG_METHOD )
__clsAddMsg( s_hClass, "SetInit" , @SetInit() , HB_OO_MSG_METHOD )
__clsAddMsg( s_hClass, "SetType" , @SetType() , HB_OO_MSG_METHOD )
__clsAddMsg( s_hClass, "hClass" , 1, MET_DATA )
__clsAddMsg( s_hClass, "_hClass" , 1, MET_DATA )
__clsAddMsg( s_hClass, "cName" , 2, MET_DATA )
__clsAddMsg( s_hClass, "_cName" , 2, MET_DATA )
__clsAddMsg( s_hClass, "aDatas" , 3, MET_DATA )
__clsAddMsg( s_hClass, "_aDatas" , 3, MET_DATA )
__clsAddMsg( s_hClass, "aMethods" , 4, MET_DATA )
__clsAddMsg( s_hClass, "_aMethods" , 4, MET_DATA )
__clsAddMsg( s_hClass, "aClsDatas" , 5, MET_DATA )
__clsAddMsg( s_hClass, "_aClsDatas" , 5, MET_DATA )
__clsAddMsg( s_hClass, "aInlines" , 6, MET_DATA )
__clsAddMsg( s_hClass, "_aInlines" , 6, MET_DATA )
__clsAddMsg( s_hClass, "aVirtuals" , 7, MET_DATA )
__clsAddMsg( s_hClass, "_aVirtuals" , 7, MET_DATA )
__clsAddMsg( s_hClass, "cSuper" , 8, MET_DATA )
__clsAddMsg( s_hClass, "_cSuper" , 8, MET_DATA )
__clsAddMsg( s_hClass, "uInit" , 9, MET_DATA )
__clsAddMsg( s_hClass, "_uInit" , 9, MET_DATA )
__clsAddMsg( s_hClass, "cType" , 10, MET_DATA )
__clsAddMsg( s_hClass, "_cType" , 10, MET_DATA )
__clsAddMsg( s_hClass, "hClass" , 1, HB_OO_MSG_DATA )
__clsAddMsg( s_hClass, "_hClass" , 1, HB_OO_MSG_DATA )
__clsAddMsg( s_hClass, "cName" , 2, HB_OO_MSG_DATA )
__clsAddMsg( s_hClass, "_cName" , 2, HB_OO_MSG_DATA )
__clsAddMsg( s_hClass, "aDatas" , 3, HB_OO_MSG_DATA )
__clsAddMsg( s_hClass, "_aDatas" , 3, HB_OO_MSG_DATA )
__clsAddMsg( s_hClass, "aMethods" , 4, HB_OO_MSG_DATA )
__clsAddMsg( s_hClass, "_aMethods" , 4, HB_OO_MSG_DATA )
__clsAddMsg( s_hClass, "aClsDatas" , 5, HB_OO_MSG_DATA )
__clsAddMsg( s_hClass, "_aClsDatas" , 5, HB_OO_MSG_DATA )
__clsAddMsg( s_hClass, "aInlines" , 6, HB_OO_MSG_DATA )
__clsAddMsg( s_hClass, "_aInlines" , 6, HB_OO_MSG_DATA )
__clsAddMsg( s_hClass, "aVirtuals" , 7, HB_OO_MSG_DATA )
__clsAddMsg( s_hClass, "_aVirtuals" , 7, HB_OO_MSG_DATA )
__clsAddMsg( s_hClass, "cSuper" , 8, HB_OO_MSG_DATA )
__clsAddMsg( s_hClass, "_cSuper" , 8, HB_OO_MSG_DATA )
__clsAddMsg( s_hClass, "uInit" , 9, HB_OO_MSG_DATA )
__clsAddMsg( s_hClass, "_uInit" , 9, HB_OO_MSG_DATA )
__clsAddMsg( s_hClass, "cType" , 10, HB_OO_MSG_DATA )
__clsAddMsg( s_hClass, "_cType" , 10, HB_OO_MSG_DATA )
ENDIF
RETURN __clsInst( s_hClass )
@@ -133,8 +133,8 @@ STATIC FUNCTION Create()
hSuper := __clsInstSuper( Upper( ::cSuper ) )
hClass := __clsNew( ::cName, nLenDatas, hSuper )
// Add class casts
__clsAddMsg( hClass, Upper( ::cSuper ), hSuper, MET_SUPER )
__clsAddMsg( hClass, "__SUPER", hSuper, MET_SUPER )
__clsAddMsg( hClass, Upper( ::cSuper ), hSuper, HB_OO_MSG_SUPER )
__clsAddMsg( hClass, "__SUPER", hSuper, HB_OO_MSG_SUPER )
nDataBegin := __cls_CntData( hSuper ) // Get offset for new DATAs
nClassBegin := __cls_CntClsData( hSuper ) // Get offset for new ClassData
@@ -143,35 +143,35 @@ STATIC FUNCTION Create()
::hClass := hClass
FOR n := 1 TO nLenDatas
__clsAddMsg( hClass, ::aDatas[ n ][ DATA_SYMBOL ], n + nDataBegin, MET_DATA, ;
::aDatas[ n ][ DATA_VALUE ] )
__clsAddMsg( hClass, "_" + ::aDatas[ n ][ DATA_SYMBOL ], n + nDataBegin,;
MET_DATA )
__clsAddMsg( hClass, ::aDatas[ n ][ HB_OO_DATA_SYMBOL ], n + nDataBegin, HB_OO_MSG_DATA, ;
::aDatas[ n ][ HB_OO_DATA_VALUE ] )
__clsAddMsg( hClass, "_" + ::aDatas[ n ][ HB_OO_DATA_SYMBOL ], n + nDataBegin,;
HB_OO_MSG_DATA )
NEXT
nLen := Len( ::aMethods )
FOR n := 1 TO nLen
__clsAddMsg( hClass, ::aMethods[ n ][ 1 ], ::aMethods[ n ][ 2 ], MET_METHOD )
__clsAddMsg( hClass, ::aMethods[ n ][ 1 ], ::aMethods[ n ][ 2 ], HB_OO_MSG_METHOD )
NEXT
nLen := Len( ::aClsDatas )
FOR n := 1 TO nLen
__clsAddMsg( hClass, ::aClsDatas[ n ][ CLASSDATA_SYMBOL ], n + nClassBegin,;
MET_CLASSDATA, ::aClsDatas[ n ][ CLASSDATA_VALUE ] )
__clsAddMsg( hClass, "_" + ::aClsDatas[ n ][ CLASSDATA_SYMBOL ],;
n + nClassBegin, MET_CLASSDATA )
__clsAddMsg( hClass, ::aClsDatas[ n ][ HB_OO_CLSD_SYMBOL ], n + nClassBegin,;
HB_OO_MSG_CLASSDATA, ::aClsDatas[ n ][ HB_OO_CLSD_VALUE ] )
__clsAddMsg( hClass, "_" + ::aClsDatas[ n ][ HB_OO_CLSD_SYMBOL ],;
n + nClassBegin, HB_OO_MSG_CLASSDATA )
NEXT
nLen := Len( ::aInlines )
FOR n := 1 TO nLen
__clsAddMsg( hClass, ::aInlines[ n ][ 1 ], ::aInlines[ n ][ 2 ],;
MET_INLINE )
HB_OO_MSG_INLINE )
NEXT
// __clsAddMsg( hClass, Upper( ::cName ), {| self | self }, MET_INLINE ) // QUESTION: Useful ?
// __clsAddMsg( hClass, Upper( ::cName ), {| self | self }, HB_OO_MSG_INLINE ) // QUESTION: Useful ?
nLen := Len( ::aVirtuals )
FOR n := 1 TO nLen
__clsAddMsg( hClass, ::aVirtuals[ n ], n, MET_VIRTUAL )
__clsAddMsg( hClass, ::aVirtuals[ n ], n, HB_OO_MSG_VIRTUAL )
NEXT
RETURN NIL

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

@@ -6,7 +6,7 @@
* Harbour Project source code:
* Get Class
*
* Copyright 1999 Ignacio Ortiz de Zúniga <ignacio@fivetech.com>
* Copyright 1999 Ignacio Ortiz de Z£niga <ignacio@fivetech.com>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
@@ -72,28 +72,28 @@ CLASS TGet
MESSAGE Delete() METHOD _delete()
METHOD DeleteAll()
METHOD insert(cChar)
METHOD overstrike(cChar)
METHOD insert( cChar )
METHOD overstrike( cChar )
METHOD IsEditable(nPos)
METHOD Input(cChar)
METHOD PutMask(cBuffer, lEdit)
METHOD IsEditable( nPos )
METHOD Input( cChar )
METHOD PutMask( cBuffer, lEdit )
METHOD Display()
// METHOD ColorDisp(cColorSpec) VIRTUAL
// METHOD hitTest(nRow, nCol) VIRTUAL
// METHOD delEnd() VIRTUAL
// METHOD delLeft() VIRTUAL
// METHOD delRight() VIRTUAL
// METHOD delWordLeft() VIRTUAL
// METHOD delWordRight() VIRTUAL
// METHOD ColorDisp( cColorSpec ) VIRTUAL
// METHOD hitTest( nRow, nCol ) VIRTUAL
// METHOD delEnd() VIRTUAL
// METHOD delLeft() VIRTUAL
// METHOD delRight() VIRTUAL
// METHOD delWordLeft() VIRTUAL
// METHOD delWordRight() VIRTUAL
ENDCLASS
//---------------------------------------------------------------------------//
METHOD New(nRow, nCol, bVarBlock, cVarName, cPicture, cColor) CLASS TGet
METHOD New( nRow, nCol, bVarBlock, cVarName, cPicture, cColor ) CLASS TGet
local cChar
local nAt, nFor
@@ -125,27 +125,27 @@ METHOD New(nRow, nCol, bVarBlock, cVarName, cPicture, cColor) CLASS TGet
::rejected := .f.
::row := nRow
::subscript := Nil
::type := Valtype(::VarGet())
::type := Valtype( ::VarGet() )
::typeout := .f.
// Existe function en picture
if Left(cPicture, 1) == "@"
nAt := At(" ", cPicture)
if Left( cPicture, 1 ) == "@"
nAt := At( " ", cPicture )
if nAt == 0
::cPicFunc := cPicture
::cPicMask := ""
else
::cPicFunc := Substr(cPicture, 1, nAt-1)
::cPicMask := Substr(cPicture, nAt+1)
::cPicFunc := SubStr( cPicture, 1, nAt - 1 )
::cPicMask := SubStr( cPicture, nAt + 1 )
endif
if (nAt := At("S", ::cPicFunc)) > 0
for nFor := nAt+1 to len(::cPicFunc)
if !IsDigit(Substr(::cPicFunc, nFor, 1))
if ( nAt := At( "S", ::cPicFunc ) ) > 0
for nFor := nAt + 1 to Len( ::cPicFunc )
if !IsDigit( SubStr( ::cPicFunc, nFor, 1 ) )
exit
endif
next
::cPicFunc := Substr(::cPicFunc,1,nAt-1)+Substr(::cPicFunc, nFor)
::cPicFunc := SubStr( ::cPicFunc, 1, nAt - 1 ) + SubStr( ::cPicFunc, nFor )
if ::cPicFunc == "@"
::cPicFunc := ""
endif
@@ -157,38 +157,38 @@ METHOD New(nRow, nCol, bVarBlock, cVarName, cPicture, cColor) CLASS TGet
// Si es fecha y no tiene plantilla ponersela
if ::type == "D" .and. Empty(::cPicMask)
::cPicMask := Set(_SET_DATEFORMAT)
::cPicMask := StrTran(::cPicmask, "y", "9")
::cPicMask := StrTran(::cPicmask, "m", "9")
::cPicMask := StrTran(::cPicmask, "d", "9")
if ::type == "D" .and. Empty( ::cPicMask )
::cPicMask := Set( _SET_DATEFORMAT )
::cPicMask := StrTran( ::cPicmask, "y", "9" )
::cPicMask := StrTran( ::cPicmask, "m", "9" )
::cPicMask := StrTran( ::cPicmask, "d", "9" )
endif
// Si es numero y no tiene plantilla ponersela
if ::type == "N" .and. Empty(::cPicMask)
if ::type == "N" .and. Empty( ::cPicMask )
::cPicMask := "9999999999"
endif
// Comprobar si tiene la , y el . cambiado (Solo en Xbase++)
::lDecRev := (","$(transform(1.1,"9.9")))
::lDecRev := "," $ transform( 1.1, "9.9" )
// Comprobar si tiene caracteres embebidos no modificables en la plantilla
::lPicComplex := .f.
if !empty(::cPicMask)
For nFor := 1 to len(::cPicMask)
cChar := Substr(::cPicMask, nFor, 1)
if !cChar$"!ANX9#"
if !Empty( ::cPicMask )
For nFor := 1 to Len( ::cPicMask )
cChar := SubStr( ::cPicMask, nFor, 1 )
if !cChar $ "!ANX9#"
::lPicComplex := .t.
exit
endif
Next
endif
::buffer := ::PutMask(::VarGet(), .f. )
::buffer := ::PutMask( ::VarGet(), .f. )
return Self
@@ -196,11 +196,7 @@ return Self
METHOD Display() CLASS TGet
local cClrInverse := __ColorIndex( SetColor(), CLR_ENHANCED )
local nOldCursor := SetCursor( 0 )
@ ::Row, ::Col SAY ::buffer COLOR cClrInverse
SetCursor( nOldCursor )
DispOutAt( ::Row, ::Col, ::buffer, hb_ColorIndex( SetColor(), CLR_ENHANCED ) )
return Self
@@ -208,8 +204,15 @@ return Self
METHOD End() CLASS TGet
local nLastCharPos
if ::HasFocus
::Pos := ::nMaxLen
nLastCharPos := Min( Len( RTrim( ::buffer ) ) + 1, ::nMaxLen )
if ::Pos != nLastCharPos
::Pos := nLastCharPos
else
::Pos := ::nMaxLen
endif
::Clear := .f.
SetPos( ::Row, ::Col + ::Pos - 1 )
endif
@@ -233,7 +236,7 @@ return nil
METHOD Reset() CLASS TGet
if ::hasfocus
::buffer := ::PutMask(::VarGet())
::buffer := ::PutMask( ::VarGet() )
::pos := 1
endif
@@ -244,7 +247,7 @@ return Self
METHOD Undo() CLASS TGet
if ::hasfocus
::buffer := ::PutMask(::original)
::buffer := ::PutMask( ::original )
::pos := 1
endif
@@ -257,28 +260,28 @@ METHOD SetFocus() CLASS TGet
::hasfocus := .t.
::rejected := .f.
::typeout := .f.
::buffer := ::PutMask(::VarGet(), .f. )
::buffer := ::PutMask( ::VarGet(), .f. )
::changed := .f.
::clear := ("K"$::cPicFunc .or. ::type == "N")
::nMaxLen := Len(::buffer)
::clear := ( "K" $ ::cPicFunc .or. ::type == "N")
::nMaxLen := Len( ::buffer )
::pos := 1
::lEdit := .f.
if ::type == "N"
::decpos := At(iif(::lDecRev,",", "."), ::buffer)
::minus := ("-"$::buffer .or. "("$::buffer)
::decpos := At( iif( ::lDecRev, ",", "." ), ::buffer )
::minus := ( "-" $ ::buffer .or. "(" $ ::buffer )
else
::decpos := Nil
::minus := .f.
endif
if ::type == "D"
::BadDate := (At(" ", DToC(CToD(::buffer))) != 0 )
::BadDate := ( At( " ", DToC( CToD( ::buffer ) ) ) != 0 )
else
::BadDate := .f.
endif
DevPos( ::Row, ::Col + ::Pos - 1 )
SetPos( ::Row, ::Col + ::Pos - 1 )
return Self
@@ -297,9 +300,9 @@ return Self
//---------------------------------------------------------------------------//
METHOD VarPut(xValue) CLASS TGet
METHOD VarPut( xValue ) CLASS TGet
Eval(::block, xValue)
Eval( ::block, xValue )
return xValue
@@ -307,11 +310,11 @@ return xValue
METHOD VarGet() CLASS TGet
return Eval(::block)
return Eval( ::block )
//---------------------------------------------------------------------------//
METHOD Untransform(cBuffer) CLASS TGet
METHOD Untransform( cBuffer ) CLASS TGet
local xValue
local cChar
@@ -322,45 +325,45 @@ METHOD Untransform(cBuffer) CLASS TGet
do case
case ::type == "C"
if "R"$::cPicFunc
for nFor := 1 to len(::cPicMask)
cChar := Substr(::cPicMask, nFor, 1)
if !cChar$"ANX9#!"
cBuffer := Substr(cBuffer, 1, nFor-1)+ Chr(1)+ Substr(cBuffer, nFor+1)
if "R" $ ::cPicFunc
for nFor := 1 to Len( ::cPicMask )
cChar := SubStr( ::cPicMask, nFor, 1 )
if !cChar $ "ANX9#!"
cBuffer := SubStr( cBuffer, 1, nFor - 1 ) + Chr( 1 ) + SubStr( cBuffer, nFor + 1 )
endif
next
cBuffer := StrTran(cBuffer, Chr(1), "")
cBuffer := StrTran( cBuffer, Chr( 1 ), "" )
endif
xValue := cBuffer
case ::type = "N"
if "E"$::cPicFunc .or. ::lDecRev
cBuffer := StrTran(cBuffer,".","")
cBuffer := StrTran(cBuffer,",",".")
case ::type == "N"
if "E" $ ::cPicFunc .or. ::lDecRev
cBuffer := StrTran( cBuffer, ".", "" )
cBuffer := StrTran( cBuffer, ",", "." )
else
cBuffer := StrTran(cBuffer,",","")
cBuffer := StrTran( cBuffer, ",", "" )
endif
cBuffer := StrTran(cBuffer,"$","")
cBuffer := StrTran(cBuffer,"*","")
cBuffer := StrTran(cBuffer,"-","")
cBuffer := StrTran(cBuffer,"(","")
cBuffer := StrTran(cBuffer,")","")
cBuffer := Alltrim(cBuffer)
xValue := Val(cBuffer)
cBuffer := StrTran( cBuffer, "$", "" )
cBuffer := StrTran( cBuffer, "*", "" )
cBuffer := StrTran( cBuffer, "-", "" )
cBuffer := StrTran( cBuffer, "(", "" )
cBuffer := StrTran( cBuffer, ")", "" )
cBuffer := Alltrim( cBuffer )
xValue := Val( cBuffer )
if ::minus
xValue := -(xValue)
xValue := -xValue
endif
case ::type = "L"
cBuffer := Upper(cBuffer)
xValue := ("T"$cBuffer .or. "Y"$cBuffer)
case ::type == "L"
cBuffer := Upper( cBuffer )
xValue := "T" $ cBuffer .or. "Y" $ cBuffer
case ::type = "D"
if "E"$::cPicFunc
cBuffer := Substr(cBuffer, 4, 3)+Substr(cBuffer, 1, 3)+Substr(cBuffer, 8)
case ::type == "D"
if "E" $ ::cPicFunc
cBuffer := SubStr( cBuffer, 4, 3 ) + SubStr( cBuffer, 1, 3 ) + SubStr( cBuffer, 8 )
endif
xValue := Ctod(cBuffer)
xValue := CToD( cBuffer )
endcase
@@ -368,7 +371,7 @@ return xValue
//---------------------------------------------------------------------------//
METHOD overstrike(cChar) CLASS TGet
METHOD overstrike( cChar ) CLASS TGet
if ::type == "N" .and. !::lEdit
::pos := 1
@@ -382,10 +385,10 @@ METHOD overstrike(cChar) CLASS TGet
if !::lEdit
::buffer := ::PutMask(::VarGet(), .t. )
::buffer := ::PutMask( ::VarGet(), .t. )
::lEdit := .t.
do while !::IsEditable(::pos) .and. ::pos <= ::nMaxLen
do while !::IsEditable( ::pos ) .and. ::pos <= ::nMaxLen
::pos++
enddo
@@ -395,32 +398,32 @@ METHOD overstrike(cChar) CLASS TGet
endif
cChar := ::Input(cChar)
cChar := ::Input( cChar )
if cChar == ""
::Rejected := .t.
return Self
endif
::buffer := Substr(::buffer, 1, ::Pos-1) + cChar + Substr(::buffer, ::Pos+1)
::buffer := SubStr( ::buffer, 1, ::Pos - 1 ) + cChar + SubStr( ::buffer, ::Pos + 1 )
::Changed := ( ::unTransform() != ::Original )
::Assign()
::Right()
if ::type == "D"
::BadDate := (At(" ", DToC(CToD(::buffer))) != 0 )
::BadDate := ( At(" ", DToC( CToD( ::buffer ) ) ) != 0 )
else
::BadDate := .f.
endif
::Display()
SetPos( ::Row, ::Col + If( ::Pos != nil, ::Pos - 1, 0 ) )
SetPos( ::Row, ::Col + iif( ::Pos != nil, ::Pos - 1, 0 ) )
return Self
//---------------------------------------------------------------------------//
METHOD Insert(cChar) CLASS TGet
METHOD Insert( cChar ) CLASS TGet
if ::type == "N" .and. !::lEdit
::pos := 1
@@ -433,7 +436,7 @@ METHOD Insert(cChar) CLASS TGet
endif
if !::lEdit
::buffer := ::PutMask(::VarGet(), .t. )
::buffer := ::PutMask( ::VarGet(), .t. )
::lEdit := .t.
endif
@@ -444,19 +447,19 @@ METHOD Insert(cChar) CLASS TGet
return Self
endif
::buffer := Left(Substr(::buffer, 1, ::Pos-1) + cChar + Substr(::buffer, ::Pos), ::nMaxLen)
::buffer := Left( SubStr( ::buffer, 1, ::Pos - 1 ) + cChar + SubStr( ::buffer, ::Pos ), ::nMaxLen )
::Changed := ( ::unTransform() != ::Original )
::Assign()
::Right()
if ::type == "D"
::BadDate := (At(" ", DToC(CToD(::buffer))) != 0 )
::BadDate := ( At( " ", DToC( CToD( ::buffer ) ) ) != 0 )
else
::BadDate := .f.
endif
::Display() // Kwon,Oh-Chul
SetPos( ::Row, ::Col + If( ::Pos != nil, ::Pos - 1, 0 ) )
SetPos( ::Row, ::Col + iif( ::Pos != nil, ::Pos - 1, 0 ) )
return Self
@@ -480,7 +483,7 @@ METHOD _Right() CLASS TGet
nPos := ::Pos + 1
Do While !::IsEditable(nPos) .and. nPos <= ::nMaxLen
Do While !::IsEditable( nPos ) .and. nPos <= ::nMaxLen
nPos++
Enddo
@@ -490,7 +493,7 @@ METHOD _Right() CLASS TGet
::TypeOut := .t.
endif
DevPos( ::Row, ::Col + ::Pos - 1 )
SetPos( ::Row, ::Col + ::Pos - 1 )
return Self
@@ -514,7 +517,7 @@ METHOD _Left() CLASS TGet
nPos := ::Pos - 1
Do While !::IsEditable(nPos) .and. nPos > 0
Do While !::IsEditable( nPos ) .and. nPos > 0
nPos--
Enddo
@@ -524,7 +527,7 @@ METHOD _Left() CLASS TGet
::TypeOut := .t.
endif
DevPos( ::Row, ::Col + ::Pos - 1 )
SetPos( ::Row, ::Col + ::Pos - 1 )
return Self
@@ -548,7 +551,7 @@ METHOD WordLeft() CLASS TGet
nPos := ::Pos - 1
Do While Substr(::buffer, nPos, 1) != " " .and. nPos > 0
Do While SubStr( ::buffer, nPos, 1 ) != " " .and. nPos > 0
nPos--
Enddo
@@ -578,7 +581,7 @@ METHOD WordRight() CLASS TGet
nPos := ::Pos + 1
Do While Substr(::buffer, nPos, 1) != " " .and. nPos <= ::nMaxLen
Do While SubStr( ::buffer, nPos, 1 ) != " " .and. nPos <= ::nMaxLen
nPos++
Enddo
@@ -597,18 +600,18 @@ return Self
endif
::Clear := .f.
::buffer := ::PutMask(::UnTransform(), .t. )
::pos := ::decpos+1
::buffer := ::PutMask( ::UnTransform(), .t. )
::pos := ::decpos + 1
return .t.
//---------------------------------------------------------------------------//
METHOD IsEditable(nPos) CLASS TGet
METHOD IsEditable( nPos ) CLASS TGet
local cChar
if empty(::cPicMask)
if Empty( ::cPicMask )
return .t.
endif
@@ -616,24 +619,24 @@ METHOD IsEditable(nPos) CLASS TGet
return .f.
endif
cChar := Substr(::cPicMask, nPos, 1)
cChar := SubStr( ::cPicMask, nPos, 1 )
do case
case ::type == "C"
return (cChar$"!ANX9#")
return cChar $ "!ANX9#"
case ::type == "N"
return (cChar$"9#$*")
return cChar $ "9#$*"
case ::type == "D"
return (cChar == "9")
return cChar == "9"
case ::type == "L"
return (cChar$"TFYN")
return cChar $ "TFYN"
endcase
return .f.
//---------------------------------------------------------------------------//
METHOD Input(cChar) CLASS TGet
METHOD Input( cChar ) CLASS TGet
do case
case ::type == "N"
@@ -646,35 +649,35 @@ METHOD Input(cChar) CLASS TGet
case cChar == "."
::toDecPos()
return ""
case !(cChar$"0123456789")
case !( cChar $ "0123456789" )
return ""
endcase
case ::type == "D"
if !(cChar$"0123456789")
if !( cChar $ "0123456789" )
return ""
endif
case ::type == "L"
if !(Upper(cChar)$"YNTF")
if !( Upper( cChar ) $ "YNTF" )
return ""
endif
endcase
if !Empty(::cPicFunc)
cChar := Transform(cChar, ::cPicFunc)
if !Empty( ::cPicFunc )
cChar := Transform( cChar, ::cPicFunc )
endif
if !Empty(::cPicMask)
cChar := Transform(cChar, Substr(::cPicMask, ::pos, 1))
if !Empty( ::cPicMask )
cChar := Transform( cChar, SubStr( ::cPicMask, ::pos, 1 ) )
endif
return cChar
//---------------------------------------------------------------------------//
METHOD PutMask(xValue, lEdit) CLASS TGet
METHOD PutMask( xValue, lEdit ) CLASS TGet
local cChar, cBuffer
local nFor, nLen, nAt
@@ -682,23 +685,23 @@ METHOD PutMask(xValue, lEdit) CLASS TGet
DEFAULT xValue TO ::VarGet()
DEFAULT lEdit TO ::hasfocus
cBuffer := Transform(xValue, Alltrim(::cPicFunc+" "+::cPicMask))
cBuffer := Transform( xValue, Alltrim( ::cPicFunc + " " + ::cPicMask ) )
if lEdit .and. ::type == "N" .and. !Empty(::cPicMask)
nLen := len(cBuffer)
if lEdit .and. ::type == "N" .and. !Empty( ::cPicMask )
nLen := Len( cBuffer )
for nFor := 1 to nLen
cChar := Substr(::cPicMask, nFor, 1)
if cChar$",." .and. Substr(cBuffer, nFor, 1) != cChar
cBuffer := Substr(cBuffer, 1, nFor-1) + cChar + Substr(cBuffer, nFor+1)
cChar := SubStr( ::cPicMask, nFor, 1 )
if cChar $ ",." .and. SubStr( cBuffer, nFor, 1 ) != cChar
cBuffer := SubStr( cBuffer, 1, nFor - 1 ) + cChar + SubStr( cBuffer, nFor + 1 )
endif
next
if (nAt := At(" ", cBuffer)) > 0
cBuffer := Strtran(cBuffer, "0", " ", nAt)
if ( nAt := At( " ", cBuffer ) ) > 0
cBuffer := StrTran( cBuffer, "0", " ", nAt )
endif
if ::lDecRev
cBuffer := Strtran(cBuffer, ",", Chr(1))
cBuffer := Strtran(cBuffer, ".", ",")
cBuffer := Strtran(cBuffer, Chr(1), ".")
cBuffer := StrTran( cBuffer, ",", Chr( 1 ) )
cBuffer := StrTran( cBuffer, ".", "," )
cBuffer := StrTran( cBuffer, Chr( 1 ), "." )
endif
endif
@@ -725,23 +728,23 @@ METHOD _Delete() CLASS TGet
do case
case ::type == "C"
if !::lPicComplex
::buffer := Padr(Substr(::buffer, 1, ::Pos-1) + ;
Substr(::buffer, ::Pos+1), ::nMaxLen)
::buffer := Padr( SubStr( ::buffer, 1, ::Pos - 1 ) + ;
SubStr( ::buffer, ::Pos + 1 ), ::nMaxLen )
else
::buffer := Substr(::buffer, 1, ::Pos-1) +" "+ ;
Substr(::buffer, ::Pos+1)
::buffer := SubStr( ::buffer, 1, ::Pos - 1 ) + " " + ;
SubStr( ::buffer, ::Pos + 1 )
endif
case ::type == "N"
if Substr(::buffer, ::Pos, 1) == "-"
if SubStr( ::buffer, ::Pos, 1 ) == "-"
::minus := .f.
endif
::buffer := Substr(::buffer, 1, ::Pos-1) +" "+ ;
Substr(::buffer, ::Pos+1)
::buffer := SubStr( ::buffer, 1, ::Pos - 1 ) + " " + ;
SubStr( ::buffer, ::Pos + 1 )
case ::type == "D"
::buffer := Substr(::buffer, 1, ::Pos-1) +" "+ ;
Substr(::buffer, ::Pos+1)
::buffer := SubStr( ::buffer, 1, ::Pos - 1 ) + " " + ;
SubStr( ::buffer, ::Pos + 1 )
case ::type == "L"
::buffer := " "
@@ -750,7 +753,7 @@ METHOD _Delete() CLASS TGet
::Assign()
::Display()
SetPos( ::Row, ::Col + If( ::Pos != nil, ::Pos - 1, 0 ) )
SetPos( ::Row, ::Col + iif( ::Pos != nil, ::Pos - 1, 0 ) )
return Self
@@ -762,16 +765,16 @@ METHOD DeleteAll() CLASS TGet
do case
case ::type == "C"
xValue := Space(::nMaxlen)
xValue := Space( ::nMaxlen )
case ::type == "N"
xValue := 0
case ::type == "D"
xValue := Dtoc("")
xValue := DToC( "" )
case ::type == "L"
xValue := .f.
endcase
::buffer := ::PutMask(xValue,.t.)
::buffer := ::PutMask( xValue, .t. )
::Pos := 1
::Assign()

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

@@ -476,12 +476,10 @@ METHOD ShowScoreboard() CLASS TGetList
local nRow, nCol, nOldCursor
if Set( _SET_SCOREBOARD )
nOldCursor = SetCursor( 0 )
nRow = Row()
nCol = Col()
DispOutAt( SCORE_ROW, SCORE_COL, If( Set( _SET_INSERT ), "Ins", " " ) )
SetPos( nRow, nCol )
SetCursor( nOldCursor )
endif
return nil

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

@@ -160,7 +160,7 @@ void hb_tone( double dFrequency, double dDuration )
#if defined(HARBOUR_GCC_OS2) || defined(OS2) || defined(WINNT) || defined(_Windows) || defined(__MINGW32__)
dFrequency = HB_MIN_( HB_MAX_( 0.0, dFrequency ), 32767.0 );
dDuration = dDuration * 1000.0 / 18.2; /* milliseconds */
#elif defined(__DJGPP) || defined(__BORLANDC__)
#elif defined(__DJGPP__) || defined(__BORLANDC__)
dFrequency = HB_MIN_( HB_MAX_( 0.0, dFrequency ), 32767.0 );
dDuration = dDuration * CLOCKS_PER_SEC / 18.2 ; /* clocks */
#endif

3
harbour/source/runner/stdalone/external.prg
View File

@@ -168,7 +168,7 @@ EXTERNAL SETBLINK
EXTERNAL SETMODE
EXTERNAL __ACCEPT
EXTERNAL __ACCEPTSTR
EXTERNAL __COLORINDEX
EXTERNAL HB_COLORINDEX
//
//symbols from file: rtl\copyfile.c
//
@@ -180,6 +180,7 @@ EXTERNAL CTOD
EXTERNAL DTOC
EXTERNAL DTOS
EXTERNAL STOD
EXTERNAL HB_STOD
EXTERNAL DAY
EXTERNAL MONTH
EXTERNAL YEAR

2
harbour/source/tools/Makefile
View File

@@ -15,6 +15,8 @@ C_SOURCES=\
chrfirst.c \
chrtotal.c \
ctchksum.c \
ctchrmix.c \
ctcrypt.c \
dates2.c \
datesx.c \
hb_f.c \

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

@@ -60,7 +60,7 @@ HARBOUR HB_GT_CHAREVEN( void )
for (i = 1; i <= len; i += 2)
s2[(i - 1)/2] = s1[i] & 0x7f;
hb_retc(s2);
hb_retclen(s2, len);
hb_xfree(s2); /* free alloc'ed mem */
} else {
hb_retc((char *) NULL); /* parameter mismatch - error NullStr */

16
harbour/source/tools/charmix.c
View File

@@ -53,30 +53,30 @@
HARBOUR HB_GT_CHARMIX( void )
{
char *s1, *s2, *s3;
int l1, l2, i, pos;
int l1, l2, i, pos3;
if (ISCHAR(1) && ISCHAR(2)) {
s1 = hb_parc(1);
s2 = hb_parc(2);
l1 = hb_parclen(1);
l2 = hb_parclen(2);
pos = 0;
pos3 = 0;
s3 = (char*)hb_xgrab(l1 + l2); /* grab us some mem to work with */
s3 = (char*)hb_xgrab(l1 + l2 + 1); /* grab us some mem to work with */
for (i = 0; i < l1; i++) {
s3[pos++] = s1[i];
s3[pos3++] = s1[i];
if (i < l2)
s3[pos++] = s2[i];
s3[pos3++] = s2[i];
}
if (l2 > l1)
for (; i < l2; i++)
s3[pos++] = s2[i];
s3[pos3++] = s2[i];
s3[pos] = '\0';
hb_retc(s3);
s3[pos3] = '\0';
hb_retclen(s3, l1 + l2);
hb_xfree(s3); /* free alloc'ed mem */
} else {
hb_retc((char *) NULL); /* parameter mismatch - error NullStr */

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

@@ -60,7 +60,7 @@ HARBOUR HB_GT_CHARODD( void )
for (i = 0; i <= len; i += 2)
s2[i/2] = s1[i] & 0x7f;
hb_retc(s2);
hb_retclen(s2, len);
hb_xfree(s2); /* free alloc'ed mem */
} else {
hb_retc((char *) NULL); /* parameter mismatch - error NullStr */

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

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* CHECKSUM() CA-Tools function
* CT_CHECKSUM() CA-Tools function
*
* Copyright 1999 Victor Szel <info@szelvesz.hu>
* www - http://www.harbour-project.org

71
harbour/source/tools/ctchrmix.c Normal file
View File

@@ -0,0 +1,71 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* CT_CHARMIX() CA-Tools compatible function
*
* Copyright 1999 Victor Szel <info@szelvesz.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 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) 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 HRL
* and/or HVM code into it.
*
* 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 program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
#include "extend.h"
#include "itemapi.h"
/* NOTE: CA-Tools will hang if the second parameter is an empty string */
HARBOUR HB_CT_CHARMIX( void )
{
PHB_ITEM pStr1 = hb_param( 1, IT_STRING );
PHB_ITEM pStr2 = hb_param( 2, IT_STRING );
ULONG ulLen2;
if( pStr1 && pStr2 && ( ulLen2 = hb_itemGetCLen( pStr2 ) ) > 0 )
{
ULONG ulLen1 = hb_itemGetCLen( pStr1 );
char * pszStr1 = hb_itemGetCPtr( pStr1 );
char * pszStr2 = hb_itemGetCPtr( pStr2 );
char * pszResult = ( char * ) hb_xgrab( 2 * ulLen1 );
ULONG ulPos1 = 0;
ULONG ulPos2 = 0;
ULONG ulPosResult = 0;
while( ulPos1 < ulLen1 )
{
pszResult[ ulPosResult++ ] = pszStr1[ ulPos1++ ];
pszResult[ ulPosResult++ ] = pszStr2[ ulPos2++ ];
if( ulPos2 == ulLen2 )
ulPos2 = 0;
}
hb_retclen( pszResult, 2 * ulLen1 );
hb_xfree( pszResult );
}
else
hb_retc( "" );
}

110
harbour/source/tools/ctcrypt.c Normal file
View File

@@ -0,0 +1,110 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* CT_CRYPT() CA-Tools compatible function
*
* Copyright 1999 Victor Szel <info@szelvesz.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 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) 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 HRL
* and/or HVM code into it.
*
* 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 program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
#include "extend.h"
HARBOUR HB_CT_CRYPT( void )
{
ULONG ulCryptLen = hb_parclen( 2 );
if( ulCryptLen >= 2 )
{
BYTE * pbyCrypt = hb_parc( 2 );
ULONG ulCryptPos = 0;
BYTE * pbyString = hb_parc( 1 );
ULONG ulStringLen = hb_parclen( 1 );
ULONG ulStringPos;
BYTE * pbyResult = hb_xgrab( ulStringLen + 1 );
USHORT uiCount2 = ( ( ( USHORT ) ( pbyCrypt[ ulCryptPos ] + ( USHORT ) ( pbyCrypt[ ulCryptPos + 1 ] * 256 ) ) ) & 0xFFFF ) ^ ( ( USHORT ) ulCryptLen & 0xFFFF );
USHORT uiCount1 = 0xAAAA;
for( ulStringPos = 0; ulStringPos < ulStringLen; )
{
USHORT uiTmpCount1 = uiCount1;
USHORT uiTmpCount2 = uiCount2;
BYTE byte = pbyString[ ulStringPos ] ^ pbyCrypt[ ulCryptPos++ ];
USHORT tmp;
uiTmpCount2 = HB_MKUSHORT( ( HB_LOBYTE( uiTmpCount2 ) ^ HB_HIBYTE( uiTmpCount2 ) ), HB_HIBYTE( uiTmpCount2 ) );
for( tmp = HB_LOBYTE( uiTmpCount2 ); tmp; tmp-- )
uiTmpCount2 = ( uiTmpCount2 >> 1 ) | ( ( uiTmpCount2 & 1 ) << 15 );
uiTmpCount2 ^= uiTmpCount1;
uiTmpCount2 += 16;
uiCount2 = uiTmpCount2;
uiTmpCount2 &= 0x1E;
uiTmpCount2 += 2;
do
{
BYTE byTmp;
uiTmpCount2--;
for( tmp = HB_LOBYTE( uiTmpCount2 ); tmp; tmp-- )
uiTmpCount1 = ( uiTmpCount1 >> 1 ) | ( ( uiTmpCount1 & 1 ) << 15 );
uiTmpCount1 = HB_MKUSHORT( HB_HIBYTE( uiTmpCount1 ), HB_LOBYTE( uiTmpCount1 ) );
uiTmpCount1 = HB_MKUSHORT( ( HB_LOBYTE( uiTmpCount1 ) ^ 0xFF ), HB_HIBYTE( uiTmpCount1 ) );
uiTmpCount1 = ( uiTmpCount1 << 1 ) | ( ( uiTmpCount1 & 0x8000 ) >> 15 );
uiTmpCount1 ^= 0xAAAA;
byTmp = HB_LOBYTE( uiTmpCount1 );
byTmp = ( byTmp << 1 ) | ( ( byTmp & 0x80 ) >> 7 );
uiTmpCount1 = HB_MKUSHORT( byTmp, HB_HIBYTE( uiTmpCount1 ) );
} while ( --uiTmpCount2 );
uiCount1 = uiTmpCount1;
pbyResult[ ulStringPos++ ] = byte ^ HB_LOBYTE( uiTmpCount1 );
if( ulCryptPos == ulCryptLen )
ulCryptPos = 0;
}
hb_retclen( pbyResult, ulStringLen );
hb_xfree( pbyResult );
}
else
hb_retc( "" );
}

4
harbour/source/tools/stringp.prg
View File

@@ -127,8 +127,8 @@ function ToChar( xTxt, cSeparator, lDebug )
aData := __objGetValueList( xTxt )
nLen := Len( aData )
for n := 1 to nLen // For each item : Recurse !
cOut += aData[n][DATA_SYMBOL] + ":" + ;
ToChar( aData[n][DATA_VALUE], cSeparator, lDebug )
cOut += aData[n][HB_OO_DATA_SYMBOL] + ":" + ;
ToChar( aData[n][HB_OO_DATA_VALUE], cSeparator, lDebug )
if n != nLen
cOut += cSeparator
endif

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

@@ -64,6 +64,7 @@
#include "pcode.h"
#include "set.h"
#include "inkey.h"
#include "hbmemory.ch"
typedef struct _SYMBOLS
{
@@ -264,7 +265,7 @@ void hb_vmInit( void )
hb_outerr( pszVersion, 0 );
hb_outerr( hb_consoleGetNewLine(), 0 );
sprintf( buffer, "DS avail=%luKB OS avail=%luKB EMM avail=%luKB", hb_xquery( 1 ), hb_xquery( 3 ), hb_xquery( 4 ) );
sprintf( buffer, "DS avail=%luKB OS avail=%luKB EMM avail=%luKB", hb_xquery( HB_MEM_BLOCK ), hb_xquery( HB_MEM_VM ), hb_xquery( HB_MEM_EMS ) );
hb_outerr( buffer, 0 );
hb_outerr( hb_consoleGetNewLine(), 0 );
@@ -1780,27 +1781,37 @@ static void hb_vmInstring( void )
static void hb_vmForTest( void ) /* Test to check the end point of the FOR */
{
if( IS_NUMERIC( hb_stack.pPos - 1 ) )
int iDec;
double dStep;
BOOL bEqual;
while( ! IS_NUMERIC( hb_stack.pPos - 1 ) )
{
int iDec;
double dStep;
BOOL bEqual;
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1073, NULL, "<" );
dStep = hb_vmPopDouble( &iDec );
/* NOTE: step of zero will cause endless loop, as in Clipper */
if( dStep > 0 ) /* Positive loop. Use LESS */
hb_vmLess();
else if( dStep < 0 ) /* Negative loop. Use GREATER */
hb_vmGreater();
bEqual = hb_vmPopLogical(); /* Logical should be on top of stack */
hb_vmPushNumber( dStep, iDec ); /* Push the step expression back on the stack */
hb_vmPushLogical( bEqual );
if( pResult )
{
hb_stackPop();
hb_vmPush( pResult );
hb_itemRelease( pResult );
}
else
/* NOTE: Return from the inside. */
return;
}
else
hb_errRT_BASE( EG_ARG, 1073, NULL, "<" );
dStep = hb_vmPopDouble( &iDec );
/* NOTE: step of zero will cause endless loop, as in Clipper */
if( dStep > 0 ) /* Positive loop. Use LESS */
hb_vmLess();
else if( dStep < 0 ) /* Negative loop. Use GREATER */
hb_vmGreater();
bEqual = hb_vmPopLogical(); /* Logical should be on top of stack */
hb_vmPushNumber( dStep, iDec ); /* Push the step expression back on the stack */
hb_vmPushLogical( bEqual );
}
/* ------------------------------- */
@@ -3421,7 +3432,7 @@ HARBOUR HB_PROCLINE( void )
hb_retni( 0 );
}
/* NOTE: Clipper undocumented function, which always returns an empty
/* NOTE: Clipper undocumented function, which always returns an empty
string. */
HARBOUR HB_PROCFILE( void )

1
harbour/tests/begin.prg
View File

@@ -5,6 +5,7 @@
// and BREAK statement
//
MEMVAR oMemvar
MEMVAR mPrivate
PROCEDURE MAIN
LOCAL oLocal

2
harbour/tests/dynobj.prg
View File

@@ -15,8 +15,6 @@
// Placed in the public domain
//
#include "hboo.ch"
function Main()
local oForm := TForm():New()

12
harbour/tests/inherit.prg
View File

@@ -215,7 +215,7 @@ function Read()
if ::hFile == -1
QOut( "DosFile:Read : No file open" )
elseif ::cMode != "R"
QOut( "File ", cFileName, " not open for reading" )
QOut( "File ", ::cFileName, " not open for reading" )
elseif !::lEoF
if Len(::cBlock) == 0 // Read new block
@@ -268,7 +268,7 @@ function WriteLn( xTxt, lCRLF )
if ::hFile == -1
QOut( "DosFile:Write : No file open" )
elseif ::cMode != 'W'
QOut( "File ",cFileName," not opened for writing" )
QOut( "File ", ::cFileName," not opened for writing" )
else
cBlock := ToChar( xTxt ) // Convert to string
if Default( lCRLF, .T. )
@@ -301,7 +301,7 @@ static function Goto( nLine )
if Empty(::hFile)
QOut( "DosFile:Goto : No file open" )
elseif ::cMode != "R"
QOut( "File ", cName, " not open for reading" )
QOut( "File ", ::cFileName, " not open for reading" )
else
::lEoF := .F. // Clear (old) End of file
::nLine := 0 // Start at beginning
@@ -312,8 +312,4 @@ static function Goto( nLine )
::Read()
enddo
endif
return !lEoF
return !::lEoF

10
harbour/tests/objects.prg
View File

@@ -32,11 +32,11 @@ function TAny() /* builds a class */
if hClass == nil
hClass = __clsNew( "TANY", 3 ) // cClassName, nDatas
__clsAddMsg( hClass, "cName", 1, MET_DATA ) // retrieve data
__clsAddMsg( hClass, "_cName", 1, MET_DATA ) // assign data. Note the '_'
__clsAddMsg( hClass, "New", @New(), MET_METHOD )
__clsAddMsg( hClass, "Test", @Test(), MET_METHOD )
__clsAddMsg( hClass, "DoNothing", 0, MET_VIRTUAL )
__clsAddMsg( hClass, "cName", 1, HB_OO_MSG_DATA ) // retrieve data
__clsAddMsg( hClass, "_cName", 1, HB_OO_MSG_DATA ) // assign data. Note the '_'
__clsAddMsg( hClass, "New", @New(), HB_OO_MSG_METHOD )
__clsAddMsg( hClass, "Test", @Test(), HB_OO_MSG_METHOD )
__clsAddMsg( hClass, "DoNothing", 0, HB_OO_MSG_VIRTUAL )
endif
/* warning: we are not defining datas names and methods yet */

2
harbour/tests/overload.prg
View File

@@ -2,8 +2,6 @@
// $Id$
//
#include "hboo.ch"
//
// DynObj
//

332
harbour/tests/rtl_test.prg
View File

@@ -703,6 +703,16 @@ STATIC FUNCTION Main_HVM()
TEST_LINE( scString $ 1 , "E BASE 1109 Argument error $ F:S" )
TEST_LINE( 1 $ "AA" , "E BASE 1109 Argument error $ F:S" )
TEST_LINE( ! scStringE $ "XE" , .T. )
TEST_LINE( ! ( scStringE $ "XE" ) , .T. )
TEST_LINE( scStringE $ "XE" , .F. )
TEST_LINE( ! "X" $ "XE" , .F. )
TEST_LINE( ! ( "X" $ "XE" ) , .F. )
TEST_LINE( "X" $ "XE" , .T. )
TEST_LINE( scStringE $ "bcde" , .F. )
TEST_LINE( ( "" ) $ "bcde" , .F. )
TEST_LINE( "" $ "bcde" , .F. ) /* Bug in CA-Cl*ppers compiler optimalizer, it will return .T. */
TEST_LINE( "d" $ "bcde" , .T. )
TEST_LINE( "D" $ "BCDE" , .T. )
TEST_LINE( "a" $ "bcde" , .F. )
@@ -875,6 +885,7 @@ STATIC FUNCTION Main_HVM()
TEST_LINE( Len( 123 ) , "E BASE 1111 Argument error LEN F:S" )
TEST_LINE( Len( "" ) , 0 )
TEST_LINE( Len( "123" ) , 3 )
TEST_LINE( Len( "123"+Chr(0)+"456 " ) , 8 )
TEST_LINE( Len( saArray ) , 1 )
#ifdef __HARBOUR__
TEST_LINE( Len( Space( 3000000000 ) ) , 3000000000 )
@@ -930,7 +941,7 @@ STATIC FUNCTION Main_MATH()
TEST_LINE( Log("A") , "E BASE 1095 Argument error LOG F:S" )
TEST_LINE( Str(Log(-1)) , "***********************" )
TEST_LINE( Str(Log(0)) , "***********************" )
// TEST_LINE( Str(Log(0)) , "***********************" )
TEST_LINE( Str(Log(1)) , " 0.00" )
TEST_LINE( Str(Log(12)) , " 2.48" )
TEST_LINE( Str(Log(snIntP)) , " 2.30" )
@@ -1214,6 +1225,11 @@ STATIC FUNCTION Main_MATH()
STATIC FUNCTION Main_STRINGS()
LOCAL xLocal
/* VAL() */
TEST_LINE( Val( NIL ) , "E BASE 1098 Argument error VAL F:S" )
TEST_LINE( Val( 10 ) , "E BASE 1098 Argument error VAL F:S" )
/* CHR() */
TEST_LINE( Chr( NIL ) , "E BASE 1104 Argument error CHR F:S" )
@@ -1257,25 +1273,16 @@ STATIC FUNCTION Main_STRINGS()
TEST_LINE( Asc( @scString ) , 72 ) /* Bug in CA-Cl*pper, it returns: "E BASE 1107 Argument error ASC F:S" */
#endif
/* ALLTRIM() */
/* These lines will cause CA-Cl*pper 5.2e to trash memory and later crash, it was fixed in 5.3 */
#ifdef __HARBOUR__
TEST_LINE( AllTrim( NIL ) , "" ) /* CA-Cl*pper 5.2e/5.3 is not giving the same result for this one. */
TEST_LINE( AllTrim( 100 ) , "" ) /* CA-Cl*pper 5.2e/5.3 is not giving the same result for this one. */
#endif
TEST_LINE( AllTrim("HELLO") , "HELLO" )
#ifdef __HARBOUR__
TEST_LINE( AllTrim(@scString) , "HELLO" ) /* CA-Cl*pper bug, it will terminate the program on this line. */
#endif
/* ISDIGIT() */
TEST_LINE( IsDigit() , .F. )
TEST_LINE( IsDigit( 100 ) , .F. )
TEST_LINE( IsDigit( @scString ) , .F. )
#ifdef __HARBOUR__
TEST_LINE( IsDigit( @scString ) , .F. ) /* Bug in CA-Cl*pper, it will always return .F. */
#endif
TEST_LINE( IsDigit( "" ) , .F. )
TEST_LINE( IsDigit( "A" ) , .F. )
TEST_LINE( IsDigit( "AA" ) , .F. )
TEST_LINE( IsDigit( "-" ) , .F. )
TEST_LINE( IsDigit( "." ) , .F. )
TEST_LINE( IsDigit( "0" ) , .T. )
@@ -1290,10 +1297,11 @@ STATIC FUNCTION Main_STRINGS()
TEST_LINE( IsAlpha() , .F. )
TEST_LINE( IsAlpha( 100 ) , .F. )
#ifdef __HARBOUR__
TEST_LINE( IsAlpha( @scString ) , .T. ) /* Bug in CA-Cl*pper, it will return .F. */
TEST_LINE( IsAlpha( @scString ) , .T. ) /* Bug in CA-Cl*pper, it will always return .F. */
#endif
TEST_LINE( IsAlpha( "" ) , .F. )
TEST_LINE( IsAlpha( "A" ) , .T. )
TEST_LINE( IsAlpha( "AA" ) , .T. )
TEST_LINE( IsAlpha( "-" ) , .F. )
TEST_LINE( IsAlpha( "." ) , .F. )
TEST_LINE( IsAlpha( "0" ) , .F. )
@@ -1319,11 +1327,12 @@ STATIC FUNCTION Main_STRINGS()
TEST_LINE( IsUpper() , .F. )
TEST_LINE( IsUpper( 100 ) , .F. )
#ifdef __HARBOUR__
TEST_LINE( IsUpper( @scString ) , .T. ) /* Bug in CA-Cl*pper, it will return .F. */
TEST_LINE( IsUpper( @scString ) , .T. ) /* Bug in CA-Cl*pper, it will always return .F. */
#endif
TEST_LINE( IsUpper( "" ) , .F. )
TEST_LINE( IsUpper( "6" ) , .F. )
TEST_LINE( IsUpper( "A" ) , .T. )
TEST_LINE( IsUpper( "AA" ) , .T. )
TEST_LINE( IsUpper( "a" ) , .F. )
TEST_LINE( IsUpper( "K" ) , .T. )
TEST_LINE( IsUpper( "Z" ) , .T. )
@@ -1335,10 +1344,13 @@ STATIC FUNCTION Main_STRINGS()
TEST_LINE( IsLower() , .F. )
TEST_LINE( IsLower( 100 ) , .F. )
TEST_LINE( IsLower( @scString ) , .F. )
#ifdef __HARBOUR__
TEST_LINE( IsLower( @scString ) , .F. ) /* Bug in CA-Cl*pper, it will always return .F. */
#endif
TEST_LINE( IsLower( "" ) , .F. )
TEST_LINE( IsLower( "6" ) , .F. )
TEST_LINE( IsLower( "A" ) , .F. )
TEST_LINE( IsLower( "AA" ) , .F. )
TEST_LINE( IsLower( "a" ) , .T. )
TEST_LINE( IsLower( "K" ) , .F. )
TEST_LINE( IsLower( "Z" ) , .F. )
@@ -1346,19 +1358,164 @@ STATIC FUNCTION Main_STRINGS()
TEST_LINE( IsLower( "™" ) , .F. )
TEST_LINE( IsLower( "”" ) , .F. )
/* TODO: Add these: */
/* ALLTRIM() */
/* These lines will cause CA-Cl*pper 5.2e to trash memory and later crash, it was fixed in 5.3 */
#ifndef __CLIPPER__
TEST_LINE( AllTrim( NIL ) , "E BASE 2022 Argument error ALLTRIM F:S" ) /* CA-Cl*pper 5.2e/5.3 is not giving the same result for this one. */
TEST_LINE( AllTrim( 100 ) , "E BASE 2022 Argument error ALLTRIM F:S" ) /* CA-Cl*pper 5.2e/5.3 is not giving the same result for this one. */
#endif
#ifdef __HARBOUR__
TEST_LINE( AllTrim(@scString) , "HELLO" ) /* CA-Cl*pper bug, it will terminate the program on this line. */
#endif
TEST_LINE( AllTrim(scString) , "HELLO" )
TEST_LINE( AllTrim("HELLO") , "HELLO" )
TEST_LINE( AllTrim( "" ) , "" )
TEST_LINE( AllTrim( "UA " ) , "UA" )
TEST_LINE( AllTrim( " UA" ) , "UA" )
TEST_LINE( AllTrim( " UA " ) , "UA" )
TEST_LINE( AllTrim( " "+Chr(0)+" UA " ) , ""+Chr(0)+" UA" )
TEST_LINE( AllTrim( " "+Chr(9)+" UA " ) , "UA" )
TEST_LINE( AllTrim( " "+Chr(9)+"U"+Chr(9)) , "U"+Chr(9)+"" )
TEST_LINE( AllTrim( " "+Chr(9)+Chr(9)) , "" )
TEST_LINE( AllTrim( Chr(10)+"U"+Chr(10)) , "U"+Chr(10)+"" )
TEST_LINE( AllTrim( Chr(13)+"U"+Chr(13)) , "U"+Chr(13)+"" )
TEST_LINE( AllTrim( "A"+Chr(10)) , "A"+Chr(10)+"" )
TEST_LINE( AllTrim( "A"+Chr(13)) , "A"+Chr(13)+"" )
TEST_LINE( AllTrim( " "+Chr(0)+"ABC"+Chr(0)+" "), ""+Chr(0)+"ABC"+Chr(0)+"" )
/* TRIM() */
TEST_LINE( Trim( 100 ) , "E BASE 1100 Argument error TRIM F:S" )
TEST_LINE( Trim( NIL ) , "E BASE 1100 Argument error TRIM F:S" )
#ifdef __HARBOUR__
TEST_LINE( Trim(@scString) , "HELLO" ) /* CA-Cl*pper bug, it will throw an error here. */
#endif
TEST_LINE( Trim(scString) , "HELLO" )
TEST_LINE( Trim("HELLO") , "HELLO" )
TEST_LINE( Trim( "" ) , "" )
TEST_LINE( Trim( "UA " ) , "UA" )
TEST_LINE( Trim( " UA" ) , " UA" )
TEST_LINE( Trim( " UA " ) , " UA" )
TEST_LINE( Trim( " "+Chr(0)+" UA " ) , " "+Chr(0)+" UA" )
TEST_LINE( Trim( " "+Chr(9)+" UA " ) , " "+Chr(9)+" UA" )
TEST_LINE( Trim( " "+Chr(9)+"U"+Chr(9)) , " "+Chr(9)+"U"+Chr(9)+"" )
TEST_LINE( Trim( " "+Chr(9)+Chr(9)) , " "+Chr(9)+""+Chr(9)+"" )
TEST_LINE( Trim( Chr(10)+"U"+Chr(10)) , ""+Chr(10)+"U"+Chr(10)+"" )
TEST_LINE( Trim( Chr(13)+"U"+Chr(13)) , ""+Chr(13)+"U"+Chr(13)+"" )
TEST_LINE( Trim( "A"+Chr(10)) , "A"+Chr(10)+"" )
TEST_LINE( Trim( "A"+Chr(13)) , "A"+Chr(13)+"" )
TEST_LINE( Trim( " "+Chr(0)+"ABC"+Chr(0)+" "), " "+Chr(0)+"ABC"+Chr(0)+"" )
/* RTRIM() */
TEST_LINE( RTrim( 100 ) , "E BASE 1100 Argument error TRIM F:S" )
TEST_LINE( RTrim( NIL ) , "E BASE 1100 Argument error TRIM F:S" )
#ifdef __HARBOUR__
TEST_LINE( RTrim(@scString) , "HELLO" ) /* CA-Cl*pper bug, it will throw an error here. */
#endif
TEST_LINE( RTrim(scString) , "HELLO" )
TEST_LINE( RTrim("HELLO") , "HELLO" )
TEST_LINE( RTrim( "" ) , "" )
TEST_LINE( RTrim( "UA " ) , "UA" )
TEST_LINE( RTrim( " UA" ) , " UA" )
TEST_LINE( RTrim( " UA " ) , " UA" )
TEST_LINE( RTrim( " "+Chr(0)+" UA " ) , " "+Chr(0)+" UA" )
TEST_LINE( RTrim( " "+Chr(9)+" UA " ) , " "+Chr(9)+" UA" )
TEST_LINE( RTrim( " "+Chr(9)+"U"+Chr(9)) , " "+Chr(9)+"U"+Chr(9)+"" )
TEST_LINE( RTrim( " "+Chr(9)+Chr(9)) , " "+Chr(9)+""+Chr(9)+"" )
TEST_LINE( RTrim( Chr(10)+"U"+Chr(10)) , ""+Chr(10)+"U"+Chr(10)+"" )
TEST_LINE( RTrim( Chr(13)+"U"+Chr(13)) , ""+Chr(13)+"U"+Chr(13)+"" )
TEST_LINE( RTrim( "A"+Chr(10)) , "A"+Chr(10)+"" )
TEST_LINE( RTrim( "A"+Chr(13)) , "A"+Chr(13)+"" )
TEST_LINE( RTrim( " "+Chr(0)+"ABC"+Chr(0)+" "), " "+Chr(0)+"ABC"+Chr(0)+"" )
/* LTRIM() */
/* UPPER() */
/* LOWER() */
TEST_LINE( LTrim( 100 ) , "E BASE 1101 Argument error LTRIM F:S" )
TEST_LINE( LTrim( NIL ) , "E BASE 1101 Argument error LTRIM F:S" )
#ifdef __HARBOUR__
TEST_LINE( LTrim(@scString) , "HELLO" ) /* CA-Cl*pper bug, it will throw an error here. */
#endif
TEST_LINE( LTrim(scString) , "HELLO" )
TEST_LINE( LTrim("HELLO") , "HELLO" )
TEST_LINE( LTrim( "" ) , "" )
TEST_LINE( LTrim( "UA " ) , "UA " )
TEST_LINE( LTrim( " UA" ) , "UA" )
TEST_LINE( LTrim( " UA " ) , "UA " )
TEST_LINE( LTrim( " "+Chr(0)+" UA " ) , ""+Chr(0)+" UA " )
TEST_LINE( LTrim( " "+Chr(9)+" UA " ) , "UA " )
TEST_LINE( LTrim( " "+Chr(9)+"U"+Chr(9)) , "U"+Chr(9)+"" )
TEST_LINE( LTrim( " "+Chr(9)+Chr(9)) , "" )
TEST_LINE( LTrim( Chr(10)+"U"+Chr(10)) , "U"+Chr(10)+"" )
TEST_LINE( LTrim( Chr(13)+"U"+Chr(13)) , "U"+Chr(13)+"" )
TEST_LINE( LTrim( "A"+Chr(10)) , "A"+Chr(10)+"" )
TEST_LINE( LTrim( "A"+Chr(13)) , "A"+Chr(13)+"" )
TEST_LINE( LTrim( " "+Chr(0)+"ABC"+Chr(0)+" "), ""+Chr(0)+"ABC"+Chr(0)+" " )
/* STRTRAN() */
/* TODO: STRTRAN() */
/* NOTE: It seems like CA-Cl*pper 5.x is not aware of the BREAK return value of
the error handler, so the error is thrown, but we can't catch it.
This bug is fixed in CA-Clipper 5.3 [vszel] */
#ifndef __CLIPPER__
TEST_LINE( StrTran() , "E BASE 1126 Argument error STRTRAN F:S" ) /* CA-Cl*pper bug, it will exit on this */
TEST_LINE( StrTran( NIL ) , "E BASE 1126 Argument error STRTRAN F:S" ) /* CA-Cl*pper bug, it will exit on this */
TEST_LINE( StrTran( 100 ) , "E BASE 1126 Argument error STRTRAN F:S" ) /* CA-Cl*pper bug, it will exit on this */
TEST_LINE( StrTran( "AA", 1 ) , "E BASE 1126 Argument error STRTRAN F:S" ) /* CA-Cl*pper bug, it will exit on this */
#endif
TEST_LINE( StrTran( "AA", "A" ) , "" )
TEST_LINE( StrTran( "AA", "A", "1" ) , "11" )
TEST_LINE( StrTran( "AA", "A", "1", "2" ) , "11" )
/* UPPER() */
TEST_LINE( Upper( scString ) , "HELLO" )
#ifdef __HARBOUR__
TEST_LINE( Upper( @scString ) , "HELLO" ) /* Bug in CA-Cl*pper, it will return argument error */
#endif
TEST_LINE( Upper( 100 ) , "E BASE 1102 Argument error UPPER F:S" )
TEST_LINE( Upper( "" ) , "" )
TEST_LINE( Upper( " " ) , " " )
TEST_LINE( Upper( "2" ) , "2" )
TEST_LINE( Upper( "{" ) , "{" )
TEST_LINE( Upper( Chr(0) ) , ""+Chr(0)+"" )
TEST_LINE( Upper( "aAZAZa" ) , "AAZAZA" )
TEST_LINE( Upper( "AazazA" ) , "AAZAZA" )
TEST_LINE( Upper( "Aaz"+Chr(0)+"zA" ) , "AAZ"+Chr(0)+"ZA" )
TEST_LINE( Upper( "z" ) , "Z" )
TEST_LINE( Upper( " µ" ) , " µ" )
TEST_LINE( Upper( "H rbor 8-) µ" ) , "H RBOR 8-) µ" )
/* LOWER() */
TEST_LINE( Lower( scString ) , "hello" )
#ifdef __HARBOUR__
TEST_LINE( Lower( @scString ) , "hello" ) /* Bug in CA-Cl*pper, it will return argument error */
#endif
TEST_LINE( Lower( 100 ) , "E BASE 1103 Argument error LOWER F:S" )
TEST_LINE( Lower( "" ) , "" )
TEST_LINE( Lower( " " ) , " " )
TEST_LINE( Lower( "2" ) , "2" )
TEST_LINE( Lower( "{" ) , "{" )
TEST_LINE( Lower( Chr(0) ) , ""+Chr(0)+"" )
TEST_LINE( Lower( "aAZAZa" ) , "aazaza" )
TEST_LINE( Lower( "AazazA" ) , "aazaza" )
TEST_LINE( Lower( "Aaz"+Chr(0)+"zA" ) , "aaz"+Chr(0)+"za" )
TEST_LINE( Lower( "z" ) , "z" )
TEST_LINE( Lower( " µ" ) , " µ" )
TEST_LINE( Lower( "H rbor 8-) µ" ) , "h rbor 8-) µ" )
/* AT() */
TEST_LINE( At("", "") , 1 )
TEST_LINE( At("", "ABCDEF") , 1 )
TEST_LINE( At(90, 100) , "E BASE 1108 Argument error AT F:S" )
TEST_LINE( At("", 100) , "E BASE 1108 Argument error AT F:S" )
TEST_LINE( At(100, "") , "E BASE 1108 Argument error AT F:S" )
TEST_LINE( At("", "") , 0 ) /* Bug in CA-Cl*ppers compiler optimalizer, it will return 1 */
TEST_LINE( At("", "ABCDEF") , 0 ) /* Bug in CA-Cl*ppers compiler optimalizer, it will return 1 */
TEST_LINE( At(scStringE, "ABCDEF") , 0 )
TEST_LINE( At("ABCDEF", "") , 0 )
TEST_LINE( At("AB", "AB") , 1 )
TEST_LINE( At("AB", "AAB") , 2 )
@@ -1376,6 +1533,9 @@ STATIC FUNCTION Main_STRINGS()
/* RAT() */
TEST_LINE( RAt(90, 100) , 0 )
TEST_LINE( RAt("", 100) , 0 )
TEST_LINE( RAt(100, "") , 0 )
TEST_LINE( RAt("", "") , 0 )
TEST_LINE( RAt("", "ABCDEF") , 0 )
TEST_LINE( RAt("ABCDEF", "") , 0 )
@@ -1429,6 +1589,10 @@ STATIC FUNCTION Main_STRINGS()
/* SUBSTR() */
TEST_LINE( SubStr(100 , 0, -1) , "E BASE 1110 Argument error SUBSTR F:S" )
TEST_LINE( SubStr("abcdef", 1, "a") , "E BASE 1110 Argument error SUBSTR F:S" )
TEST_LINE( SubStr("abcdef", "a") , "E BASE 1110 Argument error SUBSTR F:S" )
TEST_LINE( SubStr("abcdef", "a", 1) , "E BASE 1110 Argument error SUBSTR F:S" )
TEST_LINE( SubStr("abcdef", 0, -1) , "" )
TEST_LINE( SubStr("abcdef", 0, 0) , "" )
TEST_LINE( SubStr("abcdef", 0, 1) , "a" )
@@ -1455,10 +1619,15 @@ STATIC FUNCTION Main_STRINGS()
TEST_LINE( SubStr("abcdef", -10, 7) , "abcdef" )
TEST_LINE( SubStr("abcdef", -10, 15) , "abcdef" )
TEST_LINE( SubStr("abcdef", -10) , "abcdef" )
TEST_LINE( SubStr("ab" + Chr(0) + "def", 2, 3) , "b" + Chr(0) + "d" )
TEST_LINE( SubStr("ab" + Chr(0) + "def", 2, 3) , "b" + Chr(0) + "d" )
TEST_LINE( SubStr("abc" + Chr(0) + "def", 3, 1) , "c" )
TEST_LINE( SubStr("abc" + Chr(0) + "def", 4, 1) , "" + Chr(0) + "" )
TEST_LINE( SubStr("abc" + Chr(0) + "def", 5, 1) , "d" )
/* LEFT() */
TEST_LINE( Left(100 , -10) , "E BASE 1124 Argument error LEFT F:S" )
TEST_LINE( Left("abcdef", "A") , "E BASE 1124 Argument error LEFT F:S" )
TEST_LINE( Left("abcdef", -10) , "" )
TEST_LINE( Left("abcdef", -2) , "" )
TEST_LINE( Left("abcdef", 0) , "" )
@@ -1468,6 +1637,8 @@ STATIC FUNCTION Main_STRINGS()
/* RIGHT() */
TEST_LINE( Right(100 , -10) , "" )
TEST_LINE( Right("abcdef", "A") , "" )
TEST_LINE( Right("abcdef", -10) , "" )
TEST_LINE( Right("abcdef", -2) , "" )
TEST_LINE( Right("abcdef", 0) , "" )
@@ -1492,6 +1663,7 @@ STATIC FUNCTION Main_STRINGS()
TEST_LINE( Pad(@scString, 10) , "HELLO " ) /* Bug in CA-Cl*pper, it will return "" */
TEST_LINE( Pad(scString, @snIntP) , "HELLO " ) /* Bug in CA-Cl*pper, it will return "" */
#endif
TEST_LINE( Pad("abcdef", "A") , "" )
TEST_LINE( Pad("abcdef", -5) , "" )
TEST_LINE( Pad("abcdef", 0) , "" )
TEST_LINE( Pad("abcdef", 5) , "abcde" )
@@ -1515,6 +1687,7 @@ STATIC FUNCTION Main_STRINGS()
TEST_LINE( PadR(@scString, 10) , "HELLO " ) /* Bug in CA-Cl*pper, it will return "" */
TEST_LINE( PadR(scString, @snIntP) , "HELLO " ) /* Bug in CA-Cl*pper, it will return "" */
#endif
TEST_LINE( PadR("abcdef", "A") , "" )
TEST_LINE( PadR("abcdef", -5) , "" )
TEST_LINE( PadR("abcdef", 0) , "" )
TEST_LINE( PadR("abcdef", 5) , "abcde" )
@@ -1538,6 +1711,7 @@ STATIC FUNCTION Main_STRINGS()
TEST_LINE( PadL(@scString, 10) , " HELLO" ) /* Bug in CA-Cl*pper, it will return "" */
TEST_LINE( PadL(scString, @snIntP) , " HELLO" ) /* Bug in CA-Cl*pper, it will return "" */
#endif
TEST_LINE( PadL("abcdef", "A") , "" )
TEST_LINE( PadL("abcdef", -5) , "" )
TEST_LINE( PadL("abcdef", 0) , "" )
TEST_LINE( PadL("abcdef", 5) , "abcde" ) /* QUESTION: CA-Cl*pper "bug", should return: "bcdef" ? */
@@ -1561,6 +1735,7 @@ STATIC FUNCTION Main_STRINGS()
TEST_LINE( PadC(@scString, 10) , " HELLO " ) /* Bug in CA-Cl*pper, it will return "" */
TEST_LINE( PadC(scString, @snIntP) , " HELLO " ) /* Bug in CA-Cl*pper, it will return "" */
#endif
TEST_LINE( PadC("abcdef", "A") , "" )
TEST_LINE( PadC("abcdef", -5) , "" )
TEST_LINE( PadC("abcdef", 0) , "" )
TEST_LINE( PadC("abcdef", 2) , "ab" ) /* QUESTION: CA-Cl*pper "bug", should return: "cd" ? */
@@ -2140,7 +2315,7 @@ STATIC FUNCTION Main_MISC()
TEST_LINE( NationMsg() , "Invalid argument" )
TEST_LINE( NationMsg("A") , "" )
TEST_LINE( NationMsg(-1) , "" )
TEST_LINE( NationMsg(-1) , "" ) /* CA-Cl*pper bug: 5.3 may return trash. */
TEST_LINE( NationMsg(0) , "" )
TEST_LINE( NationMsg(1) , "Database Files # Records Last Update Size" )
TEST_LINE( NationMsg(2) , "Do you want more samples?" )
@@ -2156,7 +2331,7 @@ STATIC FUNCTION Main_MISC()
TEST_LINE( NationMsg(12) , "Y/N" )
TEST_LINE( NationMsg(13) , "INVALID EXPRESSION" )
TEST_LINE( NationMsg(14) , "" )
TEST_LINE( NationMsg(200) , "" ) /* Bug in CA-Cl*pper, it will return "74?" */
TEST_LINE( NationMsg(200) , "" ) /* Bug in CA-Cl*pper, it will return "74?" or other trash */
/* These will cause a GPF in CA-Cl*pper (5.2e) */
#ifndef __CLIPPER__
@@ -2336,44 +2511,44 @@ STATIC FUNCTION Main_MISC()
#ifdef __HARBOUR__
/* __COLORINDEX() */
/* HB_COLORINDEX() */
TEST_LINE( __ColorIndex() , "" )
TEST_LINE( __ColorIndex("", -1) , "" )
TEST_LINE( __ColorIndex("", 0) , "" )
TEST_LINE( __ColorIndex("W/R", -1) , "" )
TEST_LINE( __ColorIndex("W/R", 0) , "W/R" )
TEST_LINE( __ColorIndex("W/R", 1) , "" )
TEST_LINE( __ColorIndex("W/R", 2) , "" )
TEST_LINE( __ColorIndex("W/R,GR/0", 0) , "W/R" )
TEST_LINE( __ColorIndex("W/R,GR/0", 1) , "GR/0" )
TEST_LINE( __ColorIndex("W/R,GR/0", 2) , "" )
TEST_LINE( __ColorIndex("W/R,GR/0", 3) , "" )
TEST_LINE( __ColorIndex("W/R, GR/0", 0) , "W/R" )
TEST_LINE( __ColorIndex("W/R, GR/0", 1) , "GR/0" )
TEST_LINE( __ColorIndex("W/R, GR/0", 2) , "" )
TEST_LINE( __ColorIndex("W/R, GR/0", 3) , "" )
TEST_LINE( __ColorIndex("W/R,GR/0 ", 0) , "W/R" )
TEST_LINE( __ColorIndex("W/R,GR/0 ", 1) , "GR/0" )
TEST_LINE( __ColorIndex("W/R,GR/0 ", 2) , "" )
TEST_LINE( __ColorIndex("W/R, GR/0 ", 0) , "W/R" )
TEST_LINE( __ColorIndex("W/R, GR/0 ", 1) , "GR/0" )
TEST_LINE( __ColorIndex("W/R, GR/0 ", 2) , "" )
TEST_LINE( __ColorIndex("W/R, GR/0 ,", 0) , "W/R" )
TEST_LINE( __ColorIndex("W/R, GR/0 ,", 1) , "GR/0" )
TEST_LINE( __ColorIndex("W/R, GR/0 ,", 2) , "" )
TEST_LINE( __ColorIndex(" W/R, GR/0 ,", 0) , "W/R" )
TEST_LINE( __ColorIndex(" W/R, GR/0 ,", 1) , "GR/0" )
TEST_LINE( __ColorIndex(" W/R, GR/0 ,", 2) , "" )
TEST_LINE( __ColorIndex(" W/R , GR/0 ,", 0), "W/R" )
TEST_LINE( __ColorIndex(" W/R , GR/0 ,", 1), "GR/0" )
TEST_LINE( __ColorIndex(" W/R , GR/0 ,", 2), "" )
TEST_LINE( __ColorIndex(" W/R , ,", 1) , "" )
TEST_LINE( __ColorIndex(" W/R ,,", 1) , "" )
TEST_LINE( __ColorIndex(",,", 0) , "" )
TEST_LINE( __ColorIndex(",,", 1) , "" )
TEST_LINE( __ColorIndex(",,", 2) , "" )
TEST_LINE( __ColorIndex(", ,", 2) , "" )
TEST_LINE( hb_ColorIndex() , "" )
TEST_LINE( hb_ColorIndex("", -1) , "" )
TEST_LINE( hb_ColorIndex("", 0) , "" )
TEST_LINE( hb_ColorIndex("W/R", -1) , "" )
TEST_LINE( hb_ColorIndex("W/R", 0) , "W/R" )
TEST_LINE( hb_ColorIndex("W/R", 1) , "" )
TEST_LINE( hb_ColorIndex("W/R", 2) , "" )
TEST_LINE( hb_ColorIndex("W/R,GR/0", 0) , "W/R" )
TEST_LINE( hb_ColorIndex("W/R,GR/0", 1) , "GR/0" )
TEST_LINE( hb_ColorIndex("W/R,GR/0", 2) , "" )
TEST_LINE( hb_ColorIndex("W/R,GR/0", 3) , "" )
TEST_LINE( hb_ColorIndex("W/R, GR/0", 0) , "W/R" )
TEST_LINE( hb_ColorIndex("W/R, GR/0", 1) , "GR/0" )
TEST_LINE( hb_ColorIndex("W/R, GR/0", 2) , "" )
TEST_LINE( hb_ColorIndex("W/R, GR/0", 3) , "" )
TEST_LINE( hb_ColorIndex("W/R,GR/0 ", 0) , "W/R" )
TEST_LINE( hb_ColorIndex("W/R,GR/0 ", 1) , "GR/0" )
TEST_LINE( hb_ColorIndex("W/R,GR/0 ", 2) , "" )
TEST_LINE( hb_ColorIndex("W/R, GR/0 ", 0) , "W/R" )
TEST_LINE( hb_ColorIndex("W/R, GR/0 ", 1) , "GR/0" )
TEST_LINE( hb_ColorIndex("W/R, GR/0 ", 2) , "" )
TEST_LINE( hb_ColorIndex("W/R, GR/0 ,", 0) , "W/R" )
TEST_LINE( hb_ColorIndex("W/R, GR/0 ,", 1) , "GR/0" )
TEST_LINE( hb_ColorIndex("W/R, GR/0 ,", 2) , "" )
TEST_LINE( hb_ColorIndex(" W/R, GR/0 ,", 0) , "W/R" )
TEST_LINE( hb_ColorIndex(" W/R, GR/0 ,", 1) , "GR/0" )
TEST_LINE( hb_ColorIndex(" W/R, GR/0 ,", 2) , "" )
TEST_LINE( hb_ColorIndex(" W/R , GR/0 ,", 0), "W/R" )
TEST_LINE( hb_ColorIndex(" W/R , GR/0 ,", 1), "GR/0" )
TEST_LINE( hb_ColorIndex(" W/R , GR/0 ,", 2), "" )
TEST_LINE( hb_ColorIndex(" W/R , ,", 1) , "" )
TEST_LINE( hb_ColorIndex(" W/R ,,", 1) , "" )
TEST_LINE( hb_ColorIndex(",,", 0) , "" )
TEST_LINE( hb_ColorIndex(",,", 1) , "" )
TEST_LINE( hb_ColorIndex(",,", 2) , "" )
TEST_LINE( hb_ColorIndex(", ,", 2) , "" )
#endif
@@ -2393,6 +2568,9 @@ STATIC FUNCTION Main_MISC()
TEST_LINE( FKLabel( 40 ) , "F40" )
TEST_LINE( FKLabel( 41 ) , "" )
/* NOTE: BIN2*() functions are quite untable in CA-Cl*pper when the passed
parameter is smaller than the required length. */
/* BIN2I() */
#ifndef __CLIPPER__
@@ -2412,8 +2590,8 @@ STATIC FUNCTION Main_MISC()
/* BIN2W() */
#ifndef __CLIPPER__
TEST_LINE( BIN2W() , 0 )
TEST_LINE( BIN2W(100) , 0 )
TEST_LINE( BIN2W() , 0 ) /* Bug in CA-Cl*pper, this causes a GPF */
TEST_LINE( BIN2W(100) , 0 ) /* Bug in CA-Cl*pper, this causes a GPF */
#endif
TEST_LINE( BIN2W("") , 0 )
TEST_LINE( BIN2W("AB") , 16961 )
@@ -2428,8 +2606,8 @@ STATIC FUNCTION Main_MISC()
/* BIN2L() */
#ifndef __CLIPPER__
TEST_LINE( BIN2L() , 0 )
TEST_LINE( BIN2L(100) , 0 )
TEST_LINE( BIN2L() , 0 ) /* Bug in CA-Cl*pper, this causes a GPF */
TEST_LINE( BIN2L(100) , 0 ) /* Bug in CA-Cl*pper, this causes a GPF */
#endif
TEST_LINE( BIN2L("") , 0 )
TEST_LINE( BIN2L("ABCD") , 1145258561 )
@@ -2655,31 +2833,31 @@ STATIC FUNCTION Main_MISC()
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 )) , "J........." ) /* Strange in CA-Cl*pper, it should return: ".........." */
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(), 21, 3 )) , "J........." ) /* Strange in CA-Cl*pper, it should return: ".........." */
TEST_LINE( TAStr(aCopy(TARng(),TANew(), 21, 20 )) , "J........." ) /* Strange in CA-Cl*pper, it should return: ".........." */
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, 3, 20)) , ".........A" ) /* Strange in CA-Cl*pper, it should return: ".........." */
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, 3, 20)) , ".........C" ) /* Strange in CA-Cl*pper, it should return: ".........." */
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,NIL, 21)) , ".........J" ) /* Strange in CA-Cl*pper, it should return: ".........." */
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" */
TEST_LINE( TAStr(aCopy(TARng(),TANew(), 21, 3, 0)) , "J........." ) /* Strange in CA-Cl*pper, it should return: ".........." */
TEST_LINE( TAStr(aCopy(TARng(),TANew(), 21, 3, 2)) , ".J........" ) /* Strange in CA-Cl*pper, it should return: ".........." */
TEST_LINE( TAStr(aCopy(TARng(),TANew(), 21, 3, 8)) , ".......J.." ) /* Strange in CA-Cl*pper, it should return: ".........." */
TEST_LINE( TAStr(aCopy(TARng(),TANew(), 21, 3, 20)) , ".........J" ) /* Strange in CA-Cl*pper, it should return: ".........." */
TEST_LINE( TAStr(aCopy(TARng(),TANew(), 21, 20, 21)) , ".........J" ) /* Strange in CA-Cl*pper, it should return: ".........." */
/* ASORT() */

2
harbour/tests/statinit.prg
View File

@@ -4,6 +4,8 @@
// ; Donated to the public domain by Victor Szel <info@szelvesz.hu>
MEMVAR cMyPubVar
STATIC bBlock1 := {|| Hello() }
STATIC bBlock2 := {|| cMyPubVar }

55
harbour/tests/strings3.prg
View File

@@ -5,62 +5,9 @@
#include "set.ch"
function main
local cStr := "This is " + CHR(0) + " a test."
local cStr := " " + CHR (0) + "ABC" + CHR (0) + " "
local cTest, nI, nJ, crlf := CHR(13)+CHR(10)
// Test various string operators.
OUTSTD (LEN(cStr))
OUTSTD (cStr)
OUTSTD (UPPER (cStr))
OUTSTD (LOWER (cStr))
OUTSTD (crlf)
OUTSTD (ASC (SUBSTR (cStr, 8)))
OUTSTD (ASC (SUBSTR (cStr, 9)))
OUTSTD (ASC (SUBSTR (cStr, 10)))
OUTSTD (crlf)
OUTSTD (crlf)
OUTSTD (crlf)
OUTSTD (">")
OUTSTD (LEFT (cStr, 8))
OUTSTD("<")
OUTSTD (crlf)
OUTSTD (">")
OUTSTD (RIGHT (cStr, 8))
OUTSTD("<")
OUTSTD (crlf)
OUTSTD (ISDIGIT ("9"))
OUTSTD (crlf)
OUTSTD (ISDIGIT ("9A"))
OUTSTD (crlf)
OUTSTD (ISDIGIT ("AA"))
OUTSTD (crlf)
OUTSTD (ISDIGIT ("A"))
OUTSTD (crlf)
OUTSTD (crlf)
cTest := " " + CHR (0) + "ABC" + CHR (0) + " "
OUTSTD (crlf)
OUTSTD (">")
OUTSTD(LTRIM (cTest))
OUTSTD("<")
OUTSTD (crlf)
OUTSTD (">")
OUTSTD(TRIM (cTest))
OUTSTD("<")
OUTSTD (crlf)
OUTSTD (">")
OUTSTD(ALLTRIM (cTest))
OUTSTD("<")
OUTSTD (crlf)
OUTSTD (crlf)
OUTSTD (crlf)
OUTSTD (">")
OUTSTD (REPLICATE ("!", 32))
OUTSTD("<")
OUTSTD (crlf)
OUTSTD (">")
OUTSTD (SPACE (32))
OUTSTD("<")
// Test string copying.
cTest := cStr
OUTSTD (crlf)

8
harbour/tests/strip.prg
View File

@@ -161,7 +161,7 @@ function Read()
if ::hFile == -1
QOut( "DosFile:Read : No file open" )
elseif ::cMode != "R"
QOut( "File ", cFileName, " not open for reading" )
QOut( "File ", ::cFileName, " not open for reading" )
elseif !::lEoF
if Len(::cBlock) == 0 // Read new block
@@ -214,7 +214,7 @@ function WriteLn( xTxt, lCRLF )
if ::hFile == -1
QOut( "DosFile:Write : No file open" )
elseif ::cMode != 'W'
QOut( "File ",cFileName," not opened for writing" )
QOut( "File ", ::cFileName," not opened for writing" )
else
cBlock := ToChar( xTxt ) // Convert to string
if Default( lCRLF, .T. )
@@ -240,7 +240,7 @@ function Goto( nLine )
if Empty(::hFile)
QOut( "DosFile:Goto : No file open" )
elseif ::cMode != "R"
QOut( "File ", cName, " not open for reading" )
QOut( "File ", ::cFileName, " not open for reading" )
else
::lEoF := .F. // Clear (old) End of file
::nLine := 0 // Start at beginning
@@ -251,7 +251,7 @@ function Goto( nLine )
::Run()
enddo
endif
return !lEoF
return !::lEoF

2
harbour/tests/tstcolor.prg
View File

@@ -18,7 +18,9 @@
// This test program placed in the public domain
//
#include "color.ch"
#include "set.ch"
proc main
Local cColor := "r+/bg*,rg*/ng+,w/n,b+/w,rg/b,w+/n*"