uumlxmiexportdoc.pas

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

     Ident := InFile.Idents[i];               //get it
     if (Ident is TType) and                  //is a type
        not DoNotDocumentIdentifier(Ident) then //and documented?
      List.AddIdent(Ident);                       //add it
    end;

   if not List.IsEmpty then                 //some documented types found?
    begin
     List.Sort;                               //sort the list

     Write('<Foundation.Core.Namespace.ownedElement>', icOpened);
     for i := 0 to List.Count - 1 do          //for each type in the file
      begin
       Ident := List[i];                        //get it

       //is a class/interface and should be handled like that?
       if (Ident is TRecordType) and
          not (TRecordType(Ident).Kind in FNoXMIClasses) then
        //write the class/interface
        WriteClass(TRecordType(Ident), TRecordType(Ident).Kind = rkInterface)
       else
        WriteDataType(TType(Ident));              //write the simple type
      end;
     Write('</Foundation.Core.Namespace.ownedElement>', icClosed);
    end;
 finally
  List.RemoveAll(False);                    //don't free identifiers
  List.Free;                                //free the list
 end;
end;



{Writes the documentation of all files/modules. }
procedure TUMLXMIExportDoc.WriteFiles;
var       Count           :Integer;             //number of files
          i               :Integer;             //counter through the files
          List            :TIdentifierFileList; //to sort files alphabetically
          AFile           :TPascalFile;         //the files
begin
 Count := FFiles.Count;                         //get number of files

 Progress.SetWorkText('Writing File Documentation...');
 Progress.SetProgressText('');
 Progress.SetProcessText('Writing List of Files...');
 Progress.SetMaximum(Count);


 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 documented files
      begin
       AFile := Files[i];                         //get it
       if not DoNotDocumentIdentifier(nil, AFile) then //documented?
        List.AddFile(AFile);                        //add it
      end;

     if not List.IsEmpty then                   //some files found?
      begin
       Count := List.Count;                       //get number of files
       List.SortFileAlphabetically;               //and sort them


       for i := 0 to Count - 1 do                 //for each file
        begin
         List.GetIdentIndex(i, AFile);              //get the file




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


         //begin module for the file
         Write('<Model_Management.Package xmi.id="' + XMIIDPrefixIdentifier +
               GetURIOf(nil, AFile) + '">', icOpened);
         Write('<Foundation.Core.ModelElement.name>' + AFile.InternalFileName +
               '</Foundation.Core.ModelElement.name>');


         WriteTypes(AFile);                         //and write all types in it


         Write('</Model_Management.Package>', icClosed);  //end the module

         Progress.StepProgress;
        end; //for i := 0 to Count - 1
      end; //if not List.IsEmpty

   finally
    List.Free;
   end;
  end; //if Count <> 0
end;







{Writes the unknown types. }
procedure TUMLXMIExportDoc.WriteUnknownTypes;
          //kind of the type
const     KindPrefix: array[TUnknownTypeKind] of String =
           ('DataType', 'Class', 'Interface');
var       i               :Integer;          //counter through the types
          Kind            :TUnknownTypeKind; //kind of the type
begin
 if FUnknownDataTypes.Count <> 0 then        //unknown types available?
  begin
   //begin module for the unknown types
   Write('<Model_Management.Package xmi.id="__Unknown__">', icOpened);
   Write('<Foundation.Core.ModelElement.name>((Unknown))</Foundation.Core.ModelElement.name>');
   Write( '<Foundation.Core.Namespace.ownedElement>', icOpened);


   for i := 0 to FUnknownDataTypes.Count - 1 do //for each unknown type
    begin
     Kind := TUnknownTypeKind(FUnknownDataTypes.Objects[i]); //get its kind

     //write the tag for the type and its name
     Write(  '<Foundation.Core.' + KindPrefix[Kind] + ' xmi.id="' +
             XMIIDPrefixUnknownClasses + IntToStr(i) + '">', icOpened);
     Write(   '<Foundation.Core.ModelElement.name>' + FUnknownDataTypes[i] +
              '</Foundation.Core.ModelElement.name>');
