udiagramcreator.pas

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

  //font is unknown? (there are aliases/generic fonts, that can't be checked,
  //                  for instance: "Times" -> "Times New Roman")
  if Screen.Fonts.IndexOf(Value) = -1 then
   AddSimpleMessage(FDiagramCreatorMessagesID, Ord(dcmkFontNotFoundOnSystem),
                    'Warning, font not found on this system: ' + Value);

  FDiagram.Font.Name := Value;    //set the name of the font to use
 end;

 {Returns the boolean value in the string.
 ~param Value   the string expressing a boolean value
 ~param Default the value to use, if string does not represent a valid boolean
                value }
 function CheckBoolean(const Value: String; Default: Boolean): Boolean;
 var      Desc        :TOptionDescription;   //description of a boolean option
          OValue      :TOptionValue;         //boolean value of the option
 begin
  Result := (Value = '');                    //empty string means true
  if not Result then                         //string not empty?
   begin
    ClearDescription(Desc);                    //clear structure
    Desc.DataType := otBoolean;                //set it to a boolean type
    if StringToValue(Value, OValue, Desc) then //try to read boolean value
     Result := OValue.BoolData                   //use tis value
    else
     begin
      Valid := False;                            //error!
      AddSimpleMessage(FDiagramCreatorMessagesID,
                       Ord(dcmkInvalidValueForOption),
                       'Invalid boolean value for option: ' + Value);
      Result := Default;                         //use default value
     end; //else StringToValue(...)
   end; //if not Result
 end;

 {Returns the integer value in the string.
 ~param Value   the string expressing an integer value
 ~param Default the value to use, if string does not represent a valid integer
                value }
 function GetInteger(const Value: String; Default: Integer): Integer;
 var      Code      :Integer;                  //index of error in the string
 begin
  val(Value, Result, Code);                    //try to read the integer value
  if Code <> 0 then                            //not a valid value?
   begin
    Valid := False;                              //error!
    AddSimpleMessage(FDiagramCreatorMessagesID, Ord(dcmkInvalidValueForOption),
                     'Invalid integer value for option: ' + Value);
    Result := Default;                           //use default value
   end;
 end;


 {Sets the kinds of member to be shown in record-like types.
 ~param Str the string defining the kinds of members }
 procedure ReadMemberKinds(const Str: String);
 var       Desc           :TOptionDescription; //an option describing a set
           Value          :TOptionValue;       //value of the set
           Kinds          :TMemberKinds;       //the set of kinds of members
 begin
  ClearDescription(Desc);                      //clear structure
  Desc.DataType := otSet;                      //it is a set of
  Desc.SetNames := OptionItemsFilterMembersByKind; //kinds of members

  if StringToValue(Str, Value, Desc) then      //try to read the kinds
   begin
    OptionToSet(Value.SetData, Kinds, SizeOf(Kinds)); //extract the set
    FDiagram.ShowMembers := Kinds;                      //and use it
   end
  else
   begin                                         //error
    AddSimpleMessage(FDiagramCreatorMessagesID, Ord(dcmkInvalidValueForOption),
                     'Invalid kinds of members to show: ' + Str);
    Valid := False;
   end;
 end;

 {Sets the algorithm to automatically layout the diagram.
 ~param Str the string defining the layout }
 procedure ReadLayout(const Str: String);
 begin
  if Str = 'simple' then         //simple layout for record-like types?
   FLayOut := dloSimple
  else                           //simple layout with post-optimizing?
   if (Str = 'simplepost') or (Str = 'post') or (Str = 'postprocess') or
      (Str = 'simplepostprocess') or (Str = 'optimize') then
    FLayOut := dloSimplePostProcess
   else
    if (Str = 'sugiyama') or (Str = 'default') then //algorithm of Sugiyama?
     FLayOut := dloSugiyama
    else
     AddSimpleMessage(FDiagramCreatorMessagesID,
                      Ord(dcmkInvalidValueForOption),
                      'Invalid layout for diagram: ' + Str);
 end;

 {Sets the scopes of members to be shown in record-like types.
 ~param Str the string defining the scopes }
 procedure ReadScopes(const Str: String);
 var       Desc      :TOptionDescription;   //an option describing a set
           Value     :TOptionValue;         //value of the set
           Scopes    :set of TMemberScopes; //the set of scopes
 begin
  ClearDescription(Desc);                   //clear structure
  Desc.DataType := otSet;                   //it is a set of
  Desc.SetNames := OptionItemsFilterMembersByScope; //scopes of members

  if StringToValue(Str, Value, Desc) then      //try to read the kinds
   begin
    //extract the set of scopes
    OptionToSet(Value.SetData, Scopes, SizeOf(Scopes), Ord(Low(TMemberScope)));
    FDiagram.ShowScopes := Scopes;               //and use it
   end
  else
   begin                                         //error
    AddSimpleMessage(FDiagramCreatorMessagesID, Ord(dcmkInvalidValueForOption),
                     'Invalid scopes of members to show: ' + Str);
    Valid := False;
   end;
 end;


