mirror of
				https://gitlab.com/freepascal.org/fpc/source.git
				synced 2025-11-04 14:59:37 +01:00 
			
		
		
		
	
		
			
				
	
	
		
			801 lines
		
	
	
		
			19 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
			
		
		
	
	
			801 lines
		
	
	
		
			19 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
{
 | 
						|
 | 
						|
    FPDoc  -  Free Pascal Documentation Tool
 | 
						|
    Copyright (C) 2007 by the FPC team.
 | 
						|
 | 
						|
    * RTF output generator
 | 
						|
 | 
						|
    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.
 | 
						|
}
 | 
						|
{$mode objfpc}
 | 
						|
{$H+}
 | 
						|
unit dw_LinRTF;
 | 
						|
 | 
						|
interface
 | 
						|
 | 
						|
uses DOM, dGlobals, PasTree;
 | 
						|
 | 
						|
const
 | 
						|
  RTFHighLight : Boolean = False;
 | 
						|
  RTFExtension   : String = '.rtf';
 | 
						|
 | 
						|
Procedure CreateRTFDocForPackage(APackage: TPasPackage; AEngine: TFPDocEngine);
 | 
						|
 | 
						|
implementation
 | 
						|
 | 
						|
uses SysUtils, Classes, dwLinear, dwriter;
 | 
						|
 | 
						|
const
 | 
						|
  Indent = 300;
 | 
						|
 | 
						|
Type
 | 
						|
 | 
						|
  TEnvironmenttype = (etEnumerate, etItemize, etDescription);
 | 
						|
 | 
						|
  TEnvironment = class
 | 
						|
  private
 | 
						|
    fenvtype : TEnvironmenttype;
 | 
						|
    fdeltaIndent,
 | 
						|
    fdeltaMargin,
 | 
						|
    fnextitem : integer;
 | 
						|
    fprevious : TEnvironment;
 | 
						|
  public
 | 
						|
    property envtype : TEnvironmenttype read fenvtype;
 | 
						|
    property deltaIndent : integer read fdeltaIndent;
 | 
						|
    property deltaMargin : integer read fdeltaMargin;
 | 
						|
    property nextitem : integer read fnextitem;
 | 
						|
    property previous : TEnvironment read fprevious;
 | 
						|
  end;
 | 
						|
  
 | 
						|
 | 
						|
