Liren Large Software Subsidy 7/07.iso/c/c100/3.ddi/BROWSR.ZIP/BROWSR.PAS

Pascal/Delphi Source File | 1990-09-27 | 10.4 KB | 855 lines

program clbrowse;                { contains specific browser }

uses  CRT, DOS, Objects{, nodes2, cellist};



{The following classes have been reconstructed from LISTINGS 3 thru 6}



type

  AnyTypePtr = ^AnyType;

  AnyType = object(Node)

  {  constructor init;

    destructor  done;   virtual;

  }

    procedure   DSAction; virtual;

    procedure   BTAction; virtual;

    procedure   EditAction; virtual;

    end;



  procedure AnyType.DSAction;

    begin end; {Abstract}



  procedure AnyType.BTAction;

    begin end; {Abstract}



  procedure AnyType.EditAction;

    begin end; {Abstract}



type



  AnyTypeListPtr = ^AnyTypeList;

  AnyTypeList = Object(List)

    constructor init;

    destructor  done;   virtual;

    procedure   GetNodes; virtual;

    end;



  constructor AnyTypeList.Init;

    begin

      Self.Clear;

    end;



  destructor AnyTypeList.Done;

    begin

      while not Empty do

        Delete;

    end;



procedure AnyTypeList.GetNodes;  { process the browser list }

begin

(*

  P  := AnyTypePtr(First);      { set pointer to first node }

  while P <> nil do

  begin

    P^.BTAction;

    P := AnyTypePtr(Next(P));

*)

  end;



{END RECONSTRUCTION}



type



StringPtr = ^String;

BrowserListPtr = ^BrowserList;

BrowserList = object(AnyTypeList)

  constructor init;

  destructor done; virtual;

  procedure GetNodes; virtual;

end;



DisplayStrPtr = ^DisplayStr;

DisplayStr = object(AnyType)

  Value: StringPtr;

  constructor Init(V: String);

  destructor Done; virtual;

  procedure DSAction; virtual;    { Process a StrCell }

end;



BackTrackPtr = ^BackTrack;

BackTrack = object(AnyType)

  Value: StringPtr;

  constructor Init(V: String);

  destructor Done; virtual;

  procedure BTAction; virtual;    { Process a BTCell }

end;



EditPtr = ^Editor;

Editor = object(AnyType)

  FileName : String;

  Line     : String;

  LineNo   : word;

  Position : word;

  constructor Init(F: string; L: string; Ln: word; P: word);

  destructor Done; virtual;

  procedure EditAction; virtual;    { Edit }

end;



TextFile = object(base)

  F         : Text;

  FileName  : String;

  Line      : String;

  Buf       : array[0..8191] of char; { buffer for faster I/O }

  LineNo    : word;

  Position  : word;

  function open_file: boolean;

end;



HierarchyPtr = ^hierarchy;

Hierarchy = object(TextFile)

  Recurse : boolean;

  Method : String;

  Language_type : char;

  End_type, Base_type, Derived_type       : string[30];

  Object_type, Search_type, Ancestor_type : String[30];

  function base       : boolean;    { looks for base types }

  function derived    : boolean;    { looks for derived types }

  function ancestor   : boolean;    { looks for ancestors }

  constructor     init;

  destructor      done; virtual;

  procedure init_types;       { sets up types for C++ or Pascal }

  procedure init_files;       { sets up files for C++ or Pascal }

  procedure construct;              { flow controller }

  procedure Reconstruct; {calls construct & simplifies recursion}

  procedure update_backtrack_list;  { keeps track of types }

  procedure find_methods;           { finds methods }

end;



var                           { globals }

  Display, Edit : boolean;

  H      : HierarchyPtr;

  L      : BrowserListPtr;

  P      : AnyTypePtr;



{ constructors }



constructor DisplayStr.Init(V: String);

begin

  GetMem(Value, Length(V) + 1);

  Value^ := V;

end;



constructor BackTrack.Init(V: String);

begin

  GetMem(Value, Length(V) + 1);

  Value^ := V;

end;



constructor Editor.Init(F: string; L: string; Ln: word; P: word);

begin

  FileName := F;

  Line     := L;

  LineNo   := Ln;

  Position := P;

end;



constructor Hierarchy.init;   begin end;

constructor BrowserList.init; begin end;



{destructors }



destructor Editor.Done; begin end;



destructor DisplayStr.Done;

begin  FreeMem(Value, Length(Value^) + 1); end;



destructor BackTrack.Done;

begin  FreeMem(Value, Length(Value^) + 1); end;



destructor  Hierarchy.done;   begin end;

destructor  BrowserList.done; begin end;



{ methods }



procedure DisplayStr.DSAction;

var

  Ch : char;

begin

  writeln(Value^);

  Ch := readkey;

end;



procedure BackTrack.BTAction;  { show the object hierarchy }

begin  writeln(Value^); end;



procedure Editor.EditAction;

var Ch : char;

