uichtmlhelpdoc.pas

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

var       FileFormats   :TFileClassTreeFileFormat;
begin
 //check each file format
 for FileFormats := Low(FileFormats) to High(FileFormats) do
  if FileFormats in GenerateFileClassTreeFormats then  //has been generated?
   Inc(FGeneratedFileCount);                //count it

 inherited WriteFileListFileLinks(F);    //write the links
end;

{Write the links to the generated files by ~[link WriteClassesTreeFiles].
~param Kind the kind of the record-like types (record/class/interface/...)
~param F    the file to write the links to }
procedure TICHTMLHelpDoc.WriteClassTreeFileLinks(Kind: TRecordKind;
                                                 F: TBufferStream);
          //runner through file formats
var       FileFormats   :TFileClassTreeFileFormat;
begin
 //check each file format
 for FileFormats := Low(FileFormats) to High(FileFormats) do
  if FileFormats in GenerateFileClassTreeFormats then  //has been generated?
   Inc(FGeneratedFileCount);                //count it

 inherited WriteClassTreeFileLinks(Kind, F);  //write the links
end;




























{Gets the special object tag to register the key words as a string.
~param KeyWords the key words of a HTML file to return as a tag, they have to
                be already quoted for the HTML format (especially all quotes
                '~[code "]' as '~[code "]')
~result the object tag to register the key words, an empty string if the key
        words are also empty }
function TICHTMLHelpDoc.GetKeyWordsTagObject(const KeyWords: String): String;
var      KeyWord       :String;      //each single key word
         i             :Integer;     //index of separator between key words
begin
 if KeyWords <> '' then              //key words specified?
  begin                                //start object to define key words
   Result := '  <object type="application/x-oleobject" classid="clsid:1e2a7bd0-dab9-11d0-b93a-00c04fc99f9e">' +
             NewLine;

   KeyWord := KeyWords;
   i := Pos(';', KeyWords);            //get separator of key words
   while i <> 0 do                     //list of multiple key words?
    begin                                //write next key word
     Result := Result + '    <param name="Keyword" value="' +
                        Copy(KeyWord, 1, i - 1) + '"';
     if XMLConformity then
      Result := Result + ' /';             //close the empty tag
     Result := Result + '>' + NewLine;
     Delete(KeyWord, 1, i);              //remove it from the list
     KeyWord := TrimLeft(KeyWord);       //remove leading spaces
     i := Pos(';', KeyWord);             //get next separator
    end;
                                       //write the (last) key word
   Result := Result + '    <param name="Keyword" value="' +
                      TrimRight(KeyWord) + '"';
   if XMLConformity then
    Result := Result + ' /';             //close the empty tag
   Result := Result + '>' +
                      NewLine +
                      '  </object>' +  //end object to define key words
                      NewLine;
  end
 else
  Result := '';
end;




{Creates a new HTML file and writes its header.
~param FileName          the name of the file to create
~param TitlePart         the title of the HTML page, already quoted for the
                         HTML format
~param KeyWords          the keywords of the HTML page in the index, quoted in
                         HTML
~param HeaderContentProc a method to be called to write additional content
                         into the header of the new HTML file
~result the stream to write to the file }
function TICHTMLHelpDoc.CreateFile(const FileName, TitlePart, KeyWords: String;
                                   HeaderContentProc: THeaderWriteProcedure
                                                      = nil): TBufferStream;
var      RealPath      :String;        //path using platform's path-delimiter
         KeyStr        :String;        //all keywords
         i             :Integer;       //general index and counter
         DirPath       :String;        //path of the file
         MainPath      :String;        //path to the main directory