type
 | 
						|
 | 
						|
 { TRTFWriter }
 | 
						|
 | 
						|
  TRTFWriter = class(TLinearWriter)
 | 
						|
  protected
 | 
						|
    // used
 | 
						|
    FLink: String;
 | 
						|
    FEnvironmentStack : TEnvironment;
 | 
						|
    FLeftMargin, FParIndent : integer;
 | 
						|
    FEnumDepth : byte;
 | 
						|
    FBorderString : string;
 | 
						|
    FEmphLevel : integer;
 | 
						|
    Cchapters, Csections, Csubsections, Csubsubsections : integer;
 | 
						|
    // not yet used
 | 
						|
    FTableCount : Integer;
 | 
						|
    FInVerbatim : Boolean;
 | 
						|
    Inlist,
 | 
						|
    TableRowStartFlag,
 | 
						|
    TableCaptionWritten: Boolean;
 | 
						|
    // helper procedures
 | 
						|
    procedure PushEnvironment (atype:TEnvironmenttype; dmargin,dindent:integer);
 | 
						|
    procedure PopEnvironment;
 | 
						|
    function  GetEnumNumber(depth, item : integer) : string;
 | 
						|
    procedure Header(text:string; font:integer);
 | 
						|
    // Linear documentation methods overrides;
 | 
						|
    procedure WriteBeginDocument; override;
 | 
						|
    procedure WriteEndDocument; override;
 | 
						|
    procedure WriteLabel(Const S : String); override;
 | 
						|
    procedure WriteIndex(Const S : String); override;
 | 
						|
    Procedure WriteExampleFile(FN : String); override;
 | 
						|
    Procedure StartProcedure; override;
 | 
						|
    Procedure EndProcedure; override;
 | 
						|
    Procedure StartProperty; override;
 | 
						|
    Procedure EndProperty; override;
 | 
						|
    Procedure StartSynopsis; override;
 | 
						|
    Procedure StartDeclaration; override;
 | 
						|
    Procedure StartVisibility; override;
 | 
						|
    Procedure StartDescription; override;
 | 
						|
    Procedure StartAccess; override;
 | 
						|
    Procedure StartErrors; override;
 | 
						|
    Procedure StartSeealso; override;
 | 
						|
    Procedure EndSeealso; override;
 | 
						|
    procedure StartUnitOverview(AModuleName,AModuleLabel : String);override;
 | 
						|
    procedure WriteUnitEntry(UnitRef : TPasType); override;
 | 
						|
    Procedure EndUnitOverview; override;
 | 
						|
    function  GetLabel(AElement: TPasElement): String; override;
 | 
						|
    procedure StartListing(Frames: Boolean; const name: String); override;
 | 
						|
    procedure EndListing; override;
 | 
						|
    Function  EscapeText(S : String) : String; override;
 | 
						|
    Function  StripText(S : String) : String; override;
 | 
						|
    procedure WriteCommentLine; override;
 | 
						|
    procedure WriteComment(Comment : String);override;
 | 
						|
    procedure StartSection(SectionName : String);override;
 | 
						|
    procedure StartSubSection(SubSectionName : String);override;
 | 
						|
    procedure StartSubSubSection(SubSubSectionName : String);override;
 | 
						|
    procedure StartChapter(ChapterName : String); override;
 | 
						|
    procedure StartOverview(WithAccess : Boolean); override;
 | 
						|
    procedure WriteOverviewMember(ALabel,AName,Access,ADescr : String); override;
 | 
						|
    procedure WriteOverviewMember(ALabel,AName,ADescr : String); override;
 | 
						|
    procedure EndOverview; override;
 | 
						|
    Class Function FileNameExtension : String; override;
 | 
						|
    // Description node conversion
 | 
						|
    procedure DescrBeginBold; override;
 | 
						|
    procedure DescrEndBold; override;
 | 
						|
    procedure DescrBeginItalic; override;
 | 
						|
    procedure DescrEndItalic; override;
 | 
						|
    procedure DescrBeginEmph; override;
 | 
						|
    procedure DescrEndEmph; override;
 | 
						|
    procedure DescrWriteFileEl(const AText: DOMString); override;
 | 
						|
    procedure DescrWriteKeywordEl(const AText: DOMString); override;
 | 
						|
    procedure DescrWriteVarEl(const AText: DOMString); override;
 | 
						|
    procedure DescrBeginLink(const AId: DOMString); override;
 | 
						|
    procedure DescrEndLink; override;
 | 
						|
    procedure DescrWriteLinebreak; override;
 | 
						|
    procedure DescrBeginParagraph; override;
 | 
						|
    procedure DescrBeginCode(HasBorder: Boolean; const AHighlighterName: String); override;
 | 
						|
    procedure DescrWriteCodeLine(const ALine: String); override;
 | 
						|
    procedure DescrEndCode; override;
 | 
						|
    procedure DescrEndParagraph; override;
 | 
						|
    procedure DescrBeginOrderedList; override;
 | 
						|
    procedure DescrEndOrderedList; override;
 | 
						|
    procedure DescrBeginUnorderedList; override;
 | 
						|
    procedure DescrEndUnorderedList; override;
 | 
						|
    procedure DescrBeginDefinitionList; override;
 | 
						|
    procedure DescrEndDefinitionList; override;
 | 
						|
    procedure DescrBeginListItem; override;
 | 
						|
    procedure DescrEndListItem; override;
 | 
						|
    procedure DescrBeginDefinitionTerm; override;
 | 
						|
    procedure DescrEndDefinitionTerm; override;
 | 
						|
    procedure DescrBeginDefinitionEntry; override;
 | 
						|
    procedure DescrEndDefinitionEntry; override;
 | 
						|
    procedure DescrBeginSectionTitle; override;
 | 
						|
    procedure DescrBeginSectionBody; override;
 | 
						|
    procedure DescrEndSection; override;
 | 
						|
    procedure DescrBeginRemark; override;
 | 
						|
    procedure DescrEndRemark; override;
 | 
						|
    procedure DescrBeginTable(ColCount: Integer; HasBorder: Boolean); override;
 | 
						|
    procedure DescrEndTable; override;
 | 
						|
    procedure DescrBeginTableCaption; override;
 | 
						|
    procedure DescrEndTableCaption; override;
 | 
						|
    procedure DescrBeginTableHeadRow; override;
 | 
						|
    procedure DescrEndTableHeadRow; override;
 | 
						|
    procedure DescrBeginTableRow; override;
 | 
						|
    procedure DescrEndTableRow; override;
 | 
						|
    procedure DescrBeginTableCell; override;
 | 
						|
    procedure DescrEndTableCell; override;
 | 
						|
    // TFPDocWriter class methods
 | 
						|
    Function InterPretOption(Const Cmd,Arg : String) : boolean; override;
 | 
						|
  end;
 | 
						|
 | 
						|
 | 
						|
 | 
						|
 | 
						|
