tvhc.pas

还是一个词法分析程序

procedure ScanForCrossRefs(var Line: String);
var
  I, BegPos, EndPos, Alias: Integer;
const
  BegXRef = '{';
  EndXRef = '}';
  AliasCh = ':';

procedure AddXRef(XRef: String; Offset: Integer; Length: Byte);
var
  P: PCrossRefNode;
  PP: ^PCrossRefNode;
begin
  New(P);
  P^.Topic := NewStr(XRef);
  P^.Offset := Offset;
  P^.Length := Length;
  P^.Next := nil;
  PP := @XRefs;
  while PP^ <> nil do
    PP := @PP^^.Next;
  PP^ := P;
end;

procedure ReplaceSpacesWithFF(var Line: String; Start: Integer;
  Length: Byte);
var
  I: Integer;
begin
  for I := Start to Start + Length do
    if Line[I] = ' ' then Line[I] := #$FF;
end;

begin
  I := 1;
  repeat
    BegPos := Pos(BegXRef, Copy(Line, I, 255));
    if BegPos = 0 then I := 0
    else
    begin
      Inc(I, BegPos);
      if Line[I] = BegXRef then
      begin
        Delete(Line, I, 1);
        Inc(I);
      end
      else
      begin
        EndPos := Pos(EndXRef, Copy(Line, I, 255));
        if EndPos = 0 then
        begin
          Error('Unterminated topic reference.');
          Inc(I);
        end
        else
        begin
          Alias := Pos(AliasCh, Copy(Line, I, 255));
          if (Alias = 0) or (Alias > EndPos) then
            AddXRef(Copy(Line, I, EndPos - 1), Offset + Ofs + I - 1, EndPos - 1)
          else
          begin
            AddXRef(Copy(Line, I + Alias, EndPos - Alias - 1),
              Offset + Ofs + I - 1, Alias - 1);
            Delete(Line, I + Alias - 1, EndPos - Alias);
            EndPos := Alias;
          end;
          ReplaceSpacesWithFF(Line, I, EndPos-1);
          Delete(Line, I + EndPos - 1, 1);
          Delete(Line, I - 1, 1);
          Inc(I, EndPos - 2);
        end;
      end;
    end;
  until I = 0;
end;

