From 3852f7546c1429fa7fdb17499bde8f9c2c07a43b Mon Sep 17 00:00:00 2001 From: Andreas Schneider Date: Mon, 21 Sep 2015 20:57:54 +0200 Subject: [PATCH] Added highlighting with regular expressions --- restemplate.lpi | 5 ++ restemplate.pas | 165 ++++++++++++++++++++++++++++++++++++++++++++++-- 2 files changed, 163 insertions(+), 7 deletions(-) diff --git a/restemplate.lpi b/restemplate.lpi index b6240d6..b6945f1 100644 --- a/restemplate.lpi +++ b/restemplate.lpi @@ -72,6 +72,11 @@ + + + + + diff --git a/restemplate.pas b/restemplate.pas index 5bb65d7..5989941 100644 --- a/restemplate.pas +++ b/restemplate.pas @@ -20,17 +20,47 @@ program restemplate; {$mode objfpc} +{$modeswitch advancedrecords} {.$define use_synapse} {$define use_fclweb} uses - SysUtils, Classes, strutils, IniFiles, + SysUtils, Classes, strutils, IniFiles, fgl, {$ifdef use_synapse}httpsend, ssl_openssl,{$endif} {$ifdef use_fclweb}fphttpclient,{$endif} JTemplate, fpjson, jsonparser, - DOM, XMLRead, XMLWrite; + DOM, XMLRead, XMLWrite, + RegExpr, crt; + +type + TContentType = (ctOther, ctJSON, ctXML); + + { THighlightFilter } + + THighlightFilter = class + Expression: TRegExpr; + FGColor: Byte; + BGColor: Byte; + constructor Create(AString: String); + destructor Destroy; override; + class var + FilterExpression: TRegExpr; + ParamExpression: TRegExpr; + end; + TFilterList = specialize TFPGObjectList; + + { THighlight } + + THighlight = record + FGColor: Byte; + BGColor: Byte; + Start: Integer; + Length: Integer; + class operator =(A, B: THighlight): Boolean; + end; + THighlights = specialize TFPGList; var data: TextFile; @@ -45,9 +75,43 @@ var templateFile, templateName: String; sessionIni: TIniFile; beautify: Boolean; + filters: TFilterList; -type - TContentType = (ctOther, ctJSON, ctXML); +{ THighlight } + +class operator THighlight. = (A, B: THighlight): Boolean; +begin + Result := (A.Start = B.Start) and (A.Length = B.Length); +end; + + +{ THighlightFilter } + +constructor THighlightFilter.Create(AString: String); +begin + FGColor := $FF; + BGColor := $FF; + if FilterExpression.Exec(AString) then + begin + Expression := TRegExpr.Create(Copy(AString, 1, FilterExpression.MatchPos[0] - 1)); + if ParamExpression.Exec(FilterExpression.Match[0]) then + repeat + if ParamExpression.Match[1] = 'FG' then + FGColor := StrToInt(ParamExpression.Match[2]) + else if ParamExpression.Match[1] = 'BG' then + BGColor := StrToInt(ParamExpression.Match[2]); + until not ParamExpression.ExecNext; + end else + Expression := TRegExpr.Create(AString); +end; + +destructor THighlightFilter.Destroy; +begin + Expression.Free; + inherited Destroy; +end; + +{ Main } procedure CmdAskUser(AName: String); var @@ -107,6 +171,75 @@ begin Result := (ContentType <> ctOther); end; +function CompareHighlights(const AHL1: THighlight; const AHL2: THighlight): Integer; +begin + if AHL1.Start = AHL2.Start then + begin + Result := AHL1.Length - AHL2.Length; + end else + Result := AHL1.Start - AHL2.Start; +end; + +procedure WriteContent; +var + i: Integer; + matchPos, offset, lastPos: Integer; + data: String; + highlights: THighlights; + highlight: THighlight; +begin + highlights := THighlights.Create; + data := content.Text; + + offset := 0; + lastPos := 1; + + for i := 0 to filters.Count - 1 do + begin + if filters[i].Expression.Exec(data) then + begin + repeat + highlight.Start := filters[i].Expression.MatchPos[0]; + highlight.Length := filters[i].Expression.MatchLen[0]; + highlight.FGColor := filters[i].FGColor; + highlight.BGColor := filters[i].BGColor; + highlights.Add(highlight); + until not filters[i].Expression.ExecNext; + end; + end; + + highlights.Sort(@CompareHighlights); + + // Sanitize highlights + for i := 0 to highlights.Count - 2 do + begin + if (highlights[i].Start + highlights[i].Length) > highlights[i+1].Start then + begin + highlight := highlights[i]; + highlight.Length := highlights[i+1].Start - highlights[i].Start; + highlights[i] := highlight; + end; + end; + + for highlight in highlights do + begin + matchPos := highlight.Start; + offset := highlight.Length; + write(Copy(data, lastPos, matchPos - lastPos)); + if highlight.FGColor < $FF then + TextColor(highlight.FGColor); + if highlight.BGColor < $FF then + TextBackground(highlight.BGColor); + write(Copy(data, matchPos, offset)); + NormVideo; + lastPos := matchPos + offset; + end; + + writeln(Copy(data, lastPos, Length(data))); + + highlights.Free; +end; + procedure ProcessCall(AURL: String); var s: String; @@ -199,9 +332,10 @@ begin begin jsonParser := TJSONParser.Create(response); jsonData := jsonParser.Parse; - writeln(jsonData.FormatJSON); + content.Text := jsonData.FormatJSON; jsonData.Free; jsonParser.Free; + WriteContent; end; ctXML: begin @@ -210,13 +344,13 @@ begin WriteXMLFile(xmlDoc, response); response.Position := 0; content.LoadFromStream(response); - writeln(content.Text); + WriteContent; end; end; end else begin content.LoadFromStream(response); - writeln(content.Text); + WriteContent; end; response.Free; @@ -238,6 +372,12 @@ begin http.Password := Copy(AData, i + 1, Length(AData)); end; +procedure CmdHighlight(AData: String); +begin + writeln('Adding expression: ', AData); + filters.Add(THighlightFilter.Create(AData)); +end; + function ProcessCommand(ALine: String): Boolean; begin Result := False; @@ -269,6 +409,11 @@ begin Result := True; beautify := True; end else + if AnsiStartsStr('Highlight ', ALine) then + begin + Result := True; + CmdHighlight(Copy(ALine, 11, Length(ALine))); + end else if AnsiStartsStr('Call ', ALine) then begin Result := True; @@ -326,6 +471,9 @@ begin parser := TJTemplateParser.Create; content := TStringList.Create; beautify := False; //By default, we don't want to manipulate output. + filters := TFilterList.Create; + THighlightFilter.FilterExpression := TRegExpr.Create('( (FG|BG)(\d+))*$'); + THighlightFilter.ParamExpression := TRegExpr.Create('(FG|BG)(\d+)'); {$ifdef use_synapse} http := THTTPSend.Create; @@ -359,6 +507,9 @@ begin parser.Free; http.Free; content.Free; + filters.Free; + THighlightFilter.FilterExpression.Free; + THighlightFilter.ParamExpression.Free; CloseFile(data); end;