{ FPDoc - Free Pascal Documentation Tool Copyright (C) 2000 - 2003 by Areca Systems GmbH / Sebastian Guenther, sg@freepascal.org * Output string definitions * Basic writer (output generator) class See the file COPYING, included in this distribution, for details about the copyright. This program 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. } unit dWriter; {$MODE objfpc} {$H+} interface uses Classes, DOM, dGlobals, PasTree, SysUtils; resourcestring SErrFileWriting = 'An error occured during writing of file "%s": %s'; SErrInvalidShortDescr = 'Invalid short description'; SErrInvalidDescr = 'Invalid description (illegal XML element: "%s")'; SErrInvalidParaContent = 'Invalid paragraph content'; SErrInvalidElementInList = 'Invalid element in list - only "li" allowed'; SErrInvalidListContent = 'Invalid list content'; SErrInvalidRemarkContent = 'Invalid content (illegal XML element: "%s")'; SErrListIsEmpty = 'List is empty - need at least one "li" element'; SErrInvalidDefinitionTermContent = 'Invalid content in definition term'; SErrDefinitionEntryMissing = 'Definition entry after definition term is missing'; SErrInvalidBorderValue = 'Invalid "border" value for %s'; SErrInvalidTableContent = 'Invalid table content'; SErrTableRowEmpty = 'Table row is empty (no "td" elements found)'; SErrInvalidContentBeforeSectionTitle = 'Invalid content before section title'; SErrSectionTitleExpected = 'Section title ("title" element) expected'; SErrDescrTagUnknown = 'Warning: Unknown tag "%s" in description'; SErrUnknownEntityReference = 'Warning: Unknown entity reference "&%s;" found'; SErrUnknownLinkID = 'Warning: Target ID of is unknown: "%s"'; SErrUnknownPrintShortID = 'Warning: Target ID of is unknown: "%s"'; SErrUnknownLink = 'Could not resolve link to "%s"'; SErralreadyRegistered = 'Class for output format "%s" already registered'; SErrUnknownWriterClass = 'Unknown output format "%s"'; type // Phony element for pas pages. TTopicElement = Class(TPaselement) TopicNode : TDocNode; Previous, Next : TPasElement; Subtopics : TList; Constructor Create(const AName: String; AParent: TPasElement); override; Destructor Destroy; override; end; { TFPDocWriter } TFPDocWriter = class private FEngine : TFPDocEngine; FPackage : TPasPackage; FTopics : TList; FImgExt : String; procedure ConvertURL(AContext: TPasElement; El: TDOMElement); protected procedure Warning(AContext: TPasElement; const AMsg: String); procedure Warning(AContext: TPasElement; const AMsg: String; const Args: array of const); // function FindShortDescr(const Name: String): TDOMElement; // Description conversion function IsDescrNodeEmpty(Node: TDOMNode): Boolean; function IsExtShort(Node: TDOMNode): Boolean; function ConvertShort(AContext: TPasElement; El: TDOMElement): Boolean; function ConvertBaseShort(AContext: TPasElement; Node: TDOMNode): Boolean; procedure ConvertBaseShortList(AContext: TPasElement; Node: TDOMNode; MayBeEmpty: Boolean); procedure ConvertLink(AContext: TPasElement; El: TDOMElement); function ConvertExtShort(AContext: TPasElement; Node: TDOMNode): Boolean; procedure ConvertDescr(AContext: TPasElement; El: TDOMElement; AutoInsertBlock: Boolean); function ConvertNonSectionBlock(AContext: TPasElement; Node: TDOMNode): Boolean; procedure ConvertExtShortOrNonSectionBlocks(AContext: TPasElement; Node: TDOMNode); function ConvertSimpleBlock(AContext: TPasElement; Node: TDOMNode): Boolean; Function FindTopicElement(Node : TDocNode): TTopicElement; Procedure ConvertImage(El : TDomElement); procedure DescrWriteText(const AText: DOMString); virtual; abstract; procedure DescrBeginBold; virtual; abstract; procedure DescrEndBold; virtual; abstract; procedure DescrBeginItalic; virtual; abstract; procedure DescrEndItalic; virtual; abstract; procedure DescrBeginEmph; virtual; abstract; procedure DescrEndEmph; virtual; abstract; procedure DescrWriteImageEl(const AFileName, ACaption,ALinkName : DOMString); virtual; procedure DescrWriteFileEl(const AText: DOMString); virtual; abstract; procedure DescrWriteKeywordEl(const AText: DOMString); virtual; abstract; procedure DescrWriteVarEl(const AText: DOMString); virtual; abstract; procedure DescrBeginLink(const AId: DOMString); virtual; abstract; procedure DescrEndLink; virtual; abstract; procedure DescrBeginURL(const AURL: DOMString); virtual; abstract; procedure DescrEndURL; virtual; abstract; procedure DescrWriteLinebreak; virtual; abstract; procedure DescrBeginParagraph; virtual; abstract; procedure DescrEndParagraph; virtual; abstract; procedure DescrBeginCode(HasBorder: Boolean; const AHighlighterName: String); virtual; abstract; procedure DescrWriteCodeLine(const ALine: String); virtual; abstract; procedure DescrEndCode; virtual; abstract; procedure DescrBeginOrderedList; virtual; abstract; procedure DescrEndOrderedList; virtual; abstract; procedure DescrBeginUnorderedList; virtual; abstract; procedure DescrEndUnorderedList; virtual; abstract; procedure DescrBeginDefinitionList; virtual; abstract; procedure DescrEndDefinitionList; virtual; abstract; procedure DescrBeginListItem; virtual; abstract; procedure DescrEndListItem; virtual; abstract; procedure DescrBeginDefinitionTerm; virtual; abstract; procedure DescrEndDefinitionTerm; virtual; abstract; procedure DescrBeginDefinitionEntry; virtual; abstract; procedure DescrEndDefinitionEntry; virtual; abstract; procedure DescrBeginSectionTitle; virtual; abstract; procedure DescrBeginSectionBody; virtual; abstract; procedure DescrEndSection; virtual; abstract; procedure DescrBeginRemark; virtual; abstract; procedure DescrEndRemark; virtual; abstract; procedure DescrBeginTable(ColCount: Integer; HasBorder: Boolean); virtual; abstract; procedure DescrEndTable; virtual; abstract; procedure DescrBeginTableCaption; virtual; abstract; procedure DescrEndTableCaption; virtual; abstract; procedure DescrBeginTableHeadRow; virtual; abstract; procedure DescrEndTableHeadRow; virtual; abstract; procedure DescrBeginTableRow; virtual; abstract; procedure DescrEndTableRow; virtual; abstract; procedure DescrBeginTableCell; virtual; abstract; procedure DescrEndTableCell; virtual; abstract; public Constructor Create(APackage: TPasPackage; AEngine: TFPDocEngine); virtual; destructor Destroy; override; property Engine : TFPDocEngine read FEngine; Property Package : TPasPackage read FPackage; Property Topics : TList Read FTopics; Property ImageExtension : String Read FImgExt Write FImgExt; // Should return True if option was succesfully interpreted. Function InterpretOption(Const Cmd,Arg : String) : Boolean; Virtual; Class Procedure Usage(List : TStrings); virtual; procedure WriteDoc; virtual; Abstract; Function WriteDescr(Element: TPasElement) : TDocNode; procedure WriteDescr(Element: TPasElement; DocNode: TDocNode); procedure WriteDescr(AContext: TPasElement; DescrNode: TDOMElement); virtual; Procedure FPDocError(Msg : String); Procedure FPDocError(Fmt : String; Args : Array of Const); Function ShowMember(M : TPasElement) : boolean; Procedure GetMethodList(ClassDecl: TPasClassType; List : TStringList); end; TFPDocWriterClass = Class of TFPDocWriter; EFPDocWriterError = Class(Exception); // Register backend Procedure RegisterWriter(AClass : TFPDocWriterClass; Const AName,ADescr : String); // UnRegister backend Procedure UnRegisterWriter(Const AName : String); // Return back end class. Exception if not found. Function GetWriterClass(AName : String) : TFPDocWriterClass; // Return index of back end class. Function FindWriterClass(AName : String) : Integer; // List of backend in name=descr form. Procedure EnumWriters(List : TStrings); implementation { --------------------------------------------------------------------- Writer registration ---------------------------------------------------------------------} Type { TWriterRecord } TWriterRecord = Class(TObject) Private FClass : TFPDocWriterClass; FName : String; FDescription : String; Public Constructor Create (AClass : TFPDocWriterClass; Const AName,ADescr : String); end; { TWriterRecord } constructor TWriterRecord.Create(AClass: TFPDocWriterClass; const AName, ADescr: String); begin FClass:=AClass; FName:=AName; FDescription:=ADescr; end; Var Writers : TStringList; Procedure InitWriterList; begin Writers:=TStringList.Create; Writers.Sorted:=True; end; Procedure DoneWriterList; Var I : Integer; begin For I:=Writers.Count-1 downto 0 do Writers.Objects[i].Free; FreeAndNil(Writers); end; procedure RegisterWriter(AClass : TFPDocWriterClass; Const AName, ADescr : String); begin If Writers.IndexOf(AName)<>-1 then Raise EFPDocWriterError.CreateFmt(SErralreadyRegistered,[ANAme]); Writers.AddObject(AName,TWriterRecord.Create(AClass,AName,ADescr)); end; function FindWriterClass(AName : String) : Integer; begin Result:=Writers.IndexOf(AName); end; function GetWriterClass(AName : String) : TFPDocWriterClass; Var Index : Integer; begin Index:=FindWriterClass(AName); If Index=-1 then Raise EFPDocWriterError.CreateFmt(SErrUnknownWriterClass,[ANAme]); Result:=(Writers.Objects[Index] as TWriterRecord).FClass; end; // UnRegister backend Procedure UnRegisterWriter(Const AName : String); Var Index : Integer; begin Index:=Writers.IndexOf(AName); If Index=-1 then Raise EFPDocWriterError.CreateFmt(SErrUnknownWriterClass,[ANAme]); Writers.Objects[Index].Free; Writers.Delete(Index); end; Procedure EnumWriters(List : TStrings); Var I : Integer; begin List.Clear; For I:=0 to Writers.Count-1 do With (Writers.Objects[I] as TWriterRecord) do List.Add(FName+'='+FDescription); end; function IsWhitespaceNode(Node: TDOMText): Boolean; var I,L: Integer; S: DOMString; P : PWideChar; begin S := Node.Data; Result := True; I:=0; L:=Length(S); P:=PWideChar(S); While Result and (I=0) and (Result=Nil) do begin If (TTopicElement(FTopics[i]).TopicNode=Node) Then Result:=TTopicElement(FTopics[i]); Dec(I); end; end; Procedure TFPDocWriter.DescrWriteImageEl(const AFileName, ACaption,ALinkName : DOMString); begin system.writeln(ClassName,': No support for images yet: ',AFileName,' (caption: "',ACaption,'")'); end; { --------------------------------------------------------------------- Generic documentation node conversion ---------------------------------------------------------------------} function IsContentNodeType(Node: TDOMNode): Boolean; begin Result := (Node.NodeType = ELEMENT_NODE) or ((Node.NodeType = TEXT_NODE) and not IsWhitespaceNode(TDOMText(Node))) or (Node.NodeType = ENTITY_REFERENCE_NODE); end; procedure TFPDocWriter.Warning(AContext: TPasElement; const AMsg: String); begin if (AContext<>nil) then WriteLn('[', AContext.PathName, '] ', AMsg) else WriteLn('[] ', AMsg); end; procedure TFPDocWriter.Warning(AContext: TPasElement; const AMsg: String; const Args: array of const); begin Warning(AContext, Format(AMsg, Args)); end; function TFPDocWriter.IsDescrNodeEmpty(Node: TDOMNode): Boolean; var Child: TDOMNode; begin if (not Assigned(Node)) or (not Assigned(Node.FirstChild)) then Result := True else begin Child := Node.FirstChild; while Assigned(Child) do begin if (Child.NodeType = ELEMENT_NODE) or (Child.NodeType = TEXT_NODE) or (Child.NodeType = ENTITY_REFERENCE_NODE) then begin Result := False; exit; end; Child := Child.NextSibling; end; end; Result := True; end; { Check wether the nodes starting with the node given as argument make up an 'extshort' production. } function TFPDocWriter.IsExtShort(Node: TDOMNode): Boolean; begin while Assigned(Node) do begin if Node.NodeType = ELEMENT_NODE then if (Node.NodeName <> 'br') and (Node.NodeName <> 'link') and (Node.NodeName <> 'url') and (Node.NodeName <> 'b') and (Node.NodeName <> 'file') and (Node.NodeName <> 'i') and (Node.NodeName <> 'kw') and (Node.NodeName <> 'printshort') and (Node.NodeName <> 'var') then begin Result := False; exit; end; Node := Node.NextSibling; end; Result := True; end; function TFPDocWriter.ConvertShort(AContext: TPasElement; El: TDOMElement): Boolean; var Node: TDOMNode; begin Result := False; if not Assigned(El) then exit; Node := El.FirstChild; while Assigned(Node) do begin if (Node.NodeType = ELEMENT_NODE) and (Node.NodeName = 'link') then ConvertLink(AContext, TDOMElement(Node)) else if (Node.NodeType = ELEMENT_NODE) and (Node.NodeName = 'url') then ConvertURL(AContext, TDOMElement(Node)) else if not ConvertBaseShort(AContext, Node) then exit; Node := Node.NextSibling; end; Result := True; end; function TFPDocWriter.ConvertBaseShort(AContext: TPasElement; Node: TDOMNode): Boolean; function ConvertText: DOMString; var s: DOMString; i: Integer; begin if Node.NodeType = TEXT_NODE then begin s := Node.NodeValue; i := 1; SetLength(Result, 0); while i <= Length(s) do if s[i] = #13 then begin Result := Result + ' '; Inc(i); if s[i] = #10 then Inc(i); end else if s[i] = #10 then begin Result := Result + ' '; Inc(i); end else begin Result := Result + s[i]; Inc(i); end; end else if Node.NodeType = ENTITY_REFERENCE_NODE then if Node.NodeName = 'fpc' then Result := 'Free Pascal' else if Node.NodeName = 'delphi' then Result := 'Delphi' else begin Warning(AContext, Format(SErrUnknownEntityReference, [Node.NodeName])); Result := Node.NodeName; end else if Node.NodeType = ELEMENT_NODE then SetLength(Result, 0); end; function ConvertTextContent: DOMString; begin SetLength(Result, 0); Node := Node.FirstChild; while Assigned(Node) do begin Result := Result + ConvertText; Node := Node.NextSibling; end; end; var El, DescrEl: TDOMElement; FPEl: TPasElement; begin Result := True; if Node.NodeType = ELEMENT_NODE then if Node.NodeName = 'b' then begin DescrBeginBold; ConvertBaseShortList(AContext, Node, False); DescrEndBold; end else if Node.NodeName = 'i' then begin DescrBeginItalic; ConvertBaseShortList(AContext, Node, False); DescrEndItalic; end else if Node.NodeName = 'em' then begin DescrBeginEmph; ConvertBaseShortList(AContext, Node, False); DescrEndEmph; end else if Node.NodeName = 'file' then DescrWriteFileEl(ConvertTextContent) else if Node.NodeName = 'kw' then DescrWriteKeywordEl(ConvertTextContent) else if Node.NodeName = 'printshort' then begin El := TDOMElement(Node); DescrEl := Engine.FindShortDescr(AContext.GetModule, El['id']); if Assigned(DescrEl) then ConvertShort(AContext, DescrEl) else begin Warning(AContext, Format(SErrUnknownPrintShortID, [El['id']])); DescrBeginBold; DescrWriteText('#ShortDescr:' + El['id']); DescrEndBold; end; end else if Node.NodeName = 'var' then DescrWriteVarEl(ConvertTextContent) else Result := False else DescrWriteText(ConvertText); end; procedure TFPDocWriter.ConvertBaseShortList(AContext: TPasElement; Node: TDOMNode; MayBeEmpty: Boolean); var Child: TDOMNode; begin Child := Node.FirstChild; while Assigned(Child) do begin if not ConvertBaseShort(AContext, Child) then Warning(AContext, SErrInvalidShortDescr) else MayBeEmpty := True; Child := Child.NextSibling; end; if not MayBeEmpty then Warning(AContext, SErrInvalidShortDescr) end; procedure TFPDocWriter.ConvertLink(AContext: TPasElement; El: TDOMElement); begin DescrBeginLink(El['id']); if not IsDescrNodeEmpty(El) then ConvertBaseShortList(AContext, El, True) else DescrWriteText(El['id']); DescrEndLink; end; procedure TFPDocWriter.ConvertURL(AContext: TPasElement; El: TDOMElement); begin DescrBeginURL(El['href']); if not IsDescrNodeEmpty(El) then ConvertBaseShortList(AContext, El, True) else DescrWriteText(El['href']); DescrEndURL; end; function TFPDocWriter.ConvertExtShort(AContext: TPasElement; Node: TDOMNode): Boolean; begin Result := False; while Assigned(Node) do begin if (Node.NodeType = ELEMENT_NODE) and (Node.NodeName = 'link') then ConvertLink(AContext, TDOMElement(Node)) else if (Node.NodeType = ELEMENT_NODE) and (Node.NodeName = 'url') then ConvertURL(AContext, TDOMElement(Node)) else if (Node.NodeType = ELEMENT_NODE) and (Node.NodeName = 'br') then DescrWriteLinebreak else if not ConvertBaseShort(AContext, Node) then exit; Node := Node.NextSibling; end; Result := True; end; procedure TFPDocWriter.ConvertDescr(AContext: TPasElement; El: TDOMElement; AutoInsertBlock: Boolean); var Node, Child: TDOMNode; ParaCreated: Boolean; begin if AutoInsertBlock then if IsExtShort(El.FirstChild) then DescrBeginParagraph else AutoInsertBlock := False; Node := El.FirstChild; if not ConvertExtShort(AContext, Node) then begin while Assigned(Node) do begin if (Node.NodeType = ELEMENT_NODE) and (Node.NodeName = 'section') then begin DescrBeginSectionTitle; Child := Node.FirstChild; while Assigned(Child) and (Child.NodeType <> ELEMENT_NODE) do begin if not IsDescrNodeEmpty(Child) then Warning(AContext, SErrInvalidContentBeforeSectionTitle); Child := Child.NextSibling; end; if not Assigned(Child) or (Child.NodeName <> 'title') then Warning(AContext, SErrSectionTitleExpected) else ConvertShort(AContext, TDOMElement(Child)); DescrBeginSectionBody; if IsExtShort(Child) then begin DescrBeginParagraph; ParaCreated := True; end else ParaCreated := False; ConvertExtShortOrNonSectionBlocks(AContext, Child.NextSibling); if ParaCreated then DescrEndParagraph; DescrEndSection; end else if not ConvertNonSectionBlock(AContext, Node) then Warning(AContext, SErrInvalidDescr, [Node.NodeName]); Node := Node.NextSibling; end; end else if AutoInsertBlock then DescrEndParagraph; end; procedure TFPDocWriter.ConvertExtShortOrNonSectionBlocks(AContext: TPasElement; Node: TDOMNode); begin if not ConvertExtShort(AContext, Node) then while Assigned(Node) do begin if not ConvertNonSectionBlock(AContext, Node) then Warning(AContext, SErrInvalidDescr, [Node.NodeName]); Node := Node.NextSibling; end; end; function TFPDocWriter.ConvertNonSectionBlock(AContext: TPasElement; Node: TDOMNode): Boolean; procedure ConvertCells(Node: TDOMNode); var Child: TDOMNode; IsEmpty: Boolean; begin Node := Node.FirstChild; IsEmpty := True; while Assigned(Node) do begin if (Node.NodeType = ELEMENT_NODE) and (Node.NodeName = 'td') then begin DescrBeginTableCell; Child := Node.FirstChild; if not ConvertExtShort(AContext, Child) then while Assigned(Child) do begin if not ConvertSimpleBlock(AContext, Child) then Warning(AContext, SErrInvalidTableContent); Child := Child.NextSibling; end; DescrEndTableCell; IsEmpty := False; end else if IsContentNodeType(Node) then Warning(AContext, SErrInvalidTableContent); Node := Node.NextSibling; end; if IsEmpty then Warning(AContext, SErrTableRowEmpty); end; procedure ConvertTable; function GetColCount(Node: TDOMNode): Integer; begin Result := 0; Node := Node.FirstChild; while Assigned(Node) do begin if (Node.NodeType = ELEMENT_NODE) and (Node.NodeName = 'td') then Inc(Result); Node := Node.NextSibling; end; end; var s: String; HasBorder, CaptionPossible, HeadRowPossible: Boolean; ColCount, ThisRowColCount: Integer; Subnode: TDOMNode; begin s := TDOMElement(Node)['border']; if s = '1' then HasBorder := True else begin HasBorder := False; if (Length(s) <> 0) and (s <> '0') then Warning(AContext, SErrInvalidBorderValue, ['']); end; // Determine the number of columns ColCount := 0; Subnode := Node.FirstChild; while Assigned(Subnode) do begin if Subnode.NodeType = ELEMENT_NODE then if (Subnode.NodeName = 'caption') or (Subnode.NodeName = 'th') or (Subnode.NodeName = 'tr') then begin ThisRowColCount := GetColCount(Subnode); if ThisRowColCount > ColCount then ColCount := ThisRowColCount; end; Subnode := Subnode.NextSibling; end; DescrBeginTable(ColCount, HasBorder); Node := Node.FirstChild; CaptionPossible := True; HeadRowPossible := True; while Assigned(Node) do begin if Node.NodeType = ELEMENT_NODE then if CaptionPossible and (Node.NodeName = 'caption') then begin DescrBeginTableCaption; if not ConvertExtShort(AContext, Node.FirstChild) then Warning(AContext, SErrInvalidTableContent); DescrEndTableCaption; CaptionPossible := False; end else if HeadRowPossible and (Node.NodeName = 'th') then begin DescrBeginTableHeadRow; ConvertCells(Node); DescrEndTableHeadRow; CaptionPossible := False; HeadRowPossible := False; end else if Node.NodeName = 'tr' then begin DescrBeginTableRow; ConvertCells(Node); DescrEndTableRow; end else Warning(AContext, SErrInvalidTableContent) else if IsContentNodeType(Node) then Warning(AContext, SErrInvalidTableContent); Node := Node.NextSibling; end; DescrEndTable; end; begin if Node.NodeType <> ELEMENT_NODE then begin if Node.NodeType = TEXT_NODE then Result := IsWhitespaceNode(TDOMText(Node)) else Result := Node.NodeType = COMMENT_NODE; exit; end; if Node.NodeName = 'remark' then begin DescrBeginRemark; Node := Node.FirstChild; if not ConvertExtShort(AContext, Node) then while Assigned(Node) do begin if (Node.NodeType = ELEMENT_NODE) and (Node.NodeName = 'table') then ConvertTable else if not ConvertSimpleBlock(AContext, Node) then Warning(AContext, SErrInvalidRemarkContent, [Node.NodeName]); Node := Node.NextSibling; end; DescrEndRemark; Result := True; end else if Node.NodeName = 'table' then begin ConvertTable; Result := True; end else Result := ConvertSimpleBlock(AContext, Node); end; function TFPDocWriter.ConvertSimpleBlock(AContext: TPasElement; Node: TDOMNode): Boolean; procedure ConvertListItems; var Empty: Boolean; begin Node := Node.FirstChild; Empty := True; while Assigned(Node) do begin if ((Node.NodeType = TEXT_NODE) and not IsWhitespaceNode(TDOMText(Node))) or (Node.NodeType = ENTITY_REFERENCE_NODE) then Warning(AContext, SErrInvalidListContent) else if Node.NodeType = ELEMENT_NODE then if Node.NodeName = 'li' then begin DescrBeginListItem; ConvertExtShortOrNonSectionBlocks(AContext, Node.FirstChild); DescrEndListItem; Empty := False; end else Warning(AContext, SErrInvalidElementInList); Node := Node.NextSibling; end; if Empty then Warning(AContext, SErrListIsEmpty); end; procedure ConvertDefinitionList; var Empty, ExpectDTNext: Boolean; begin Node := Node.FirstChild; Empty := True; ExpectDTNext := True; while Assigned(Node) do begin if ((Node.NodeType = TEXT_NODE) and not IsWhitespaceNode(TDOMText(Node))) or (Node.NodeType = ENTITY_REFERENCE_NODE) then Warning(AContext, SErrInvalidListContent) else if Node.NodeType = ELEMENT_NODE then if ExpectDTNext and (Node.NodeName = 'dt') then begin DescrBeginDefinitionTerm; if not ConvertShort(AContext, TDOMElement(Node)) then Warning(AContext, SErrInvalidDefinitionTermContent); DescrEndDefinitionTerm; Empty := False; ExpectDTNext := False; end else if not ExpectDTNext and (Node.NodeName = 'dd') then begin DescrBeginDefinitionEntry; ConvertExtShortOrNonSectionBlocks(AContext, Node.FirstChild); DescrEndDefinitionEntry; ExpectDTNext := True; end else Warning(AContext, SErrInvalidElementInList); Node := Node.NextSibling; end; if Empty then Warning(AContext, SErrListIsEmpty) else if not ExpectDTNext then Warning(AContext, SErrDefinitionEntryMissing); end; procedure ProcessCodeBody(Node: TDOMNode); var s: String; i, j: Integer; begin Node := Node.FirstChild; SetLength(s, 0); while Assigned(Node) do begin if Node.NodeType = TEXT_NODE then begin s := s + Node.NodeValue; j := 1; for i := 1 to Length(s) do // In XML, linefeeds are normalized to #10 by the parser! if s[i] = #10 then begin DescrWriteCodeLine(Copy(s, j, i - j)); j := i + 1; end; if j > 1 then s := Copy(s, j, Length(s)); end; Node := Node.NextSibling; end; if Length(s) > 0 then DescrWriteCodeLine(s); end; var s: String; HasBorder: Boolean; begin if Node.NodeType <> ELEMENT_NODE then begin Result := (Node.NodeType = TEXT_NODE) and IsWhitespaceNode(TDOMText(Node)); exit; end; if Node.NodeName = 'p' then begin DescrBeginParagraph; if not ConvertExtShort(AContext, Node.FirstChild) then Warning(AContext, SErrInvalidParaContent); DescrEndParagraph; Result := True; end else if Node.NodeName = 'code' then begin s := TDOMElement(Node)['border']; if s = '1' then HasBorder := True else begin if (Length(s) > 0) and (s <> '0') then Warning(AContext, SErrInvalidBorderValue, ['']); end; DescrBeginCode(HasBorder, TDOMElement(Node)['highlighter']); ProcessCodeBody(Node); DescrEndCode; Result := True; end else if Node.NodeName = 'pre' then begin DescrBeginCode(False, 'none'); ProcessCodeBody(Node); DescrEndCode; Result := True; end else if Node.NodeName = 'ul' then begin DescrBeginUnorderedList; ConvertListItems; DescrEndUnorderedList; Result := True; end else if Node.NodeName = 'ol' then begin DescrBeginOrderedList; ConvertListItems; DescrEndOrderedList; Result := True; end else if Node.NodeName = 'dl' then begin DescrBeginDefinitionList; ConvertDefinitionList; DescrEndDefinitionList; Result := True; end else if Node.NodeName = 'img' then begin begin ConvertImage(Node as TDomElement); Result:=True; end; end else Result := False; end; Procedure TFPDocWriter.ConvertImage(El : TDomElement); Var FN,Cap,LinkName : DOMString; begin FN:=El['file']; Cap:=El['caption']; LinkName:=El['name']; FN:=ChangeFileExt(FN,ImageExtension); DescrWriteImageEl(FN,Cap,LinkName); end; Constructor TTopicElement.Create(const AName: String; AParent: TPasElement); begin Inherited Create(AName,AParent); SubTopics:=TList.Create; end; Destructor TTopicElement.Destroy; begin // Actual subtopics are freed by TFPDocWriter Topics list. SubTopics.Free; Inherited; end; Function TFPDocWriter.WriteDescr(Element: TPasElement) : TDocNode; begin Result:=Engine.FindDocNode(Element); WriteDescr(ELement,Result); end; procedure TFPDocWriter.WriteDescr(Element: TPasElement; DocNode: TDocNode); begin if Assigned(DocNode) then begin if not IsDescrNodeEmpty(DocNode.Descr) then WriteDescr(Element, DocNode.Descr) else if not IsDescrNodeEmpty(DocNode.ShortDescr) then WriteDescr(Element, DocNode.ShortDescr); end; end; procedure TFPDocWriter.WriteDescr(AContext: TPasElement; DescrNode: TDOMElement); begin if Assigned(DescrNode) then ConvertDescr(AContext, DescrNode, False); end; procedure TFPDocWriter.FPDocError(Msg: String); begin Raise EFPDocWriterError.Create(Msg); end; procedure TFPDocWriter.FPDocError(Fmt: String; Args: array of const); begin FPDocError(Format(Fmt,Args)); end; function TFPDocWriter.ShowMember(M: TPasElement): boolean; begin Result:=not ((M.Visibility=visPrivate) and Engine.HidePrivate); If Result then Result:=Not ((M.Visibility=visProtected) and Engine.HideProtected) end; Procedure TFPDocWriter.GetMethodList(ClassDecl: TPasClassType; List : TStringList); Var I : Integer; M : TPasElement; begin List.Clear; List.Sorted:=False; for i := 0 to ClassDecl.Members.Count - 1 do begin M:=TPasElement(ClassDecl.Members[i]); if M.InheritsFrom(TPasProcedureBase) and ShowMember(M) then List.AddObject(M.Name,M); end; List.Sorted:=False; end; initialization InitWriterList; finalization DoneWriterList; end.