diff --git a/fcl/inc/wformat.pp b/fcl/inc/wformat.pp new file mode 100644 index 0000000000..ba493b08e6 --- /dev/null +++ b/fcl/inc/wformat.pp @@ -0,0 +1,322 @@ +{ + $Id$ + This file is part of the Free Component Library (FCL) + Copyright (c) 1999-2000 by the Free Pascal development team + + See the file COPYING.FPC, 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 wformat; + +{$ifdef fpc} +{$mode objfpc} +{$endif} + +Interface + +uses Classes,SysUtils; + +Type + TlistType = (ltNumbered,ltOrdered,ltDefinition); + + TFormattingWriter = Class + Private + FStream : TStream; + Public + Constructor Create (AStream : TStream); Virtual; + // To be overridden by descendents + Function EscapeText (AText : String) : String; Virtual; + // Quick dump. + Procedure Dump(Const AText : String); + Procedure DumpLn(Const AText : String); + // Formatted write. Calls escapetext. + Procedure Write(Const AText : String); + Procedure WriteFmt(Const Fmt : String; Args : Array of const); + // Document Structure + Procedure DocumentStart(Const Title : String); Virtual; + Procedure DocumentEnd; Virtual; + // Header formatting + Procedure Header(Alevel : Integer; Msg : String); + Procedure HeaderStart(Alevel : Integer); virtual; + Procedure HeaderEnd(Alevel : Integer); virtual; + // Basic line formatting. + Procedure ParagraphStart; virtual; + Procedure ParagraphEnd; virtual; + Procedure LineBreak; virtual; + Procedure Rule; virtual; + // text formatting. + Procedure BoldStart; Virtual; + Procedure BoldEnd;Virtual; + Procedure ItalicStart;Virtual; + Procedure ItalicEnd;Virtual; + Procedure UnderlineStart;Virtual; + Procedure UnderlineEnd;Virtual; + // Preformatted. + Procedure PreformatStart; virtual; + Procedure PreformatEnd; virtual; + // Table support + Procedure TableStart( NoCols: Integer; Border : Boolean); virtual; + Procedure TableEnd; virtual; + Procedure RowStart; virtual; + Procedure RowEnd; virtual; + Procedure RowNext; + Procedure CellStart; virtual; + Procedure CellEnd; virtual; + Procedure CellNext; + Procedure HeaderCellStart; virtual; + Procedure HeaderCellEnd; virtual; + Procedure HeaderCellNext; + // List support; + Procedure ListStart(ListType : TListType); Virtual; + Procedure ListEnd(ListType : TListType); Virtual; + Procedure ListItemStart; Virtual; + Procedure ListItemEnd; Virtual; + Procedure ListItem(Const AText : String); + Procedure DefinitionItem(Const Aname,AText : String); Virtual; + Procedure WriteList(ListType : TListType; List : TStrings); + end; + +Const +{$ifdef linux} + LineFeed = #10; +{$else} + LineFeed = #13#10; +{$endif} + + +Implementation + +{ TFormattingWriter } + +procedure TFormattingWriter.BoldEnd; +begin +end; + +procedure TFormattingWriter.BoldStart; +begin +end; + +procedure TFormattingWriter.CellEnd; +begin +end; + +procedure TFormattingWriter.CellStart; +begin +end; + +procedure TFormattingWriter.CellNext; +begin + CellEnd; + CellStart; +end; + +constructor TFormattingWriter.Create(AStream: TStream); +begin + FStream:=AStream; +end; + +procedure TFormattingWriter.DefinitionItem(const Aname, AText: String); +begin + +end; + +procedure TFormattingWriter.DocumentEnd; +begin + +end; + +procedure TFormattingWriter.DocumentStart(const Title: String); +begin + +end; + +procedure TFormattingWriter.Dump(const AText: String); +begin + FStream.WriteBuffer(Atext[1],Length(AText)); +end; + +procedure TFormattingWriter.DumpLn(const AText: String); + +begin + Dump(Atext); + Dump(LineFeed); +end; + +Function TFormattingWriter.EscapeText(AText: String) : String; +begin + Result:=AText; +end; + +procedure TFormattingWriter.Header(Alevel: Integer; Msg: String); +begin + HeaderStart(ALevel); + Write(Msg); + HeaderEnd(Alevel) +end; + +procedure TFormattingWriter.HeaderCellEnd; +begin + +end; + +procedure TFormattingWriter.HeaderCellStart; +begin + +end; + +procedure TFormattingWriter.HeaderCellNext; +begin + HeaderCellEnd; + HeaderCellStart; +end; + +procedure TFormattingWriter.HeaderEnd(Alevel: Integer); +begin +end; + +procedure TFormattingWriter.HeaderStart(Alevel: Integer); +begin + +end; + +procedure TFormattingWriter.ItalicEnd; +begin + +end; + +procedure TFormattingWriter.ItalicStart; +begin + +end; + +procedure TFormattingWriter.LineBreak; +begin +end; + +procedure TFormattingWriter.ListEnd(ListType: TListType); +begin + +end; + +procedure TFormattingWriter.ListItem(const AText: String); +begin + ListItemStart; + Write(Atext); + ListItemEnd; +end; + +procedure TFormattingWriter.ListItemEnd; +begin + +end; + +procedure TFormattingWriter.ListItemStart; +begin + +end; + +procedure TFormattingWriter.ListStart(ListType: TListType); +begin + +end; + +procedure TFormattingWriter.ParagraphEnd; +begin +end; + +procedure TFormattingWriter.ParagraphStart; +begin +end; + +procedure TFormattingWriter.PreformatEnd; +begin +end; + +procedure TFormattingWriter.PreformatStart; +begin +end; + +procedure TFormattingWriter.RowEnd; +begin +end; + +procedure TFormattingWriter.RowStart; +begin +end; + +procedure TFormattingWriter.RowNext; +begin + RowEnd; + RowStart; +end; + +procedure TFormattingWriter.Rule; +begin +end; + +procedure TFormattingWriter.TableStart(NoCols: Integer; Border: Boolean); +begin +end; + +procedure TFormattingWriter.TableEnd; +begin +end; + +procedure TFormattingWriter.UnderlineEnd; +begin +end; + +procedure TFormattingWriter.UnderlineStart; +begin +end; + +procedure TFormattingWriter.Write(const AText: String); +begin + Dump(EscapeText(Atext)); +end; + +procedure TFormattingWriter.WriteFmt(const Fmt: String; Args: array of const); +begin + Write(Format(Fmt,Args)); +end; + +procedure TFormattingWriter.WriteList(ListType: TListType; List: TStrings); + +Var + I,J : integer; + N,V : String; + +begin + ListStart(ListType); + try + For I:=0 to List.Count-1 do + if ListType<>ltDefinition then + ListItem(List[i]) + else + begin + V:=List[i]; + J:=Pos('=',V); + if (J>0) then + begin + N:=Copy(V,1,J-1); + Delete(V,1,J); + end; + DefinitionItem(N,V); + end; + finally + ListEnd(ListType) + end; +end; + +end. +{ + $Log$ + Revision 1.1 2003-10-01 20:49:29 michael + + Initial implementation + +} diff --git a/fcl/inc/whtml.pp b/fcl/inc/whtml.pp new file mode 100644 index 0000000000..06c3f3c2e1 --- /dev/null +++ b/fcl/inc/whtml.pp @@ -0,0 +1,271 @@ +{ + $Id$ + This file is part of the Free Component Library (FCL) + Copyright (c) 1999-2000 by the Free Pascal development team + + See the file COPYING.FPC, 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 whtml; + +{$ifdef fpc} +{$mode objfpc} +{$endif} + +interface + +uses wformat,Classes,SysUtils; + +Type + THTMLWriter=Class(TFormattingWriter) + Public + Constructor Create (AStream : TStream); override; + Procedure TagStart(Const Name, Attrs : String); + Procedure TagEnd(Const Name : String); + Function EscapeText (AText : String) : String; override; + Procedure DocumentStart(Const Title : String); override; + Procedure DocumentEnd; override; + Procedure HeaderStart(Alevel : Integer); override; + Procedure HeaderEnd(Alevel : Integer); override; + Procedure ParagraphStart; override; + Procedure ParagraphEnd; override; + Procedure LineBreak; override; + Procedure Rule; override; + Procedure BoldStart; override; + Procedure BoldEnd;override; + Procedure ItalicStart;override; + Procedure ItalicEnd;override; + Procedure UnderlineStart;override; + Procedure UnderlineEnd;override; + Procedure PreformatStart; override; + Procedure PreformatEnd; override; + Procedure TableStart( NoCols: Integer; Border : Boolean); override; + Procedure TableEnd; override; + Procedure RowStart; override; + Procedure RowEnd; override; + Procedure CellStart; override; + Procedure CellEnd; override; + Procedure HeaderCellStart; override; + Procedure HeaderCellEnd; override; + Procedure ListStart(ListType : TListType); override; + Procedure ListEnd(ListType : TListType); override; + Procedure ListItemStart; override; + Procedure ListItemEnd; override; + Procedure DefinitionItem(Const Aname,AText : String); override; + end; + +Const + ListTags : Array[TListType] of string[2] = ('OL','UL','DL'); + +implementation + +{ THTMLWriter } + +procedure THTMLWriter.BoldEnd; +begin + TagEnd('B'); +end; + +procedure THTMLWriter.BoldStart; +begin + TagStart('B',''); +end; + +procedure THTMLWriter.CellEnd; +begin + TagEnd('TD'); +end; + +procedure THTMLWriter.CellStart; +begin + TagStart('TD',''); +end; + +constructor THTMLWriter.Create(AStream: TStream); +begin + inherited; +end; + +procedure THTMLWriter.DefinitionItem(const Aname, AText: String); +begin + TagStart('DT',''); + Write(Aname); + TagEnd('DT'); + TagStart('DD',''); + Write(AText); + TagEnd('DD'); +end; + +procedure THTMLWriter.DocumentEnd; +begin + TagEnd('BODY'); + TagEnd('HTML'); +end; + +procedure THTMLWriter.DocumentStart(const Title: String); +begin + inherited; + TagStart('HTML',''); + TagStart('TITLE',''); + Write(Title); + TagEnd('TITLE'); + TagStart('BODY',''); +end; + +function THTMLWriter.EscapeText(AText: String): String; +begin + // replace by a more sensitive method. + Result:=StringReplace(AText,'&','&',[rfReplaceAll]); + Result:=StringReplace(Result,'<','<',[rfReplaceAll]); + Result:=StringReplace(Result,'>','>',[rfReplaceAll]); + Result:=StringReplace(Result,#10,'
',[rfreplaceAll]); +end; + +procedure THTMLWriter.HeaderCellEnd; +begin + TagEnd('TH'); +end; + +procedure THTMLWriter.HeaderCellStart; +begin + TagStart('TH',''); +end; + +procedure THTMLWriter.HeaderEnd(Alevel: Integer); +begin + TagEnd(Format('H%d',[ALevel])); +end; + +procedure THTMLWriter.HeaderStart(Alevel: Integer); +begin + TagStart(Format('H%d',[ALevel]),''); +end; + +procedure THTMLWriter.ItalicEnd; +begin + TagEnd('I'); +end; + +procedure THTMLWriter.ItalicStart; +begin + TagStart('I',''); +end; + +procedure THTMLWriter.LineBreak; +begin + TagStart('BR',''); +end; + +procedure THTMLWriter.ListEnd(ListType: TListType); +begin + TagEnd(ListTags[ListType]); +end; + + +procedure THTMLWriter.ListItemEnd; +begin + TagEnd('LI'); + +end; + +procedure THTMLWriter.ListItemStart; +begin + TagStart('LI',''); +end; + +procedure THTMLWriter.ListStart(ListType: TListType); +begin + TagEnd(ListTags[ListType]); +end; + +procedure THTMLWriter.ParagraphEnd; +begin + TagEnd('P') +end; + +procedure THTMLWriter.ParagraphStart; +begin + TagStart('P','') +end; + +procedure THTMLWriter.PreformatEnd; +begin + TagEnd('PRE') +end; + +procedure THTMLWriter.PreformatStart; +begin + TagStart('PRE',''); +end; + +procedure THTMLWriter.RowEnd; +begin + TagEnd('TR') +end; + +procedure THTMLWriter.RowStart; +begin + TagStart('TR','') +end; + +procedure THTMLWriter.Rule; +begin + TagStart('HR',''); +end; + +procedure THTMLWriter.TableStart(NoCols: Integer; Border: Boolean); + +Var + Attr : string; +begin + if Border then + Attr:='BORDER=1' + else + Attr:=''; + TagStart('TABLE',Attr); +end; + +procedure THTMLWriter.TableEnd; + +begin + TagEnd('TABLE'); +end; + +procedure THTMLWriter.TagEnd(const Name : String); +begin + Dump(''); +end; + +procedure THTMLWriter.TagStart(const Name, Attrs: String); +begin + Dump('<'+Name); + If Attrs<>'' then + begin + Dump(' '); + Dump(Attrs); + end; + Dump('>'); +end; + +procedure THTMLWriter.UnderlineEnd; +begin + TagEnd('U'); +end; + +procedure THTMLWriter.UnderlineStart; +begin + TagStart('U',''); +end; + +end. +{ + $Log$ + Revision 1.1 2003-10-01 20:49:29 michael + + Initial implementation + +} diff --git a/fcl/inc/wtex.pp b/fcl/inc/wtex.pp new file mode 100644 index 0000000000..64d20a9d31 --- /dev/null +++ b/fcl/inc/wtex.pp @@ -0,0 +1,276 @@ +{ + $Id$ + This file is part of the Free Component Library (FCL) + Copyright (c) 1999-2000 by the Free Pascal development team + + See the file COPYING.FPC, 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 wtex; + +interface + +{$ifdef fpc} +{$mode objfpc} +{$endif} + + +uses wformat,classes,sysutils; + +Type + TTexWriter=Class(TFormattingWriter) + FCellCount : Integer; + Protected + Procedure IncCellCount; + Property CellCount : Integer Read FCellCount Write FCellCount; + Public + Procedure ScopeStart; + Procedure ScopeEnd; + Procedure EnvironmentStart(Const Name,Opts : String); + Procedure EnvironmentEnd(Const Name : String); + Function EscapeText (AText : String) : String; override; + Procedure DocumentStart(Const Title : String); override; + Procedure DocumentEnd; override; + Procedure HeaderStart(Alevel : Integer); override; + Procedure HeaderEnd(Alevel : Integer); override; + Procedure ParagraphEnd; override; + Procedure LineBreak; override; + Procedure Rule; override; + Procedure BoldStart; override; + Procedure BoldEnd;override; + Procedure ItalicStart;override; + Procedure ItalicEnd;override; + Procedure UnderlineStart;override; + Procedure UnderlineEnd;override; + Procedure PreformatStart; override; + Procedure PreformatEnd; override; + Procedure TableStart( NoCols: Integer; Border : Boolean); override; + Procedure TableEnd; override; + Procedure RowStart; override; + Procedure RowEnd; override; + Procedure CellStart; override; + Procedure HeaderCellStart; override; + Procedure HeaderCellEnd; override; + Procedure ListStart(ListType : TListType); override; + Procedure ListEnd(ListType : TListType); override; + Procedure ListItemStart; override; + Procedure DefinitionItem(Const Aname,AText : String); override; + + end; + +Const + ListNames : Array[TListType] of string + = ('enumerate','itemize','definition'); + +implementation + +{ TTexWriter } + +procedure TTexWriter.BoldEnd; +begin + ScopeEnd; +end; + +procedure TTexWriter.BoldStart; +begin + dump('\textbf'); + ScopeStart; +end; + +procedure TTexWriter.CellStart; +begin + If CellCount<>0 then + Dump('&'); + IncCellCount; +end; + +procedure TTexWriter.DefinitionItem(const Aname, AText: String); +begin + dump('\item['); + Write(AName); + Dump(']'); + Write(Atext); +end; + +procedure TTexWriter.DocumentEnd; +begin + dump('\end{document}') +end; + +procedure TTexWriter.DocumentStart(const Title: String); +begin + dumpln('\documentclass{report}'); + dumpln('\usepackage{a4}'); + dumpln('\begin{document}'); + dump('\title'); + ScopeStart; + Write(Title); + ScopeEnd; +end; + +procedure TTexWriter.EnvironmentStart(const Name,opts: String); + +begin + Dump('\begin'); + If Opts<>'' then + Dump(Opts); + ScopeStart; + Dump(Name); + ScopeEnd; +end; + +procedure TTexWriter.EnvironmentEnd(const Name: String); +begin + Dump('\end'); + ScopeStart; + Dump(Name); + ScopeEnd; +end; + +function TTexWriter.EscapeText(AText: String): String; +begin + Result:=StringReplace(AText,'_','\_',[rfReplaceAll]); +end; + +procedure TTexWriter.HeaderCellEnd; +begin + CellEnd; +end; + +procedure TTexWriter.HeaderCellStart; +begin + CellStart; +end; + +procedure TTexWriter.HeaderEnd(Alevel: Integer); +begin + ScopeEnd; + Dumpln(''); +end; + +procedure TTexWriter.HeaderStart(Alevel: Integer); + +Const + Headers : Array [0..4] of string = + ('\part','\chapter','\section','\subsection','\subsubsection'); + +begin + dump(Headers[Alevel]); + ScopeStart; +end; + +procedure TTexWriter.IncCellCount; +begin + Inc(FCellCount); +end; + +procedure TTexWriter.ItalicEnd; +begin + ScopeEnd; +end; + +procedure TTexWriter.ItalicStart; +begin + dump('\textit'); + ScopeStart; +end; + +procedure TTexWriter.LineBreak; +begin + Dump('\\'); +end; + +procedure TTexWriter.ListEnd(ListType: TListType); +begin + EnvironmentEnd(ListNames[ListType]); +end; + +procedure TTexWriter.ListItemStart; +begin + dump('\item'); +end; + +procedure TTexWriter.ListStart(ListType: TListType); +begin + EnvironmentStart(ListNames[ListType],''); +end; + +procedure TTexWriter.ParagraphEnd; +begin + DumpLn(LineFeed+LineFeed); +end; + +procedure TTexWriter.PreformatEnd; +begin + EnvironmentEnd('verbatim') +end; + +procedure TTexWriter.PreformatStart; +begin + EnvironmentStart('verbatim','') +end; + +procedure TTexWriter.RowEnd; +begin + DumpLn('\\') +end; + +procedure TTexWriter.RowStart; +begin + FCellCount:=0; +end; + +procedure TTexWriter.Rule; +begin + dump('\hline'); +end; + +procedure TTexWriter.ScopeEnd; +begin + Dump('}'); +end; + +procedure TTexWriter.ScopeStart; +begin + Dump('{'); +end; + +procedure TTexWriter.TableStart(NoCols: Integer; Border: Boolean); +begin +// EnvironmentStart('table',''); + EnvironmentStart('tabular',''); + ScopeStart; + Dump(StringOfChar('l',NoCols)); + ScopeEnd; + DumpLn(''); +end; + +procedure TTexWriter.TableEnd; +begin + EnvironmentEnd('tabular'); +// EnvironmentEnd('table'); +end; + +procedure TTexWriter.UnderlineEnd; +begin + ScopeEnd; +end; + +procedure TTexWriter.UnderlineStart; +begin + dump('\textul'); + ScopeStart; +end; + +end. +{ + $Log$ + Revision 1.1 2003-10-01 20:49:29 michael + + Initial implementation + +}