SynEdit: TSynEditExporter: implement methods that add formatting data immediately before and after each token, regardless of the formatting status of the previous token.

git-svn-id: trunk@53335 -

components/synedit/syneditexport.pas

@@ -50,7 +50,7 @@ uses
   Classes,
   SysUtils,
   SynEditHighlighter, SynEditTextBase, SynEditTextBuffer,
-  FileUtil, LazUTF8, FPCAdds, LCLType,
+  FileUtil, LazUTF8, FPCAdds, LCLType, LCLProc,
   Graphics, Clipbrd;
 
 type
@@ -65,10 +65,14 @@ type
     to track the changes of token attributes, to export to the clipboard or to
     save the output to a file. Descendant classes have to implement only the
     actual formatting of tokens. }
+
+  { TSynCustomExporter }
+
   TSynCustomExporter = class(TComponent)
   private
     fBuffer: TMemoryStream;
     fFirstAttribute: boolean;
+    fImmediateAttrWrite: Boolean;
     procedure AssignFont(Value: TFont);
     procedure SetFont(Value: TFont);
     procedure SetHighlighter(Value: TSynCustomHighlighter);
@@ -115,9 +119,19 @@ type
       ForegroundChanged: boolean; FontStylesChanged: TFontStyles);
       virtual; abstract;
 {end}                                                                           //mh 2000-10-10
+
+    { The Format*Immediate methods apply formatting based entirely on the
+      current token attribute, they do not take the attribute of the previous
+      token into account }
+    procedure FormatBeforeFirstAttributeImmediate(BG, FG: TColor); virtual; abstract;
+    procedure FormatAfterLastAttributeImmediate; virtual; abstract;
+    procedure FormatAttributeInitImmediate(Attri: TSynHighlighterAttributes; IsSpace: Boolean); virtual; abstract;
+    procedure FormatAttributeDoneImmediate(Attri: TSynHighlighterAttributes; IsSpace: Boolean); virtual; abstract;
+
     { Has to be overridden in descendant classes to add the formatted text of
       the actual token text to the output buffer. }
     procedure FormatToken(Token: string); virtual;
+    procedure FormatTokenImmediate(Token: String; Attri: TSynHighlighterAttributes; IsSpace: Boolean);
     { Has to be overridden in descendant classes to add a newline in the output
       format to the output buffer. }
     procedure FormatNewLine; virtual; abstract;
@@ -152,6 +166,7 @@ type
       added to the output buffer. }
     procedure SetTokenAttribute(IsSpace: boolean;
       Attri: TSynHighlighterAttributes); virtual;
+    function ValidatedColor(AColor, ADefColor: TColor): TColor;
   public
     { Creates an instance of the exporter. }
     constructor Create(AOwner: TComponent); override;
@@ -187,6 +202,7 @@ type
     { The highlighter to use for exporting. }
     property Highlighter: TSynCustomHighlighter
       read fHighlighter write SetHighlighter;
+    property ImmediateAttrWrite: Boolean read fImmediateAttrWrite write fImmediateAttrWrite default false;
     { The title to embedd into the output header. }
     property Title: string read fTitle write SetTitle;
     { Use the token attribute background for the exporting. }
@@ -322,6 +338,7 @@ begin
     // export all the lines into fBuffer
     fFirstAttribute := TRUE;
 
+
     for i := Start.Y to Stop.Y do begin
       Highlighter.StartAtLineIndex(i - 1);
       X := 1;
@@ -344,16 +361,28 @@ begin
         end;
 
         Token := ReplaceReservedChars(Token, IsSpace);
-        SetTokenAttribute(IsSpace, Attri);
+        if fImmediateAttrWrite then begin
-        FormatToken(Token);
+           if fFirstAttribute then begin
+             FormatBeforeFirstAttributeImmediate(fBackgroundColor, fFont.Color);
+             fFirstAttribute := False;
+           end;
+           FormatTokenImmediate(Token, Attri ,IsSpace);
+        end else begin
+          SetTokenAttribute(IsSpace, Attri);
+          FormatToken(Token);
+        end;
         Highlighter.Next;
       end;
 
       FormatNewLine;
     end;
 
