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

19990816-21:57 GMT+1

Browse Source
This commit is contained in:
Viktor Szakats
1999-08-16 20:09:36 +00:00
parent 4d2f48f9dd
commit 7b10d473fc
6 changed files with 78 additions and 32 deletions
Download Patch File Download Diff File Expand all files Collapse all files

13
harbour/ChangeLog
View File

@@ -1,3 +1,15 @@
19990816-21:57 GMT+1 Victor Szel <info@szelvesz.hu>
* source/rtl/console.c
tests/working/colorind.prg
+ Added standard header to __ColorIndex()
! Some Lint warnings fixed.
+ Some tests added.
* include/hbdefs.h
include/extend.h
! Some Lint warnings fixed.
* include/Makefile
+ Added hboo.ch
19990816-22:15 GMT+3 Alexander Kresin
* source/rtl/tbrowse.prg
* tests/working/testbrw.prg
@@ -15,6 +27,7 @@
+ browdb
+ tone
>>>>>>> 1.792
19990816-15:30 GMT+1 Victor Szel <info@szelvesz.hu>
* source/rtl/errorapi.c
! Fixed hb_errLaunch() so that it will handle error handler return

1
harbour/include/Makefile
View File

@@ -44,6 +44,7 @@ PRG_HEADERS=\
error.ch \
fileio.ch \
getexit.ch \
hboo.ch \
inkey.ch \
memoedit.ch \
rddsys.ch \

30
harbour/include/extend.h
View File

@@ -42,24 +42,24 @@
#endif
/* items types */
#define IT_NIL 0x0000
#define IT_INTEGER 0x0002
#define IT_LONG 0x0008
#define IT_DOUBLE 0x0010
#define IT_DATE 0x0020
#define IT_LOGICAL 0x0080
#define IT_SYMBOL 0x0100
#define IT_ALIAS 0x0200
#define IT_STRING 0x0400
#define IT_MEMOFLAG 0x0800
#define IT_NIL ((WORD) 0x0000)
#define IT_INTEGER ((WORD) 0x0002)
#define IT_LONG ((WORD) 0x0008)
#define IT_DOUBLE ((WORD) 0x0010)
#define IT_DATE ((WORD) 0x0020)
#define IT_LOGICAL ((WORD) 0x0080)
#define IT_SYMBOL ((WORD) 0x0100)
#define IT_ALIAS ((WORD) 0x0200)
#define IT_STRING ((WORD) 0x0400)
#define IT_MEMOFLAG ((WORD) 0x0800)
#define IT_MEMO ( IT_MEMOFLAG & IT_STRING )
#define IT_BLOCK 0x1000
#define IT_BYREF 0x2000
#define IT_MEMVAR 0x4000
#define IT_ARRAY 0x8000
#define IT_BLOCK ((WORD) 0x1000)
#define IT_BYREF ((WORD) 0x2000)
#define IT_MEMVAR ((WORD) 0x4000)
#define IT_ARRAY ((WORD) 0x8000)
#define IT_OBJECT IT_ARRAY
#define IT_NUMERIC ( IT_INTEGER | IT_LONG | IT_DOUBLE )
#define IT_ANY 0xFFFF
#define IT_ANY ((WORD) 0xFFFF)
/* forward declarations */
struct _HB_CODEBLOCK;

16
harbour/include/hbdefs.h
View File

