uumlxmiexportdoc.pas

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

{  JADD - Just Another DelphiDoc: Documentation from Delphi Source Code

Copyright (C) 2003-2008   Gerold Veith

This file is part of JADD - Just Another DelphiDoc.

DelphiDoc is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License version 3 as
published by the Free Software Foundation.

DelphiDoc is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program.  If not, see <http://www.gnu.org/licenses/>.
}


unit UUMLXMIExportDoc;

{Contains the generator-class ~[link TUMLXMIExportDoc] to create an UML
 notation of the classes as an XMI-file. }

interface

uses Classes,
     UPascalConsts,
     UBaseIdents, UExtIdents,
     UOptions, UMakeDoc;





const DefaultUMLXMIFileName = 'DelphiDoc';   //default name of the XMI file
      UMLXMIFileExtension = '.xmi';           //extension of XMI file
      //the default name of the DTD file of the XMI UML file
      UMLXMIDTDFileName = 'uml13.dtd';
      //the default name of the XSL file of the XMI XML file
      XMIXSLFileName = 'xmi.xsl';




type
   //indentation/nesting level of tags changed by a line
   TIdentationChange = (
                        icClosed,  //one tag closed
                        icNone,    //neutral line, tag only on this line
                        icOpened); //one additonal tag opened


   //different type of record-like types
   TRecordKinds = set of TRecordKind;


   //the different kinds of unknown types
   TUnknownTypeKind = (
                       utkUnknown,    //kind of type is unknown
                       utkClass,      //type has to be a class
                       utkInterface); //type has to be an interface





   { * * *  ***  * * *  ***   TUMLXMIExportDoc   ***  * * *  ***  * * *  }


  //just another simple test for this program
  TParentClass = TMakeDoc;


  {Extends its base class to to create an UML notation of the classes as an
   XMI-file. }
  TUMLXMIExportDoc = class(TParentClass)
  private
    //the XMI file to write
    FXMIFile: TextFile;
    //current level of nesting of XML tags in the XMI file
    FCurrentTagLevel: Integer;


    //list of unknown (simple) data types (not sorted)
    FUnknownDataTypes: TStringList;








    //the name of the UML XMI File to be generated
    FXMIFileName: String;
    //additional indention of enclosed XML-Tags (per level)
    FTagIndentionPerLevel: Integer;
    //character encoding to set for the XML file
    FCharacterEncoding: String;
    //name of the DTD file to include in the XMI file;
    //default is ~[link UMLXMIDTDFileName] that will be created unless
    //~[link FCreateDTDFile] is false
    //~seeText ~[linkExtern http://www.jeckle.de/xmi/v1.1/uml13.dtd
    //                      http://www.jeckle.de/xmi/v1.1/uml13.dtd]
    FXMIDTDFile: String;
    //name of the XSL file to include in the XMI file;
    //default is ~[link XMIXSLFileName]
    FXMIXSLFile: String;
    //if the DTD file should be created, it is created under the name
    //~[link UMLXMIDTDFileName]; it is created by default
    //~seeText ~[linkExtern http://www.jeckle.de/xmi/v1.1/uml13.dtd
    //                      http://www.jeckle.de/xmi/v1.1/uml13.dtd]
    FCreateDTDFile: Boolean;
    //if the XSL file should be created, it is created under the name
    //~[link XMIXSLFileName]; it is created by default
    FCreateXSLFile: Boolean;



    //if the associations (fields/properties with the type of another
    //class/etc.) should also be written to the XMI file
    FExportAssociations: Boolean;

    //record-like type not to add as classes to the XMI
    FNoXMIClasses: TRecordKinds;      //(only as simple data types)










    //Handles text by encoding special characters.
    function HandleRawText(const Text: String): String;

    //Returns the unique ID of an identifier to be used in the documentation.
    function GetURIOf(Ident: TIdentifier; TheFile: TPascalFile = nil;
                      WithPrefix: Boolean = True): String;



    //Gets the ID of the unknown type by creating a dummy object.
    function GetUnknownTypeID(const TypeDef: String;
                              TypeKind: TUnknownTypeKind = utkUnknown): String;





    //Writes the line while maintaining the nesting level of the XML tags.
    procedure Write(const Line :String; Tag: TIdentationChange = icNone);


    //Writes the scope.
    procedure WriteScope(Scope: TScope);

    //Write the type by searching and referencing it.
    function WriteTypeReference(TheType: TType;
                                const Tag, NestedTag: String): Boolean;








    //Writes the method.
    procedure WriteOperation(Ident: TFunction);
    //Writes the field or property.
    procedure WriteAttribute(Ident: TIdentifier; IsProperty: Boolean);

    //Writes the class or interface.
    procedure WriteClass(Ident: TRecordType; IsInterface: Boolean);
    //Writes the data type.
    procedure WriteDataType(Ident: TType);



    //Writes all types in the file.
    procedure WriteTypes(InFile: TPascalFile);




    //Writes the documentation of all files/modules.
    procedure WriteFiles;

    //Writes the unknown types.
    procedure WriteUnknownTypes;








    //Writes the header of the XMI file.
    procedure WriteXMIHeader;
    //Writes the footer of the XMI file.
    procedure WriteXMIFooter;



    //Extracts the file from the resources and writes it decompressed.
    procedure CreateFileFromResource(ResourceID: Integer;
                                     const FileName: String);
  protected

    //Process parsed data; extract the source code into files.
    function DoGenerateDocumentation: Boolean; override;
  public
    //Creates the generator object.
    constructor Create; override;
    //Creates the generator object and initializes the options.
    destructor Destroy; override;


    //Returns a description of the documentation of the generator.
    class function GetDescription: TGeneratorDescription; override;


    //Returns the number of available options in this class.
    class function GetOptionCount: Cardinal; override;
    //Gets a description of an option.
    class procedure GetOptionDescription(Index: Cardinal;
                                         var Desc: TOptionDescription);
                                                                      override;
    //Gets the value of an option.
    function GetOption(Index: Cardinal): TOptionValue; override;
    //Sets the value of an option.
    procedure SetOption(Index: Cardinal; const Value: TOptionValue); override;

    //Resets the attributes to ready the generator for a new generation.
    procedure ResetForNewGeneration; override;
  end;