function TRTFWriter.GetLabel(AElement: TPasElement): String;
 | 
						|
var
 | 
						|
  i: Integer;
 | 
						|
begin
 | 
						|
  if AElement.ClassType = TPasUnresolvedTypeRef then
 | 
						|
    Result := Engine.ResolveLink(Module, AElement.Name)
 | 
						|
  else
 | 
						|
  begin
 | 
						|
    Result := AElement.PathName;
 | 
						|
    Result := LowerCase(Copy(Result, 2, Length(Result) - 1));
 | 
						|
  end;
 | 
						|
  for i := 1 to Length(Result) do
 | 
						|
    if Result[i] = '.' then
 | 
						|
      Result[i] := ':';
 | 
						|
end;
 | 
						|
 | 
						|
 | 
						|
Function TRTFWriter.EscapeText(S : String) : String;
 | 
						|
 | 
						|
var
 | 
						|
  i: Integer;
 | 
						|
 | 
						|
begin
 | 
						|
  if FInVerBatim=True then
 | 
						|
    Result:=S
 | 
						|
  else
 | 
						|
    begin
 | 
						|
    SetLength(Result, 0);
 | 
						|
    for i := 1 to Length(S) do
 | 
						|
      case S[i] of
 | 
						|
        '\','{','}':            // Escape these characters
 | 
						|
          Result := Result + '\' + S[i];
 | 
						|
        else
 | 
						|
          Result := Result + S[i];
 | 
						|
      end;
 | 
						|
    end;
 | 
						|
end;
 | 
						|
 | 
						|
Function TRTFWriter.StripText(S : String) : String;
 | 
						|
 | 
						|
var
 | 
						|
  I: Integer;
 | 
						|
 | 
						|
