tvhc.pas

还是一个词法分析程序

{************************************************}
{                                                }
{   Turbo Vision Demo                            }
{   Copyright (c) 1992 by Borland International  }
{                                                }
{************************************************}

{===== TVHC version 1.1 ================================================}
{  Turbo Vision help file compiler documentation.                       }
{=======================================================================}
{                                                                       }
{    Refer to DEMOHELP.TXT for an example of a help source file.        }
{                                                                       }
{    This program takes a help script and produces a help file (.HLP)   }
{    and a help context file (.PAS).  The format for the help file is   }
{    very simple.  Each context is given a symbolic name (i.e FileOpen) }
{    which is then put in the context file (i.e. hcFileOpen).  The text }
{    following the topic line is put into the help file.  Since the     }
{    help file can be resized, some of the text will need to be wrapped }
{    to fit into the window.  If a line of text is flush left with      }
{    no preceeding white space, the line will be wrapped.  All adjacent }
{    wrappable lines are wrapped as a paragraph.  If a line begins with }
{    a space it will not be wrapped. For example, the following is a    }
{    help topic for a File|Open menu item.                              }
{                                                                       }
{       |.topic FileOpen                                                }
{       |  File|Open                                                    }
{       |  ---------                                                    }
{       |This menu item will bring up a dialog...                       }
{                                                                       }
{    The "File|Open" will not be wrapped with the "----" line since     }
{    they both begin with a space, but the "This menu..." line will     }
{    be wrapped.                                                        }
{      The syntax for a ".topic" line is:                               }
{                                                                       }
{        .topic symbol[=number][, symbol[=number][...]]                 }
{                                                                       }
{    Note a topic can have multiple symbols that define it so that one  }
{    topic can be used by multiple contexts.  The number is optional    }
{    and will be the value of the hcXXX context in the context file     }
{    Once a number is assigned all following topic symbols will be      }
{    assigned numbers in sequence.  For example,                        }
{                                                                       }
{       .topic FileOpen=3, OpenFile, FFileOpen                          }
{                                                                       }
{    will produce the follwing help context number definitions,         }
{                                                                       }
{        hcFileOpen  = 3;                                               }
{        hcOpenFile  = 4;                                               }
{        hcFFileOpen = 5;                                               }
{                                                                       }
{    Cross references can be imbedded in the text of a help topic which }
{    allows the user to quickly access related topics.  The format for  }
{    a cross reference is as follows,                                   }
{                                                                       }
(*        {text[:alias]}                                               *)
{                                                                       }
{    The text in the brackets is highlighted by the help viewer.  This  }
{    text can be selected by the user and will take the user to the     }
{    topic by the name of the text.  Sometimes the text will not be     }
{    the same as a topic symbol.  In this case you can use the optional }
{    alias syntax.  The symbol you wish to use is placed after the text }
{    after a ':'. The following is a paragraph of text using cross      }
{    references,                                                        }
{                                                                       }
(*      |The {file open dialog:FileOpen} allows you specify which      *)
{       |file you wish to view.  If it also allow you to navigate       }
{       |directories.  To change to a given directory use the           }
(*      |{change directory dialog:ChDir}.                              *)
{                                                                       }
{    The user can tab or use the mouse to select more information about }
{    the "file open dialog" or the "change directory dialog". The help  }
{    compiler handles forward references so a topic need not be defined }
{    before it is referenced.  If a topic is referenced but not         }
{    defined, the compiler will give a warning but will still create a  }
{    useable help file.  If the undefined reference is used, a message  }
{    ("No help available...") will appear in the help window.           }
{=======================================================================}

program TVHC;

{$S-}

{$M 8192,8192,655360}

uses Drivers, Objects, Dos, Strings, HelpFile;

{ If you get a FILE NOT FOUND error when compiling this program
  from a DOS IDE, change to the \BP\EXAMPLES\DOS\TVDEMO directory
  (use File|Change dir).

  This will enable the compiler to find all of the units used by
  this program.
}

{======================= File Management ===============================}