//     WriteScope(sPublic);     //has to be public, to be used

     //is a class/interface and should be handled like that?
     if Kind <> utkUnknown then
      begin
       //write references to associations, generalizations and abstractions
      end;

     Write(  '</Foundation.Core.DataType>', icClosed);
    end;

   //end module for the unknown types
   Write( '</Foundation.Core.Namespace.ownedElement>', icClosed);
   Write('</Model_Management.Package>', icClosed);
  end; //if FUnknownDataTypes.Count <> 0
end;






















































{Writes the header of the XMI file. }
procedure TUMLXMIExportDoc.WriteXMIHeader;
begin
 //write XML version and character encoding used in the document
 Write('<?xml version="1.0" encoding="' + FCharacterEncoding + '"?>');
 if FXMIDTDFile <> '' then
  Write('<!DOCTYPE XMI SYSTEM "' + FXMIDTDFile + '">');   //write DTD
   if FXMIXSLFile <> '' then                            //write XSL
    Write('<?xml-stylesheet type="text/xsl" href="' + FXMIXSLFile + '" ?>');
 Write('<XMI xmi.version="1.0">', icOpened);            //start XMI
 Write( '<XMI.header>', icOpened);                      //start the header
 Write(  '<XMI.documentation>', icOpened);              //write exporter
 Write(   '<XMI.exporter>JADD - Just Another DelphiDoc; XMI Exporter</XMI.exporter>');
 Write(   '<XMI.exporterVersion>1</XMI.exporterVersion>');
 Write(  '</XMI.documentation>', icClosed);
 Write(  '<XMI.metamodel xmi.name="UML" xmi.version="1.3"/>'); //write version
 Write( '</XMI.header>', icClosed);
 Write( '<XMI.content>', icOpened);

 Write(  '<Model_Management.Model>', icOpened);
 if FProjectName <> '' then                             //write name of model
  Write(   '<Foundation.Core.ModelElement.name>' + FProjectName +
           '</Foundation.Core.ModelElement.name>')
 else
  Write(   '<Foundation.Core.ModelElement.name>DelphiDoc-Project-Model</Foundation.Core.ModelElement.name>');

 Write(   '<Foundation.Core.Namespace.ownedElement>', icOpened);
end;


{Writes the footer of the XMI file. }
procedure TUMLXMIExportDoc.WriteXMIFooter;
begin
 Write(   '</Foundation.Core.Namespace.ownedElement>', icClosed);
 Write(  '</Model_Management.Model>', icClosed);  //close the model
 Write( '</XMI.content>', icClosed);              //close the body
 Write('</XMI>', icClosed);                       //close the file
end;






















{Extracts the file from the resources and writes it decompressed.
~param ResourceID the ID of the resource to extract and write decompressed
~param FileName   the name of the file to write to }
procedure TUMLXMIExportDoc.CreateFileFromResource(ResourceID: Integer;
                                                  const FileName: String);

 {Copies the Data from the Stream Source to Dest.
 ~param Source the stream with the data to copy
 ~param Dest   the stream to copy the data to }
 procedure CopyFrom(Source, Dest: TStream);
 const     MaxBufSize = $F000;
 var       Buffer              :^Byte;    //buffer to copy
           Count               :Integer;  //number of read and written bytes
 begin
  GetMem(Buffer, MaxBufSize);             //get the buffer
  try
    repeat
      Count := Source.Read(Buffer^, MaxBufSize); //read from stream
      Count := Dest.Write(Buffer^, Count);       //write read bytes
    until Count <> MaxBufSize;            //until everything read
  finally
   FreeMem(Buffer);                       //free the buffer
  end;
 end;


var       DF              :TFileStream;      //the destination file to write
          Resource        :TResourceStream;  //to read the text of the DTD
          Decompressor    :TDecompressionStream; //to decompress the DTD
