ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/PROG/PASCAL/CONV_P18.ZIP/TOKSTR18.PAS

Pascal/Delphi Source File | 1989-11-21 | 10.5 KB | 308 lines

Program Sort_Tok;
{ Reads in reserved word strings from one (or more) text files,
  breaks strings down into single words,
  builds all these words into a dynamic linked list of token records.
  Then concatenates these reserved word tokens into 255-char strings
  (or as near to 255 as we can come) (suitable for incorporation
  as typed constant arrays into a Pascal program),
  outputs to CONV_P.DAT.

  v1.8, 21 Nov 89
  - Got a suggestion from Dennis Essa (mrmarx![e-mail])
  "- Allow multiple 'token.inc' input files (even if it needed a global
     token count on the command line.  This would allow for easy segregation
     and upgrade of specific library and project token files."
    Yeah, we can do that.  UPCONV will have a new command line switch:
      /Ifilename.typ
      where the "/I" means include a token string file (followed by the
      name .. NO SPACE SEPARATOR!).
      Multiple include files are permitted.
    For THIS utility program, new command line requirement:
      The name(s) of the target TEXT file with reserved words.
      These files should be reserved words, separated by space(s) or tab(s),
      with CR/LF End-Of-Lines (EOL).
    Order of reserved words is not important for this program or UPCONV.
    We aren't doing sorting or alphabetizing for now.

    We're gonna use some functions from STRINGS.TPU (in the TPSTRING
    package) by
         Richard Winkel
         Route 1, box 193
         Harrisburg, MO.   65256

function words(S : String) : byte;
     Returns the number of (blank delimited) words in the string S.
     Ex: words('two four six      eight') returns 4.

function Werd(S : String; n : Byte) : String;
     Returns the N'th (blank delimited) word from the string S.
     The strange spelling is to avoid conflict with Tpas's WORD type.
     Ex: werd('two     air is humin',3) returns 'is'
         werd('two     air is humin',5) returns ''

function Uppercase(S : String) : String;
     Folds the argument S to uppercase.
     Ex: Uppercase('abcdef123') returns 'ABCDEF123'

function firstpos(FindStr, InStr : String; start : Byte) : Byte;
     This function was included for completeness.  It works exactly
     the same way as Turbo's built in POS function, except for the
     presence of the START option.  It is equivalent to:
     start-1+pos(findstr,copy(instr,start,length(instr)-start+1));
     except for being more efficient.
     Ex: firstpos('he','he was the best',15) returns 0.
         firstpos('he','he was the best',6) returns 9.
         firstpos('he','he was the best',0) returns 1.
         firstpos('he','he was the best',1) returns 1.

  v1.7
  - Stupid bug in concatenating a long string of tokens.
    Fixed.
  v1.6
  - Bug: Didn't initialize Tok string before building the string.
  - Adding line counter for final screen display.
  - Bumping length to full 255-char strings (was 80 char max),
    no quotes before/after string.
}

Uses Dos,Crt,Strings;

TYPE
  TokenStr = STRING[20];

  TokenPtr = ^Str_Rec;
  Str_Rec = RECORD
              S : TokenStr;
              next : Pointer;
            END;

VAR
  curr,                           {working token record ptr}
  Tokens: TokenPtr;               {pointer to first dynamic
                                   reserved word record}

{ Multiple cmdline parm/wildcard stuff }
CONST
  MAXARGS = 10;                         {change as you like}

TYPE
  PathStrPtr = ^PathStr;

VAR
  argv, argc : Byte;
  Args : ARRAY[1..MAXARGS]              {array of cmdline parm ptrs}
           OF PathStrPtr;               {STRING[79]}

  Dir : DirStr;                         {STRING[79]}
  Name: NameStr;                        {STRING[8]}
  Ext : ExtStr;                         {STRING[4]}

{SearchRec is declared in the Dos unit:}
(*
 TYPE SearchRec = RECORD
                    fill : ARRAY[1..21] OF Byte;
                    attr : Byte;
                    time : LongInt;
                    size : LongInt;
                    Name : STRING[12];
                  END;
*)
    SrchRec : SearchRec;

VAR
  TokenFile,           {input file of reserved words}
  DataFile : TEXT;     {our output file}
  Tok       : String;  {working 255-char output string}


PROCEDURE Usage;
  {Give user help, terminate.
   Happens on cmd line of '?', '-?', '/?', '-h', '/h', or empty.
  }
  BEGIN
    WRITELN(
'TOKSTR v1.8 - Convert file(s) of Pascal reserved words');
    WRITELN('to a single data file (CONV_P.DAT).');
    WRITELN(
'Usage:  TOKSTR file1.typ] [file2.typ ...] ');
    WRITELN('where file1.typ, file2.typ, etc. are target input filenames.');
    WRITELN(
'Formatted output will be CONV_P.DAT.');
    WRITELN('Wildcards may be used for target input filenames.');
    HALT(1);
  END;  {of Usage}


PROCEDURE Get_Args;
  {Process command line for all target reserved word filenames.
   Move them into a dynamic array of PathStrs (Args).
  }
  CONST
    HelpArgs : STRING[13] =
      ' -? -H /? /H ';
  VAR
    Ch : CHAR;
  BEGIN
    argc := ParamCount;
    IF (argc = 0)                       {no parms at all}
    OR (argc > MAXARGS)                 {or more than we can handle}
    THEN Usage;                         {display help, die}

    FOR argv := 1 TO argc DO BEGIN
      NEW(Args[argv]);
      Args[argv]^ := Uppercase(ParamStr(argv)); {snarf parm, (uppercased)}
    END;

    IF firstpos(' ' + Args[1]^ + ' ', HelpArgs, 1) <> 0   {-? -H, etc.}
    THEN Usage;                         {display help, die}

    argv := 0;                          {assume we start at 1}

  END;  {of Get_Args}


