forks
/
dexed
mirror of https://gitlab.com/basile.b/dexed.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

fix, DUB json file that included trailing commas were not loadable

This commit is contained in:
Basile Burg 2016-01-30 10:11:56 +01:00
parent c9a1878987
commit b3d489d610
9 changed files with 6143 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

229
etc/fcl-json/src/README.txt Normal file
View File

@ -0,0 +1,229 @@
This package implements JSON support for FPC.
You might want to have a look at the lazarus jsonviewer tool, written using
fpJSON (see lazarus/tools/jsonviewer). It visualizes the fpJSON data and
shows how to program using fpjson.
JSON support consists of 3 parts:
unit fpJSON contains the data representation. Basically, it defines a set of
classes:
TJSONData
+- TJSONNumber
+- TJSONIntegerNumber
+- TJSONFloatNumber
+- TJSONInt64Number
+- TJSONString
+- TJSONBoolean
+- TJSONNull
+- TJSONObject
+- TJSONArray
The TJSONData.JSONType property is an enumerated:
TJSONtype = (jtUnknown, jtNumber, jtString, jtBoolean, jtNull, jtArray, jtObject);
Which allows to determine the type of a value.
The following methods exist:
Procedure Clear;
Clears the value. For arrays and objects, removes all elements/members
Function Clone : TJSONData;
Creates an exact replica of the valye
property Count: Integer;
For simple values this is zero, for complex values this is the number of
elements/members. Read only.
property Items[Index: Integer]: TJSONData
For simple values, reading this will result in an error. For complex
values, this gives access to the members.
property Value: variant;
The value as a variant. Only for simple values.
Property AsString : TJSONStringType:
The value as a string. Only for simple values.
Property AsFloat : TJSONFloat;
The value as a float (double). only for simple values.
Property AsInteger : Integer ;
The value as an integer. only for simple values.
Property AsInt64 : Int64;
The value as an 64-bit integer. only for simple values.
Property AsBoolean : Boolean ;
The value as a boolean.
Property IsNull : Boolean ;
Is the value Null ?
Property AsJSON : TJSONStringType
Return the value in JSON notation. For simple and complex values.
The TJSONArray type provides access to the elements in the array in the
following ways:
Property Types[Index : Integer] : TJSONType;
Indexed access to the types of the elements in the array.
Property Nulls[Index : Integer] : Boolean
Checks if the Index-the element is NULL.
Property Integers[Index : Integer] : Integer
Read/Write element values as integers.
Property Int64s[Index : Integer] : Int64
Read/Write element values as 64-bit integers.
Property Strings[Index : Integer] : TJSONStringType;
Read/Write element values as strings.
Property Floats[Index : Integer] : TJSONFloat ;
Read/Write element values as floats (doubles).
Property Booleans[Index : Integer] : Boolean;
Read/Write element values as booleans.
Property Arrays[Index : Integer] : TJSONArray;
Read/Write element values as arrays.
Property Objects[Index : Integer] : TJSONObject;
Read/Write element values a strings
Reading an element as a type which is incompatible, will result in an
exception. For instance if element 5 is an object value, then the following
will result in an exception:
i:=i+Array.Integers[5]
The TJSONObject type similarly provides access to the elements in the array
using the member names:
property Names[Index : Integer] : TJSONStringType;
Indexed access to the member names.
property Elements[AName: string] : TJSONData;
Read/Write a member as a raw TJSONData value.
Property Types[AName : String] : TJSONType Read GetTypes;
Read/Write the type of a member.
Property Nulls[AName : String] : Boolean;
Read/Write a member as a NULL value.
Property Floats[AName : String] : TJSONFloat;
Read/Write a member as a float value (double)
Property Integers[AName : String] : Integer;
Read/Write a member as an integer value
Property Int64s[AName : String] : Int64;
Read/Write a member as an 64-bit integer value
Property Strings[AName : String] : TJSONStringType;
Read/Write a member as a string value.
Property Booleans[AName : String] : Boolean;
Read/Write a member as a boolean value.
Property Arrays[AName : String] : TJSONArray;
Read/Write a member as an array value.
Property Objects[AName : String] : TJSONObject
Read/Write a member as an object value.
Members can be added with the Add() call, which exists in various overloaded
forms:
function Add(const AName: TJSONStringType; Const AValue): Integer;
Where the type of AVAlue is one of the supported types:
integer, int64, double, string, TJSONArray or TJSONObject.
The Delete() call deletes an element from an array or object. The element is
freed.
Important remark:
The array and object classes own their members: the members are destroyed as
they are deleted. For this, the Extract() call exists: it removes an
element/member from the array/object, without destroying it.
Converting from string/stream to JSONData
=========================================
The fpjson unit contains a GetJSON() function which accepts a string or a
stream as a parameter. The function will parse the JSON in the stream and
the return value is a TJSONData value corresponding to the JSON.
The function works with a callback, which is set by the JSONParser unit.
The JSONParser unit simply needs to be included in the project.
The parsing happens with default settings for the parser class.
You can override this behaviour by creating your own callback,
and creating the parser with different settings.
Enumerator support
==================
the TJSONData class offers support for an enumerator, hence the
For e in JSON do
construct can be used. The enumerator is a TJSONEnum value, which has 3
members:
Key : The key of the element
(name in TJSONObject, Index in TJSONArray, empty otherwise)
KeyNum: The index of the element.
(Index in TJSONArray/TJSONObject, 0 otherwise)
Value : The value of the element
(These are the member values for TJSONArray/TJSONObject, and is the
element itself otherwise)
While the enumerator is looping, it is not allowed to change the content of
the array or object, and the value may not be freed.
Scanner/Parser
==============
The JSONSCanner unit contains a scanner for JSON data: TJSONScanner.
Currently it does not support full unicode, only UTF-8 is supported.
The JSONParser unit contains the parser for JSON data: TJSONParser.
It uses to scanner to read the tokens. The scanner is created automatically.
The Parse method will parse the data that was passed to the parser and will
return the JSON value.
Sample use:
Var
P : TJSONParser;
S : String;
D : TJSONObject;
begin
P:=TJSONParser.Create('{ "top": 10, "left": 20}');
try
D:=P.Parse as TJSONObject;
Writeln('Top : ',D.Integers['top']);
Writeln('Left : ',D.Integers['left']);
D.free;
Finally
P.free;
end;
end;
Note that the member names are case sensitive.
As an alternative, a stream may be passed to the constructor of TJSONParser.
The scanner and parser support the 'Strict' property.
Strict JSON syntax requires the member names of an object to be strings:
{ "top": 10, "left": 20}
However, due to the sloppy definition of Javascript (and hence JSON),
the following type of JSON notation is frequently encountered:
{ top: 10, left: 20}
By default, this sloppy notation is accepted. Setting 'Strict' to true will
reject this.
A second effect of the Strict property is the requirement of " as a string
delimiter. A single quote is also often found in Javascript and JSON:
{ title: 'A nice title' }
By default, this is accepted. Setting 'Strict' to true will reject this.
Customizing the classes : Factory support
=========================================
The various classes created by the methods can be customized.
This can be useful to create customized descendents, for example to attach
extra data to the various values. All instances of TJSONData are created
through the CreateJSON() functions, which use a set of customizable classes
to create the JSONData structures.
All functions which somehow create a new instance (clone, add, insert, parsing)
use the CreateJSON functions.
Which classes need to be created for a specific value is enumerated in
TJSONInstanceType = (jitUnknown, jitNumberInteger,jitNumberInt64,jitNumberFloat,
jitString, jitBoolean, jitNull, jitArray, jitObject);
when a Int64 value must be instantiated, the class identified with
jitNumberInt64 is instantiated.
To customize the classes, the new class can be set using SetJSONInstanceType:
Procedure SetJSONInstanceType(AType : TJSONInstanceType; AClass : TJSONDataClass);
Function GetJSONInstanceType(AType : TJSONInstanceType) : TJSONDataClass;
The function checks whether sane classes are specified.;

