+ Initial implementation

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
+
+}

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,'&','&amp',[rfReplaceAll]);
+  Result:=StringReplace(Result,'<','&lt',[rfReplaceAll]);
+  Result:=StringReplace(Result,'>','&gt',[rfReplaceAll]);
+  Result:=StringReplace(Result,#10,'<BR>',[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('</'+Name+'>');
+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
+
+}

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
+
+}