You've already forked lazarus-ccr
cmdlinecfg: the initial files commit
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@2802 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
skalogryz
318
components/cmdlinecfg/trunk/cmdlinecfg.pas
Normal file
318
components/cmdlinecfg/trunk/cmdlinecfg.pas
Normal file
@ -0,0 +1,318 @@
|
||||
unit cmdlinecfg;
|
||||
|
||||
{$mode delphi}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, contnrs;
|
||||
|
||||
type
|
||||
TCmdLineCfgValues = record
|
||||
CmdLineValue : String; // the actual command that goes to the cmd line
|
||||
DisplayName : String; // the default display name (in English)
|
||||
Condition : String; // condition for the value of the option
|
||||
end;
|
||||
|
||||
{ TCmdLineCfgOption }
|
||||
|
||||
TCmdLineCfgOption = class(TObject)
|
||||
private
|
||||
procedure AssureSizeForIndex(AIndex: Integer);
|
||||
public
|
||||
Section : String; // the secion of the option
|
||||
SubSection : String; // logical sub-section of the option
|
||||
Name : String; // the "code" of the option, to be saved into project settings (to be backward compatible)
|
||||
OptType : String; // option type - free form type option options
|
||||
Key : String; // the key that needs to go
|
||||
MasterKey : String; // the key values will be combined into a single Key, prefixed with the MasterKey
|
||||
// example: two options -Ct -Co will be combined into -Cto, if both have -C as master key.
|
||||
AliasToKey : string; // the key is deprecated and it's alias to a newer and better key
|
||||
Display : String; // the default description of the option
|
||||
Condition : String; // the condition for the option (in general)
|
||||
Values : array of TCmdLineCfgValues; // cmd line value used with the key
|
||||
ValCount : Integer; // the total number of values
|
||||
isMultiple : Boolean;
|
||||
constructor Create;
|
||||
procedure SetValue(const AValue: string; Index: Integer = 0);
|
||||
procedure SetValDisplay(const DispName: string; Index: Integer = 0);
|
||||
procedure SetCondition(const Condition: string; Index: Integer = 0);
|
||||
end;
|
||||
|
||||
{ TCmdLineCfg }
|
||||
|
||||
TCmdLineCfg = class(TObject)
|
||||
private
|
||||
fHash : TFPHashObjectList;
|
||||
isValid : Boolean;
|
||||
public
|
||||
Options : TList;
|
||||
Executable : String; // the executable code. Doesn't have to be the actual command-line executable name
|
||||
Version : String; // human-readable version name
|
||||
FromVersion : String; // the previous version of configuration
|
||||
TestKey : String; // the command that should return the TestValue
|
||||
TestValue : String; // expected test value to confirm the version.
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
function FindOption(const name: string): TCmdLineCfgOption;
|
||||
end;
|
||||
|
||||
{ TCmdLineOptionValue }
|
||||
|
||||
TCmdLineOptionValue = class(TObject)
|
||||
Option : TCmdLineCfgOption;
|
||||
Value : String;
|
||||
constructor Create(AOption: TCmdLineCfgOption=nil; const AValue: string = '');
|
||||
end;
|
||||
|
||||
procedure CmdLineDebug(cfg: TCmdLineCfg);
|
||||
procedure CmdLineDebugOption(opt: TCmdLineCfgOption);
|
||||
function CmdLineMakeOptions(values: TList {of TCmdLineOptionValue}): string;
|
||||
|
||||
// returns the substring for thr command-line, by replacing %value% from the "Key" param
|
||||
// is ValueType is switch, simply returns the key, if Value is not an empty string
|
||||
// Example #1
|
||||
// Key = -Ck%value%
|
||||
// ValueType = int
|
||||
// Value = 5000
|
||||
// Result = -Ck5000
|
||||
// Example #2
|
||||
// Key = -Fu%value%
|
||||
// ValueType = filename
|
||||
// Value = /usr/bin/my files/test.pas
|
||||
// Result = -Fu"/usr/bin/my files/test.pas"
|
||||
function CmdLineCollectValue(const Key, ValueType, Value: string): string;
|
||||
|
||||
function CmdLineGenerateName(const Key,Name: String): String;
|
||||
// Automatically sets the name based by CmdLineGenerateName
|
||||
// Empty type is not allow, so defaults to "switch"
|
||||
// Chagnes type from "switch" to either "string" ot "select"
|
||||
// if the Key has a value (string), or there's a list of options given (select)
|
||||
procedure CmdLineOptionNormalize(opt: TCmdLineCfgOption);
|
||||
|
||||
implementation
|
||||
|
||||
procedure CmdLineOptionNormalize(opt: TCmdLineCfgOption);
|
||||
var
|
||||
tp: string;
|
||||
begin
|
||||
if not Assigned(opt) then Exit;
|
||||
opt.Name:=CmdLineGenerateName(opt.Key, opt.Name);
|
||||
if opt.OptType='' then opt.OptType:='switch';
|
||||
tp:=AnsiLowerCase(opt.OptType);
|
||||
if (pos('%value%', AnsiLowercase(opt.Key))>0) and (tp='switch')then begin
|
||||
if opt.ValCount>1 then opt.OptType:='select'
|
||||
else opt.OptType:='string';
|
||||
end;;
|
||||
|
||||
end;
|
||||
|
||||
function CmdLineGenerateName(const Key,Name: String): String;
|
||||
begin
|
||||
Result:=Name;
|
||||
if Name='' then Result:=StringReplace(Key, '%value%', '', [rfIgnoreCase,rfReplaceAll]);
|
||||
end;
|
||||
|
||||
{ TCmdLineOptionValue }
|
||||
|
||||
constructor TCmdLineOptionValue.Create(AOption: TCmdLineCfgOption;
|
||||
const AValue: string);
|
||||
begin
|
||||
inherited Create;
|
||||
Option:=AOption;
|
||||
Value:=AValue;
|
||||
end;
|
||||
|
||||
|
||||
{ TCmdLineCfgOption }
|
||||
|
||||
procedure TCmdLineCfgOption.AssureSizeForIndex(AIndex: Integer);
|
||||
begin
|
||||
while length(Values)<=AIndex do begin
|
||||
if length(Values)=0 then SetLength(Values, 4)
|
||||
else SetLength(Values, length(Values)*2);
|
||||
end;
|
||||
if ValCount<=AIndex then ValCount:=AIndex+1;
|
||||
end;
|
||||
|
||||
constructor TCmdLineCfgOption.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
end;
|
||||
|
||||
procedure TCmdLineCfgOption.SetValue(const AValue: string; Index: Integer);
|
||||
begin
|
||||
AssureSizeForIndex(Index);
|
||||
Values[Index].CmdLineValue:=AValue;
|
||||
end;
|
||||
|
||||
procedure TCmdLineCfgOption.SetValDisplay(const DispName: string; Index: Integer);
|
||||
begin
|
||||
AssureSizeForIndex(Index);
|
||||
Values[Index].DisplayName:=DispName;
|
||||
end;
|
||||
|
||||
procedure TCmdLineCfgOption.SetCondition(const Condition: string; Index: Integer
|
||||
);
|
||||
begin
|
||||
AssureSizeForIndex(Index);
|
||||
Values[Index].Condition:=Condition;
|
||||
end;
|
||||
|
||||
{ TCmdLineCfg }
|
||||
|
||||
constructor TCmdLineCfg.Create;
|
||||
begin
|
||||
Options:=TList.Create;
|
||||
fHash:=TFPHashObjectList.Create(false);
|
||||
end;
|
||||
|
||||
destructor TCmdLineCfg.Destroy;
|
||||
var
|
||||
i : integer;
|
||||
begin
|
||||
for i:=0 to Options.Count-1 do TCmdLineCfgOption(Options[i]).Free;
|
||||
Options.Free;
|
||||
fHash.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TCmdLineCfg.FindOption(const name: string): TCmdLineCfgOption;
|
||||
var
|
||||
i : integer;
|
||||
l : string;
|
||||
opt : TCmdLineCfgOption;
|
||||
begin
|
||||
if not isValid then begin
|
||||
for i:=0 to Options.Count-1 do begin
|
||||
opt := TCmdLineCfgOPtion(Options[i]);
|
||||
fHash.Add( opt.Name, opt);
|
||||
end;
|
||||
isValid:=true;
|
||||
end;
|
||||
Result:=TCmdLineCfgOption(fHash.Find(name));
|
||||
end;
|
||||
|
||||
procedure CmdLineDebugOption(opt: TCmdLineCfgOption);
|
||||
var
|
||||
i : integer;
|
||||
begin
|
||||
if (opt.Section<>'') or (opt.SubSection<>'') then
|
||||
writeln(opt.Name, ' [', opt.Section,'/',opt.SubSection,']');
|
||||
writeln('key: ', opt.key,' (',opt.Display,')');
|
||||
writeln('type: ', opt.OptType);
|
||||
if opt.isMultiple then writeln('multiple values allowed');
|
||||
if opt.MasterKey<>'' then writeln('masterkey: ', opt.MasterKey);
|
||||
for i:=0 to opt.ValCount-1 do begin
|
||||
writeln(' value: ', opt.Values[i].CmdLineValue,' ', opt.Values[i].DisplayName );
|
||||
if opt.Values[i].Condition<>'' then
|
||||
writeln(' condition: ', opt.Values[i].Condition);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure CmdLineDebug(cfg: TCmdLineCfg);
|
||||
var
|
||||
i : integer;
|
||||
begin
|
||||
writeln('executable: ', cfg.Executable);
|
||||
writeln('version: ', cfg.Version);
|
||||
writeln('test key: ', cfg.TestKey);
|
||||
writeln('test value: ', cfg.TestValue);
|
||||
writeln('total options: ', cfg.Options.Count);
|
||||
writeln;
|
||||
for i:=0 to cfg.Options.Count-1 do begin
|
||||
CmdLineDebugOption(TCmdLineCfgOption(cfg.Options[i]));
|
||||
writeln;
|
||||
end;
|
||||
end;
|
||||
|
||||
function CheckQuotes(const v: string): string;
|
||||
var
|
||||
i : integer;
|
||||
begin
|
||||
Result:=v;
|
||||
for i:=1 to length(v) do
|
||||
if (v[i] in [' ','<','>',#39]) then begin
|
||||
//todo: how to handle quotes in parameter value?
|
||||
Result:='"'+v+'"';
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
function CmdLineCollectValue(const Key, ValueType, Value: string): string;
|
||||
var
|
||||
l : string;
|
||||
j : Integer;
|
||||
vl : string;
|
||||
const
|
||||
ValueParam = '%value%';
|
||||
begin
|
||||
if Value='' then begin
|
||||
Result:='';
|
||||
Exit;
|
||||
end;
|
||||
|
||||
l:=LowerCase(ValueType);
|
||||
if l='switch' then begin
|
||||
Result:=Key // no values expected
|
||||
end else begin
|
||||
vl:=CheckQuotes(Value);
|
||||
Result:=Key;
|
||||
j:=Pos(ValueParam, LowerCase(Result));
|
||||
if j>0 then begin
|
||||
//%value% is present in key declaration
|
||||
Delete(Result, j, length(ValueParam));
|
||||
// replacing any %% with %
|
||||
Result:=StringReplace(Result, '%%', '%', [rfIgnoreCase, rfReplaceAll]);
|
||||
Insert(vl, Result, j);
|
||||
end else
|
||||
//%value% is not present in key declaration, so just attach it to the key
|
||||
Result:=Key+StringReplace(Key, '%%', '%', [rfIgnoreCase, rfReplaceAll])+vl;
|
||||
end;
|
||||
end;
|
||||
|
||||
function CmdLineMakeOptions(values: TList {of TCmdLineOption}): string;
|
||||
var
|
||||
i : Integer;
|
||||
j : Integer;
|
||||
masters : TStringList;
|
||||
vl : TCmdLineOptionValue;
|
||||
v : string;
|
||||
mk : string;
|
||||
begin
|
||||
Result:='';
|
||||
masters := TStringList.Create;
|
||||
try
|
||||
for i:=0 to values.Count-1 do begin
|
||||
vl:=TCmdLineOptionValue(values[i]);
|
||||
if vl.Option = nil then Continue;
|
||||
|
||||
v:=CmdLineCollectValue(vl.Option.Key, vl.Option.OptType, vl.Value);
|
||||
if v='' then Continue;
|
||||
|
||||
mk:=vl.Option.MasterKey;
|
||||
if mk<>'' then begin
|
||||
j:=masters.IndexOfName(mk);
|
||||
v:=Copy(v, length(mk)+1, length(v));
|
||||
if j<0 then
|
||||
masters.Values[mk]:=v
|
||||
else
|
||||
masters.ValueFromIndex[j]:=masters.ValueFromIndex[j]+v;
|
||||
end else begin
|
||||
if Result='' then Result:=v
|
||||
else Result:=Result+' '+v;
|
||||
end;
|
||||
end;
|
||||
for i:=0 to masters.Count-1 do begin
|
||||
v:=masters.Names[i]+masters.ValueFromIndex[i];
|
||||
if Result='' then Result:=v
|
||||
else Result:=Result+' '+v;
|
||||
end;
|
||||
finally
|
||||
masters.Free;
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
183
components/cmdlinecfg/trunk/cmdlinecfgjson.pas
Normal file
183
components/cmdlinecfg/trunk/cmdlinecfgjson.pas
Normal file
@ -0,0 +1,183 @@
|
||||
unit cmdlinecfgjson;
|
||||
|
||||
{$mode delphi}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, cmdlinecfg, fpjson, jsonparser;
|
||||
|
||||
function CmdLineCfgJSONReadFile(stream: TStream; cfg: TCmdLineCfg): Boolean; overload;
|
||||
function CmdLineCfgJSONReadFile(const FileName: String; cfg: TCmdLineCfg): Boolean; overload;
|
||||
procedure CmdLineCfgJSONLoadFilesFromDir(const Dir: String; list: TList; const Mask : string = '*.copt');
|
||||
|
||||
implementation
|
||||
|
||||
// ugh... no better way to do it anyway. ... see TValueIterator below
|
||||
type
|
||||
{ TCfgIterator }
|
||||
TCfgIterator = class(TObject)
|
||||
class procedure Iterate(Const AName : TJSONStringType; Item: TJSONData; Data: TObject; var DoContinue: Boolean);
|
||||
class procedure IterateOption(Const AName : TJSONStringType; Item: TJSONData; Data: TObject; var DoContinue: Boolean);
|
||||
class procedure IterateValue(const AName: TJSONStringType; Item: TJSONdata; Data: TObject; var DoContinue: Boolean);
|
||||
end;
|
||||
|
||||
type
|
||||
TIterateValue = class(TObject)
|
||||
opt : TCmdLineCfgOption;
|
||||
idx : Integer;
|
||||
end;
|
||||
|
||||
class procedure TCfgIterator.IterateOption(Const AName : TJSONStringType; Item: TJSONData; Data: TObject; var DoContinue: Boolean);
|
||||
var
|
||||
opt : TCmdLineCfgOption;
|
||||
nm : String;
|
||||
ja : TJSONArray;
|
||||
i : Integer;
|
||||
iv : TIterateValue;
|
||||
begin
|
||||
opt:=TCmdLineCfgOption(Data);
|
||||
nm:=lowerCase(AName);
|
||||
if nm='section' then opt.Section:=Item.AsString
|
||||
else if nm='subsection' then opt.SubSection:=Item.AsString
|
||||
else if nm='type' then opt.OptType:=Item.AsString
|
||||
else if nm='name' then opt.Name:=Item.AsString
|
||||
else if nm='key' then opt.Key:=Item.AsString
|
||||
else if nm='masterkey' then opt.MasterKey:=Item.AsString
|
||||
else if nm='display' then opt.Display:=Item.AsString
|
||||
else if (nm='condition') or (nm='cond') then opt.Condition:=Item.AsString
|
||||
else if (nm='value') then opt.SetValue(Item.AsString)
|
||||
else if (nm='alias') then opt.AliasToKey:=Item.AsString
|
||||
else if (nm='multiple') then opt.isMultiple:=(Item.JSONType=jtBoolean) and (Item.AsBoolean)
|
||||
else if (nm='options') then begin
|
||||
ja:=TJSONArray(Item);
|
||||
if ja.Count>0 then begin
|
||||
iv:=TIterateValue.Create;
|
||||
try
|
||||
iv.opt:=opt;
|
||||
for i:=0 to ja.Count-1 do begin
|
||||
if ja.Items[i].JSONType = jtObject then begin
|
||||
iv.idx:=opt.ValCount;
|
||||
TJSONObject(ja.Items[i]).Iterate ( TCfgIterator.IterateValue, iv);
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
iv.Free;
|
||||
end;
|
||||
end;
|
||||
end
|
||||
end;
|
||||
|
||||
class procedure TCfgIterator.IterateValue(const AName: TJSONStringType;
|
||||
Item: TJSONdata; Data: TObject; var DoContinue: Boolean);
|
||||
var
|
||||
opt : TCmdLineCfgOption;
|
||||
idx : Integer;
|
||||
nm : String;
|
||||
begin
|
||||
idx:=TIterateValue(Data).idx;
|
||||
opt:=TIterateValue(Data).opt;
|
||||
nm:=lowerCase(AName);
|
||||
if nm='display' then opt.SetValDisplay(Item.AsString, idx)
|
||||
else if nm='value' then opt.SetValue(Item.AsString, idx)
|
||||
else if nm='condition' then opt.SetCondition(Item.AsString, idx);
|
||||
end;
|
||||
|
||||
class procedure TCfgIterator.Iterate(Const AName : TJSONStringType; Item: TJSONData; Data: TObject; var DoContinue: Boolean);
|
||||
var
|
||||
cfg : TCmdLineCfg;
|
||||
nm : string;
|
||||
ja : TJSONArray;
|
||||
j : TJSONData;
|
||||
i : Integer;
|
||||
opt : TCmdLineCfgOption;
|
||||
|
||||
begin
|
||||
cfg:=TCmdLineCfg(data);
|
||||
nm:=lowerCase(AName);
|
||||
if nm='options' then begin
|
||||
if Item.JSONType<>jtArray then Exit; // options must be an array of options
|
||||
ja:=TJSONArray(Item);
|
||||
for i:=0 to ja.Count-1 do begin
|
||||
j:=ja.Items[i];
|
||||
if j.JSONType<>jtObject then Continue;
|
||||
|
||||
opt:=TCmdLineCfgOption.Create;
|
||||
TJSONObject(j).Iterate(TCfgIterator.IterateOption, opt);
|
||||
if (opt.Key='') then begin
|
||||
opt.Free
|
||||
end else begin
|
||||
CmdLineOptionNormalize(opt);
|
||||
cfg.Options.Add(opt);
|
||||
end;
|
||||
end;
|
||||
|
||||
end else begin
|
||||
if Item.JSONType<>jtString then Exit;
|
||||
if nm='executable' then cfg.Executable:=Item.AsString
|
||||
else if nm='version' then cfg.Version:=Item.AsString
|
||||
else if nm='fromversion' then cfg.FromVersion:=Item.AsString
|
||||
else if nm='testvalue' then cfg.TestValue:=Item.AsString
|
||||
else if nm='testkey' then cfg.TestKey:=Item.AsString
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
function CmdLineCfgJSONReadFile(stream: TStream; cfg: TCmdLineCfg): Boolean;
|
||||
var
|
||||
p : TJSONParser;
|
||||
d : TJSONData;
|
||||
core : TJSONObject;
|
||||
begin
|
||||
Result:=False;
|
||||
d:=nil;
|
||||
p:=TJSONParser.Create(stream);
|
||||
try
|
||||
d:=p.Parse;
|
||||
if d.JSONType<>jtObject then Exit;
|
||||
core:=TJSONObject(d);
|
||||
core.Iterate(TCfgIterator.Iterate, cfg);
|
||||
Result:=cfg.Executable<>'';
|
||||
finally
|
||||
d.Free;
|
||||
p.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function CmdLineCfgJSONReadFile(const FileName: String; cfg: TCmdLineCfg): Boolean;
|
||||
var
|
||||
fs : TFileStream;
|
||||
begin
|
||||
fs := TFileStream.Create(FileName, fmOpenRead or fmShareDenyNone);
|
||||
try
|
||||
Result:=CmdLineCfgJSONReadFile(fs, cfg);
|
||||
finally
|
||||
fs.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure CmdLineCfgJSONLoadFilesFromDir(const Dir: String; list: TList; const Mask: string);
|
||||
var
|
||||
rslt : TSearchRec;
|
||||
res : Integer;
|
||||
pth : string;
|
||||
cfg : TCmdLineCfg;
|
||||
begin
|
||||
pth:=IncludeTrailingPathDelimiter(Dir);
|
||||
res:=FindFirst( pth+Mask, faAnyFile, rslt);
|
||||
try
|
||||
while res = 0 do begin
|
||||
if (rslt.Attr and faDirectory=0) and (rslt.Size>0) then begin
|
||||
cfg := TCmdLineCfg.Create;
|
||||
if not CmdLineCfgJSONReadFile(pth+rslt.Name, cfg) then cfg.Free
|
||||
else list.Add(cfg);
|
||||
end;
|
||||
res:=FindNext(rslt);
|
||||
end;
|
||||
finally
|
||||
FindClose(rslt);
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
285
components/cmdlinecfg/trunk/cmdlinecfgparser.pas
Normal file
285
components/cmdlinecfg/trunk/cmdlinecfgparser.pas
Normal file
@ -0,0 +1,285 @@
|
||||
unit cmdlinecfgparser;
|
||||
|
||||
interface
|
||||
|
||||
{$mode delphi}
|
||||
|
||||
uses
|
||||
Classes, SysUtils, cmdlinecfg, cmdlinecfgutils;
|
||||
|
||||
type
|
||||
|
||||
{ TCmdLineOptionParse }
|
||||
|
||||
TOptionParse = class(TObject)
|
||||
key : string;
|
||||
opt : TCmdLineCfgOption;
|
||||
isDelimited : Boolean; // the value comes with a white-space after the key
|
||||
isParameter : Boolean;
|
||||
constructor Create(aopt: TCmdLineCfgOption; const akey: string; AisDelim: Boolean; AisParam: Boolean);
|
||||
end;
|
||||
|
||||
{ TCmdLineArgsParser }
|
||||
|
||||
TCmdLineArgsParser = class(TObject)
|
||||
private
|
||||
fKeyPrefix : TStrings;
|
||||
fCfg : TCmdLineCfg;
|
||||
fisValid : Boolean;
|
||||
fMasters : TStringList;
|
||||
MaxMasterLen : Integer;
|
||||
MinMasterLen : Integer;
|
||||
fOptions : TStringList;
|
||||
MaxKeyLen : Integer;
|
||||
MinKeyLen : Integer;
|
||||
protected
|
||||
procedure SetCfg(ACfg: TCmdLineCfg);
|
||||
procedure PrepareConfig;
|
||||
function FindMasterKey(const arg: string): string;
|
||||
function FindParseOption(const arg: string): TOptionParse;
|
||||
function CreateMasterKeyValues(const ArgValue, MasterKey: string; Vals: TList): Boolean;
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
// if an argumant doesn't have a corresponding cmd line option;
|
||||
// .Option field will be set to nil. The next "unkey" option will be set as a value;
|
||||
// KeyPrefix - would be used to find values that are not part of arguments only;
|
||||
// the method will create TCmdLineOptionValue objects and add them to values list
|
||||
// it doesn't check for their existance, just adds them!
|
||||
function Parse(Args: TStrings; Vals: TList {of TCmdLineOptionValue}): Boolean;
|
||||
property CmdLineCfg: TCmdLineCfg read fCfg write SetCfg;
|
||||
property KeyPrefix : TStrings read fKeyPrefix;
|
||||
end;
|
||||
|
||||
// note that KeyPrefix defaults to unix keys = "-". On Windows, many MS commandlines
|
||||
// are using "/" as the key prefix
|
||||
procedure CmdLineMatchArgsToOpts(CmdLineCfg: TCmdLineCfg; Args: TStrings; Vals: TList {of TCmdLineOptionValue}; const KeyPrefix: string = '-'); overload;
|
||||
procedure CmdLineMatchArgsToOpts(CmdLineCfg: TCmdLineCfg; const CmdLine: string; Vals: TList {of TCmdLineOptionValue}; const KeyPrefix: string = '-'); overload;
|
||||
|
||||
implementation
|
||||
|
||||
procedure CmdLineMatchArgsToOpts(CmdLineCfg: TCmdLineCfg; Args: TStrings; Vals: TList;
|
||||
const KeyPrefix: string);
|
||||
var
|
||||
parser : TCmdLineArgsParser;
|
||||
begin
|
||||
parser := TCmdLineArgsParser.Create;
|
||||
try
|
||||
parser.CmdLineCfg:=CmdLineCfg;
|
||||
parser.KeyPrefix.Add(KeyPrefix);
|
||||
parser.Parse(Args, Vals);
|
||||
finally
|
||||
parser.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure CmdLineMatchArgsToOpts(CmdLineCfg: TCmdLineCfg; const CmdLine: string;
|
||||
Vals: TList; const KeyPrefix: string);
|
||||
var
|
||||
args : TStringList;
|
||||
begin
|
||||
args:=TstringList.Create;
|
||||
try
|
||||
CmdLineParse(cmdLine, args);
|
||||
CmdLineMatchArgsToOpts(cmdlinecfg, args, vals, KeyPrefix);
|
||||
finally
|
||||
args.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TOptionParse }
|
||||
|
||||
constructor TOptionParse.Create(aopt: TCmdLineCfgOption; const akey: string; AisDelim: Boolean; AisParam: Boolean);
|
||||
begin
|
||||
inherited Create;
|
||||
opt:=Aopt;
|
||||
key:=akey;
|
||||
isDelimited:=AisDelim;
|
||||
isParameter:=AisParam;
|
||||
end;
|
||||
|
||||
{ TCmdLineArgsParse }
|
||||
|
||||
procedure TCmdLineArgsParser.SetCfg(ACfg: TCmdLineCfg);
|
||||
begin
|
||||
if fCfg<>ACfg then begin
|
||||
fisValid:=false;
|
||||
fCfg:=ACfg;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure MaxMinOptionLen(options: TStrings; var minlen, maxlen: Integer);
|
||||
var
|
||||
i : Integer;
|
||||
j : Integer;
|
||||
ln : Integer;
|
||||
k : string;
|
||||
begin
|
||||
maxlen:=0;
|
||||
minlen:=0;
|
||||
if options.Count=0 then Exit;
|
||||
|
||||
for i:=0 to options.Count-1 do begin
|
||||
ln:=length(options[i]);
|
||||
if ln>maxlen then maxlen:=ln;
|
||||
end;
|
||||
|
||||
j:=0;
|
||||
repeat
|
||||
inc(minlen);
|
||||
k:=Copy(options[0],1,minlen);
|
||||
for i:=0 to options.Count-1 do
|
||||
if Pos(k, options[i])<>1 then begin
|
||||
inc(j);
|
||||
break;
|
||||
end;
|
||||
until (j<>0) or (minlen>maxlen);
|
||||
dec(minlen);
|
||||
end;
|
||||
|
||||
procedure TCmdLineArgsParser.PrepareConfig;
|
||||
var
|
||||
i : integer;
|
||||
ov : TCmdLineCfgOption;
|
||||
k : string;
|
||||
j : integer;
|
||||
y : integer;
|
||||
begin
|
||||
if not Assigned(fCfg) then Exit;
|
||||
fMasters.Clear;
|
||||
fOptions.Clear;
|
||||
fMasters.Duplicates:=dupIgnore;
|
||||
for i:=0 to fCfg.Options.Count-1 do begin
|
||||
ov:=TCmdLineCfgOption(fCfg.Options[i]);
|
||||
if not Assigned(ov) then Continue;
|
||||
k:=Trim(ov.Key);
|
||||
if ov.MasterKey<>'' then fMasters.Add(ov.MasterKey);
|
||||
// preparing keys for values with parameters, like -Cp%test% or -Cp %test%
|
||||
j:=Pos('%', k);
|
||||
y:=Pos(' ', k);
|
||||
if (y>0) and ((y<j) or (j=0)) then k:=Copy(k, 1, y-1)
|
||||
else if j>0 then k:=Copy(k, 1, j-1);
|
||||
fOptions.AddObject(k, TOptionParse.Create(ov, k, y>0, j>0) );
|
||||
end;
|
||||
MaxMinOptionLen(fMasters, MinMasterLen, MaxMasterLen);
|
||||
MaxMinOptionLen(fOptions, MinKeyLen, MaxKeyLen);
|
||||
fOptions.Sort;
|
||||
fisValid:=true;
|
||||
end;
|
||||
|
||||
function TCmdLineArgsParser.FindMasterKey(const arg: string): string;
|
||||
var
|
||||
i : integer;
|
||||
t : string;
|
||||
j : integer;
|
||||
begin
|
||||
for i:=MinMasterLen to MaxMasterLen do begin
|
||||
t:=Copy(arg, 1, i);
|
||||
j:=fMasters.IndexOf(t);
|
||||
if j>=0 then begin
|
||||
Result:=fMasters[j];
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
Result:='';
|
||||
end;
|
||||
|
||||
function TCmdLineArgsParser.FindParseOption(const arg: string): TOptionParse;
|
||||
var
|
||||
k : string;
|
||||
j : Integer;
|
||||
i : Integer;
|
||||
begin
|
||||
for i:=MinKeyLen to MaxKeyLen do begin
|
||||
k:=Copy(arg, 1, i);
|
||||
j:=fOptions.IndexOf(k);
|
||||
if j>=0 then begin
|
||||
Result:=TOptionParse( fOptions.Objects[j] );
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
Result:=nil;
|
||||
end;
|
||||
|
||||
function TCmdLineArgsParser.CreateMasterKeyValues(const ArgValue, MasterKey: string; Vals: TList): Boolean;
|
||||
var
|
||||
i : Integer;
|
||||
k : string;
|
||||
j : Integer;
|
||||
op : TOptionParse;
|
||||
begin
|
||||
Result:=False;
|
||||
for i:=length(MasterKey)+1 to length(ArgValue) do begin
|
||||
k:=MasterKey + ArgValue[i];
|
||||
j:=fOptions.IndexOf(k);
|
||||
if j>=0 then begin
|
||||
Result:=True;
|
||||
op:=TOptionParse(fOptions.Objects[j]);
|
||||
Vals.Add( TCmdLineOptionValue.Create ( op.opt, '1'))
|
||||
end else begin
|
||||
Vals.Add( TCmdLineOptionValue.Create ( nil, k));
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TCmdLineArgsParser.Create;
|
||||
begin
|
||||
fKeyPrefix := TStringList.Create;
|
||||
TStringList(fKeyPrefix).CaseSensitive:=true;
|
||||
|
||||
fMasters := TStringList.Create;
|
||||
TStringList(fMasters).CaseSensitive:=true;
|
||||
|
||||
fOptions := TStringList.Create;
|
||||
TStringList(fOptions).CaseSensitive:=true;
|
||||
TStringList(fOptions).OwnsObjects:=true;
|
||||
end;
|
||||
|
||||
destructor TCmdLineArgsParser.Destroy;
|
||||
begin
|
||||
fMasters.Free;
|
||||
fOptions.Clear;
|
||||
fOptions.Free;
|
||||
fKeyPrefix.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TCmdLineArgsParser.Parse(Args: TStrings; Vals: TList): Boolean;
|
||||
var
|
||||
i : integer;
|
||||
v : string;
|
||||
mk : string;
|
||||
op : TOptionParse;
|
||||
begin
|
||||
Result:=Assigned(fCfg);
|
||||
if not Result then Exit;
|
||||
if not fisValid then PrepareConfig;
|
||||
i:=0;
|
||||
while i<Args.Count do begin
|
||||
v:=Args[i];
|
||||
mk:=FindMasterKey(v);
|
||||
if mk<>'' then begin
|
||||
// todo: test if there's any known value among keys!
|
||||
CreateMasterKeyValues(v, mk, Vals);
|
||||
end else begin
|
||||
op:=FindParseOption(v);
|
||||
if not Assigned(op) then
|
||||
Vals.Add ( TCmdLineOptionValue.Create(nil, v))
|
||||
else begin
|
||||
if op.isParameter then begin
|
||||
if op.isDelimited then begin
|
||||
inc(i);
|
||||
if i<Args.Count then v:=args[i] else v:='';
|
||||
end else
|
||||
v:=Copy(v, length(op.key)+1, length(v));
|
||||
end else
|
||||
v:='1'; // is switch, is enabled!
|
||||
Vals.Add( TCmdLineOptionValue.Create(op.opt, v));
|
||||
end;
|
||||
end;
|
||||
inc(i);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
170
components/cmdlinecfg/trunk/cmdlinecfgui.pas
Normal file
170
components/cmdlinecfg/trunk/cmdlinecfgui.pas
Normal file
@ -0,0 +1,170 @@
|
||||
unit cmdlinecfgui;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils,
|
||||
cmdlinecfg;
|
||||
|
||||
type
|
||||
{ TCmdLineLayoutInfo }
|
||||
|
||||
// Section names are assumed to be . separated.
|
||||
// Anything after to . is expected to be a "sub section" of the section.
|
||||
|
||||
{ TLayoutSection }
|
||||
|
||||
TLayoutElementType = (letSwitch, letSection);
|
||||
|
||||
TLayoutSection = class(TObject)
|
||||
//level : integer; // number of "dots" in the name
|
||||
public
|
||||
fName : string;
|
||||
fElementType: TLayoutElementType;
|
||||
public
|
||||
Display : string;
|
||||
GUIHint : string;
|
||||
Elements : array of TLayoutSection;
|
||||
ElemCount : integer;
|
||||
function AddElement(const AName: string; AElementType: TLayoutElementType): TLayoutSection;
|
||||
destructor Destroy; override;
|
||||
property Name: string read fName;
|
||||
property ElementType: TLayoutElementType read fElementType;
|
||||
end;
|
||||
|
||||
TCmdLineLayoutInfo = class(TObject)
|
||||
private
|
||||
fSections: TStringList;
|
||||
fValidOrder: Boolean;
|
||||
function DoGetSection(const SectName: String; Forced: Boolean = true): TLayoutSection;
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
function AddSection(const Section: string): TLayoutSection;
|
||||
function GetSection(const Section: string): TLayoutSection;
|
||||
//function GetSwitches(const Section: string; Dst: TStrings): Boolean;
|
||||
end;
|
||||
|
||||
{ TCmdLineUIControl }
|
||||
|
||||
TCmdLineUIControl = class(TObject)
|
||||
private
|
||||
FValueChanged: TNotifyEvent;
|
||||
protected
|
||||
procedure ValueChanged; virtual;
|
||||
public
|
||||
procedure Init(cfg: TCmdLineCfg; layout: TCmdLineLayoutInfo); virtual; abstract;
|
||||
procedure SetValues(list: TList {of TCmdLineOptionValue}); virtual; abstract;
|
||||
procedure Serialize(list: TList {of TCmdLineOptionValue}); virtual; abstract;
|
||||
property OnValueChanged: TNotifyEvent read FValueChanged write fValueChanged;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TLayoutSection }
|
||||
|
||||
function TLayoutSection.AddElement(const AName: string; AElementType: TLayoutElementType): TLayoutSection;
|
||||
begin
|
||||
if ElemCount = length(Elements) then begin
|
||||
if ElemCount=0 then SetLength(Elements, 2)
|
||||
else SetLength(Elements, ElemCount*2);
|
||||
end;
|
||||
Result:=TLayoutSection.Create;
|
||||
Result.fName:=AName;
|
||||
Result.fElementType:=AElementType;
|
||||
Result.Display:=Aname;
|
||||
Elements[ElemCount]:=Result;
|
||||
inc(ElemCount);
|
||||
end;
|
||||
|
||||
destructor TLayoutSection.Destroy;
|
||||
var
|
||||
i : integer;
|
||||
begin
|
||||
for i:=0 to ElemCount-1 do Elements[i].Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
{ TCmdLineLayoutInfo }
|
||||
|
||||
function TCmdLineLayoutInfo.DoGetSection(const SectName: String; Forced: Boolean): TLayoutSection;
|
||||
var
|
||||
i : integer;
|
||||
begin
|
||||
i:=fSections.IndexOf(SectName);
|
||||
if (i<0) and Forced then begin
|
||||
Result:=TLayoutSection.Create;
|
||||
fSections.AddObject(SectName, Result);
|
||||
fValidOrder:=false; // a new section has been added, it might ruin the order
|
||||
end else if (i<0) and not Forced then begin
|
||||
Result:=nil;
|
||||
end else
|
||||
Result:=TLayoutSection(fSections.Objects[i]);
|
||||
end;
|
||||
|
||||
constructor TCmdLineLayoutInfo.Create;
|
||||
begin
|
||||
fSections:=TStringList.Create;
|
||||
fSections.OwnsObjects:=true;
|
||||
AddSection('');
|
||||
end;
|
||||
|
||||
destructor TCmdLineLayoutInfo.Destroy;
|
||||
begin
|
||||
fSections.Clear; // need to call clear explicitly, since FREE doesn't free objects (even if owned)
|
||||
fSections.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
{procedure TCmdLineLayoutInfo.AddSwitch(const Section: string;
|
||||
const SwitchOrName: string);
|
||||
begin
|
||||
GetSection(Section).fswitches.Add(SwitchOrName);
|
||||
end;}
|
||||
|
||||
function TCmdLineLayoutInfo.AddSection(const Section: string): TLayoutSection;
|
||||
begin
|
||||
Result:=DoGetSection(Section, true);
|
||||
end;
|
||||
|
||||
function TCmdLineLayoutInfo.GetSection(const Section: string): TLayoutSection;
|
||||
begin
|
||||
Result:=DoGetSection(Section, false);
|
||||
end;
|
||||
|
||||
{function TCmdLineLayoutInfo.GetSections(Dst: TStrings): Boolean;
|
||||
var
|
||||
i : Integer;
|
||||
begin
|
||||
if not fValidOrder then begin
|
||||
SortSections;
|
||||
fValidOrder:=true;
|
||||
end;
|
||||
Dst.BeginUpdate;
|
||||
try
|
||||
for i:=0 to fSections.Count-1 do
|
||||
Dst.Add(fSections[i]);
|
||||
finally
|
||||
Dst.EndUpdate;
|
||||
end;
|
||||
Result:=True;
|
||||
end;}
|
||||
|
||||
{function TCmdLineLayoutInfo.GetSwitches(const Section: string; Dst: TStrings): Boolean;
|
||||
var
|
||||
sct : TLayoutSection;
|
||||
begin
|
||||
sct:=GetSection(Section);
|
||||
Result:=Assigned(Sct);
|
||||
if not Result then Exit;
|
||||
Dst.AddStrings(sct.fswitches);
|
||||
end;}
|
||||
|
||||
{ TCmdLineUIControl }
|
||||
|
||||
procedure TCmdLineUIControl.ValueChanged;
|
||||
begin
|
||||
if Assigned(fValueChanged) then fValueChanged(Self);
|
||||
end;
|
||||
|
||||
end.
|
||||
141
components/cmdlinecfg/trunk/cmdlinecfguijson.pas
Normal file
141
components/cmdlinecfg/trunk/cmdlinecfguijson.pas
Normal file
@ -0,0 +1,141 @@
|
||||
unit cmdlinecfguijson;
|
||||
|
||||
interface
|
||||
|
||||
{$mode delphi}
|
||||
|
||||
uses
|
||||
Classes, SysUtils, cmdlinecfgui, fpjson, jsonparser;
|
||||
|
||||
|
||||
function CmdLineUIJSONReadFile(stream: TStream; lt: TCmdLineLayoutInfo): Boolean; overload;
|
||||
function CmdLineUIJSONReadFile(const FileName: String; lt: TCmdLineLayoutInfo): Boolean; overload;
|
||||
procedure CmdLineCfgUIJSONLoadFilesFromDir(const Dir: String; list: TList; const Mask : string = '*.coptui');
|
||||
|
||||
implementation
|
||||
|
||||
type
|
||||
{ TSectionIterator }
|
||||
|
||||
TSectionIterator = class(TObject)
|
||||
public
|
||||
lt : TCmdLineLayoutInfo;
|
||||
sc : TLayoutSection;
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
procedure Iterate(Const AName : TJSONStringType; Item: TJSONData; Data: TObject; var DoContinue: Boolean);
|
||||
end;
|
||||
|
||||
|
||||
function CmdLineUIJSONReadFile(stream: TStream; lt: TCmdLineLayoutInfo): Boolean;
|
||||
var
|
||||
p : TJSONParser;
|
||||
d : TJSONData;
|
||||
core : TJSONObject;
|
||||
st : TSectionIterator;
|
||||
begin
|
||||
Result:=False;
|
||||
d:=nil;
|
||||
p:=TJSONParser.Create(stream);
|
||||
try
|
||||
d:=p.Parse;
|
||||
if d.JSONType<>jtObject then Exit;
|
||||
core:=TJSONObject(d);
|
||||
|
||||
st:=TSectionIterator.Create;
|
||||
try
|
||||
st.lt:=lt;
|
||||
st.sc:=lt.GetSection('');
|
||||
core.Iterate( st.Iterate, st)
|
||||
finally
|
||||
st.Free;
|
||||
end;
|
||||
Result:=true;
|
||||
finally
|
||||
d.Free;
|
||||
p.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function CmdLineUIJSONReadFile(const FileName: String; lt: TCmdLineLayoutInfo): Boolean;
|
||||
var
|
||||
fs : TFileStream;
|
||||
begin
|
||||
fs := TFileStream.Create(FileName, fmOpenRead or fmShareDenyNone);
|
||||
try
|
||||
Result:=CmdLineUIJSONReadFile(fs, lt);
|
||||
finally
|
||||
fs.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure CmdLineCfgUIJSONLoadFilesFromDir(const Dir: String; list: TList; const Mask : string = '*.coptui');
|
||||
var
|
||||
rslt : TSearchRec;
|
||||
res : Integer;
|
||||
pth : string;
|
||||
cfg : TCmdLineLayoutInfo;
|
||||
begin
|
||||
pth:=IncludeTrailingPathDelimiter(Dir);
|
||||
res:=FindFirst( pth+Mask, faAnyFile, rslt);
|
||||
try
|
||||
while res = 0 do begin
|
||||
if (rslt.Attr and faDirectory=0) and (rslt.Size>0) then begin
|
||||
cfg := TCmdLineLayoutInfo.Create;
|
||||
if not CmdLineUIJSONReadFile(pth+rslt.Name, cfg) then cfg.Free
|
||||
else list.Add(cfg);
|
||||
end;
|
||||
res:=FindNext(rslt);
|
||||
end;
|
||||
finally
|
||||
FindClose(rslt);
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
{ TSectionIterator }
|
||||
|
||||
constructor TSectionIterator.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
end;
|
||||
|
||||
destructor TSectionIterator.Destroy;
|
||||
begin
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TSectionIterator.Iterate(const AName: TJSONStringType;
|
||||
Item: TJSONData; Data: TObject; var DoContinue: Boolean);
|
||||
var
|
||||
l : string;
|
||||
a : TJSONArray;
|
||||
i : Integer;
|
||||
st : TSectionIterator;
|
||||
subnm : string;
|
||||
begin
|
||||
l:=AnsiLowerCase(AName);
|
||||
if (l='switches') and (Item.JSONType=jtArray) then begin
|
||||
a:=TJSONArray(Item);
|
||||
for i:=0 to a.Count-1 do begin
|
||||
if (a.Items[i].JSONType=jtString) then
|
||||
sc.AddElement( TJSONString(a.Items[i]).AsString, letSwitch );
|
||||
end;
|
||||
end else if (l='display') and (Item.JSONType=jtString) then begin
|
||||
sc.Display:=Item.AsString;
|
||||
end else if (l='hint') and (Item.JSONType=jtString) then begin
|
||||
sc.GUIHint:=Item.AsString;
|
||||
end else if (item.JSONType=jtObject) then begin
|
||||
// sub section
|
||||
st:=TSectionIterator.Create;
|
||||
try
|
||||
st.sc:=Self.sc.AddElement(AName, letSection);
|
||||
st.lt:=Self.lt;
|
||||
TJSONObject(Item).Iterate(st.Iterate, st);
|
||||
finally
|
||||
st.Free;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
282
components/cmdlinecfg/trunk/cmdlinecfgutils.pas
Normal file
282
components/cmdlinecfg/trunk/cmdlinecfgutils.pas
Normal file
@ -0,0 +1,282 @@
|
||||
unit cmdlinecfgutils;
|
||||
|
||||
interface
|
||||
|
||||
{$mode delphi}
|
||||
|
||||
uses
|
||||
SysUtils, Classes, cmdlinecfg, process;
|
||||
|
||||
function CmdLineCfgCombine(const ancestor, child: TCmdLineCfg; DoDeleteDashTypes: Boolean = true): Boolean;
|
||||
procedure CmdLineCfgRemoveUnused(cfg: TCmdLineCfg);
|
||||
function CmdLineCfgDetect(listofcfg: TList {of TCmdLineCfg}; const Dir, FullPathExec: string): TCmdLineCfg;
|
||||
|
||||
function ReadOutput(const Dir, ExecCommand: String): string;
|
||||
|
||||
// make the Value to be comand-line friendly, by handling CommandLineINvalidChars
|
||||
// quotes would be added, if white-space characters are found
|
||||
// todo: command lines replacement, should be system specific!
|
||||
function CmdLineNormalizeParam(const Value: String): String;
|
||||
|
||||
// parses a command line into a list of arguments
|
||||
// to be compatbile with RTL: ParamStr, ParamCount
|
||||
procedure CmdLineParse(const cmdline: string; arguments : TStrings);
|
||||
function CmdLineToExecutable(const cmdline: String; var Executable: string; Args: TStrings): Boolean;
|
||||
|
||||
procedure CmdLineAllocMultiValues(opt: TCmdLineCfgOption; const SrcValue: string; Delim: Char; dst: TList);
|
||||
|
||||
implementation
|
||||
|
||||
function OverrideIfEmpty(const existingValue, ReplacingValue: string): string;
|
||||
begin
|
||||
if existingValue='' then Result:=ReplacingValue else Result:=existingValue;
|
||||
end;
|
||||
|
||||
function CmdLineCfgOptionCopy(const opt: TCmdLineCfgOption): TCmdLineCfgOption;
|
||||
var
|
||||
i : Integer;
|
||||
begin
|
||||
Result:=TCmdLineCfgOption.Create;
|
||||
Result.Section:=opt.Section;
|
||||
Result.SubSection:=opt.SubSection;
|
||||
Result.Name:=opt.Name;
|
||||
Result.OptType:=opt.OptType;
|
||||
Result.Key:=opt.Key;
|
||||
Result.Display:=opt.Display;
|
||||
Result.Condition:=opt.Condition;
|
||||
Result.ValCount:=opt.ValCount;
|
||||
SetLength(Result.Values, Result.ValCount);
|
||||
for i:=0 to Result.ValCount-1 do begin
|
||||
Result.Values[i].Condition:=opt.Values[i].Condition;
|
||||
Result.Values[i].DisplayName:=opt.Values[i].DisplayName;
|
||||
Result.Values[i].CmdLineValue:=opt.Values[i].DisplayName;
|
||||
end;
|
||||
end;
|
||||
|
||||
function SortByName(p1,p2: Pointer): Integer;
|
||||
var
|
||||
o1, o2: TCmdLineCfgOption;
|
||||
begin
|
||||
o1:=TCmdLineCfgOption(p1);
|
||||
o2:=TCmdLineCfgOption(p2);
|
||||
Result:=CompareStr(o1.Name, o2.Name);
|
||||
end;
|
||||
|
||||
function CmdLineCfgCombine(const ancestor, child: TCmdLineCfg; DoDeleteDashTypes: Boolean = true): Boolean;
|
||||
var
|
||||
i, j : integer;
|
||||
l1,l2 : TList;
|
||||
opt : TCmdLineCfgOption;
|
||||
begin
|
||||
Result:=Assigned(ancestor) and Assigned(child)
|
||||
and (ancestor.Version=child.FromVersion) and (ancestor.Executable=child.Executable);
|
||||
if not Result then Exit;
|
||||
// executable
|
||||
// version
|
||||
// testValue
|
||||
// fromVersion are not inheritable
|
||||
child.TestKey:=OverrideIfEmpty(child.TestKey, ancestor.TestKey);
|
||||
ancestor.Options.Sort(@SortByName);
|
||||
child.Options.Sort(@SortByName);
|
||||
i:=0;
|
||||
j:=0;
|
||||
for i:=0 to ancestor.Options.Count-1 do begin
|
||||
opt:=TCmdLineCfgOption(ancestor.Options[i]);
|
||||
while (j<child.Options.Count) and (CompareStr(opt.Name, TCmdLineCfgOption(child.Options[j]).Name)>0) do
|
||||
inc(j);
|
||||
if (j<child.Options.Count) and (CompareStr(opt.Name, TCmdLineCfgOption(child.Options[j]).Name)<0) then begin
|
||||
child.Options.Add ( CmdLineCfgOptionCopy (opt));
|
||||
end;
|
||||
end;
|
||||
if DoDeleteDashTypes then CmdLineCfgRemoveUnused(child);
|
||||
end;
|
||||
|
||||
procedure CmdLineCfgRemoveUnused(cfg: TCmdLineCfg);
|
||||
var
|
||||
i : Integer;
|
||||
begin
|
||||
for i:=0 to cfg.Options.Count-1 do
|
||||
if TCmdLineCfgOption(cfg.Options[i]).OptType='-' then begin
|
||||
TCmdLineCfgOption(cfg.Options[i]).Free;
|
||||
cfg.Options[i]:=nil;
|
||||
end;
|
||||
cfg.Options.Pack;
|
||||
end;
|
||||
|
||||
function ReadOutput(const Dir, ExecCommand: String): string;
|
||||
var
|
||||
p: TProcess;
|
||||
m: TMemoryStream;
|
||||
BytesRead : Integer;
|
||||
n: INteger;
|
||||
exe : string;
|
||||
const
|
||||
READ_BYTES = 1024;
|
||||
begin
|
||||
Result:='';
|
||||
BytesRead:=0;
|
||||
m:=TMemoryStream.Create;
|
||||
p:=TProcess.Create(nil);
|
||||
try
|
||||
exe:='';
|
||||
if not CmdLineToExecutable(ExecCommand, exe, p.Parameters) then Exit;
|
||||
p.Executable:=exe;
|
||||
p.CurrentDirectory:=Dir;
|
||||
p.Options:=[poUsePipes, poStdErrToOutput];
|
||||
p.Execute;
|
||||
while P.Running do begin
|
||||
if P.Output.NumBytesAvailable>0 then begin
|
||||
if M.Size-M.Position<READ_BYTES then begin
|
||||
M.SetSize(BytesRead + READ_BYTES);
|
||||
end;
|
||||
n := P.Output.Read((M.Memory + BytesRead)^, READ_BYTES);
|
||||
if n > 0 then Inc(BytesRead, n) else Sleep(1);
|
||||
end;
|
||||
end;
|
||||
repeat
|
||||
M.SetSize(BytesRead + READ_BYTES);
|
||||
n := P.Output.Read((M.Memory + BytesRead)^, READ_BYTES);
|
||||
if n > 0 then Inc(BytesRead, n);
|
||||
until n <= 0;
|
||||
if BytesRead > 0 then M.SetSize(BytesRead);
|
||||
M.Position:=0;
|
||||
SetLength(Result, M.Size);
|
||||
if length(Result)>0 then
|
||||
M.Read(Result[1], M.Size);
|
||||
finally
|
||||
p.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function SortByTestKey(c1, c2: TCmdLineCfg {these are actually Pointers in here!}): Integer;
|
||||
begin
|
||||
Result:=CompareStr(c1.TestKey, c2.TestKey);
|
||||
end;
|
||||
|
||||
function CmdLineCfgDetect(listofcfg: TList {of TCmdLineCfg}; const Dir, FullPathExec: string): TCmdLineCfg;
|
||||
var
|
||||
i : integer;
|
||||
cfg : TCmdLineCfg;
|
||||
tk : String;
|
||||
tv : String;
|
||||
search : TList;
|
||||
begin
|
||||
Result:=nil;
|
||||
search:=TList.Create;
|
||||
try
|
||||
tk:='';
|
||||
search.Assign(listofcfg);
|
||||
search.Sort(@SortByTestKey);
|
||||
for i:=0 to listofcfg.Count-1 do begin
|
||||
cfg := TCmdLineCfg(listofcfg[i]);
|
||||
if cfg.TestKey<>tk then begin
|
||||
tk:=cfg.TestKey;
|
||||
tv:=trim(ReadOutput(dir, FullPathExec+' '+tk));
|
||||
end;
|
||||
if cfg.TestValue=tv then begin
|
||||
Result:=cfg;
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
search.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function CmdLineNormalizeParam(const Value: String): String;
|
||||
var
|
||||
i : Integer;
|
||||
const
|
||||
CommandLineInvalidChars : set of Char = ['/','\',':','"','''','?','<','>',' '];
|
||||
begin
|
||||
for i:=0 to length(Value) do
|
||||
if Value[i] in CommandLineInvalidChars then begin
|
||||
//todo!
|
||||
Result:='"'+Result+'"';
|
||||
Exit;
|
||||
end;
|
||||
Result:=Value;
|
||||
end;
|
||||
|
||||
|
||||
function CmdLineToExecutable(const cmdline: String; var Executable: string;
|
||||
Args: TStrings): Boolean;
|
||||
var
|
||||
a : TStringList;
|
||||
begin
|
||||
a:=TStringList.Create;
|
||||
try
|
||||
CmdLineParse(cmdline, a);
|
||||
Result:=a.Count>0;
|
||||
if Result then begin
|
||||
Executable:=a[0];
|
||||
a.Delete(0);
|
||||
Args.Assign(a);
|
||||
end;
|
||||
finally
|
||||
a.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure CmdLineParse(const cmdline: string; arguments : TStrings);
|
||||
var
|
||||
i : integer;
|
||||
j : integer;
|
||||
isprm : Boolean;
|
||||
p : string;
|
||||
const
|
||||
WhiteSpace : set of char = [#32,#9,#8,#13,#10];
|
||||
QuoteChar = '"'; // yeah! be academic!
|
||||
begin
|
||||
if not Assigned(arguments) then eXit;
|
||||
j:=1;
|
||||
i:=1;
|
||||
isprm:=false;
|
||||
p:='';
|
||||
while i<=length(cmdline) do begin
|
||||
if not (cmdline[i] in WhiteSpace) then begin
|
||||
if not isprm then j:=i;
|
||||
if cmdline[i]=QuoteChar then begin
|
||||
p:=p+Copy(cmdline, j, i-j);
|
||||
inc(i);
|
||||
j:=i;
|
||||
while (i<=length(cmdline)) and (cmdline[i]<>'"') do
|
||||
inc(i);
|
||||
p:=p+Copy(cmdline, j, i-j);
|
||||
j:=i+1;
|
||||
end;
|
||||
isprm:=true;
|
||||
end else if isprm then begin
|
||||
arguments.Add(p+Copy(cmdline, j, i-j));
|
||||
isprm:=false;
|
||||
p:='';
|
||||
end;
|
||||
inc(i);
|
||||
end;
|
||||
if isprm then arguments.Add(p+Copy(cmdline, j, i-j));
|
||||
end;
|
||||
|
||||
procedure CmdLineAllocMultiValues(opt: TCmdLineCfgOption; const SrcValue: string; Delim: Char; dst: TList);
|
||||
var
|
||||
i, j : Integer;
|
||||
vl : TCmdLineOptionValue;
|
||||
v : string;
|
||||
begin
|
||||
if not Assigned(opt) or not Assigned(dst) or (SrcValue='') then Exit;
|
||||
i:=1; j:=1;
|
||||
while i<=length(SrcValue) do begin
|
||||
if SrcValue[i]=Delim then begin
|
||||
v:=Trim(Copy(SrcValue, j, i-j));
|
||||
j:=i+1;
|
||||
if v<>'' then dst.Add( TCmdLineOptionValue.Create(opt, v));
|
||||
end;
|
||||
inc(i);
|
||||
end;
|
||||
if j<i then begin
|
||||
v:=Trim(Copy(SrcValue, j, i-j));
|
||||
j:=i+1;
|
||||
if v<>'' then dst.Add( TCmdLineOptionValue.Create(opt, v));
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
122
components/cmdlinecfg/trunk/cmdlinefpccond.pas
Normal file
122
components/cmdlinecfg/trunk/cmdlinefpccond.pas
Normal file
@ -0,0 +1,122 @@
|
||||
unit cmdlinefpccond;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils;
|
||||
|
||||
//todo: need to distingiush between cpu and os.
|
||||
// the list however, need to come externally
|
||||
|
||||
type
|
||||
{ TFPCConditionCheck }
|
||||
TFPCConditionCheck = class(TObject)
|
||||
private
|
||||
fCndStr: string;
|
||||
cnt : integer;
|
||||
fCnd : array of record cpu, os: string end;
|
||||
procedure AddSubCond(const cond: string);
|
||||
procedure ParseStr(const ACndStr: string);
|
||||
public
|
||||
constructor Create(const ACndStr: string);
|
||||
function isValid(const cpu, os: string): Boolean;
|
||||
property CndStr: string read fCndStr;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
procedure ParseCPUOS(const cpu_os: string; var cpu, os : string);
|
||||
var
|
||||
i : integer;
|
||||
begin
|
||||
//todo: see todo above!
|
||||
i:=Pos('-', cpu_os);
|
||||
if i>0 then begin
|
||||
cpu:=Copy(cpu_os, 1, i-1);
|
||||
os:=Copy(cpu_os, i+1, length(cpu_os));
|
||||
end else begin
|
||||
cpu:=cpu_os;
|
||||
os:='';
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TFPCConditionCheck }
|
||||
|
||||
procedure TFPCConditionCheck.AddSubCond(const cond: string);
|
||||
var
|
||||
os,cpu: string;
|
||||
begin
|
||||
os:=''; cpu:='';
|
||||
ParseCPUOS(cond, cpu, os);
|
||||
if cpu<>'' then begin
|
||||
if cnt=length(fCnd) then begin
|
||||
if cnt=0 then SetLength(fCnd, 4)
|
||||
else SetLEngth(fCnd, cnt*2);
|
||||
end;
|
||||
fCnd[cnt].cpu:=AnsiLowerCase(cpu);
|
||||
fCnd[cnt].os:=AnsiLowerCase(os);
|
||||
inc(cnt);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFPCConditionCheck.ParseStr(const ACndStr: string);
|
||||
var
|
||||
i : integer;
|
||||
j : integer;
|
||||
s : string;
|
||||
begin
|
||||
j:=1;
|
||||
cnt:=0;
|
||||
i:=1;
|
||||
while i<=length(ACndStr) do begin
|
||||
if ACndStr[i] in [','] then begin
|
||||
s:=trim(Copy(ACndStr, j, i-j));
|
||||
if s<>'' then AddSubCond(s);
|
||||
j:=i+1;
|
||||
end;
|
||||
inc(i);
|
||||
end;
|
||||
if j<length(ACndStr) then
|
||||
AddSubCond( Copy(ACndStr, j, i-j));
|
||||
SetLength(fCnd, cnt);
|
||||
end;
|
||||
|
||||
constructor TFPCConditionCheck.Create(const ACndStr: string);
|
||||
begin
|
||||
inherited Create;
|
||||
ParseStr(ACndStr);
|
||||
fCndStr:=ACndStr;
|
||||
end;
|
||||
|
||||
function TFPCConditionCheck.isValid(const cpu, os: string): Boolean;
|
||||
var
|
||||
i : integer;
|
||||
a, b: string;
|
||||
begin
|
||||
if length(fCnd)=0 then begin
|
||||
Result:=true;
|
||||
Exit;
|
||||
end;
|
||||
a:=AnsiLowerCase(cpu);
|
||||
b:=AnsiLowerCase(os);
|
||||
if (cpu='') and (os<>'') then begin
|
||||
a:=b;
|
||||
b:='';
|
||||
end;
|
||||
for i:=0 to length(fCnd)-1 do begin
|
||||
Result:=// complete match of os and cpu
|
||||
((fCnd[i].os=b) and (fCnd[i].cpu=a))
|
||||
// this is the check, when only OS or only CPU is specified as a condition
|
||||
// but either CPU or OS has been passed.
|
||||
// i.e.
|
||||
// "i386" valid for "i386-linux" or "i386-Win32"
|
||||
// "darwin" valid for "arm-darwin" or "i386-darwin"
|
||||
// note, that if a condition consists only of a single string, it
|
||||
// will always be saved into "cpu" field of the check record.
|
||||
or ( (fCnd[i].os='') and ((fCnd[i].cpu=a) or (fCnd[i].cpu=b)));
|
||||
if Result then Exit;
|
||||
end;
|
||||
Result:=False;
|
||||
end;
|
||||
|
||||
end.
|
||||
371
components/cmdlinecfg/trunk/cmdlinelazcompopt.pas
Normal file
371
components/cmdlinecfg/trunk/cmdlinelazcompopt.pas
Normal file
@ -0,0 +1,371 @@
|
||||
unit cmdlinelazcompopt;
|
||||
|
||||
{$mode delphi}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
// this unit depends on IDEIntf package (CompOptsIntf.pas) !
|
||||
|
||||
uses
|
||||
Classes, SysUtils, CompOptsIntf, cmdlinecfg, cmdlinecfgutils, cmdlinecfgparser, contnrs;
|
||||
|
||||
{ Either procedures depends on a certain names/keys used for the FPC options.
|
||||
This has to be caferully maintained in the configuration file. }
|
||||
procedure LazCompOptToVals(opt: TLazCompilerOptions; cfg: TCmdLineCfg; list: TList {of TCmdLineValueOpts});
|
||||
procedure ValsToLazCompOpt(list: TList {of TCmdLineValueOpts}; opt: TLazCompilerOptions);
|
||||
|
||||
implementation
|
||||
|
||||
// hash all values - make their copies and "join" multi values (if available)
|
||||
function AllocLookup(list: TList): TFPHashObjectList;
|
||||
var
|
||||
i : integer;
|
||||
v : TCmdLineOptionValue;
|
||||
lv : TCmdLineOptionValue;
|
||||
d : string;
|
||||
begin
|
||||
Result:=TFPHashObjectList.Create(true);
|
||||
for i:=0 to list.Count-1 do begin
|
||||
v:=TCmdLineOptionValue(list[i]);
|
||||
if not Assigned(v) or not Assigned(v.Option) then Continue;
|
||||
lv:=TCmdLineOptionValue(Result.Find(v.Option.Name));
|
||||
if v.Option.isMultiple then begin
|
||||
if not Assigned(lv) then begin
|
||||
lv:=TCmdLineOptionValue.Create(v.Option, v.Value);
|
||||
Result.Add(v.Option.Name, lv);
|
||||
end else begin
|
||||
if (v.Option.OptType='filepath') or (v.Option.OptType='dirpath') then d:=';' else d:=' ';
|
||||
if lv.Value='' then lv.Value:=v.Value else lv.Value:=lv.Value+d+v.Value;
|
||||
end;
|
||||
end else begin
|
||||
if not Assigned(lv) then begin
|
||||
lv:=TCmdLineOptionValue.Create(v.Option, v.Value);
|
||||
Result.Add(v.Option.Name, lv);
|
||||
end else
|
||||
lv.Value:=v.Value;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function LookupStr(lp: TFPHashObjectList; const Name: string; const Default: string = ''; Remove: Boolean = true): string;
|
||||
var
|
||||
v: TCmdLineOptionValue;
|
||||
i: integer;
|
||||
begin
|
||||
i:=lp.FindIndexOf(Name);
|
||||
if i>=0 then begin
|
||||
v:=TCmdLineOptionValue(lp.Items[i]);
|
||||
Result:=v.Value;
|
||||
if Remove then lp.Delete(i); // frees the object
|
||||
end else
|
||||
Result:=Default;
|
||||
end;
|
||||
|
||||
function LookupBool(lp: TFPHashObjectList; const Name: string; const Default: Boolean = false; Remove: Boolean = true): Boolean;
|
||||
var
|
||||
v: TCmdLineOptionValue;
|
||||
i: integer;
|
||||
begin
|
||||
i:=lp.FindIndexOf(Name);
|
||||
if i>=0 then begin
|
||||
v:=TCmdLineOptionValue(lp.Items[i]);
|
||||
Result:=v.Value<>'';
|
||||
if Remove then lp.Delete(i); // frees the object
|
||||
end else
|
||||
Result:=Default;
|
||||
end;
|
||||
|
||||
function LookupInt(lp: TFPHashObjectList; const Name: string; const Default: Integer = 0; Remove: Boolean = true): Integer;
|
||||
var
|
||||
v: TCmdLineOptionValue;
|
||||
i: integer;
|
||||
begin
|
||||
i:=lp.FindIndexOf(Name);
|
||||
if i>=0 then begin
|
||||
v:=TCmdLineOptionValue(lp.Items[i]);
|
||||
Result:=StrToIntDef(v.Value,Default);
|
||||
if Remove then lp.Delete(i); // frees the object
|
||||
end else
|
||||
Result:=Default;
|
||||
end;
|
||||
|
||||
function StrToDbgSymbolType(const vals: string): TCompilerDbgSymbolType;
|
||||
var
|
||||
v : string;
|
||||
begin
|
||||
v:=AnsiLowerCase(vals);
|
||||
if v='s' then Result:=dsStabs
|
||||
else if v='w2' then Result:=dsDwarf2
|
||||
else if v='w' then Result:=dsDwarf2Set // ???
|
||||
else if v='w3' then Result:=dsDwarf3;
|
||||
end;
|
||||
|
||||
procedure ValsToLazCompOpt(list: TList {of TCmdLineValueOpts}; opt: TLazCompilerOptions);
|
||||
var
|
||||
lookup : TFPHashObjectList;
|
||||
i : Integer;
|
||||
l : TList;
|
||||
begin
|
||||
lookup:=AllocLookup(list);
|
||||
try
|
||||
// search paths:
|
||||
opt.IncludePath:=LookupStr(lookup, '-Fi');
|
||||
opt.Libraries:=LookupStr(lookup, '-Fl');
|
||||
opt.ObjectPath:=LookupStr(lookup, '-Fo');
|
||||
opt.OtherUnitFiles:=LookupStr(lookup, '-Fu');
|
||||
//opt.SrcPath (not in compiler options)
|
||||
//opt.DebugPath
|
||||
opt.UnitOutputDirectory:=LookupStr(lookup, '-FU');
|
||||
|
||||
// target:
|
||||
opt.TargetFilename:=LookupStr(lookup, '-o');
|
||||
//opt.TargetFilenameApplyConventions
|
||||
|
||||
// parsing:
|
||||
opt.SyntaxMode:=LookupStr(lookup, '-M');
|
||||
//property AssemblerStyle: Integer read fAssemblerStyle write SetAssemblerStyle;
|
||||
opt.CStyleOperators:=LookupBool(lookup, '-Sc');
|
||||
opt.IncludeAssertionCode:=LookupBool(lookup, '-Sa');
|
||||
opt.AllowLabel:=LookupBool(lookup,'-Sg');
|
||||
opt.UseAnsiStrings:=LookupBool(lookup,'-Sh');
|
||||
opt.CPPInline:=LookupBool(lookup,'-Si');
|
||||
opt.CStyleMacros:=LookupBool(lookup,'-Sm');
|
||||
opt.InitConstructor:=LookupBool(lookup,'-Ss');
|
||||
|
||||
// -St is obsolete option ... so shouldn't be available
|
||||
opt.StaticKeyword:=LookupBool(lookup,'-St');
|
||||
|
||||
// code generation:
|
||||
opt.IOChecks:=LookupBool(lookup,'-Ci');
|
||||
opt.RangeChecks:=LookupBool(lookup,'-Cr');
|
||||
opt.OverflowChecks:=LookupBool(lookup,'-Co');
|
||||
opt.StackChecks:=LookupBool(lookup,'-Ct');
|
||||
opt.SmartLinkUnit:=LookupBool(lookup,'-CX');
|
||||
opt.RelocatableUnit:=LookupBool(lookup,'-WR');
|
||||
opt.EmulatedFloatOpcodes:=LookupBool(lookup,'-Ce');
|
||||
|
||||
opt.HeapSize:=LookupInt(lookup, '-Ch');
|
||||
opt.StackSize:=LookupInt(lookup, '-Cs');
|
||||
opt.VerifyObjMethodCall:=LookupBool(lookup,'-CR');
|
||||
|
||||
opt.SmallerCode :=LookupBool(lookup, '-Os');
|
||||
opt.TargetCPU :=LookupStr(lookup, '-P');
|
||||
opt.TargetProcessor:=LookupStr(lookup, '-Op');
|
||||
opt.TargetOS:=LookupStr(lookup, '-T');
|
||||
opt.VariablesInRegisters:=LookupBool(lookup, '-Or');
|
||||
opt.UncertainOptimizations:=LookupBool(lookup, '-Ou');
|
||||
opt.OptimizationLevel:=StrToIntDef(LookupStr(lookup, '-O'),0);
|
||||
|
||||
// linking:
|
||||
opt.GenerateDebugInfo:=LookupBool(lookup, '-g');
|
||||
|
||||
opt.DebugInfoType:=StrToDbgSymbolType(LookupStr(lookup, '-g'));
|
||||
//opt.DebugInfoTypeStr: String read GetDebugInfoTypeStr;
|
||||
|
||||
opt.UseLineInfoUnit:=LookupBool(lookup, '-gl');
|
||||
opt.UseHeaptrc:=LookupBool(lookup, '-gh');
|
||||
opt.UseValgrind:=LookupBool(lookup, '-gv');
|
||||
opt.GenGProfCode:=LookupBool(lookup, '-pg');
|
||||
opt.StripSymbols:=LookupBool(lookup, '-Xs');
|
||||
opt.LinkSmart:=LookupBool(lookup, '-XX');
|
||||
|
||||
opt.LinkerOptions:=LookupStr(lookup, '-k');
|
||||
opt.PassLinkerOptions:=opt.LinkerOptions<>''; //todo:!
|
||||
|
||||
opt.Win32GraphicApp:=LookupBool(lookup, '-WG');
|
||||
//ExecutableType: TCompilationExecutableType read FExecutableType write SetExecutableType;
|
||||
opt.UseExternalDbgSyms:=LookupBool(lookup, '-Xg');
|
||||
|
||||
// messages:
|
||||
opt.ShowErrors:=LookupBool(lookup, '-ve');
|
||||
opt.ShowWarn:=LookupBool(lookup, '-vw');
|
||||
opt.ShowNotes:=LookupBool(lookup, '-vn');
|
||||
opt.ShowHints:=LookupBool(lookup, '-vh');
|
||||
opt.ShowGenInfo:=LookupBool(lookup, '-vi');
|
||||
opt.ShowLineNum:=LookupBool(lookup, '-vl');
|
||||
opt.ShowAll:=LookupBool(lookup, '-va');
|
||||
opt.ShowAllProcsOnError:=LookupBool(lookup, '-Xs');
|
||||
|
||||
opt.ShowDebugInfo:=LookupBool(lookup, '-vd');
|
||||
opt.ShowUsedFiles:=LookupBool(lookup, '-vu');
|
||||
opt.ShowTriedFiles:=LookupBool(lookup, '-vt');
|
||||
opt.ShowCompProc:=LookupBool(lookup, '-vp');
|
||||
opt.ShowCond:=LookupBool(lookup, '-vc');
|
||||
opt.ShowExecInfo:=LookupBool(lookup, '-vx');
|
||||
opt.ShowNothing:=LookupBool(lookup, '-v0');
|
||||
//opt.ShowSummary
|
||||
//opt.ShowHintsForUnusedUnitsInMainSrc
|
||||
//opt.ShowHintsForSenderNotUsed
|
||||
opt.WriteFPCLogo:=LookupBool(lookup, '-l');
|
||||
opt.StopAfterErrCount:=LookupInt(lookup, '-Se');
|
||||
|
||||
// other
|
||||
opt.DontUseConfigFile:=LookupBool(lookup, '-n');
|
||||
//opt.ConfigFilePath:=LookupStr(lookup, '@');
|
||||
//opt.CustomConfigFile:=opt.ConfigFilePath<>'';
|
||||
|
||||
|
||||
if lookup.Count>0 then begin
|
||||
l:=TList.Create;
|
||||
try
|
||||
for i:=0 to lookup.Count-1 do l.Add(lookup.Items[i]);
|
||||
opt.CustomOptions:=CmdLineMakeOptions(l);
|
||||
finally
|
||||
l.Free; // values, will be freed with lookup
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
lookup.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure AddBoolValue(cfg: TCmdLineCfg; const Key: string; AVal: Boolean; list: TList; var Other: string);
|
||||
var
|
||||
o : TCmdLineCfgOption;
|
||||
begin
|
||||
if not AVal then Exit;
|
||||
o:=cfg.FindOption(Key);
|
||||
if Assigned(o) then
|
||||
list.Add(TCmdLineOptionValue.Create(o, '1'));
|
||||
end;
|
||||
|
||||
procedure AddStrValue(cfg: TCmdLineCfg; const Key, AVal: string; list: TList; var Other: string);
|
||||
var
|
||||
o : TCmdLineCfgOption;
|
||||
begin
|
||||
if AVal='' then Exit;
|
||||
o:=cfg.FindOption(Key);
|
||||
if Assigned(o) then
|
||||
list.Add(TCmdLineOptionValue.Create(o, AVal));
|
||||
end;
|
||||
|
||||
procedure AddIntValue(cfg: TCmdLineCfg; const Key: string; AVal: Integer; list: TList; var Other: string);
|
||||
var
|
||||
o : TCmdLineCfgOption;
|
||||
begin
|
||||
if AVal<=0 then Exit;
|
||||
o:=cfg.FindOption(Key);
|
||||
if Assigned(o) then
|
||||
list.Add(TCmdLineOptionValue.Create(o, IntToStr(AVal)));
|
||||
end;
|
||||
|
||||
procedure AddMultiStrValue(cfg: TCmdLineCfg; const Key, AVal, Delim: string; list: TList; var Other: string);
|
||||
var
|
||||
o : TCmdLineCfgOption;
|
||||
ch : Char;
|
||||
begin
|
||||
if AVal='' then Exit;
|
||||
o:=cfg.FindOption(Key);
|
||||
if Assigned(o) then begin
|
||||
if length(DElim)>0 then ch:=Delim[1] else ch:=#0;
|
||||
CmdLineAllocMultiValues(o, AVal, ch, list);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure LazCompOptToVals(opt: TLazCompilerOptions; cfg: TCmdLineCfg; list: TList {of TCmdLineValueOpts});
|
||||
var
|
||||
other : string;
|
||||
begin
|
||||
other := '';
|
||||
AddMultiStrValue(cfg, '-Fi', opt.IncludePath, ';', list, Other);
|
||||
AddMultiStrValue(cfg, '-Fl', opt.Libraries, ';', list, Other);
|
||||
AddMultiStrValue(cfg, '-Fo', opt.ObjectPath, ';', list, Other);
|
||||
AddMultiStrValue(cfg, '-Fu', opt.OtherUnitFiles, ';', list, Other);
|
||||
// opt.SrcPath (not in compiler options) ?? -sources for Lazarus itself?
|
||||
|
||||
//opt.DebugPath
|
||||
AddStrValue(cfg, '-FU', opt.UnitOutputDirectory, list, other);
|
||||
|
||||
// target:
|
||||
AddStrValue(cfg, '-o', opt.TargetFilename, list, other);
|
||||
|
||||
// parsing:
|
||||
AddStrValue(cfg, '-M', opt.UnitOutputDirectory, list, other);
|
||||
|
||||
//property AssemblerStyle: Integer read fAssemblerStyle write SetAssemblerStyle;
|
||||
AddBoolValue(cfg, '-Sc', opt.CStyleOperators, list, other);
|
||||
|
||||
AddBoolValue(cfg, '-Sa', opt.IncludeAssertionCode, list, other);
|
||||
AddBoolValue(cfg, '-Sg', opt.AllowLabel, list, other);
|
||||
AddBoolValue(cfg, '-Sh', opt.UseAnsiStrings, list, other);
|
||||
AddBoolValue(cfg, '-Si', opt.CPPInline, list, other);
|
||||
AddBoolValue(cfg, '-Sm', opt.CStyleMacros, list, other);
|
||||
AddBoolValue(cfg, '-Ss', opt.InitConstructor, list, other);
|
||||
|
||||
// -St is obsolete option ... so shouldn't be available
|
||||
AddBoolValue(cfg, '-St', opt.StaticKeyword, list, other);
|
||||
|
||||
// code generation:
|
||||
AddBoolValue(cfg, '-Ci', opt.IOChecks, list, other);
|
||||
AddBoolValue(cfg, '-Cr', opt.RangeChecks, list, other);
|
||||
AddBoolValue(cfg, '-Co', opt.OverflowChecks, list, other);
|
||||
AddBoolValue(cfg, '-Ct', opt.StackChecks, list, other);
|
||||
AddBoolValue(cfg, '-CX', opt.SmartLinkUnit, list, other);
|
||||
AddBoolValue(cfg, '-WR', opt.RelocatableUnit, list, other);
|
||||
AddBoolValue(cfg, '-Ce', opt.EmulatedFloatOpcodes, list, other);
|
||||
|
||||
AddIntValue(cfg, '-Ch', opt.HeapSize, list, other);
|
||||
AddIntValue(cfg, '-Cs', opt.StackSize, list, other);
|
||||
AddBoolValue(cfg, '-CR', opt.VerifyObjMethodCall, list, other);
|
||||
|
||||
AddBoolValue(cfg, '-CR', opt.SmallerCode, list, other);
|
||||
AddStrValue(cfg, '-P', opt.TargetCPU, list, other);
|
||||
AddStrValue(cfg, '-Op', opt.TargetProcessor, list, other);
|
||||
AddStrValue(cfg, '-T', opt.TargetOS, list, other);
|
||||
AddBoolValue(cfg, '-Or', opt.VariablesInRegisters, list, other);
|
||||
AddBoolValue(cfg, '-Ou', opt.UncertainOptimizations, list, other);
|
||||
AddStrValue(cfg, '-O', IntToStr(opt.OptimizationLevel), list, other);
|
||||
|
||||
// linking:
|
||||
AddBoolValue(cfg, '-g', opt.GenerateDebugInfo, list, other);
|
||||
|
||||
//todo: EPIC TODO
|
||||
//AddStrValue(cfg, '-g', opt.DebugInfoType, list, other);
|
||||
//opt.DebugInfoTypeStr: String read GetDebugInfoTypeStr;
|
||||
|
||||
AddBoolValue(cfg, '-gl', opt.UseLineInfoUnit, list, other);
|
||||
AddBoolValue(cfg, '-gh', opt.UseHeaptrc, list, other);
|
||||
AddBoolValue(cfg, '-gv', opt.UseValgrind, list, other);
|
||||
AddBoolValue(cfg, '-pg', opt.GenGProfCode, list, other);
|
||||
AddBoolValue(cfg, '-Xs', opt.StripSymbols, list, other);
|
||||
AddBoolValue(cfg, '-XX', opt.LinkSmart, list, other);
|
||||
|
||||
AddMultiStrValue(cfg, '-k', opt.LinkerOptions, ' ', list, other);
|
||||
{opt.LinkerOptions:=LookupStr(lookup, '-k');
|
||||
opt.PassLinkerOptions:=opt.LinkerOptions<>''; //todo:!}
|
||||
|
||||
AddBoolValue(cfg, '-WG', opt.Win32GraphicApp, list, other);
|
||||
//ExecutableType: TCompilationExecutableType read FExecutableType write SetExecutableType;
|
||||
AddBoolValue(cfg, '-Xg', opt.UseExternalDbgSyms, list, other);
|
||||
|
||||
// messages:
|
||||
AddBoolValue(cfg, '-ve', opt.ShowErrors, list, other);
|
||||
AddBoolValue(cfg, '-vw', opt.ShowWarn, list, other);
|
||||
AddBoolValue(cfg, '-vn', opt.ShowNotes, list, other);
|
||||
AddBoolValue(cfg, '-vh', opt.ShowHints, list, other);
|
||||
AddBoolValue(cfg, '-vi', opt.ShowGenInfo, list, other);
|
||||
AddBoolValue(cfg, '-vl', opt.ShowLineNum, list, other);
|
||||
AddBoolValue(cfg, '-va', opt.ShowAll, list, other);
|
||||
AddBoolValue(cfg, '-Xs', opt.ShowAllProcsOnError, list, other);
|
||||
|
||||
AddBoolValue(cfg, '-vd', opt.ShowDebugInfo, list, other);
|
||||
AddBoolValue(cfg, '-vu', opt.ShowUsedFiles, list, other);
|
||||
AddBoolValue(cfg, '-vt', opt.ShowTriedFiles, list, other);
|
||||
AddBoolValue(cfg, '-vp', opt.ShowCompProc, list, other);
|
||||
AddBoolValue(cfg, '-vc', opt.ShowCond, list, other);
|
||||
AddBoolValue(cfg, '-vx', opt.ShowExecInfo, list, other);
|
||||
AddBoolValue(cfg, '-v0', opt.ShowNothing, list, other);
|
||||
//opt.ShowSummary
|
||||
//opt.ShowHintsForUnusedUnitsInMainSrc
|
||||
//opt.ShowHintsForSenderNotUsed
|
||||
AddBoolValue(cfg, '-l' , opt.WriteFPCLogo, list, other);
|
||||
AddIntValue(cfg, '-Se', opt.StopAfterErrCount, list, other);
|
||||
|
||||
// other
|
||||
AddBoolValue(cfg, '-n', opt.DontUseConfigFile, list, other);
|
||||
CmdLineMatchArgsToOpts(cfg, opt.CustomOptions, list);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
398
components/cmdlinecfg/trunk/cmdlinelclctrlsbox.pas
Normal file
398
components/cmdlinecfg/trunk/cmdlinelclctrlsbox.pas
Normal file
@ -0,0 +1,398 @@
|
||||
unit cmdlinelclctrlsbox;
|
||||
|
||||
{$mode delphi}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Controls, Forms, StdCtrls, Graphics
|
||||
, cmdlinecfg, cmdlinecfgutils, cmdlinelclutils, cmdlinecfgui
|
||||
, contnrs
|
||||
, cmdlinefpccond;
|
||||
|
||||
type
|
||||
|
||||
{ TControlInfo }
|
||||
|
||||
TControlInfo = class(TObject)
|
||||
public
|
||||
check : TFPCConditionCheck;
|
||||
opt : TCmdLineCfgOption;
|
||||
ctrl : TControl;
|
||||
constructor Create(aopt: TCmdLineCfgOption; actrl: TControl);
|
||||
destructor Destroy; override;
|
||||
function isAllowed(const cpu, os: string): Boolean;
|
||||
end;
|
||||
|
||||
{ TCmdLineScrollBoxControl }
|
||||
|
||||
TCmdLineScrollBoxControl = class(TCmdLineUIControl)
|
||||
private
|
||||
fScrollBox : TScrollBox;
|
||||
fCfg : TCmdLineCfg;
|
||||
fControls : TList;
|
||||
fOptToCtrl : TFPHashObjectList;
|
||||
protected
|
||||
flayout: TCmdLineLayoutInfo;
|
||||
fusedoptlist: TStringList;
|
||||
procedure OnChange(Sender: TObject);
|
||||
procedure OnCndChange(Sender: TObject);
|
||||
procedure RevaluateConditions;
|
||||
function AllocControls(AParent: TWinControl; VOffset: Integer; listofopt: TList): Integer;
|
||||
function AllocHeaderLabel(AParent: TWinControl; VOffset: Integer; const Caption: String): Integer;
|
||||
function AllocForSection(AParent: TWinControl; VOffset: Integer; sct : TLayoutSection; SkipHeader: Boolean = false): Integer;
|
||||
procedure Reset;
|
||||
public
|
||||
constructor Create(AParent: TWinControl);
|
||||
destructor Destroy; override;
|
||||
procedure Init(cfg: TCmdLineCfg; layout: TCmdLineLayoutInfo); override;
|
||||
procedure SetValues(list: TList {of TCmdLineOptionValue}); override;
|
||||
procedure Serialize(list: TList {of TCmdLineOptionValue}); override;
|
||||
end;
|
||||
|
||||
procedure ReleaseScrollBox(box: TCmdLineScrollBoxControl);
|
||||
|
||||
implementation
|
||||
|
||||
procedure ReleaseScrollBox(box: TCmdLineScrollBoxControl);
|
||||
begin
|
||||
if not Assigned(box) then Exit;
|
||||
box.fScrollBox.Free;
|
||||
end;
|
||||
|
||||
{ TControlInfo }
|
||||
|
||||
constructor TControlInfo.Create(aopt: TCmdLineCfgOption; actrl: TControl);
|
||||
begin
|
||||
inherited Create;
|
||||
ctrl:=actrl;
|
||||
opt:=aopt;
|
||||
if aopt.Condition<>'' then
|
||||
check := TFPCConditionCheck.Create(aopt.Condition)
|
||||
else
|
||||
check:=nil;
|
||||
end;
|
||||
|
||||
destructor TControlInfo.Destroy;
|
||||
begin
|
||||
check.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TControlInfo.isAllowed(const cpu, os: string): Boolean;
|
||||
begin
|
||||
Result:=(not Assigned(check)) or (check.isValid(cpu, os));
|
||||
end;
|
||||
|
||||
{ TCmdLineScrollBoxControl }
|
||||
|
||||
procedure TCmdLineScrollBoxControl.OnChange(Sender: TObject);
|
||||
begin
|
||||
ValueChanged;
|
||||
end;
|
||||
|
||||
procedure TCmdLineScrollBoxControl.OnCndChange(Sender: TObject);
|
||||
begin
|
||||
OnChange(Sender);
|
||||
RevaluateConditions;
|
||||
end;
|
||||
|
||||
procedure TCmdLineScrollBoxControl.RevaluateConditions;
|
||||
var
|
||||
i : Integer;
|
||||
cpu : string;
|
||||
os : string;
|
||||
ci : TControlInfo;
|
||||
begin
|
||||
ci:=TControlInfo(fOptToCtrl.Find('-P'));
|
||||
if Assigned(ci) then SerializeAControl(ci.opt, ci.ctrl, cpu)
|
||||
else cpu:='';
|
||||
ci:=TControlInfo(fOptToCtrl.Find('-T'));
|
||||
if Assigned(ci) then SerializeAControl(ci.opt, ci.ctrl, os)
|
||||
else os:='';
|
||||
|
||||
for i:=0 to fOptToCtrl.Count-1 do begin
|
||||
ci:=TControlInfo(fOptToCtrl.Items[i]);
|
||||
if (ci.opt.Name='-P') or (ci.opt.Name='-T') then Continue;
|
||||
if Assigned(ci.check) then begin
|
||||
ci.ctrl.Enabled:=ci.isAllowed(cpu, os);
|
||||
end;
|
||||
//todo: values availability
|
||||
end;
|
||||
end;
|
||||
|
||||
function TCmdLineScrollBoxControl.AllocControls(AParent: TWinControl;
|
||||
VOffset: Integer; listofopt: TList): Integer;
|
||||
var
|
||||
i : Integer;
|
||||
y : Integer;
|
||||
opt : TCmdLineCfgOption;
|
||||
chk : TCheckBox;
|
||||
dd : TComboBox;
|
||||
YOffset : Integer;
|
||||
XOffset : Integer;
|
||||
lbl : TLabel;
|
||||
mctrl : TControl;
|
||||
edt : TEdit;
|
||||
begin
|
||||
y:=VOffset;
|
||||
YOffset:=0; //todo: get from the widgetset
|
||||
XOffset:=10;
|
||||
|
||||
for i:=0 to listofopt.Count-1 do begin
|
||||
mctrl:=nil;
|
||||
opt:=TCmdLineCfgOption(listofopt[i]);
|
||||
if opt.AliasToKey <>'' then Continue;
|
||||
|
||||
if opt.ValCount>0 then begin
|
||||
CreateComboBoxWithLabel(opt, APArent, dd, lbl);
|
||||
lbl.Left:=XOffset;
|
||||
lbl.Top:=y;
|
||||
dd.Style:=csDropDownList;
|
||||
dd.Top:=y;
|
||||
dd.Left:=lbl.Width;
|
||||
//todo: hardcoded key names :(
|
||||
if (opt.Name='-P') or (opt.Name='-T') then
|
||||
dd.OnSelect:=OnCndChange
|
||||
else
|
||||
dd.OnSelect:=OnChange;
|
||||
ControlSpanToRight(dd);
|
||||
AnchorControls(lbl, dd);
|
||||
mctrl:=dd;
|
||||
inc(y, dd.Height);
|
||||
end else if opt.OptType='switch' then begin
|
||||
CreateCheckBox(opt, AParent, true, chk);
|
||||
chk.Top:=y;
|
||||
chk.Left:=XOffset;
|
||||
chk.OnClick:=OnChange;
|
||||
mctrl:=chk;
|
||||
inc(y, chk.Height + YOffset);
|
||||
end else begin
|
||||
CreateEdit(opt, AParent, lbl, edt);
|
||||
edt.Top:=y;
|
||||
lbl.Top:=y;
|
||||
lbl.Left:=XOffset;
|
||||
mctrl:=edt;
|
||||
edt.OnEditingDone:=OnChange;
|
||||
AnchorControls(lbl, edt);
|
||||
ControlSpanToRight(edt);
|
||||
inc(y, edt.Height + YOffset);
|
||||
end;
|
||||
if Assigned(mctrl) then begin
|
||||
mctrl.Tag:=PtrUInt(opt);
|
||||
fControls.Add(mctrl);
|
||||
fOptToCtrl.Add( opt.Name, TControlInfo.Create(opt, mctrl) );
|
||||
end;
|
||||
end;
|
||||
Result:=y;
|
||||
end;
|
||||
|
||||
function TCmdLineScrollBoxControl.AllocHeaderLabel(AParent: TWinControl;
|
||||
VOffset: Integer; const Caption: String): Integer;
|
||||
var
|
||||
lbl : TLabel;
|
||||
begin
|
||||
inc(VOffset, 10);//todo: this information should come from a widgetset
|
||||
lbl:=TLabel.Create(APArent);
|
||||
lbl.Caption:=Caption;
|
||||
lbl.Parent:=AParent;
|
||||
lbl.Top:=VOffset;
|
||||
lbl.Left:=0;
|
||||
lbl.Width:=AParent.ClientWidth;
|
||||
lbl.Anchors:=lbl.Anchors+[akRight];
|
||||
lbl.Alignment:=taCenter;
|
||||
inc(VOffset, lbl.Height);
|
||||
Result:=VOffset;
|
||||
end;
|
||||
|
||||
function TCmdLineScrollBoxControl.AllocForSection(AParent: TWinControl; VOffset: Integer; sct : TLayoutSection; SkipHeader: Boolean ): Integer;
|
||||
var
|
||||
ls : TLayoutSection;
|
||||
sw : TStringList;
|
||||
y : Integer;
|
||||
l : TList;
|
||||
j : Integer;
|
||||
k : Integer;
|
||||
box : TGroupBox;
|
||||
by : integer;
|
||||
begin
|
||||
if not Assigned(sct) then begin
|
||||
Result:=VOffset;
|
||||
Exit;
|
||||
end;
|
||||
y:=VOffset;
|
||||
sw:=TStringList.Create;
|
||||
l:=TList.Create;
|
||||
try
|
||||
if (sct.Name<>'') and not SkipHeader then
|
||||
y:=AllocHeaderLabel(APArent, y, sct.Display);
|
||||
|
||||
for j:=0 to sct.ElemCount-1 do begin
|
||||
ls:=sct.Elements[j];
|
||||
if ls.ElementType=letSection then begin
|
||||
if l.Count>0 then begin
|
||||
y:=AllocControls(AParent, y, l);
|
||||
l.Clear;
|
||||
end;
|
||||
if ls.GUIHint='groupbox' then begin
|
||||
box := TGroupBox.Create(AParent);
|
||||
box.Parent:=AParent;
|
||||
box.Caption:=ls.Display;
|
||||
box.Width:=AParent.Width-10;
|
||||
box.Anchors:=box.Anchors+[akRight];
|
||||
by:=AllocForSection(box, 0, ls, true);
|
||||
box.Height:=by+22; //todo: define the border size by widgetset
|
||||
box.Top:=y;
|
||||
inc(y, box.Height);
|
||||
end else
|
||||
y:=AllocForSection(AParent, y, ls );
|
||||
end else begin
|
||||
k:=fusedoptlist.IndexOf(ls.Name);
|
||||
if (k>=0) then begin
|
||||
l.Add( fusedoptlist.Objects[k] );
|
||||
fusedoptlist.Delete(k);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
if l.Count>0 then y:=AllocControls(AParent, y, l);
|
||||
finally
|
||||
sw.Free;
|
||||
l.Free;
|
||||
Result:=y;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCmdLineScrollBoxControl.Reset;
|
||||
var
|
||||
i :Integer;
|
||||
begin
|
||||
for i:=0 to fControls.Count-1 do
|
||||
ResetValue(fControls[i]);
|
||||
|
||||
end;
|
||||
|
||||
constructor TCmdLineScrollBoxControl.Create(AParent: TWinControl);
|
||||
begin
|
||||
inherited Create;
|
||||
fScrollBox := TScrollBox.Create(AParent);
|
||||
fScrollBox.Align:=alClient;
|
||||
fScrollBox.Parent:=AParent;
|
||||
fScrollBox.VertScrollBar.Tracking:=true;
|
||||
fControls:=TList.Create;
|
||||
fOptToCtrl:=TFPHashObjectList.Create(true);
|
||||
end;
|
||||
|
||||
destructor TCmdLineScrollBoxControl.Destroy;
|
||||
begin
|
||||
// fill not free fScrollBox as it should be destroyed by the parent
|
||||
fOptToCtrl.Free;
|
||||
fControls.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TCmdLineScrollBoxControl.Init(cfg: TCmdLineCfg; layout: TCmdLineLayoutInfo);
|
||||
var
|
||||
i : Integer;
|
||||
opt : TCmdLineCfgOption;
|
||||
list : TStringList;
|
||||
l : TList;
|
||||
nm : string;
|
||||
y : Integer;
|
||||
begin
|
||||
if not Assigned(cfg) then Exit;
|
||||
fCfg:=cfg;
|
||||
list:=TStringList.Create;
|
||||
list.CaseSensitive:=true; // must be case sensitive
|
||||
l:=TList.Create;
|
||||
fOptToCtrl.Clear;
|
||||
fusedoptlist:=list;
|
||||
flayout:=layout;
|
||||
try
|
||||
y:=24;
|
||||
for i:=0 to cfg.Options.Count-1 do begin
|
||||
opt:=TCmdLineCfgOption(cfg.Options[i]);
|
||||
nm:=opt.Name;
|
||||
if nm='' then nm:=opt.Key;
|
||||
list.AddObject(nm, cfg.Options[i]);
|
||||
end;
|
||||
|
||||
if Assigned(layout) then y:=AllocForSection(fScrollBox, y, layout.GetSection(''));
|
||||
if Assigned(layout) then begin
|
||||
y:=AllocHeaderLabel(fScrollBox, y, 'Other');
|
||||
end;
|
||||
l.Clear;
|
||||
for i:=0 to list.Count-1 do
|
||||
l.Add(list.Objects[i]);
|
||||
AllocControls(fScrollBox, y, l);
|
||||
finally
|
||||
fusedoptlist:=nil;
|
||||
flayout:=nil;
|
||||
l.Free;
|
||||
list.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCmdLineScrollBoxControl.SetValues(list: TList);
|
||||
var
|
||||
vl : TCmdLineOptionValue;
|
||||
ctrl : TControl;
|
||||
i : Integer;
|
||||
mlt : TFPHashList;
|
||||
isPath : Boolean;
|
||||
const
|
||||
Delims : array [Boolean] of string = (' ', ';');
|
||||
begin
|
||||
if not Assigned(fCfg) or not Assigned(list) then Exit;
|
||||
Reset;
|
||||
mlt:=TFPHashList.Create;
|
||||
try
|
||||
for i:=0 to list.Count-1 do begin
|
||||
vl:=TCmdLineOptionValue(list[i]);
|
||||
if not Assigned(vl.Option) then Continue;
|
||||
ctrl:=TControlInfo(fOptToCtrl.Find(vl.Option.Name)).ctrl;
|
||||
if not Assigned(ctrl) then Continue;
|
||||
if ctrl is TComboBox then SetValueComboBox(vl.Option, vl.Value, TComboBoX(ctrl))
|
||||
else if ctrl is TCheckBox then SetValueCheckBox(vl.Option, vl.Value, TCheckBox(ctrl))
|
||||
else if ctrl is TEdit and not vl.Option.isMultiple then SetValueEdit(vl.Option, vl.Value, TEdit(ctrl))
|
||||
else if ctrl is TEdit and vl.Option.isMultiple then begin
|
||||
if mlt.FindIndexOf(vl.Option.Name) <0 then begin
|
||||
TEdit(ctrl).Text:='';
|
||||
mlt.Add(vl.Option.Name, ctrl);
|
||||
end;
|
||||
isPath:=(vl.Option.OptType='dirpath') or (vl.Option.OptType='filepath');
|
||||
SetMultiValueEdit(vl.Option, vl.Value, Delims[isPath], TEdit(ctrl));
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
mlt.Free;
|
||||
end;
|
||||
RevaluateConditions;
|
||||
end;
|
||||
|
||||
procedure TCmdLineScrollBoxControl.Serialize(list: TList);
|
||||
var
|
||||
i : Integer;
|
||||
vl : TCmdLineOptionValue;
|
||||
opt : TCmdLineCfgOption;
|
||||
ctrl : TControl;
|
||||
v : string;
|
||||
dlm : char;
|
||||
begin
|
||||
if not Assigned(fCfg) then Exit;
|
||||
for i:=0 to fControls.Count-1 do begin
|
||||
ctrl:=TControl(fControls[i]);
|
||||
opt:=TCmdLineCfgOption(ctrl.Tag);
|
||||
if not Assigned(opt) then Continue;
|
||||
if SerializeAControl(opt, ctrl, v) then begin
|
||||
if opt.isMultiple then begin
|
||||
if (opt.OptType = 'filepath') or (opt.OptType='dirpath') then dlm:=';' else dlm:=' ';
|
||||
CmdLineAllocMultiValues(opt, v, dlm, list);
|
||||
end else
|
||||
list.Add( TCmdLineOptionValue.Create(opt, v));
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
233
components/cmdlinecfg/trunk/cmdlinelclpropgrid.pas
Normal file
233
components/cmdlinecfg/trunk/cmdlinelclpropgrid.pas
Normal file
@ -0,0 +1,233 @@
|
||||
unit cmdlinelclpropgrid;
|
||||
|
||||
//todo: this unit is incomplete
|
||||
{$mode delphi}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Controls, ValEdit, StdCtrls
|
||||
, cmdlinecfg, cmdlinecfgui;
|
||||
|
||||
type
|
||||
|
||||
{ TCmdLineGridControl }
|
||||
|
||||
TCmdLineGridControl = class(TCmdLineUIControl)
|
||||
private
|
||||
fPropGrid : TValueListEditor;
|
||||
fCfg : TCmdLineCfg;
|
||||
fDropdown : TComboBox;
|
||||
fEditCol,fEditRow: Integer;
|
||||
public
|
||||
procedure OnSelectEditor(Sender: TObject; aCol, aRow: Integer; var Editor: TWinControl);
|
||||
procedure OnHeaderSizing(sender: TObject; const IsColumn: boolean;
|
||||
const aIndex, aSize: Integer) ;
|
||||
procedure OnEditingDone(Sender: TObject);
|
||||
procedure OnDDKeyPress(Sender: TObject; var Key: char);
|
||||
procedure OnDDSelect(Sender: TObject);
|
||||
procedure OnExit(Sender: TObject);
|
||||
procedure OnCanSelect(Sender: TObject; aCol, aRow: Integer; var CanSelect: Boolean);
|
||||
procedure OnTopLeftChanged(Sender: TObject);
|
||||
|
||||
procedure UpdateEditorBounds;
|
||||
procedure UpdateValue(aCol, arow: Integer; const newval: string; NotifyChange: Boolean = true);
|
||||
public
|
||||
constructor Create(AParent: TWinControl);
|
||||
procedure Init(cfg: TCmdLineCfg; layout: TCmdLineLayoutInfo); override;
|
||||
procedure SetValues(list: TList {of TCmdLineOptionValue}); override;
|
||||
procedure Serialize(list: TList {of TCmdLineOptionValue}); override;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TCmdLineGridControl }
|
||||
|
||||
procedure TCmdLineGridControl.OnSelectEditor(Sender: TObject; aCol,
|
||||
aRow: Integer; var Editor: TWinControl);
|
||||
var
|
||||
i : Integer;
|
||||
opt : TCmdLineCfgOption;
|
||||
dd : TComboBox;
|
||||
j : integer;
|
||||
nm : string;
|
||||
begin
|
||||
if not Assigned(fCfg) then Exit;
|
||||
|
||||
i:=aRow-1;
|
||||
if (i<0) or (i>=fCfg.Options.Count) then Exit;
|
||||
opt:=TCmdLineCfgOption(fPropGrid.Objects[aCol, aRow]);
|
||||
if not Assigned(opt) then Exit;
|
||||
|
||||
fEditCol:=aCol;
|
||||
fEditRow:=aRow;
|
||||
if (opt.OptType='switch') or (opt.ValCount>0) then begin
|
||||
if not Assigned(fDropdown) then begin
|
||||
dd:=TComboBox.Create(fPropGrid);
|
||||
dd.OnSelect:=OnDDSelect;
|
||||
dd.OnKeyPress:=OnDDKeyPress;
|
||||
dd.OnExit:=OnExit;
|
||||
fDropdown:=dd;
|
||||
end else
|
||||
dd:=fDropdown;
|
||||
dd.Style:=csDropDownList;
|
||||
dd.Items.Clear;
|
||||
if opt.OptType='switch' then begin
|
||||
dd.Items.Add('false');
|
||||
dd.Items.Add('true');
|
||||
end else if opt.ValCount>0 then
|
||||
for j:=0 to opt.ValCount-1 do begin
|
||||
nm:=opt.Values[j].DisplayName;
|
||||
if nm='' then nm:=opt.Values[j].CmdLineValue;
|
||||
dd.Items.Add(nm);
|
||||
end;
|
||||
dd.ItemIndex:=dd.Items.IndexOf( fPropGrid.Cells[aCol, aRow]);
|
||||
dd.BoundsRect:=fPropGrid.CellRect(aCol,Arow);
|
||||
Editor:=dd;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCmdLineGridControl.OnEditingDone(Sender: TObject);
|
||||
begin
|
||||
if not Assigned(fCfg) then Exit;
|
||||
if Assigned(fDropdown) and (fDropdown.Visible) then begin
|
||||
fDropdown.Hide;
|
||||
UpdateValue(fEditCol, fEditRow, fDropdown.Text);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCmdLineGridControl.OnDDKeyPress(Sender: TObject; var Key: char);
|
||||
begin
|
||||
if Key=#13 then begin
|
||||
fPropGrid.EditingDone;
|
||||
fDropdown.Hide;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCmdLineGridControl.OnDDSelect(Sender: TObject);
|
||||
begin
|
||||
|
||||
UpdateValue(fEditCol, fEditRow, fDropdown.Text);
|
||||
end;
|
||||
|
||||
procedure TCmdLineGridControl.OnExit(Sender: TObject);
|
||||
begin
|
||||
if Assigned(fDropDown) then fDropdown.Hide;
|
||||
end;
|
||||
|
||||
procedure TCmdLineGridControl.OnCanSelect(Sender: TObject; aCol, aRow: Integer;
|
||||
var CanSelect: Boolean);
|
||||
begin
|
||||
CanSelect:=aCol>0;
|
||||
end;
|
||||
|
||||
procedure TCmdLineGridControl.OnTopLeftChanged(Sender: TObject);
|
||||
begin
|
||||
UpdateEditorBounds;
|
||||
end;
|
||||
|
||||
procedure TCmdLineGridControl.UpdateEditorBounds;
|
||||
begin
|
||||
if Assigned(fPropGrid.Editor) then begin
|
||||
fPropGrid.Editor.BoundsRect:=fPropGrid.CellRect(fEditCol,fEditRow);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCmdLineGridControl.UpdateValue(aCol, arow: Integer;
|
||||
const newval: string; NotifyChange: Boolean );
|
||||
begin
|
||||
fPropGrid.Cells[aCol, aRow]:=newval;
|
||||
if NotifyChange then ValueChanged;
|
||||
end;
|
||||
|
||||
procedure TCmdLineGridControl.OnHeaderSizing(sender: TObject;
|
||||
const IsColumn: boolean; const aIndex, aSize: Integer);
|
||||
begin
|
||||
UpdateEditorBounds;
|
||||
end;
|
||||
|
||||
constructor TCmdLineGridControl.Create(AParent: TWinControl);
|
||||
begin
|
||||
inherited Create;
|
||||
fPropGrid:=TValueListEditor.Create(AParent);
|
||||
fPropGrid.Parent:=AParent;
|
||||
fPropGrid.Align:=alClient;
|
||||
fPropGrid.OnSelectEditor:=Self.OnSelectEditor;
|
||||
fPropGrid.OnHeaderSizing:=OnHeaderSizing;
|
||||
fPropGrid.OnEditingDone:=OnEditingDone;
|
||||
fPropGrid.OnExit:=OnExit;
|
||||
fPropGrid.OnSelectCell:=OnCanSelect;
|
||||
fPropGrid.OnTopLeftChanged:=OnTopLeftChanged;
|
||||
fPropGrid.OnResize:=OnTopLeftChanged;
|
||||
end;
|
||||
|
||||
procedure TCmdLineGridControl.Init(cfg: TCmdLineCfg; layout: TCmdLineLayoutInfo);
|
||||
var
|
||||
i : integer;
|
||||
j : integer;
|
||||
opt : TCmdLineCfgOption;
|
||||
chk : TCheckBox;
|
||||
cr : TRect;
|
||||
begin
|
||||
// todo: Clean if exists
|
||||
fCfg:=cfg;
|
||||
if Assigned(fcfg) then begin
|
||||
fPropGrid.BeginUpdate;
|
||||
try
|
||||
fPropGrid.RowCount:=cfg.Options.Count+1;
|
||||
j:=1;
|
||||
for i:=0 to cfg.Options.Count-1 do begin
|
||||
opt:=TCmdLineCfgOption(cfg.Options[i]);
|
||||
if opt.AliasToKey <>'' then Continue;
|
||||
fPropGrid.Keys[j]:=opt.Display;
|
||||
fPropGrid.Objects[1, j]:=opt;
|
||||
if opt.OptType='switch' then begin
|
||||
fPropGrid.Values[opt.Display]:='false';
|
||||
end;
|
||||
inc(j);
|
||||
end;
|
||||
fPropGrid.RowCount:=j;
|
||||
finally
|
||||
fPropGrid.EndUpdate;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCmdLineGridControl.SetValues(list: TList);
|
||||
begin
|
||||
if not Assigned(fCfg) then Exit;
|
||||
|
||||
end;
|
||||
|
||||
procedure TCmdLineGridControl.Serialize(list: TList);
|
||||
var
|
||||
i : Integer;
|
||||
j : Integer;
|
||||
vl : TCmdLineOptionValue;
|
||||
opt : TCmdLineCfgOption;
|
||||
v : string;
|
||||
begin
|
||||
if not Assigned(fCfg) then Exit;
|
||||
for i:=1 to fPropGrid.RowCount-1 do begin
|
||||
opt:=TCmdLineCfgOption(fPropGrid.Objects[1, i]);
|
||||
if not Assigned(opt) then Continue;
|
||||
vl := TCmdLineOptionValue.Create;
|
||||
if opt.ValCount>0 then begin
|
||||
v:=fPropGrid.Cells[1, i];
|
||||
for j:=0 to opt.ValCount-1 do
|
||||
if ((opt.Values[j].DisplayName <> '') and (opt.Values[j].DisplayName=v)) or (opt.Values[j].CmdLineValue=v) then begin
|
||||
vl.Value:=opt.Values[j].CmdLineValue;
|
||||
Break;
|
||||
end;
|
||||
end else
|
||||
vl.Value:=fPropGrid.Cells[1, i];
|
||||
vl.Option:=opt;
|
||||
if vl.Option.OptType='switch' then begin
|
||||
if vl.Value='false' then vl.Value:='' else vl.Value:='1';
|
||||
end;
|
||||
list.Add(vl);
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
217
components/cmdlinecfg/trunk/cmdlinelclutils.pas
Normal file
217
components/cmdlinecfg/trunk/cmdlinelclutils.pas
Normal file
@ -0,0 +1,217 @@
|
||||
unit cmdlinelclutils;
|
||||
|
||||
interface
|
||||
|
||||
uses Controls, SysUtils, StdCtrls, Classes, cmdlinecfg;
|
||||
|
||||
var
|
||||
ADirsDialogs : function (var path: string): Boolean = nil;
|
||||
AFilesDialogs : function (var path: string): Boolean = nil;
|
||||
|
||||
procedure CreateComboBoxWithLabel(opt: TCmdLineCfgOption; AOwner: TWinControl; var combo: TComboBox; var lbl: TLabel);
|
||||
procedure CreateComboBox(opt: TCmdLineCfgOption; AOwner: TWinControl; var combo: TComboBox);
|
||||
procedure CreateCheckBox(opt: TCmdLineCfgOption; AOwner: TWinControl; SetCaptionToDisplay: Boolean; var chk: TCheckBox);
|
||||
procedure AnchorControls(left, right: TControl; Spacing: Integer = 10);
|
||||
procedure ControlSpanToRight(ctrl: TControl; XOffset: Integer = 10);
|
||||
function SerializeComboBox(opt: TCmdLineCfgOption; combo: TComboBox): string;
|
||||
function SerializeCheckBox(opt: TCmdLineCfgOption; chk: TCheckBox): string;
|
||||
function SerializeEdit(opt: TCmdLineCfgOption; edt: TEdit): string;
|
||||
procedure SetValueComboBox(opt: TCmdLineCfgOption; const vl: string; combo: TComboBox);
|
||||
procedure SetValueCheckBox(opt: TCmdLineCfgOption; const vl: string; chk: TCheckBox);
|
||||
procedure SetValueEdit(opt: TCmdLineCfgOption; const vl: string; edt: TEdit);
|
||||
procedure SetMultiValueEdit(opt: TCmdLineCfgOption; const vl: string; const Delim: string; edt: TEdit);
|
||||
|
||||
procedure ResetValue(ctrl: TControl);
|
||||
function SerializeAControl(opt: TCmdLineCfgOption; ctrl: TControl; var v: string): Boolean;
|
||||
|
||||
type
|
||||
TEditPathsOpt = (epoSingleFileOnly, epoSingleDirOnly, epoFilesOnly, epoDirsOnly);
|
||||
|
||||
function ExecuteEditPathsDialogs(var path: string; DialogOption: TEditPathsOpt ): Boolean;
|
||||
procedure CreatePathsEdit(opt: TCmdLineCfgOption; AOwner: TWinControl;
|
||||
var lbl: TLabel; var edit: TEdit; var lookupbtn: TButton);
|
||||
procedure CreateEdit(opt: TCmdLineCfgOption; AOwner: TWinControl; var lbl: TLabel; var edit: TEdit);
|
||||
|
||||
function OptKeyLabel(opt: TCmdLineCfgOption): string;
|
||||
|
||||
implementation
|
||||
|
||||
function OptKeyLabel(opt: TCmdLineCfgOption): string;
|
||||
begin
|
||||
if not Assigned(opt) then Result:=''
|
||||
else Result:='('+StringReplace(opt.key, '%value%','', [rfIgnoreCase, rfReplaceAll])+')';
|
||||
end;
|
||||
|
||||
procedure AnchorControls(left, right: TControl; Spacing: Integer);
|
||||
begin
|
||||
right.AnchorSideLeft.Control:=left;
|
||||
right.AnchorSideLeft.Side:=asrRight;
|
||||
right.BorderSpacing.Left:=Spacing;
|
||||
end;
|
||||
|
||||
function SerializeEdit(opt: TCmdLineCfgOption; edt: TEdit): string;
|
||||
begin
|
||||
Result:=edt.Text;
|
||||
end;
|
||||
|
||||
procedure SetValueComboBox(opt: TCmdLineCfgOption; const vl: string; combo: TComboBox);
|
||||
var
|
||||
j : Integer;
|
||||
begin
|
||||
if vl='' then begin
|
||||
combo.ItemIndex:=-1;
|
||||
Exit;
|
||||
end;
|
||||
for j:=0 to opt.ValCount-1 do begin
|
||||
if (opt.Values[j].CmdLineValue =vl) then begin
|
||||
if j<=combo.Items.Count then begin
|
||||
combo.ItemIndex:=j;
|
||||
end;
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure SetValueCheckBox(opt: TCmdLineCfgOption; const vl: string; chk: TCheckBox);
|
||||
begin
|
||||
chk.Checked:=vl<>'';
|
||||
end;
|
||||
|
||||
procedure SetValueEdit(opt: TCmdLineCfgOption; const vl: string; edt: TEdit);
|
||||
begin
|
||||
edt.Text:=vl;
|
||||
end;
|
||||
|
||||
procedure SetMultiValueEdit(opt: TCmdLineCfgOption; const vl: string;
|
||||
const Delim: string; edt: TEdit);
|
||||
begin
|
||||
if vl<>'' then begin
|
||||
if edt.Text<>'' then edt.Text:=edt.Text+Delim+vl
|
||||
else edt.Text:=vl;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure ControlSpanToRight(ctrl: TControl; XOffset: Integer = 10);
|
||||
begin
|
||||
if not Assigned(ctrl) or not Assigned(ctrl.Parent) then Exit;
|
||||
ctrl.Anchors:=ctrl.Anchors-[akRight];
|
||||
ctrl.Width:=ctrl.Parent.ClientWidth-ctrl.Left-XOffset;
|
||||
ctrl.Anchors:=ctrl.Anchors+[akRight];
|
||||
end;
|
||||
|
||||
function ExecuteEditPathsDialogs(var path: string; DialogOption: TEditPathsOpt
|
||||
): Boolean;
|
||||
begin
|
||||
case DialogOption of
|
||||
epoSingleFileOnly: begin
|
||||
|
||||
end;
|
||||
epoSingleDirOnly: begin
|
||||
|
||||
end;
|
||||
epoDirsOnly: if not Assigned(ADirsDialogs) then Result:=false
|
||||
else Result:=ADirsDialogs(path);
|
||||
epoFilesOnly: if not Assigned(AFilesDialogs) then Result:=false;
|
||||
else Result:=AFilesDialogs(path);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure CreatePathsEdit(opt: TCmdLineCfgOption; AOwner: TWinControl;
|
||||
var lbl: TLabel; var edit: TEdit; var lookupbtn: TButton);
|
||||
begin
|
||||
lbl:=TLabel.Create(AOwner);
|
||||
lbl.Caption:=opt.Display+' '+OptKeyLabel(opt);
|
||||
edit:=TEdit.Create(AOwner);
|
||||
lookupbtn:=TButton.Create(AOwner);
|
||||
lookupbtn.Caption:='...';
|
||||
lookupbtn.AutoSize:=true;
|
||||
AnchorControls(lbl, edit);
|
||||
AnchorControls(edit, lookupbtn);
|
||||
end;
|
||||
|
||||
procedure CreateEdit(opt: TCmdLineCfgOption; AOwner: TWinControl; var lbl: TLabel; var edit: TEdit);
|
||||
begin
|
||||
lbl:=TLabel.Create(AOwner);
|
||||
lbl.Caption:=opt.Display+' '+OptKeyLabel(opt);
|
||||
edit:=TEdit.Create(AOwner);
|
||||
edit.Parent:=AOwner;
|
||||
lbl.Parent:=AOwner;
|
||||
end;
|
||||
|
||||
procedure CreateComboBoxWithLabel(opt: TCmdLineCfgOption; AOwner: TWinControl;
|
||||
var combo: TComboBox; var lbl: TLabel);
|
||||
begin
|
||||
lbl:=TLabel.Create(AOwner);
|
||||
lbl.Caption:=opt.Display + ' '+OptKeyLabel(opt);
|
||||
lbl.Parent:=AOwner;
|
||||
CreateComboBox(opt, AOwner, combo);
|
||||
end;
|
||||
|
||||
procedure CreateComboBox(opt: TCmdLineCfgOption; AOwner: TWinControl; var combo: TComboBox);
|
||||
var
|
||||
dd : TComboBox;
|
||||
j : Integer;
|
||||
nm : string;
|
||||
begin
|
||||
dd:=TComboBox.Create(AOwner);
|
||||
for j:=0 to opt.ValCount-1 do begin
|
||||
nm:=opt.Values[j].DisplayName;
|
||||
if nm='' then nm:=opt.Values[j].CmdLineValue;
|
||||
dd.Items.Add(nm);
|
||||
end;
|
||||
dd.Parent:=AOwner;
|
||||
combo:=dd;
|
||||
end;
|
||||
|
||||
function SerializeComboBox(opt: TCmdLineCfgOption; combo: TComboBox): string;
|
||||
var
|
||||
vl : string;
|
||||
j : Integer;
|
||||
begin
|
||||
vl:=combo.Text;
|
||||
Result:='';
|
||||
if vl='' then Exit;
|
||||
for j:=0 to opt.ValCount-1 do
|
||||
if (opt.Values[j].DisplayName='') then begin
|
||||
if (opt.Values[j].CmdLineValue =vl) then begin
|
||||
Result:=vl;
|
||||
Exit;
|
||||
end;
|
||||
end else if (opt.Values[j].DisplayName=vl) then begin
|
||||
Result:=opt.Values[j].CmdLineValue;
|
||||
Exit;
|
||||
end;
|
||||
Result:=vl;
|
||||
end;
|
||||
|
||||
procedure CreateCheckBox(opt: TCmdLineCfgOption; AOwner: TWinControl;
|
||||
SetCaptionToDisplay: Boolean; var chk: TCheckBox);
|
||||
begin
|
||||
chk := TCheckBox.Create(AOwner);
|
||||
if SetCaptionToDisplay then chk.Caption:=opt.Display+' '+ OptKeyLabel(opt);
|
||||
chk.Parent:=AOwner;
|
||||
end;
|
||||
|
||||
function SerializeCheckBox(opt: TCmdLineCfgOption; chk: TCheckBox): string;
|
||||
begin
|
||||
if chk.Checked then Result:='1' else Result:='';
|
||||
end;
|
||||
|
||||
procedure ResetValue(ctrl: TControl);
|
||||
begin
|
||||
if ctrl is TEdit then TEdit(ctrl).Text:=''
|
||||
else if ctrl is TCheckBox then TCheckBox(ctrl).Checked:=false
|
||||
else if ctrl is TComboBox then TComboBox(ctrl).ItemIndex:=-1;
|
||||
end;
|
||||
|
||||
function SerializeAControl(opt: TCmdLineCfgOption; ctrl: TControl; var v: string): Boolean;
|
||||
begin
|
||||
v:='';
|
||||
Result:=true;
|
||||
if ctrl is TComboBox then v:=SerializeComboBox(opt, TComboBox(ctrl))
|
||||
else if ctrl is TCheckBox then v:=SerializeCheckBox(opt, TCheckBox(ctrl))
|
||||
else if ctrl is TEdit then v:=SerializeEdit(opt, TEdit(ctrl))
|
||||
else Result:=false;
|
||||
end;
|
||||
|
||||
end.
|
||||
327
components/cmdlinecfg/trunk/fpc.copt
Normal file
327
components/cmdlinecfg/trunk/fpc.copt
Normal file
@ -0,0 +1,327 @@
|
||||
{
|
||||
"executable":"fpc",
|
||||
"version":"2.6.0",
|
||||
"testkey":"-iV",
|
||||
"testValue":"2.6.0",
|
||||
"options": [
|
||||
{ "key":"-a", "display":"The compiler doesn't delete the generated assembler file" }
|
||||
,{"key":"-al", "display":"List sourcecode lines in assembler file", "masterkey":"-a"}
|
||||
,{"key":"-an", "display":"List node info in assembler file", "masterkey":"-a" }
|
||||
,{"key":"-ar", "display":"List register allocation/release info in assembler file", "masterkey":"-a"}
|
||||
,{"key":"-at", "display":"List temp allocation/release info in assembler file", "masterkey":"-a"}
|
||||
,{"key":"-A%value%", "display":"Output format:",
|
||||
"options": [
|
||||
{ "value": "default", "display":"Use default assembler" }
|
||||
,{ "value": "as", "display":"Assemble using GNU AS" }
|
||||
,{ "value": "macho", "display":"Mach-O (Darwin, Intel 32 bit) using internal writer" }
|
||||
,{ "value": "nasmcoff", "display":"COFF (Go32v2) file using Nasm" }
|
||||
,{ "value": "nasmelf", "display":"ELF32 (Linux) file using Nasm" }
|
||||
,{ "value": "nasmwin32Win32", "display":"object file using Nasm" }
|
||||
,{ "value": "nasmwdosxWin32/WDOSX", "display":"object file using Nasm" }
|
||||
,{ "value": "wasm", "display":"Obj file using Wasm (Watcom)" }
|
||||
,{ "value": "nasmobj", "display":"Obj file using Nasm" }
|
||||
,{ "value": "masm", "display":"Obj file using Masm (Microsoft)" }
|
||||
,{ "value": "tasm", "display":"Obj file using Tasm (Borland)" }
|
||||
,{ "value": "elf", "display":"ELF (Linux) using internal writer" }
|
||||
,{ "value": "coff", "display":"COFF (Go32v2) using internal writer" }
|
||||
,{ "value": "pecoff", "display":"PE-COFF (Win32) using internal writer" }
|
||||
]}
|
||||
,{ "key":"-b", "display": "Generate browser info" }
|
||||
,{ "key":"-bl", "display": "Generate local symbol info" }
|
||||
,{ "key":"-B", "display": "Build all modules" }
|
||||
,{ "key":"-C3", "display": "Turn on ieee error checking for constants" }
|
||||
,{ "key":"-Ca%value%", "display":"Select ABI, see fpc -i for possible values"
|
||||
,"options": [
|
||||
{"value": "DEFAULT"}
|
||||
,{"value": "SYSV"}
|
||||
,{"value": "AIX"}
|
||||
,{"value": "EABI"}
|
||||
,{"value": "ARMEB"}
|
||||
]}
|
||||
,{ "key":"-Cb", "display":"Generate big-endian code" }
|
||||
,{ "key":"-Cc%value%", "display":"Set default calling convention.", "type":"string" }
|
||||
,{ "key":"-CD", "display":"Create also dynamic library (not supported)" }
|
||||
,{ "key":"-Ce", "display":"Compilation with emulated floating point opcodes" }
|
||||
,{ "key":"-Cf%value%", "display":"Select fpu instruction set to use"
|
||||
,"options": [
|
||||
{"value":"X87"}
|
||||
,{"value":"SSE"}
|
||||
,{"value":"SSE2"}
|
||||
,{"value":"SSE3"}
|
||||
]}
|
||||
,{ "key":"-CF%value%", "display":"Minimal floating point constant precision"
|
||||
,"options": [
|
||||
{"value":"default"}
|
||||
,{"value":"32"}
|
||||
,{"value":"64"}
|
||||
]}
|
||||
,{ "key":"-Cg", "display":"Generate PIC code" }
|
||||
,{ "key":"-Ch%value%", "display":"Bytes heap (between 1023 and 67107840)"
|
||||
, "type":"bytesize" }
|
||||
,{ "key":"-Ci", "display":"IO-checking" }
|
||||
,{ "key":"-Cn", "display":"Omit linking stage" }
|
||||
,{ "key":"-Co", "display":"Check overflow of integer operations" }
|
||||
,{ "key":"-CO", "display":"Check for possible overflow of integer operations" }
|
||||
,{ "key":"-Cp%value%", "display":"Select instruction set"
|
||||
,"options": [
|
||||
{"value":"386"}
|
||||
,{"value":"PENTIUM"}
|
||||
,{"value":"PENTIUM2"}
|
||||
,{"value":"PENTIUM3"}
|
||||
,{"value":"PENTIUM4"}
|
||||
,{"value":"PENTIUMM"}
|
||||
]}
|
||||
,{ "key":"-CPPACKSET=%value%", "display":"Packing of sets"
|
||||
,"options": [
|
||||
{"value":"0"}
|
||||
,{"value":"1"}
|
||||
,{"value":"DEFAULT"}
|
||||
,{"value":"NORMAL"}
|
||||
,{"value":"2"}
|
||||
,{"value":"4"}
|
||||
,{"value":"8"}
|
||||
]}
|
||||
,{ "key":"-Cr", "display":"Range checking" }
|
||||
,{ "key":"-CR", "display":"Verify object method call validity" }
|
||||
,{ "key":"-Cs%value%", "display":"Set stack checking size", "type":"bytesize" }
|
||||
,{ "key":"-Ct", "display":"Stack checking (for testing only, see manual)" }
|
||||
,{ "key":"-CX", "display":"Create also smartlinked library" }
|
||||
,{ "key":"-d%value%", "display":"Defines the symbol <x>", "multiple":true, type:"string" }
|
||||
,{ "key":"-D", "display":"Generate a DEF file" }
|
||||
,{ "key":"-Dd%value%", "display":"Set description", "type":"string" }
|
||||
,{ "key":"-Dv%value%", "display":"Set DLL version", "type":"string" }
|
||||
,{ "key":"-e%value%", "display":"Set path to executable", "type":"filepath" }
|
||||
,{ "key":"-E", "alias":"-E" }
|
||||
,{ "key":"-fPIC", "alias":"-Cg" }
|
||||
|
||||
,{ "key":"-Fa%value%", "display":"(for a program) load units <x> and [y] before uses is parsed", "type": "string", "multiple": true }
|
||||
,{ "key":"-Fc%value%", "display":"Set input codepage to <x>", type:"string"}
|
||||
,{ "key":"-FC%value%", "display":"Set RC compiler binary name to <x>", type:"string" }
|
||||
,{ "key":"-Fd", "display":"Disable the compiler's internal directory cache" }
|
||||
,{ "key":"-FD%value%", "display":"Set the directory where to search for compiler utilities", type:"dirpath", "multiple": true }
|
||||
,{ "key":"-Fe%value%", "display":"Redirect error output to <x>", type:"filepath" }
|
||||
,{ "key":"-Ff%value%", "display":"Add <x> to framework path", type:"string", "multiple": true
|
||||
,"condition":"darwin" }
|
||||
,{ "key":"-FE%value%", "display":"Set exe/unit output path to <x>", type: "dirpath" }
|
||||
,{ "key":"-Fi%value%", "display":"Add <x> to include path", type: "dirpath", "multiple": true }
|
||||
,{ "key":"-Fl%value%", "display":"Add <x> to library path", type: "dirpath", "multiple": true }
|
||||
,{ "key":"-FL%value%", "display":"Use <x> as dynamic linker", type: "string" }
|
||||
,{ "key":"-Fm%value%", "display":"Load unicode conversion table from <x>.txt in the compiler dir", type: "filepath" }
|
||||
,{ "key":"-Fo%value%", "display":"Add <x> to object path", type: "dirpath", "multiple": true }
|
||||
,{ "key":"-Fr%value%", "display":"Load error message file <x>", type: "filepath" }
|
||||
,{ "key":"-FR%value%", "display":"Set resource (.res) linker to <x>", type: "filepath" }
|
||||
,{ "key":"-Fu%value%", "display":"Add <x> to unit path", type: "dirpath", "multiple": true }
|
||||
,{ "key":"-FU%value%", "display":"Set unit output path to <x>", type: "dirpath" }
|
||||
,{ "key":"-FW%value%", "display":"Store generated whole-program optimization feedback in <x>", type: "filepath" }
|
||||
,{ "key":"-Fw%value%", "display":"Load previously stored whole-program optimization feedback from <x>", type: "filepath" }
|
||||
|
||||
,{ "key":"-g", "display":"Generate debug information (default format for target)" }
|
||||
,{ "key":"-gc", "display":"Generate checks for pointers" }
|
||||
,{ "key":"-gh", "display":"Use heaptrace unit (for memory leak/corruption debugging)" }
|
||||
,{ "key":"-gl", "display":"Use line info unit (show more info with backtraces)" }
|
||||
,{ "key":"-godwarfsets", "display":"Enable DWARF 'set' type debug information (breaks gdb < 6.5)" }
|
||||
,{ "key":"-gostabsabsincludes", "display":"Store absolute/full include file paths in Stabs" }
|
||||
,{ "key":"-godwarfmethodclassprefix", "display":"Prefix method names in DWARF with class name" }
|
||||
,{ "key":"-gp", "display":"Preserve case in stabs symbol names" }
|
||||
,{ "key":"-gs", "display":"Generate Stabs debug information" }
|
||||
,{ "key":"-gt", "display":"Trash local variables (to detect uninitialized uses)" }
|
||||
,{ "key":"-gv", "display":"Generates programs traceable with Valgrind" }
|
||||
,{ "key":"-gw", "alias":"-gw2" }
|
||||
,{ "key":"-gw2", "display":"Generate DWARFv2 debug information" }
|
||||
,{ "key":"-gw3", "display":"Generate DWARFv3 debug information" }
|
||||
,{ "key":"-gw4", "display":"Generate DWARFv4 debug information (experimental)" }
|
||||
,{ "key":"-I%value%", "display":"Add <x> to include path", "type":"dirpath", "multiple":true }
|
||||
,{ "key":"-k%value%", "display":"Pass <x> to the linker", "type":"string", "multiple":true }
|
||||
,{ "key":"-M%value%", "display":"Set language mode to <x>"
|
||||
,"options": [
|
||||
{ "value":"fpc", "display":"Free Pascal dialect (default)" }
|
||||
,{ "value":"objfpc", "display":"FPC mode with Object Pascal support" }
|
||||
,{ "value":"delphi", "display":"Delphi 7 compatibility mode" }
|
||||
,{ "value":"tp", "display":"TP/BP 7.0 compatibility mode" }
|
||||
,{ "value":"macpas", "display":"Macintosh Pascal dialects compatibility mode" }
|
||||
]}
|
||||
,{ "key":"-n", "display":"Do not read the default config files" }
|
||||
,{ "key":"-N<x>", "display":"Node tree optimizations" }
|
||||
,{ "key":"-Nu", "display":"Unroll loops" }
|
||||
,{ "key":"-o%value%", "display":"Name of the executable produced"
|
||||
,"type" : "filename" }
|
||||
,{ "key":"-O%value%", "display":"Optimizations:"
|
||||
,"options": [
|
||||
{ "value":"-", "display":"Disable optimizations" }
|
||||
,{ "value":"1", "display":"Level 1 optimizations (quick and debugger friendly)" }
|
||||
,{ "value":"2", "display":"Level 2 optimizations (-O1 + quick optimizations)" }
|
||||
,{ "value":"3", "display":"Level 3 optimizations (-O2 + slow optimizations)" }
|
||||
]
|
||||
}
|
||||
,{ "key":"-OaPROC=%value%", "display":"Set the alignment for procedure entry points" }
|
||||
,{ "key":"-OaJUMP=%value%", "display":"Set the alignment for jump destination locations" }
|
||||
,{ "key":"-OaLOOP=%value%", "display":"Set alignment for loops (for, while, repeat)" }
|
||||
,{ "key":"-OaCONSTMIN=%value%", "display":"Minimum alignment for constants (both typed and untyped)" }
|
||||
,{ "key":"-OaCONSTMAX=%value%", "display":"Maximum alignment for constants (both typed and untyped)" }
|
||||
,{ "key":"-OaVARMIN=%value%", "display":"Minimum alignment for static and global variables" }
|
||||
,{ "key":"-OaVARMAX=%value%", "display":"Maximum alignment for static and global variables" }
|
||||
,{ "key":"-OaLOCALMIN=%value%", "display":"Minimum alignment for local variables" }
|
||||
,{ "key":"-OaLOCALMAX=%value%", "display":"Maximum alignment for local variables" }
|
||||
,{ "key":"-OaRECORDMIN=%value%", "display":"Minimum alignment for record fields" }
|
||||
,{ "key":"-OaRECORDMAX=%value%", "display":"Maximum alignment for record fields" }
|
||||
,{ "key":"-OoAll", "display":"Enable or disable whole program optimization" }
|
||||
,{ "key":"-OoDEVIRTCALLS", "display":"Enable or disable whole program optimization DEVIRTCALLS" }
|
||||
,{ "key":"-OoOPTVMTS", "display":"Enable or disable whole program optimization OPTVMTS" }
|
||||
,{ "key":"-OoSYMBOLLIVENESS", "display":"Enable or disable whole program optimization SYMBOLLIVENESS" }
|
||||
,{ "key":"-Op%value%", "display":"Set target cpu for optimizing"
|
||||
,"options":[
|
||||
{"value":"REGVAR"}
|
||||
,{"value":"UNCERTAIN"}
|
||||
,{"value":"STACKFRAME"}
|
||||
,{"value":"PEEPHOLE"}
|
||||
,{"value":"ASMCSE"}
|
||||
,{"value":"LOOPUNROLL"}
|
||||
,{"value":"TAILREC"}
|
||||
,{"value":"CSE"}
|
||||
]}
|
||||
,{ "key":"-OW<x>", "display":"Generate whole-program optimization feedback for optimization <x>, see fpc -i for possible values" }
|
||||
,{ "key":"-Ow<x>", "display":"Perform whole-program optimization <x>, see fpc -i for possible values" }
|
||||
,{ "key":"-Os", "display":"Optimize for size rather than speed" }
|
||||
,{ "key":"-pg", "display":"Generate profile code for gprof (defines FPC_PROFILE)" }
|
||||
|
||||
,{ "key":"-R%value%", "display":"Assembler reading style:"
|
||||
,"options":[
|
||||
{ "value":"default", "display":"Use default assembler for target" }
|
||||
,{ "value":"att", "display":"Read AT&T style assembler" }
|
||||
,{ "value":"intel", "display":"Read Intel style assembler" }
|
||||
]}
|
||||
|
||||
,{ "key":"-S2", "display":"Same as -Mobjfpc", "alias":"" }
|
||||
,{ "key":"-Sd", "display":"Same as -Mdelphi", "alias":"" }
|
||||
,{ "key":"-So", "display":"Same as -Mtp", "alias":"" }
|
||||
,{ "key":"-Sc", "display":"Support operators like C (*=,+=,/= and -=)", "masterkey": "-S" }
|
||||
,{ "key":"-Sa", "display":"Turn on assertions" , "masterkey": "-S"}
|
||||
,{ "key":"-Se%value%", "display":"Compiler Compiler halts after the number of errors (default is 1)", "type":"int" }
|
||||
,{ "key":"-Sew", "display":"Compiler also halts after warnings", "type":"int" }
|
||||
,{ "key":"-Sen", "display":"Compiler also halts after notes", "type":"int" }
|
||||
,{ "key":"-Seh", "display":"Compiler also halts after hints", "type":"int" }
|
||||
,{ "key":"-Sg", "display":"Enable LABEL and GOTO (default in -Mtp and -Mdelphi)", "masterkey": "-S" }
|
||||
,{ "key":"-Sh", "display":"Use ansistrings by default instead of shortstrings", "masterkey": "-S" }
|
||||
,{ "key":"-Si", "display":"Turn on inlining of procedures/functions declared as \"inline\"","masterkey": "-S" }
|
||||
,{ "key":"-Sk", "display":"Load fpcylix unit","masterkey": "-S" }
|
||||
,{ "key":"-SI%value%", "display":"Set interface style"
|
||||
,"options": [
|
||||
{ "value":"com", "display":"COM compatible interface (default)" }
|
||||
,{ "value":"corba", "display":"CORBA compatible interface" }
|
||||
]}
|
||||
,{ "key":"-Sm", "display":"Support macros like C (global)","masterkey": "-S" }
|
||||
,{ "key":"-Ss", "display":"Constructor name must be init (destructor must be done)","masterkey": "-S" }
|
||||
,{ "key":"-Sx", "display":"Enable exception keywords (default in Delphi/ObjFPC modes)","masterkey": "-S" }
|
||||
,{ "key":"-Sy", "display":"@<pointer> returns a typed pointer, same as $T+","masterkey": "-S" }
|
||||
|
||||
,{ "key":"-s", "display":"Do not call assembler and linker" }
|
||||
,{ "key":"-sh", "display":"Generate script to link on host", "masterkey": "-s" }
|
||||
,{ "key":"-st", "display":"Generate script to link on target", "masterkey": "-s" }
|
||||
,{ "key":"-sr", "display":"Skip register allocation phase (use with -alr)", "masterkey": "-s" }
|
||||
|
||||
,{ "key":"-T%value%", "display":"Target operating system:",
|
||||
"options": [
|
||||
{ "value":"darwin", "display":"Darwin/Mac OS X" }
|
||||
,{ "value":"emx", "display":"OS/2 via EMX (including EMX/RSX extender)" }
|
||||
,{ "value":"freebsd", "display":"FreeBSD" }
|
||||
,{ "value":"go32v2", "display":"Version 2 of DJ Delorie DOS extender" }
|
||||
,{ "value":"iphonesim", "display":"iPhoneSimulator from iOS SDK 3.2+ (older versions: -Tdarwin)" }
|
||||
,{ "value":"linux", "display":"Linux" }
|
||||
,{ "value":"netbsd", "display":"NetBSD" }
|
||||
,{ "value":"netware", "display":"Novell Netware Module (clib)" }
|
||||
,{ "value":"netwlibc", "display":"Novell Netware Module (libc)" }
|
||||
,{ "value":"openbsd", "display":"OpenBSD" }
|
||||
,{ "value":"os2", "display":"OS/2 / eComStation" }
|
||||
,{ "value":"sunos", "display":"SunOS/Solaris" }
|
||||
,{ "value":"symbian", "display":"Symbian OS" }
|
||||
,{ "value":"solaris", "display":"Solaris" }
|
||||
,{ "value":"watcom", "display":"Watcom compatible DOS extender" }
|
||||
,{ "value":"wdosx", "display":"WDOSX DOS extender" }
|
||||
,{ "value":"win32", "display":"Windows 32 Bit" }
|
||||
,{ "value":"wince", "display":"Windows CE" }
|
||||
]}
|
||||
,{ "key":"-P%value%", "display":"Target processor family:",
|
||||
"options": [
|
||||
{ "value":"arm", "display":"arm" }
|
||||
,{ "value":"i386", "display":"i386" }
|
||||
,{ "value":"m68k", "display":"m68k" }
|
||||
,{ "value":"powerpc", "display":"powerpc" }
|
||||
,{ "value":"sparc", "display":"sparc" }
|
||||
,{ "value":"x86_64", "display":"x86_64" }
|
||||
,{ "value":"mipsel", "display":"mipsel" }
|
||||
]}
|
||||
|
||||
|
||||
,{ "key":"-u%value%", "display":"Undefines the symbol", "multiple": true, "type": "string" }
|
||||
|
||||
,{ "key":"-Un", "display":"Do not check where the unit name matches the file name" }
|
||||
,{ "key":"-Ur", "display":"Generate release unit files (never automatically recompiled)" }
|
||||
,{ "key":"-Us", "display":"Compile a system unit" }
|
||||
|
||||
,{ "key":"-ve", "display":"Show errors (default)", "masterkey": "-v" }
|
||||
,{ "key":"-v0", "display":"Show nothing (except errors)", "masterkey": "-v" }
|
||||
,{ "key":"-vw", "display":"Show warnings", "masterkey": "-v" }
|
||||
,{ "key":"-vu", "display":"Show unit info", "masterkey": "-v" }
|
||||
,{ "key":"-vn", "display":"Show notes", "masterkey": "-v" }
|
||||
,{ "key":"-vt", "display":"Show tried/used files", "masterkey": "-v" }
|
||||
,{ "key":"-vh", "display":"Show hints", "masterkey": "-v" }
|
||||
,{ "key":"-vc", "display":"Show conditionals", "masterkey": "-v" }
|
||||
,{ "key":"-vi", "display":"Show general info", "masterkey": "-v" }
|
||||
,{ "key":"-vd", "display":"Show debug info", "masterkey": "-v" }
|
||||
,{ "key":"-vl", "display":"Show linenumbers", "masterkey": "-v" }
|
||||
,{ "key":"-vr", "display":"Rhide/GCC compatibility mode", "masterkey": "-v" }
|
||||
,{ "key":"-vs", "display":"Show time stamps", "masterkey": "-v" }
|
||||
,{ "key":"-vq", "display":"Show message numbers", "masterkey": "-v" }
|
||||
,{ "key":"-va", "display":"Show everything", "masterkey": "-v" }
|
||||
,{ "key":"-vx", "display":"Executable info", "masterkey": "-v"
|
||||
,"condition":"win32" }
|
||||
,{ "key":"-vb", "display":"Write file names messages with full path", "masterkey": "-v" }
|
||||
,{ "key":"-vp", "display":"Write tree.log with parse tree", "masterkey": "-v" }
|
||||
,{ "key":"-vv", "display":"Write fpcdebug.txt with lots of debugging info", "masterkey": "-v" }
|
||||
|
||||
,{ "key":"-WA", "display":"Specify native type application", "masterkey": "-W"
|
||||
,"condition":"win32" }
|
||||
,{ "key":"-Wb", "display":"Create a bundle instead of a library", "masterkey": "-W"
|
||||
,"condition":"darwin" }
|
||||
,{ "key":"-WB%value%", "display":"Set image base to ", "type":"bytesize"
|
||||
,"condition":"symbian,win32" }
|
||||
,{ "key":"-WC", "display":"Specify console type application ", "masterkey": "-W"
|
||||
,"condition":"OS/2,win32" }
|
||||
,{ "key":"-WD", "display":"Use DEFFILE to export functions of DLL or EXE", "masterkey": "-W"
|
||||
,"condition":"OS/2,win32" }
|
||||
,{ "key":"-We", "display":"Use external resources", "masterkey": "-W"
|
||||
,"condition":"darwin" }
|
||||
,{ "key":"-WF", "display":"Specify full-screen type application", "masterkey": "-W"
|
||||
,"condition":"OS/2" }
|
||||
,{ "key":"-WG", "display":"Specify graphic type application", "masterkey": "-W"
|
||||
,"condition":"OS/2,win32" }
|
||||
,{ "key":"-Wi", "display":"Use internal resources", "masterkey": "-W"
|
||||
,"condition":"darwin" }
|
||||
,{ "key":"-WI", "display":"Turn on/off the usage of import sections", "masterkey": "-W"
|
||||
,"condition":"win32" }
|
||||
,{ "key":"-WN", "display":"Do not generate relocation code, needed for debugging", "masterkey": "-W"
|
||||
,"condition":"win32" }
|
||||
,{ "key":"-WR", "display":"Generate relocation code", "masterkey": "-W"
|
||||
,"condition":"win32" }
|
||||
,{ "key":"-WX", "display":"Enable executable stack", "masterkey": "-W"
|
||||
,"condition":"linux" }
|
||||
,{ "key":"-Xc", "display":"Pass --shared/-dynamic to the linker", "masterkey": "-X"
|
||||
,"condition":"beos,darwin,freebsd,linux" }
|
||||
,{ "key":"-Xd", "display":"Do not use standard library search path (needed for cross compile)", "masterkey": "-X" }
|
||||
,{ "key":"-Xe", "display":"Use external linker", "masterkey": "-X" }
|
||||
,{ "key":"-Xg", "display":"Create debuginfo in a separate file and add a debuglink section to executable", "masterkey": "-X" }
|
||||
,{ "key":"-XD", "display":"Try to link units dynamically", "masterkey": "-X" }
|
||||
,{ "key":"-Xi", "display":"Use internal linker", "masterkey": "-X" }
|
||||
,{ "key":"-Xm", "display":"Generate link map", "masterkey": "-X" }
|
||||
,{ "key":"-XM%value%", "display":"Set the name of the 'main' program routine (default is 'main')", "type":"string" }
|
||||
,{ "key":"-XP%value%", "display":"Prepend the binutils names with the prefix <x>", "type":"dirpath" }
|
||||
,{ "key":"-Xr%value%", "display":"Set the linker's rlink-path", "type": "dirpath"
|
||||
,"condition":"beos,linux" }
|
||||
,{ "key":"-XR%value%", "display":"Prepend to all linker search paths", "type": "dirpath"
|
||||
,"condition":"beos,darwin,freebsd,linux,solaris,macos"}
|
||||
,{ "key":"-Xs", "display":"Strip all symbols from executable", "masterkey": "-X" }
|
||||
,{ "key":"-XS", "display":"Try to link units statically (default, defines FPC_LINK_STATIC)", "masterkey": "-X" }
|
||||
,{ "key":"-Xt", "display":"Link with static libraries (-static is passed to linker)", "masterkey": "-X" }
|
||||
,{ "key":"-XX", "display":"Try to smartlink units (defines FPC_LINK_SMART)", "masterkey": "-X" }
|
||||
]
|
||||
}
|
||||
97
components/cmdlinecfg/trunk/idecompopt/cfgcompopt.lpk
Normal file
97
components/cmdlinecfg/trunk/idecompopt/cfgcompopt.lpk
Normal file
@ -0,0 +1,97 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<Package Version="4">
|
||||
<PathDelim Value="\"/>
|
||||
<Name Value="cfgcompopt"/>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<SearchPaths>
|
||||
<OtherUnitFiles Value=".."/>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Other>
|
||||
<CompilerMessages>
|
||||
<MsgFileName Value=""/>
|
||||
</CompilerMessages>
|
||||
<CompilerPath Value="$(CompPath)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
<Files Count="13">
|
||||
<Item1>
|
||||
<Filename Value="optviewform.pas"/>
|
||||
<UnitName Value="optviewform"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Filename Value="..\cmdlinelclctrlsbox.pas"/>
|
||||
<UnitName Value="cmdlinelclctrlsbox"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Filename Value="..\cmdlinelclpropgrid.pas"/>
|
||||
<UnitName Value="cmdlinelclpropgrid"/>
|
||||
</Item3>
|
||||
<Item4>
|
||||
<Filename Value="..\cmdlinelclutils.pas"/>
|
||||
<UnitName Value="cmdlinelclutils"/>
|
||||
</Item4>
|
||||
<Item5>
|
||||
<Filename Value="..\cmdlinecfg.pas"/>
|
||||
<UnitName Value="cmdlinecfg"/>
|
||||
</Item5>
|
||||
<Item6>
|
||||
<Filename Value="..\cmdlinecfgjson.pas"/>
|
||||
<UnitName Value="cmdlinecfgjson"/>
|
||||
</Item6>
|
||||
<Item7>
|
||||
<Filename Value="..\cmdlinecfgparser.pas"/>
|
||||
<UnitName Value="cmdlinecfgparser"/>
|
||||
</Item7>
|
||||
<Item8>
|
||||
<Filename Value="..\cmdlinecfgui.pas"/>
|
||||
<UnitName Value="cmdlinecfgui"/>
|
||||
</Item8>
|
||||
<Item9>
|
||||
<Filename Value="..\cmdlinecfguijson.pas"/>
|
||||
<UnitName Value="cmdlinecfguijson"/>
|
||||
</Item9>
|
||||
<Item10>
|
||||
<Filename Value="..\cmdlinecfgutils.pas"/>
|
||||
<UnitName Value="cmdlinecfgutils"/>
|
||||
</Item10>
|
||||
<Item11>
|
||||
<Filename Value="..\cmdlinefpccond.pas"/>
|
||||
<UnitName Value="cmdlinefpccond"/>
|
||||
</Item11>
|
||||
<Item12>
|
||||
<Filename Value="cfgcompoptreg.pas"/>
|
||||
<HasRegisterProc Value="True"/>
|
||||
<UnitName Value="cfgcompoptreg"/>
|
||||
</Item12>
|
||||
<Item13>
|
||||
<Filename Value="optviewform.lfm"/>
|
||||
<Type Value="LFM"/>
|
||||
</Item13>
|
||||
</Files>
|
||||
<Type Value="DesignTime"/>
|
||||
<RequiredPkgs Count="3">
|
||||
<Item1>
|
||||
<PackageName Value="IDEIntf"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<PackageName Value="lcl"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<PackageName Value="FCL"/>
|
||||
</Item3>
|
||||
</RequiredPkgs>
|
||||
<UsageOptions>
|
||||
<UnitPath Value="$(PkgOutDir)"/>
|
||||
</UsageOptions>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
</PublishOptions>
|
||||
<CustomOptions Items="ExternHelp" Version="2">
|
||||
<_ExternHelp Items="Count"/>
|
||||
</CustomOptions>
|
||||
</Package>
|
||||
</CONFIG>
|
||||
24
components/cmdlinecfg/trunk/idecompopt/cfgcompopt.pas
Normal file
24
components/cmdlinecfg/trunk/idecompopt/cfgcompopt.pas
Normal file
@ -0,0 +1,24 @@
|
||||
{ This file was automatically created by Lazarus. Do not edit!
|
||||
This source is only used to compile and install the package.
|
||||
}
|
||||
|
||||
unit cfgcompopt;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
optviewform, cmdlinelclctrlsbox, cmdlinelclpropgrid, cmdlinelclutils,
|
||||
cmdlinecfg, cmdlinecfgjson, cmdlinecfgparser, cmdlinecfgui,
|
||||
cmdlinecfguijson, cmdlinecfgutils, cmdlinefpccond, cfgcompoptreg,
|
||||
LazarusPackageIntf;
|
||||
|
||||
implementation
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
RegisterUnit('cfgcompoptreg', @cfgcompoptreg.Register);
|
||||
end;
|
||||
|
||||
initialization
|
||||
RegisterPackage('cfgcompopt', @Register);
|
||||
end.
|
||||
126
components/cmdlinecfg/trunk/idecompopt/cfgcompoptreg.pas
Normal file
126
components/cmdlinecfg/trunk/idecompopt/cfgcompoptreg.pas
Normal file
@ -0,0 +1,126 @@
|
||||
unit cfgcompoptreg;
|
||||
|
||||
{$mode delphi}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Forms, Dialogs
|
||||
, LazIDEIntf, MenuIntf
|
||||
, cmdlinecfg, cmdlinecfgutils
|
||||
, cmdlinecfgjson, cmdlinecfgui, cmdlinecfguijson
|
||||
, optviewform
|
||||
, XMLConf;
|
||||
|
||||
procedure Register;
|
||||
|
||||
var
|
||||
listOfOpt : TList;
|
||||
listOfLayout : TList;
|
||||
|
||||
CompOptVers : string; // the version of fpc compiler used
|
||||
CompOptCfg : TCmdLineCfg; // fpc compiler options
|
||||
CfgLayout : TCmdLineLayoutInfo; // compiler options layout hints
|
||||
|
||||
implementation
|
||||
|
||||
resourcestring
|
||||
mnuViewCfgCompilerOpt = 'Review Compiler Options';
|
||||
|
||||
function GetCompilerPath: string;
|
||||
var
|
||||
path : string;
|
||||
xml : TXMLConfig;
|
||||
begin
|
||||
//appears to be a hack, but is there a better way to do that?
|
||||
path := LazarusIDE.GetPrimaryConfigPath;
|
||||
xml := TXMLConfig.Create(nil);
|
||||
try
|
||||
xml.RootName:='CONFIG';
|
||||
xml.Filename:=IncludeTrailingPathDelimiter(path)+'environmentoptions.xml';
|
||||
Result:=xml.GetValue('EnvironmentOptions/CompilerFilename/Value', '');
|
||||
finally
|
||||
xml.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure ReviewCompOpt(Sender: TObject);
|
||||
var
|
||||
cmp : string;
|
||||
begin
|
||||
if not Assigned(CompOptCfg) then begin
|
||||
cmp:=GetCompilerPath;
|
||||
if cmp<>'' then
|
||||
CompOptCfg:=CmdLineCfgDetect(listOfOpt, ExtractFileDir(cmp), cmp);
|
||||
end;
|
||||
|
||||
//todo: better selection of default options
|
||||
if not Assigned(CompOptCfg) and (listOfOpt.Count>0) then
|
||||
CompOptCfg:=TCmdLineCfg(listOfOpt[0]);
|
||||
|
||||
if not Assigned(CompOptCfg) then begin
|
||||
ShowMessage('Unable to detect the compiler version.');
|
||||
Exit;
|
||||
end;
|
||||
|
||||
if Assigned(LazarusIDE.ActiveProject) then begin
|
||||
if not Assigned(OptView) then OptView:=TOptView.Create(Application);
|
||||
ReviewOpts(CompOptCfg, CfgLayout);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure DoRegister;
|
||||
var
|
||||
cmd : TIDEMenuCommand;
|
||||
begin
|
||||
cmd := RegisterIDEMenuCommand(itmProjectWindowSection, 'showCfgCompOpt',
|
||||
mnuViewCfgCompilerOpt, nil, ReviewCompOpt, nil, '');
|
||||
end;
|
||||
|
||||
procedure ReadConfig;
|
||||
var
|
||||
path : string;
|
||||
begin
|
||||
path:=ExcludeTrailingPathDelimiter(LazarusIDE.GetPrimaryConfigPath);
|
||||
if not DirectoryExists( path ) then path:=ExcludeTrailingPathDelimiter(LazarusIDE.GetSecondaryConfigPath );
|
||||
CmdLineCfgJSONLoadFilesFromDir( path , listOfOpt );
|
||||
CmdLineCfgUIJSONLoadFilesFromDir( path , listOfLayout );
|
||||
|
||||
|
||||
//todo: make a smarter layout selection
|
||||
if listOfLayout.Count>0 then CfgLayout:=TCmdLineLayoutInfo(listOfLayout[0]);
|
||||
end;
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
try
|
||||
DoRegister;
|
||||
ReadConfig;
|
||||
except
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure Init;
|
||||
begin
|
||||
listOfOpt := TList.Create;
|
||||
listOfLayout := TList.Create;
|
||||
end;
|
||||
|
||||
procedure Release;
|
||||
var
|
||||
i : integer;
|
||||
begin
|
||||
for i:=0 to listOfOpt.Count-1 do TObject(listOfOpt[i]).Free;
|
||||
listOfOpt.Free;
|
||||
for i:=0 to listOfLayout.Count-1 do TObject(listOfLayout[i]).Free;
|
||||
listOfLayout.Free;
|
||||
end;
|
||||
|
||||
initialization
|
||||
Init;
|
||||
|
||||
finalization
|
||||
Release;
|
||||
|
||||
end.
|
||||
|
||||
50
components/cmdlinecfg/trunk/idecompopt/optviewform.lfm
Normal file
50
components/cmdlinecfg/trunk/idecompopt/optviewform.lfm
Normal file
@ -0,0 +1,50 @@
|
||||
object OptView: TOptView
|
||||
Left = 359
|
||||
Height = 240
|
||||
Top = 214
|
||||
Width = 320
|
||||
Caption = 'OptView'
|
||||
ClientHeight = 240
|
||||
ClientWidth = 320
|
||||
OnDestroy = FormDestroy
|
||||
OnShow = FormShow
|
||||
LCLVersion = '1.1'
|
||||
object Panel1: TPanel
|
||||
Left = 0
|
||||
Height = 190
|
||||
Top = 0
|
||||
Width = 320
|
||||
Align = alClient
|
||||
Caption = 'Panel1'
|
||||
TabOrder = 0
|
||||
end
|
||||
object Panel2: TPanel
|
||||
Left = 0
|
||||
Height = 50
|
||||
Top = 190
|
||||
Width = 320
|
||||
Align = alBottom
|
||||
Caption = 'Panel2'
|
||||
ClientHeight = 50
|
||||
ClientWidth = 320
|
||||
TabOrder = 1
|
||||
object btnOk: TButton
|
||||
Left = 33
|
||||
Height = 25
|
||||
Top = 15
|
||||
Width = 75
|
||||
Caption = 'Ok'
|
||||
ModalResult = 1
|
||||
TabOrder = 0
|
||||
end
|
||||
object btnCancel: TButton
|
||||
Left = 115
|
||||
Height = 25
|
||||
Top = 15
|
||||
Width = 75
|
||||
Caption = 'Cancel'
|
||||
ModalResult = 2
|
||||
TabOrder = 1
|
||||
end
|
||||
end
|
||||
end
|
||||
108
components/cmdlinecfg/trunk/idecompopt/optviewform.pas
Normal file
108
components/cmdlinecfg/trunk/idecompopt/optviewform.pas
Normal file
@ -0,0 +1,108 @@
|
||||
unit optviewform;
|
||||
|
||||
{$mode delphi}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
|
||||
LCLIntf,
|
||||
StdCtrls, LazIDEIntf, IDEOptionsIntf, ProjectIntf, CompOptsIntf, cmdlinecfg,
|
||||
cmdlinecfgjson, cmdlinecfgui, cmdlinecfguijson, cmdlinelclctrlsbox, cmdlinelazcompopt;
|
||||
|
||||
type
|
||||
|
||||
{ TOptView }
|
||||
|
||||
TOptView = class(TForm)
|
||||
btnOk: TButton;
|
||||
btnCancel: TButton;
|
||||
Panel1: TPanel;
|
||||
Panel2: TPanel;
|
||||
procedure FormDestroy(Sender: TObject);
|
||||
procedure FormShow(Sender: TObject);
|
||||
private
|
||||
{ private declarations }
|
||||
cmd : TCmdLineScrollBoxControl;
|
||||
cfg : TCmdLineCfg;
|
||||
layout : TCmdLineLayoutInfo;
|
||||
procedure InitOpts(acfg: TCmdLineCfg; alayout: TCmdLineLayoutInfo);
|
||||
public
|
||||
{ public declarations }
|
||||
function ShowForOpts(opt: TLazCompilerOptions): Integer;
|
||||
end;
|
||||
|
||||
var
|
||||
OptView: TOptView = nil;
|
||||
|
||||
function ReviewOpts(acfg: TCmdLineCfg; alayout: TCmdLineLayoutInfo; opt: TLazCompilerOptions = nil): Integer;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
{ TOptView }
|
||||
|
||||
function ReviewOpts(acfg: TCmdLineCfg; alayout: TCmdLineLayoutInfo; opt: TLazCompilerOptions = nil): Integer;
|
||||
begin
|
||||
if not Assigned(OptView) then OptView:=TOptView.Create(Application);
|
||||
if (OptView.cfg<>acfg) or (OptView.layout<>alayout) then
|
||||
OptView.InitOpts(acfg, alayout);
|
||||
if not Assigned(opt) and Assigned(LazarusIDE.ActiveProject) then
|
||||
opt:=LazarusIDE.ActiveProject.LazCompilerOptions;
|
||||
|
||||
if Assigned(OptView.cmd) and Assigned(opt) then
|
||||
Result:=OptView.ShowForOpts(opt)
|
||||
else
|
||||
Result:=mrCancel;
|
||||
end;
|
||||
|
||||
procedure TOptView.FormDestroy(Sender: TObject);
|
||||
begin
|
||||
cmd.Free;
|
||||
end;
|
||||
|
||||
procedure TOptView.FormShow(Sender: TObject);
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure TOptView.InitOpts(acfg: TCmdLineCfg; alayout: TCmdLineLayoutInfo);
|
||||
begin
|
||||
ReleaseScrollBox(cmd);
|
||||
cmd.Free;
|
||||
cfg:=acfg;
|
||||
layout:=alayout;
|
||||
cmd:=TCmdLineScrollBoxControl.Create(Panel1);
|
||||
cmd.Init(cfg, layout);
|
||||
end;
|
||||
|
||||
function TOptView.ShowForOpts(opt: TLazCompilerOptions): Integer;
|
||||
var
|
||||
list : TList;
|
||||
i : Integer;
|
||||
begin
|
||||
list := TList.Create;
|
||||
try
|
||||
LazCompOptToVals(opt, cfg, list);
|
||||
cmd.SetValues(list);
|
||||
for i:=0 to list.Count-1 do TObject(list[i]).Free;
|
||||
|
||||
Result:=ShowModal;
|
||||
if Result=mrOK then begin
|
||||
list.Clear;
|
||||
cmd.Serialize(list);
|
||||
ValsToLazCompOpt(list, opt);
|
||||
for i:=0 to list.Count-1 do TObject(list[i]).Free;
|
||||
end;
|
||||
|
||||
finally
|
||||
list.Free;
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
initialization
|
||||
|
||||
end.
|
||||
|
||||
101
components/cmdlinecfg/trunk/readme.txt
Normal file
101
components/cmdlinecfg/trunk/readme.txt
Normal file
@ -0,0 +1,101 @@
|
||||
Command Line Configuration
|
||||
|
||||
|
||||
== JSON Storage ==
|
||||
|
||||
The configuration can be stored in JSON format.
|
||||
Root values are
|
||||
|
||||
executable : string - the name of executable (don't have to match the actual binary name)
|
||||
must be the same accross multiple versions
|
||||
version : string - the executable version.
|
||||
testkey : string - the test command-line key that needs to be passed to the executable
|
||||
to retrieve the test value
|
||||
testValue : string - the value that's unique to this version of executable
|
||||
option : array - an array of options, where each option is described as json object
|
||||
fromversion : string - the version of the same executable that configuration file can be used.
|
||||
thus "incremental" configuration files are allowed.
|
||||
however, previous version of the file must be available as well.
|
||||
Any new values or options
|
||||
|
||||
Option values are:
|
||||
|
||||
key : string (required) - the command-line text that needs to be added to a parameter
|
||||
if the option is selected or any value is assigned to this option
|
||||
(in case any value is accepted, such as: int, size, filepath, dirpath, etc)
|
||||
name : string (optional) - code name of the option (the same name should be shared accross multiple
|
||||
versions of the executable - to store the value);
|
||||
section : string (optional) - the section of command line option.
|
||||
subsection : string (optional) - the sub section of the section ... todo: make a better description here
|
||||
masterkey : string (optional) - the "key" prefix that should be used to combining multiple values into
|
||||
a single key entry. Example:
|
||||
two switches -Ct -Co will be combined into -Cto, if both have -C as master key.
|
||||
display : string (optional) - the display name of the option. (if blank, name is used)
|
||||
condition : string (optional) - free form condition string (see FPC Condition below)
|
||||
type : string (default switch) - the type of an option. Available types are:
|
||||
switch - simple enabled or disabled
|
||||
select - multple options are available (expected "options" to be defined)
|
||||
filename - name of a file
|
||||
dirname - name of a directory
|
||||
int - an integer value
|
||||
string - a free form string
|
||||
- - (dash) if type is a dash, the option is removed from this version
|
||||
of the compiler. (used with "fromversion" configuration)
|
||||
options : array (optional) - a list of available values.
|
||||
mutiple : boolean (default false) - multiple entries of the same value is allowed. typically
|
||||
is used for filename or dirnames. However, even for dirname of filename
|
||||
it still defaults to false and must be reinitialized;
|
||||
alias : string (optional) - the current key is considered to be deprecated is, the better
|
||||
key to be used is specified by the "alias" field
|
||||
|
||||
|
||||
Example of JSON Storage:
|
||||
|
||||
{
|
||||
"executable":"fpc",
|
||||
"version":"2.6.0",
|
||||
"testkey":"-iV",
|
||||
"testValue":"2.6.0",
|
||||
options: [
|
||||
{
|
||||
section:"execopt",
|
||||
key:"Xm",
|
||||
name:"generatelinkmap",
|
||||
display:"Generate Link Map"
|
||||
},
|
||||
{
|
||||
section:"codegen",
|
||||
key: "Cp%value%",
|
||||
display: "Instruction set",
|
||||
name: "instructionset",
|
||||
options: [
|
||||
{ value: "80386", condition:"i386,x86_64" }
|
||||
,{ value: "PENTIUM", condition:"i386,x86_64" }
|
||||
,{ value: "PENTIUM2", condition:"i386,x86_64" }
|
||||
,{ value: "PENTIUM3", condition:"i386,x86_64" }
|
||||
,{ value: "PENTIUM4", condition:"i386,x86_64" }
|
||||
,{ value: "PENTIUMM", condition:"i386,x86_64" }
|
||||
]
|
||||
}
|
||||
]
|
||||
}
|
||||
|
||||
== FPC Condition ==
|
||||
|
||||
Free Pascal Compiler condition define for what target (CPU, CPU-OS) the option or value of an option
|
||||
is available. The format follows the FPC convention of target platforms naming:
|
||||
CPU-OS
|
||||
or
|
||||
CPU
|
||||
|
||||
Example, if an option is available for Intel 386 (32-bit machines), the condition should be set to
|
||||
i386
|
||||
If an option is specific to Windows on i386 machine, the condition would be
|
||||
i386-win32
|
||||
(No whitespaces are allowed between)
|
||||
|
||||
If an option is available for multple platforms, each condition has to be comma separated:
|
||||
i386,x86_64,arm-linux
|
||||
|
||||
|
||||
|
||||
28
components/cmdlinecfg/trunk/test.copt
Normal file
28
components/cmdlinecfg/trunk/test.copt
Normal file
@ -0,0 +1,28 @@
|
||||
{
|
||||
"executable":"fpc",
|
||||
"version":"2.6.0",
|
||||
"testkey":"-iV",
|
||||
"testValue":"2.6.0",
|
||||
options: [
|
||||
{
|
||||
section:"execopt",
|
||||
key:"Xm",
|
||||
name:"generatelinkmap",
|
||||
display:"Generate Link Map"
|
||||
},
|
||||
{
|
||||
section:"codegen",
|
||||
key: "Cp%value%",
|
||||
display: "Instruction set",
|
||||
name: "instructionset",
|
||||
options: [
|
||||
{ value: "80386", condition:"i386,x86_64" }
|
||||
,{ value: "PENTIUM", condition:"i386,x86_64" }
|
||||
,{ value: "PENTIUM2", condition:"i386,x86_64" }
|
||||
,{ value: "PENTIUM3", condition:"i386,x86_64" }
|
||||
,{ value: "PENTIUM4", condition:"i386,x86_64" }
|
||||
,{ value: "PENTIUMM", condition:"i386,x86_64" }
|
||||
]
|
||||
}
|
||||
]
|
||||
}
|
||||
72
components/cmdlinecfg/trunk/testcmdlineparse.lpi
Normal file
72
components/cmdlinecfg/trunk/testcmdlineparse.lpi
Normal file
@ -0,0 +1,72 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="9"/>
|
||||
<PathDelim Value="\"/>
|
||||
<General>
|
||||
<Flags>
|
||||
<MainUnitHasCreateFormStatements Value="False"/>
|
||||
<MainUnitHasTitleStatement Value="False"/>
|
||||
</Flags>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<MainUnit Value="0"/>
|
||||
<Title Value="testcmdlineparse"/>
|
||||
<UseAppBundle Value="False"/>
|
||||
<ResourceType Value="res"/>
|
||||
</General>
|
||||
<i18n>
|
||||
<EnableI18N LFM="False"/>
|
||||
</i18n>
|
||||
<VersionInfo>
|
||||
<StringTable ProductVersion=""/>
|
||||
</VersionInfo>
|
||||
<BuildModes Count="1">
|
||||
<Item1 Name="Default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<local>
|
||||
<FormatVersion Value="1"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<Units Count="1">
|
||||
<Unit0>
|
||||
<Filename Value="testcmdlineparse.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="testcmdlineparse"/>
|
||||
</Unit0>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<Target>
|
||||
<Filename Value="testcmdlineparse"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Other>
|
||||
<CompilerMessages>
|
||||
<MsgFileName Value=""/>
|
||||
</CompilerMessages>
|
||||
<CompilerPath Value="$(CompPath)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="3">
|
||||
<Item1>
|
||||
<Name Value="EAbort"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item3>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
79
components/cmdlinecfg/trunk/testcmdlineparse.lpr
Normal file
79
components/cmdlinecfg/trunk/testcmdlineparse.lpr
Normal file
@ -0,0 +1,79 @@
|
||||
program testcmdlineparse;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
{$IFDEF UNIX}{$IFDEF UseCThreads}
|
||||
cthreads,
|
||||
{$ENDIF}{$ENDIF}
|
||||
SysUtils, Classes
|
||||
, cmdlinecfg, cmdlinecfgutils, cmdlinecfgparser, cmdlinecfgjson
|
||||
{ you can add units after this };
|
||||
|
||||
|
||||
procedure TestConfigLineParam(const cmdlinefn, conffn: string);
|
||||
var
|
||||
cfg : TcmdLineCfg;
|
||||
prm : TStringList;
|
||||
result :TList;
|
||||
i : integer;
|
||||
v : TCmdLineOptionValue;
|
||||
p : string;
|
||||
begin
|
||||
prm:=TStringList.Create;
|
||||
result:=TList.Create;
|
||||
try
|
||||
prm.LoadFromFile(cmdlinefn);
|
||||
p:=prm.Text;
|
||||
prm.Clear;
|
||||
CmdLineParse(p, prm);
|
||||
writeln('total input arguments: ', prm.Count);
|
||||
for i:=0 to prm.Count-1 do writeln(prm[i]);
|
||||
writeln;
|
||||
|
||||
if FileExists(conffn) then begin
|
||||
cfg:=TCmdLineCfg.Create;
|
||||
try
|
||||
CmdLineCfgJSONReadFile(conffn, cfg);
|
||||
|
||||
CmdLineMatchArgsToOpts(cfg, prm, result);
|
||||
writeln('known values: ');
|
||||
for i:=0 to result.Count-1 do begin
|
||||
v:=TCmdLineOptionValue(result[i]);
|
||||
if v.Option = nil then Continue;
|
||||
writeln(' ', v.Option.Key,' (',v.Option.Display,')');
|
||||
writeln(' value: ', v.Value);
|
||||
end;
|
||||
writeln;
|
||||
|
||||
writeln('unknown values: ');
|
||||
for i:=0 to result.Count-1 do begin
|
||||
v:=TCmdLineOptionValue(result[i]);
|
||||
if v.Option <> nil then Continue;
|
||||
writeln(' ',v.Value);
|
||||
end;
|
||||
finally
|
||||
cfg.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
finally
|
||||
prm.Free;
|
||||
result.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
if Paramcount=0 then begin
|
||||
writeln('Please specify file name that contains command lines to be parsed');
|
||||
Exit;
|
||||
end;
|
||||
if ParamCount=1 then begin
|
||||
writeln('Simple command line parsing test');
|
||||
TestConfigLineParam(ParamStr(1), '');
|
||||
end else if PAramCount=2 then begin
|
||||
writeln('Command line to configuration parsing test');
|
||||
TestConfigLineParam(ParamSTr(1), Paramstr(2));
|
||||
end;
|
||||
end.
|
||||
|
||||
89
components/cmdlinecfg/trunk/testcompconfread.lpi
Normal file
89
components/cmdlinecfg/trunk/testcompconfread.lpi
Normal file
@ -0,0 +1,89 @@
|
||||
<?xml version="1.0"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="9"/>
|
||||
<PathDelim Value="\"/>
|
||||
<General>
|
||||
<Flags>
|
||||
<MainUnitHasCreateFormStatements Value="False"/>
|
||||
<MainUnitHasTitleStatement Value="False"/>
|
||||
</Flags>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<MainUnit Value="0"/>
|
||||
<Title Value="project1"/>
|
||||
<UseAppBundle Value="False"/>
|
||||
<ResourceType Value="res"/>
|
||||
</General>
|
||||
<i18n>
|
||||
<EnableI18N LFM="False"/>
|
||||
</i18n>
|
||||
<VersionInfo>
|
||||
<StringTable ProductVersion=""/>
|
||||
</VersionInfo>
|
||||
<BuildModes Count="1">
|
||||
<Item1 Name="Default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
|
||||
<ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<local>
|
||||
<FormatVersion Value="1"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<Units Count="3">
|
||||
<Unit0>
|
||||
<Filename Value="testcompconfread.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="testcompconfread"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="cmdlinecfg.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="cmdlinecfg"/>
|
||||
</Unit1>
|
||||
<Unit2>
|
||||
<Filename Value="cmdlinecfgjson.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="cmdlinecfgjson"/>
|
||||
</Unit2>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<Target>
|
||||
<Filename Value="testcompconfread"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Parsing>
|
||||
<SyntaxOptions>
|
||||
<SyntaxMode Value="Delphi"/>
|
||||
</SyntaxOptions>
|
||||
</Parsing>
|
||||
<Other>
|
||||
<CompilerMessages>
|
||||
<MsgFileName Value=""/>
|
||||
</CompilerMessages>
|
||||
<CompilerPath Value="$(CompPath)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="3">
|
||||
<Item1>
|
||||
<Name Value="EAbort"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item3>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
29
components/cmdlinecfg/trunk/testcompconfread.pas
Normal file
29
components/cmdlinecfg/trunk/testcompconfread.pas
Normal file
@ -0,0 +1,29 @@
|
||||
program testcompconfread;
|
||||
|
||||
{$mode delphi}{$H+}
|
||||
|
||||
uses
|
||||
SysUtils, Classes, cmdlinecfg, cmdlinecfgjson, cmdlinecfgutils
|
||||
{ you can add units after this };
|
||||
|
||||
var
|
||||
cfg : TCmdLineCfg;
|
||||
begin
|
||||
if Paramcount=0 then begin
|
||||
writeln('please provide the configuration file name');
|
||||
exit;
|
||||
end;
|
||||
try
|
||||
cfg := TCmdLineCfg.Create;
|
||||
try
|
||||
CmdLineCfgJSONReadFile(ParamStr(1), cfg);
|
||||
CmdLineDebug(cfg);
|
||||
finally
|
||||
cfg.Free;
|
||||
end;
|
||||
except
|
||||
on e: Exception do
|
||||
writeln(e.message);
|
||||
end;
|
||||
end.
|
||||
|
||||
74
components/cmdlinecfg/trunk/testgetversion.lpi
Normal file
74
components/cmdlinecfg/trunk/testgetversion.lpi
Normal file
@ -0,0 +1,74 @@
|
||||
<?xml version="1.0"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="9"/>
|
||||
<PathDelim Value="\"/>
|
||||
<General>
|
||||
<Flags>
|
||||
<MainUnitHasCreateFormStatements Value="False"/>
|
||||
<MainUnitHasTitleStatement Value="False"/>
|
||||
</Flags>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<MainUnit Value="0"/>
|
||||
<Title Value="project1"/>
|
||||
<UseAppBundle Value="False"/>
|
||||
<ResourceType Value="res"/>
|
||||
</General>
|
||||
<i18n>
|
||||
<EnableI18N LFM="False"/>
|
||||
</i18n>
|
||||
<VersionInfo>
|
||||
<StringTable ProductVersion=""/>
|
||||
</VersionInfo>
|
||||
<BuildModes Count="1">
|
||||
<Item1 Name="Default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
|
||||
<ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<local>
|
||||
<FormatVersion Value="1"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<Units Count="1">
|
||||
<Unit0>
|
||||
<Filename Value="testgetversion.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="testgetversion"/>
|
||||
</Unit0>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<Target>
|
||||
<Filename Value="testgetversion"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Other>
|
||||
<CompilerMessages>
|
||||
<MsgFileName Value=""/>
|
||||
</CompilerMessages>
|
||||
<CompilerPath Value="$(CompPath)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="3">
|
||||
<Item1>
|
||||
<Name Value="EAbort"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item3>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
34
components/cmdlinecfg/trunk/testgetversion.lpr
Normal file
34
components/cmdlinecfg/trunk/testgetversion.lpr
Normal file
@ -0,0 +1,34 @@
|
||||
program testgetversion;
|
||||
|
||||
{$mode delphi}{$H+}
|
||||
|
||||
uses
|
||||
Classes, SysUtils, cmdlinecfg, cmdlinecfgutils, cmdlinecfgjson;
|
||||
|
||||
var
|
||||
s : string;
|
||||
list : TList;
|
||||
cfg : TCmdLineCfg;
|
||||
exe : string;
|
||||
i : Integer;
|
||||
begin
|
||||
exe := 'fpc';
|
||||
if ParamCount>0 then exe:=ParamStr(1);
|
||||
writeln('executable: ', exe);
|
||||
list := TList.Create;
|
||||
try
|
||||
CmdLineCfgJSONLoadFilesFromDir( GetCurrentDir, list );
|
||||
writeln('found configurations: ', list.Count);
|
||||
for i:=0 to list.Count-1 do
|
||||
writeln( TCmdLineCfg(list[i]).Version );
|
||||
|
||||
cfg:=CmdLineCfgDetect( list, GetCurrentDir, exe);
|
||||
if Assigned(cfg) then begin
|
||||
writeln('version detected: ', cfg.Version);
|
||||
end else
|
||||
writeln('not found');
|
||||
finally
|
||||
list.Free;
|
||||
end;
|
||||
end.
|
||||
|
||||
47
components/cmdlinecfg/trunk/testguibuild/conf.coptui
Normal file
47
components/cmdlinecfg/trunk/testguibuild/conf.coptui
Normal file
@ -0,0 +1,47 @@
|
||||
{
|
||||
"paths": {
|
||||
"display": "Paths",
|
||||
"switches": ["-Fu","-Fi","-Fl","-FU","-o"]
|
||||
},
|
||||
"target": {
|
||||
"display": "Config and Target",
|
||||
"switches": ["-n"],
|
||||
"platform": {
|
||||
"display": "Target Platform",
|
||||
"hint" : "groupbox",
|
||||
"switches": ["-T","-P","-Op"]
|
||||
},
|
||||
"switches": ["-WG"]
|
||||
},
|
||||
"parsing": {
|
||||
"display": "Parsing",
|
||||
"switches": ["-M","-Sc","-Sa","-Sg","-Si","-Sm","-Ss","-St","-Sh","-R"]
|
||||
},
|
||||
"compiler": {
|
||||
"display": "Compilation and Linking",
|
||||
"switches": ["-O","-Os","-CX","-WR","-Ch","-Cs","-XX","-k"]
|
||||
},
|
||||
"debugging": {
|
||||
"display": "Debugging",
|
||||
"checks" : {
|
||||
"display":"Checks and assertions",
|
||||
"hint" : "groupbox",
|
||||
"switches":["-Ci","-Cr","-Co","-Ct","-CR","-Sa"]
|
||||
},
|
||||
"switches": ["-g"],
|
||||
"infos" : {
|
||||
"display": "Info for GDB",
|
||||
"hint" : "groupbox",
|
||||
"switches": ["-WG", "-gl","-gv","-Xg"]
|
||||
},
|
||||
"otherdebug" :{
|
||||
"display" : "Other debugging Info",
|
||||
"hint" : "groupbox",
|
||||
"switches":["-gh","-gt","-pg","-Xs"]
|
||||
}
|
||||
},
|
||||
"verbosity": {
|
||||
"display": "Verbosity",
|
||||
"switches": ["-ve","-vw", "-vn","-vh","-vi","-vp","-vc","-vx","-v0","-vd","-vu","-vt","-vl","-vb","-va","-l","-Se"]
|
||||
}
|
||||
}
|
||||
67
components/cmdlinecfg/trunk/testguibuild/mainform.lfm
Normal file
67
components/cmdlinecfg/trunk/testguibuild/mainform.lfm
Normal file
@ -0,0 +1,67 @@
|
||||
object Form1: TForm1
|
||||
Left = 411
|
||||
Height = 319
|
||||
Top = 197
|
||||
Width = 425
|
||||
Caption = 'Form1'
|
||||
ClientHeight = 319
|
||||
ClientWidth = 425
|
||||
OnCreate = FormCreate
|
||||
OnDestroy = FormDestroy
|
||||
LCLVersion = '1.1'
|
||||
object Memo1: TMemo
|
||||
Left = 0
|
||||
Height = 90
|
||||
Top = 179
|
||||
Width = 425
|
||||
Align = alBottom
|
||||
Lines.Strings = (
|
||||
'Memo1'
|
||||
)
|
||||
TabOrder = 0
|
||||
end
|
||||
object Splitter1: TSplitter
|
||||
Cursor = crVSplit
|
||||
Left = 0
|
||||
Height = 5
|
||||
Top = 174
|
||||
Width = 425
|
||||
Align = alBottom
|
||||
ResizeAnchor = akBottom
|
||||
end
|
||||
object Label1: TLabel
|
||||
Left = 47
|
||||
Height = 13
|
||||
Top = 44
|
||||
Width = 31
|
||||
Caption = 'Label1'
|
||||
ParentColor = False
|
||||
end
|
||||
object Edit1: TEdit
|
||||
Left = 105
|
||||
Height = 21
|
||||
Top = 46
|
||||
Width = 191
|
||||
TabOrder = 2
|
||||
Text = 'Edit1'
|
||||
end
|
||||
object Panel1: TPanel
|
||||
Left = 0
|
||||
Height = 50
|
||||
Top = 269
|
||||
Width = 425
|
||||
Align = alBottom
|
||||
ClientHeight = 50
|
||||
ClientWidth = 425
|
||||
TabOrder = 3
|
||||
object toOpt: TButton
|
||||
Left = 8
|
||||
Height = 25
|
||||
Top = 9
|
||||
Width = 75
|
||||
Caption = 'To Options'
|
||||
OnClick = toOptClick
|
||||
TabOrder = 0
|
||||
end
|
||||
end
|
||||
end
|
||||
104
components/cmdlinecfg/trunk/testguibuild/mainform.pas
Normal file
104
components/cmdlinecfg/trunk/testguibuild/mainform.pas
Normal file
@ -0,0 +1,104 @@
|
||||
unit mainform;
|
||||
|
||||
{$mode delphi}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ValEdit,
|
||||
StdCtrls, ExtCtrls
|
||||
,cmdlinecfg , cmdlinelclctrlsbox, cmdlinecfgjson //, patheditor
|
||||
,cmdlinecfgui, cmdlinecfguijson
|
||||
,cmdlinecfgparser;
|
||||
|
||||
type
|
||||
|
||||
{ TForm1 }
|
||||
|
||||
TForm1 = class(TForm)
|
||||
toOpt: TButton;
|
||||
Edit1: TEdit;
|
||||
Label1: TLabel;
|
||||
Memo1: TMemo;
|
||||
Panel1: TPanel;
|
||||
Splitter1: TSplitter;
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure FormDestroy(Sender: TObject);
|
||||
procedure toOptClick(Sender: TObject);
|
||||
private
|
||||
{ private declarations }
|
||||
ctrl : TCmdLineScrollBoxControl;
|
||||
cfg : TCmdLineCfg;
|
||||
lt : TCmdLineLayoutInfo;
|
||||
public
|
||||
{ public declarations }
|
||||
procedure OnValueChanged(Sender: TObject);
|
||||
end;
|
||||
|
||||
var
|
||||
Form1: TForm1;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
{ TForm1 }
|
||||
|
||||
procedure TForm1.FormCreate(Sender: TObject);
|
||||
begin
|
||||
{cmdlinelclutils.ADirsDialogs:=DummyEditPaths;
|
||||
cmdlinelclutils.AFilesDialogs:=DummyEditPaths;}
|
||||
|
||||
ctrl:=TCmdLineScrollBoxControl.Create(Self);
|
||||
if ParamCount>0 then begin
|
||||
cfg:=TCmdLineCfg.Create;
|
||||
CmdLineCfgJSONReadFile(ParamStr(1), cfg);
|
||||
if ParamCOunt>1 then begin
|
||||
lt:=TCmdLineLayoutInfo.Create;
|
||||
CmdLineUIJSONReadFile(PAramStr(2), lt);
|
||||
end;
|
||||
ctrl.Init(cfg, lt);
|
||||
ctrl.OnValueChanged:=OnValueChanged;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TForm1.FormDestroy(Sender: TObject);
|
||||
begin
|
||||
ctrl.Free;
|
||||
lt.Free;
|
||||
cfg.Free;
|
||||
end;
|
||||
|
||||
procedure TForm1.toOptClick(Sender: TObject);
|
||||
var
|
||||
vl : TList;
|
||||
i : Integer;
|
||||
begin
|
||||
vl := TList.Create;
|
||||
try
|
||||
CmdLineMatchArgsToOpts(cfg, Memo1.Text, vl);
|
||||
ctrl.SetValues(vl);
|
||||
for i:=0 to vl.Count-1 do TObject(vl[i]).Free;
|
||||
finally
|
||||
vl.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TForm1.OnValueChanged(Sender: TObject);
|
||||
var
|
||||
l : TList;
|
||||
i : integer;
|
||||
begin
|
||||
l :=TList.create;
|
||||
try
|
||||
ctrl.Serialize(l);
|
||||
Memo1.Text:=CmdLineMakeOptions(l);
|
||||
for i:=0 to l.Count-1 do
|
||||
TObject(l[i]).Free;
|
||||
finally
|
||||
l.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
106
components/cmdlinecfg/trunk/testguibuild/testguibuild.lpi
Normal file
106
components/cmdlinecfg/trunk/testguibuild/testguibuild.lpi
Normal file
@ -0,0 +1,106 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="9"/>
|
||||
<PathDelim Value="\"/>
|
||||
<General>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<MainUnit Value="0"/>
|
||||
<Title Value="project1"/>
|
||||
<ResourceType Value="res"/>
|
||||
<UseXPManifest Value="True"/>
|
||||
<Icon Value="0"/>
|
||||
</General>
|
||||
<i18n>
|
||||
<EnableI18N LFM="False"/>
|
||||
</i18n>
|
||||
<VersionInfo>
|
||||
<StringTable ProductVersion=""/>
|
||||
</VersionInfo>
|
||||
<BuildModes Count="1">
|
||||
<Item1 Name="Default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
|
||||
<ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<local>
|
||||
<FormatVersion Value="1"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<RequiredPackages Count="1">
|
||||
<Item1>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item1>
|
||||
</RequiredPackages>
|
||||
<Units Count="4">
|
||||
<Unit0>
|
||||
<Filename Value="testguibuild.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="testguibuild"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="mainform.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="Form1"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="mainform"/>
|
||||
</Unit1>
|
||||
<Unit2>
|
||||
<Filename Value="..\cmdlinelclctrlsbox.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="cmdlinelclctrlsbox"/>
|
||||
</Unit2>
|
||||
<Unit3>
|
||||
<Filename Value="..\commonui\patheditor.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="PathEditorForm"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="patheditor"/>
|
||||
</Unit3>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<Target>
|
||||
<Filename Value="testguibuild"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<OtherUnitFiles Value="..;..\commonui"/>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<CodeGeneration>
|
||||
<Checks>
|
||||
<IOChecks Value="True"/>
|
||||
<RangeChecks Value="True"/>
|
||||
<OverflowChecks Value="True"/>
|
||||
<StackChecks Value="True"/>
|
||||
</Checks>
|
||||
</CodeGeneration>
|
||||
<Other>
|
||||
<CompilerMessages>
|
||||
<MsgFileName Value=""/>
|
||||
</CompilerMessages>
|
||||
<CompilerPath Value="$(CompPath)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="3">
|
||||
<Item1>
|
||||
<Name Value="EAbort"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item3>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
23
components/cmdlinecfg/trunk/testguibuild/testguibuild.lpr
Normal file
23
components/cmdlinecfg/trunk/testguibuild/testguibuild.lpr
Normal file
@ -0,0 +1,23 @@
|
||||
program testguibuild;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
heaptrc,
|
||||
{$IFDEF UNIX}{$IFDEF UseCThreads}
|
||||
cthreads,
|
||||
{$ENDIF}{$ENDIF}
|
||||
Interfaces, // this includes the LCL widgetset
|
||||
Forms, mainform, cmdlinelclctrlsbox//, patheditor
|
||||
{ you can add units after this };
|
||||
|
||||
{$R *.res}
|
||||
|
||||
begin
|
||||
SetHeapTraceOutput('test.txt');
|
||||
RequireDerivedFormResource := True;
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TForm1, Form1);
|
||||
Application.Run;
|
||||
end.
|
||||
|
||||
86
components/cmdlinecfg/trunk/testlazopt.lpi
Normal file
86
components/cmdlinecfg/trunk/testlazopt.lpi
Normal file
@ -0,0 +1,86 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="9"/>
|
||||
<PathDelim Value="\"/>
|
||||
<General>
|
||||
<Flags>
|
||||
<MainUnitHasCreateFormStatements Value="False"/>
|
||||
<MainUnitHasTitleStatement Value="False"/>
|
||||
</Flags>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<MainUnit Value="0"/>
|
||||
<Title Value="testlazopt"/>
|
||||
<UseAppBundle Value="False"/>
|
||||
<ResourceType Value="res"/>
|
||||
</General>
|
||||
<i18n>
|
||||
<EnableI18N LFM="False"/>
|
||||
</i18n>
|
||||
<VersionInfo>
|
||||
<StringTable ProductVersion=""/>
|
||||
</VersionInfo>
|
||||
<BuildModes Count="1">
|
||||
<Item1 Name="Default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<local>
|
||||
<FormatVersion Value="1"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<RequiredPackages Count="2">
|
||||
<Item1>
|
||||
<PackageName Value="IDEIntf"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item2>
|
||||
</RequiredPackages>
|
||||
<Units Count="2">
|
||||
<Unit0>
|
||||
<Filename Value="testlazopt.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="testlazopt"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="cmdlinelazcompopt.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="cmdlinelazcompopt"/>
|
||||
</Unit1>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<Target>
|
||||
<Filename Value="testlazopt"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<OtherUnitFiles Value="c:\library\;c:\library2\"/>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Other>
|
||||
<CompilerMessages>
|
||||
<MsgFileName Value=""/>
|
||||
</CompilerMessages>
|
||||
<CompilerPath Value="$(CompPath)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="3">
|
||||
<Item1>
|
||||
<Name Value="EAbort"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item3>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
14
components/cmdlinecfg/trunk/testlazopt.lpr
Normal file
14
components/cmdlinecfg/trunk/testlazopt.lpr
Normal file
@ -0,0 +1,14 @@
|
||||
program testlazopt;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
{$IFDEF UNIX}{$IFDEF UseCThreads}
|
||||
cthreads,
|
||||
{$ENDIF}{$ENDIF}
|
||||
Interfaces,
|
||||
Classes;
|
||||
|
||||
begin
|
||||
end.
|
||||
|
||||
74
components/cmdlinecfg/trunk/testmakeline.lpi
Normal file
74
components/cmdlinecfg/trunk/testmakeline.lpi
Normal file
@ -0,0 +1,74 @@
|
||||
<?xml version="1.0"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="9"/>
|
||||
<PathDelim Value="\"/>
|
||||
<General>
|
||||
<Flags>
|
||||
<MainUnitHasCreateFormStatements Value="False"/>
|
||||
<MainUnitHasTitleStatement Value="False"/>
|
||||
</Flags>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<MainUnit Value="0"/>
|
||||
<Title Value="project1"/>
|
||||
<UseAppBundle Value="False"/>
|
||||
<ResourceType Value="res"/>
|
||||
</General>
|
||||
<i18n>
|
||||
<EnableI18N LFM="False"/>
|
||||
</i18n>
|
||||
<VersionInfo>
|
||||
<StringTable ProductVersion=""/>
|
||||
</VersionInfo>
|
||||
<BuildModes Count="1">
|
||||
<Item1 Name="Default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
|
||||
<ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<local>
|
||||
<FormatVersion Value="1"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<Units Count="1">
|
||||
<Unit0>
|
||||
<Filename Value="testmakeline.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="testmakeline"/>
|
||||
</Unit0>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<Target>
|
||||
<Filename Value="testmakeline"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Other>
|
||||
<CompilerMessages>
|
||||
<MsgFileName Value=""/>
|
||||
</CompilerMessages>
|
||||
<CompilerPath Value="$(CompPath)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="3">
|
||||
<Item1>
|
||||
<Name Value="EAbort"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item3>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
31
components/cmdlinecfg/trunk/testmakeline.lpr
Normal file
31
components/cmdlinecfg/trunk/testmakeline.lpr
Normal file
@ -0,0 +1,31 @@
|
||||
program testmakeline;
|
||||
|
||||
{$mode delphi}{$H+}
|
||||
|
||||
uses
|
||||
Classes, cmdlinecfg, cmdlinecfgutils, cmdlinecfgjson;
|
||||
|
||||
var
|
||||
cfg : TCmdLineCfg;
|
||||
vals : TList;
|
||||
begin
|
||||
if ParamCount=0 then begin
|
||||
writeln('please specify a configuration file');
|
||||
Exit;
|
||||
end;
|
||||
cfg := TCmdLineCfg.Create;
|
||||
vals:= TList.Create;
|
||||
try
|
||||
CmdLineCfgJSONReadFile(ParamStr(1), cfg);
|
||||
vals.Add(TCmdLineOptionValue.Create( cfg.FindOption('instructionset'), 'PENTIUM' ));
|
||||
vals.Add(TCmdLineOptionValue.Create( cfg.FindOption('generatelinkmap'), '-1' ));
|
||||
vals.Add(TCmdLineOptionValue.Create( cfg.FindOption('shownotes'), '1' ));
|
||||
vals.Add(TCmdLineOptionValue.Create( cfg.FindOption('showhints'), '1' ));
|
||||
writeln( CmdLineMakeOptions ( vals ));
|
||||
finally
|
||||
vals.Free;
|
||||
cfg.Free;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
74
components/cmdlinecfg/trunk/testuijson.lpi
Normal file
74
components/cmdlinecfg/trunk/testuijson.lpi
Normal file
@ -0,0 +1,74 @@
|
||||
<?xml version="1.0"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="9"/>
|
||||
<PathDelim Value="\"/>
|
||||
<General>
|
||||
<Flags>
|
||||
<MainUnitHasCreateFormStatements Value="False"/>
|
||||
<MainUnitHasTitleStatement Value="False"/>
|
||||
</Flags>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<MainUnit Value="0"/>
|
||||
<Title Value="testuijson"/>
|
||||
<UseAppBundle Value="False"/>
|
||||
<ResourceType Value="res"/>
|
||||
</General>
|
||||
<i18n>
|
||||
<EnableI18N LFM="False"/>
|
||||
</i18n>
|
||||
<VersionInfo>
|
||||
<StringTable ProductVersion=""/>
|
||||
</VersionInfo>
|
||||
<BuildModes Count="1">
|
||||
<Item1 Name="Default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
|
||||
<ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<local>
|
||||
<FormatVersion Value="1"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<Units Count="1">
|
||||
<Unit0>
|
||||
<Filename Value="testuijson.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="testuijson"/>
|
||||
</Unit0>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<Target>
|
||||
<Filename Value="testuijson"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Other>
|
||||
<CompilerMessages>
|
||||
<MsgFileName Value=""/>
|
||||
</CompilerMessages>
|
||||
<CompilerPath Value="$(CompPath)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="3">
|
||||
<Item1>
|
||||
<Name Value="EAbort"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item3>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
41
components/cmdlinecfg/trunk/testuijson.lpr
Normal file
41
components/cmdlinecfg/trunk/testuijson.lpr
Normal file
@ -0,0 +1,41 @@
|
||||
program testuijson;
|
||||
|
||||
{$mode delphi}{$H+}
|
||||
|
||||
uses
|
||||
Classes, cmdlinecfgui, cmdlinecfguijson;
|
||||
|
||||
procedure DebugSection(sc: TLayoutSection);
|
||||
var
|
||||
i : Integer;
|
||||
begin
|
||||
if sc.Name<>'' then writeln(sc.Display, ' (', sc.Name,')');
|
||||
for i:=0 to sc.ElemCount-1 do begin
|
||||
if sc.Elements[i].ElementType=letSwitch then
|
||||
writeln(' ', sc.Elements[i].Name)
|
||||
else
|
||||
DebugSection(sc.Elements[i]);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TestUIConfFile(const fn: string);
|
||||
var
|
||||
layout : TCmdLineLayoutInfo;
|
||||
begin
|
||||
layout:=TCmdLineLayoutInfo.Create;
|
||||
try
|
||||
CmdLineUIJSONReadFile(fn, layout);
|
||||
DebugSection(layout.GetSection(''));
|
||||
finally
|
||||
layout.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
if ParamCount=0 then begin
|
||||
writeln('Please specify UI configuration file');
|
||||
Exit;
|
||||
end;
|
||||
TestUIConfFile(ParamStr(1));
|
||||
end.
|
||||
|
||||
Reference in New Issue
Block a user