3131
etc/fcl-json/src/fpjson.pp Normal file
View File

File diff suppressed because it is too large Load Diff

1119
etc/fcl-json/src/fpjsonrtti.pp Normal file
View File

File diff suppressed because it is too large Load Diff

793
etc/fcl-json/src/jsonconf.pp Normal file
View File

@ -0,0 +1,793 @@
{
This file is part of the Free Component Library
Implementation of TJSONConfig class
Copyright (c) 2007 Michael Van Canneyt michael@freepascal.org
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.
**********************************************************************}
{
TJSONConfig enables applications to use JSON files for storing their
configuration data
}
{$IFDEF FPC}
{$MODE objfpc}
{$H+}
{$ENDIF}
unit jsonConf;
interface
uses
SysUtils, Classes, fpjson, jsonscanner, jsonparser;
type
EJSONConfigError = class(Exception);
(* ********************************************************************
"APath" is the path and name of a value: A JSON configuration file
is hierachical. "/" is the path delimiter, the part after the last
"/" is the name of the value. The path components will be mapped
to nested JSON objects, with the name equal to the part. In practice
this means that "/my/path/value" will be written as:
{
"my" : {
"path" : {
"value" : Value
}
}
}
******************************************************************** *)
{ TJSONConfig }
TJSONConfig = class(TComponent)
private
FFilename: String;
FFormatIndentSize: Integer;
FFormatoptions: TFormatOptions;
FFormatted: Boolean;
FKey: TJSONObject;
procedure DoSetFilename(const AFilename: String; ForceReload: Boolean);
procedure SetFilename(const AFilename: String);
Function StripSlash(Const P : UnicodeString) : UnicodeString;
protected
FJSON: TJSONObject;
FModified: Boolean;
procedure Loaded; override;
function FindPath(Const APath: UnicodeString; AllowCreate : Boolean) : TJSONObject;
function FindObject(Const APath: UnicodeString; AllowCreate : Boolean) : TJSONObject;
function FindObject(Const APath: UnicodeString; AllowCreate : Boolean;Out ElName : UnicodeString) : TJSONObject;
function FindElement(Const APath: UnicodeString; CreateParent : Boolean; AllowObject : Boolean = False) : TJSONData;
function FindElement(Const APath: UnicodeString; CreateParent : Boolean; out AParent : TJSONObject; Out ElName : UnicodeString; AllowObject : Boolean = False) : TJSONData;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
Procedure Reload;
procedure Clear;
procedure Flush; // Writes the JSON file
procedure OpenKey(const aPath: UnicodeString; AllowCreate : Boolean);
procedure CloseKey;
procedure ResetKey;
Procedure EnumSubKeys(Const APath : UnicodeString; List : TStrings);
Procedure EnumValues(Const APath : UnicodeString; List : TStrings);
function GetValue(const APath: UnicodeString; const ADefault: UnicodeString): UnicodeString; overload;
function GetValue(const APath: UnicodeString; ADefault: Integer): Integer; overload;
function GetValue(const APath: UnicodeString; ADefault: Int64): Int64; overload;
function GetValue(const APath: UnicodeString; ADefault: Boolean): Boolean; overload;
function GetValue(const APath: UnicodeString; ADefault: Double): Double; overload;
Function GetValue(const APath: UnicodeString; AValue: TStrings; Const ADefault: String) : Boolean; overload;
Function GetValue(const APath: UnicodeString; AValue: TStrings; Const ADefault: TStrings): Boolean; overload;
procedure SetValue(const APath: UnicodeString; const AValue: UnicodeString); overload;
procedure SetValue(const APath: UnicodeString; AValue: Integer); overload;
procedure SetValue(const APath: UnicodeString; AValue: Int64); overload;
procedure SetValue(const APath: UnicodeString; AValue: Boolean); overload;
procedure SetValue(const APath: UnicodeString; AValue: Double); overload;
procedure SetValue(const APath: UnicodeString; AValue: TStrings; AsObject : Boolean = False); overload;
procedure SetDeleteValue(const APath: UnicodeString; const AValue, DefValue: UnicodeString); overload;
procedure SetDeleteValue(const APath: UnicodeString; AValue, DefValue: Integer); overload;
procedure SetDeleteValue(const APath: UnicodeString; AValue, DefValue: Int64); overload;
procedure SetDeleteValue(const APath: UnicodeString; AValue, DefValue: Boolean); overload;
procedure DeletePath(const APath: UnicodeString);
procedure DeleteValue(const APath: UnicodeString);
property Modified: Boolean read FModified;
published
Property Filename: String read FFilename write SetFilename;
Property Formatted : Boolean Read FFormatted Write FFormatted;
Property FormatOptions : TFormatOptions Read FFormatoptions Write FFormatOptions Default DefaultFormat;
Property FormatIndentsize : Integer Read FFormatIndentSize Write FFormatIndentSize Default DefaultIndentSize;
end;
// ===================================================================
implementation
Resourcestring
SErrInvalidJSONFile = '"%s" is not a valid JSON configuration file.';
SErrCouldNotOpenKey = 'Could not open key "%s".';
constructor TJSONConfig.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FJSON:=TJSONObject.Create;
FKey:=FJSON;
FFormatOptions:=DefaultFormat;
FFormatIndentsize:=DefaultIndentSize;
end;
destructor TJSONConfig.Destroy;
begin
if Assigned(FJSON) then
begin
Flush;
FreeANdNil(FJSON);
end;
inherited Destroy;
end;
procedure TJSONConfig.Clear;
begin
FJSON.Clear;
FKey:=FJSON;
end;
procedure TJSONConfig.Flush;
Var
F : Text;
S : TJSONStringType;
begin
if Modified then
begin
AssignFile(F,FileName);
Rewrite(F);
Try
if Formatted then
S:=FJSON.FormatJSON(Formatoptions,FormatIndentSize)
else
S:=FJSON.AsJSON;
Writeln(F,S);
Finally
CloseFile(F);
end;
FModified := False;
end;
end;
function TJSONConfig.FindObject(const APath: UnicodeString; AllowCreate: Boolean
): TJSONObject;
Var
Dummy : UnicodeString;
begin
Result:=FindObject(APath,AllowCreate,Dummy);
end;
function TJSONConfig.FindObject(const APath: UnicodeString; AllowCreate: Boolean;
out ElName: UnicodeString): TJSONObject;
Var
S,El : UnicodeString;
P,I : Integer;
T : TJSonObject;
begin
// Writeln('Looking for : ', APath);
S:=APath;
If Pos('/',S)=1 then
Result:=FJSON
else
Result:=FKey;
Repeat
P:=Pos('/',S);
If (P<>0) then
begin
// Only real paths, ignore double slash
If (P<>1) then
begin
El:=Copy(S,1,P-1);
If (Result.Count=0) then
I:=-1
else
I:=Result.IndexOfName(UTF8Encode(El));
If (I=-1) then
// No element with this name.
begin
If AllowCreate then
begin
// Create new node.
T:=Result;
Result:=TJSonObject.Create;
T.Add(UTF8Encode(El),Result);
end
else
Result:=Nil
end
else
// Node found, check if it is an object
begin
if (Result.Items[i].JSONtype=jtObject) then
Result:=Result.Objects[UTF8Encode(el)]
else
begin
// Writeln(el,' type wrong');
If AllowCreate then
begin
// Writeln('Creating ',el);
Result.Delete(I);
T:=Result;
Result:=TJSonObject.Create;
T.Add(UTF8Encode(El),Result);
end
else
Result:=Nil
end;
end;
end;
Delete(S,1,P);
end;
Until (P=0) or (Result=Nil);
ElName:=S;
end;
function TJSONConfig.FindElement(const APath: UnicodeString; CreateParent: Boolean; AllowObject : Boolean = False): TJSONData;
Var
O : TJSONObject;
ElName : UnicodeString;
begin
Result:=FindElement(APath,CreateParent,O,ElName,AllowObject);
end;
function TJSONConfig.FindElement(const APath: UnicodeString;
CreateParent: Boolean; out AParent: TJSONObject; out ElName: UnicodeString;
AllowObject : Boolean = False): TJSONData;
Var
I : Integer;
begin
Result:=Nil;
Aparent:=FindObject(APath,CreateParent,ElName);
If Assigned(Aparent) then
begin
// Writeln('Found parent, looking for element:',elName);
I:=AParent.IndexOfName(UTF8Encode(ElName));
// Writeln('Element index is',I);
If (I<>-1) And ((AParent.items[I].JSONType<>jtObject) or AllowObject) then
Result:=AParent.Items[i];
end;
// Writeln('Find ',aPath,' in "',FJSON.AsJSOn,'" : ',Elname,' : ',Result<>NIl);
end;
function TJSONConfig.GetValue(const APath: UnicodeString; const ADefault: UnicodeString): UnicodeString;
var
El : TJSONData;
begin
El:=FindElement(StripSlash(APath),False);
If Assigned(El) then
Result:=El.AsUnicodeString
else
Result:=ADefault;
end;
function TJSONConfig.GetValue(const APath: UnicodeString; ADefault: Integer): Integer;
var
El : TJSONData;
begin
El:=FindElement(StripSlash(APath),False);
If Not Assigned(el) then
Result:=ADefault
else if (el is TJSONNumber) then
Result:=El.AsInteger
else
Result:=StrToIntDef(El.AsString,ADefault);
end;
function TJSONConfig.GetValue(const APath: UnicodeString; ADefault: Int64): Int64;
var
El : TJSONData;
begin
El:=FindElement(StripSlash(APath),False);
If Not Assigned(el) then
Result:=ADefault
else if (el is TJSONNumber) then
Result:=El.AsInt64
else
Result:=StrToInt64Def(El.AsString,ADefault);
end;
function TJSONConfig.GetValue(const APath: UnicodeString; ADefault: Boolean): Boolean;
var
El : TJSONData;
begin
El:=FindElement(StripSlash(APath),False);
If Not Assigned(el) then
Result:=ADefault
else if (el is TJSONBoolean) then
Result:=El.AsBoolean
else
Result:=StrToBoolDef(El.AsString,ADefault);
end;
function TJSONConfig.GetValue(const APath: UnicodeString; ADefault: Double): Double;
var
El : TJSONData;
begin
El:=FindElement(StripSlash(APath),False);
If Not Assigned(el) then
Result:=ADefault
else if (el is TJSONNumber) then
Result:=El.AsFloat
else
Result:=StrToFloatDef(El.AsString,ADefault);
end;
function TJSONConfig.GetValue(const APath: UnicodeString; AValue: TStrings;
const ADefault: String): Boolean;
var
El : TJSONData;
D : TJSONEnum;
begin
AValue.Clear;
El:=FindElement(StripSlash(APath),False,True);
Result:=Assigned(el);
If Not Result then
begin
AValue.Text:=ADefault;
exit;
end;
Case El.JSONType of
jtArray:
For D in El do
if D.Value.JSONType in ActualValueJSONTypes then
AValue.Add(D.Value.AsString);
jtObject:
For D in El do
if D.Value.JSONType in ActualValueJSONTypes then
AValue.Add(D.Key+'='+D.Value.AsString);
else
AValue.Text:=EL.AsString
end;
end;
function TJSONConfig.GetValue(const APath: UnicodeString; AValue: TStrings;
const ADefault: TStrings): Boolean;
begin
Result:=GetValue(APath,AValue,'');
If Not Result then
AValue.Assign(ADefault);
end;
procedure TJSONConfig.SetValue(const APath: UnicodeString; const AValue: UnicodeString);
var
El : TJSONData;
ElName : UnicodeString;
O : TJSONObject;
I : integer;
begin
El:=FindElement(StripSlash(APath),True,O,ElName);
if Assigned(El) and (El.JSONType<>jtString) then
begin
I:=O.IndexOfName(UTF8Encode(elName));
O.Delete(i);
El:=Nil;
end;
If Not Assigned(el) then
begin
El:=TJSONString.Create(AValue);
O.Add(UTF8Encode(ElName),El);
end
else
El.AsUnicodeString:=AValue;
FModified:=True;
end;
procedure TJSONConfig.SetDeleteValue(const APath: UnicodeString; const AValue, DefValue: UnicodeString);
begin
if AValue = DefValue then
DeleteValue(APath)
else
SetValue(APath, AValue);
end;
procedure TJSONConfig.SetValue(const APath: UnicodeString; AValue: Integer);
var
El : TJSONData;
ElName : UnicodeString;
O : TJSONObject;
I : integer;
begin
El:=FindElement(StripSlash(APath),True,O,ElName);
if Assigned(El) and (Not (El is TJSONIntegerNumber)) then
begin
I:=O.IndexOfName(UTF8Encode(elName));
If (I<>-1) then // Normally not needed...
O.Delete(i);
El:=Nil;
end;
If Not Assigned(el) then
begin
El:=TJSONIntegerNumber.Create(AValue);
O.Add(UTF8Encode(ElName),El);
end
else
El.AsInteger:=AValue;
FModified:=True;
end;
procedure TJSONConfig.SetValue(const APath: UnicodeString; AValue: Int64);
var
El : TJSONData;
ElName : UnicodeString;
O : TJSONObject;
I : integer;
begin
El:=FindElement(StripSlash(APath),True,O,ElName);
if Assigned(El) and (Not (El is TJSONInt64Number)) then
begin
I:=O.IndexOfName(UTF8Encode(elName));
If (I<>-1) then // Normally not needed...
O.Delete(i);
El:=Nil;
end;
If Not Assigned(el) then
begin
El:=TJSONInt64Number.Create(AValue);
O.Add(UTF8Encode(ElName),El);
end
else
El.AsInt64:=AValue;
FModified:=True;
end;
procedure TJSONConfig.SetDeleteValue(const APath: UnicodeString; AValue,
DefValue: Integer);
begin
if AValue = DefValue then
DeleteValue(APath)
else
SetValue(APath, AValue);
end;
procedure TJSONConfig.SetDeleteValue(const APath: UnicodeString; AValue,
DefValue: Int64);
begin
if AValue = DefValue then
DeleteValue(APath)
else
SetValue(APath, AValue);
end;
procedure TJSONConfig.SetValue(const APath: UnicodeString; AValue: Boolean);
var
El : TJSONData;
ElName : UnicodeString;
O : TJSONObject;
I : integer;
begin
El:=FindElement(StripSlash(APath),True,O,ElName);
if Assigned(El) and (el.JSONType<>jtBoolean) then
begin
I:=O.IndexOfName(UTF8Encode(elName));
O.Delete(i);
El:=Nil;
end;
If Not Assigned(el) then
begin
El:=TJSONBoolean.Create(AValue);
O.Add(UTF8Encode(ElName),El);
end
else
El.AsBoolean:=AValue;
FModified:=True;
end;
procedure TJSONConfig.SetValue(const APath: UnicodeString; AValue: Double);
var
El : TJSONData;
ElName : UnicodeString;
O : TJSONObject;
I : integer;
begin
El:=FindElement(StripSlash(APath),True,O,ElName);
if Assigned(El) and (Not (El is TJSONFloatNumber)) then
begin
I:=O.IndexOfName(UTF8Encode(elName));
O.Delete(i);
El:=Nil;
end;
If Not Assigned(el) then
begin
El:=TJSONFloatNumber.Create(AValue);
O.Add(UTF8Encode(ElName),El);
end
else
El.AsFloat:=AValue;
FModified:=True;
end;
procedure TJSONConfig.SetValue(const APath: UnicodeString; AValue: TStrings; AsObject : Boolean = False);
var
El : TJSONData;
ElName : UnicodeString;
O : TJSONObject;
I : integer;
A : TJSONArray;
N,V : String;
DoDelete: Boolean;
begin
El:=FindElement(StripSlash(APath),True,O,ElName,True);
if Assigned(El) then
begin
if AsObject then
DoDelete:=(Not (El is TJSONObject))
else
DoDelete:=(Not (El is TJSONArray));
if DoDelete then
begin
I:=O.IndexOfName(UTF8Encode(elName));
O.Delete(i);
El:=Nil;
end;
end;
If Not Assigned(el) then
begin
if AsObject then
El:=TJSONObject.Create
else
El:=TJSONArray.Create;
O.Add(UTF8Encode(ElName),El);
end;
if Not AsObject then
begin
A:=El as TJSONArray;
A.Clear;
For N in Avalue do
A.Add(N);
end
else
begin
O:=El as TJSONObject;
For I:=0 to AValue.Count-1 do
begin
AValue.GetNameValue(I,N,V);
O.Add(N,V);
end;
end;
FModified:=True;
end;
procedure TJSONConfig.SetDeleteValue(const APath: UnicodeString; AValue,
DefValue: Boolean);
begin
if AValue = DefValue then
DeleteValue(APath)
else
SetValue(APath,AValue);
end;
procedure TJSONConfig.DeletePath(const APath: UnicodeString);
Var
P : UnicodeString;
L : integer;
Node : TJSONObject;
ElName : UnicodeString;
begin
P:=StripSlash(APath);
L:=Length(P);
If (L>0) then
begin
Node := FindObject(P,False,ElName);
If Assigned(Node) then
begin
L:=Node.IndexOfName(UTF8Encode(ElName));
If (L<>-1) then
Node.Delete(L);
end;
end;
end;
procedure TJSONConfig.DeleteValue(const APath: UnicodeString);
begin
DeletePath(APath);
end;
procedure TJSONConfig.Reload;
begin
if Length(Filename) > 0 then
DoSetFilename(Filename,True);
end;
procedure TJSONConfig.Loaded;
begin
inherited Loaded;
Reload;
end;
function TJSONConfig.FindPath(const APath: UnicodeString; AllowCreate: Boolean
): TJSONObject;
Var
P : UnicodeString;
L : Integer;
begin
P:=APath;
L:=Length(P);
If (L=0) or (P[L]<>'/') then
P:=P+'/';
Result:=FindObject(P,AllowCreate);
end;
procedure TJSONConfig.DoSetFilename(const AFilename: String; ForceReload: Boolean);
Var
P : TJSONParser;
J : TJSONData;
F : TFileStream;
begin
if (not ForceReload) and (FFilename = AFilename) then
exit;
FFilename := AFilename;
if csLoading in ComponentState then
exit;
Flush;
If Not FileExists(AFileName) then
Clear
else
begin
F:=TFileStream.Create(AFileName,fmopenRead);
try
P:=TJSONParser.Create(F,[joUTF8,joComments]);
try
J:=P.Parse;
If (J is TJSONObject) then
begin
FreeAndNil(FJSON);
FJSON:=J as TJSONObject;
FKey:=FJSON;
end
else
Raise EJSONConfigError.CreateFmt(SErrInvalidJSONFile,[AFileName]);
finally
P.Free;
end;
finally
F.Free;
end;
end;
end;
procedure TJSONConfig.SetFilename(const AFilename: String);
begin
DoSetFilename(AFilename, False);
end;
function TJSONConfig.StripSlash(const P: UnicodeString): UnicodeString;
Var
L : Integer;
begin
L:=Length(P);
If (L>0) and (P[l]='/') then
Result:=Copy(P,1,L-1)
else
Result:=P;
end;
procedure TJSONConfig.CloseKey;
begin
ResetKey;
end;
procedure TJSONConfig.OpenKey(const aPath: UnicodeString; AllowCreate: Boolean);
Var
P : UnicodeString;
L : Integer;
begin
P:=APath;
L:=Length(P);
If (L=0) then
FKey:=FJSON
else
begin
if (P[L]<>'/') then
P:=P+'/';
FKey:=FindObject(P,AllowCreate);
If (FKey=Nil) Then
Raise EJSONConfigError.CreateFmt(SErrCouldNotOpenKey,[APath]);
end;
end;
procedure TJSONConfig.ResetKey;
begin
FKey:=FJSON;
end;
procedure TJSONConfig.EnumSubKeys(const APath: UnicodeString; List: TStrings);
Var
AKey : TJSONObject;
I : Integer;
begin
AKey:=FindPath(APath,False);
If Assigned(AKey) then
begin
For I:=0 to AKey.Count-1 do
If AKey.Items[i] is TJSONObject then
List.Add(AKey.Names[i]);
end;
end;
procedure TJSONConfig.EnumValues(const APath: UnicodeString; List: TStrings);
Var
AKey : TJSONObject;
I : Integer;
begin
AKey:=FindPath(APath,False);
If Assigned(AKey) then
begin
For I:=0 to AKey.Count-1 do
If Not (AKey.Items[i] is TJSONObject) then
List.Add(AKey.Names[i]);
end;
end;
end.