@@ -120,15 +120,15 @@ typedef char SYMBOLSCOPE; /* stores symbol's scope */
#define IS_SYMBOL( p ) IS_OF_TYPE( p, IT_SYMBOL )
#define IS_MEMVAR( p ) IS_OF_TYPE( p, IT_MEMVAR )
#define PCOUNT hb_parinfo( 0 )
#define ISCHAR( n ) ( hb_param( n, IT_STRING ) != NULL )
#define ISNUM( n ) ( hb_param( n, IT_NUMERIC ) != NULL )
#define ISLOG( n ) ( hb_param( n, IT_LOGICAL ) != NULL )
#define ISDATE( n ) ( hb_param( n, IT_DATE ) != NULL )
#define ISMEMO( n ) ( hb_param( n, IT_MEMO ) != NULL )
#define ISBYREF( n ) ( hb_param( n, IT_BYREF ) != NULL )
#define ISARRAY( n ) ( hb_param( n, IT_ARRAY ) != NULL )
#define ISCHAR( n ) hb_param( n, IT_STRING )
#define ISNUM( n ) hb_param( n, IT_NUMERIC )
#define ISLOG( n ) hb_param( n, IT_LOGICAL )
#define ISDATE( n ) hb_param( n, IT_DATE )
#define ISMEMO( n ) hb_param( n, IT_MEMO )
#define ISBYREF( n ) hb_param( n, IT_BYREF )
#define ISARRAY( n ) hb_param( n, IT_ARRAY )
#define PCOUNT hb_parinfo( 0 )
#define ALENGTH( n ) hb_parinfa( n, 0 )
#endif /* HB_DEFS_H_ */

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

@@ -1123,13 +1123,43 @@ HARBOUR HB___ACCEPT( void ) /* Internal Clipper function used in ACCEPT command
}
/* ------------------------------------------------- */
/* Copyright 1999 Victor Szel <info@szelvesz.hu> */
/* ------------------------------------------------- */
/* __COLORINDEX(cColorStr, nColorIndex) -> cColor */
/* */
/* ? __ColorIndex("W/N, N/W", CLR_ENHANCED) -> "N/W" */
/* Copyright (C) 1999 Victor Szel <info@szelvesz.hu> */
/* ------------------------------------------------- */
/* $DOC$
* $FUNCNAME$
* __ColorIndex
* $CATEGORY$
* GT
* $ONELINER$
* Extract one color from a full Clipper colorspec string.
* $SYNTAX$
* __ColorIndex( <cColorSpec>, <nIndex> )
* $ARGUMENTS$
* <cColorSpec> is a Clipper color list
* <nIndex> is the position of the color item to be extracted, the first
* position is the zero.
* $RETURNS$
* The selected color string, or if anything goes wrong, and empty
* string
* $DESCRIPTION$
* Clipper has color spec string, which have more than one single
* colors in it, separated with commas. This function is able to extract
* 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"
* $TESTS$
* see in coloring.prg for a comprehensive regression test suit.
* $STATUS$
* R
* $COMPLIANCE$
* Was not part of CA-Clipper.
* $SEEALSO$
* ColorSelect()
* $END$
*/
HARBOUR HB___COLORINDEX( void )
{
if ( ISCHAR( 1 ) && ISNUM( 2 ) )
@@ -1137,11 +1167,11 @@ HARBOUR HB___COLORINDEX( void )
char * szColor = hb_parc( 1 );
ULONG ulColorPos;
ULONG ulColorLen;
USHORT uiColorIndex = hb_parni( 2 );
USHORT uiColorIndex = (USHORT) hb_parni( 2 );
/* Skip the given number of commas */
for ( ulColorPos = 0 ; szColor[ ulColorPos ] && uiColorIndex > 0 ; ulColorPos++ )
for ( ulColorPos = 0 ; szColor[ ulColorPos ] != '\0' && uiColorIndex > 0 ; ulColorPos++ )
{
if ( szColor[ ulColorPos ] == ',' )
uiColorIndex--;
@@ -1159,12 +1189,12 @@ HARBOUR HB___COLORINDEX( void )
ulColorLen = 0;
while ( szColor[ ulColorPos + ulColorLen ] &&
while ( szColor[ ulColorPos + ulColorLen ] != '\0' &&
szColor[ ulColorPos + ulColorLen ] != ',' ) ulColorLen++;
/* Skip the trailing spaces */
while ( ulColorLen &&
while ( ulColorLen > 0 &&
szColor[ ulColorPos + ulColorLen - 1 ] == ' ' ) ulColorLen--;
/* Return the string */

2
harbour/tests/working/colorind.prg
View File

@@ -10,7 +10,9 @@ STATIC snFail := 0
FUNCTION Main()
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) , "" )