begin
 | 
						|
  SetLength(Result, 0);
 | 
						|
  for i := 1 to Length(S) do
 | 
						|
    If not (S[i] in ['{','}','\']) then
 | 
						|
      Result := Result + S[i];
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.PushEnvironment(atype: TEnvironmenttype; dmargin,dindent:integer);
 | 
						|
var e : TEnvironment;
 | 
						|
begin
 | 
						|
  e := TEnvironment.Create;
 | 
						|
  with e do
 | 
						|
    begin
 | 
						|
    fenvtype := atype;
 | 
						|
    fnextitem := 1;
 | 
						|
    fdeltaIndent := dIndent;
 | 
						|
    fdeltaMargin := dMargin;
 | 
						|
    fprevious := FEnvironmentStack;
 | 
						|
    end;
 | 
						|
  if atype = etEnumerate then
 | 
						|
    inc (FEnumDepth);
 | 
						|
  inc (FParIndent, dindent);
 | 
						|
  inc (FLeftMargin, dmargin);
 | 
						|
  FEnvironmentStack := e;
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.PopEnvironment;
 | 
						|
var e : TEnvironment;
 | 
						|
begin
 | 
						|
  e := FEnvironmentStack.previous;
 | 
						|
  with FEnvironmentStack do
 | 
						|
    begin
 | 
						|
    if envtype = etEnumerate then
 | 
						|
      dec (FEnumDepth);
 | 
						|
    dec (FParIndent, deltaIndent);
 | 
						|
    dec (FLeftMargin, deltaMargin);
 | 
						|
    end;
 | 
						|
  FEnvironmentStack.Free;
 | 
						|
  FEnvironmentStack := e;
 | 
						|
end;
 | 
						|
 | 
						|
function Romanized (nr : integer) : string;
 | 
						|
const
 | 
						|
  st : array[0..9] of string = ('','X','XX','XXX','XL','L','LX','LXX','LXXX','XC');
 | 
						|
  se : array[0..9] of string = ('','I','II','III','IV','V','VI','VII','VIII','IX');
 | 
						|
var t,e : integer;
 | 
						|
begin
 | 
						|
  t := (nr mod 100) div 10;
 | 
						|
  e := nr mod 10;
 | 
						|
  result := st[t] + se[e];
 | 
						|
end;
 | 
						|
 | 
						|
function TRTFWriter.GetEnumNumber(depth, item: integer) : string;
 | 
						|
begin
 | 
						|
  case depth of
 | 
						|
    1 : result := inttostr(item) + '.';
 | 
						|
    2 : result := '(' + char (ord('a')+item-1) + ')';
 | 
						|
    3 : result := Romanized(item);
 | 
						|
    4 : result := '(' + char (ord('A')+item-1) + ')';
 | 
						|
    else result := '(' + inttostr(item) + ')';
 | 
						|
  end;
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.WriteBeginDocument;
 | 
						|
begin
 | 
						|
  write('{\rtf1');
 | 
						|
  write('{\fonttbl');
 | 
						|
    Write('{\f0\fswiss Helvetica{\*\falt Arial};}');
 | 
						|
    write('{\f1\fmodern Courier{\*\falt Courier New};}');
 | 
						|
    write('{\f2\froman Times{\*\falt Times New Roman};}');
 | 
						|
  write('}{\stylesheet');
 | 
						|
    write('{\s1\li0\fi0\ql\sb240\sa60\keepn\f2\b\fs32 Section Title;}');
 | 
						|
    write('{\s2\ql\sb30\sa30\keepn\b0\i0\scaps1\f1\fs28 Table Title;}');
 | 
						|
    write('{\s3\li0\fi0\qc\sb240\sa60\keepn\f2\b\scaps1\fs28 Listing Title;}');
 | 
						|
    write('{\s4\li30\fi30\ql\f2\fs24 Listing Contents;}');
 | 
						|
    write('{\s5\li0\fi0\ql\sb240\sa60\keepn\f2\b\fs40 Chapter;}');
 | 
						|
    write('{\s6\li0\fi0\ql\sb240\sa60\keepn\f2\b\fs32 Section;}');
 | 
						|
    write('{\s7\li0\fi0\ql\sb240\sa60\keepn\f2\b\fs28 Subsection;}');
 | 
						|
    write('{\s8\li0\fi0\ql\sb240\sa60\keepn\f2\b\fs24 Subsubsection;}');
 | 
						|
    write('{\s9\li30\fi10\ql\sb60\keepn\f2\fs24 Description titles;}');
 | 
						|
    write('{\s10\li30\fi30\ql\fs24 Description;}');
 | 
						|
    write('{\s11\li0\fi0\ql\fs24 Source Example;}');
 | 
						|
  write ('}');
 | 
						|
  FLeftMargin := 0;
 | 
						|
  FParIndent := 0;
 | 
						|
  FEnvironmentStack := nil;
 | 
						|
  FEnumDepth := 0;
 | 
						|
  Cchapters := 0;
 | 
						|
  Csections := 0;
 | 
						|
  Csubsections := 0;
 | 
						|
  Csubsubsections := 0;
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.WriteEndDocument;
 | 
						|
begin
 | 
						|
  write('}');
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.DescrBeginBold;
 | 
						|
begin
 | 
						|
  Write('{\b ');
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.DescrEndBold;
 | 
						|
begin
 | 
						|
  Write('}');
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.DescrBeginItalic;
 | 
						|
begin
 | 
						|
  Write('{\i ');
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.DescrEndItalic;
 | 
						|
begin
 | 
						|
  Write('}');
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.DescrBeginEmph;
 | 
						|
begin
 | 
						|
  inc (FEmphLevel);
 | 
						|
  if (FEmphLevel and 1) = 1 then
 | 
						|
    Write('{\i ')
 | 
						|
  else
 | 
						|
    Write('{\i0 ');
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.DescrEndEmph;
 | 
						|
begin
 | 
						|
  dec (FEmphLevel);
 | 
						|
  Write('}')
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.DescrWriteFileEl(const AText: DOMString);
 | 
						|
begin
 | 
						|
  Write('{\f0 ');
 | 
						|
  DescrWriteText(AText);
 | 
						|
  Write('}');
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.DescrWriteKeywordEl(const AText: DOMString);
 | 
						|
begin
 | 
						|
  Write('{\b\f1 ');
 | 
						|
  DescrWriteText(AText);
 | 
						|
  Write('}');
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.DescrWriteVarEl(const AText: DOMString);
 | 
						|
begin
 | 
						|
  Write('{\f1 ');
 | 
						|
  DescrWriteText(AText);
 | 
						|
  Write('}');
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.DescrBeginLink(const AId: DOMString);
 | 
						|
begin
 | 
						|
  FLink := Engine.ResolveLink(Module, AId);
 | 
						|
//  System.WriteLn('Link "', AId, '" => ', FLink);
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.DescrEndLink;
 | 
						|
var s : string;
 | 
						|
begin
 | 
						|
  s := StripText(Flink);
 | 
						|
  WriteF('{\field{\*\fldinst{\lang1024 PAGEREF BM%s \\*MERGEFORMAT }}',[s]);
 | 
						|
  WriteF('{\\fldrslt{%s}}}',[s]);
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.DescrWriteLinebreak;
 | 
						|
begin
 | 
						|
  WriteLn('\line');
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.DescrBeginParagraph;
 | 
						|
begin
 | 
						|
  // Do nothing
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.DescrEndParagraph;
 | 
						|
begin
 | 
						|
  Write('\par ');
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.DescrBeginCode(HasBorder: Boolean;
 | 
						|
  const AHighlighterName: String);
 | 
						|
begin
 | 
						|
  StartListing(HasBorder,'');
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.DescrWriteCodeLine(const ALine: String);
 | 
						|
begin
 | 
						|
  Write(ALine+'\line ');
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.DescrEndCode;
 | 
						|
begin
 | 
						|
  EndListing;
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.DescrBeginOrderedList;
 | 
						|
begin
 | 
						|
  PushEnvironment(etEnumerate, 2*Indent, -Indent);
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.DescrEndOrderedList;
 | 
						|
begin
 | 
						|
  PopEnvironment;
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.DescrBeginUnorderedList;
 | 
						|
begin
 | 
						|
  PushEnvironment(etItemize, 2*Indent, -Indent);
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.DescrEndUnorderedList;
 | 
						|
begin
 | 
						|
  PopEnvironment;
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.DescrBeginDefinitionList;
 | 
						|
begin
 | 
						|
  PushEnvironment(etDescription, Indent, -Indent);
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.DescrEndDefinitionList;
 | 
						|
begin
 | 
						|
  PopEnvironment;
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.DescrBeginListItem;
 | 
						|
begin
 | 
						|
  WriteF('{\pard\li%d\fi%d ',[FLeftMargin,FParIndent]);
 | 
						|
  with FEnvironmentStack do
 | 
						|
    if envtype = etItemize then
 | 
						|
      write('\bullet\tab ')
 | 
						|
    else
 | 
						|
      begin
 | 
						|
      WriteF('%s\tab ', [GetEnumNumber(fenumdepth,fnextitem)]);
 | 
						|
      inc (fnextitem);
 | 
						|
      end;
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.DescrEndListItem;
 | 
						|
begin
 | 
						|
  WriteLn('}');
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.DescrBeginDefinitionTerm;
 | 
						|
begin
 | 
						|
  WriteF('{\pard\li%d\fi%d{\b  ',[FLeftMargin,FParIndent]);
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.DescrEndDefinitionTerm;
 | 
						|
begin
 | 
						|
  Write('}');
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.DescrBeginDefinitionEntry;
 | 
						|
begin
 | 
						|
  Write('\tab ');
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.DescrEndDefinitionEntry;
 | 
						|
begin
 | 
						|
  WriteLn('}');
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.DescrBeginSectionTitle;
 | 
						|
begin
 | 
						|
  write('{\pard\s1 ');
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.DescrBeginSectionBody;
 | 
						|
begin
 | 
						|
  WriteLn('\par}');
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.DescrEndSection;
 | 
						|
begin
 | 
						|
  write('\par ');
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.DescrBeginRemark;
 | 
						|
begin
 | 
						|
  write ('\par ');
 | 
						|
  write('{\b Remark:}\tab ');
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.DescrEndRemark;
 | 
						|
begin
 | 
						|
  write ('\par ');
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.DescrBeginTable(ColCount: Integer; HasBorder: Boolean);
 | 
						|
begin
 | 
						|
  Write('\par{');
 | 
						|
  if HasBorder then
 | 
						|
    FBorderString := '\trbrdrl\brdrs\brdrw1\trbrdrr\brdrs\brdrw1'
 | 
						|
  else
 | 
						|
    FBorderString := ''
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.DescrEndTable;
 | 
						|
begin
 | 
						|
  Write('}');
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.DescrBeginTableCaption;
 | 
						|
begin
 | 
						|
  Write('\pard\s2 ');
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.DescrEndTableCaption;
 | 
						|
begin
 | 
						|
  write('\par ');
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.DescrBeginTableHeadRow;
 | 
						|
begin
 | 
						|
  write('{\b\trowd'+FBorderstring+'\trbrdrh\brdrs\trbrdrv\brdrs ');
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.DescrEndTableHeadRow;
 | 
						|
begin
 | 
						|
  Write('\row}');
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.DescrBeginTableRow;
 | 
						|
begin
 | 
						|
  write('\trowd'+FBorderstring+'\trbrdrh\brdrs\trbrdrv\brdrs ');
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.DescrEndTableRow;
 | 
						|
begin
 | 
						|
  Write('\row ');
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.DescrBeginTableCell;
 | 
						|
begin
 | 
						|
  write('\pard\intbl ');
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.DescrEndTableCell;
 | 
						|
begin
 | 
						|
  write('\cell');
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.WriteLabel(const s: String);
 | 
						|
var b: string;
 | 
						|
begin
 | 
						|
  b := LowerCase(StripText(s));
 | 
						|
  WriteF('{\bkmkstart %s}{\bkmkend %s}', [b,b]);
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.WriteIndex(const s : String);
 | 
						|
begin
 | 
						|
  Write('{\xe{\v '+EscapeText(s)+'}}');
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.StartListing(Frames: Boolean; const name: String);
 | 
						|
begin
 | 
						|
  Write('\par');
 | 
						|
  if name <> '' then
 | 
						|
    Write('{\pard\s3 '+name+'\par}');
 | 
						|
  Write('{\pard\s4 ');
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.EndListing;
 | 
						|
begin
 | 
						|
  Writeln('}')
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.WriteCommentLine;
 | 
						|
begin
 | 
						|
  // doesn't exist
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.WriteComment(Comment : String);
 | 
						|
begin
 | 
						|
  // doesn't exist
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.StartChapter(ChapterName : String);
 | 
						|
begin
 | 
						|
  inc (Cchapters);
 | 
						|
  if Cchapters > 1 then
 | 
						|
    Write('\par\page');
 | 
						|
  WriteF('{\pard\s5 %d   %s\par}', [Cchapters,EscapeText(ChapterName)]);
 | 
						|
  Csubsubsections := 0;
 | 
						|
  Csubsections := 0;
 | 
						|
  Csections := 0;
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.StartSection(SectionName : String);
 | 
						|
begin
 | 
						|
  inc (Csections);
 | 
						|
  if Csections > 1 then
 | 
						|
    Write('\par');
 | 
						|
  WriteF('{\pard\s6 %d.%d   %s\par}', [Cchapters,Csections,EscapeText(SectionName)]);
 | 
						|
  Csubsubsections := 0;
 | 
						|
  Csubsections := 0;
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.StartSubSection(SubSectionName : String);
 | 
						|
begin
 | 
						|
  inc (Csubsections);
 | 
						|
  if Csubsections > 1 then
 | 
						|
    Write('\par');
 | 
						|
  WriteF('{\pard\s7 %d.%d.%d   %s\par}', [Cchapters,Csections,Csubsections,EscapeText(SubSectionName)]);
 | 
						|
  Csubsubsections := 0;
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.StartSubSubSection(SubSubSectionName : String);
 | 
						|
begin
 | 
						|
  inc (Csubsubsections);
 | 
						|
  if Csubsubsections > 1 then
 | 
						|
    Write('\par');
 | 
						|
  WriteF('{\pard\s8 %d.%d.%d.%d   %s\par}', [Cchapters,Csections,Csubsections,Csubsubsections,
 | 
						|
          EscapeText(SubSubSectionName)]);
 | 
						|
end;
 | 
						|
 | 
						|
Procedure TRTFWriter.StartProcedure;
 | 
						|
begin
 | 
						|
  Write('{\pard');
 | 
						|
end;
 | 
						|
 | 
						|
Procedure TRTFWriter.StartProperty;
 | 
						|
begin
 | 
						|
  Write('{\pard');
 | 
						|
end;
 | 
						|
 | 
						|
Procedure TRTFWriter.Header(text:string; font:integer);
 | 
						|
begin
 | 
						|
  WriteF('\par\s9 %s\pard\par\s10\f%d ',[text, font]);
 | 
						|
end;
 | 
						|
 | 
						|
Procedure TRTFWriter.StartSynopsis;
 | 
						|
begin
 | 
						|
  Header(SDocSynopsis,2);
 | 
						|
end;
 | 
						|
 | 
						|
Procedure TRTFWriter.StartDeclaration;
 | 
						|
begin
 | 
						|
  Header(SDocDeclaration,1);
 | 
						|
end;
 | 
						|
 | 
						|
Procedure TRTFWriter.StartVisibility;
 | 
						|
begin
 | 
						|
  Header(SDocVisibility,2);
 | 
						|
end;
 | 
						|
 | 
						|
Procedure TRTFWriter.StartDescription;
 | 
						|
begin
 | 
						|
  Header(SDocDescription,2);
 | 
						|
end;
 | 
						|
 | 
						|
Procedure TRTFWriter.StartErrors;
 | 
						|
begin
 | 
						|
  Header(SDocErrors,2);
 | 
						|
end;
 | 
						|
 | 
						|
Procedure TRTFWriter.StartAccess;
 | 
						|
begin
 | 
						|
  Header(SDocAccess,2)
 | 
						|
end;
 | 
						|
 | 
						|
Procedure TRTFWriter.EndProcedure;
 | 
						|
begin
 | 
						|
  Write('}');
 | 
						|
end;
 | 
						|
 | 
						|
Procedure TRTFWriter.EndProperty;
 | 
						|
begin
 | 
						|
  Write('}');
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.WriteExampleFile(FN : String);
 | 
						|
var s : TStringlist;
 | 
						|
begin
 | 
						|
  If (FN<>'') then
 | 
						|
    begin
 | 
						|
    Write('\pard{\s4 Listing:} '+FN);
 | 
						|
    Write('\pard{\f1 ');
 | 
						|
    s := TStringlist.Create;
 | 
						|
    try
 | 
						|
      s.loadfromfile (FN);
 | 
						|
      Write(s.Text);
 | 
						|
    finally
 | 
						|
      s.Free;
 | 
						|
    end;
 | 
						|
    Write('}');
 | 
						|
    end;
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.StartOverview(WithAccess : Boolean);
 | 
						|
begin
 | 
						|
  If WithAccess then
 | 
						|
    WriteF('\par\trowd\pard\intbl %s\cell\pard\intbl %s\cell\pard\intbl %s \cell\pard\intbl %s \cell\row',
 | 
						|
        [EscapeText(SDocPage), EscapeText(SDocProperty), EscapeText(SDocAccess), EscapeText(SDocDescription)])
 | 
						|
  else
 | 
						|
    WriteF('\par\trowd\pard\intbl %s\cell\pard\intbl %s\cell\pard\intbl %s\cell\row',
 | 
						|
        [EscapeText(SDocPage), EscapeText(SDocProperty), EscapeText(SDocDescription)]);
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.WriteOverviewMember(ALabel,AName,Access,ADescr : String);
 | 
						|
begin
 | 
						|
  //TODO: Translate Latex \pageref to RTF
 | 
						|
  //WriteLnF('\pageref{%s} & %s  & %s & %s \\',[ALabel,AName,Access,ADescr]);
 | 
						|
  WriteF('\par\trowd\pard\intbl %s\cell\pard\intbl %s\cell\pard\intbl %s \cell\pard\intbl %s \cell\row',
 | 
						|
      [ALabel,AName,Access,ADescr]);
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.WriteOverviewMember(ALabel,AName,ADescr : String);
 | 
						|
begin
 | 
						|
  //TODO: Translate Latex \pageref to RTF
 | 
						|
  //WriteLnF('\pageref{%s} & %s  & %s \\',[ALabel,AName,ADescr]);
 | 
						|
  WriteF('\par\trowd\pard\intbl %s\cell\pard\intbl %s\cell\pard\intbl %s\cell\row',
 | 
						|
      [ALabel,AName,ADescr]);
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.EndOverview;
 | 
						|
begin
 | 
						|
  Write ('\par');
 | 
						|
end;
 | 
						|
 | 
						|
Procedure TRTFWriter.StartSeeAlso;
 | 
						|
begin
 | 
						|
  Header(SDocSeeAlso, 2);
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.EndSeealso;
 | 
						|
begin
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.StartUnitOverview(AModuleName,AModuleLabel : String);
 | 
						|
begin
 | 
						|
  WriteF ('\pard\qc\s3 %s', [Format(SDocUsedUnitsByUnitXY, [AModuleName])]);
 | 
						|
  Write ('\par\trowd\pard\intbl Name\cell\pard\intbl Page\cell\row');
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.WriteUnitEntry(UnitRef : TPasType);
 | 
						|
begin
 | 
						|
  WriteF('\par\trowd\pard\intbl %s\cell\pard\intbl %s\cell\row',
 | 
						|
      [UnitRef.Name, 'Pageref to '+StripText(GetLabel(UnitRef))]);
 | 
						|
  //WriteLnF('%s\index{unit!%s} & \pageref{%s} \\',
 | 
						|
  //   [UnitRef.Name, UnitRef.Name, StripText(GetLabel(UnitRef))]);
 | 
						|
end;
 | 
						|
 | 
						|
procedure TRTFWriter.EndUnitOverview;
 | 
						|
begin
 | 
						|
  Write('\par');
 | 
						|
end;
 | 
						|
 | 
						|
procedure CreateRTFDocForPackage(APackage: TPasPackage; AEngine: TFPDocEngine);
 | 
						|
var
 | 
						|
  Writer: TRTFWriter;
 | 
						|
begin
 | 
						|
  Writer := TRTFWriter.Create(APackage, AEngine);
 | 
						|
  try
 | 
						|
    Writer.WriteDoc;
 | 
						|
  finally
 | 
						|
    Writer.Free;
 | 
						|
  end;
 | 
						|
end;
 | 
						|
 | 
						|
Function TRTFWriter.InterPretOption(Const Cmd,Arg : String) : boolean;
 | 
						|
begin
 | 
						|
  if Cmd = '--RTF-extension' then
 | 
						|
    begin
 | 
						|
    RTFExtension:=Arg;
 | 
						|
    Result := true;
 | 
						|
    end
 | 
						|
  else
 | 
						|
    Result:=False;
 | 
						|
end;
 | 
						|
 | 
						|
class function TRTFWriter.FileNameExtension: String;
 | 
						|
begin
 | 
						|
  Result:=RTFExtension;
 | 
						|
end;
 | 
						|
 | 
						|
initialization
 | 
						|
  // Do not localize.
 | 
						|
  RegisterWriter(TRTFWriter,'rtf','RTF output.');
 | 
						|
 | 
						|
finalization
 | 
						|
  UnRegisterWriter('rtf');
 | 
						|
end.
 |