Files
harbour-core/harbour/utils/hbdoc/hbdoc.prg
2000-03-22 12:39:13 +00:00

1109 lines
31 KiB
Plaintext

/*
* $Id$
*/
/*
* Harbour Project source code:
* HBDOC document Extractor
*
* Copyright 2000 Luiz Rafael Culik <culik@sl.conex.net>
* 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/).
*
*/
/*
* File......: HBDOC.PRG
* Author....: Luiz Rafael Culik
* Date......: $Date$
* Revision..: $Revision$
* Log file..: $Logfile: $
*
*
* Modification history:
* ---------------------
*
* V1.00
* 2000/01/05 Initial Version. Based on Leo Letendre FT_DOC
*
* 2000/01/06 Added the ProccAlso Function
*
* 2000/01/08 Fixed the Line between the Title and the Text
* Functions Description is now in font Arial size 12
* V1.01
* 2000/01/09 Added RTF Source output Format
*
* 2000/01/11 Remove the code to add the Author name and Source file
* Name to the output file.
*
* V1.02
* 2000/01/12 Added suport for WWW output Format
* Striped out the "<" and ">" delimeter for WWW outPut,
* since the "<>" are HTML Command delimeters
* Output files names are in lower case to Linux Compatibility
*
* 2000/01/13 Added the link for the HARBOUR GPL LICENSE
* 2000/01/14 Fixed a bug on generating the HTML file
* 2000/01/15 Strip out the for Norton guides controls characters
* when generating HTML and RTF output
*
* V1.03
* 2000/01/16 Added Code to generate Norton Guide Source code
*
* V1.04
* 2000/01/17 Added Code to generate TROFF files
* 2000/01/18 Added Cleanup procedure when Generating Norton Guide
*
* V1.05
* 2000/01/22 Added Code to generate OS2 IPF files
*
* V1.06
* 2000/01/25 Fixed some error that was not generating a valid RTF File
* Removed Call TO HB_OEMTOANSI() on the rountines to generate the .Ngi
* and Rtf files.
* Added support to generate the Docs from .Txt files, See doc\Subcodes.txt
* for header file.
*
* V1.07
* Added back the "<" and ">" symbols
* Fixed the links on the Harbour.htm file
* Fixed the help text when hbdoc is called with out any parameter
*/
#ifdef __HARBOUR__
#define NANFOR
#endif
#include "directry.ch"
#include "fileio.ch"
#include "inkey.ch"
#include 'hbdoc.ch'
// output lines on the screen
#define INFILELINE 10
#define MODULELINE 12
#define LINELINE 14
#define ERRORLINE 20
#define LONGLINE 78
#define LONGONELINE 66
// The delimiter
memvar aDirList
memvar aDocInfo
memvar aLinkInfo
memvar aAuthorList
memvar lAscii
memvar lContinuous
memvar lAuthor
memvar lRtf
memvar lNgi
memvar lOs2
memvar lWww
memvar lNorton
memvar aWWW
memvar lTroff
STATIC theHandle
/*
*/
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
*+ Function MAIN()
*+
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
FUNCTION MAIN( cFlags, cLinkName, cAtFile )
// LOCAL variables:
// NG/EH input
LOCAL aExtensions := { "*.ch","*.prg", "*.c", "*.asm" , "*.txt" }
LOCAL i
LOCAL j
LOCAL nItem,nHpj,nPos
LOCAL cCompiler // Compiler type
// Include norton compatable switch for EH
LOCAL lDone // Done with a loop
LOCAL cMi // Name params
LOCAL cLName // Name params
LOCAL cFName // Name params
LOCAL aName // Tokenized name
LOCAL nLen // Length of the token array
LOCAL oHtm
LOCAL cTemp
PUBLIC aDirList
PUBLIC aDocInfo := {}
PUBLIC aLinkInfo := {}
PUBLIC aAuthorList := {}
PUBLIC lAscii := .F. // Create ascii output instead of NG/EH input
PUBLIC lContinuous := .F. // Create continuous ascii output instead of
PUBLIC lAuthor := .T. // Include author in output of ascii output
PUBLIC lRtf := .F.
PUBLIC lNgi := .F.
PUBLIC lOs2 := .F.
PUBLIC lWww := .F.
PUBLIC lNorton := .F.
PUBLIC aWWW := {}
PUBLIC lTroff := .f.
// The following variables are used to allow one to change the delimiter
// around the keywords.
//
// Entry Point
//
mHIDE()
// Delete log file if present
IF FILE( "hbdocerr.log" )
DELETE FILE "hbdocerr.log"
ENDIF
// See if flag is there
IF .NOT. EMPTY( cFlags )
IF LEFT( cFlags, 1 ) == "-" .OR. LEFT( cFlags, 1 ) == "/"
IF ( cFlags := UPPER( RIGHT( cFlags, 3 ) ) ) == "TXT"
lAscii := .T.
lContinuous := .F.
ELSEIF cFlags = "HPC"
lNorton := .T.
ELSEIF cFlags = "NGI"
lNgi := .T.
ELSEIF cFlags = "OS2"
lOs2 := .T.
ELSEIF cFlags = "RTF"
lRtf := .T.
ELSEIF cFlags = "HTM"
lWww := .T.
ELSEIF cFlags = "TRF"
lTroff := .t.
ELSEIF cFlags = "DOC"
lAscii := .T.
lContinuous := .T.
lAuthor := .F.
ENDIF
ELSE
cAtFIle := cLinkName
cLinkName := cFlags
ENDIF
ENDIF
// Get the linkfile name and get the info in it
IF cLinkName = NIL
?? "Harbour Doc Extractor"
? "Copyright 1999-2000, http://www.harbour-project.org"
? ""
? "Syntax: hbdoc [options] <linkname> [<ifile>]"
? ""
? "Options: /txt Create an ASCII file instead of a Norton Guide"
? " /con Create an ASCII file without formfeeds"
? " /hpc Helpc source file"
? " /ngi Adds the -NG switch to EHC command for compile for"
? " DOS/Windows/Linux."
? " /rtf Winhelp source code for Windows"
? " /os2 OS/2 help source code For OS/2"
? " /htm Generate HTML output"
? " /trf Gerenate Linux TROFF code"
? " /doc Create continuous ASCII file w/o author information"
? " "
? "Notes: - Only one option can be specified at a time."
? " - <linkname> is the name of the Norton Guide Link file."
? " - <iFile> is a file containing a list of files to process"
? " otherwise *.prg, *.c, *.asm, *.ch and *.txt are used."
RETURN NIL
ENDIF
// check to see if input files are present
IF .NOT. FILE( cLinkName )
? "Link file Not Found:", cLinkName
RETURN NIL
ENDIF
IF .NOT. EMPTY( cAtFIle ) .AND. .NOT. FILE( cAtFile )
? "Indirect file Not Found:", cAtFile
RETURN NIL
ENDIF
CLEAR SCREEN
SET CURSOR OFF
cCompiler := fill_Link_info( cLinkName )
// See if ngi subdirectory is present
IF lNorton
IF EMPTY( DIRECTORY( "hdf.*", "D" ) )
FT_MKDIR( "hdf" )
ENDIF
ELSEIF lRtf
IF EMPTY( DIRECTORY( "rtf.*", "D" ) )
FT_MKDIR( "rtf" )
ENDIF
ELSEIF lWww
IF EMPTY( DIRECTORY( "htm.*", "D" ) )
FT_MKDIR( "htm" )
ENDIF
ELSEIF lNgi
IF EMPTY( DIRECTORY( "ngi.*", "D" ) )
FT_MKDIR( "ngi" )
ENDIF
ELSEIF lTroff
IF EMPTY( DIRECTORY( "tr.*", "D" ) )
FT_MKDIR( "tr" )
ENDIF
ELSEIF lOs2
IF EMPTY( DIRECTORY( "ipf.*", "D" ) )
FT_MKDIR( "ipf" )
ENDIF
ENDIF
IF cAtFile = NIL // use all files in directory
// Loop through each of the types of files
FOR i := 1 TO LEN( aExtensions )
// Get the list of
// aDirList=DIRECTORY(&cDir+aExtensions[i])
aDirList := DIRECTORY( aExtensions[ i ] )
// If there are any files then process them
IF LEN( aDirList ) > 0
IF lAscii
ASCIIFiles()
ELSEIF lNorton
ProcessFiles()
ELSEIF lRtf
ProcessRtf()
ELSEIF lWww
ProcessWww()
ELSEIF lNgi
ProcessiNg()
ELSEIF lTroff
ProcessTroff()
ELSEIF lOs2
ProcessOs2()
ENDIF
ENDIF
NEXT
ELSE
// an indirect file was given so read it and use it
aDirList := ReadAtFile( cAtFile )
// If there are any files then process them
IF LEN( aDirList ) > 0
IF lAscii
ASCIIFILES()
ELSEIF lNorton
ProcessFiles()
ELSEIF lRtf
ProcessRtf()
ELSEIF lWww
ProcessWww()
ELSEIF lNgi
ProcessiNg()
ELSEIF lTroff
ProcessTroff()
ELSEIF lOs2
ProcessOs2()
ENDIF
ENDIF
ENDIF
// Now build text files for norton compiler based upon link file
// first sort based upon category and filename. Not Fast but easy.
@ INFILELINE, 0 CLEAR TO INFILELINE, MAXCOL()
@ MODULELINE, 0 CLEAR TO MODULELINE, MAXCOL()
@ LINELINE, 0 CLEAR TO LINELINE, MAXCOL()
@ INFILELINE, 30 SAY "Sorting input files"
ASORT( aDocInfo,,, { | a, b | UPPER( a[ 1 ] + " " + a[ 2 ] ) < UPPER( b[ 1 ] + " " + b[ 2 ] ) } )
// Now actually build the info
@ INFILELINE, 0 CLEAR TO INFILELINE, MAXCOL()
IF lnorton
@ INFILELINE, 30 SAY "Assembling " + IIF( lAscii, "documentation", "HelpC" ) ;
+ " input files"
ELSEIF lRTF
@ INFILELINE, 30 SAY "Assembling " + IIF( lAscii, "documentation", "WINHELP" ) ;
+ " input files"
ELSEIF lWww
@ INFILELINE, 30 SAY "Assembling " + IIF( lAscii, "documentation", "Html" ) ;
+ " input files"
ELSEIF lNgi
@ INFILELINE, 30 SAY "Assembling " + IIF( lAscii, "documentation", "NG" ) ;
+ " input files"
ELSEIF lTroff
@ INFILELINE, 30 SAY "Assembling " + IIF( lAscii, "documentation", "TROFF" ) ;
+ " input files"
ENDIF
IF FILE( "assembl.bat" )
DELETE FILE "assembl.bat"
ENDIF
SET ALTERNATE TO "assembl.bat"
SET ALTERNATE ON
SET CONSOLE OFF
? "@Echo OFF"
? "ECHO Assembling input files"
IF lNorton
FOR i := 1 TO LEN( aDocInfo )
// Find match
nItem := ASCAN( aLinkInfo, { | a | UPPER( ALLTRIM( a[ 1 ] ) ) == UPPER( ALLTRIM( aDocInfo[ i, 1 ] ) ) } )
IF nItem > 0
IF i = 1 .OR. .NOT. ( ALLTRIM( aDocInfo[ i - 1, 1 ] ) == ALLTRIM( aDocInfo[ i, 1 ] ) )
// Make the first copy
? "ECHO Creating", aLinkinfo[ nItem, 2 ]
? "COPY hdf\" + ALLTRIM( aDocInfo[ i, 4 ] ) + " HarDoc.hdf > NUL"
ELSE
// This may be slow but I don't have to worry about line length
? "TYPE hdf\" + ALLTRIM( aDocInfo[ i, 4 ] ) + " >> HarDoc.hdf "
ENDIF
aLinkInfo[ nItem, 3 ] = .T.
ELSE
// Write the error message
SET ALTERNATE TO
SET ALTERNATE OFF
SET CONSOLE ON
write_error( "Category not found: " + aDocInfo[ i, 1 ],,,, aDocInfo[ i, 4 ] )
@ ERRORLINE, 0 CLEAR TO ERRORLINE, MAXCOL()
@ ERRORLINE, 20 SAY "Category not found: " + aDocInfo[ i, 1 ] + " in " + aDocInfo[ i, 4 ]
SET ALTERNATE TO "assembl.bat" ADDITIVE
SET ALTERNATE ON
SET CONSOLE OFF
ENDIF
NEXT
ELSEIF lRtf
nHpj := FCREATE( 'HARBOUR.HPJ' )
FWRITE( nHpj, '[OPTIONS]' + CRLF )
FWRITE(nHpj, 'HCW=1'+CRLF)
FWRITE( nHpj, 'COMPRESS=60 Hall Zeck' + CRLF )
FWRITE( nHpj, 'LCID=0x416 0x0 0x0 ;Português (brasileiro)'+CRLF)
FWRITE( nHpj, 'REPORT=Yes' + CRLF )
FWRITE( nHpj, 'CONTENTS=IDH_OVERVIEW' + CRLF )
FWRITE( nHpj, 'TITLE=Harbour Winhelp' + CRLF )
FWRITE( nHpj, 'COPYRIGHT=Harbour (C) http://www.harbour-project.org' + CRLF )
FWRITE( nHpj, 'HLP=.\harbour.hlp' + CRLF )
FWRITE( nHpj, 'ROOT=' + CURDIR() + "\RTF" + CRLF )
FWRITE( nHpj, 'CNT=.\Harbour.cnt'+CRLF)
FWRITE( nHpj, '[FILES]' + CRLF )
FWRITE( nHpj, "harbour.rtf"+CRLF)
FWRITE( nHpj, '[CONFIG]'+CRLF+'contents()'+CRLF+'prev()'+CRLF+'next()'+CRLF+'BrowseButtons()'+CRLF)
FWRITE( nHpj, '[WINDOWS]'+CRLF+'Commands="Harbour Commands",(653,102,360,600),20736,(r14876671),(r12632256),f3'+CRLF+'Error="Harbour Run Time Errors",(653,102,360,600),20736,(r14876671),(r12632256),f3'+CRLF+'Tools="Harbour Tools",(653,102,360,600),20736,(r14876671),(r12632256),f3'+CRLF+'Class="Harbour OOP Commands",(653,102,360,600),20736,(r14876671),(r12632256),f3'+CRLF+'Funca="Harbour Run Time Functions A-M",(653,102,360,600),20736,(r14876671),(r12632256),f3'+CRLF+'Funcn="Harbour Run Time Functions N-_",(653,102,360,600),20736,(r14876671),(r12632256),f3'+CRLF+'Main="HARBOUR",(117,100,894,873),60672,(r14876671),(r12632256),f3'+CRLF)
FCLOSE( nHpj )
ELSEIF lWWW
oHtm := THTML():New( "htm\harbour.htm" )
oHtm:WriteTitle( "Harbour Reference Guide" )
oHtm:WriteText("<H1>Harbour Reference Guide</H1>")
oHtm:WriteText( "<H2>HARBOUR</H2>"+hb_osnEwline()+'<UL>' )
oHtm:WriteLink( "overview",UpperLower("Harbour Read me" ))
oHtm:WriteLink( "license", UpperLower("Harbour License" ))
oHtm:WriteLink( "http://www.gnu.org/copyleft/gpl.html","GNU License" )
oHtm:WriteLink( "compileroptions.htm","Compiler Options")
oHtm:WriteText( "</UL>" )
oHtm:WriteText("<H2>Alphabetical list of functions</H2>")
oHtm:WriteText( "<UL>" )
ASORT( awww,,,{|x,y| x[1]<y[1] })
FOR nPos := 1 TO LEN( aWww )
cTemp := aWww[ nPos,1 ]
IF LEFT( cTemp, 1 ) >= "A" .AND. LEFT( cTemp, 1 ) < "N" .AND. AT( "()", cTemp ) > 0
oHtm:WriteLink( Lower(aWww[ nPos ,2]),UpperLower(aWww[nPos,1] ))
ENDIF
NEXT
FOR nPos := 1 TO LEN( aWww )
cTemp := aWww[ nPos,1 ]
IF LEFT( cTemp, 1 ) >= "N" .AND. LEFT( cTemp, 1 ) < "_" .AND. AT( "()", cTemp ) > 0
oHtm:WriteLink(Lower(aWww[ nPos ,2]),UpperLower(aWww[nPos,1] ) )
ENDIF
NEXT
oHtm:WriteText("</ul>")
oHtm:Writetext( "<h2>Commands</h2>" )
oHtm:WriteText("<UL>")
FOR nPos := 1 TO LEN( aWww )
cTemp := aWww[ nPos,1 ]
IF AT( "()", cTemp ) == 0 .AND. ctemp <> "LICENSE" .AND. cTemp <> "OVERVIEW" .and. cTemp<>"Compiler Options" ;
.AND. UPPER(Left(ctemp,4)) <>"BASE" .AND. UPPER(LEFT(cTemp,4))<>"TERM" .and. UPPER(LEFT(cTemp,5))<>"TOOLS"
oHtm:WriteLink( Lower(aWww[ nPos ,2]),UpperLower(aWww[nPos,1]))
ENDIF
NEXT
oHtm:WriteText("</ul>")
oHtm:WriteText( "<h2>Run Time Error</h2>" )
oHtm:WriteText("<ul>")
FOR nPos := 1 TO LEN( aWww )
cTemp := aWww[ nPos,1 ]
IF AT( "()", cTemp ) == 0 .And. UPPER(Left(ctemp,4)) =="BASE" .OR. UPPER(LEFT(cTemp,4))=="TERM" .OR. UPPER(LEFT(cTemp,5))=="TOOLS"
oHtm:WriteLink( Lower(aWww[ nPos ,2]),UpperLower(aWww[nPos,1]))
ENDIF
NEXT
oHtm:WriteText("</ul>")
oHtm:Close()
ELSEIF lNgi
SET ALTERNATE TO "assembl.bat" ADDITIVE
SET ALTERNATE ON
SET CONSOLE OFF
ENDIF
// Now assemble the output
IF .NOT. lAscii
? "REM Compile the sources"
? "Echo Compiling the sources"
IF lNorton
? "Helpc /W31 hardoc.hdf"
? "REM Link the files"
? "Echo Linking library"
? "hcw hardoc.hpj"
? " "
ELSEIF lRtf
? "REM Link the files"
? "Echo Linking library"
? "hcw harbour.hpj"
? " "
ELSEIF lNgi
? "Processing Input Files"
SET ALTERNATE TO
SET ALTERNATE OFF
SET CONSOLE ON
ProcNgiInput()
SET ALTERNATE TO "assembl.bat" ADDITIVE
SET ALTERNATE ON
SET CONSOLE OFF
? 'Copy ngi\overview.ngi .'
? 'Copy ngi\License.ngi .'
? 'Copy ngi\Funcam.txt .'
? 'Copy ngi\funcn_.txt .'
? 'copy ngi\comm.txt .'
? 'Compiling Sources'
? 'ngxc overview.ngi'
? 'ngxc license.ngi'
? 'ngxc funcam.txt'
? 'ngxc funcn_.txt '
? 'ngxc comm.txt'
? 'Linking the Guide'
? 'ngxl harbour.lnk'
? 'del ngi\*.*'
? 'del *.ngo'
ENDIF
@ INFILELINE, 0 CLEAR TO INFILELINE, MAXCOL()
@ INFILELINE, 30 SAY "Writing summary file"
ENDIF
SET ALTERNATE TO "hbdoc.log"
SET ALTERNATE ON
SET CONSOLE OFF
FOR i := 1 TO LEN( aDocInfo )
? PAD( aDocInfo[ i, 1 ], 15 ), PAD( aDocInfo[ i, 2 ], 15 ), PAD( aDocInfo[ i, 4 ], 15 )
NEXT
// Send out list of authors
@ INFILELINE, 0 CLEAR TO INFILELINE, MAXCOL()
@ INFILELINE, 30 SAY "Sorting Author file"
FOR i := 1 TO LEN( aAuthorList )
aName := ListAsArray( aAuthorList[ i, 1 ], " " )
nLen := 0
AEVAL( aName, { | a, b | nLen := IIF( !EMPTY( a ), b, nLen ) }, 1, LEN( aName ) )
IF nLen > 0
cFName := aName[ 1 ]
IF nLen > 1
// Middle initial
cMI := aName[ 2 ]
IF !( LEN( cMi ) = 1 .OR. ( LEN( cMi ) = 2 .AND. RIGHT( cMi, 1 ) = "." ) )
cMi := NIL
ENDIF
// Last name
cLName := ""
FOR j := IIF( !EMPTY( cMi ), 3, 2 ) TO nLen
cLname := ALLTRIM( cLName ) + " " + aName[ j ]
NEXT
cLName := LTRIM( cLName )
ENDIF
// Add to array
aAuthorList[ i, 3 ] = cLName + "," + cFname + IIF( !EMPTY( cMi ), " " + cMi, " " )
ENDIF
NEXT
// sort the list bring any CIS ID to the top so it gets printed out
ASORT( aAuthorList,,, { | a, b | IIF( UPPER( a[ 3 ] ) == UPPER( b[ 3 ] ), a[ 2 ] > b[ 2 ], ;
UPPER( a[ 3 ] ) < UPPER( b[ 3 ] ) ) } )
@ INFILELINE, 0 CLEAR TO INFILELINE, MAXCOL()
@ INFILELINE, 30 SAY "Writing Author file"
IF LEN( aAuthorList ) > 1
i := 2
lDone := .F.
DO WHILE !lDone
IF UPPER( ALLTRIM( aAuthorList[ i, 1 ] ) ) == UPPER( ALLTRIM( aAuthorList[ i - 1, 1 ] ) )
// Remove duplicate names but capture a CIS ID if we don't have one
IF EMPTY( aAuthorList[ i - 1, 2 ] ) .AND. !EMPTY( aAuthorList[ i, 2 ] )
aAuthorList[ i - 1, 2 ] = aAuthorList[ i, 2 ]
ENDIF
ADEL( aAuthorList, i )
ASIZE( aAuthorList, LEN( aAuthorList ) - 1 )
ELSE
i ++
ENDIF
lDone := ( i > LEN( aAuthorList ) )
ENDDO
ENDIF
// Now write it out
SET ALTERNATE TO "author.txt"
SET ALTERNATE ON
SET CONSOLE OFF
FOR i := 1 TO LEN( aAuthorList )
? " ", aAuthorList[ i, 1 ], IIF( !EMPTY( aAuthorList[ i, 2 ] ), "[" + aAuthorList[ i, 2 ] + "]", "" )
NEXT
SET CONSOLE ON
SET ALTERNATE OFF
SET ALTERNATE TO
mShow()
@ MAXROW(), 0 SAY "Execute ASSEMBL.BAT to compile and link Guides"
// Return to caller
RETURN NIL
// End of MAIN()
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, SUBSTR( cList, 1, nPos - 1 ) ) // Add a new element
cList := SUBSTR( cList, nPos + 1 )
ENDDO
AADD( aList, cList ) // Add final element
//
RETURN aList // Return the array
FUNCTION StripNgControls( cString )
LOCAL nPos
LOCAL lStriped := .f.
nPos := AT( "^b", cString )
IF nPos > 0
cString := SUBSTR( cString, nPos + 3 )
lStriped := .t.
ELSE
IF !lStriped
cString := cString
ENDIF
ENDIF
nPos := AT( "^b^", cString )
IF nPos > 0
cString := SUBSTR( cString, 1, nPos - 1 )
lStriped := .t.
ELSE
IF !lStriped
cString := cString
ENDIF
ENDIF
nPos := AT( "^CFE", cString )
IF nPos > 0
cString := SUBSTR( cString, nPos + 5 )
lStriped := .t.
ELSE
IF !lStriped
cString := cString
ENDIF
ENDIF
nPos := AT( "^a1f", cString )
IF nPos > 0
cString := SUBSTR( cString, nPos + 5 )
lStriped := .t.
ELSE
IF !lStriped
cString := cString
ENDIF
ENDIF
RETURN cString
#ifdef NANFOR
#define xReadBuffer 4096
/****
* FT_FUSE(cFile,nMode) ---> nHandle
* Open a File
*/
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
*+ Function ft_fuse()
*+
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
FUNCTION ft_fuse( cFile, nMode )
IF nMode == nil
nMode := 2
ENDIF
IF cFile == Nil
theHandle:close()
ENDIF
IF cFile <> Nil
IF nMode <> 0
theHandle := TFileRead():new( cFile ):open( nMode )
ELSE
theHandle := TFileRead():new( cFile ):open()
ENDIF
ENDIF
RETURN theHandle:nHan
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
*+ Function ft_FEOF()
*+
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
FUNCTION ft_FEOF()
LOCAL lRETURN := theHandle:lEOF
RETURN lRETURN
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
*+ Function FReadLn()
*+
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
FUNCTION FReadLn( nH, cLine )
// cline:= thehandle:readline()
// ENDIF
IF theHandle:MoreToRead()
cLine := theHandle:ReadLine()
ELSE
FSEEK( theHandle:nHan, 0, 0 )
theHandle:lEOF := .f.
cLine := theHandle:ReadLine()
ENDIF
RETURN cLine
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
*+ Function FT_FReadLn()
*+
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
FUNCTION FT_FReadLn()
LOCAL cBuffer := ''
cBuffer := FReadLn( theHandle:nHan, @cBuffer )
RETURN cBuffer
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
*+ Function FT_FGotop()
*+
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
FUNCTION FT_FGotop()
FSEEK( theHandle:nHan, 0, 0 )
RETURN NIL
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
*+ Function ft_fskip()
*+
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
FUNCTION ft_fskip( )
RETURN nil
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
*+ Function FT_MKDIR()
*+
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
FUNCTION FT_MKDIR( CDIR )
MAKEDIR( cdir )
RETURN nil
#ENDIF
FUNCTION StripFiles( cString )
//
// This routine and all accompaning database structures are
// Copyright (C) 1993 Leo J. Letendre. All rights reserved.
//
// Purpose: Determine the position of the first non-blank character
//
// Modification History:
// Version Date Who Notes
// V1.00 10/30/93 LJL Initial Version
//
// Calling parameters: cString - The string to remove filenames from
//
// Returns: <cString> with filenames removed
//
// Notes: For example: func.ngo:FUNC1() proc.ngo:PROC1()
// becomes: FUNC1() PROC1()
// -
// LOCAL variables:
LOCAL nColon // location of colon
LOCAL nSpace // location of space prior to colon
// Look for a colon
DO WHILE ( nColon := AT( ":", cString ) ) > 0
// find the space prior to it
nSpace := RAT( " ", LEFT( cString, nColon ) )
IF nSpace > 0
cString := STUFF( cString, nSpace + 1, nColon - nSpace, "" )
ELSE
cString := STUFF( cString, 1, nColon, "" )
ENDIF
ENDDO
RETURN cString
// End of StripFiles
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
*+ Function FirstNB()
*+
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
FUNCTION FirstNB( cString )
//
// This routine and all accompaning database structures are
// Copyright (C) 1992 Leo J. Letendre. All rights reserved.
//
// Purpose: Determine the position of the first non-blank character
//
// Modification History:
// Version Date Who Notes
// V1.00 10/10/92 LJL Initial Version
//
// Calling parameters: cString - The string to test
//
// Notes: None
// -
// LOCAL variables:
LOCAL nLen := LEN( cString )
LOCAL nReturn := 0
LOCAL i
//
// Entry Point
//
i := 1
IF !EMPTY( cString )
DO WHILE nReturn = 0 .AND. i < LEN( cString )
IF SUBSTR( cString, i, 1 ) != " "
nReturn := i
ELSE
i ++
ENDIF
ENDDO
ENDIF
RETURN nReturn
// End of file FirstNB
/***
* ListAsArray( <cList>, <cDelimiter> ) --> aList
* Convert a delimited string to an array
* Taken from Clipper supplied routines 1/2/90
*
*/
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
*+ Function ListAsArray()
*+
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
FUNCTION ListAsArray( cList, cDelimiter )
LOCAL nPos
LOCAL aList := {} // Define an empty array
IF cDelimiter = NIL
cDelimiter := ","
ENDIF
//
DO WHILE ( nPos := AT( cDelimiter, cList ) ) != 0
AADD( aList, '"' + SUBSTR( cList, 1, nPos - 1 ) + '"' ) // Add a new element
cList := SUBSTR( cList, nPos + 1 )
ENDDO
AADD( aList, '"' + cList + '"' ) // Add final element
//
RETURN aList // Return the array
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
*+ Function ReadLN()
*+
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
FUNCTION ReadLN( leof )
LOCAL cBuffer := ""
cBuffer := FT_FREADLN()
FT_FSKIP( 1 )
lEof := FT_FEOF()
RETURN cBuffer
// End of ReadLN
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
*+ Static Function ReadAtFile()
*+
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
FUNCTION ReadAtFile( cAtFile )
//
// This routine and all accompaning database structures are
// Copyright (C) 1992 Leo J. Letendre.
//
// Purpose: read in the users list of files to act on
//
// Modification History:
// Version Date Who Notes
// V1.00 1/1/92 LJL Initial Version
//
// Calling parameters: cAtFile - The name of the file containing a list of
// files to be processed
//
// Returns: an array containing information that looks like it came
// from DIRECTORY() but only has the name present.
//
// Notes:
// -
// LOCAL variables:
LOCAL aDirList := {}
LOCAL cBuffer
LOCAL lEof
LOCAL nCount := 0
//
// Entry Point
//
IF FT_FUSE( cAtFile ) <> NIL
// Read each line
lEof := .F.
DO WHILE .NOT. lEof
cBuffer := ALLTRIM( ReadLN( @lEof ) )
IF .NOT. EMPTY( cBuffer )
AADD( aDirList, ARRAY( F_LEN ) )
nCount ++
aDirList[ nCount, F_NAME ] = UPPER( cBuffer )
ENDIF
ENDDO
ENDIF
FT_FUSE()
RETURN aDirList
// End of ReadAtFile
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
*+ Static Function write_error()
*+
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
FUNCTION write_error( cDescrip, cBadLine, nLineCnt, nMax, cFile )
// This routine will send error messages to the error log - hbdocerr.log
//
// Calling parameters: cDesc - Description of info being written
// cBadLine - The offending line - IF NIL then just
// output cDesc and filename
// nLineCnt - The line number of the bad line
// nMax - The maximum length of the bad line
// cFile - The file currently being processed
//
// Returns: NIL
//
// Entry point
//
// Point output to the log file
SET ALTERNATE TO "hbdocerr.log" ADDITIVE
SET CONSOLE OFF
SET ALTERNATE ON
// Send out the output
IF cBadLine = NIL
? cDescrip, "in file", cFile
? " "
ELSE
? "Line too long in file", cFile, "at line", ALLTRIM( STR( nLineCnt, 10, 0 ) )
? "Reading", cDescrip, "information when line greater than", STR( nMax, 2, 0 ), "encountered:"
? cBadLine
? " "
ENDIF
// Turn off the log file and return
SET ALTERNATE OFF
SET CONSOLE ON
SET ALTERNATE TO
RETURN NIL
*+
FUNCTION fill_link_info( cLinkName )
//
// This routine and all accompaning database structures are
// Copyright (C) 1992 Leo J. Letendre.
//
// Purpose: read the link information to learn how to assemble database files
//
// Modification History:
// Version Date Who Notes
// V1.00 1/22/92 LJL Initial Version
// V1.01 4/25/92 LJL Get the compiler type based upon
// "object" file extension
//
// Calling parameters: cLinkName - The name of the link file
//
// Returns: cCompiler - The name of the compiler to use
//
// Notes: looks for the !menu command and then reads the lines after it to
// get the catagories and filenames associated with each.
// -
// LOCAL variables:
LOCAL cBuffer
LOCAL lEof
LOCAL cSpace
LOCAL cCategory
LOCAL cFile
LOCAL nReadHandle
LOCAL lMenuMode := .F. // Menu infomation being read
LOCAL lGetType := .T. // Get the compiled file type to determine complier
LOCAL cCompiler // Compiler Type
//
// Entry Point
//
nReadHandle := FT_FUSE( cLinkName )
lEof := .F.
DO WHILE .NOT. lEof
// Read a line
cBuffer := UPPER( ReadLN( @lEof ) )
// Does it have a !menu?
IF AT( "!MENU", cBuffer ) > 0
lMenuMode := .T.
cBuffer := UPPER( ReadLN( @lEof ) )
ELSEIF LEFT( cBuffer, 1 ) = "!"
lMenuMode := .F.
ENDIF
// If we are in menu mode and the line has information on it then parse it
cBuffer := ALLTRIM( cBuffer )
IF .NOT. EMPTY( cBuffer ) .AND. lMenuMode
cSpace := AT( " ", cBuffer )
cCategory := UPPER( RTRIM( LEFT( cBuffer, cSpace - 1 ) ) )
cFile := UPPER( LTRIM( SUBSTR( cBuffer, cSpace ) ) )
IF lGetType
cCompiler := IIF( ".NGO" $ cFile, "NGXC", "EHC" )
lGetType := .NOT. ( ".NGO" $ cFile .OR. "EHO" $ cFile )
ENDIF
cFile := STRTRAN( cFile, IIF( cCompiler = "NGXC", ".NGO", ".EHO" ), ".TXT" )
AADD( aLinkInfo, { cCategory, cFile, .F. } )
ENDIF
ENDDO
// Close the file
FT_FUSE()
// Return to caller
RETURN cCompiler