uicdocumentdoc.pas

DelphiDoc is a program for automatic generation of documentation on a Delphi-Project. At the momen

   if not Progress.ShouldAbort then
    begin
     if Count <> 0 then                     //if data present
      begin
       List := TIdentifierFileList.Create;    //create list for sorting files
       try
         for i := 0 to Count - 1 do           //add all files
          List.AddFile(Files[i]);
         List.SortFileAlphabetically;         //and sort them

         i := 0;                              //for each file
         while (i < Count) and not Progress.ShouldAbort do
          begin
           List.GetIdentIndex(i, AFile);        //get the file

           Progress.SetProgressText(Format('Writing File %d of %d',
                                           [i + 1, Count]));
           Progress.SetProcessText(AFile.InternalFileName);

           //if file should be documented
           if not DoNotDocumentIdentifier(nil, AFile) then
            //write the documentation about it
            WriteFileDocumentation(AFile);

           Progress.StepProgress;

           inc(i);
          end;
       finally
        List.Free;
       end;
      end;
    end;
  end;
end;

















































{Writes files of all classes of that kind and their inheritance from each
 other. XFig, EMF and SVG files may be written, depending on the options set.

 Annals: The first version of this method was a TCL-script, that read the
 ClassList.html file generated by ~[linkclass THTMLDoc] and printed the
 Xfig-file to stdout.
~param Kind            the kind of the record-like types to create files about
~param TopLevelClasses the list of top level classes including lists to their
                       descendants }
procedure TICDocumentDoc.WriteClassesTreeFiles(Kind: TRecordKind;
                                             TopLevelClasses: TStrings);
var       BaseName      :String;           //the base name of the file
begin
 if FGenerateClassesTreeFiles then         //files should be generated?
  begin
   BaseName := FDestPath + FClassTreeFileBaseName[Kind]; //calculate base name
   //XFig file should be generated?
   if fctffXfig in FGenerateFileClassTreeFormats then
    WriteClassesXFigureTree(TopLevelClasses, BaseName + '.fig'); //generate it
   //EMF file should be generated?
   if fctffEWMF in FGenerateFileClassTreeFormats then
    WriteClassesEMFTree(TopLevelClasses, BaseName + '.emf');     //generate it
   //SVG file should be generated?
   if fctffSVG in FGenerateFileClassTreeFormats then
    WriteClassesSVGTree(TopLevelClasses, BaseName + '.svg',      //generate it
                        FClassTreeDiagramCallBack);
  end;
end;