begin
 Assert((FUseSubdirectories <> sduNone) or
        ((Pos(PathDelimiter, FileName) = 0) and (Pos('/', FileName) = 0)));

 RealPath := FileName;

 MainPath := '';
 if FUseSubdirectories <> sduNone then //uses sub-directories?
  begin
   DirPath := ExtractFilePath(RealPath); //extract path component
   i := LastPos('/', RealPath);
   if i > Length(DirPath) then
    DirPath := Copy(RealPath, 1, i);

   if DirPath <> '' then                 //is in a sub-directory?
    begin
     if PathDelimiter <> '/' then          //path-delimiter isn't "/" ?
      for i := 1 to Length(DirPath) do       //adjust path delimiter
       if RealPath[i] = '/' then               { Is this really necessary ??? }
        RealPath[i] := PathDelimiter;
     for i := 1 to Length(DirPath) do      //count level of directories
      if DirPath[i] = '/' then
       MainPath := MainPath + '../';       //go up another directory
     Assert((MainPath = '../') or (MainPath = '../../'));

     //get absolute path
     DirPath := GetAbsolutePathCurrent(FDestPath + DirPath);
     if not DirectoryExists(DirPath) then  //directory does not exist?
      if not CreateDir(DirPath) then         //create it
       //if it couldn't be created, try creating its parent directories
       ForceDirectories(DirPath);
    end;
  end;

// if FProjectName <> '' then            //name of project defined?
  //append it to the title
//  TitlePart := TitlePart + ' - ' + HandleRawText(FProjectName);

 KeyStr := ReformatKeyWords(KeyWords);



 Inc(FGeneratedFileCount);             //another file generated

 //open the file
 Result := TBufferStream.CreateFile(FDestPath + RealPath + FileExtension);
 try
   if TextHeaderFile <> '' then        //custom header supplied?
    //write the custom header
    WriteFileHeader(Result, TitlePart, KeyStr, MainPath, HeaderContentProc)
   else
    begin
     if UseXHTMLHeader then              //write the DTD of the file
      begin
       Result.WriteString('<?xml version="1.0" encoding="');
       Result.WriteString(CharacterEncoding);
       Result.WriteString('"?>');
       Result.WriteString(NewLine);
       Result.WriteString(DTD_XHTML_Text);
       Result.WriteString(NewLine);
       Result.WriteString('<html xmlns="http://www.w3.org/1999/xhtml">')
      end
     else
      begin
       Result.WriteString(DTD_HTMLTrans_Text);
       Result.WriteString(NewLine);
       Result.WriteString('<html>');
      end;
     Result.WriteString(NewLine);
     Result.WriteString('<head>');
     Result.WriteString(NewLine);
     Result.WriteString('  <meta http-equiv="Content-Type" content="text/html; charset=');
     Result.WriteString(CharacterEncoding);
     Result.WriteCharacter('"');
     Result.WriteString(EmptyTagEnd[XMLConformity]);
     Result.WriteCharacter('>');
     Result.WriteString(NewLine);
     Result.WriteString('  <meta http-equiv="Content-Style-Type" content="text/css"');
     Result.WriteString(EmptyTagEnd[XMLConformity]);
     Result.WriteCharacter('>');
     Result.WriteString(NewLine);
     Result.WriteString('  <title>');
     Result.WriteString(TitlePart);      //write the title of the page
     Result.WriteString('</title>');
     Result.WriteString(NewLine);
     if KeyWords <> '' then
      begin                                //write key words
       Result.WriteString('  <meta name="keywords" content="');
       Result.WriteString(KeyStr);
       Result.WriteCharacter('"');
       Result.WriteString(EmptyTagEnd[XMLConformity]);
       Result.WriteCharacter('>');
       Result.WriteString(NewLine);
      end;
     Result.WriteString('  <link rel="stylesheet" type="text/css" href="');
     Result.WriteString(MainPath);
     Result.WriteString(CSSFileName);    //include the CSS file
     Result.WriteString('" title="Style"');
     Result.WriteString(EmptyTagEnd[XMLConformity]);
     Result.WriteCharacter('>');
     Result.WriteString(NewLine);

     if Assigned(HeaderContentProc) then //additional content for the header?
      HeaderContentProc(Result);           //let it be written

     Result.WriteString('</head>');
     Result.WriteString(NewLine);
     Result.WriteString('<body>');
     Result.WriteString(NewLine);

     if UseXHTMLHeader then              //if it has to conform to XHTML
      begin
       Result.WriteString('<div>');        //create a block element to allow
       Result.WriteString(NewLine);          //text outside of paragraphs
      end;
    end; //else TextHeaderFile <> ''

   //write special object tag to register the key words
   Result.WriteString(GetKeyWordsTagObject(KeyWords));

   if CurrentUserDocPage <> -1 then    //for user documentation
    begin
     Result.WriteString('<h1 class="userdoc">');
     Result.WriteString(TitlePart);      //write the title of the page
     Result.WriteString('</h1>');
     Result.WriteString(NewLine);
    end; //if CurrentUserDocPage <> -1

 except                                //in case of an error
   Result.Free;                          //close the file, then
   raise;                                //forward the error
 end;