implementation

uses SysUtils, Windows, 
{$IFNDEF LINUX}
     ShellAPI,
{$ENDIF}
     ZLib,    //if you don't have this file installed, search on your Delphi CD
     General;


const

      //for identifiers
      //(files, classes, interfaces, data type, attributes and operations);
      //the path of the identifier follows: file[<sep>identifier[<sep>member]];
      //<sep> being ~[link XMIIDSeparatorIdentifier]
      XMIIDPrefixIdentifier = 'I_';
      //to separate identifiers in the path of an identifier
      //see XMIIDPrefixIdentifier
      XMIIDSeparatorIdentifier = '.I_';
      //for generalizations (class a is subclassed by class b);
      //the path of the specializing class (class b) follows
      XMIIDPrefixGeneralization = 'G_';
      //for abstractions (interface i is implemented by class c)
      //the paths of the class and the interface follow:
      //file1.class.file2.interface
      XMIIDPrefixAbstraction = 'A_';
      //for usage (class x has an attribute with the type of class y);
      //the paths of the types follow:
      //file1.usingtype.file2.usedtype
      XMIIDPrefixUsage = 'U_';
      //separator to combine two URIs to one
      XMIIDDoubleSeparator = '.';

      //for unknown types, followed by whole known path
      XMIIDPrefixUnknownClasses = 'Un_';



      //the characters indication kinds of record-like types for the option
      //to exclude their export as classes
      NoExportRecordLikeKindChars: array[TRecordKind] of Char =
                                   ('R', 'O', 'C', 'I', 'D');







   { * * *  ***  * * *  ***   TUMLXMIExportDoc   ***  * * *  ***  * * *  }


{Creates the generator object and initializes the options. }
constructor TUMLXMIExportDoc.Create;
begin
 inherited Create;                       //create object

 FXMIFileName := DefaultUMLXMIFileName;  //initialize options
 FTagIndentionPerLevel := 1;
 FCharacterEncoding := 'iso-8859-15';
 FXMIDTDFile := UMLXMIDTDFileName;
 FCreateDTDFile := True;
 FXMIXSLFile := XMIXSLFileName;
 FCreateXSLFile := True;
 FExportAssociations := True;
 FNoXMIClasses := [rkRecord, rkDispInterface];
end;

{Creates the generator object and initializes the options. }
destructor TUMLXMIExportDoc.Destroy;
begin
 FUnknownDataTypes.Free;                 //free the lists

 inherited Destroy;                      //free the object
end;