begin

  writeln(#13, #10,'File      = ',FileName);

  writeln('Line      = ',Line);

  writeln('LineNumber= ',LineNo);

  writeln('Position  = ',Position);

  { Call editor here & pass it appropriate information. }

end;



procedure hierarchy.init_types;

begin

  case Language_type of

  'p': begin                        { Pascal }

         Base_type := ' = object';

         Derived_type := ' = object(';

         End_type := 'end';

       end;

  'c': begin                        { C++ }

         Base_type := 'class ';

         Derived_type := ' :';

         End_type := '}';

       end;

  end; { case }

end;



procedure hierarchy.init_files;

begin

  case Language_type of

  'p': FileName := 'cltest.pas';   { Pascal }

  'c': FileName := 'cltest.cpp';   { C++ }

  end;  { case }

  write('Enter File Name : ');Readln(FileName);

{ add functions here to read a project's files }

end;



procedure hierarchy.find_methods;

var

  NextLine     : string;

  TempPosition : word;

begin

  Method := '';

  NextLine := Line;

  TempPosition := 0;

  While (TempPosition = 0) do

  begin

    TempPosition := Pos(End_type,NextLine);

    Method := Method + NextLine + #13 + #10;

    readln(F,NextLine);

  end;

  L^.Append(New(DisplayStrPtr,Init(Method)));

  L^.Append(New(EditPtr,Init(FileName,Line,LineNo,Position)));

end;



function hierarchy.base: boolean;

begin

  LineNo := 1;

  case Language_type of

  'p': Search_type := Object_type + Base_type;

  'c': Search_type := Base_type + Object_type;

  end; { case }

  while not eof(F) do

  begin

    readln(F,Line);

    Position := Pos(Search_type,Line);

    If (Position > 0) then

    begin

      Position := Pos(Derived_type,Line);

      If (Position = 0) then

        begin

          find_methods;

          base := true;

          exit;

        end;

    end;

    inc(LineNo);

  end;

  base := false;

end;



function hierarchy.derived: boolean;

begin

  case Language_type of

  'p': Search_type := Object_type + Derived_type;

  'c': Search_type := Base_type + Object_type + Derived_type;

  end; { case }

  LineNo := 1;

  while not eof(F) do

  begin

    readln(F,Line);

    Position := Pos(Search_type,Line);

    If (Position > 0) then

    begin

      If ancestor then

      begin

        find_methods;

        derived := true;

        exit;

      end;

    end;

    inc(LineNo);

  end;

  derived := false;

end;



function hierarchy.ancestor: boolean;

var

  T_Ancestor_type : string[30];

  I,J,L : integer;

begin

    Ancestor_type := '';

    T_Ancestor_type := '';

    I := Length(Line);        { start at the end of the Line }

    while (Line[I] = #32) do  { space }

    dec(I);

    while (Line[I] = ')') do  { empty in C++ }

    dec(I);

    case Language_type of

    'c':

      while (Line[I] <> #32) do  { space }

      begin

        T_Ancestor_type := T_Ancestor_type + Line[I];

        dec(I);

      end;

    'p':

      while (Line[I] <> '(') do

      begin

        T_Ancestor_type := T_Ancestor_type + Line[I];

        dec(I);

      end;

    end; { case }



    L := Length(T_Ancestor_type);

    for I := L downto 1 do       { reverse the list }

      Ancestor_type := Ancestor_type + T_Ancestor_type[I];

end;



procedure hierarchy.update_backtrack_list;

begin

  L^.Append(New(BackTrackPtr, Init(Object_type)));

end;



function TextFile.open_file: boolean;

begin

  {$I-}                     { test for I/O error }

  assign(F,FileName);

  Reset(f);

  {$I+}

  Open_file := (IOResult = 0);

end;



procedure hierarchy.Reconstruct;

begin

  Recurse := true;  { still more ancestors }

  While Recurse do  { recursively backtrack for ancestors }

    construct;

end;



procedure hierarchy.construct;

begin

  Recurse := FALSE;

  If Open_file then      { if open successful }

  begin

    SetTextBuf(F,buf);

    update_backtrack_list;

    Close(F);

    If Open_file then

      If Derived then { If derived class, find its ancestor. }

      begin

          Object_type := ancestor_type; { set up for backtrack }

          Close(F);

          Recurse := true; { still more ancestors }

      end

    ELSE

      Close(F);

    IF Open_file then

      If Base then     { if base type, we're done. }

      begin

        Close(F);

        Recurse := false;  { no more ancestors }

      end;

  end;

end;



procedure display_mode;

var Ch : char;

begin

  write('e-Edit or d-display '); { display/edit option }

  Ch := Readkey;

  writeln;

  If Ch = 'e' then Edit := true

  Else Display := true;

end;



procedure BrowserList.GetNodes;  { process the browser list }

begin

  P  := AnyTypePtr(First);      { set pointer to first node }

  while P <> nil do

  begin

    P^.BTAction;

    P := AnyTypePtr(Next(P));

  end;



  If Display = true then        { are we displaying ? }

  begin

    P  := AnyTypePtr(First);

    while P <> nil do

    begin

      P^.DSAction;

      P := AnyTypePtr(Next(P));

    end;

  end;



  If Edit = true then           { editing ? }

  begin

    P  := AnyTypePtr(First);

    while P <> nil do

    begin

      P^.EditAction;

      P := AnyTypePtr(Next(P));

    end;

  end;

end;



{ main }



begin

  Clrscr;

  Edit := false;                 { initializations }

  Display := false;

  New(L,init);               { initialize a new browser list }

  L^.clear;

  New(H,init);             { initialize a new hierarchy list }

  write('Enter Language -- p or c : ');

  readln(H^.Language_type);

  write('Enter Object: ');

  readln(H^.Object_type);

  writeln;

  H^.Init_files;

  H^.Init_types;

  H^.ReConstruct;

  display_mode;            { set display or edit }

  L^.GetNodes;             { process the browser list }

  Dispose(L,Done);         { cleanup }

  Dispose(H,Done);

end. { main