diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 414fed95b4..f22ed189b5 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,29 @@ +2000-12-10 15:50 GMT -3 Luiz Rafael Culik +*makefile.bc + hb_slex.bc + *Add hbmake to dependencies list ++utils/hbmake + *hbmake directoy ++utils/hbmake/hbmake.prg + *Harbour make utility main file ++utils/hbmake/radios.prg + utils/hbmake/checks.prg + utils/hbmake/pickarry.prg + utils/hbmake/pickfile.prg + utils/hbmake/prb_stak.prg + utils/hbmake/radios.ch + utils/hbmake/checks.ch + utils/hbmake/radiodef.ch + utils/hbmake/checkdef.ch + *Utilityes functions need by hbmake + *utils/hbmake/fclass1.prg + utils/hbmake/ft_funcs.prg + utils/hbmake/ffile1.prg + Hbdoc File class engine + *utils/hbmake/makefile + *makefile for GNu compiler + utils/hbmake/checks.ch + 2000-12-09 14:09 UTC-0800 Brian Hays * source/rdd/dbfntx/dbfntx1.c * More fixes by Alexander diff --git a/harbour/hb_slex.bc b/harbour/hb_slex.bc index 334ca719c7..4fcfe21f57 100644 --- a/harbour/hb_slex.bc +++ b/harbour/hb_slex.bc @@ -86,6 +86,7 @@ HBRUN_DIR = utils\hbrun HBTEST_DIR = utils\hbtest HBDOC_DIR = utils\hbdoc HBPP_DIR = utils\hbpp +HBMAKE_DIR = utils\hbmake !if $d(PDF) HBPDF_DIR = contrib\pdflib !endif @@ -131,7 +132,7 @@ HBPP_EXE = $(BIN_DIR)\hbpp.exe HBRUN_EXE = $(BIN_DIR)\hbrun.exe HBTEST_EXE = $(BIN_DIR)\hbtest.exe HBDOC_EXE = $(BIN_DIR)\hbdoc.exe - +HBMAKE_EXE = $(BIN_DIR)\hbmake.exe # # GT driver list # @@ -605,6 +606,14 @@ HBDOC_EXE_OBJS = \ $(OBJ_DIR)\genpdf1.obj !endif +HBMAKE_EXE_OBJS = \ + $(OBJ_DIR)\hbmake.obj \ + $(OBJ_DIR)\checks.obj \ + $(OBJ_DIR)\pickarry.obj \ + $(OBJ_DIR)\pickfile.obj \ + $(OBJ_DIR)\prb_stak.obj \ + $(OBJ_DIR)\radios.obj + # # Our default target # @@ -626,7 +635,8 @@ all: \ $(HBRUN_EXE) \ $(HBPP_EXE) \ $(HBTEST_EXE) \ - $(HBDOC_EXE) + $(HBDOC_EXE) \ + $(HBMAKE_EXE) # # Library dependencies and build rules @@ -2351,3 +2361,67 @@ $(OBJ_DIR)\genpdf1.obj : $(OBJ_DIR)\genpdf1.c $(OBJ_DIR)\pdfhbdoc.obj : $(HBPDF_DIR)\pdfhbdoc.c $(CC) $(CLIBFLAGS) -v -y -I$(HBPDF_DIR) -o$@ $** !endif + +$(HBMAKE_EXE) : $(HBMAKE_EXE_OBJS) + + echo. $(CFLAGS) > make.tmp + echo. -M -e$(HBMAKE_EXE) >> make.tmp + echo. $(OBJ_DIR)\hbmake.obj >> make.tmp + echo. $(OBJ_DIR)\radios.obj >> make.tmp + echo. $(OBJ_DIR)\checks.obj >> make.tmp + echo. $(OBJ_DIR)\fclass1.obj >> make.tmp + echo. $(OBJ_DIR)\ffile1.obj >> make.tmp + echo. $(OBJ_DIR)\ft_funcs.obj >> make.tmp + echo. $(OBJ_DIR)\pickarry.obj >> make.tmp + echo. $(OBJ_DIR)\pickfile.obj >> make.tmp + echo. $(OBJ_DIR)\prb_stak.obj >> make.tmp + echo. $(PP_LIB) >> make.tmp + echo. $(COMMON_LIB) >> make.tmp + echo. $(VM_LIB) >> make.tmp + echo. $(RTL_LIB) >> make.tmp + echo. $(HB_GT_LIB) >> make.tmp + echo. $(LANG_LIB) >> make.tmp + echo. $(RDD_LIB) >> make.tmp + echo. $(MACRO_LIB) >> make.tmp + echo. $(DBFNTX_LIB) >> make.tmp + echo. $(DBFCDX_LIB) >> make.tmp + + $(CC) @make.tmp + del make.tmp + +$(OBJ_DIR)\hbmake.c : $(HBMAKE_DIR)\hbmake.prg + $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ + +$(OBJ_DIR)\hbmake.obj : $(OBJ_DIR)\hbmake.c + $(CC) $(CLIBFLAGS) -o$@ $** + +$(OBJ_DIR)\radios.c : $(HBMAKE_DIR)\radios.prg + $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ + +$(OBJ_DIR)\radios.obj : $(OBJ_DIR)\radios.c + $(CC) $(CLIBFLAGS) -o$@ $** + +$(OBJ_DIR)\checks.c : $(HBMAKE_DIR)\checks.prg + $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ + +$(OBJ_DIR)\checks.obj : $(OBJ_DIR)\checks.c + $(CC) $(CLIBFLAGS) -o$@ $** + +$(OBJ_DIR)\pickarry.c : $(HBMAKE_DIR)\pickarry.prg + $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ + +$(OBJ_DIR)\pickarry.obj : $(OBJ_DIR)\pickarry.c + $(CC) $(CLIBFLAGS) -o$@ $** + +$(OBJ_DIR)\pickfile.c : $(HBMAKE_DIR)\pickfile.prg + $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ + +$(OBJ_DIR)\pickfile.obj : $(OBJ_DIR)\pickfile.c + $(CC) $(CLIBFLAGS) -o$@ $** + +$(OBJ_DIR)\prb_stak.c : $(HBMAKE_DIR)\prb_stak.prg + $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ + +$(OBJ_DIR)\prb_stak.obj : $(OBJ_DIR)\prb_stak.c + $(CC) $(CLIBFLAGS) -o$@ $** + diff --git a/harbour/makefile.bc b/harbour/makefile.bc index cc88f1d0ec..11abf7664f 100644 --- a/harbour/makefile.bc +++ b/harbour/makefile.bc @@ -86,6 +86,7 @@ HBRUN_DIR = utils\hbrun HBTEST_DIR = utils\hbtest HBDOC_DIR = utils\hbdoc HBPP_DIR = utils\hbpp +HBMAKE_DIR = utils\hbmake !if $d(PDF) HBPDF_DIR = contrib\pdflib !endif @@ -131,7 +132,7 @@ HBPP_EXE = $(BIN_DIR)\hbpp.exe HBRUN_EXE = $(BIN_DIR)\hbrun.exe HBTEST_EXE = $(BIN_DIR)\hbtest.exe HBDOC_EXE = $(BIN_DIR)\hbdoc.exe - +HBMAKE_EXE = $(BIN_DIR)\hbmake.exe # # GT driver list # @@ -606,6 +607,14 @@ HBDOC_EXE_OBJS = \ $(OBJ_DIR)\genpdf1.obj !endif +HBMAKE_EXE_OBJS = \ + $(OBJ_DIR)\hbmake.obj \ + $(OBJ_DIR)\checks.obj \ + $(OBJ_DIR)\pickarry.obj \ + $(OBJ_DIR)\pickfile.obj \ + $(OBJ_DIR)\prb_stak.obj \ + $(OBJ_DIR)\radios.obj + # # Our default target # @@ -627,8 +636,8 @@ all: \ $(HBRUN_EXE) \ $(HBPP_EXE) \ $(HBTEST_EXE) \ - $(HBDOC_EXE) - + $(HBDOC_EXE) \ + $(HBMAKE_EXE) # # Library dependencies and build rules # @@ -2343,3 +2352,67 @@ $(OBJ_DIR)\genpdf1.obj : $(OBJ_DIR)\genpdf1.c $(OBJ_DIR)\pdfhbdoc.obj : $(HBPDF_DIR)\pdfhbdoc.c $(CC) $(CLIBFLAGS) -v -y -I$(HBPDF_DIR) -o$@ $** !endif + +$(HBMAKE_EXE) : $(HBMAKE_EXE_OBJS) + + echo. $(CFLAGS) > make.tmp + echo. -M -e$(HBMAKE_EXE) >> make.tmp + echo. $(OBJ_DIR)\hbmake.obj >> make.tmp + echo. $(OBJ_DIR)\radios.obj >> make.tmp + echo. $(OBJ_DIR)\checks.obj >> make.tmp + echo. $(OBJ_DIR)\fclass1.obj >> make.tmp + echo. $(OBJ_DIR)\ffile1.obj >> make.tmp + echo. $(OBJ_DIR)\ft_funcs.obj >> make.tmp + echo. $(OBJ_DIR)\pickarry.obj >> make.tmp + echo. $(OBJ_DIR)\pickfile.obj >> make.tmp + echo. $(OBJ_DIR)\prb_stak.obj >> make.tmp + echo. $(PP_LIB) >> make.tmp + echo. $(COMMON_LIB) >> make.tmp + echo. $(VM_LIB) >> make.tmp + echo. $(RTL_LIB) >> make.tmp + echo. $(HB_GT_LIB) >> make.tmp + echo. $(LANG_LIB) >> make.tmp + echo. $(RDD_LIB) >> make.tmp + echo. $(MACRO_LIB) >> make.tmp + echo. $(DBFNTX_LIB) >> make.tmp + echo. $(DBFCDX_LIB) >> make.tmp + + $(CC) @make.tmp + del make.tmp + +$(OBJ_DIR)\hbmake.c : $(HBMAKE_DIR)\hbmake.prg + $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ + +$(OBJ_DIR)\hbmake.obj : $(OBJ_DIR)\hbmake.c + $(CC) $(CLIBFLAGS) -o$@ $** + +$(OBJ_DIR)\radios.c : $(HBMAKE_DIR)\radios.prg + $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ + +$(OBJ_DIR)\radios.obj : $(OBJ_DIR)\radios.c + $(CC) $(CLIBFLAGS) -o$@ $** + +$(OBJ_DIR)\checks.c : $(HBMAKE_DIR)\checks.prg + $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ + +$(OBJ_DIR)\checks.obj : $(OBJ_DIR)\checks.c + $(CC) $(CLIBFLAGS) -o$@ $** + +$(OBJ_DIR)\pickarry.c : $(HBMAKE_DIR)\pickarry.prg + $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ + +$(OBJ_DIR)\pickarry.obj : $(OBJ_DIR)\pickarry.c + $(CC) $(CLIBFLAGS) -o$@ $** + +$(OBJ_DIR)\pickfile.c : $(HBMAKE_DIR)\pickfile.prg + $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ + +$(OBJ_DIR)\pickfile.obj : $(OBJ_DIR)\pickfile.c + $(CC) $(CLIBFLAGS) -o$@ $** + +$(OBJ_DIR)\prb_stak.c : $(HBMAKE_DIR)\prb_stak.prg + $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ + +$(OBJ_DIR)\prb_stak.obj : $(OBJ_DIR)\prb_stak.c + $(CC) $(CLIBFLAGS) -o$@ $** + diff --git a/harbour/utils/hbmake/checkdef.ch b/harbour/utils/hbmake/checkdef.ch new file mode 100644 index 0000000000..b39ef648e7 --- /dev/null +++ b/harbour/utils/hbmake/checkdef.ch @@ -0,0 +1,9 @@ +/*** +* Checkdef.ch +* +* Definition of translates for simulated Check box class. +*/ + +#translate :checkGsb => :cargo\[1\] + +#define CHECK_NUM_IVARS 1 diff --git a/harbour/utils/hbmake/checks.ch b/harbour/utils/hbmake/checks.ch new file mode 100644 index 0000000000..54b323f686 --- /dev/null +++ b/harbour/utils/hbmake/checks.ch @@ -0,0 +1,15 @@ +/*** +* Checks.ch +* +* Definition of @ ... GET Check box command. +*/ + +#define CHECK_BOX "X" + +#command @ , GET CHECKBOX ; + ; + => ; + SetPos(, ) ; + ; Aadd(GetList, ; + CheckGetNew({|x| iif(x == NIL, , := x) }, ; + <(var)>, )) diff --git a/harbour/utils/hbmake/checks.prg b/harbour/utils/hbmake/checks.prg new file mode 100644 index 0000000000..c0942423e0 --- /dev/null +++ b/harbour/utils/hbmake/checks.prg @@ -0,0 +1,185 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * checks.Prg checks gets for hbmake + * + * Copyright 2000 Luiz Rafael Culik + * 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 "Getexit.ch" +#include "InKey.ch" +#include "Checks.ch" +#include "Checkdef.ch" + +FUNCTION CheckGetNew(bVar, cVar, cStr) + +LOCAL oGet +LOCAL nRow := Row(), nCol := Col() + + // Display [ ] before the get + DevPos(nRow, nCol) + DevOut("[ ]") + + // Create an empty get object and initialize its cargo + oGet := GetNew() + oGet := GetNew(nRow,ncol+4,{|| cStr },cvar) + + oGet:cargo := Array(CHECK_NUM_IVARS) + + // Get / Set block for real variable + oGet:checkGsb := bVar + + // Check box gets have their own reader, of course + oGet:reader := {|o| CheckReader(o) } + + // Draw the check box + DrawCheck(oGet) + + oGet:display() + +RETURN oGet + + +// The reader for check boxes +Proc CheckReader( oGet ) + + // read the GET if the WHEN condition is satisfied + IF ( GetPreValidate(oGet) ) + // activate the GET for reading + oGet:SetFocus() + + DO WHILE ( oGet:exitState == GE_NOEXIT ) + // check for initial typeout (no editable positions) + IF ( oGet:typeOut ) + oGet:exitState := GE_ENTER + ENDIF + + // apply keystrokes until exit + DO WHILE ( oGet:exitState == GE_NOEXIT ) + CheckApplyKey(oGet, InKey(0)) + ENDDO + + // disallow exit if the VALID condition is not satisfied + IF ( !GetPostValidate(oGet) ) + oGet:exitState := GE_NOEXIT + ENDIF + ENDDO + + // de-activate the GET + oGet:KillFocus() + ENDIF + +RETURN + + +PROC CheckApplyKey(oGet, nKey) + +LOCAL cKey +LOCAL bKeyBlock +LOCAL nSaveRow, nSaveCol + + // check for SET KEY first + IF ( (bKeyBlock := SetKey(nKey)) <> NIL ) + GetDoSetKey(bKeyBlock, oGet) + RETURN // NOTE + ENDIF + + DO CASE + CASE ( nKey == K_UP ) + oGet:exitState := GE_UP + + CASE ( nKey == K_SH_TAB ) + oGet:exitState := GE_UP + + CASE ( nKey == K_DOWN ) + oGet:exitState := GE_DOWN + + CASE ( nKey == K_TAB ) + oGet:exitState := GE_DOWN + + CASE ( nKey == K_ENTER ) + oGet:exitState := GE_ENTER + + CASE nKey == K_SPACE + // Toggle state of this check box. + Eval(oGet:checkGsb, !Eval(oGet:checkGsb)) + + oGet:changed := .T. + + // And redraw the getlist + DrawCheck(oGet) + + CASE ( nKey == K_ESC ) + IF ( Set(_SET_ESCAPE) ) + oGet:undo() + oGet:exitState := GE_ESCAPE + ENDIF + + CASE (nKey == K_PGUP ) + oGet:exitState := GE_WRITE + + CASE (nKey == K_PGDN ) + oGet:exitState := GE_WRITE + + CASE ( nKey == K_CTRL_HOME ) + oGet:exitState := GE_TOP + + // both ^W and ^End terminate the READ (the default) + CASE (nKey == K_CTRL_W) + oGet:exitState := GE_WRITE + + CASE (nKey == K_INS) + Set( _SET_INSERT, !Set(_SET_INSERT) ) + + ENDCASE + +RETURN + + +// Redraw check box +PROC DrawCheck(oGet) + +LOCAL lSelected := Eval(oGet:checkGsb) +LOCAL oGet1 +LOCAL nSaveRow := Row() +LOCAL nSaveCol := Col() +LOCAL nGet + + DevPos(oGet:row, oGet:col - 3) + IF lSelected + DevOut(CHECK_BOX) + ELSE + DevOut(" ") + ENDIF + + DevPos(nSaveRow, nSaveCol) + +RETURN diff --git a/harbour/utils/hbmake/fclass1.prg b/harbour/utils/hbmake/fclass1.prg new file mode 100644 index 0000000000..2391a6819d --- /dev/null +++ b/harbour/utils/hbmake/fclass1.prg @@ -0,0 +1,353 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * FCLASS.PRG Fileman class for hbdoc + * + * Copyright 2000 Luiz Rafael Culik + * 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 "hbclass.ch" +#include 'common.ch' +#include 'hbdocdef.ch' + +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +*+ Class FileMan +*+ +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +CLASS FileMan + + data aDosHandles // Holds an array of dos handles and names + + data nHan + data nLastDosMessage // Holds the DOS error level of last operation + + METHOD addItem( nDos, cFile, cPath ) // Adds an item to the array of handles + METHOD delItem( xitem ) // Deletes an item from the array of handles + + METHOD new() // The constructor for this class + METHOD closeAll() // Closes all of those files + METHOD rewindAll() // Positions the file pointer for each file + METHOD writeAll() // Performs hard-write of all + + METHOD getFileName( cfile ) // Obtains the name of the file based on ID + METHOD getFileId( nid ) // Obtains the ID based on file name + METHOD getFilePath( xItem ) // Obtains file path based on either ID or name + + METHOD noDosError() // Returns a logical true/false + + METHOD openfile( cFile, nMethod ) // Opens the specified file and sets error + METHOD Buffget( ld ) virtual + +ENDCLASS + + /* Method: Init/New + Params: N/A + Returns: Self + Purpose: Constructor +*/ + +METHOD new() CLASS FileMan + + IF ::aDosHandles == NIL // has yet to be initialized + ::aDosHandles := {} + ENDIF + + IF ::nLastDosMessage == NIL // has yet to be initialized + ::nLastDosMessage := 0 + ENDIF + + RETURN ( self ) + + // The following are global operations that need to be performed by all + // files regardless of their format + + /* Method: ::closeAll() + Params: N/A + Returns: Self + Purpose: To go through the stack of opened file handles and close each + file, one at a time. Since this is a global operation, it + will not check on the status of the error message on each + pass but will at the start of the evaluation. + +*/ + +METHOD closeAll() CLASS FileMan + + IF ::nLastDosMessage == 0 + AEVAL( ::aDosHandles, { | aFile | FCLOSE( aFile[ pDOS_HANDLE ] ) } ) + ENDIF + + RETURN ( self ) + + /* Method: ::rewindAll() + Params: N/A + Returns: Self + Purpose: To go through the stack of opened file handles and places the + file pointer to the top of each file, one at a time. Since + Since this is a global operation, it will not check on the + status of the error message on each pass but will at the + start of the evaluation. + +*/ +METHOD rewindAll() CLASS FileMan + + IF ::nLastDosMessage == 0 + AEVAL( ::aDosHandles, { | aFile | FSEEK( aFile[ pDOS_HANDLE ], 0, 0 ) } ) + ENDIF + + RETURN ( self ) + + /* Method: ::writeAll() + Params: N/A + Returns: Self + Purpose: To go through the stack of opened file handles and writes each + file, one at a time. Since this is a global operation, it + will not check on the status of the error message on each + pass but will at the start of the evaluation. + +*/ +METHOD writeAll() CLASS FileMan + + IF ::nLastDosMessage == 0 + AEVAL( ::aDosHandles, { | aFile | FWRITE( aFile[ pDOS_HANDLE ], "", 0 ) } ) + ENDIF + + RETURN ( self ) + + /* Method: ::getFileName( ) + Params: DOS File handle / ID + Returns: File name store with that ID handle + Purpose: This method will return the file's name found + within the table of this class. +*/ +METHOD getFileName( nId ) CLASS FileMan // Obtains the name of the file based on ID + + LOCAL cName := "" // as char + LOCAL nPosition // as int + + IF ::nLastDosMessage == 0 + IF nId IS pNUMERIC + nPosition := ASCAN( ::aDosHandles, ; + { | aFile | nId == aFile[ pDOS_HANDLE ] } ) + IF nPosition != 0 + cName := ::aDosHandles[ nPosition, pDOS_FILE ] + ENDIF + ENDIF + ENDIF + + RETURN ( cName ) + + /* Method: ::getFileId( ) + Params: File names used to store item to stack + Returns: DOS File handle or ID associated with name + Purpose: This method will return the file's ID or DOS handle found + within the table of this class. +*/ +METHOD getFileId( cName ) CLASS FileMan // Obtains the ID based on file name + + LOCAL nId := 0 // as int + LOCAL nPosition // as int + + IF ::nLastDosMessage == 0 + IF cName IS pCHARACTER + nPosition := ASCAN( ::aDosHandles, ; + { | aFile | cName == aFile[ pDOS_FILE ] } ) + IF nPosition != 0 + nId := ::aDosHandles[ nPosition, pDOS_HANDLE ] + ENDIF + ENDIF + ENDIF + + RETURN ( nId ) + + /* Method: ::getFilePath( ) + Params: DOS File handle / ID or stored file name + Returns: Associated file path + Purpose: This method will return the associated DOS path for either the + given file name or DOS file handle / ID. If there is no file + path or if there is an error with the method, the return value + will be a NULL character byte. +*/ +METHOD getFilePath( xItem ) CLASS FileMan // Obtains file path based on either ID or name + + LOCAL cPath := "" // as char + LOCAL nPosition // as int + + IF ::nLastDosMessage == 0 + DO CASE + CASE ( xItem IS pCHARACTER ) // we've got the file name + nPosition := ASCAN( ::aDosHandles, ; + { | aFile | xItem == aFile[ pDOS_FILE ] } ) + IF nPosition != 0 + cPath := ::aDosHandles[ nPosition, pDOS_PATH ] + ENDIF + + CASE ( xItem IS pNUMERIC ) // we've got the file path + nPosition := ASCAN( ::aDosHandles, ; + { | aFile | xItem == aFile[ pDOS_HANDLE ] } ) + IF nPosition != 0 + cPath := ::aDosHandles[ nPosition, pDOS_PATH ] + ENDIF + + ENDCASE + ENDIF + + RETURN ( cPath ) + + // The following two methods are for the sole purpose of manipulating the + // array of DOS file handles + + /* Method: ::addItem( , [, DOS file handle + File name + File path, defaults to "" + Returns: self + Purpose: This method will add the DOS file ID and name to the internal + stack. It will not work if either of the the first two + parameters are not passed to the method OR if the value of + ::nLastDosMessage is 0. The return value of the method will + be the object itself. +*/ +METHOD addItem( nDos, cFile, cPath ) CLASS FileMan + + DEFAULT cPath TO "" + + IF ::nLastDosMessage == 0 + AADD( ::aDosHandles, { nDos, cFile, cPath } ) + ENDIF + + RETURN ( self ) + + /* Method: ::delItem( ) + Params: DOS file handle or file name + Returns: Success status of operation + Purpose: To go through the stack of opened file handles and based on the + parameter passed to the method, it will remove the file from + the stack. If is a numeric, it will be assumed a + valud DOS file handle. If is character, then it will + be assumed the name of the file. If is neither numeric + or character or if the value of ::nLastDosMessage is not 0, + then the method will return a logical false (.F.) value; + otherwise, a logical true (.T.) will be returned. +*/ + +METHOD delItem( xItem ) CLASS FileMan + + LOCAL nPosition // as int + LOCAL lSuccess := pTRUE // as logical + + // if xItem is N/Numeric, then seek on first element; + // if xItem is C/Character, then seek on second element + + IF ::nLastDosMessage == 0 // No DOS error! + DO CASE + CASE ( xItem IS pNUMERIC ) // It's a DOS file handle + nPosition := ASCAN( ::aDosHandles, ; + { | aItem | xItem == aItem[ pDOS_HANDLE ] } ) + IF nPosition == 0 + // Don't remove and set the return value of the function + lSuccess := pFALSE + ELSE + // Since we have a position, remove from the table and keep the + // default return value + ADEL( ::aDosHandles, nPosition ) + ASIZE( ::aDosHandles, LEN( ::aDosHandles ) - 1 ) + ENDIF + + CASE ( xItem IS pCHARACTER ) // It's a file name + nPosition := ASCAN( ::aDosHandles, ; + { | aItem | xItem == aItem[ pDOS_FILE ] } ) + IF nPosition == 0 + // Don't remove and set the return value of the function + lSuccess := pFALSE + ELSE + // Since we have a position, remove from the table and keep the + // default return value + ADEL( ::aDosHandles, nPosition ) + ASIZE( ::aDosHandles, LEN( ::aDosHandles ) - 1 ) + ENDIF + + OTHERWISE + // Invalid data passed to method + lSuccess := pFALSE + + ENDCASE + ELSE + lSuccess := pFALSE + + ENDIF + + RETURN ( lSuccess ) + + /* Method: noDosError() + Params: N/A + Returns: + Purpose: To return a logical true (.T.) if there is no existing error + state within the system +*/ + +METHOD noDosError() CLASS FileMan + + RETURN ( ::nLastDosMessage == 0 ) + + /* Method: open() + Params: N/A + Returns: + Purpose: This method acutally opens the file specified by the parameter + with the open mode of . Each file object + should carry this information locally and use this method only + to update the internal table. + +*/ +METHOD openfile( cFile, nMethod ) CLASS FileMan + + LOCAL nFileHandle // as int + LOCAL cFilename // as char + LOCAL cPath // as char + + DEFAULT nMethod TO 0 + + nFileHandle := FOPEN( cFile, nMethod ) // opens the file + IF !EMPTY( FERROR() ) // There was an error in opening + ::nLastDosMessage := FERROR() + nFileHandle := - 1 + ELSE + cFileName := DOSFILENAME( cFile ) + cPath := STRTRAN( cFile, cFileName, "" ) + ::addItem( nFileHandle, cFileName, cPath ) + ENDIF + ::nHan := nFileHandle +RETURN ( nFileHandle ) + +// End of File: FClass1.prg + +*+ EOF: FCLASS1.PRG diff --git a/harbour/utils/hbmake/ffile1.prg b/harbour/utils/hbmake/ffile1.prg new file mode 100644 index 0000000000..23eefd3fcb --- /dev/null +++ b/harbour/utils/hbmake/ffile1.prg @@ -0,0 +1,625 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * FFILE1.PRG Filebase class for hbdoc + * + * Copyright 2000 Luiz Rafael Culik + * 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 "hbclass.ch" +#include 'common.ch' +#include 'hbdocdef.ch' + +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +*+ Class FileBase +*+ +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +CLASS FileBase FROM FileMan + + DATA nOpenMode // Holds the value to use when opening the file + DATA nCreateMode // Holds the value to use when creating the file + DATA nDosHandle // Holds the DOS file handle for this + + DATA nEndOfFile // Holds the last byte value in the file + DATA nSkipLength // This holds the default skpping length of 1 + DATA cName // This holds the name of the file being worked on + DATA nPosition // This holds the position in the file at + DATA lAtBottom // This is a value to show if at bottom of file + DATA lAtTop // This is a value to show if at top of file + + METHOD new( cname ) // This is the constructor for the file + METHOD FOPEN() // This opens the specified file + METHOD closefile() // This closes the specified file + METHOD fskip( n ) // Moves the byte pointer within the file + METHOD FWRITE( c ) // Write passed data to file w/ len() == nSkipLenght + METHOD retrieve() // Returns the contents of the file at current pos + METHOD fgoTop() // Move the byte pointer to the top of the file + METHOD fgoBottom() // Move the byte pointer to the bottom of the file + METHOD fgoto() // Moves the byte pointer to a specific location + METHOD create() + message fappend METHOD fappendByte( cByte ) + message BuffGet METHOD BufferGet( lDirection ) + METHOD SKIP( nRecord ) // Moves the byte pointer within the file + METHOD WRITE( cChar ) // Write passed data to file w/ len() == nSkipLenght + METHOD goTop() // Move the byte pointer to the top of the file + METHOD goBottom() // Move the byte pointer to the bottom of the file + METHOD GOTO( nValue ) // Moves the byte pointer to a specific location + METHOD OPEN() + message append METHOD appendLine( cline ) + +ENDCLASS + + /* Method: Init/New + Params: N/A + Returns: Self + Purpose: Constructor +*/ +METHOD new( cName ) CLASS FileBase + + super:new() + // first thing to do is check to see if there is a valid file + + ::nSkipLength := 1 + ::nOpenMode := 2 // Mode for which to open the file + ::nCreateMode := 0 // Mode for which to create the file + + ::cName := cName + + RETURN ( self ) + + /* Method: skip( ) + Params: + Returns: Self + Purpose: This method moves the file's byte pointer position + from the current location. The actualy movement is determined + on the value of ::nSkipLength which holds the skipping base. + This class's purpose is to do one byte movements. +*/ +METHOD fskip( nRecords ) CLASS FileBase + + DEFAULT nRecords TO 1 + + IF ::noDosError() .AND. ::nDosHandle > 0 + FSEEK( ::nDosHandle, ( ::nSkipLength * nRecords ), 1 ) + ::nLastDosMessage := FERROR() + ::nPosition := FSEEK( ::nDosHandle, 0, 1 ) + DO CASE + CASE ::nPosition == ::nEndOfFile + ::lAtBottom := pTRUE + ::lAtTop := pFALSE + CASE ::nPosition <= 1 + ::lAtTop := pTRUE + ::lAtBottom := pFALSE + OTHERWISE + ::lAtBottom := ::lAtTop := pFALSE + ENDCASE + ENDIF + + RETURN ( self ) + + /* Method: gotop() + Params: N/A + Returns: Self + Purpose: Move the byte pointer to the top of the file +*/ +METHOD fgotop() CLASS FileBase + + IF ::noDosError() .AND. ::nDosHandle > 0 + ::nPosition := FSEEK( ::nDosHandle, 0, 0 ) + ::nLastDosMessage := FERROR() + ::lAtTop := pTRUE + ::lAtBottom := pFALSE + ENDIF + + RETURN ( self ) + + /* Method: gobottom() + Params: N/A + Returns: Self + Purpose: Move hte byte pointer of the file to tbe bottom. +*/ +METHOD fgoBottom() CLASS FileBase + + IF ::noDosError() .AND. ::nDosHandle > 0 + ::nPosition := FSEEK( ::nDosHandle, 0, 2 ) + ::nLastDosMessage := FERROR() + ::lAtTop := pFALSE + ::lAtBottom := pTRUE + ENDIF + + RETURN ( self ) + + /* Method: close() + Params: N/A + Returns: Self + Purpose: To close the file +*/ +METHOD closefile() CLASS FileBase + + IF ::noDosError() .AND. ::nDosHandle > 0 + FCLOSE( ::nDosHandle ) + ::nLastDosMessage := FERROR() + ::delItem( ::nDosHandle ) + ::lAtTop := ::lAtBottom := pFALSE + ::nPosition := 0 + ENDIF + + RETURN ( self ) + + /* Method: retrieve + Params: N/A + Returns: + Purpose: To return the contents of the file at the current position based + on the length of ::nSkipLength. +*/ +METHOD retrieve() CLASS FileBase + + LOCAL cReturn // as char + LOCAL nMoved // as int + + IF ::noDosError() .AND. ::nDosHandle > 0 + cReturn := SPACE( ::nSkipLength ) + nMoved := FREAD( ::nDosHandle, @cReturn, ::nSkipLength ) + ::nLastDosMessage := FERROR() + FSEEK( ::nDosHandle, - ( nMoved ), 1 ) // Re-position the pointer + ENDIF + + RETURN ( cReturn ) + + /* Method: write() + Params: + Returns: Self + Purpose: To write out to the contents of the file the value in the + parameter . +*/ +METHOD FWRITE( cChar ) CLASS FileBase + + IF ::noDosError() .AND. ::nDosHandle > 0 + IF cChar IS pCHARACTER + FWRITE( ::nDosHandle, cChar, 1 ) + ::nLastDosMessage := FERROR() + IF ::noDosError() + FSEEK( ::nDosHandle, ::nPosition, 0 ) // Re-position the pointer + ENDIF + ENDIF + ENDIF + + RETURN ( self ) + + /* Method: goto() + Params: The record byte to move to + Returns: Self + Purpose: This method moves the byte marker to the position + within the file. It is also based on the value stored to the + ::nSkipLength instance variable +*/ +METHOD fgoto( nValue ) CLASS FileBase + + IF ::noDosError() .AND. ::nDosHandle > 0 + IF nValue IS pNUMERIC + IF nValue > 0 .AND. ; + ( nValue * ::nSkipLength ) <= ::nEndOfFile + FSEEK( ::nDosHandle, ( nValue * ::nSkipLength ), 0 ) + ::nLastDosMessage := FERROR() + ::nPosition := FSEEK( ::nDosHandle, 0, 1 ) + DO CASE + CASE ::nPosition == ::nEndOfFile + ::lAtBottom := pTRUE + ::lAtTop := pFALSE + CASE ::nPosition <= 1 + ::lAtTop := pTRUE + ::lAtBottom := pFALSE + OTHERWISE + ::lAtBottom := ::lAtTop := pFALSE + ENDCASE + ENDIF + ENDIF + ENDIF + + RETURN ( ::nPosition ) + + /* Method: create() + Params: N/A + Returns: Self + Purpose: Creates the specified file with the proper access code +*/ +METHOD Create() CLASS FileBase + + LOCAL nFile // as int + + IF ::noDosError() + nFile := FCREATE( ::cName, ::nCreateMode ) + ::nLastDosMessage := FERROR() + IF ::noDosError() // No Error + FCLOSE( nFile ) // Close the file + ::fopen() // Re-open the file + ENDIF + ENDIF + + RETURN ( self ) + + /* Method: open() + Params: N/A + Returns: Self + Purpose: Opens the file with the proper access code +*/ +METHOD FOPEN() CLASS FileBase + + IF ::noDosError() + ::nDosHandle :=::openfile( ::cName, ::nOpenMode ) + ::nEndOfFile := FSEEK( ::nDosHandle, 0, 2 ) + ::nPosition := FSEEK( ::nDosHandle, 0, 0 ) + ::lAtTop := pTRUE + ::lAtBottom := pFALSE + ENDIF + +RETURN ( self ) + +METHOD fappendByte( cByte ) CLASS FileBase + + DEFAULT cByte TO "" + + IF !EMPTY( cByte ) // Valid line + IF ::noDosError() .AND. ::nDosHandle > 0 // No error + FSEEK( ::nDosHandle, 0, 2 ) + FWRITE( ::nDosHandle, cByte, 1 ) + ::nEndOfFile := FSEEK( ::nDosHandle, 0, 2 ) + ::nPosition := FSEEK( ::nDosHandle, - ( LEN( cByte ) ), 2 ) + ::nSkipLength := LEN( cByte ) + ::lAtBottom := ::lAtTop := pFALSE + ENDIF + ENDIF + +RETURN ( self ) + +// End of File: FFile1.prg +METHOD OPEN() CLASS FileBase + + Self:nDosHandle := Self:openfile( ::cName, ::nOpenMode ) + ::nEndOfFile := FSEEK( Self:nDosHandle, 0, 2 ) + FSEEK( Self:nDosHandle, 0, 0 ) + ::nSkipLength := Self:Buffget() + ::lAtTop := pTRUE + ::lAtBottom := pFALSE + ::nHan := Self:nDosHandle + RETURN ( self ) + + /* Method: gotop() + Params: N/A + Returns: Self + Purpose: Move the byte pointer to the top of the file +*/ +METHOD gotop() CLASS FileBase + + IF Self:noDosError() .AND. Self:nDosHandle > 0 + ::fgotop() + ::nSkipLength := Self:Buffget() + ENDIF + + RETURN ( self ) + + /* Method: gobottom() + Params: N/A + Returns: Self + Purpose: Move hte byte pointer of the file to tbe bottom. +*/ +METHOD goBottom() CLASS FileBase + + LOCAL cBuffer // as char + LOCAL lWithCRLF := pFALSE // as logical + + IF Self:noDosError() .AND. Self:nDosHandle > 0 + ::fgobottom() + // Now, back off from the end one line length and set the marker + cBuffer := SPACE( pBUFFER_LENGTH ) + FSEEK( Self:nDosHandle, - ( pBUFFER_LENGTH ), 2 ) + FREAD( Self:nDosHandle, @cBuffer, pBUFFER_LENGTH ) + IF RIGHT( cBuffer, 2 ) == pCRLF // We need to remove this extra one! + cBuffer := LEFT( cBuffer, LEN( cBuffer ) - 2 ) + lWithCRLF := pTRUE + ENDIF + cBuffer := SUBSTR( cBuffer, RAT( pCRLF, cBuffer ) + 2 ) + ::nSkipLength := LEN( cBuffer ) + IF( lWithCRLF, 2, 0 ) + ::nposition := FSEEK( Self:nDosHandle, - ( LEN( cBuffer ) ), 2 ) + IF lWithCRLF + ::nposition := FSEEK( Self:nDosHandle, - 2, 1 ) + ENDIF + ENDIF + + RETURN ( self ) + + /* Method: close() + Params: N/A + Returns: Self + Purpose: To close the file +*/ +METHOD FCLOSE() CLASS FileBase + + IF Self:noDosError() .AND. Self:nDosHandle > 0 + FCLOSE( Self:nDosHandle ) + Self:nLastDosMessage := FERROR() + Self:delItem( Self:nDosHandle ) + Self:lAtTop := Self:lAtBottom := pFALSE + Self:nPosition := 0 + ENDIF + + RETURN ( self ) + + /* Method: write() + Params: + Returns: Self + Purpose: To write out to the contents of the file the value in the + parameter . +*/ +METHOD WRITE( cChar ) CLASS FileBase + + IF Self:noDosError() .AND. Self:nDosHandle > 0 + IF cChar IS pCHARACTER + IF cChar > Self:nSkipLength // we are going to truncate for now... + FWRITE( Self:nDosHandle, cChar, Self:nSkipLength ) + ELSE + FWRITE( Self:nDosHandle, cChar, LEN( cChar ) ) + ENDIF + FSEEK( Self:nDosHandle, ::nposition, 0 ) + Self:nLastDosMessage := FERROR() + IF Self:noDosError() + FSEEK( Self:nDosHandle, Self:nPosition, 0 ) // Re-position the pointer + ENDIF + ENDIF + ENDIF + + RETURN ( self ) + + /* Method: getBuffer( ) + Params: Logical toggle for direction + Returns: + Purpose: To return the number of bytes either forward or backward from + the present file pointer position in which the next CRLF char + appears. If is a logical false (.F.) value, them + the operation will go in reverse order; otherwise, it will go + in a forward direction. The default value is a logical true + (.T.) value. +*/ +METHOD Buffget( lForward ) CLASS FileBase + + LOCAL cBuffer // as char + LOCAL nLocation // as int + LOCAL nRead // as int + LOCAL lWithCRLF := pFALSE // as logical + + DEFAULT lForward TO pTRUE + + IF !lForward + + nRead := FSEEK( Self:nDosHandle, ; + - ( IF( ::nposition < pBUFFER_LENGTH, ; + ::nposition, ; + pBUFFER_LENGTH ) ), ; + 1 ) // rewind backwards + + cBuffer := SPACE( ::nposition - nRead ) + FREAD( Self:nDosHandle, @cBuffer, ( ::nposition - nRead ) ) + + IF RIGHT( cBuffer, 2 ) == pCRLF // with line already + cBuffer := LEFT( cBuffer, LEN( cBuffer ) - 2 ) + lWithCRLF := pTRUE + ENDIF + nLocation := LEN( cBuffer ) - ( RAT( pCRLF, cBuffer ) ) + + ELSE + cBuffer := SPACE( pBUFFER_LENGTH ) + nRead := FREAD( Self:nDosHandle, @cBuffer, pBUFFER_LENGTH ) + FSEEK( Self:nDosHandle, - ( IF( nRead < pBUFFER_LENGTH, nRead, ; + pBUFFER_LENGTH ) ), 1 ) // Rewind + + // Now, parse the string. and file + + nLocation := AT( pCRLF, cBuffer ) + + // Now, if there is NO CRLF in the buffer and if the value of the + // number of bytes read is less than the buffer length, then we + // have an end of file condition. + IF nLocation == 0 .AND. ( nRead < pBUFFER_LENGTH ) + // If so, then set the appropriate flags accordingly. + ::lAtBottom := pTRUE + ::lAtTop := pFALSE + ENDIF + ENDIF + + RETURN ( nLocation ) + + /* Method: appendLine( Character line to append + Returns: Self + Purpose: To append a blank CRLF delimited line at the end of the file. + If is not passed or if it an empty line with 0 bytes + in length, the function will not operate. +*/ +METHOD appendLine( cLine ) CLASS FileBase + + DEFAULT cLine TO "" + + IF LEN( cLine ) == 0 // Valid line + IF Self:noDosError() .AND. Self:nDosHandle > 0 // No error + IF !( pCRLF $ cLine ) // No CRLF, so add + cLIne += pCRLF + ENDIF + FSEEK( Self:nDosHandle, 0, 2 ) + FWRITE( Self:nDosHandle, cLine ) + ::nEndOfFile := FSEEK( Self:nDosHandle, 0, 2 ) + ::nposition := FSEEK( Self:nDosHandle, - ( LEN( cLine ) ), 2 ) + ::nSkipLength := LEN( cLine ) + ::lAtBottom := ::lAtTop := pFALSE + ENDIF + ENDIF + + RETURN ( self ) + + /* Method: skip( ) + Params: + Returns: Self + Purpose: This method moves the file's byte pointer position + from the current location. The actualy movement is determined + on the value of Self:nSkipLength which holds the skipping base. + This class's purpose is to do one byte movements. +*/ + +METHOD SKIP( nRecords ) CLASS FileBase + + LOCAL nCount := 0 // as int + + DEFAULT nRecords TO 1 + + // Here, we have to start looking for CHR(13)+CHR(10) character + // combinations. Once found, then we have to set the super class + // values appropriately + + IF Self:noDosError() .AND. Self:nDosHandle > 0 + DO CASE + CASE nRecords > 0 // It's positive movement + WHILE nCount ++ != nRecords + ::fskip() + ::nSkipLength := Self:Buffget() + ENDDO + + CASE nRecords < 0 // It's negative movement + WHILE nCount -- != nRecords + ::nSkipLength := Self:Buffget( pFALSE ) + ::fskip( - 1 ) + ENDDO + + ENDCASE + ENDIF + + RETURN ( self ) + + /* Method: goto() + Params: The record byte to move to + Returns: Self + Purpose: This method moves the byte marker to the position + within the file. It is also based on the value stored to the + Self:nSkipLength instance variable +*/ +METHOD GOTO( nValue ) CLASS FileBase + + LOCAL cLine := "" // as char + LOCAL nCount := 0 // as int + LOCAL lContinue := pTRUE // as logical + LOCAL cBuffer // as char + + DEFAULT nValue TO 0 + + IF Self:noDosError() .AND. Self:nDosHandle > 0 + IF nValue IS pNUMERIC + IF nValue > 0 // o.k. so far + FSEEK( Self:nDosHandle, 0, 0 ) // start at the top + WHILE lContinue + cBuffer := SPACE( pBUFFER_LENGTH ) + lContinue := ( FREAD( Self:nDosHandle, @cBuffer, pBUFFER_LENGTH ) == ; + pBUFFER_LENGTH ) + cBuffer := cLine + cBuffer + WHILE pCRLF $ cBuffer + IF ++ nCount == nValue + lContinue := pFALSE + EXIT + ENDIF + cBuffer := SUBSTR( cBuffer, AT( pCRLF, cBuffer ) + 2 ) + ENDDO + cLine := cBuffer + ENDDO + IF nCount == nValue // We have a match + FSEEK( Self:nDosHandle, - ( pBUFFER_LENGTH ), 1 ) // Back off from here + ::nposition := FSEEK( Self:nDosHandle, ; + ( pBUFFER_LENGTH - LEN( cBuffer ) ), ; + 1 ) // Move + ::nSkipLength := Self:Buffget() + ELSE + FSEEK( Self:nDosHandle, ::nposition, 0 ) + nCount := 0 + ENDIF + ENDIF + ENDIF + ENDIF + +RETURN ( nCount ) + +// End of File: FFile2.prg + +METHOD BufferGet( lForward ) CLASS FileBase + + LOCAL cBuffer // as char + LOCAL nLocation // as int + LOCAL nRead // as int + LOCAL lWithCRLF := pFALSE // as logical + + DEFAULT lForward TO pTRUE + + IF !lForward + + nRead := FSEEK( Self:nDosHandle, ; + - ( IF( ::nposition < pBUFFER_LENGTH, ; + ::nposition, ; + pBUFFER_LENGTH ) ), ; + 1 ) // rewind backwards + + cBuffer := SPACE( ::nposition - nRead ) + FREAD( Self:nDosHandle, @cBuffer, ( ::nposition - nRead ) ) + + IF RIGHT( cBuffer, 2 ) == pCRLF // with line already + cBuffer := LEFT( cBuffer, LEN( cBuffer ) - 2 ) + lWithCRLF := pTRUE + ENDIF + nLocation := LEN( cBuffer ) - ( RAT( pCRLF, cBuffer ) ) + + ELSE + cBuffer := SPACE( pBUFFER_LENGTH ) + nRead := FREAD( Self:nDosHandle, @cBuffer, pBUFFER_LENGTH ) + FSEEK( Self:nDosHandle, - ( IF( nRead < pBUFFER_LENGTH, nRead, ; + pBUFFER_LENGTH ) ), 1 ) // Rewind + + // Now, parse the string. and file + + nLocation := AT( pCRLF, cBuffer ) + + // Now, if there is NO CRLF in the buffer and if the value of the + // number of bytes read is less than the buffer length, then we + // have an end of file condition. + IF nLocation == 0 .AND. ( nRead < pBUFFER_LENGTH ) + // If so, then set the appropriate flags accordingly. + ::lAtBottom := pTRUE + ::lAtTop := pFALSE + ENDIF + ENDIF + +RETURN ( nLocation ) + +*+ EOF: FFILE1.PRG diff --git a/harbour/utils/hbmake/ft_funcs.prg b/harbour/utils/hbmake/ft_funcs.prg new file mode 100644 index 0000000000..16aaa5fcbc --- /dev/null +++ b/harbour/utils/hbmake/ft_funcs.prg @@ -0,0 +1,282 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * FT_FUNCS.Prg File support Functions For hbdoc + * + * Copyright 2000 Luiz Rafael Culik + * 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 "directry.ch" +#include "fileio.ch" +#include "inkey.ch" +#include 'hbdocdef.ch' +#include 'common.ch' + +#define xReadBuffer 4096 +DECLARE FT_FUSE(CFILE AS STRING,NMODE AS NUMERIC) AS NUMERIC +DECLARE ft_FEOF() AS LOGICAL +DECLARE FReadLn( cLine ) AS STRING +DECLARE FT_FReadLn() AS STRING +DECLARE FT_FGotop() //AS USUAL +DECLARE FT_FSKIP(n AS NUMERIC) //AS USUAL +DECLARE FT_MKDIR( CDIR AS STRING ) //AS USUAL +DECLARE StrPos( cBuffer AS STRING ) AS NUMERIC +DECLARE GetNumberofTableItems( cBuffer AS STRING ) AS NUMERIC +DECLARE FREADline( nH AS NUMERIC, @cB AS STRING, nMaxLine AS NUMERIC ) +//DECLARE FILEBASE() AS OBJECT +DECLARE FILEBASE ; + New( cname AS STRING) AS CLASS FILEBASE; + FOPEN() AS OBJECT; + closefile() AS OBJECT; + fskip( OPTIONAL n AS NUMERIC) AS OBJECT; + FWRITE( c AS STRING) AS OBJECT; + retrieve() AS STRING; + fgoTop() AS OBJECT; + fgoBottom() AS OBJECT; + fgoto() AS NUMERIC; + create() AS OBJECT; + fappendByte( cByte ) AS OBJECT; + BuffGet METHOD BufferGet( OPTIONAL lDirection AS LOGICAL ) AS NUMERIC; + SKIP( OPTIONAL nRecord AS NUMERIC ) AS OBJECT; + WRITE( cChar AS STRING ) AS OBJECT; + goTop() AS OBJECT; + goBottom() AS OBJECT; + GOTO( OPTIONAL nValue AS NUMERIC) AS NUMERIC; + OPEN() AS OBJECT; + append(OPTIONAL cline AS STRING) AS OBJECT + +STATIC TheHandle As Object +/**** +* FT_FUSE(cFile,nMode) ---> nHandle +* Open a File +*/ + +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +*+ Function FT_FUSE() +*+ +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +FUNCTION FT_FUSE( cFile AS STRING, nMode AS NUMERIC) + Local nHandle as numeric + IF nMode == nil + nMode := 2 + ENDIF + IF cFile == Nil + theHandle:closefile() + ENDIF + IF cFile <> Nil + IF nMode <> 0 + theHandle := FileBase():new( cFile ):open() + ELSE + theHandle := FileBase():new( cFile ):open() + ENDIF + ENDIF + nHandle:= theHandle:nHan +RETURN nHandle + +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +*+ Function ft_FEOF() +*+ +*+ Called from ( hbdoc.prg ) 1 - function readln() +*+ +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +FUNCTION ft_FEOF() + LOCAL lRETURN as LOGICAL := theHandle:lAtBottom +RETURN lRETURN + +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +*+ Function FReadLn() +*+ +*+ Called from ( ft_funcs.prg ) 1 - function ft_freadln() +*+ +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +FUNCTION FReadLn( cLine AS STRING) + + cLine := theHandle:retrieve() +RETURN cLine + +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +*+ Function FT_FReadLn() +*+ +*+ Called from ( hbdoc.prg ) 1 - function readln() +*+ +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +FUNCTION FT_FReadLn() + + LOCAL cBuffer AS STRING := '' + + cBuffer := FReadLn( @cBuffer ) + + cBuffer := STRTRAN( cBuffer, CHR( 13 ), '' ) + +RETURN cBuffer + +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +*+ Function FT_FGotop() +*+ +*+ Called from ( genng.prg ) 1 - static function readfromtop() +*+ ( genrtf.prg ) 1 - static function readfromtop() +*+ +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +FUNCTION FT_FGotop() + + theHandle:Gotop() +RETURN NIL + +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +*+ Function FT_FSKIP() +*+ +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +FUNCTION FT_FSKIP( n AS NUMERIC) + + TheHandle:Skip( n ) +RETURN nil + +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +*+ Function FT_MKDIR() +*+ +*+ Called from ( hbdoc.prg ) 6 - function main() +*+ +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +FUNCTION FT_MKDIR( CDIR AS STRING) + + MAKEDIR( cdir ) + +RETURN nil + +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +*+ Function StrPos() +*+ +*+ Called from ( genhtm1.prg ) 1 - function prochtmtable() +*+ ( genhtm2.prg ) 1 - function prochtmtable() +*+ +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +FUNCTION StrPos( cBuffer AS STRING) + + LOCAL nPos AS NUMERIC :=0 + LOCAL x AS NUMERIC + LOCAL cChar AS STRING + FOR x := 1 TO LEN( cBuffer ) + cChar := SUBSTR( cBuffer, x, 1 ) + IF cChar >= CHR( 64 ) .AND. cChar <= CHR( 90 ) .OR. cChar >= CHR( 97 ) ; + .AND. cChar <= CHR( 122 ) .OR. cChar >= CHR( 48 ) .AND. cChar <= CHR( 57 ) ; + .OR. cChar == CHR( 60 ) .OR. cchar == CHR( ASC( "-" ) ) ; + .OR. cchar == CHR( ASC( "(" ) ) .OR. cchar = CHR( ASC( "|" ) ) .OR. ; + cchar == CHR( ASC( '.' ) ) .OR. cchar == CHR( ASC( '*' ) ) .OR. ; + cchar == CHR( ASC( '#' ) ) .OR. cchar == CHR( ASC( '"' ) ) .OR. ; + cchar == CHR( ASC( '/' ) ) .OR. cchar == CHR( ASC( "@" ) ) ; + .OR. cchar == CHR( ASC( "=" ) ) .OR. cchar == CHR( ASC( 'Ä' ) ) ; + .OR. cchar == CHR( ASC( '?' ) ) .OR. cchar == CHR( ASC( '!' ) ) ; + .OR. cchar == CHR( ASC( "<" ) ) .OR. cchar == CHR( ASC( '>' ) ) ; + .OR. cchar == CHR( ASC( '!' ) ) .OR. cchar == CHR( ASC( '+' ) ) + + nPos := x + + EXIT + ENDIF + NEXT + +RETURN nPos + +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +*+ Function GetNumberofTableItems() +*+ +*+ Called from ( genhtm.prg ) 1 - function prochtmdesc() +*+ ( genng.prg ) 1 - function procngdesc() +*+ ( genng1.prg ) 1 - function procngdesc() +*+ +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +FUNCTION GetNumberofTableItems( cBuffer ) + + LOCAL cItem AS STRING + LOCAL nItem AS NUMERIC := 0 + + cBuffer := ALLTRIM( cBuffer ) + + DO WHILE AT( SPACE( 3 ), cBuffer ) > 0 + cItem := SUBSTR( cBuffer, 1, AT( SPACE( 3 ), cBuffer ) - 1 ) + IF AT( SPACE( 3 ), cBuffer ) == 0 + nItem ++ + ELSE + cBuffer := ALLTRIM( STRTRAN( cBuffer, cItem, '' ) ) + nItem ++ + ENDIF + ENDDO + nItem ++ + RETURN nItem + +#define EOL hb_osnewline() + +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +*+ Function FREADline() +*+ +*+ Called from ( genng.prg ) 1 - static function readfromtop() +*+ ( genrtf.prg ) 1 - static function readfromtop() +*+ +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +FUNCTION FREADline( nH as Numeric, cB AS STRING, nMaxLine as Numeric) + + LOCAL cLine AS STRING + LOCAL nSavePos AS NUMERIC + LOCAL nEol AS NUMERIC + LOCAL nNumRead AS NUMERIC + LOCAL lReturn as Logical + cLine := SPACE( nMaxLine ) + cB := '' + nSavePos := FSEEK( nH, 0, FS_RELATIVE ) + nNumRead := FREAD( nH, @cLine, nMaxLine ) + IF ( nEol := AT( EOL, SUBSTR( cLine, 1, nNumRead ) ) ) == 0 + cB := cLine + ELSE + cB := SUBSTR( cLine, 1, nEol - 1 ) + FSEEK( nH, nSavePos + nEol + 1, FS_SET ) + ENDIF + lReturn := (nNumRead != 0) +RETURN lReturn + +*+ EOF: FT_FUNCS.PRG diff --git a/harbour/utils/hbmake/hbmake.prg b/harbour/utils/hbmake/hbmake.prg new file mode 100644 index 0000000000..649b0748be --- /dev/null +++ b/harbour/utils/hbmake/hbmake.prg @@ -0,0 +1,1147 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * hbmake.Prg Harbour make utility main file + * + * Copyright 2000 Luiz Rafael Culik + * 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 'fileio.ch' +#include "common.ch" +#include "radios.ch" +#include "checks.ch" +#ifdef __HARBOUR__ +#define EOL hb_osnewline() +#define CRLF hb_osnewline() +#else +#define EOL chr(13)+chr(10) +#define hb_osnewline() chr(13)+chr(10) +#define CRLF hb_osnewline() +#endif +Static lPrint := .f. +Static nHandle +Static aDefines := {} +Static aBuildOrder := {} +Static aCommands := {} +Static aMacros := {} +Static aPrgs := {} +Static aCs := {} +Static aObjs := {} +Static lEof := .f. +Static aRes := {} +Static nLinkHandle +Static cLinker := "makefile.@@@" +Static cLinkcomm := '' +Static nFilePos := 1 +Static aFile := {} +Static lBcc := .T. +Static lGcc := .F. +Static lVcc := .F. + +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +*+ Function main() +*+ +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +Function main( cFile, p1, p2, p3 ) + +Local nPos +Local aDef := {} +Default p1 To "" +Default p2 To "" +Default p3 To "" +If Pcount() == 0 + ?? "Harbour Make Utility" + ? "Copyright 1999-2000, http://www.harbour-project.org" + ? "" + ? "Syntax: hbmake cFile [options]" + ? "" + ? "Options: /e Create an New Makefile" + ? " /d Define an macro" + ? " /p Print all command and depencies" + ? " /b+ Use BCC as C compiler" + ? " /g Use GCC as C compiler" + ? " /v Use MSVC as C compiler" + ? " Note: /p and /d can be used together" + ? " Options with + are the default Value" + Return NIL +Endif +If cFile == NIL + ? "File not Found" + Return Nil +Endif +If Pcount() == 2 + If Upper( Left( p1, 2 ) ) == "-B" .or. Upper( Left( p1, 2 ) ) == "/B" + lBcc := .T. + lGcc := .F. + lVcc := .F. + + Endif + If Upper( Left( p1, 2 ) ) == "-G" .or. Upper( Left( p1, 2 ) ) == "/G" + lBcc := .F. + lGcc := .T. + lVcc := .F. + + Endif + If Upper( Left( p1, 2 ) ) == "-V" .or. Upper( Left( p1, 2 ) ) == "/V" + lBcc := .F. + lGcc := .F. + lVcc := .T. + + Endif + If Upper( Left( p1, 2 ) ) == "-E" .or. Upper( Left( p1, 2 ) ) == "/E" + crtmakfile( cFile ) + Return nil + Endif + + If Upper( Left( p1, 2 ) ) == "-P" .or. Upper( Left( p1, 2 ) ) == "/P" + lPrint := .t. + Endif + + If Upper( Left( p1, 2 ) ) == "-D" .or. Upper( Left( p1, 2 ) ) == "/D" + adef := listasarray2( Substr( p1, 3 ), ";" ) + For nPos := 1 To Len( aDef ) + If At( "=", adef[ nPos ] ) > 0 + GetParaDefines( aDef[ nPos ] ) + Endif + Next + Endif +Endif +If Pcount() > 2 + If Upper( Left( p1, 2 ) ) == "-E" .or. Upper( Left( p1, 2 ) ) == "/E" .or. ; + Upper( Left( p2, 2 ) ) == "-E" .or. Upper( Left( p2, 2 ) ) == "/E" .or. ; + Upper( Left( p3, 2 ) ) == "-E" .or. Upper( Left( p3, 2 ) ) == "/E" + crtmakfile( cFile ) + Return nil + Endif + + If Upper( Left( p1, 2 ) ) == "-P" .or. Upper( Left( p1, 2 ) ) == "/P" .or. Upper( Left( p2, 2 ) ) == "-P" .or. Upper( Left( p2, 2 ) ) == "/P" .or. Upper( Left( p3, 2 ) ) == "-P" .or. Upper( Left( p3, 2 ) ) == "/P" + lPrint := .t. + Endif + + If Upper( Left( p1, 2 ) ) == "-D" .or. Upper( Left( p1, 2 ) ) == "/D" .or. Upper( Left( p2, 2 ) ) == "-D" .or. Upper( Left( p2, 2 ) ) == "/D" .or. Upper( Left( p3, 2 ) ) == "-D" .or. Upper( Left( p3, 2 ) ) == "/D" + adef := listasarray2( Substr( p1, 3 ), ";" ) + For nPos := 1 To Len( aDef ) + If At( "=", adef[ nPos ] ) > 0 + GetParaDefines( aDef[ nPos ] ) + Endif + Next + Endif + If Upper( Left( p1, 2 ) ) == "-B" .or. Upper( Left( p1, 2 ) ) == "/B" .or. Upper( Left( p2, 2 ) ) == "-B" .or. Upper( Left( p2, 2 ) ) == "/B" .or. Upper( Left( p3, 2 ) ) == "-B" .or. Upper( Left( p3, 2 ) ) == "/B" + lBcc := .T. + lGcc := .F. + lVcc := .F. + + Endif + If Upper( Left( p1, 2 ) ) == "-G" .or. Upper( Left( p1, 2 ) ) == "/G" .or. Upper( Left( p2, 2 ) ) == "-G" .or. Upper( Left( p2, 2 ) ) == "/G" .or. Upper( Left( p3, 2 ) ) == "-G" .or. Upper( Left( p3, 2 ) ) == "/G" + + lBcc := .F. + lGcc := .T. + lVcc := .F. + + Endif + If Upper( Left( p1, 2 ) ) == "-V" .or. Upper( Left( p1, 2 ) ) == "/V" .or. Upper( Left( p2, 2 ) ) == "-V" .or. Upper( Left( p2, 2 ) ) == "/V" .or. Upper( Left( p3, 2 ) ) == "-V" .or. Upper( Left( p3, 2 ) ) == "/V" + + lBcc := .F. + lGcc := .F. + lVcc := .T. + + Endif + +Endif + +parsemakfi( cFile ) +If lPrint + PrintMacros() +Endif +compfiles() +! ( cLinkcomm ) +Return nil + +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +*+ Function parsemakfi() +*+ +*+ Called from ( hbmake.prg ) 1 - function main() +*+ +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +Function parsemakfi( cFile ) + +Local nPos +Local cBuffer := {} +Local cMacro := "#BCC" +Local cDep := "#DEPENDS" +Local cOpt := "#OPTS" +Local cCom := "#COMMANDS" +Local cBuild := "#BUILD" +Local cTemp := "" +Local cTemp1 := '' +Local aTemp := {} +Local lMacrosec := .f. +Local lBuildSec := .f. +Local lComSec := .f. +// ? "i'm in parsemakfi()" +// ?"cfile= ",cfile +nHandle := FT_FUSE( cFile ) +//nHandle:=fopen(cFile) +// ? "nhandle",nhandle +If nHandle < 0 + Return nil +Endif +cBuffer := Trim( Substr( ReadLN( @lEof ), 1 ) ) +// ? "setting Defines" +Aadd( aDefines, { "HMAKEDIR", If( lgcc, GetMakeDir(), GetMakeDir() + "\.." ) } ) +If lBcc + Aadd( aDefines, { "MAKEDIR", GetBccDir() + "\.." } ) +Elseif lGcc + Aadd( aDefines, { "MAKEDIR", GetGccDir() } ) +Elseif lVcc + Aadd( aDefines, { "MAKEDIR", GetVccDir() + "\.." } ) + +Endif +While !leof + + If At( cMacro, cBuffer ) > 0 + lMacroSec := .T. + lBuildSec := .f. + lComSec := .f. + + Elseif At( cBuild, cBuffer ) > 0 + lMacroSec := .f. + lBuildSec := .T. + lComSec := .f. + Elseif At( cCom, cBuffer ) > 0 + lBuildSec := .f. + lComSec := .t. + lMacroSec := .f. + Endif + + cTemp := Trim( Substr( ReadLN( @lEof ), 1 ) ) + + aTemp := listasArray2( Alltrim( cTemp ), "=" ) + If lmacrosec + If Alltrim( Left( ctemp, 7 ) ) <> '!ifndef' .and. Alltrim( Left( ctemp, 6 ) ) <> "!endif" + + If Len( atemp ) > 1 + If At( "$", atemp[ 2 ] ) > 0 + If lgcc .and. aTemp[ 1 ] = "CFLAG1" .or. aTemp[ 1 ] = "CFLAG2" + Aadd( amacros, { aTemp[ 1 ], Strtran( Replacemacros( atemp[ 2 ] ), "\", "/" ) } ) + Else + Aadd( amacros, { aTemp[ 1 ], Replacemacros( atemp[ 2 ] ) } ) + Endif + Else + If lgcc .and. aTemp[ 1 ] = "CFLAG1" .or. aTemp[ 1 ] = "CFLAG2" + Aadd( aMacros, { aTemp[ 1 ], Strtran( atemp[ 2 ], "\", "/" ) } ) + Else + Aadd( aMacros, { aTemp[ 1 ], atemp[ 2 ] } ) + Endif + Endif + Endif + If aTemp[ 1 ] = "OBJFILES" + aObjs := listasArray2( atemp[ 2 ], " " ) + Endif + If atemp[ 1 ] = "CFILES" + aCs := listasArray2( atemp[ 2 ], " " ) + Endif + If atemp[ 1 ] = "RESFILES" + aRes := listasArray2( atemp[ 2 ], " " ) + Endif + + Else + // cTemp1:=TRIM( SUBSTR( ReadLN( @lEof ),1 ) ) + checkDefine( cTemp ) + // endif + Endif + Endif + If lbuildSec + aBuildOrder := listasarray2( ctemp, ":" ) + // ? cTemp + SetBuild() + + Endif + If lComSec + If !Empty( ctemp ) + Setcommands( cTemP ) + Endif + Endif + If cTemp = "#BUILD" + cBuffer := cTEmp + Elseif cTemp == "#COMMANDS" + cbuffer := ctemp + Endif +Enddo + +If Len( aCs ) > 0 + For nPos := 1 To Len( aCs ) + If !Empty( acs[ nPos ] ) + cTemp := Strtran( acs[ nPos ], ".c", ".prg" ) + If File( cTemp ) + Aadd( aPrgs, Strtran( acs[ nPos ], ".c", ".prg" ) ) + Endif + Endif + Next +Endif +Fclose( nhandle ) +Return nil + +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +*+ Function ListAsArray2() +*+ +*+ Called from ( bccdir.prg ) 1 - function getbccdir() +*+ ( hbmake.prg ) 2 - function main() +*+ 5 - function parsemakfi() +*+ 1 - function getbccdir() +*+ 1 - function getvccdir() +*+ 1 - function getgccdir() +*+ 1 - function checkdefine() +*+ 1 - function setcommands() +*+ 1 - function replacemacros() +*+ 4 - function setbuild() +*+ 1 - function compfiles() +*+ 1 - function getparadefines() +*+ +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +Function ListAsArray2( cList, cDelimiter ) + +Local nPos +Local aList := {} // Define an empty array + +If cDelimiter = NIL + cDelimiter := "," +Endif +// +Do While ( nPos := At( cDelimiter, cList ) ) != 0 + Aadd( aList, Alltrim( Substr( cList, 1, nPos - 1 ) ) ) // Add a new element + cList := Substr( cList, nPos + 1 ) +Enddo +Aadd( aList, Alltrim( cList ) ) // Add final element +// +Return aList // Return the array + +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +*+ Function GetMakeDir() +*+ +*+ Called from ( hbmake.prg ) 2 - function parsemakfi() +*+ +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +Function GetMakeDir() + +Local cPath := "" +Local cExe := HB_ARGV( 0 ) +// ? "get hbmake path" +cPath := Left( cexe, Rat( "\", cexe ) - 1 ) +Return cPath + +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +*+ Function GetBccDir() +*+ +*+ Called from ( hbmake.prg ) 1 - function parsemakfi() +*+ +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +Function GetBccDir() + +Local cPath := '' +Local cEnv := Gete( "PATH" ) +Local aEnv := listasarray2( cEnv, ";" ) +Local nPos +// ? "get bcc32 path" + +For nPos := 1 To Len( aEnv ) + // ? aenv[nPos] + // ? nPos + If File( aenv[ nPos ] + '\bcc32.exe' ) .or. File( Upper( aenv[ nPos ] ) + '\BCC32.EXE' ) + cPath := aenv[ nPos ] + // ? cPath + Exit + Endif +Next + +Return cPath + +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +*+ Function GetVccDir() +*+ +*+ Called from ( hbmake.prg ) 1 - function parsemakfi() +*+ +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +Function GetVccDir() + +Local cPath := '' +Local cEnv := Gete( "PATH" ) +Local aEnv := listasarray2( cEnv, ";" ) +Local nPos +// ? "get bcc32 path" + +For nPos := 1 To Len( aEnv ) + // ? aenv[nPos] + // ? nPos + If File( aenv[ nPos ] + '\cl.exe' ) .or. File( Upper( aenv[ nPos ] ) + '\cl.EXE' ) + cPath := aenv[ nPos ] + // ? cPath + Exit + Endif +Next + +Return cPath + +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +*+ Function GetGccDir() +*+ +*+ Called from ( hbmake.prg ) 1 - function parsemakfi() +*+ +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +Function GetGccDir() + +Local cPath := '' +Local cEnv +Local aEnv +Local nPos +if at("linux",GetEnv("HB_ARCHITECTURE"))>0 + cpath:="/usr/bin" +else + cEnv := Gete( "PATH" ) + aEnv := listasarray2( cEnv, ";" ) + + For nPos := 1 To Len( aEnv ) + If File( aenv[ nPos ] + '\gcc.exe' ) .or. File( Upper( aenv[ nPos ] ) + '\GCC.EXE' ) + cPath := aenv[ nPos ] + Exit + Endif + Next +endif +Return cPath + +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +*+ Function ReadLN() +*+ +*+ Called from ( hbmake.prg ) 2 - function parsemakfi() +*+ 1 - function checkdefine() +*+ 1 - function setcommands() +*+ 2 - function setbuild() +*+ +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +Function ReadLN( leof ) + +Local cBuffer := "" +cBuffer := FT_FREADLN() +cBuffer := Strtran( cBuffer, Chr( 13 ), '' ) +cBuffer := Strtran( cBuffer, Chr( 10 ), '' ) +FT_FSKIP( 1 ) +leof := ft_FEOF() +Return cBuffer + +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +*+ Function checkDefine() +*+ +*+ Called from ( hbmake.prg ) 1 - function parsemakfi() +*+ +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +Function checkDefine( cTemp ) + +Local cDef +Local nPos +Local cRead +Local aSet := {} +Local nMakePos +// ?"checking defines" +If cTemp == "!endif" + Return nil +Endif +cTemp := Trim( Substr( ReadLN( @lEof ), 1 ) ) +cTemp := Strtran( cTemp, "!ifndef ", "" ) +aSet := listasarray2( ctemp, "=" ) +nPos := Ascan( adefines, { | x, y | x[ 1 ] == aset[ 1 ] } ) +If nPos = 0 + cRead := Alltrim( Strtran( aset[ 2 ], "$(", "" ) ) + cRead := Strtran( cRead, ")\..", "" ) + nMakePos := Ascan( aDefines, { | x, y | x[ 1 ] == cRead } ) + If nMakePos > 0 + Aadd( aDefines, { aset[ 1 ], aDefines[ nMakePos, 2 ] } ) + Aadd( amacros, { aset[ 1 ], aDefines[ nMakePos, 2 ] } ) + Endif +Endif +Return nil + +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +*+ Function Setcommands() +*+ +*+ Called from ( hbmake.prg ) 1 - function parsemakfi() +*+ +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +Function Setcommands( cTemP ) + +Local cRead := Alltrim( readln( @leof ) ) +Local nPos +Local nCount := 0 +Local aTempMacros := {} +// ? 'setting commands' +aTempMacros := listasarray2( cREad, " " ) +For nCount := 1 To Len( atempmacros ) + If At( "$", atempmacros[ ncount ] ) > 0 + findmacro( atempmacros[ ncount ], @cRead ) + Endif +Next +Aadd( aCommands, { cTemp, cRead } ) +Return nil + +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +*+ Function Findmacro() +*+ +*+ Called from ( hbmake.prg ) 1 - function setcommands() +*+ 1 - function replacemacros() +*+ 2 - function setbuild() +*+ +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +Function Findmacro( cMacro, cRead ) + +Local nPos +Local cTemp +cMacro := Substr( cMacro, 1, At( ")", cMacro ) ) +If At( "-", cMacro ) > 0 + cMacro := Substr( cMacro, 3 ) +Endif +If At( ";", cMacro ) > 0 + cMacro := Substr( cMacro, At( ";", cMacro ) + 1 ) +Endif + +nPos := Ascan( aMacros, { | x, y | "$(" + Alltrim( x[ 1 ] ) + ")" == cMacro } ) +If nPos = 0 + cTemp := Strtran( cmacro, "$(", "" ) + cTemp := Strtran( ctemp, ")", "" ) + If !Empty( cTemp ) + cRead := Alltrim( Strtran( cRead, cmacro, Gete( cTemp ) ) ) + Endif +Else + cRead := Alltrim( Strtran( cRead, cmacro, amacros[ npos, 2 ] ) ) +Endif +Return nil + +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +*+ Function Replacemacros() +*+ +*+ Called from ( hbmake.prg ) 2 - function parsemakfi() +*+ +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +Function Replacemacros( cMacros ) + +Local nPos +Local nCount := 0 +Local aTempMacros := {} +// ? "replacing macros" +aTempMacros := listasarray2( cMacros, " " ) +For nCount := 1 To Len( atempmacros ) + If At( "$", atempmacros[ ncount ] ) > 0 + findmacro( atempmacros[ ncount ], @cmacros ) + Endif +Next +Return cmacros + +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +*+ Function setBuild() +*+ +*+ Called from ( hbmake.prg ) 1 - function parsemakfi() +*+ +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +Function setBuild() + +Local cRead +Local nPos +Local aMacro +Local aTemp +Local nCount +// ? "setting link file" +cRead := Alltrim( readln( @leof ) ) +amacro := listasarray2( cRead, ":" ) +If Len( amacro ) > 1 + aTemp := listasarray2( amacro[ 2 ], " " ) + For nPos := 1 To Len( aTemp ) + Aadd( aBuildOrder, atemp[ nPos ] ) + Next + +Endif +Aadd( aBuildOrder, amacro[ 1 ] ) +cRead := Strtran( cRead, "@&&!", "" ) + +amacro := listasarray2( cRead, '\' ) + +For nPos := 1 To Len( amacro ) + If At( "$", amacro[ nPos ] ) > 0 + findmacro( amacro[ nPos ], @cRead ) + Endif +Next +cLinkcomm := cRead + " @" + cLinker +nLinkHandle := Fcreate( clinker ) +//#define CRLF hb_osnewline() +For nPos := 1 To 7 + cRead := Alltrim( readln( @leof ) ) + amacro := listasarray2( cRead, " " ) + For ncount := 1 To Len( amacro ) + If At( "$", amacro[ nCount ] ) > 0 + findmacro( amacro[ nCount ], @cRead ) + If At( ".exe", cRead ) > 0 .and. lGcc + Fwrite( nLinkhandle, "-o" + cRead + CRLF ) + Else + Fwrite( nLinkhandle, cRead + CRLF ) + Endif + Endif + Next +Next +Fclose( nLinkhandle ) + +Return nil + +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +*+ Function Compfiles() +*+ +*+ Called from ( hbmake.prg ) 1 - function main() +*+ +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +Function Compfiles() + +Local cComm +Local cOld +Local nPos +Local nCount +Local nFiles +Local aOrder := listasarray2( aBuildOrder[ 2 ], " " ) +// ? "compiling files" +For nCount := 1 To Len( aOrder ) + If aOrder[ nCount ] == "$(CFILES)" + nPos := Ascan( aCommands, { | x, y | x[ 1 ] == ".prg.c:" } ) + If nPos > 0 + cComm := aCommands[ nPos, 2 ] + cOld := cComm + Endif + For nFiles := 1 To Len( aPrgs ) + nPos := Ascan( aCs, { | x | Left( x, At( ".", x ) ) == Left( aPrgs[ nFiles ], At( ".", aPrgs[ nFiles ] ) ) } ) + If nPos > 0 + cComm := Strtran( cComm, "o$*", "o" + aCs[ nPos ] ) + cComm := Strtran( cComm, "$**", aPrgs[ nFiles ] ) + ? " " + ! ( cComm ) + cComm := cold + Endif + Next + Endif + If aOrder[ nCount ] == "$(OBJFILES)" + If lGcc + nPos := Ascan( aCommands, { | x, y | x[ 1 ] == ".c.o:" } ) + Else + nPos := Ascan( aCommands, { | x, y | x[ 1 ] == ".c.obj:" } ) + Endif + If nPos > 0 + cComm := aCommands[ nPos, 2 ] + cOld := ccomm + Endif + For nFiles := 1 To Len( aCs ) + nPos := Ascan( aObjs, { | x | Left( x, At( ".", x ) ) == Left( acs[ nFiles ], At( ".", acs[ nFiles ] ) ) } ) + If nPos > 0 + cComm := Strtran( cComm, "o$*", "o" + aObjs[ nPos ] ) + cComm := Strtran( cComm, "$**", acs[ nFiles ] ) + ? " " + // ? cComm + If lGcc + ? ccomm + Endif + ! ( cComm ) + ccomm := cold + Endif + Next + Endif + If aOrder[ nCount ] == "$(RESDEPEN)" + nPos := Ascan( aCommands, { | x, y | x[ 1 ] == ".rc.res:" } ) + If nPos > 0 + cComm := aCommands[ nPos, 2 ] + Endif + For nFiles := 1 To Len( aRes ) + // nPos:=ascan(aObjs,{|x| left(x,at(".",x)) == left(acs[nFiles],at(".",acs[nFiles]))}) + If !Empty( ares[ nFiles ] ) + cComm := Strtran( cComm, "$<", aRes[ nFiles ] ) + ? " " + ! ( cComm ) + Endif + Next + Endif + +Next +Return nil + +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +*+ Function GetParaDefines() +*+ +*+ Called from ( hbmake.prg ) 2 - function main() +*+ +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +Function GetParaDefines( cTemp ) + +Local cDef +Local nPos +Local cRead +Local aSet := {} +Local nMakePos +// ?"checking defines" +aSet := listasarray2( ctemp, "=" ) +nPos := Ascan( adefines, { | x, y | x[ 1 ] == aset[ 1 ] } ) +If nPos = 0 + cRead := Alltrim( Strtran( aset[ 2 ], "$(", "" ) ) + cRead := Strtran( cRead, ")\..", "" ) + nMakePos := Ascan( aDefines, { | x, y | x[ 1 ] == cRead } ) + If nMakePos = 0 + Aadd( aDefines, { aset[ 1 ], aset[ 2 ] } ) + Aadd( amacros, { aset[ 1 ], aset[ 2 ] } ) + + Endif +Endif +Return nil + +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +*+ Function PrintMacros() +*+ +*+ Called from ( hbmake.prg ) 1 - function main() +*+ +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +Function PrintMacros() + +Local nPos +Local cRead := "" +Outstd( "HBMAKE Version ", Version(), "CopyRight (c) 2000 The Harbour Project" + CRLF ) +Outstd( "" + CRLF ) +Outstd( "Macros:" + CRLF ) +For nPos := 1 To Len( aMacros ) + Outstd( " " + aMacros[ nPos, 1 ] + " = " + aMacros[ nPos, 2 ] + CRLF ) +Next +Outstd( "Implicit Rules:" + CRLF ) +For nPos := 1 To Len( aCommands ) + Outstd( " " + aCommands[ nPos, 1 ] + hb_osnewline() + " " + aCommands[ nPos, 2 ] + CRLF ) +Next +Outstd( "" + CRLF ) +Outstd( "Targets:" ) +Outstd( " " + aMacros[ 6 ] + ":" + CRLF ) +Outstd( " " + "Flags:" + CRLF ) +Outstd( " " + "Dependents:" ) +For nPos := 1 To Len( aCs ) + Outstd( acs[ nPos ] ) +Next +For nPos := 1 To Len( aobjs ) + Outstd( aobjs[ nPos ] ) +Next +Outstd( " " + CRLF ) +Outstd( " commands:" + aBuildOrder[ Len( aBuildOrder ) - 1 ] ) + +Return Nil + +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +*+ Function crtmakfile() +*+ +*+ Called from ( hbmake.prg ) 2 - function main() +*+ +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +Func crtmakfile( cFile ) + +Local ain := {} +Local aOut := {} +Local aSrc := Directory( "*.prg" ) +Local nLenaSrc := Len( asrc ) +Local nLenaOut +Local lFwh := .f. +Local lCw := .f. +Local lRddAds := .f. +Local cOs := "Win32" +Local cCompiler := "BCC" +Local cfwhpath := space(40) +Local ccwpath := space(40) +Local cmainfile := "" +Local cRddAds := "" +Local lAutomemvar := .f. +Local lvarismemvar := .f. +Local ldebug := .f. +Local lSupressline := .f. +Local cGrap := "NONE" +Local cDefHarOpts := "-I$(BHC)\include -n -q0 -w -es2 -gc0 $(PRG_USR) $(HARBOURFLAGS)" +Local cDefcOpts := "" +Local cDefLinkOpts := "" +Local lCompMod := .f. +Local x +Local lGenppo := .f. +Local getlist := {} +Local cTopFile := "" +Local cDefBccLibs := "lang.lib vm.lib rtl.lib rdd.lib macro.lib pp.lib dbfntx.lib dbfcdx.lib common.lib gtwin.lib" +Local cDefGccLibs := "-lvm -lrtl -lgtdos -llang -lrdd -lrtl -lvm -lmacro -lpp -ldbfntx -ldbfcdx -lcommon" +Local cscreen := Savescreen( 0, 0, Maxrow(), Maxcol() ) +local citem:="" +nLinkHandle := Fcreate( cFile ) +Fwrite( nLinkHandle, "#BCC" + CRLF ) +Fwrite( nLinkHandle, "VERSION=BCB01" + CRLF ) +Fwrite( nLinkHandle, "!ifndef BCB" + CRLF ) +Fwrite( nLinkHandle, "BCB = $(MAKEDIR)\.." + CRLF ) +Fwrite( nLinkHandle, "!endif" + CRLF ) +Fwrite( nLinkHandle, "!ifndef BHC" + CRLF ) +Fwrite( nLinkHandle, "BHC = $(HMAKEDIR)\.." + CRLF ) +Fwrite( nLinkHandle, "!endif" + CRLF ) + +Cls +Setcolor( 'w/b+,w/b,w+/b,w/b+,w/b,w+/b' ) +@ 0, 0, Maxrow(), Maxcol() Box( Chr( 201 ) + Chr( 205 ) + Chr( 187 ) + Chr( 186 ) + Chr( 188 ) + Chr( 205 ) + Chr( 200 ) + Chr( 186 ) + Space( 1 ) ) +ATTENTION( "Enviroment options", 0 ) +@ 1, 1 Say "Select Os" +@ 1, 12 Get cos radio { "Win32", "OS/2", "Linux" } +@ 1, 23 Say "Select C Compiler" +@ 1, 40 Get cCompiler radio { "BCC", "MSVC", "GCC" } +@ 1, 48 Say "Graphic Library" +@ 1, 64 Get lFwh checkbox "Use FWH" +@ 2, 64 Get lcw checkbox "Use C4W" +@ 3, 64 Get lRddads checkbox "Use RddAds" +Read + +If lFwh + @ 4, 1 Say "FWH path" Get cfwhpath +Elseif lCw + @ 4, 1 Say "C4H path" Get ccwpath +Endif +ATTENTION( "Harbour Options", 5 ) + +@ 6, 1 Get lautomemvar checkbox "Automatic memvar declaration" +@ 6, 43 Get lvarismemvar checkbox "Variables are assumed M->" +@ 7, 1 Get lDebug checkbox "Debug info" +@ 7, 43 Get lSupressline checkbox "Suppress line number information" +@ 8, 1 Get lGenppo checkbox "Generate pre-processed output" +@ 8, 43 Get lCompMod checkbox "compile module only" +Read +lBcc := If( At( "BCC", cCompiler ) > 0, .t., .f. ) +lVcc := If( At( "MSVC", cCompiler ) > 0, .t., .f. ) +lGcc := If( At( "GCC", cCompiler ) > 0, .t., .f. ) +If lBcc + Aadd( aCommands, { ".cpp.obj:", "$(BCB)\BIN\bcc32 $(CFLAG1) $(CFLAG2) -o$* $*" } ) + + Aadd( aCommands, { ".c.obj:", "$(BCB)\BIN\bcc32 -I$(BHC)\include $(CFLAG1) $(CFLAG2) -o$* $**" } ) + + Aadd( aCommands, { ".prg.c:", "$(BHC)\bin\harbour -n -I$(BHC)\include -o$* $**" } ) + + Aadd( aCommands, { ".rc.res:", "$(BCB)\BIN\brcc32 $(RFLAGS) $<" } ) + +Elseif lGcc + if at("linux",Getenv("HB_ARCHITECTURE"))>0 + Aadd( aCommands, { ".cpp.o:", "$(BCB)/gcc $(CFLAG1) $(CFLAG2) -o$* $*" } ) + + Aadd( aCommands, { ".c.o:", "$(BCB)/gcc -I$(HB_INC_INSTALL) $(CFLAG1) $(CFLAG2) -o$* $**" } ) + + Aadd( aCommands, { ".prg.c:", "$(BHC)/harbour -n -I$(HB_INC_INSTALL) -o$* $**" } ) +else + Aadd( aCommands, { ".cpp.o:", "$(BCB)\gcc $(CFLAG1) $(CFLAG2) -o$* $*" } ) + + Aadd( aCommands, { ".c.o:", "$(BCB)\gcc -I$(BHC)/include $(CFLAG1) $(CFLAG2) -o$* $**" } ) + + Aadd( aCommands, { ".prg.c:", "$(BHC)\harbour -n -I$(BHC)/include -o$* $**" } ) + +endif + +Elseif lVcc + Aadd( aCommands, { ".cpp.obj:", "$(BCB)\bin\cl $(CFLAG1) $(CFLAG2) -Fo$* $*" } ) + + Aadd( aCommands, { ".c.obj:", "$(BCB)\bin\cl -I$(BHC)\include $(CFLAG1) $(CFLAG2) -Fo$* $**" } ) + + Aadd( aCommands, { ".prg.c:", "$(BHC)\bin\harbour -n -I$(BHC)\include -o$* $**" } ) + + Aadd( aCommands, { ".rc.res:", "$(BCB)\BIN\rc $(RFLAGS) $<" } ) +Endif + +attention( 'Spacebar to select, Enter to continue process', 22 ) + +Asize( aIn, nLenaSrc ) +For x := 1 To nLenaSrc + aIn[ x ] := lower(Pad( aSrc[ x, 1 ], 13 )) + ; + Str( aSrc[ x, 2 ], 8 ) + ' ' + ; + Dtoc( aSrc[ x, 3 ] ) + ' ' + ; + aSrc[ x, 4 ] +Next + +aOut := Aclone( aIn ) + +pickarry( 10, 15, 19, 64, aIn, aOut ) + +nLenaOut := Len( aOut ) + +For x := 1 To nLenaOut + aOut[ x ] := lower(Trim( Left( aOut[ x ], 12 ) )) +Next + +aOut := Asort( aOut ) + +If Len( aOut ) == 1 + cTopFile := aOut[ 1 ] +Else + attention( 'Select the TOP MODULE of your executable', 22 ) + cTopFile := lower(pickfile( "*.prg" )) +Endif + +x:=ascan(aOut,{|x| lower(x)==lower(cTopFile)}) +if x>0 + adel(aout,x) + asize(aout,len(aout)-1) +endif +aCs := aclone(aout) + +For x := 1 To Len( aCs ) + cItem:= aCs[ x ] + aCs[ x ]:=strtran( cItem, ".prg", ".c" ) +Next +aObjs := aClone(aout) +For x := 1 To Len( aObjs ) + cItem:=aObjs[ x ] + If !lGcc + aObjs[ x ]:=strtran( cItem, ".prg", ".obj" ) + Else + aObjs[ x ]:=strtran( cItem, ".prg", ".o" ) + Endif +Next + + +? 'Ħm rewritting' +If lFwh + Fwrite( nLinkHandle, "!ifndef FWH" + CRLF ) + Fwrite( nLinkHandle, "FWH = " + cfwhpath + CRLF ) + Fwrite( nLinkHandle, "!endif" + CRLF ) +Elseif lCw + Fwrite( nLinkHandle, "!ifndef C4H" + CRLF ) + Fwrite( nLinkHandle, "C4W =" + ccwpath + CRLF ) + Fwrite( nLinkHandle, "!endif" + CRLF ) +Endif +? 'Setting project name' +Fwrite( nLinkHandle, "PROJECT = " + Strtran( cTopfile, ".prg", ".exe" ) + CRLF ) +? 'Setting object files' +Fwrite( nLinkHandle, "OBJFILES = " +Strtran( cTopfile, ".prg", ".obj" ) ) +For x := 1 To Len( aobjs ) + If x <> Len( aobjs ) .and. aObjs[x]<>cTopfile + + Fwrite( nLinkHandle, " " + aobjs[ x ] ) + Else + Fwrite( nLinkHandle, " " + aobjs[ x ] + CRLF ) + Endif +Next + ? 'Setting C Files' +Fwrite( nLinkHandle, "CFILES = " +Strtran( cTopfile, ".prg", ".c" ) ) +For x := 1 To Len( acs ) + If x <> Len( acs ) .and. aCs[x]<>cTopfile + Fwrite( nLinkHandle, " " + aCs[ x ] ) + Else + Fwrite( nLinkHandle, " " + aCs[ x ] + CRLF ) + Endif +Next +? 'Setting ResFiles files' +Fwrite( nLinkHandle, "RESFILES = " + CRLF ) +Fwrite( nLinkHandle, "RESDEPEN = $(RESFILES)" + CRLF ) +if lRddads + cDefBccLibs+=" rddads.lib ace2.lib" +endif +if lBcc .or. lVcc + If lFwh + Fwrite( nLinkHandle, "LIBFILES = $(FWH)\lib\fiveh.lib $(FWH)\lib\fivec.lib " + cDefBccLibs + CRLF ) + elseif lCw + Fwrite( nLinkHandle, "LIBFILES = $(C4W)\c4wclass.lib $(C4W)\wbrowset.lib $(C4W)\otabt.lib $(C4W)\clip4win.lib" + cDefBccLibs + CRLF ) + else + Fwrite( nLinkHandle, "LIBFILES = " +cDefBccLibs + CRLF ) + endif +elseif lGcc + Fwrite( nLinkHandle, "LIBFILES = " +cDefgccLibs + CRLF ) +endif + Fwrite( nLinkHandle, "DEFFILE = "+CRLF) +if lBcc + Fwrite( nLinkHandle, "CFLAG1 = -OS $(CFLAGS) -d -L$(BHC)\lib\b32 -c"+CRLF) + Fwrite( nLinkHandle, "CFLAG2 = -I$(BHC)\include;$(BCB)\include" +CRLF) + Fwrite( nLinkHandle, "RFLAGS = "+CRLF) + Fwrite( nLinkHandle, "LFLAGS = -L$(BCB)\lib\obj;$(BCB)\lib;$(BHC)\lib;$(FWH)\lib -Gn -M -m -s" + if(lFwh,"-Tpe","")+CRLF) + Fwrite( nLinkHandle, "IFLAGS = " +CRLF) + Fwrite( nLinkHandle, "LINKER = ilink32"+CRLF) + Fwrite( nLinkHandle, " "+CRLF) + Fwrite( nLinkHandle, "ALLOBJ = " +if(lFwh,"c0w32.obj","c0x32.obj")+ "$(OBJFILES)"+CRLF) + Fwrite( nLinkHandle, "ALLRES = $(RESFILES)"+CRLF) + Fwrite( nLinkHandle, "ALLLIB = $(LIBFILES) import32.lib cw32.lib"+CRLF) + Fwrite( nLinkHandle, ".autodepend"+CRLF) +elseif lVcc + Fwrite( nLinkHandle, "CFLAG1 = -I$(INCLUDE_DIR) -TP -W3 -nologo $(C_USR) $(CFLAGS)"+CRLF) + Fwrite( nLinkHandle, "CFLAG2 = -c"+CRLF) + Fwrite( nLinkHandle, "RFLAGS = "+CRLF) + Fwrite( nLinkHandle, "LFLAGS = /LIBPATH:$(BCB)\lib;$(BHC)\lib;$(C4W)\lib /SUBSYSTEM:CONSOLE"+CRLF) + Fwrite( nLinkHandle, "IFLAGS = "+CRLF) + Fwrite( nLinkHandle, "LINKER = link"+CRLF) + Fwrite( nLinkHandle, " "+CRLF) + Fwrite( nLinkHandle, "ALLOBJ = "+if(lCw,"$(C4W)\initc.obj","")+"$(OBJFILES)"+CRLF) + Fwrite( nLinkHandle, "ALLRES = $(RESFILES)"+CRLF) + Fwrite( nLinkHandle, "ALLLIB = $(LIBFILES) comdlg32.lib shell32.lib user32.lib gdi32.lib"+CRLF) + +elseif lGcc + Fwrite( nLinkHandle, "CFLAG1 = "+if(at("linux",Getenv("HB_ARCHITECTURE"))>0 ,"-I$(HB_INC_INSTALL)"," -I$(BHC)/../include")+ " -c -Wall"+CRLF) + Fwrite( nLinkHandle, "CFLAG2 = "+if(at("linux",Getenv("HB_ARCHITECTURE"))>0 ,"-L$(HB_LIB_INSTALL)"," -L$(BHC)/../lib")+CRLF) + Fwrite( nLinkHandle, "RFLAGS = "+CRLF) + Fwrite( nLinkHandle, "LFLAGS = $(CFLAG2)"+CRLF) + Fwrite( nLinkHandle, "IFLAGS = "+CRLF) + Fwrite( nLinkHandle, "LINKER = gcc"+CRLF) + Fwrite( nLinkHandle, " "+CRLF) + Fwrite( nLinkHandle, "ALLOBJ = $(OBJFILES) "+CRLF) + Fwrite( nLinkHandle, "ALLRES = $(RESFILES) "+CRLF) + Fwrite( nLinkHandle, "ALLLIB = $(LIBFILES) "+CRLF) + Fwrite( nLinkHandle, ".autodepend"+CRLF) +Fwrite( nLinkHandle, " "+CRLF) +Fwrite( nLinkHandle, "#COMMANDS"+CRLF) + +For x:=1 to len(aCommands) + if lBcc + Fwrite( nLinkHandle, aCommands[x,1]+CRLF) + Fwrite( nLinkHandle, aCommands[x,2]+CRLF) + Fwrite( nLinkHandle, " "+CRLF) + elseif lVcc + Fwrite( nLinkHandle, aCommands[x,1]+CRLF) + Fwrite( nLinkHandle, aCommands[x,2]+CRLF) + Fwrite( nLinkHandle, " "+CRLF) + elseif lGcc + Fwrite( nLinkHandle, aCommands[x,1]+CRLF) + Fwrite( nLinkHandle, aCommands[x,2]+CRLF) + Fwrite( nLinkHandle, " "+CRLF) + endif +next +if lBcc + Fwrite( nLinkHandle, "#BUILD"+CRLF) + Fwrite( nLinkHandle, " "+CRLF) + Fwrite( nLinkHandle, "$(PROJECT): $(CFILES) $(OBJFILES) $(RESDEPEN) $(DEFFILE)"+CRLF) + Fwrite( nLinkHandle, " $(BCB)\BIN\$(LINKER) @&&!"+CRLF) + Fwrite( nLinkHandle, " $(LFLAGS) +"+CRLF) + Fwrite( nLinkHandle, " $(ALLOBJ), +"+CRLF) + Fwrite( nLinkHandle, " $(PROJECT),, +"+CRLF) + Fwrite( nLinkHandle, " $(ALLLIB), +"+CRLF) + Fwrite( nLinkHandle, " $(DEFFILE), +"+CRLF) + Fwrite( nLinkHandle, " $(ALLRES) "+CRLF) + Fwrite( nLinkHandle, "!"+CRLF) + + +elseif lVcc + Fwrite( nLinkHandle, "#BUILD"+CRLF) + Fwrite( nLinkHandle, ""+CRLF) + Fwrite( nLinkHandle, "$(PROJECT): $(CFILES) $(OBJFILES) $(RESDEPEN) $(DEFFILE)"+CRLF) + Fwrite( nLinkHandle, " $(BCB)\BIN\$(LINKER) @&&!"+CRLF) + Fwrite( nLinkHandle, " $(LFLAGS)"+CRLF) + Fwrite( nLinkHandle, " $(ALLOBJ) "+CRLF) + Fwrite( nLinkHandle, " $(PROJECT)"+CRLF) + Fwrite( nLinkHandle, " $(PROJECTMAP)"+CRLF) + Fwrite( nLinkHandle, " $(ALLLIB) "+CRLF) + Fwrite( nLinkHandle, " $(DEFFILE) "+CRLF) + Fwrite( nLinkHandle, " $(ALLRES) "+CRLF) + Fwrite( nLinkHandle, "!"+CRLF) + + +elseif lGcc + Fwrite( nLinkHandle, "#BUILD"+CRLF) + Fwrite( nLinkHandle, " "+CRLF) + Fwrite( nLinkHandle, "$(PROJECT): $(CFILES) $(OBJFILES) $(RESDEPEN) $(DEFFILE)"+CRLF) + Fwrite( nLinkHandle, " $(BCB)\$(LINKER) @&&!"+CRLF) + Fwrite( nLinkHandle, " $(PROJECT) "+CRLF) + Fwrite( nLinkHandle, " $(ALLOBJ) "+CRLF) + Fwrite( nLinkHandle, " $(LFLAGS) "+CRLF) + Fwrite( nLinkHandle, " $(ALLLIB) "+CRLF) + Fwrite( nLinkHandle, "!"+CRLF) +endif +endif + + +Return nil + +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +*+ Procedure ATTENTION() +*+ +*+ Called from ( hbmake.prg ) 4 - function crtmakfile() +*+ +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +Procedure ATTENTION( CSTRING, NLINENUM, CCOLOR ) + +Local COLDCOLOR + +Default NLINENUM To 24 +Default CCOLOR To 'GR+/R' + +COLDCOLOR := Setcolor( CCOLOR ) + +CSTRING := ' ' + Alltrim( CSTRING ) + ' ' + +Devpos( NLINENUM, c( CSTRING ) ) + +Devout( CSTRING ) + +Setcolor( COLDCOLOR ) + +Return + +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +*+ Function c() +*+ +*+ Called from ( hbmake.prg ) 1 - procedure attention() +*+ +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +Function c( CSTRING ) + +Return Max( ( Maxcol() / 2 ) - Int( Len( CSTRING ) / 2 ), 0 ) + +*+ EOF: HBMAKE.PRG diff --git a/harbour/utils/hbmake/pickarry.prg b/harbour/utils/hbmake/pickarry.prg new file mode 100644 index 0000000000..88f0c17923 --- /dev/null +++ b/harbour/utils/hbmake/pickarry.prg @@ -0,0 +1,143 @@ +/* + * $Id$ + */ + +*+²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²² +*+ +*+ Source Module => D:\SRC\PBMAKE\PICKARRY.PRG +*+ +*+ PBMake is a Clipper, C, ASM, Xbase++ make engine. +*+ +*+ Copyright(C) 1996-1999 by Phil Barnett. +*+ +*+ 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. +*+ +*+ 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. +*+ +*+ You can contact me at: +*+ +*+ Phil Barnett +*+ Box 944 +*+ Plymouth, Florida 32768 +*+ +*+ or +*+ +*+ philb@iag.net +*+ +*+ +*+ Functions: Function PICKARRY() +*+ Function Keys() +*+ +*+ Reformatted by Click! 2.03 on Mar-30-1999 at 11:19 pm +*+ +*+²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²² + +static someitems + +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +*+ Function PICKARRY() +*+ +*+ Called from ( makelink.prg ) 1 - function makelink() +*+ +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +function PICKARRY( T, L, b, r, IN_ARRAY, OUT_ARRAY ) + +local nChoice := 1 +local x +local NEW_ARRAY := {} +local NUM_ELEMS := len( IN_ARRAY ) +local PAD_LEN := ( r - 1 ) - ( L + 1 ) +local lIsChecked + +someitems := 0 + +putscreen() + +@ T - 1, L - 1 clear to b + 1, r + 1 +@ T - 1, L - 1 to b + 1, r + 1 double + +for x := 1 to NUM_ELEMS + IN_ARRAY[ X ] := padr( ' ' + IN_ARRAY[ X ], PAD_LEN ) + OUT_ARRAY[ X ] := ' ' + OUT_ARRAY[ X ] +next + +do while nChoice != 0 + nChoice := achoice( T, L , b , r , IN_ARRAY, , 'keys' , nChoice, 1 ) + + if nChoice > 0 + + lIsChecked := substr( IN_ARRAY[ nChoice ], 2, 1 ) == 'û' + + IN_ARRAY[ nChoice ] := stuff( IN_ARRAY[ nChoice ], 2, 1, if( lIsChecked, ' ', 'û' ) ) + OUT_ARRAY[ nChoice ] := stuff( OUT_ARRAY[ nChoice ], 1, 1, if( lIsChecked, ' ', 'û' ) ) + + if lIsChecked + SOMEITEMS -- + else + SOMEITEMS ++ + endif + + nChoice ++ + + endif + +enddo + +for x := 1 to NUM_ELEMS + if left( OUT_ARRAY[ X ], 1 ) == 'û' + aadd( NEW_ARRAY, substr( OUT_ARRAY[ X ], 2 ) ) + endif + IN_ARRAY[ X ] := substr( IN_ARRAY[ X ], 4 ) +next + +asize( OUT_ARRAY, len( NEW_ARRAY ) ) +acopy( NEW_ARRAY, OUT_ARRAY ) + +getscreen() + +return len( NEW_ARRAY ) + +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +*+ Function Keys() +*+ +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +function Keys( MODE ) + +local RETVAL := 2 +local THEKEY := lastkey() + +if MODE = 1 + keyboard chr( 30 ) +elseif MODE = 2 + keyboard chr( 31 ) +elseif MODE = 3 + if THEKEY = 32 + RETVAL := 1 + elseif THEKEY = 27 + RETVAL := 0 + elseif THEKEY = 13 .and. SOMEITEMS < 1 + RETVAL := 1 + keyboard chr( 13 ) + elseif THEKEY = 13 + keyboard chr( 24 ) + RETVAL := 0 + endif +endif + +return ( RETVAL ) + +*+ EOF: PICKARRY.PRG diff --git a/harbour/utils/hbmake/pickfile.prg b/harbour/utils/hbmake/pickfile.prg new file mode 100644 index 0000000000..4d7fa12127 --- /dev/null +++ b/harbour/utils/hbmake/pickfile.prg @@ -0,0 +1,120 @@ +/* + * $Id$ + */ + +*+²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²² +*+ +*+ Source Module => D:\SRC\PBMAKE\PICKFILE.PRG +*+ +*+ PBMake is a Clipper, C, ASM, Xbase++ make engine. +*+ +*+ Copyright(C) 1996-1999 by Phil Barnett. +*+ +*+ 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. +*+ +*+ 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. +*+ +*+ You can contact me at: +*+ +*+ Phil Barnett +*+ Box 944 +*+ Plymouth, Florida 32768 +*+ +*+ or +*+ +*+ philb@iag.net +*+ +*+ +*+ Functions: Function pickfile() +*+ +*+ Reformatted by Click! 2.03 on Mar-30-1999 at 11:19 pm +*+ +*+²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²² + +/* + PICKFILE.PRG + + Author : Phil Barnett + + Written : 18-Apr-93 + + Function : PICKFILE() + + Purpose : Generic file picking routine that pops a picklist of files. + + Syntax : PICKFILE( [FILESPEC] ) + + Parameters : FILESPEC is a DOS filename. Wildcards permitted + + Returns : Character file name of selected file or "" if nothing picked. + + Example : yourfile := pickfile( '*.dbf' ) + + if empty(yourfile) + ? 'You pressed Escape or No Matching File' + else + ? 'The file you selected is: '+yourfile + endif + + Released to Public Domain by Author. + +*/ + +#include "COMMON.CH" +#include "BOX.CH" +#include "DIRECTRY.CH" + +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +*+ Function pickfile() +*+ +*+ Called from ( makelink.prg ) 1 - function makelink() +*+ ( pbinit.prg ) 1 - procedure pbinit() +*+ +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +function pickfile( cFileSpec ) + +local cOldString := savescreen( 8, 19, 16, 61 ) +local aFiles := directory( cFileSpec ) +local aPickList := {} +local cRetVal := '' +local sel + +default cFileSpec to '*.*' + +dispbox( 8, 19, 16, 61, B_SINGLE + " ", "+W/R" ) + +if len( aFiles ) > 0 + + aeval( aFiles, { | xx | aadd( aPickList, ; + pad( xx[ F_NAME ], 13 ) + ; + str( xx[ F_SIZE ], 8 ) + ' ' + ; + dtoc( xx[ F_DATE ] ) + ' ' + ; + xx[ F_TIME ] ) } ) + + sel := achoice( 9, 20, 15, 60, aPickList ) + + cRetVal := iif( lastkey() == 27, '', aFiles[ sel, 1 ] ) + +else + + achoice( 9, 20, 15, 60, { "No files match " + cFileSpec } ) + +endif + +restscreen( 8, 19, 16, 61, cOldString ) + +return cRetVal + +*+ EOF: PICKFILE.PRG diff --git a/harbour/utils/hbmake/prb_stak.prg b/harbour/utils/hbmake/prb_stak.prg new file mode 100644 index 0000000000..09c8b734f3 --- /dev/null +++ b/harbour/utils/hbmake/prb_stak.prg @@ -0,0 +1,101 @@ +/* + * $Id$ + */ + +*+²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²² +*+ +*+ Source Module => D:\SRC\PBMAKE\PRB_STAK.PRG +*+ +*+ PBMake is a Clipper, C, ASM, Xbase++ make engine. +*+ +*+ Copyright(C) 1996-1999 by Phil Barnett. +*+ +*+ 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. +*+ +*+ 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. +*+ +*+ You can contact me at: +*+ +*+ Phil Barnett +*+ Box 944 +*+ Plymouth, Florida 32768 +*+ +*+ or +*+ +*+ philb@iag.net +*+ +*+ +*+ Functions: Procedure PUTSCREEN() +*+ Procedure GETSCREEN() +*+ +*+ Reformatted by Click! 2.03 on Mar-30-1999 at 11:19 pm +*+ +*+²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²² + +#include "COMMON.CH" +static SCR := {} +static CNT := 0 + +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +*+ Procedure PUTSCREEN() +*+ +*+ Called from ( pbinit.prg ) 4 - procedure pbinit() +*+ ( pickarry.prg ) 1 - function pickarry() +*+ +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +procedure PUTSCREEN( T, L, b, r ) + +default T to 0 +default L to 0 +default b to maxrow() +default r to maxcol() + +aadd( SCR, { T, L, b, r, savescreen( T, L, b, r ), row(), col(), set( _SET_CURSOR ), setcolor() } ) +CNT ++ + +return + +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +*+ Procedure GETSCREEN() +*+ +*+ Called from ( pbinit.prg ) 4 - procedure pbinit() +*+ ( pickarry.prg ) 1 - function pickarry() +*+ +*+ħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħħ +*+ +procedure GETSCREEN( OPTION ) + +default OPTION to 1 + +do case +case OPTION == 0 + CNT := 0 + SCR := {} +case OPTION == - 1 + asize( SCR, -- CNT ) +otherwise + if CNT > 0 + restscreen( SCR[ cnt, 1 ], SCR[ cnt, 2 ], SCR[ cnt, 3 ], SCR[ cnt, 4 ], SCR[ cnt, 5 ] ) + devpos( SCR[ cnt, 6 ], SCR[ cnt, 7 ] ) + set( _SET_CURSOR, SCR[ cnt, 8 ] ) + setcolor( SCR[ cnt, 9 ] ) + asize( SCR, -- CNT ) + endif +endcase + +return + +*+ EOF: PRB_STAK.PRG diff --git a/harbour/utils/hbmake/radiodef.ch b/harbour/utils/hbmake/radiodef.ch new file mode 100644 index 0000000000..b5afe01c6e --- /dev/null +++ b/harbour/utils/hbmake/radiodef.ch @@ -0,0 +1,10 @@ +/*** +* Radiodef.ch +* +* Definition of translates for simulated Radio button class. +*/ + +#translate :radioGsb => :cargo\[1\] +#translate :radioGets => :cargo\[2\] + +#define RADIO_NUM_IVARS 2 diff --git a/harbour/utils/hbmake/radios.ch b/harbour/utils/hbmake/radios.ch new file mode 100644 index 0000000000..882791cd99 --- /dev/null +++ b/harbour/utils/hbmake/radios.ch @@ -0,0 +1,17 @@ +/*** +* Radios.ch +* +* Header file for Radio button gets. +*/ + +// #define K_SPACE 32 +#define RADIO_BUTTON Chr(4) + +#command @ , GET ; + RADIO ; + ; + => ; + SetPos(, ) ; + ; RadioGets({|x| iif(x == NIL, , := x) }, ; + <(var)>, , GetList) ; + ; DrawRadios(GetList, Atail(GetList)) diff --git a/harbour/utils/hbmake/radios.prg b/harbour/utils/hbmake/radios.prg new file mode 100644 index 0000000000..dd75c4ff03 --- /dev/null +++ b/harbour/utils/hbmake/radios.prg @@ -0,0 +1,208 @@ + +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * radios.Prg radios gets for hbmake + * + * Copyright 2000 Luiz Rafael Culik + * 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 "Getexit.ch" +#include "InKey.ch" +#include "Radios.ch" + +#include "Radiodef.ch" + +FUNCTION RadioGets(bVar, cVar, aChoices, aGetList) + +LOCAL oGet +LOCAL nRow := Row(), nCol := Col() +LOCAL nGets := Len(aChoices) +LOCAL nGet +LOCAL nStartGet := Len(aGetList) + 1 + // For each element in aChoices + FOR nGet := 1 To nGets + + // Display ( ) before the get + DevPos(nRow, nCol) + DevOut("( ) ") + + // Create an empty get object and add it to the list + oGet := GetNew(nRow++,ncol+4,t(aChoices[nGet]),cvar) + Aadd(aGetList, oGet) + + oGet:cargo := Array(RADIO_NUM_IVARS) + + oGet:radioGsb := bVar + oGet:radioGets := Array(nGets) + + Aeval(oGet:radioGets, {|x, n| oGet:radioGets[n] := nStartGet + n - 1}) + + // Radio gets have their own reader, of course + oGet:reader := {|o| RadioReader(o, aGetList) } + oGet:display() + NEXT + +RETURN oGet + + +FUNCTION t(c) + +RETURN {|x| c } + + +// The reader for radio buttons +Proc RadioReader( oGet, aGetList ) + + // read the GET if the WHEN condition is satisfied + IF ( GetPreValidate(oGet) ) + // activate the GET for reading + oGet:SetFocus() + + DO WHILE ( oGet:exitState == GE_NOEXIT ) + // check for initial typeout (no editable positions) + IF ( oGet:typeOut ) + oGet:exitState := GE_ENTER + ENDIF + + // apply keystrokes until exit + DO WHILE ( oGet:exitState == GE_NOEXIT ) + RadioApplyKey(oGet, InKey(0), aGetList) + ENDDO + + // disallow exit if the VALID condition is not satisfied + IF ( !GetPostValidate(oGet) ) + oGet:exitState := GE_NOEXIT + ENDIF + ENDDO + + // de-activate the GET + oGet:KillFocus() + ENDIF + +RETURN + + +PROC RadioApplyKey(oGet, nKey, aGetList) + +LOCAL cKey +LOCAL bKeyBlock +LOCAL nSaveRow, nSaveCol + + // check for SET KEY first + IF ( (bKeyBlock := SetKey(nKey)) <> NIL ) + GetDoSetKey(bKeyBlock, oGet) + RETURN // NOTE + ENDIF + + DO CASE + CASE ( nKey == K_UP ) + oGet:exitState := GE_UP + + CASE ( nKey == K_SH_TAB ) + oGet:exitState := GE_UP + + CASE ( nKey == K_DOWN ) + oGet:exitState := GE_DOWN + + CASE ( nKey == K_TAB ) + oGet:exitState := GE_DOWN + + CASE ( nKey == K_ENTER ) + oGet:exitState := GE_ENTER + + CASE nKey == K_SPACE + // Toggle state of this radio button. If the get + // currently contains this radio button, clear it. + // If it does not, set it to that value + IF Eval(oGet:radioGsb) == Eval(oGet:block) + Eval(oGet:radioGsb, "") + ELSE + // This sets the real variable to the value + // of this radio button + Eval(oGet:radioGsb, Eval(oGet:block)) + ENDIF + + // Ensure Updated() gets set + oGet:changed := .T. + + // And redraw the getlist + DrawRadios(aGetlist, oGet) + + CASE ( nKey == K_ESC ) + IF ( Set(_SET_ESCAPE) ) + oGet:undo() + oGet:exitState := GE_ESCAPE + ENDIF + + CASE (nKey == K_PGUP ) + oGet:exitState := GE_WRITE + + CASE (nKey == K_PGDN ) + oGet:exitState := GE_WRITE + + CASE ( nKey == K_CTRL_HOME ) + oGet:exitState := GE_TOP + + // both ^W and ^End terminate the READ (the default) + CASE (nKey == K_CTRL_W) + oGet:exitState := GE_WRITE + + CASE (nKey == K_INS) + Set( _SET_INSERT, !Set(_SET_INSERT) ) + + ENDCASE + +RETURN + + +// Draw all radio buttons in aGetList to which the get object in +// oGet is attached +PROC DrawRadios(aGetList, oGet) + +LOCAL nRadios := Len(oGet:radioGets) +LOCAL oGet1 +LOCAL nSaveRow := Row() +LOCAL nSaveCol := Col() +LOCAL nGet + + FOR nGet := 1 TO nRadios + oGet1 := aGetList[oGet:radioGets[nGet]] + DevPos(oGet1:row, oGet1:col - 3) + IF Eval(oGet1:radioGsb) == Eval(oGet1:block) + DevOut(RADIO_BUTTON) + ELSE + DevOut(" ") + ENDIF + NEXT + + DevPos(nSaveRow, nSaveCol) + +RETURN