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

19991127-17:25 GMT+1 Victor Szel <info@szelvesz.hu>

Browse Source
This commit is contained in:
Viktor Szakats
1999-11-27 16:47:07 +00:00
parent 89cde2ddc2
commit 736b33c8ff
9 changed files with 310 additions and 61 deletions
Download Patch File Download Diff File Expand all files Collapse all files

13
harbour/ChangeLog
View File

@@ -1,9 +1,20 @@
19991127-17:25 GMT+1 Victor Szel <info@szelvesz.hu>
* source/rtl/alert.prg
+ Documentation by Chen Kedem added
+ Added SPACE key handling for GT mode.
! Fixed autodelay after a LEFT/RIGHT key.
! Fixed ENTER/LEFT/RIGHT key handling in console mode.
! SAY/BOX converted to DispBox()/DispOutAt()
* source/rtl/adir.prg
+ Documentation by Chen Kedem added
* source/pp/*
! Some Borland warnings fixed.
19991126-12:00 WIB Andi Jahja <andij@aonlippo.co.id>
* tests
+ hversion.prg - List version of Harbour source codes
+ entries.ini - File list for hversion.prg to work
19991126-01:11 GMT+1 Jose Lalin <dezac@corevia.com>
* source/rtl/input.prg
+ documented

1
harbour/hbpp.b32
View File

@@ -26,4 +26,3 @@ hbpplib.obj : hbpplib.c
hbpp.exe : source\pp\stdalone\hbpp.c
bcc32 -O2 -ebin\hbpp.exe -Iinclude source\pp\stdalone\hbpp.c lib\b32\hbpp.lib
del source\pp\stdalone\hbpp.obj

2
harbour/source/common/hbfsapi.c
View File

@@ -116,7 +116,7 @@ PHB_FNAME hb_fsFNameSplit( char * pszFileName )
platforms where applicable. Note that the drive info is always
present also in the path itself. */
if( pFileName->szPath && ( pszAt = strchr( pFileName->szPath, ':' ) ) )
if( pFileName->szPath && ( pszAt = strchr( pFileName->szPath, ':' ) ) != NULL )
{
pFileName->szDrive = pszPos;
strncpy( pszPos, pFileName->szPath, pszAt - pFileName->szPath + 1 );

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

@@ -1410,6 +1410,8 @@ static BOOL CheckOptional( char * ptrmp, char * ptri, char * ptro, int * lenres,
char * lastInputptr[ 5 ];
char * lastopti[ 3 ], *ptr;
HB_SYMBOL_UNUSED( com_or_tra );
HB_TRACE(HB_TR_DEBUG, ("CheckOptional(%s, %s, %s, %p, %d, %d)", ptrmp, ptri, ptro, lenres, com_or_tra, com_or_xcom));
s_bReplacePat = FALSE;

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

@@ -145,6 +145,8 @@ int hb_pp_Parse( FILE * handl_i, FILE * handl_o, char * szSource )
int iBuffer = 10, lenBuffer = 10;
int lens = 0, rdlen, iLine = 0;
HB_SYMBOL_UNUSED( handl_o );
HB_TRACE(HB_TR_DEBUG, ("hb_pp_Parse(%p, %p)", handl_i, handl_o));
while( ( rdlen = hb_pp_RdStr( handl_i, s_szLine + lens, HB_PP_STR_SIZE - lens, lContinue,

3
harbour/source/pp/hbpplib.c
View File

@@ -87,6 +87,7 @@ HARBOUR HB___PREPROCESS( void )
{
/* Some error here? */
}
hb_retc( pText ); /* Preprocessor returns parsed line in input buffer */
}
else
@@ -109,6 +110,8 @@ void hb_compGenError( char * szErrors[], char cPrefix, int iError, char * szErro
PHB_ITEM pError;
char buffer[ 128 ];
HB_SYMBOL_UNUSED( cPrefix );
HB_TRACE(HB_TR_DEBUG, ("GenError(%p, %c, %d, %s, %s)", szErrors, cPrefix, iError, szError1, szError2));
/* TODO: The internal buffers allocated by the preprocessor should be

7
harbour/source/pp/stdalone/hbpp.c
View File

@@ -67,7 +67,8 @@ int main( int argc, char * argv[] )
FILE * handl_o;
char szFileName[ _POSIX_PATH_MAX ];
char * szDefText;
int iArg = 1, i;
int iArg = 1;
unsigned int i;
BOOL bOutTable = FALSE;
BOOL bOutNew = FALSE;
DEFINES * stdef = hb_pp_topDefine;
@@ -217,7 +218,9 @@ int hb_pp_Parse( FILE * handl_i, FILE * handl_o, char * szSource )
int iBuffer = 10, lenBuffer = 10;
int lens = 0, rdlen;
HB_TRACE(HB_TR_DEBUG, ("hb_pp_Parse(%p, %p)", handl_i, handl_o));
HB_SYMBOL_UNUSED( szSource );
HB_TRACE(HB_TR_DEBUG, ("hb_pp_Parse(%p, %p, %s)", handl_i, handl_o, szSource));
while( ( rdlen = hb_pp_RdStr( handl_i, s_szLine + lens, HB_PP_STR_SIZE - lens, lContinue,
sBuffer, &lenBuffer, &iBuffer ) ) >= 0 )

86
harbour/source/rtl/adir.prg
View File

@@ -33,9 +33,95 @@
*
*/
/*
* The following parts are Copyright of the individual authors.
* www - http://www.harbour-project.org
*
* Copyright 1999 Chen Kedem <niki@actcom.co.il>
* ADIR() documentation
*
* See doc/license.txt for licensing terms.
*
*/
#include "common.ch"
#include "directry.ch"
/* $DOC$
* $FUNCNAME$
* ADIR()*
* $CATEGORY$
* Array
* $ONELINER$
* Fill pre-defined arrays with file/directory information
* $SYNTAX$
* ADIR( [<cFileMask>], [<aName>], [<aSize>], [<aDate>],
* [<aTime>], [<aAttr>] ) -> nDirEnries
* $ARGUMENTS$
* <cFileMask> File mask to include in the function return. It could
* contain path and standard wildcard characters as supported by your
* OS (like * and ?). If you omit <cFileMask> or if <cFileMask> contain
* no path, then the path from SET DEFAULT is used.
*
* <aName> Array to fill with file name of files that meet <cFileMask>.
* Each element is a Character string and include the file name and
* extension without the path. The name is the long file name as
* reported by the OS and not necessarily the 8.3 uppercase name.
*
* <aSize> Array to fill with file size of files that meet <cFileMask>.
* Each element is a Numeric integer and include the file size in Bytes.
* Directories are always zero in size.
*
* <aDate> Array to fill with file last modification date of files that
* meet <cFileMask>. Each element is of type Date.
*
* <aTime> Array to fill with file last modification time of files that
* meet <cFileMask>. Each element is a Character string in the format
* HH:mm:ss.
*
* <aAttr> Array to fill with attribute of files that meet <cFileMask>.
* Each element is a Character string, see DIRECTORY() for information
* about attribute values. If you pass array to <aAttr>, the function
* is going to return files with normal, hidden, system and directory
* attributes. If <aAttr> is not specified or with type other than
* Array, only files with normal attribute would return.
* $RETURNS$
* ADIR() return the number of file entries that meet <cFileMask>
* $DESCRIPTION$
* ADIR() return the number of files and/or directories that match
* a specified skeleton, it also fill a series of given arrays with
* the name, size, date, time and attribute of those files. The passed
* arrays should pre-initialized to the proper size, see example below.
* In order to include hidden, system or directories <aAttr> must be
* specified.
*
* ADIR() is a compatibility function, it is superseded by DIRECTORY()
* which return all the information in a multidimensional array.
* $EXAMPLES$
* LOCAL aName, aSize, aDate, aTime, aAttr, nLen, i
* nLen := ADIR( "*.JPG" ) // Number of JPG files in this directory
* IF nLen > 0
* ASIZE( aName, nLen ) // make room to store the information
* ASIZE( aSize, nLen )
* ASIZE( aDate, nLen )
* ASIZE( aTime, nLen )
* ASIZE( aAttr, nLen )
* FOR i = 1 TO nLen
* ? aName[i], aSize[i], aDate[i], aTime[i], aAttr[i]
* NEXT
* ELSE
* ? "This directory is clean from smut"
* ENDIF
* $TESTS$
* $STATUS$
* $COMPLIANCE$
* <aName> is going to be fill with long file name and not necessarily
* the 8.3 uppercase name.
* $SEEALSO$
* ASIZE(), DIRECTORY(), SET DEFAULT
* $END$
*/
FUNCTION ADir( cFileMask, aName, aSize, aDate, aTime, aAttr )
LOCAL aDir

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

@@ -18,6 +18,9 @@
* Copyright 1999 Victor Szel <info@szelvesz.hu>
* Changes for higher Clipper compatibility
*
* Copyright 1999 Chen Kedem <niki@actcom.co.il>
* Documentation
*
* See doc/license.txt for licensing terms.
*
*/
@@ -41,9 +44,102 @@
STATIC s_lNoAlert := NIL
/* $DOC$
* $FUNCNAME$
* ALERT()
* $CATEGORY$
* Data input and output
* $ONELINER$
* Display a dialog box with a message
* $SYNTAX$
* ALERT( <xMessage>, [<aOptions>], [<cColorNorm>],
* [<nDelay>] ) --> nChoice or NIL
* $ARGUMENTS$
* <xMessage> Message to display in the dialog box. <xMessage> can be
* of any Harbour type.
* If <xMessage> is an array of Character strings, each element would
* be displayed in a new line. <xMessage> is converted to Character
* string, you could split the message to several lines by placing
* semicolon (;) in the desired places.
*
* <aOptions> Array with available response. Each element should be
* Character string. If omitted, default is { "Ok" }.
*
* <cColorNorm> Color string to paint the dialog box with.
* If omitted, default color is "W+/R".
*
* <nDelay> Number of seconds to wait to user response before abort.
* Default value is 0, that wait forever.
* $RETURNS$
* ALERT() return Numeric value representing option number chosen.
* If ESC was pressed, return value is zero. The return value is NIL
* if ALERT() is called with no parameters, or if <xMessage> type is
* not Character and HARBOUR_STRICT_CLIPPER_COMPATIBILITY option was
* used. If <nDelay> seconds had passed without user response, the
* return value is 1.
* $DESCRIPTION$
* ALERT() display simple dialog box on screen and let the user select
* one option. The user can move the highlight bar using arrow keys or
* TAB key. To select an option the user can press ENTER, SPACE or the
* first letter of the option.
*
* If the program is executed with the //NOALERT command line switch,
* nothing is displayed and the program simply QUIT. This switch could
* be override with __NONOALERT().
*
* If the GT system is linked in, ALERT() display the message using
* the full screen I/O system, if not, the information is printed to
* the standard output using OUTSTD().
* $EXAMPLES$
* LOCAL cMessage, aOptions, nChoice
*
* // harmless message
* cMessage := "Major Database Corruption Detected!;" + ;
* "(deadline in few hours);;" + ;
* "where DO you want to go today?"
*
* // define response option
* aOptions := { "Ok", "www.jobs.com", "Oops" }
*
* // show message and let end user select panic level
* nChoice := ALERT( cMessage, aOptions )
* DO CASE
* CASE nChoice == 0
* // do nothing, blame it on some one else
* CASE nChoice == 1
* ? "Please call home and tell them you're gonn'a be late"
* CASE nChoice == 2
* // make sure your resume is up to date
* CASE nChoice == 3
* ? "Oops mode is not working in this version"
* ENDCASE
* $TESTS$
* $STATUS$
* $COMPLIANCE$
* This function is sensitive to HARBOUR_STRICT_CLIPPER_COMPATIBILITY
* settings.
*
* ON: <xMessage> accept Character values only and return NIL if other
* types are passed,
* OFF: <xMessage> could be any type, and internally converted to
* Character string. If type is Array, multi-line message is
* displayed.
*
* ON: Only the first four valid <aOptions> are taken.
* OFF: <aOptions> could contain as many as needed options.
*
* <cColorNorm> is an Harbour extension, or at least un-documented
* in Clipper 5.2 NG.
*
* <nDelay> is an Harbour extension.
* $SEEALSO$
* @...PROMPT, MENU TO, STDOUT(), __NONOALERT()
* $END$
*/
FUNCTION Alert( xMessage, aOptions, cColorNorm, nDelay )
LOCAL nChoice
LOCAL aSay, nPos, nWidth, nOpWidth, nInitRow, nInitCol, iEval
LOCAL aSay, nPos, nWidth, nOpWidth, nInitRow, nInitCol, nEval
LOCAL nKey, aPos, nCurrent, aHotkey, aOptionsOK
LOCAL cColorHigh
@@ -87,9 +183,9 @@ FUNCTION Alert( xMessage, aOptions, cColorNorm, nDelay )
IF ISARRAY( xMessage )
FOR iEval := 1 TO Len( xMessage )
IF ISCHARACTER( xMessage[ iEval ] )
AAdd( aSay, xMessage[ iEval ] )
FOR nEval := 1 TO Len( xMessage )
IF ISCHARACTER( xMessage[ nEval ] )
AAdd( aSay, xMessage[ nEval ] )
ENDIF
NEXT
@@ -137,9 +233,9 @@ FUNCTION Alert( xMessage, aOptions, cColorNorm, nDelay )
/* Cleanup the button array */
aOptionsOK := {}
FOR iEval := 1 TO Len( aOptions )
IF ISCHARACTER( aOptions[ iEval ] ) .AND. !Empty( aOptions[ iEval ] )
AAdd( aOptionsOK, aOptions[ iEval ] )
FOR nEval := 1 TO Len( aOptions )
IF ISCHARACTER( aOptions[ nEval ] ) .AND. !Empty( aOptions[ nEval ] )
AAdd( aOptionsOK, aOptions[ nEval ] )
ENDIF
NEXT
@@ -169,24 +265,52 @@ FUNCTION Alert( xMessage, aOptions, cColorNorm, nDelay )
nCurrent := nInitCol + Int( ( nWidth - nOpWidth ) / 2 ) + 2
AEval( aOptionsOK, {| x | AAdd( aPos, nCurrent ), AAdd( aHotKey, Upper( Left( x, 1 ) ) ), nCurrent += Len( x ) + 4 } )
nChoice := 1
IF lConsole
FOR iEval := 1 TO Len( aSay )
OutStd( aSay[ iEval ] )
IF iEval < Len( aSay )
FOR nEval := 1 TO Len( aSay )
OutStd( aSay[ nEval ] )
IF nEval < Len( aSay )
OutStd( Chr( 13 ) + Chr( 10 ) )
ENDIF
NEXT
OutStd( " (" )
FOR iEval := 1 TO Len( aOptionsOK )
OutStd( aOptionsOK[ iEval ] )
IF iEval < Len( aOptionsOK )
FOR nEval := 1 TO Len( aOptionsOK )
OutStd( aOptionsOK[ nEval ] )
IF nEval < Len( aOptionsOK )
OutStd( ", " )
ENDIF
NEXT
OutStd( ") " )
/* choice loop */
DO WHILE .T.
nKey := Inkey( nDelay )
DO CASE
CASE nKey == 0
EXIT
CASE nKey == K_ESC
nChoice := 0
EXIT
CASE aScan( aHotkey, {| x | x == Upper( Chr( nKey ) ) } ) > 0
nChoice := aScan( aHotkey, {| x | x == Upper( Chr( nKey ) ) } )
EXIT
ENDCASE
ENDDO
OutStd( Chr( nKey ) )
ELSE
/* PreExt */
@@ -203,68 +327,60 @@ FUNCTION Alert( xMessage, aOptions, cColorNorm, nDelay )
cOldScreen := SaveScreen( nInitRow, nInitCol, nInitRow + Len( aSay ) + 3, nInitCol + nWidth + 1 )
/* draw box */
@ nInitRow, nInitCol, nInitRow + Len( aSay ) + 3, nInitCol + nWidth + 1 ;
BOX B_SINGLE + ' ' COLOR cColorNorm
DispBox( nInitRow, nInitCol, nInitRow + Len( aSay ) + 3, nInitCol + nWidth + 1, B_SINGLE + ' ', cColorNorm )
FOR iEval := 1 TO Len( aSay )
@ nInitRow + iEval, nInitCol + 1 + Int( ( ( nWidth - Len( aSay[ iEval ] ) ) / 2 ) + .5 ) SAY aSay[ iEval ] ;
COLOR cColorNorm
FOR nEval := 1 TO Len( aSay )
DispOutAt( nInitRow + nEval, nInitCol + 1 + Int( ( ( nWidth - Len( aSay[ nEval ] ) ) / 2 ) + .5 ), aSay[ nEval ], cColorNorm )
NEXT
ENDIF
/* choice loop */
DO WHILE .T.
nChoice := 1
/* choice loop */
DO WHILE .T.
IF !lConsole
FOR iEval := 1 TO Len( aOptionsOK )
@ nInitRow + Len( aSay ) + 2, aPos[ iEval ] SAY " " + aOptionsOK[ iEval ] + " " ;
COLOR iif( iEval == nChoice, cColorHigh, cColorNorm )
FOR nEval := 1 TO Len( aOptionsOK )
DispOutAt( nInitRow + Len( aSay ) + 2, aPos[ nEval ], " " + aOptionsOK[ nEval ] + " ",;
iif( nEval == nChoice, cColorHigh, cColorNorm ) )
NEXT
ENDIF
nKey := Inkey( nDelay )
nKey := Inkey( nDelay )
DO CASE
CASE nKey == K_ENTER .OR. nKey == 0
DO CASE
CASE nKey == K_ENTER .OR. ;
nKey == K_SPACE .OR. ;
nKey == 0
EXIT
EXIT
CASE nKey == K_ESC
CASE nKey == K_ESC
nChoice := 0
EXIT
nChoice := 0
EXIT
CASE ( nKey == K_LEFT .OR. nKey == K_SH_TAB ) .AND. Len( aOptionsOK ) > 1
CASE ( nKey == K_LEFT .OR. nKey == K_SH_TAB ) .AND. Len( aOptionsOK ) > 1
nChoice--
IF nChoice == 0
nChoice := Len( aOptionsOK )
ENDIF
nChoice--
IF nChoice == 0
nChoice := Len( aOptionsOK )
ENDIF
CASE ( nKey == K_RIGHT .OR. nKey == K_TAB ) .AND. Len( aOptionsOK ) > 1
nDelay := 0
nChoice++
IF nChoice > Len( aOptionsOK )
nChoice := 1
ENDIF
CASE ( nKey == K_RIGHT .OR. nKey == K_TAB ) .AND. Len( aOptionsOK ) > 1
CASE aScan( aHotkey, {| x | x == Upper( Chr( nKey ) ) } ) > 0
nChoice++
IF nChoice > Len( aOptionsOK )
nChoice := 1
ENDIF
nChoice := aScan( aHotkey, {| x | x == Upper( Chr( nKey ) ) } )
EXIT
nDelay := 0
ENDCASE
CASE aScan( aHotkey, {| x | x == Upper( Chr( nKey ) ) } ) > 0
ENDDO
nChoice := aScan( aHotkey, {| x | x == Upper( Chr( nKey ) ) } )
EXIT
IF lConsole
ENDCASE
OutStd( Chr( nKey ) )
ELSE
ENDDO
/* Restore status */
RestScreen( nInitRow, nInitCol, nInitRow + Len( aSay ) + 3, nInitCol + nWidth + 1, cOldScreen )
@@ -280,10 +396,37 @@ FUNCTION Alert( xMessage, aOptions, cColorNorm, nDelay )
RETURN nChoice
/* Undocumented CA-Clipper functions */
/* $DOC$
* $FUNCNAME$
* __NONOALERT()
* $CATEGORY$
* Data input and output
* $ONELINER$
* Override //NOALERT command line switch
* $SYNTAX$
* __NONOALERT() --> NIL
* $ARGUMENTS$
* This function take no arguments.
* $RETURNS$
* __NONOALERT() always return NIL.
* $DESCRIPTION$
* The //NOALERT command line switch cause the program to QUIT whenever
* it encounter ALERT() function, this function override this behavior
* and always display ALERT() dialog box.
* $EXAMPLES$
* // make sure alert are been displayed
* __NONOALERT()
* $TESTS$
* $STATUS$
* $COMPLIANCE$
* __NONOALERT() is an Undocumented CA-Clipper function
* $SEEALSO$
* $END$
*/
PROCEDURE __NONOALERT()
s_lNoAlert := .F.
RETURN