-    if not fFirstAttribute then
+    if not fFirstAttribute then begin
-      FormatAfterLastAttribute;
+      if fImmediateAttrWrite then
+        FormatAfterLastAttributeImmediate
+      else
+        FormatAfterLastAttribute;
+    end;
     // insert header
     fBuffer.SetSize(integer(fBuffer.Position));
     InsertData(0, GetHeader);
@@ -373,6 +402,15 @@ begin
   AddData(Token);
 end;
 
+procedure TSynCustomExporter.FormatTokenImmediate(Token: String;
+  Attri: TSynHighlighterAttributes; IsSpace: Boolean);
+begin
+  debugln(['TSynCustomExporter.FormatTokenImmediate: Token = "', Token,'", IsSpace = ',IsSpace]);
+  FormatAttributeInitImmediate(Attri, IsSpace);
+  FormatToken(Token);
+  FormatAttributeDoneImmediate(Attri, IsSpace);
+end;
+
 function TSynCustomExporter.GetBufferSize: integer;
 begin
   Result := integer(fBuffer.Size);
@@ -521,14 +559,6 @@ var
   ChangedFG: boolean;
   ChangedStyles: TFontStyles;
 
-  function ValidatedColor(AColor, ADefColor: TColor): TColor;
-  begin
-    if AColor = clNone then
-      Result := ADefColor
-    else
-      Result := AColor;
-  end;
-
 begin
   if fFirstAttribute then begin
     fFirstAttribute := FALSE;
@@ -570,5 +600,13 @@ begin
   end;
 end;
 
+function TSynCustomExporter.ValidatedColor(AColor, ADefColor: TColor): TColor;
+begin
+  if AColor = clNone then
+    Result := ADefColor
+  else
+    Result := AColor;
+end;
+
 end.
 

components/synedit/synexporthtml.pas

@@ -46,7 +46,7 @@ interface
 uses
   Classes,
   LCLIntf, LCLType, Graphics, ClipBrd,
-  SynEditExport, LCLProc, LazUtf8;
+  SynEditHighlighter, SynEditExport, LCLProc, LazUtf8;
 
 type
   THTMLFontSize = (fs01, fs02, fs03, fs04, fs05, fs06, fs07, fsDefault);        //eb 2000-10-12
@@ -66,10 +66,11 @@ type
   private
     fOptions: TExportHtmlOptions;
     fFontSize: THTMLFontSize;
-    function ColorToHTML(AColor: TColor): string;
     procedure SetExportHtmlOptions(Value: TExportHtmlOptions);
     function GetCreateHTMLFragment: Boolean;
     procedure SetCreateHTMLFragment(Value: Boolean);