382
etc/fcl-json/src/jsonparser.pp Normal file
View File

@ -0,0 +1,382 @@
{
This file is part of the Free Component Library
JSON source parser
Copyright (c) 2007 by Michael Van Canneyt michael@freepascal.org
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.
**********************************************************************}
{$mode objfpc}
{$h+}
unit jsonparser;
interface
uses
Classes, SysUtils, fpJSON, jsonscanner;
Type
{ TJSONParser }
TJSONParser = Class(TObject)
Private
FScanner : TJSONScanner;
function GetO(AIndex: TJSONOption): Boolean;
function GetOptions: TJSONOptions;
function ParseNumber: TJSONNumber;
procedure SetO(AIndex: TJSONOption; AValue: Boolean);
procedure SetOptions(AValue: TJSONOptions);
Protected
procedure DoError(const Msg: String);
function DoParse(AtCurrent,AllowEOF: Boolean): TJSONData;
function GetNextToken: TJSONToken;
function CurrentTokenString: String;
function CurrentToken: TJSONToken;
function ParseArray: TJSONArray;
function ParseObject: TJSONObject;
Property Scanner : TJSONScanner read FScanner;
Public
function Parse: TJSONData;
Constructor Create(Source : TStream; AUseUTF8 : Boolean = True); overload;deprecated 'use options form instead';
Constructor Create(Source : TJSONStringType; AUseUTF8 : Boolean = True); overload;deprecated 'use options form instead';
constructor Create(Source: TStream; AOptions: TJSONOptions); overload;
constructor Create(const Source: String; AOptions: TJSONOptions); overload;
destructor Destroy();override;
// Use strict JSON: " for strings, object members are strings, not identifiers
Property Strict : Boolean Index joStrict Read GetO Write SetO ; deprecated 'use options instead';
// if set to TRUE, then strings will be converted to UTF8 ansistrings, not system codepage ansistrings.
Property UseUTF8 : Boolean index joUTF8 Read GetO Write SetO; deprecated 'Use options instead';
// Parsing options
Property Options : TJSONOptions Read GetOptions Write SetOptions;
end;
EJSONParser = Class(EParserError);
implementation
Resourcestring
SErrUnexpectedEOF = 'Unexpected EOF encountered.';
SErrUnexpectedToken = 'Unexpected token (%s) encountered.';
SErrExpectedColon = 'Expected colon (:), got token "%s".';
SErrUnexpectedComma = 'Invalid comma encountered.';
SErrEmptyElement = 'Empty element encountered.';
SErrExpectedElementName = 'Expected element name, got token "%s"';
SExpectedCommaorBraceClose = 'Expected , or ], got token "%s".';
SErrInvalidNumber = 'Number is not an integer or real number: %s';
SErrNoScanner = 'No scanner. No source specified ?';
{ TJSONParser }
procedure DefJSONParserHandler(AStream: TStream; const AUseUTF8: Boolean; out
Data: TJSONData);
Var
P : TJSONParser;
begin
Data:=Nil;
P:=TJSONParser.Create(AStream,[joUTF8]);
try
Data:=P.Parse;
finally
P.Free;
end;
end;
function TJSONParser.Parse: TJSONData;
begin
if (FScanner=Nil) then
DoError(SErrNoScanner);
Result:=DoParse(False,True);
end;
{
Consume next token and convert to JSON data structure.
If AtCurrent is true, the current token is used. If false,
a token is gotten from the scanner.
If AllowEOF is false, encountering a tkEOF will result in an exception.
}
function TJSONParser.CurrentToken: TJSONToken;
begin
Result:=FScanner.CurToken;
end;
function TJSONParser.CurrentTokenString: String;
begin
If CurrentToken in [tkString,tkIdentifier,tkNumber,tkComment] then
Result:=FScanner.CurTokenString
else
Result:=TokenInfos[CurrentToken];
end;
function TJSONParser.DoParse(AtCurrent, AllowEOF: Boolean): TJSONData;
var
T : TJSONToken;
begin
Result:=nil;
try
If not AtCurrent then
T:=GetNextToken
else
T:=FScanner.CurToken;
Case T of
tkEof : If Not AllowEof then
DoError(SErrUnexpectedEOF);
tkNull : Result:=CreateJSON;
tkTrue,
tkFalse : Result:=CreateJSON(t=tkTrue);
tkString : if joUTF8 in Options then
Result:=CreateJSON(UTF8Decode(CurrentTokenString))
else
Result:=CreateJSON(CurrentTokenString);
tkCurlyBraceOpen : Result:=ParseObject;
tkCurlyBraceClose : DoError(SErrUnexpectedToken);
tkSQuaredBraceOpen : Result:=ParseArray;
tkSQuaredBraceClose : DoError(SErrUnexpectedToken);
tkNumber : Result:=ParseNumber;
tkComma : DoError(SErrUnexpectedToken);
end;
except
FreeAndNil(Result);
Raise;
end;
end;
// Creates the correct JSON number type, based on the current token.
function TJSONParser.ParseNumber: TJSONNumber;
Var
I : Integer;
I64 : Int64;
QW : QWord;
F : TJSONFloat;
S : String;
begin
S:=CurrentTokenString;
I:=0;
if TryStrToQWord(S,QW) then
begin
if QW>qword(high(Int64)) then
Result:=CreateJSON(QW)
else
if QW>MaxInt then
begin
I64 := QW;
Result:=CreateJSON(I64);
end
else
begin
I := QW;
Result:=CreateJSON(I);
end
end
else
begin
If TryStrToInt64(S,I64) then
if (I64>Maxint) or (I64<-MaxInt) then
Result:=CreateJSON(I64)
Else
begin
I:=I64;
Result:=CreateJSON(I);
end
else
begin
I:=0;
Val(S,F,I);
If (I<>0) then
DoError(SErrInvalidNumber);
Result:=CreateJSON(F);
end;
end;
end;
function TJSONParser.GetO(AIndex: TJSONOption): Boolean;
begin
Result:=AIndex in Options;
end;
function TJSONParser.GetOptions: TJSONOptions;
begin
Result:=FScanner.Options
end;
procedure TJSONParser.SetO(AIndex: TJSONOption; AValue: Boolean);
begin
if aValue then
FScanner.Options:=FScanner.Options+[AINdex]
else
FScanner.Options:=FScanner.Options-[AINdex]
end;
procedure TJSONParser.SetOptions(AValue: TJSONOptions);
begin
FScanner.Options:=AValue;
end;
// Current token is {, on exit current token is }
function TJSONParser.ParseObject: TJSONObject;
Var
T : TJSONtoken;
E : TJSONData;
N : String;
LastComma : Boolean;
begin
LastComma:=False;
Result:=CreateJSONObject([]);
Try
T:=GetNextToken;
While T<>tkCurlyBraceClose do
begin
If (T<>tkString) and (T<>tkIdentifier) then
DoError(SErrExpectedElementName);
N:=CurrentTokenString;
T:=GetNextToken;
If (T<>tkColon) then
DoError(SErrExpectedColon);
E:=DoParse(False,False);
Result.Add(N,E);
T:=GetNextToken;
If Not (T in [tkComma,tkCurlyBraceClose]) then
DoError(SExpectedCommaorBraceClose);
If T=tkComma then
begin
T:=GetNextToken;
LastComma:=(t=tkCurlyBraceClose);
end;
end;
If LastComma and ((joStrict in Options) or not (joIgnoreTrailingComma in Options)) then // Test for ,} case
DoError(SErrUnExpectedToken);
Except
FreeAndNil(Result);
Raise;
end;
end;
// Current token is [, on exit current token is ]
function TJSONParser.ParseArray: TJSONArray;
Var
T : TJSONtoken;
E : TJSONData;
LastComma : Boolean;
S : TJSONOPTions;
begin
Result:=CreateJSONArray([]);
LastComma:=False;
Try
Repeat
T:=GetNextToken;
If (T<>tkSquaredBraceClose) then
begin
E:=DoParse(True,False);
If (E<>Nil) then
Result.Add(E)
else if (Result.Count>0) then
DoError(SErrEmptyElement);
T:=GetNextToken;
If Not (T in [tkComma,tkSquaredBraceClose]) then
DoError(SExpectedCommaorBraceClose);
LastComma:=(t=TkComma);
end;
Until (T=tkSquaredBraceClose);
S:=Options;
If LastComma and ((joStrict in S) or not (joIgnoreTrailingComma in S)) then // Test for ,] case
DoError(SErrUnExpectedToken);
Except
FreeAndNil(Result);
Raise;
end;
end;
// Get next token, discarding whitespace
function TJSONParser.GetNextToken: TJSONToken;
begin
Repeat
Result:=FScanner.FetchToken;
Until (Not (Result in [tkComment,tkWhiteSpace]));
end;
procedure TJSONParser.DoError(const Msg: String);
Var
S : String;
begin
S:=Format(Msg,[CurrentTokenString]);
S:=Format('Error at line %d, Pos %d:',[FScanner.CurRow,FSCanner.CurColumn])+S;
Raise EJSONParser.Create(S);
end;
constructor TJSONParser.Create(Source: TStream; AUseUTF8 : Boolean = True);
begin
Inherited Create;
FScanner:=TJSONScanner.Create(Source,[joUTF8]);
if AUseUTF8 then
Options:=Options + [joUTF8];
end;
constructor TJSONParser.Create(Source: TJSONStringType; AUseUTF8 : Boolean = True);
begin
Inherited Create;
FScanner:=TJSONScanner.Create(Source,[joUTF8]);
if AUseUTF8 then
Options:=Options + [joUTF8];
end;
constructor TJSONParser.Create(Source: TStream; AOptions: TJSONOptions);
begin
FScanner:=TJSONScanner.Create(Source,AOptions);
end;
constructor TJSONParser.Create(const Source: String; AOptions: TJSONOptions);
begin
FScanner:=TJSONScanner.Create(Source,AOptions);
end;
destructor TJSONParser.Destroy();
begin
FreeAndNil(FScanner);
inherited Destroy();
end;
Procedure InitJSONHandler;
begin
if GetJSONParserHandler=Nil then
SetJSONParserHandler(@DefJSONParserHandler);
end;
Procedure DoneJSONHandler;
begin
if GetJSONParserHandler=@DefJSONParserHandler then
SetJSONParserHandler(Nil);
end;
initialization
InitJSONHandler;
finalization
DoneJSONHandler;
end.

