Initial commit

This commit is contained in:
2015-09-17 11:47:04 +02:00
commit c128b16996
48 changed files with 41459 additions and 0 deletions

28
jtemplate/LICENSE Normal file
View File

@@ -0,0 +1,28 @@
JTemplate plugin.
Copyright (C) 2013 Silvio Clecio - silvioprog@gmail.com
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published by
the Free Software Foundation; either version 2 of the License, or (at your
option) any later version with the following modification:
As a special exception, the copyright holders of this library give you
permission to link this library with independent modules to produce an
executable, regardless of the license terms of these independent modules,and
to copy and distribute the resulting executable under terms of your choice,
provided that you also meet, for each linked independent module, the terms
and conditions of the license of that module. An independent module is a
module which is not derived from or based on this library. If you modify
this library, you may extend this exception to your version of the library,
but you are not obligated to do so. If you do not wish to do so, delete this
exception statement from your version.
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. See the GNU Library General Public License
for more details.
You should have received a copy of the GNU Library General Public License
along with this library; if not, write to the Free Software Foundation,
Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.

496
jtemplate/jtemplate.pas Normal file
View File

@@ -0,0 +1,496 @@
(*
J-Template plugin.
Copyright (C) 2012-2014 Silvio Clecio.
Please see the LICENSE, README and AUTHORS files.
*)
unit JTemplate;
{$mode objfpc}{$H+}
interface
uses
SysUtils, StrUtils, Classes, FPJSON;
type
EJTemplate = class(Exception);
TJTemplateParserClass = class of TJTemplateParser;
TJTemplateStreamClass = class of TJTemplateStream;
TJTemplateLoadingFieldsEvent = procedure(Sender: TObject;
var AVar, AValue: string) of object;
TJTemplateReplacingEvent = procedure(Sender: TObject;
var AValue: string) of object;
{ TJTemplateParser }
TJTemplateParser = class
private
FContent: string;
FFields: TJSONObject;
FHtmlSupports: Boolean;
FOnLoadingFields: TJTemplateLoadingFieldsEvent;
FOnReplace: TNotifyEvent;
FOnReplacing: TJTemplateReplacingEvent;
FTagEscape: ShortString;
FTagPrefix: ShortString;
FTagSuffix: ShortString;
public
constructor Create; virtual;
destructor Destroy; override;
procedure Replace(const ARecursive: Boolean = False); virtual;
property Content: string read FContent write FContent;
property Fields: TJSONObject read FFields write FFields;
property HtmlSupports: Boolean read FHtmlSupports write FHtmlSupports;
property TagPrefix: ShortString read FTagPrefix write FTagPrefix;
property TagSuffix: ShortString read FTagSuffix write FTagSuffix;
property TagEscape: ShortString read FTagEscape write FTagEscape;
property OnLoadingFields: TJTemplateLoadingFieldsEvent read FOnLoadingFields
write FOnLoadingFields;
property OnReplacing: TJTemplateReplacingEvent read FOnReplacing
write FOnReplacing;
property OnReplace: TNotifyEvent read FOnReplace write FOnReplace;
end;
{ TJTemplateStream }
TJTemplateStream = class
private
FParser: TJTemplateParser;
protected
function CreateParser: TJTemplateParser; virtual;
procedure FreeParser; virtual;
function GetParserClass: TJTemplateParserClass; virtual;
public
constructor Create; virtual;
destructor Destroy; override;
procedure LoadFromStream(AStream: TStream);
procedure LoadFromFile(const AFileName: TFileName);
procedure SaveToStream(AStream: TStream);
procedure SaveToFile(const AFileName: TFileName);
property Parser: TJTemplateParser read FParser write FParser;
end;
{ TJTemplate }
TJTemplate = class(TComponent)
private
FContent: TStrings;
FOnLoadingFields: TJTemplateLoadingFieldsEvent;
FOnReplace: TNotifyEvent;
FOnReplacing: TJTemplateReplacingEvent;
FStream: TJTemplateStream;
function GetContent: TStrings;
function GetFields: TJSONObject;
function GetHtmlSupports: Boolean;
function GetParser: TJTemplateParser;
function GetStream: TJTemplateStream;
function GetTagEscape: string;
function GetTagPrefix: string;
function GetTagSuffix: string;
procedure SetContent(AValue: TStrings);
procedure SetFields(AValue: TJSONObject);
procedure SetHtmlSupports(AValue: Boolean);
procedure SetParser(AValue: TJTemplateParser);
procedure SetStream(AValue: TJTemplateStream);
procedure SetTagEscape(AValue: string);
procedure SetTagPrefix(AValue: string);
procedure SetTagSuffix(AValue: string);
protected
procedure Loaded; override;
function CreateStream: TJTemplateStream; virtual;
procedure FreeStream; virtual;
function GetStreamClass: TJTemplateStreamClass;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Replace(const ARecursive: Boolean = False);
procedure LoadFromStream(AStream: TStream);
procedure LoadFromFile(const AFileName: TFileName);
procedure SaveToStream(AStream: TStream);
procedure SaveToFile(const AFileName: TFileName);
property Fields: TJSONObject read GetFields write SetFields;
property Parser: TJTemplateParser read GetParser write SetParser;
property Stream: TJTemplateStream read GetStream write SetStream;
published
property Content: TStrings read GetContent write SetContent;
property HtmlSupports: Boolean read GetHtmlSupports write SetHtmlSupports;
property TagPrefix: string read GetTagPrefix write SetTagPrefix;
property TagSuffix: string read GetTagSuffix write SetTagSuffix;
property TagEscape: string read GetTagEscape write SetTagEscape;
property OnLoadingFields: TJTemplateLoadingFieldsEvent read FOnLoadingFields
write FOnLoadingFields;
property OnReplacing: TJTemplateReplacingEvent read FOnReplacing
write FOnReplacing;
property OnReplace: TNotifyEvent read FOnReplace write FOnReplace;
end;
resourcestring
SNilParamError = '"%s" must not be nil.';
const
LatinCharsCount = 74;
LatinChars: array[0..LatinCharsCount] of string = (
'"', '<', '>', '^', '~', '£', '§', '°', '²', '³', 'µ', '·', '¼', '½', '¿',
'À', 'Á', 'Â', 'Ã', 'Ä', 'Å', 'Æ', 'Ç', 'È', 'É', 'Ê', 'Ë', 'Ì', 'Í', 'Î',
'Ï', 'Ñ', 'Ò', 'Ó', 'Ô', 'Õ', 'Ö', 'Ù', 'Ú', 'Û', 'Ü', 'Ý', 'ß', 'á', 'à',
'â', 'ã', 'ä', 'å', 'æ', 'ç', 'é', 'è', 'ê', 'ë', 'ì', 'í', 'î', 'ï', 'ñ',
'ò', 'ó', 'ô', 'õ', 'ö', '÷', 'ù', 'ú', 'û', 'ü', 'ý', 'ÿ', '&', '´', '`');
HtmlChars: array[0..LatinCharsCount] of string = (
'&quot;', '&lt;', '&gt;', '&circ;', '&tilde;', '&pound;', '&sect;', '&deg;',
'&sup2;', '&sup3;', '&micro;', '&middot;', '&frac14;', '&frac12;', '&iquest;',
'&Agrave;', '&Aacute;', '&Acirc;', '&Atilde;', '&Auml;', '&Aring;', '&AElig;',
'&Ccedil;', '&Egrave;', '&Eacute;', '&Ecirc;', '&Euml;', '&Igrave;', '&Iacute;',
'&Icirc;', '&Iuml;', '&Ntilde;', '&Ograve;', '&Oacute;', '&Ocirc;', '&Otilde;',
'&Ouml;', '&Ugrave;', '&Uacute;', '&Ucirc;', '&Uuml;', '&Yacute;', '&szlig;',
'&aacute;', '&agrave;', '&acirc;', '&atilde;', '&auml;', '&aring;', '&aelig;',
'&ccedil;', '&eacute;', '&egrave;', '&ecirc;', '&euml;', '&igrave;', '&iacute;',
'&icirc;', '&iuml;', '&ntilde;', '&ograve;', '&oacute;', '&ocirc;', '&otilde;',
'&ouml;', '&divide;', '&ugrave;', '&uacute;', '&ucirc;', '&uuml;', '&yacute;',
'&yuml;', '&amp;', '&acute;', '&grave;');
function StrToHtml(const S: string): string;
implementation
function StrToHtml(const S: string): string;
function _Found(const ABuf: PChar; const ALen: Integer): Integer; inline;
var
P: PString;
begin
for Result := Low(LatinChars) to High(LatinChars) do
begin
P := @LatinChars[Result];
if Length(P^) <= ALen then
// compare in blocks of 8(x64), 4, 2 and 1 byte
if CompareByte(P^[1], ABuf^, Length(P^)) = 0 then
Exit;
end;
Result := -1;
end;
var
I: Integer;
VResStr: string;
PComp, PLast: PChar;
begin
VResStr := '';
PComp := @S[1];
PLast := PComp + Length(S);
while PComp < PLast do
begin
I := _Found(PComp, PLast - PComp);
if I > -1 then
begin
VResStr := VResStr + HtmlChars[I];
Inc(PComp, Length(LatinChars[I]));
end
else
begin
// it can be optimized decreasing the concatenations
VResStr := VResStr + PComp^;
Inc(PComp);
end;
end;
Result := VResStr;
end;
{ TJTemplateParser }
constructor TJTemplateParser.Create;
begin
FFields := TJSONObject.Create;
FTagPrefix := '@';
FHtmlSupports := True;
end;
destructor TJTemplateParser.Destroy;
begin
FreeAndNil(FFields);
inherited Destroy;
end;
procedure TJTemplateParser.Replace(const ARecursive: Boolean);
var
VVar, VValue: string;
I, P, VTagLen, VEscapLen: Integer;
begin
VEscapLen := Length(FTagEscape);
for I := 0 to Pred(FFields.Count) do
begin
VVar := FTagPrefix + FFields.Names[I] + FTagSuffix;
if FHtmlSupports then
VValue := StrToHtml(FFields.Items[I].AsString)
else
VValue := FFields.Items[I].AsString;
if Assigned(FOnLoadingFields) then
FOnLoadingFields(Self, VVar, VValue);
P := 1;
VTagLen := Length(VVar);
repeat
P := PosEx(VVar, FContent, P);
if P < 1 then
Break;
if (VEscapLen <> 0) and // no TagEscape defined
(CompareChar(FContent[P - VEscapLen], FTagEscape[1], VEscapLen) = 0) then
begin
System.Delete(FContent, P - VEscapLen, VEscapLen);
Inc(P, VTagLen - VEscapLen);
end
else
begin
System.Delete(FContent, P, VTagLen);
if Assigned(FOnReplacing) then
FOnReplacing(Self, VValue);
Insert(VValue, FContent, P);
Inc(P, Length(VValue));
if not ARecursive then
Break;
end;
until False;
end;
if Assigned(FOnReplace) then
FOnReplace(Self);
end;
{ TJTemplateStream }
constructor TJTemplateStream.Create;
begin
inherited Create;
FParser := CreateParser;
end;
destructor TJTemplateStream.Destroy;
begin
FreeParser;
inherited Destroy;
end;
function TJTemplateStream.CreateParser: TJTemplateParser;
begin
Result := GetParserClass.Create;
end;
procedure TJTemplateStream.FreeParser;
begin
FreeAndNil(FParser);
end;
function TJTemplateStream.GetParserClass: TJTemplateParserClass;
begin
Result := TJTemplateParser;
end;
procedure TJTemplateStream.LoadFromStream(AStream: TStream);
begin
if not Assigned(AStream) then
raise EJTemplate.CreateFmt(SNilParamError, ['AStream']);
AStream.Seek(0, 0);
SetLength(FParser.FContent, AStream.Size);
AStream.Read(Pointer(FParser.FContent)^, Length(FParser.FContent));
end;
procedure TJTemplateStream.LoadFromFile(const AFileName: TFileName);
var
VFile: TFileStream;
begin
VFile := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyWrite);
try
LoadFromStream(VFile);
finally
VFile.Free;
end;
end;
procedure TJTemplateStream.SaveToStream(AStream: TStream);
begin
if not Assigned(AStream) then
raise EJTemplate.CreateFmt(SNilParamError, ['AStream']);
AStream.Seek(0, 0);
AStream.Write(Pointer(FParser.FContent)^, Length(FParser.FContent));
end;
procedure TJTemplateStream.SaveToFile(const AFileName: TFileName);
var
VFile: TFileStream;
begin
VFile := TFileStream.Create(AFileName, fmCreate);
try
SaveToStream(VFile);
finally
VFile.Free;
end;
end;
{ TJTemplate }
constructor TJTemplate.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FStream := CreateStream;
FContent := TStringList.Create;
end;
destructor TJTemplate.Destroy;
begin
FContent.Free;
FreeStream;
inherited Destroy;
end;
function TJTemplate.CreateStream: TJTemplateStream;
begin
Result := GetStreamClass.Create;
end;
procedure TJTemplate.FreeStream;
begin
FreeAndNil(FStream);
end;
function TJTemplate.GetStreamClass: TJTemplateStreamClass;
begin
Result := TJTemplateStream;
end;
function TJTemplate.GetContent: TStrings;
begin
Result := FContent;
if Assigned(FContent) then
FContent.Text := FStream.FParser.FContent;
end;
function TJTemplate.GetFields: TJSONObject;
begin
Result := FStream.FParser.FFields;
end;
function TJTemplate.GetHtmlSupports: Boolean;
begin
Result := FStream.FParser.FHtmlSupports;
end;
function TJTemplate.GetParser: TJTemplateParser;
begin
Result := FStream.FParser;
end;
function TJTemplate.GetStream: TJTemplateStream;
begin
Result := FStream;
end;
function TJTemplate.GetTagEscape: string;
begin
Result := FStream.FParser.FTagEscape;
end;
function TJTemplate.GetTagPrefix: string;
begin
Result := FStream.FParser.FTagPrefix;
end;
function TJTemplate.GetTagSuffix: string;
begin
Result := FStream.FParser.FTagSuffix;
end;
procedure TJTemplate.SetContent(AValue: TStrings);
begin
if Assigned(AValue) then
begin
FContent.Assign(AValue);
FStream.FParser.FContent := AValue.Text;
end;
end;
procedure TJTemplate.SetFields(AValue: TJSONObject);
begin
FStream.FParser.FFields := AValue;
end;
procedure TJTemplate.SetHtmlSupports(AValue: Boolean);
begin
FStream.FParser.FHtmlSupports := AValue;
end;
procedure TJTemplate.SetParser(AValue: TJTemplateParser);
begin
FStream.FParser := AValue;
if Assigned(AValue) then
begin
AValue.OnLoadingFields := FOnLoadingFields;
AValue.OnReplacing := FOnReplacing;
AValue.OnReplace := FOnReplace;
end;
end;
procedure TJTemplate.SetStream(AValue: TJTemplateStream);
begin
FStream := AValue;
end;
procedure TJTemplate.SetTagEscape(AValue: string);
begin
FStream.FParser.FTagEscape := AValue;
end;
procedure TJTemplate.SetTagPrefix(AValue: string);
begin
FStream.FParser.FTagPrefix := AValue;
end;
procedure TJTemplate.SetTagSuffix(AValue: string);
begin
FStream.FParser.FTagSuffix := AValue;
end;
procedure TJTemplate.Loaded;
begin
inherited Loaded;
if Assigned(FContent) then
FStream.FParser.FContent := FContent.Text;
if Assigned(FStream) and Assigned(FStream.FParser) then
begin
if Assigned(FOnLoadingFields) then
FStream.FParser.OnLoadingFields := FOnLoadingFields;
if Assigned(FOnReplacing) then
FStream.FParser.OnReplacing := FOnReplacing;
if Assigned(FOnReplace) then
FStream.FParser.OnReplace := FOnReplace;
end;
end;
procedure TJTemplate.Replace(const ARecursive: Boolean);
begin
FStream.FParser.Replace(ARecursive);
end;
procedure TJTemplate.LoadFromStream(AStream: TStream);
begin
FStream.LoadFromStream(AStream);
end;
procedure TJTemplate.LoadFromFile(const AFileName: TFileName);
begin
FStream.LoadFromFile(AFileName);
end;
procedure TJTemplate.SaveToStream(AStream: TStream);
begin
FStream.SaveToStream(AStream);
end;
procedure TJTemplate.SaveToFile(const AFileName: TFileName);
begin
FStream.LoadFromFile(AFileName);
end;
end.