FUNCTION Open_File : BOOLEAN;
  {Works FindNext if appropriate, else uses a new Arg string.
   Returns TRUE or FALSE  per success/failure.
  }
  VAR
    FName : PathStr;
    Ok : BOOLEAN;
  BEGIN
    Open_File := FALSE;                {assume failure}

    IF SrchRec.Name = '' THEN BEGIN     {time for a new name}

      Inc(argv);                        {bump for first/next name}
      IF Args[argv] = NIL THEN Exit;    {all done, return FALSE}

      FSplit(Args[argv]^, Dir, Name, Ext);  {split up the new name}
      FName := Dir + Name + Ext;            {build new name}
      FindFirst(FName,ReadOnly OR Archive,SrchRec)  {first time thru}
    END
    ELSE FindNext(SrchRec);             {working a wildcard}

    Ok := (DosError = 0);               {from FindFirst or FindNext}
    IF NOT Ok THEN BEGIN                {not found}
      SrchRec.Name := '';               {Flag we need a new arg
                                         and FindFirst}
      Exit;                             {return FALSE}
    END;

    FName := Dir + SrchRec.Name;        {new name from FindFirst/FindNext}
    Args[argv]^ := FName;               {Update Args for outside display}

Writeln('Opening ', FName);

    Assign(TokenFile, FName);
    RESET(TokenFile);                   {open input file}

    Open_File := TRUE;                  {return TRUE}
  END;  {of Open_File}


PROCEDURE Add_To_Tokens;
  {Read in our file of reserved word strings.
   Add to our linked list of string records:
   We just do this for each target token file.
  }
  VAR
    p : TokenPtr;                       {working string record pointer}
    FileS : STRING;                     {working string}
    w,
    wordcnt : BYTE;                     {nr of words in working string}

  BEGIN
    WHILE NOT EOF(TokenFile) DO BEGIN   {read in all the strings}
      READLN(TokenFile,FileS);
      IF (FileS <> '')                  {skip blank lines}
      AND (FileS[1] <> ';')             {and not a comment line}
      THEN BEGIN
        wordcnt := words(FileS);          {nr of words in string}
        IF wordcnt <> 0                   {we got some}
        THEN FOR w := 1 TO wordcnt DO BEGIN
          curr^.S := Werd(FileS,w);       {bring in the string's w'th word}
          NEW(p);                         {allocate new token record}
          curr^.next := p;                {point current record to next one}
          curr := p;                      {bump to next token record}
        END;
      END;
    END;

    {$I-} CLOSE(TokenFile);  {$I+}      {close up}
    IF IOResult <> 0 THEN ;             {we don't care}

  END;  {of Add_To_Tokens}


PROCEDURE Build_Token_Array;
  {Find all target token files.
   Read in each one, adding its reserved word tokens
   to our dynamic token array.
  }
  BEGIN
    NEW(Tokens);                      {allocate first reserved string
                                         record}
    Tokens^.S := '';                  {build first string ptr}
    Tokens^.next := NIL;              {no next}

    curr := Tokens;                   {point to first string ptr}

{Now we go into our file loop.
 We continue until FindNext returns no more files.
 Get_Args set argv appropriately.
}

    SrchRec.Name := '';                 {clear for first file}

    WHILE (SrchRec.Name <> '')          {we're working a wildcard}
    OR (argv < argc)                    {no wildcard, but still got args}
    DO BEGIN

      IF Open_File                      {open Token InFile}
      THEN Add_To_Tokens;               {file open, add to token array}

    END;  {until all done}
    curr^.S := '';                      {last string is empty}
    curr^.next := NIL;                  {..and points nowhere}

  END;  {of Build_Token_Array}


BEGIN  {main}

  Get_Args;                   {get cmdline target text file names}
  Build_Token_Array;          {read in all token files,
                               building a dynamic array of tokens}

  IF curr = Tokens THEN BEGIN         {never read any}
    Writeln('No tokens were found!');
    Writeln('Aborting!');
    Halt(2);
  END;

  Assign(DataFile,'CONV_P.DAT');
  Rewrite(DataFile);

  Tok := '';                            {v1.6 Initialize Token string}
  curr := Tokens;                       {v1.8 point to first string ptr}

  {Remember, the LAST record has the "next" NIL ptr.
   It's actually a blank string.
  }
  WHILE curr^.next <> NIL DO BEGIN

    IF LENGTH(Tok) + LENGTH(curr^.S) < 253  {string isn't too long}
    THEN Tok := Tok + ' ' + curr^.S     {so continue to concatenate}
    ELSE BEGIN                          {string is max length}
      Writeln(DataFile,Tok,' ');        {write out the long string}
      Tok := ' ' + curr^.S;             {pick up that last token}
    END;
    curr := curr^.next;                 {point to next token record}
  END;

  IF Tok <> ''                          {if any remaining line}
  THEN Writeln(DataFile,Tok, ' ');      {write it out}
  Close(DataFile);
END.