{Adds the hierarchy of the kind of the record-like types to the node.
~param Kind  the kind of the record-like types (record/class/interface/...)
~param AddTo the node to add the hierarchy to }
procedure TICDocumentDoc.AddClassList(Kind: TRecordKind; AddTo: TICNCompound);

 //Adds an entry in the class tree and its descendants.
 procedure AddTreeEntry(Ident: TRecordType; AddTo: TICNCompound); forward;
 //Adds a list of entries in the class tree.
 procedure AddTreeList(List: TIdentifierList; AddTo: TICNCompound); forward;
 //Adds the tree by writing the top-level list.
 procedure AddTree(List: TStrings; AddTo: TICNCompound); forward;



 {Adds an entry in the class tree and its descendants.
 ~param Ident the identifier of this class tree entry
 ~param AddTo the node to add the tree entry to }
 procedure AddTreeEntry(Ident: TRecordType; AddTo: TICNCompound);
 var       SubClasses  :Boolean;        //whether sub classes should be listed
           i           :Integer;        //general counter through identifiers
           Implement   :Boolean;        //whether class implements interfaces
           EntryNode   :TICNCompound;   //node to add entry to
           Interf      :TIdentType;     //the implemented interfaces
           List        :TICNList;       //the list of sub classes
 begin
  SubClasses := not Ident.Children.IsEmpty;
  if SubClasses then                    //has sub classes
   begin
    i := Ident.Children.Count - 1;        //check if any sub class documented
    while (i >= 0) and (DoNotDocumentIdentifier(Ident.Children[i])) do
     dec(i);
    SubClasses := i >= 0;                 //any sub class is documented?
   end;
  //is a class and implements interfaces?
  Implement := (Ident.Kind = rkClass) and not Ident.Implementing.IsEmpty;

  if SubClasses or Implement then       //more than one node (the class)?
   begin
    EntryNode := TICNCompound.CreateCompound(AddTo.Owner); //create compound
    AddTo.AppendNode(EntryNode);                   //and add it
   end
  else
   EntryNode := AddTo;                  //just add to the parent entry

  if DoNotDocumentIdentifier(Ident) then
   //add class name as a simple text
   EntryNode.AppendNode(TICNPascalCode.CreatePascalCode(AddTo.Owner,
                                                        icpcIdentifier,
                                                        Ident.Name))
  else
   //add class name as a link
   EntryNode.AppendNode(TICNPascalLink.CreateLink(AddTo.Owner, Ident, nil));


  if Implement then                   //is a class that implements interfaces?
   begin
    EntryNode.AppendNode(TICNTokenClassList.CreateClassListToken(AddTo.Owner,
                                                               iccltImplements,
                                                               rkClass));

    for i := 0 to Ident.Implementing.Count - 1 do   //for each interface
     begin
      if i <> 0 then                                  //if not first interface
       EntryNode.AppendText(', ');                      //insert separator

      Interf := TIdentType(Ident.Implementing[i]);    //get interface
      if assigned(Interf.TheType) and                 //interface known
         not DoNotDocumentIdentifier(Interf.TheType) then //and documented?
       //add link to interface
       EntryNode.AppendNode(TICNPascalLink.CreateLink(AddTo.Owner,
                                                      Interf.TheType, nil))
      else
       //just add name of it
       EntryNode.AppendNode(TICNPascalCode.CreatePascalCode(AddTo.Owner,
                                                            icpcIdentifier,
                                                            Interf.DefIdent))
     end;
   end;

  if SubClasses then                  //if is has descendants
   begin
    List := TICNList.CreateListBullet(AddTo.Owner); //create list of decendants
    EntryNode.AppendNode(List);
    AddTreeList(Ident.Children, List);              //write all entries
   end;
 end;

 {Adds a list of entries in the class tree.
 ~param Ident the list of identifiers
 ~param AddTo the node to add the tree entry to }
 procedure AddTreeList(List: TIdentifierList; AddTo: TICNCompound);
 var       i          :Integer;              //counter through all entries
           Rec        :TRecordType;          //each entry
 begin
  for i := 0 to List.Count - 1 do            //for each entry in the list
   begin
    Rec := TRecordType(List[i]);               //get it
    if not DoNotDocumentIdentifier(Rec) then   //should not be excluded?
     AddTreeEntry(Rec, AddTo);                   //write it
   end;
 end;

 {Adds the tree by writing the top-level list.
 ~param List  the list of top level class entries
 ~param AddTo the node to add the tree entry to }
 procedure AddTree(List: TStrings; AddTo: TICNCompound);
 var       ClassList   :TICNList;     //the list of classes
           i           :Integer;      //counter through all entries of the list
           Obj         :TObject;      //the entries in the list
           Compound    :TICNCompound; //compound for unknown base classes
           SubClasses  :TICNList;     //the list of sub classes
 begin
  ClassList := TICNList.CreateListBullet(AddTo.Owner); //create list of classes
  AddTo.AppendNode(ClassList);

  for i := 0 to List.Count - 1 do     //for each entry
   begin
    Obj := List.Objects[i];             //get the entry
    if Obj is TIdentifierList then      //is an unknown base class?
     begin                                //add compound for the list
      Compound := TICNCompound.CreateCompound(AddTo.Owner);
      ClassList.AppendNode(Compound);
      //write unknown base class
      Compound.AppendNode(TICNPascalCode.CreatePascalCode(AddTo.Owner,
                                                          icpcIdentifier,
                                                          List[i]));

      //create list of decendants of the unknown class
      SubClasses := TICNList.CreateListBullet(AddTo.Owner);
      Compound.AppendNode(SubClasses);
      //write all descendants of it
      AddTreeList(TIdentifierList(Obj), SubClasses);
     end
    else
     begin
      assert(Obj is TRecordType);
      //write base class and all its descendants
      AddTreeEntry(TRecordType(Obj), ClassList);
     end;
   end;
 end;