var      Name            :String;        //the name of the option
         OptionIndex     :Integer;       //index of the option
         i               :Integer;       //index of end of name of option
         ShowRecordKinds :TRecordKinds;  //kinds of record-like types to show
begin
 Name := Option;
 i := pos('=', Name);                    //get separator between name and value
 if i = 0 then                           //no value?
  Option := ''                             //no value
 else
  begin
   Delete(Name, i, High(Length(Name)));    //extract the name
   Delete(Option, 1, i);                   //extract the value
  end;

 if IsWordIn(Name, DiagramOptionNames, OptionIndex) then //is a valid option?
  begin
   if TDiagramOption(OptionIndex) <> doFont then //not the name of a font?
    Option := LowerCase(Option);                  //values are case-insensitive
   Valid := True;
   case TDiagramOption(OptionIndex) of       //handle the option
     doAssociations:   FDiagram.ShowAssociations := CheckBoolean(Option,
                                                    FDiagram.ShowAssociations);
     doClass,
     doFile:           FDiagram.NewDiagram(TDiagramOption(OptionIndex) =
                                           doFile);
     doFont:           SetFont(Option);
     doImplementation: FDiagram.ShowUsingImplementation :=
                        CheckBoolean(Option, FDiagram.ShowUsingImplementation);
     doMemberKinds:    ReadMemberKinds(Option);
     doLayout:         ReadLayout(Option);
     doMargin:         FDiagram.Margin := GetInteger(Option, FDiagram.Margin);
     doParameter:      FDiagram.ShowMethodParameters := CheckBoolean(Option,
                                                FDiagram.ShowMethodParameters);
     doResult:         FDiagram.ShowReturnType := CheckBoolean(Option,
                                                      FDiagram.ShowReturnType);
     doScopes:         ReadScopes(Option);
     doShowFile:       FDiagram.ShowFileNameInClass := CheckBoolean(Option,
                                                 FDiagram.ShowFileNameInClass);
     doShowPrivate:    FDiagram.ShowClassesNotInInterface :=
                              CheckBoolean(Option,
                                           FDiagram.ShowClassesNotInInterface);
     doSize:           FDiagram.Font.Size := GetInteger(Option,
                                                        FDiagram.Font.Size);
     doTypes:          if GetRecordLikeTypeSet(Option, ShowRecordKinds) then
                        FDiagram.ShowClasses := ShowRecordKinds
                       else
                        begin
                         Valid := False;
                        end;
   else
    assert(False);
   end;
{
   if Valid and not             //was a valid option that changed the diagram?
      (TDiagramOption(OptionIndex) in [doClass, doFile, doLayout]) then
    FDiagram.ApplyOptions         //apply the new option
}
  end
 else
  AddSimpleMessage(FDiagramCreatorMessagesID, Ord(dcmkUnknownOption),
                   'Unknown option: ' + Name);
end;

