481
etc/fcl-json/src/jsonscanner.pp Normal file
View File

@ -0,0 +1,481 @@
{
This file is part of the Free Component Library
JSON source lexical scanner
Copyright (c) 2007 by Michael Van Canneyt michael@freepascal.org
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.
**********************************************************************}
{$mode objfpc}
{$h+}
unit jsonscanner;
interface
uses SysUtils, Classes;
resourcestring
SErrInvalidCharacter = 'Invalid character at line %d, pos %d: ''%s''';
SUnterminatedComment = 'Unterminated comment at line %d, pos %d: ''%s''';
SErrOpenString = 'string exceeds end of line';
type
TJSONToken = (
tkEOF,
tkWhitespace,
tkString,
tkNumber,
tkTrue,
tkFalse,
tkNull,
// Simple (one-character) tokens
tkComma, // ','
tkColon, // ':'
tkCurlyBraceOpen, // '{'
tkCurlyBraceClose, // '}'
tkSquaredBraceOpen, // '['
tkSquaredBraceClose, // ']'
tkIdentifier, // Any Javascript identifier
tkComment,
tkUnknown
);
EScannerError = class(EParserError);
TJSONOption = (joUTF8,joStrict,joComments,joIgnoreTrailingComma);
TJSONOptions = set of TJSONOption;
Const
DefaultOptions = [joUTF8];
Type
{ TJSONScanner }
TJSONScanner = class
private
FAllowComments: Boolean;
FSource : TStringList;
FCurRow: Integer;
FCurToken: TJSONToken;
FCurTokenString: string;
FCurLine: string;
TokenStr: PChar;
FOptions : TJSONOptions;
function GetCurColumn: Integer;
function GetO(AIndex: TJSONOption): Boolean;
procedure SetO(AIndex: TJSONOption; AValue: Boolean);
protected
procedure Error(const Msg: string);overload;
procedure Error(const Msg: string; Const Args: array of Const);overload;
function DoFetchToken: TJSONToken;
public
constructor Create(Source : TStream; AUseUTF8 : Boolean = True); overload; deprecated 'use options form instead';
constructor Create(const Source : String; AUseUTF8 : Boolean = True); overload; deprecated 'use options form instead';
constructor Create(Source: TStream; AOptions: TJSONOptions); overload;
constructor Create(const Source: String; AOptions: TJSONOptions); overload;
destructor Destroy; override;
function FetchToken: TJSONToken;
property CurLine: string read FCurLine;
property CurRow: Integer read FCurRow;
property CurColumn: Integer read GetCurColumn;
property CurToken: TJSONToken read FCurToken;
property CurTokenString: string read FCurTokenString;
// Use strict JSON: " for strings, object members are strings, not identifiers
Property Strict : Boolean Index joStrict Read GetO Write SetO ; deprecated 'use options instead';
// if set to TRUE, then strings will be converted to UTF8 ansistrings, not system codepage ansistrings.
Property UseUTF8 : Boolean index joUTF8 Read GetO Write SetO; deprecated 'Use options instead';
// Parsing options
Property Options : TJSONOptions Read FOptions Write FOptions;
end;
const
TokenInfos: array[TJSONToken] of string = (
'EOF',
'Whitespace',
'String',
'Number',
'True',
'False',
'Null',
',',
':',
'{',
'}',
'[',
']',
'identifier',
'comment',
''
);
implementation
constructor TJSONScanner.Create(Source : TStream; AUseUTF8 : Boolean = True);
Var
O : TJSONOptions;
begin
O:=DefaultOptions;
if AUseUTF8 then
Include(O,joUTF8)
else
Exclude(O,joUTF8);
Create(Source,O);
end;
constructor TJSONScanner.Create(const Source : String; AUseUTF8 : Boolean = True);
Var
O : TJSONOptions;
begin
O:=DefaultOptions;
if AUseUTF8 then
Include(O,joUTF8)
else
Exclude(O,joUTF8);
Create(Source,O);
end;
constructor TJSONScanner.Create(Source: TStream; AOptions: TJSONOptions);
begin
FSource:=TStringList.Create;
FSource.LoadFromStream(Source);
FOptions:=AOptions;
end;
constructor TJSONScanner.Create(const Source: String; AOptions: TJSONOptions);
begin
FSource:=TStringList.Create;
FSource.Text:=Source;
FOptions:=AOptions;
end;
destructor TJSONScanner.Destroy;
begin
FreeAndNil(FSource);
Inherited;
end;
function TJSONScanner.FetchToken: TJSONToken;
begin
Result:=DoFetchToken;
end;
procedure TJSONScanner.Error(const Msg: string);
begin
raise EScannerError.Create(Msg);
end;
procedure TJSONScanner.Error(const Msg: string; const Args: array of const);
begin
raise EScannerError.CreateFmt(Msg, Args);
end;
function TJSONScanner.DoFetchToken: TJSONToken;
function FetchLine: Boolean;
begin
Result:=FCurRow<FSource.Count;
if Result then
begin
FCurLine:=FSource[FCurRow];
TokenStr:=PChar(FCurLine);
Inc(FCurRow);
end
else
begin
FCurLine:='';
TokenStr:=nil;
end;
end;
var
TokenStart, CurPos: PChar;
it : TJSONToken;
I : Integer;
OldLength, SectionLength, Index: Integer;
C : char;
S : String;
IsStar,EOC: Boolean;
begin
if TokenStr = nil then
if not FetchLine then
begin
Result := tkEOF;
FCurToken := Result;
exit;
end;
FCurTokenString := '';
case TokenStr[0] of
#0: // Empty line
begin
FetchLine;
Result := tkWhitespace;
end;
#9, ' ':
begin
Result := tkWhitespace;
repeat
Inc(TokenStr);
if TokenStr[0] = #0 then
if not FetchLine then
begin
FCurToken := Result;
exit;
end;
until not (TokenStr[0] in [#9, ' ']);
end;
'"','''':
begin
C:=TokenStr[0];
If (C='''') and (joStrict in Options) then
Error(SErrInvalidCharacter, [CurRow,CurColumn,TokenStr[0]]);
Inc(TokenStr);
TokenStart := TokenStr;
OldLength := 0;
FCurTokenString := '';
while not (TokenStr[0] in [#0,C]) do
begin
if (TokenStr[0]='\') then
begin
// Save length
SectionLength := TokenStr - TokenStart;
Inc(TokenStr);
// Read escaped token
Case TokenStr[0] of
'"' : S:='"';
'''' : S:='''';
't' : S:=#9;
'b' : S:=#8;
'n' : S:=#10;
'r' : S:=#13;
'f' : S:=#12;
'\' : S:='\';
'/' : S:='/';
'u' : begin
S:='0000';
For I:=1 to 4 do
begin
Inc(TokenStr);
Case TokenStr[0] of
'0'..'9','A'..'F','a'..'f' :
S[i]:=Upcase(TokenStr[0]);
else
Error(SErrInvalidCharacter, [CurRow,CurColumn,TokenStr[0]]);
end;
end;
// WideChar takes care of conversion...
if (joUTF8 in Options) then
S:=Utf8Encode(WideString(WideChar(StrToInt('$'+S))))
else
S:=WideChar(StrToInt('$'+S));
end;
#0 : Error(SErrOpenString);
else
Error(SErrInvalidCharacter, [CurRow,CurColumn,TokenStr[0]]);
end;
SetLength(FCurTokenString, OldLength + SectionLength+1+Length(S));
if SectionLength > 0 then
Move(TokenStart^, FCurTokenString[OldLength + 1], SectionLength);
Move(S[1],FCurTokenString[OldLength + SectionLength+1],Length(S));
Inc(OldLength, SectionLength+Length(S));
// Next char
// Inc(TokenStr);
TokenStart := TokenStr+1;
end;
if TokenStr[0] = #0 then
Error(SErrOpenString);
Inc(TokenStr);
end;
if TokenStr[0] = #0 then
Error(SErrOpenString);
SectionLength := TokenStr - TokenStart;
SetLength(FCurTokenString, OldLength + SectionLength);
if SectionLength > 0 then
Move(TokenStart^, FCurTokenString[OldLength + 1], SectionLength);
Inc(TokenStr);
Result := tkString;
end;
',':
begin
Inc(TokenStr);
Result := tkComma;
end;
'0'..'9','.','-':
begin
TokenStart := TokenStr;
while true do
begin
Inc(TokenStr);
case TokenStr[0] of
'.':
begin
if TokenStr[1] in ['0'..'9', 'e', 'E'] then
begin
Inc(TokenStr);
repeat
Inc(TokenStr);
until not (TokenStr[0] in ['0'..'9', 'e', 'E','-','+']);
end;
break;
end;
'0'..'9': ;
'e', 'E':
begin
Inc(TokenStr);
if TokenStr[0] in ['-','+'] then
Inc(TokenStr);
while TokenStr[0] in ['0'..'9'] do
Inc(TokenStr);
break;
end;
else
break;
end;
end;
SectionLength := TokenStr - TokenStart;
FCurTokenString:='';
SetString(FCurTokenString, TokenStart, SectionLength);
If (FCurTokenString[1]='.') then
FCurTokenString:='0'+FCurTokenString;
Result := tkNumber;
end;
':':
begin
Inc(TokenStr);
Result := tkColon;
end;
'{':
begin
Inc(TokenStr);
Result := tkCurlyBraceOpen;
end;
'}':
begin
Inc(TokenStr);
Result := tkCurlyBraceClose;
end;
'[':
begin
Inc(TokenStr);
Result := tkSquaredBraceOpen;
end;
']':
begin
Inc(TokenStr);
Result := tkSquaredBraceClose;
end;
'/' :
begin
if Not (joComments in Options) then
Error(SErrInvalidCharacter, [CurRow,CurCOlumn,TokenStr[0]]);
TokenStart:=TokenStr;
Inc(TokenStr);
Case Tokenstr[0] of
'/' : begin
SectionLength := Length(FCurLine)- (TokenStr - PChar(FCurLine));
Inc(TokenStr);
FCurTokenString:='';
SetString(FCurTokenString, TokenStr, SectionLength);
Fetchline;
end;
'*' :
begin
IsStar:=False;
Inc(TokenStr);
TokenStart:=TokenStr;
Repeat
if (TokenStr[0]=#0) then
begin
SectionLength := (TokenStr - TokenStart);
S:='';
SetString(S, TokenStart, SectionLength);
FCurtokenString:=FCurtokenString+S;
if not fetchLine then
Error(SUnterminatedComment, [CurRow,CurCOlumn,TokenStr[0]]);
TokenStart:=TokenStr;
end;
IsStar:=TokenStr[0]='*';
Inc(TokenStr);
EOC:=(isStar and (TokenStr[0]='/'));
Until EOC;
if EOC then
begin
SectionLength := (TokenStr - TokenStart-1);
S:='';
SetString(S, TokenStart, SectionLength);
FCurtokenString:=FCurtokenString+S;
Inc(TokenStr);
end;
end;
else
Error(SErrInvalidCharacter, [CurRow,CurCOlumn,TokenStr[0]]);
end;
Result:=tkComment;
end;
'a'..'z','A'..'Z','_':
begin
TokenStart := TokenStr;
repeat
Inc(TokenStr);
until not (TokenStr[0] in ['A'..'Z', 'a'..'z', '0'..'9', '_']);
SectionLength := TokenStr - TokenStart;
FCurTokenString:='';
SetString(FCurTokenString, TokenStart, SectionLength);
for it := tkTrue to tkNull do
if CompareText(CurTokenString, TokenInfos[it]) = 0 then
begin
Result := it;
FCurToken := Result;
exit;
end;
if (joStrict in Options) then
Error(SErrInvalidCharacter, [CurRow,CurColumn,TokenStr[0]])
else
Result:=tkIdentifier;
end;
else
Error(SErrInvalidCharacter, [CurRow,CurCOlumn,TokenStr[0]]);
end;
FCurToken := Result;
end;
function TJSONScanner.GetCurColumn: Integer;
begin
Result := TokenStr - PChar(CurLine);
end;
function TJSONScanner.GetO(AIndex: TJSONOption): Boolean;
begin
Result:=AIndex in FOptions;
end;
procedure TJSONScanner.SetO(AIndex: TJSONOption; AValue: Boolean);
begin
If AValue then
Include(Foptions,AIndex)
else
Exclude(Foptions,AIndex)
end;
end.

6
lazproj/coedit.lpi
View File

@ -31,7 +31,7 @@
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<OtherUnitFiles Value="..\src;..\etc"/>
<OtherUnitFiles Value="..\src;..\etc\fcl-json\src"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Parsing>
@ -73,7 +73,7 @@
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<OtherUnitFiles Value="..\src"/>
<OtherUnitFiles Value="..\src;..\etc\fcl-json\src"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Parsing>
@ -390,7 +390,7 @@
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<OtherUnitFiles Value="..\src;..\etc"/>
<OtherUnitFiles Value="..\src;..\etc\fcl-json\src"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<CodeGeneration>

5
src/ce_dubproject.pas
View File

@ -209,8 +209,9 @@ begin
//
FreeAndNil(fJSON);
parser := TJSONParser.Create(loader, true);
//TODO-cgonnawork: from FPC 3.02, uses parser.options to allow trailing comma in DUB descriptions
// http://bugs.freepascal.org/view.php?id=29357
parser.Options:= parser.Options + [joIgnoreTrailingComma] - [joStrict];
//TODO-cfcl-json: remove etc/fcl-json the day they'll merge and rlz the version with 'Options'
//TODO-cfcl-json: track possible changes and fixes at http://svn.freepascal.org/cgi-bin/viewvc.cgi/trunk/packages/fcl-json/
try
try
fJSON := parser.Parse as TJSONObject;

5
wiki/wiki.txt
View File

@ -300,10 +300,9 @@ To do so, the application option _Native project compiler_ must be set according
Since the version 2 alpha 1, Coedit also handles DUB projects.
DUB project description must be in JSON format. JSON format must be strictly compliant with RFC 4627 and trailing commas will cause errors.
This restriction will be removed in the future (when CE will be build with FPC 3.0.2).
DUB project description must be in JSON format, SDL in not handled.
Dub projects are handled exactly as the native projects are. The _project_ menu proposes the same features.
DUB projects are handled exactly as the CE projects are. The _project_ menu proposes the same features.
However the configuration is done in another widget, see the [dedicated paragraph][lnk_widg_dub].
# D Completion Daemon integration