end;




{Writes the footer of a HTML file and closes it.
~param F the HTML file to end and close }
procedure TICHTMLHelpDoc.EndFile(F: TBufferStream);
begin
 try
   if TextFooterFile <> '' then       //custom footer supplied?
    F.WriteString(FTextFooter)          //just write it
   else
    begin
     if UseXHTMLHeader then             //if it has to conform to XHTML
      begin
       F.WriteString('</div>');           //end the block element with all the
       F.WriteString(NewLine);             //content
      end;

     F.WriteString('</body>');
     F.WriteString(NewLine);
     F.WriteString('</html>');          //end the HTML file
    end;
   F.WriteString(NewLine);
 finally
  F.Free;                             //finally close the file
 end;
end;




{Inserts an entry into the content file.
~param Text   the text of the topic in the content file (already quoted in
              HTML)
~param Target the target of the topic, without the file extension }
procedure TICHTMLHelpDoc.AddContentEntry(const Text, Target: String);
begin
 Assert(Pos('#', Target) = 0);             //no sub-topics in HTML Help
 //no file extension needed at its end
 Assert(Copy(Target, Length(Target) - Length(FileExtension) + 1,
             Length(FileExtension)) <> FileExtension);

 FContentFile.WriteString(StringOfChar(' ', FContentLevel));
 FContentFile.WriteString('<LI><OBJECT type="text/sitemap"><param name="Name" value="');
 FContentFile.WriteString(Text);
 FContentFile.WriteString('"><param name="Local" value="');
 FContentFile.WriteString(Target);
// if Pos('#', Target) = 0 then
 FContentFile.WriteString(FileExtension);
 FContentFile.WriteString('"></OBJECT></LI>');
 FContentFile.WriteString(NewLine);
end;

{Starts a new list of sub-topics in the content file.
~param Text the text of the list of topics (already quoted in HTML) }
procedure TICHTMLHelpDoc.StartContentList(const Text: String);
begin
 FContentFile.WriteString(StringOfChar(' ', FContentLevel));
 FContentFile.WriteString('<LI><OBJECT type="text/sitemap"><param name="Name" value="');
 FContentFile.WriteString(Text);
 FContentFile.WriteString('"></OBJECT><UL>');   //open the tag of the sub-list
 FContentFile.WriteString(NewLine);

 Inc(FContentLevel);                            //increment current depth
end;

{Ends a list of sub-topics. }
procedure TICHTMLHelpDoc.EndContentList;
begin
 Assert(FContentLevel > 0);

 Dec(FContentLevel);                            //decrement current depth

 FContentFile.WriteString(StringOfChar(' ', FContentLevel));
 FContentFile.WriteString('</UL></LI>');        //close the tag of the sub-list
 FContentFile.WriteString(NewLine);
end;










{Returns the absolute unique ID of an identifier to be used in the
 documentation. Is is used as the name of the file (without extension) to be
 created for it.
~param Ident   the identifier to return a link to (may be nil, to return a link
               to the file)
~param TheFile the file the identifier is defined in
~param Local   if it should be local, without directory
~result the absolute unique ID of the identifier }
function TICHTMLHelpDoc.GetFileName(Ident: TIdentifier;
                                    TheFile: TPascalFile = nil;
                                    Local: Boolean = False): String;
var      TheRecord     :TRecordType;   //the record-like type of the identifier
begin
 if FUseSubdirectories <> sduNone then //uses sub-directories?
  begin
   Assert(Assigned(Ident) <> Assigned(TheFile));
   Assert(not DoNotDocumentIdentifier(Ident, TheFile));

   if Assigned(Ident) then
    begin
     TheFile := Ident.InFile;