From e613c39896c9a9487eb60040495d6d05625f0c0d Mon Sep 17 00:00:00 2001 From: bart <9132501-flyingsheep@users.noreply.gitlab.com> Date: Thu, 10 Nov 2016 15:51:38 +0000 Subject: [PATCH] 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 | 64 ++++++++++++---- components/synedit/synexporthtml.pas | 107 ++++++++++++++++++++++++++- 2 files changed, 156 insertions(+), 15 deletions(-) diff --git a/components/synedit/syneditexport.pas b/components/synedit/syneditexport.pas index a4c2d7ae53..26de9c2aa5 100644 --- a/components/synedit/syneditexport.pas +++ b/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); - FormatToken(Token); + if fImmediateAttrWrite then begin + 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 - FormatAfterLastAttribute; + if not fFirstAttribute then begin + 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. diff --git a/components/synedit/synexporthtml.pas b/components/synedit/synexporthtml.pas index 65c05526eb..c0dc3134f0 100644 --- a/components/synedit/synexporthtml.pas +++ b/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(''); 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(''); +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(''); + 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 := ''; +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 + '' else Result := Result + ''; + if (fsItalic in AStyle) then + if DoSet then Result := Result + '' else Result := Result + ''; + if (fsUnderline in AStyle) then + if DoSet then Result := Result + '' else Result := Result + ''; + end; + //the only style that actually is applied to whitespace in HTML + if (fsStrikeOut in AStyle) then + if DoSet then Result := Result + '' else Result := Result + ''; +end; + end.