begin
 //open the file
 DF := TFileStream.Create(FDestPath + FileName, fmCreate or fmShareDenyWrite);
 try
   //create the stream to read the text out of the resources
   try
     Resource := TResourceStream.CreateFromID(0, ResourceID, RT_RCDATA);
   except
     on EAccessViolation do                    //real old error in CreateFromID
      raise EResNotFound.CreateFmt('Resource %d of file "%s" to extract not found!',
                                   [ResourceID, ExtractFileName(FileName)])
     else
      raise;
   end;
   try
     //create the decompressor            (640 kb <--> 28 kb)
     Decompressor := TDecompressionStream.Create(Resource);
     try
       //copy from resource- to file stream while decompressing
       CopyFrom(Decompressor, DF);
       //TStream.CopyFrom does a seek to the end to get the size,
       //that is not allowed for TDecompressionStream
     finally
      Decompressor.Free;                                 //free decompressor
     end;
   finally
    Resource.Free;                                       //free the stream
   end;
 finally
  DF.Free;                                              //close the file
 end;
end;









{Process parsed data; i.e. in this case save the source code of the parsed
 files into files in a directory tree.
~result if the files have been successfully saved and it hasn't been aborted }
function TUMLXMIExportDoc.DoGenerateDocumentation: Boolean;

 {Creates or clears all used lists. }
 procedure RefreshLists;
 begin
  if assigned(FUnknownDataTypes) then        //if list not yet created
   FUnknownDataTypes.Clear                     //clear it
  else
   FUnknownDataTypes := TStringList.Create;    //create it
 end;


var      FileName        :String;       //name of the file to be generated
begin
 CreateDocumentationDirectory;          //create path of the main directory


 FileName := FXMIFileName;
 if TrimLeft(FileName) = '' then        //no name for the file specified?
  FileName := DefaultUMLXMIFileName;      //use default
 //no extension or at least not the correct one?
 if LowerCase(ExtractFileExt(FileName)) <> UMLXMIFileExtension then
  FileName := FileName + UMLXMIFileExtension;   //add the extension



 Progress.Reset;
 Progress.SetThrowExceptionOnStepIfAbort(True);

 Progress.SetWorkText('Saving Files...');
 Progress.SetProgressText('');
 Progress.SetProcessText('');

 Progress.SetMaximum(FFiles.Count);

 if FCreateDTDFile then                         //DTD file should be written?
  CreateFileFromResource(600, UMLXMIDTDFileName); //write it

 if FCreateXSLFile then                         //XSL file should be written?
  CreateFileFromResource(601, XMIXSLFileName);    //write it


 RefreshLists;                                  //prepare for generation


 AssignFile(FXMIFile, FDestPath + FileName);
 Rewrite(FXMIFile);                             //open the file
 try
   FCurrentTagLevel := 0;                       //it's empty, no indentation

   WriteXMIHeader;                              //write the header


   WriteFiles;                                  //write all known types
   WriteUnknownTypes;                           //write used unknown types


   WriteXMIFooter;                              //write the footer

   assert(FCurrentTagLevel = 0);
 finally
  CloseFile(FXMIFile);                          //close the file
 end;


{$IFNDEF LINUX}              

 //if possible: launch the XMI file
 if AutoLaunchDocumentation and
    (ShellExecute(0, 'open', PChar(FDestPath + FileName), nil, nil,
                  SW_SHOWNORMAL) <= 32) then
  if GetLastError <> ERROR_NO_ASSOCIATION then
   raise Exception.CreateFmt('Can''t launch XMI-file: GetLastError: %d' + LineDelimiter + '%s',
                             [GetLastError, SysErrorMessage(GetLastError)])
  else
   raise Exception.Create('.xmi-files are not associated with any program. If you don''t have any UML programs, try viewing it with a XML capable web browser (XSL file is included).' + LineDelimiter + 
                          SysErrorMessage(ERROR_NO_ASSOCIATION));

{$ENDIF}


 Progress.Reset;
 Progress.SetWorkText('Finished writing files!');
 Progress.SetProgressText('Finished!');
 Progress.SetProcessText('');
 Progress.SetMaximum(1);
 Progress.StepProgress;

 Result := True;
end;






initialization
{$IFOPT C+}
 TUMLXMIExportDoc.Create.Destroy;      //generate warning, if class is abstract
{$ENDIF}
 AddGeneratorClass(TUMLXMIExportDoc);  //register generator class

end.