var       TopLevelList  :TStringList;     //top level classes
          List          :TIdentifierList; //all record-like types of that kind
          i, j          :Integer;         //general counters
          Count         :Integer;         //number of record-like types
          FileD         :TPascalFile;     //file of the record-like types
          Ident         :TIdentifier;     //the record-like types
          Parent        :TRecordType;     //the super class
          UnknownParent :TIdentType;      //name of unknown base class
          S             :String;          //name of unknown base class
          Obj           :TObject;         //to free identifier lists
          Bold          :TICNTextStyle;   //to format the text bold
begin
 TopLevelList := TStringList.Create;      //create list for top level classes
 try
   List := TIdentifierList.Create;        //create list for all classes
   try
     for i := 0 to FFiles.Count - 1 do    //search all classes of that kind
      begin
       FileD := FFiles.GetFile(i);          //in each file
       for j := 0 to FileD.Idents.Count - 1 do //for each identifier
        begin
         Ident := FileD.Idents[j];               //get identifier and check it
         if (Ident is TRecordType) and (TRecordType(Ident).Kind = Kind) then
          List.AddIdent(Ident);                    //add it
        end;
      end;

     Count := List.Count;                 //get number of classes
     if Count > 0 then                    //classes there?
      begin
       if Kind = rkObject then              //here just for object's
        CheckForUnscopedFieldsObject(List);   //for class'es is below

       for i := Count - 1 downto 0 do     //for each class
        begin
         Ident := List[i];                  //get it
         assert(Ident is TRecordType);
         Parent := TRecordType(Ident).GetParent();   //get the super class
         //if not a known base class or parent class not documented
         if (assigned(Parent) and not DoNotDocumentIdentifier(Parent)) or
            DoNotDocumentIdentifier(Ident) then
          List.RemoveIdent(Ident, False);                   //remove it
        end;
       Count := List.Count;               //get number of classes
       if Count <> 0 then                 //not all filtered?
        begin

         TopLevelList.Sorted := True;      //use list to sort top level classes
         TopLevelList.Duplicates := dupError;
         for i := Count - 1 downto 0 do     //for each top level class
          begin
           Ident := List[i];                  //get it and it's base class
           UnknownParent := TRecordType(Ident).IdentParent;
           if assigned(UnknownParent) then
            begin
             //get last known base class
             while UnknownParent.TheType is TIdentType do
              UnknownParent := TIdentType(UnknownParent.TheType);

             //add this class to list of top level classes with name of last
             //known base class
             j := TopLevelList.IndexOf(UnknownParent.DefIdent);
             if j = -1 then                                //not an entry, yet?
              j := TopLevelList.AddObject(UnknownParent.DefIdent,  //create one
                                          TIdentifierList.Create);
             //add this class to the list of the entry
             TIdentifierList(TopLevelList.Objects[j]).AddIdent(Ident);
             List.RemoveIdent(Ident, False);                //and remove it
            end;
          end;
         for i := 0 to TopLevelList.Count - 1 do //sort all lists
          TIdentifierList(TopLevelList.Objects[i]).Sort;


         List.Sort;                       //sort all classes without base class

         //accept classes with the same name
         TopLevelList.Duplicates := dupAccept;
         if Kind in [rkClass, rkInterface] then //type with default base class?
          for i := 0 to List.Count - 1 do     //for each class
           begin
            Ident := List[i];                   //get class
            S := Ident.Name;                    //add as the base class
            if LowerCase(S) =                   //if it is the
               'system.' +                       //default base class
               LowerCase(DocumentationTexts[DefParentClassNameHeader[Kind]].T)
               then
             //use just the default base class name
             S := DocumentationTexts[DefParentClassNameHeader[Kind]].T;
            TopLevelList.AddObject(S, Ident);   //add class as base class
           end
         else
          if not List.IsEmpty then            //list not empty?
           begin