procedure Error(Text: String); forward;

type
  PProtectedStream = ^TProtectedStream;
  TProtectedStream = object(TBufStream)
    FileName: FNameStr;
    Mode: Word;
    constructor Init(AFileName: FNameStr; AMode, Size: Word);
    destructor Done; virtual;
    procedure Error(Code, Info: Integer); virtual;
  end;

var
  TextStrm,
  SymbStrm: TProtectedStream;

const
  HelpStrm: PProtectedStream = nil;

constructor TProtectedStream.Init(AFileName: FNameStr; AMode, Size: Word);
begin
  inherited Init(AFileName, AMode, Size);
  FileName := AFileName;
  Mode := AMode;
end;

destructor TProtectedStream.Done;
var
  F: File;
begin
  inherited Done;
  if (Mode = stCreate) and ((Status <> stOk) or (ExitCode <> 0)) then
  begin
    Assign(F, FileName);
    Erase(F);
  end;
end;

procedure TProtectedStream.Error(Code, Info: Integer);
begin
  case Code of
    stError:
      TVHC.Error('Error encountered in file ' + FileName);
    stInitError:
      if Mode = stCreate then
        TVHC.Error('Could not create ' + FileName)
      else
        TVHC.Error('Could not find ' + FileName);
    stReadError: Status := Code; {EOF is "ok"}
    stWriteError:
      TVHC.Error('Disk full encountered writting file '+ FileName);
  else
      TVHC.Error('Internal error.');
  end;
end;

{----- UpStr(Str) ------------------------------------------------------}
{  Returns a string with Str uppercased.				}
{-----------------------------------------------------------------------}

function UpStr(Str: String): String;
var
  I: Integer;
begin
  for I := 1 to Length(Str) do
    Str[I] := UpCase(Str[I]);
  UpStr := Str;
end;

{----- ReplaceExt(FileName, NExt, Force) -------------------------------}
{  Replace the extension of the given file with the given extension.    }
{  If the an extension already exists Force indicates if it should be   }
{  replaced anyway.                                                     }
{-----------------------------------------------------------------------}

function ReplaceExt(FileName: PathStr; NExt: ExtStr; Force: Boolean):
  PathStr;
var
  Dir: DirStr;
  Name: NameStr;
  Ext: ExtStr;
begin
  FileName := UpStr(FileName);
  FSplit(FileName, Dir, Name, Ext);
  if Force or (Ext = '') then
    ReplaceExt := Dir + Name + NExt else
    ReplaceExt := FileName;
end;

{----- FExist(FileName) ------------------------------------------------}
{  Returns true if the file exists false otherwise.                     }
{-----------------------------------------------------------------------}

function FExists(FileName: PathStr): Boolean;
var
  F: file;
  Attr: Word;
begin
  Assign(F, FileName);
  GetFAttr(F, Attr);
  FExists := DosError = 0;
end;


{======================== Line Management ==============================}

{----- GetLine(S) ------------------------------------------------------}
{  Return the next line out of the stream.                              }
{-----------------------------------------------------------------------}

const
  Line: String = '';
  LineInBuffer: Boolean = False;
  Count: Integer = 0;

function GetLine(var S: TStream): String;
var
  C, I: Byte;
