12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229 |
- {
- FPDoc - Free Pascal Documentation Tool
- Copyright (C) 2000 - 2003 by
- Areca Systems GmbH / Sebastian Guenther, [email protected]
- 2005-2012 by
- various FPC contributors
- * 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 <remark> 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 <link> in unit "%s", element "%s", is unknown: "%s"';
- SErrUnknownPrintShortID = 'Warning: Target ID of <printshort> 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;
- TWriterLogEvent = Procedure(Sender : TObject; Const Msg : String) of object;
- TWriterNoteEvent = Procedure(Sender : TObject; Note : TDomElement; Var EmitNote : Boolean) of object;
-
- { TFPDocWriter }
- TFPDocWriter = class
- private
- FEmitNotes: Boolean;
- FEngine : TFPDocEngine;
- FPackage : TPasPackage;
- FContext : TPasElement;
- FTopics : TList;
- FImgExt : String;
- FBeforeEmitNote : TWriterNoteEvent;
- procedure ConvertURL(AContext: TPasElement; El: TDOMElement);
-
- protected
- Procedure DoLog(Const Msg : String);
- Procedure DoLog(Const Fmt : String; Args : Array of const);
- 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 ConvertNotes(AContext: TPasElement; El: TDOMElement): Boolean; virtual;
- 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 DescrEmitNotesHeader(AContext : TPasElement); virtual;
- Procedure DescrEmitNotesFooter(AContext : TPasElement); virtual;
- 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;
- Property CurrentContext : TPasElement Read FContext ;
- 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 Function FileNameExtension : String; virtual;
- Class Procedure Usage(List : TStrings); virtual;
- Class procedure SplitImport(var AFilename, ALinkPrefix: String); 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);
- Property EmitNotes : Boolean Read FEmitNotes Write FEmitNotes;
- Property BeforeEmitNote : TWriterNoteEvent Read FBeforeEmitNote Write FBeforeEmitNote;
- 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<L) do
- begin
- Result:=P^ in [#32,#10,#9,#13];
- Inc(P);
- Inc(I);
- end;
- end;
- { ---------------------------------------------------------------------
- TFPDocWriter
- ---------------------------------------------------------------------}
- {
- fmtIPF:
- begin
- if Length(Engine.Output) = 0 then
- WriteLn(SCmdLineOutputOptionMissing)
- else
- CreateIPFDocForPackage(Engine.Package, Engine);
- end;
- }
- Constructor TFPDocWriter.Create(APackage: TPasPackage; AEngine: TFPDocEngine);
- begin
- inherited Create;
- FEngine := AEngine;
- FPackage := APackage;
- FTopics:=Tlist.Create;
- FImgExt:='.png';
- end;
- destructor TFPDocWriter.Destroy;
- Var
- i : integer;
- begin
- For I:=0 to FTopics.Count-1 do
- TTopicElement(FTopics[i]).Free;
- FTopics.Free;
- Inherited;
- end;
- function TFPDocWriter.InterpretOption(const Cmd, Arg: String): Boolean;
- begin
- Result:=False;
- end;
- class function TFPDocWriter.FileNameExtension: String;
- begin
- //Override in linear writers with the expected extension.
- Result := ''; //Output must not contain an extension.
- end;
- class procedure TFPDocWriter.Usage(List: TStrings);
- begin
- // Do nothing.
- end;
- class procedure TFPDocWriter.SplitImport(var AFilename, ALinkPrefix: String);
- var
- i: integer;
- begin
- //override in HTML and CHM writer
- i := Pos(',', AFilename);
- if i > 0 then
- begin //split CSV into filename and prefix
- ALinkPrefix := Copy(AFilename,i+1,Length(AFilename));
- SetLength(AFilename, i-1);
- end;
- end;
- Function TFPDocWriter.FindTopicElement(Node : TDocNode): TTopicElement;
- Var
- I : Integer;
- begin
- Result:=Nil;
- I:=FTopics.Count-1;
- While (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
- DoLog('%s : No support for images yet: %s (caption: "%s")',[ClassName,AFileName,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
- DoLog('[%s] %s',[AContext.PathName,AMsg])
- else
- DoLog('[<no context>] %s', [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;
- FContext:=AContext;
- try
- 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;
- finally
- FContext:=Nil;
- end;
- end;
- function TFPDocWriter.ConvertNotes(AContext: TPasElement; El: TDOMElement
- ): Boolean;
- Var
- L : TFPList;
- N : TDomNode;
- I : Integer;
- B : Boolean;
- begin
- Result:=Assigned(El) and EmitNotes;
- If Not Result then
- exit;
- L:=TFPList.Create;
- try
- N:=El.FirstChild;
- While Assigned(N) do
- begin
- If (N.NodeType=ELEMENT_NODE) and (N.NodeName='note') then
- begin
- B:=True;
- if Assigned(FBeforeEmitNote) then
- FBeforeEmitNote(Self,TDomElement(N),B);
- If B then
- L.Add(N);
- end;
- N:=N.NextSibling;
- end;
- Result:=L.Count>0;
- If Not Result then
- exit;
- DescrEmitNotesHeader(AContext);
- DescrBeginUnorderedList;
- For i:=0 to L.Count-1 do
- begin
- DescrBeginListItem;
- ConvertExtShortOrNonSectionBlocks(AContext, TDOMNode(L[i]).FirstChild);
- DescrEndListItem;
- end;
- DescrEndUnorderedList;
- DescrEmitNotesFooter(AContext);
- finally
- L.Free;
- end;
- 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;
- hlp : 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);
- hlp:=AContext;
- while assigned(hlp) and not (hlp is TPasModule) do
- hlp:=hlp.parent;
- if not (hlp is TPasModule) then
- hlp:=nil;
- DescrEl := Engine.FindShortDescr(TPasModule(hlp), 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;
- procedure TFPDocWriter.DoLog(const Msg: String);
- begin
- If Assigned(FEngine.OnLog) then
- FEngine.OnLog(Self,Msg);
- end;
- procedure TFPDocWriter.DoLog(const Fmt: String; Args: array of const);
- begin
- DoLog(Format(Fmt,Args));
- 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
- FContext:=AContext;
- try
- 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;
- finally
- FContext:=Nil;
- end;
- 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, ['<table>']);
- 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, ['<code>']);
- 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;
- procedure TFPDocWriter.DescrEmitNotesHeader(AContext: TPasElement);
- begin
- DescrWriteLinebreak;
- DescrBeginBold;
- DescrWriteText(SDocNotes);
- DescrEndBold;
- DescrWriteLinebreak;
- end;
- procedure TFPDocWriter.DescrEmitNotesFooter(AContext: TPasElement);
- begin
- DescrWriteLinebreak;
- 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.
|