function IsEndParagraph: Boolean;
begin
  IsEndParagraph :=
     (Line = '') or
     (Line[1] = CommandChar) or
     (Line = #26) or
     ((Line[1] =  ' ') and (State = Wrapping)) or
     ((Line[1] <> ' ') and (State = NotWrapping));
end;

begin
  Ofs := 0;
  ReadParagraph := nil;
  State := Undefined;
  Line := GetLine(TextFile);
  while Line = '' do
  begin
    AddToBuffer(Line, State = Wrapping);
    Line := GetLine(TextFile);
  end;

  if IsEndParagraph then
  begin
    ReadParagraph := nil;
    UnGetLine(Line);
    Exit;
  end;
  while not IsEndParagraph do
  begin
    if State = Undefined then
      if Line[1] = ' ' then State := NotWrapping
      else State := Wrapping;
    ScanForCrossRefs(Line);
    AddToBuffer(Line, State = Wrapping);
    Line := GetLine(TextFile);
  end;
  UnGetLine(Line);
  GetMem(P, SizeOf(P^) + Ofs);
  P^.Size := Ofs;
  P^.Wrap := State = Wrapping;
  Move(Buffer, P^.Text, Ofs);
  Inc(Offset, Ofs);
  ReadParagraph := P;
end;

{----- ReadTopic -------------------------------------------------------}
{ Read a topic from the source file and write it to the help file       }
{-----------------------------------------------------------------------}
var
  XRefs: PCrossRefNode;

procedure HandleCrossRefs(var S: TStream; XRefValue: Integer); far;
var
  P: PCrossRefNode;
begin
  P := XRefs;
  while XRefValue > 1 do
  begin
    if P <> nil then P := P^.Next;
    Dec(XRefValue);
  end;
  if P <> nil then RecordReference(P^.Topic^, S);
end;

procedure ReadTopic(var TextFile: TStream; var HelpFile: THelpFile);
var
  Line: String;
  P: PParagraph;
  Topic: PHelpTopic;
  TopicDef: PTopicDefinition;
  I, J, Offset: Integer;
  Ref: TCrossRef;
  RefNode: PCrossRefNode;

procedure SkipBlankLines(var S: TStream);
var
  Line: String;
begin
  Line := '';
  while Line = '' do
    Line := GetLine(S);
  UnGetLine(Line);
end;

function XRefCount: Integer;
var
  I: Integer;
  P: PCrossRefNode;
begin
  I := 0;
  P := XRefs;
  while P <> nil do
  begin
    Inc(I);
    P := P^.Next;
  end;
  XRefCount := I;
end;

procedure DisposeXRefs(P: PCrossRefNode);
var
  Q: PCrossRefNode;
begin
  while P <> nil do
  begin
    Q := P;
    P := P^.Next;
    if Q^.Topic <> nil then DisposeStr(Q^.Topic);
    Dispose(Q);
  end;
end;

procedure RecordTopicDefinitions(P: PTopicDefinition);
begin
  while P <> nil do
  begin
    ResolveReference(P^.Topic^, P^.Value, HelpFile.Stream^);
    HelpFile.RecordPositionInIndex(P^.Value);
    P := P^.Next;
  end;
end;

begin
  { Get Screen command }
  SkipBlankLines(TextFile);
  Line := GetLine(TextFile);

  TopicDef := TopicHeader(Line);

  Topic := New(PHelpTopic, Init);

  { Read paragraphs }
  XRefs := nil;
  Offset := 0;
  P := ReadParagraph(TextFile, XRefs, Offset);
  while P <> nil do
  begin
    Topic^.AddParagraph(P);
    P := ReadParagraph(TextFile, XRefs, Offset);
  end;

  I := XRefCount;
  Topic^.SetNumCrossRefs(I);
  RefNode := XRefs;
  for J := 1 to I do
  begin
    Ref.Offset := RefNode^.Offset;
    Ref.Length := RefNode^.Length;
    Ref.Ref := J;
    Topic^.SetCrossRef(J, Ref);
    RefNode := RefNode^.Next;
  end;

  RecordTopicDefinitions(TopicDef);

  CrossRefHandler := HandleCrossRefs;
  HelpFile.PutTopic(Topic);

  if Topic <> nil then Dispose(Topic, Done);
  if TopicDef <> nil then Dispose(TopicDef, Done);
  DisposeXRefs(XRefs);

  SkipBlankLines(TextFile);
end;

{----- WriteSymbFile ---------------------------------------------------}
{ Write the .PAS file containing all screen titles as constants.        }
{-----------------------------------------------------------------------}

procedure WriteSymbFile(var SymbFile: TProtectedStream);
const
  HeaderText1 =
    'unit ';
  HeaderText2 =
    ';'#13#10 +
    #13#10 +
    'interface'#13#10 +
    #13#10 +
    'const'#13#10 +
    #13#10;
  FooterText =
    #13#10 +
    'implementation'#13#10 +
    #13#10 +
    'end.'#13#10;
  Header1: array[1..Length(HeaderText1)] of Char = HeaderText1;
  Header2: array[1..Length(HeaderText2)] of Char = HeaderText2;
  Footer: array[1..Length(FooterText)] of Char = FooterText;
var
  I, Count: Integer;
  Dir: DirStr;
  Name: NameStr;
  Ext: ExtStr;

procedure DoWriteSymbol(P: PReference); far;
var
  L: array[0..1] of LongInt;
  Line: String;
  I: Word;
begin
  if (P^.Resolved) then
  begin
    if not IsBuiltInContext(P^.Topic^, I) then
    begin
      L[0] := LongInt(P^.Topic);
      L[1] := P^.Value;
      FormatStr(Line, '  hc%-20s = %d;'#13#10, L);
      SymbFile.Write(Line[1], Length(Line));
    end
  end
  else Warning('Unresolved forward reference "' + P^.Topic^ + '"');
end;

begin
  SymbFile.Write(Header1, SizeOf(Header1));
  FSplit(SymbFile.FileName, Dir, Name, Ext);
  SymbFile.Write(Name[1], Length(Name));
  SymbFile.Write(Header2, SizeOf(Header2));

  RefTable^.ForEach(@DoWriteSymbol);

  SymbFile.Write(Footer, SizeOf(Footer));
end;

{----- ProcessText -----------------------------------------------------}
{ Compile the given stream, and output a help file.                     }
{-----------------------------------------------------------------------}

procedure ProcessText(var TextFile, HelpFile, SymbFile: TProtectedStream);
var
  HelpRez: THelpFile;
begin
  HelpRez.Init(@HelpFile);
  while TextFile.Status = stOk do
    ReadTopic(TextFile, HelpRez);
  WriteSymbFile(SymbFile);
  HelpRez.Done;
end;

{========================== Program Block ==========================}

var
  TextName,
  HelpName,
  SymbName: PathStr;

procedure ExitClean; far;
begin
  { Print a message if an out of memory error encountered }
  if ExitCode = 201 then
  begin
    Writeln('Error: Out of memory.');
    ErrorAddr := nil;
    ExitCode := 1;
  end;

  { Clean up files }
  TextStrm.Done;
  SymbStrm.Done;
end;

begin
  { Banner messages }
  PrintStr('Help Compiler  Version 1.1  Copyright (c) 1992 Borland International.'#13#10);
  if ParamCount < 1 then
  begin
    PrintStr(
      #13#10 +
      '  Syntax:  TVHC <Help text>[.TXT] [<Help file>[.HLP] [<Symbol file>[.PAS]]'#13#10 +
      #13#10+
      '     Help text   = Help file source'#13#10 +
      '     Help file   = Compiled help file'#13#10 +
      '     Symbol file = A Pascal file containing all the screen names as CONST''s'#13#10);
    Halt(0);
  end;

  { Calculate file names }
  TextName := ReplaceExt(ParamStr(1), '.TXT', False);
  if not FExists(TextName) then
    Error('File "' + TextName + '" not found.');
  if ParamCount >= 2 then
    HelpName := ReplaceExt(ParamStr(2), '.HLP', False) else
    HelpName := ReplaceExt(TextName, '.HLP',  True);
  if ParamCount >= 3 then
    SymbName := ReplaceExt(ParamStr(3), '.PAS', False) else
    SymbName := ReplaceExt(HelpName, '.PAS', True);

  ExitProc := @ExitClean;

  RegisterHelpFile;

  TextStrm.Init(TextName, stOpenRead, 1024);
  SymbStrm.Init(SymbName, stCreate,   1024);
  HelpStrm := New(PProtectedStream, Init(HelpName, stCreate, 1024));
  ProcessText(TextStrm, HelpStrm^, SymbStrm);
end.