begin
  if S.Status <> stOk then
  begin
    GetLine := #26;
    Exit;
  end;
  if not LineInBuffer then
  begin
    Line := '';
    C := 0;
    I := 0;
    while (Line[I] <> #13) and (I < 254) and (S.Status = stOk) do
    begin
      Inc(I);
      S.Read(Line[I], 1);
    end;
    Dec(I);
    S.Read(C, 1); { Skip #10 }
    Line[0] := Char(I);
  end;
  Inc(Count);

  { Return a blank line if the line is a comment }
  if Line[1] = ';' then Line[0] := #0;

  GetLine := Line;
  LineInBuffer := False;
end;

{----- UnGetLine(S) ----------------------------------------------------}
{  Return given line into the stream.                                   }
{-----------------------------------------------------------------------}

procedure UnGetLine(S: String);
begin
  Line := S;
  LineInBuffer := True;
  Dec(Count);
end;

{========================= Error routines ==============================}

{----- PrntMsg(Text) ---------------------------------------------------}
{  Used by Error and Warning to print the message.                      }
{-----------------------------------------------------------------------}

procedure PrntMsg(Pref: String; var Text: String);
const
  Blank: String[1] = '';
var
  S: String;
  L: array[0..3] of LongInt;
begin
  L[0] := LongInt(@Pref);
  if HelpStrm <> nil then
    L[1] := LongInt(@HelpStrm^.FileName)
  else
    L[1] := LongInt(@Blank);
  L[2] := Count;
  L[3] := LongInt(@Text);
  if Count > 0 then FormatStr(S, '%s: %s(%d): %s'#13#10, L)
  else FormatStr(S, '%s: %s %3#%s', L);
  PrintStr(S);
end;

{----- Error(Text) -----------------------------------------------------}
{  Used to indicate an error.  Terminates the program                   }
{-----------------------------------------------------------------------}

procedure Error(Text: String);
begin
  PrntMsg('Error', Text);
  Halt(1);
end;

{----- Warning(Text) ---------------------------------------------------}
{  Used to indicate an warning.                                         }
{-----------------------------------------------------------------------}

procedure Warning(Text: String);
begin
  PrntMsg('Warning', Text);
end;

{================ Built-in help context number managment ===============}

type
  TBuiltInContext = record
    Text: PChar;
    Number: Word;
  end;

{ A list of all the help contexts defined in APP }
const
  BuiltInContextTable: array[0..21] of TBuiltInContext = (
    (Text: 'Cascade';   Number: $FF21),
    (Text: 'ChangeDir'; Number: $FF06),
    (Text: 'Clear';     Number: $FF14),
    (Text: 'Close';     Number: $FF27),
    (Text: 'CloseAll';  Number: $FF22),
    (Text: 'Copy';      Number: $FF12),
    (Text: 'Cut';       Number: $FF11),
    (Text: 'DosShell';  Number: $FF07),
    (Text: 'Dragging';  Number: 1),
    (Text: 'Exit';      Number: $FF08),
    (Text: 'New';       Number: $FF01),
    (Text: 'Next';      Number: $FF25),
    (Text: 'Open';      Number: $FF02),
    (Text: 'Paste';     Number: $FF13),
    (Text: 'Prev';      Number: $FF26),
    (Text: 'Resize';    Number: $FF23),
    (Text: 'Save';      Number: $FF03),
    (Text: 'SaveAll';   Number: $FF05),
    (Text: 'SaveAs';    Number: $FF04),
    (Text: 'Tile';      Number: $FF20),
    (Text: 'Undo';      Number: $FF10),
    (Text: 'Zoom';      Number: $FF24)
    );

function IsBuiltInContext(Text: String; var Number: Word): Boolean;
var
  Hi, Lo, Mid, Cmp: Integer;
begin
  { Convert Text into a #0 terminted PChar }
  Inc(Text[0]);
  Text[Length(Text)] := #0;

  Hi := High(BuiltInContextTable);
  Lo := Low(BuiltInContextTable);
  while Lo <= Hi do
  begin
    Mid := (Hi + Lo) div 2;
    Cmp := StrComp(@Text[1], BuiltInContextTable[Mid].Text);
    if Cmp > 0 then
      Lo := Mid + 1
    else if Cmp < 0 then
      Hi := Mid - 1
    else
    begin
      Number := BuiltInContextTable[Mid].Number;
      IsBuiltInContext := True;
      Exit;
    end;
  end;
  IsBuiltInContext := False;
end;

{====================== Topic Reference Management =====================}

type
  PFixUp = ^TFixUp;
  TFixUp = record
    Pos: LongInt;
    Next: PFixUp;
  end;

  PReference = ^TReference;
  TReference = record
    Topic: PString;
    case Resolved: Boolean of