{Handles the first part of classes to add or remove from the diagram.
~param ClassName the name fo the class or generic command
~param Parameter parameter to the class or command
~param List      the list to add the class(es) to
~result whether the class(es) has/ve been successfully added }
function TDiagramCreator.AddSubClassStart(const ClassName, Parameter: String;
                                          List: TList): Boolean;

 {Adds all classes in the file. }
 procedure AddAllClassesInTheFile;
 var       TheFile       :TPascalFile;     //file of the classes to add
           i             :Integer;         //counter through the identifiers
           Ident         :TIdentifier;     //each identifier in the file
 begin
  if (Parameter = '') or                   //check the file
     (Parameter[1] <> '(') or (Parameter[Length(Parameter)] <> ')') then
   AddSimpleMessage(FDiagramCreatorMessagesID,
                    Ord(dcmkNoFileSpecifiedForClass),
                    Format('No file given for "%s(name of file)"!',
                           [ClassName]))
  else
   begin                                   //search the file
    TheFile := FFiles.GetFileByName(copy(Parameter, 2,
                                         Length(Parameter) - 2));
    if not assigned(TheFile) then
     AddSimpleMessage(FDiagramCreatorMessagesID, Ord(dcmkFileNotFound),
                      Format('File not found: "%s"!',
                             [copy(Parameter, 2, Length(Parameter) - 2)]))
    else
     begin
      for i := 0 to TheFile.Idents.Count - 1 do  //for each identifier in it
       begin
        Ident := TheFile.Idents[i];                //get it
         //is a valid class?
        if (Ident is TRecordType) and not DoNotDocumentIdentifier(Ident) then
         Add(List, Ident);                           //add it to the list
       end;
       Result := True;                           //command was correct
     end; //else not assigned(TheFile)
   end; //else Parameter invalid
 end;


 {Adds all record-like types of the kinds. }
 procedure AddAllClassesOfKinds;
 var       FilterSet      :TRecordKinds;    //kinds of record-like types to add
           i              :Integer;         //counter through the files
           TheFile        :TPascalFile;     //each file
           j              :Integer;         //counter through the identifiers
           Ident          :TIdentifier;     //all identifiers
 begin
  if (Parameter = '') or                    //parameter given?
     (Parameter[1] <> '(') or (Parameter[Length(Parameter)] <> ')') then
   AddSimpleMessage(FDiagramCreatorMessagesID, Ord(dcmkParameters),
                    Format('"%s()" needs a parameter!', [ClassName]))
  else
   begin
    //extract kinds of record-like types to add
    Result := GetRecordLikeTypeSet(copy(Parameter, 2, Length(Parameter) - 2),
                                   FilterSet);
    if Result and (FilterSet <> []) then      //set of kinds valid?
     for i := 0 to FFiles.Count - 1 do          //for each file
      begin
       TheFile := FFiles[i];
       for j := 0 to TheFile.Idents.Count - 1 do  //for each identifier
        begin
         Ident := TheFile.Idents[j];
         if (Ident is TRecordType) and              //is a valid class?
            (TRecordType(Ident).Kind in FilterSet) and
            not DoNotDocumentIdentifier(Ident) then
          Add(List, Ident);                           //add it to the list
        end; //for j := 0 to TheFile.Idents.Count - 1
      end; //for i := 0 to FFiles.Count - 1
   end; //else Parameter invalid
 end;


var      Ident          :TIdentifier;     //the specified class to add
         TheFile        :TPascalFile;     //the file of the class to add
         i              :Integer;         //counter through the files
begin
 Result := False;                         //not proved correct yet
 if LowerCase(ClassName) = 'file' then    //classes in file should be added?
  AddAllClassesInTheFile                    //add all classes in the file
 else
  //all record-like types of the kinds should be added?
  if LowerCase(ClassName) = 'type' then
   AddAllClassesOfKinds                     //add all types of the kinds
  else
   begin //name of a record-like type given
    Ident := nil;                           //class not found so far

    if Parameter <> '' then                 //file specified?
     begin                                    //file valid?
      if (Parameter[1] <> '(') or (Parameter[Length(Parameter)] <> ')') then
       AddSimpleMessage(FDiagramCreatorMessagesID,
                        Ord(dcmkInvalidFileSpecified),
                        Format('No valid file given for %s(File)!',
                               [ClassName]))
      else
       begin
        TheFile := FFiles.GetFileByName(copy(Parameter, 2,
                                             Length(Parameter) - 2));
        if not assigned(TheFile) then         //file not found?
         AddSimpleMessage(FDiagramCreatorMessagesID, Ord(dcmkFileNotFound),
                          Format('File not found: "%s"!',
                                 [copy(Parameter, 2, Length(Parameter) - 2)]))
        else
         begin                                //search class in the file
          Ident := TheFile.Idents.GetIdentByName(ClassName);
          //is not a valid class?
          if not (Ident is TRecordType) or DoNotDocumentIdentifier(Ident) then
           AddSimpleMessage(FDiagramCreatorMessagesID,
                            Ord(dcmkClassNotFoundInFile),
                            Format('No class "%s" in file "%s" found!',
                                   [ClassName,
                                    copy(Parameter, 2,
                                         Length(Parameter) - 2)]))
          else
           begin
            List.Add(Ident);                    //add it to the list
            Result := True;                     //class was valid
           end; //else Ident not found or invalid
         end; //else not assigned(TheFile)
       end; //else Parameter invalid
     end //if Parameter <> ''
    else
     begin
      if assigned(FStartFile) then      //file to start searched defined?