+    function MakeFontSpan(FG, BG: TColor): String;
+    function StyleToHtml(AStyle: TFontStyles; IsSpace, DoSet: Boolean): String;
   protected
     procedure FormatAfterLastAttribute; override;
     procedure FormatAttributeDone(BackgroundChanged, ForegroundChanged: boolean;
@@ -80,6 +81,11 @@ type
     procedure FormatBeforeFirstAttribute(BackgroundChanged,
       ForegroundChanged: boolean; FontStylesChanged: TFontStyles); override;
 {end}                                                                           //mh 2000-10-10
+    procedure FormatBeforeFirstAttributeImmediate(BG, FG: TColor); override;
+    procedure FormatAfterLastAttributeImmediate; override;
+    procedure FormatAttributeInitImmediate(Attri: TSynHighlighterAttributes; IsSpace: Boolean); override;
+    procedure FormatAttributeDoneImmediate(Attri: TSynHighlighterAttributes; IsSpace: Boolean); override;
+
     procedure FormatNewLine; override;
     function GetFooter: string; override;
     function GetFormatName: string; override;
@@ -87,6 +93,7 @@ type
     procedure SetExportAsText(Value: boolean); override;
   public
     constructor Create(AOwner: TComponent); override;
+    function ColorToHTML(AColor: TColor): string;
   published
     property Color;
     property CreateHTMLFragment: boolean read GetCreateHTMLFragment
@@ -351,6 +358,72 @@ begin
       AddData('<strike>');
   end;
 end;
+
+procedure TSynExporterHTML.FormatBeforeFirstAttributeImmediate(BG, FG: TColor);
+var
+  Span: String;
+begin
+  debugln(['TSynExporterHTML.FormatBeforeFirstAttributeImmediate']);
+  // if not heoFragmentOnly this is handled in GetHeader
+  if (heoFragmentOnly in Options) then
+  begin
+    Span := MakeFontSpan(FG, BG);
+    AddData(Span);
+  end;
+end;
+
+procedure TSynExporterHTML.FormatAfterLastAttributeImmediate;
+begin
+  debugln(['TSynExporterHTML.FormatAfterLastAttributeImmediate']);
+  if (heoFragmentOnly in Options) then
+    AddData('</span>');
+end;
+
+procedure TSynExporterHTML.FormatAttributeInitImmediate(
+  Attri: TSynHighlighterAttributes; IsSpace: Boolean);
+var
+  Span, StyleStr: String;
+  FG, BG: TColor;
+begin
+  debugln(['TSynExporterHTML.FormatAttributeInitImmediate']);
+  FG := ValidatedColor(Attri.Foreground, fFont.Color);
+  BG := ValidatedColor(Attri.Background, fBackgroundColor);
+  if (not IsSpace and (FG <> fFont.Color)) or
+     (UseBackGround and (BG <> fbackGroundColor)) then
+  begin
+    Span := MakeFontSpan(FG, BG);
+    AddData(Span);
+  end;
+  if (Attri.Style <> []) then
+  begin
+    StyleStr := StyleToHtml(Attri.Style, IsSpace, True);
+    AddData(StyleStr);
+  end;
+end;
+
+procedure TSynExporterHTML.FormatAttributeDoneImmediate(
+  Attri: TSynHighlighterAttributes; IsSpace: Boolean);
+var
+  FG, BG: TColor;
+  StyleStr: String;
+begin
+  debugln(['TSynExporterHTML.FormatAttributeDoneImmediate']);
+  //reversed order compared to FormatAttributeInitImmediate
+  if (Attri.Style <> []) then
+  begin
+    StyleStr := StyleToHtml(Attri.Style, IsSpace, False);
+    AddData(StyleStr);
+  end;
+  FG := ValidatedColor(Attri.Foreground, fFont.Color);
+  BG := ValidatedColor(Attri.Background, fBackgroundColor);
+  if (not IsSpace and (FG <> fFont.Color)) or
+     (UseBackGround and (BG <> fbackGroundColor)) then
+  begin
+    AddData('</span>');
+  end;
+
+end;
+
 {end}                                                                           //mh 2000-10-10
 
 procedure TSynExporterHTML.FormatNewLine;
@@ -475,5 +548,35 @@ begin
   end;
 end;
 
+function TSynExporterHTML.MakeFontSpan(FG, BG: TColor): String;
+begin
+  Result := '<span style="color: ';
+  FG := ValidatedColor(FG, fFont.Color);
+  Result := Result + AnsiDequotedStr(ColorToHtml(FG), '"');
+  BG := ValidatedColor(BG, fBackgroundColor);
+  if UseBackGround then
+  begin
+    Result := Result + '; background-color: ' + AnsiDequotedStr(ColorToHtml(BG), '"');
+  end;
+  Result := Result + ';">';
+end;
+
+function TSynExporterHTML.StyleToHtml(AStyle: TFontStyles; IsSpace, DoSet: Boolean): String;
+begin
+  Result := '';
+  if not IsSpace then
+  begin
+    if (fsBold in AStyle) then
+      if DoSet then Result := Result + '<b>' else Result := Result + '</b>';
+    if (fsItalic in AStyle) then
+      if DoSet then Result := Result + '<i>' else Result := Result + '</i>';
+    if (fsUnderline in AStyle) then
+      if DoSet then Result := Result + '<u>' else Result := Result + '</u>';
+  end;
+  //the only style that actually is applied to whitespace in HTML
+  if (fsStrikeOut in AStyle) then
+    if DoSet then Result := Result + '<strike>' else Result := Result + '</strike>';
+end;
+
 end.