{Returns a description of the documentation of the generator.
~result a description of the documentation of the generator }
class function TUMLXMIExportDoc.GetDescription: TGeneratorDescription;
begin
 Result.Name := 'Export as UML XMI Model';
 Result.Identification := 'UMLXMIExport';
 Result.Description :=
  'Generates an UML notation of all classes and interfaces and their associations and inheritance as an XMI file.' + LineDelimiter +
  'May be used to import it into other programs.';
end;






{Returns the number of available options in this class.
~result the number of available options }
class function TUMLXMIExportDoc.GetOptionCount: Cardinal;
begin
 Result := inherited GetOptionCount + 8; //9; //<-- last one not active
end;                                          //no associations so far

{Gets a description of an option.
~param Index index of the option to get data of
~param Desc  out: the description of the option (name, type, default value,
                  etc.)
~see GetOptionCount }
class procedure TUMLXMIExportDoc.GetOptionDescription(Index: Cardinal;
                                                 var Desc: TOptionDescription);
var             PreOptionCount   :Cardinal;     //number of inherited options
begin
 PreOptionCount := inherited GetOptionCount;    //get number of inherited ones
 if Index < PreOptionCount then                 //asked for inherited option?
  inherited GetOptionDescription(Index, Desc)     //forward to parent class
 else
  begin
   ClearDescription(Desc);               //clear structure
   case Index - PreOptionCount of        //depending on index of option
     0: begin                            //set the values describing the option
         Desc.Name := 'TagIndentionPerLevel';
         Desc.Category := 'Generation';
         Desc.Description := 'Indention of enclosed XML-Tags (per level).';
         Desc.DataType := otInteger;
         Desc.DefaultValue.IntData := 1;
         Desc.MinInt := 0;
         Desc.MaxInt := 100;
        end;
     1: begin
         Desc.Name := 'CharacterEncoding';
         Desc.Category := 'Generation';
         Desc.Description := 'Name of the character encoding to set for the XMI file, f.i.: iso-8859-15, UTF-8, iso-8859-1, windows-1252';
         Desc.DataType := otString;
         Desc.DefaultValue.StrData := 'iso-8859-15';
        end;
     2: begin
         Desc.Name := 'XMIDTDFile';
         Desc.Category := 'Generation';
         Desc.Description := 'Name of the DTD file to include in the XMI file; see also: http://www.jeckle.de/xmi/v1.1/uml13.dtd';
         Desc.DataType := otString;
         Desc.DefaultValue.StrData := UMLXMIDTDFileName;
        end;
     3: begin
         Desc.Name := 'XMIXSLFile';
         Desc.Category := 'Generation';
         Desc.Description := 'Name of the XSL file to include in the XMI file.';
         Desc.DataType := otString;
         Desc.DefaultValue.StrData := XMIXSLFileName;
        end;
     4: begin
         Desc.Name := 'CreateDTDFile';
         Desc.Category := 'Generation';
         Desc.Description := 'If the DTD file "' + UMLXMIDTDFileName +
                             '" should be created.';
         Desc.DataType := otBoolean;
         Desc.DefaultValue.BoolData := True;
        end;
     5: begin
         Desc.Name := 'CreateXSLFile';
         Desc.Category := 'Generation';
         Desc.Description := 'If the XSL file "' + XMIXSLFileName +
                             '" should be created.';
         Desc.DataType := otBoolean;
         Desc.DefaultValue.BoolData := True;
        end;
     6: begin
         Desc.Name := 'NoXMIClasses';
         Desc.Category := 'Generation';
         Desc.Description := 'The kind of record-like types not to export as classes.';
         Desc.DataType := otSet;
         Desc.SetNames := OptionItemsFilterClassesByKind;
         Desc.DefaultValue.SetData := $11; //10001 = R___D
        end;
     7: begin
         Desc.Name := 'FileName';
         Desc.Category := '';
         Desc.Description := 'The name of the UML XMI file to be generated.';
         Desc.DataType := otString;
         Desc.DefaultValue.StrData := DefaultUMLXMIFileName;
        end;
     8: begin
         Desc.Name := 'ExportAssociations';
         Desc.Category := 'Generation';
         Desc.Description := 'If the associations (fields/properties of type of another class) should also be exported.';
         Desc.DataType := otBoolean;
         Desc.DefaultValue.BoolData := True;
        end;
   else
    assert(Index >= GetOptionCount);
    raise EInvalidOption.Create('Invalid index for option supplied!');
   end;
 end;
end;