diff --git a/components/cmdlinecfg/trunk/cmdlinecfg.pas b/components/cmdlinecfg/trunk/cmdlinecfg.pas new file mode 100644 index 000000000..0f0535509 --- /dev/null +++ b/components/cmdlinecfg/trunk/cmdlinecfg.pas @@ -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. + diff --git a/components/cmdlinecfg/trunk/cmdlinecfgjson.pas b/components/cmdlinecfg/trunk/cmdlinecfgjson.pas new file mode 100644 index 000000000..0ad7f46a4 --- /dev/null +++ b/components/cmdlinecfg/trunk/cmdlinecfgjson.pas @@ -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. + diff --git a/components/cmdlinecfg/trunk/cmdlinecfgparser.pas b/components/cmdlinecfg/trunk/cmdlinecfgparser.pas new file mode 100644 index 000000000..f1b5fabc0 --- /dev/null +++ b/components/cmdlinecfg/trunk/cmdlinecfgparser.pas @@ -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 ((y0 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'' 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 ijtObject 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. diff --git a/components/cmdlinecfg/trunk/cmdlinecfgutils.pas b/components/cmdlinecfg/trunk/cmdlinecfgutils.pas new file mode 100644 index 000000000..efd2c9898 --- /dev/null +++ b/components/cmdlinecfg/trunk/cmdlinecfgutils.pas @@ -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 (j0) do + inc(j); + if (j0 then begin + if M.Size-M.Position 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'' then dst.Add( TCmdLineOptionValue.Create(opt, v)); + end; +end; + +end. diff --git a/components/cmdlinecfg/trunk/cmdlinefpccond.pas b/components/cmdlinecfg/trunk/cmdlinefpccond.pas new file mode 100644 index 000000000..afdcbd144 --- /dev/null +++ b/components/cmdlinecfg/trunk/cmdlinefpccond.pas @@ -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'') 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. diff --git a/components/cmdlinecfg/trunk/cmdlinelazcompopt.pas b/components/cmdlinecfg/trunk/cmdlinelazcompopt.pas new file mode 100644 index 000000000..ca0a2a267 --- /dev/null +++ b/components/cmdlinecfg/trunk/cmdlinelazcompopt.pas @@ -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. + diff --git a/components/cmdlinecfg/trunk/cmdlinelclctrlsbox.pas b/components/cmdlinecfg/trunk/cmdlinelclctrlsbox.pas new file mode 100644 index 000000000..eeec59dc2 --- /dev/null +++ b/components/cmdlinecfg/trunk/cmdlinelclctrlsbox.pas @@ -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. + diff --git a/components/cmdlinecfg/trunk/cmdlinelclpropgrid.pas b/components/cmdlinecfg/trunk/cmdlinelclpropgrid.pas new file mode 100644 index 000000000..bfa323eea --- /dev/null +++ b/components/cmdlinecfg/trunk/cmdlinelclpropgrid.pas @@ -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. + diff --git a/components/cmdlinecfg/trunk/cmdlinelclutils.pas b/components/cmdlinecfg/trunk/cmdlinelclutils.pas new file mode 100644 index 000000000..a12425864 --- /dev/null +++ b/components/cmdlinecfg/trunk/cmdlinelclutils.pas @@ -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. diff --git a/components/cmdlinecfg/trunk/fpc.copt b/components/cmdlinecfg/trunk/fpc.copt new file mode 100644 index 000000000..ed89b6bc2 --- /dev/null +++ b/components/cmdlinecfg/trunk/fpc.copt @@ -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 ", "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 and [y] before uses is parsed", "type": "string", "multiple": true } + ,{ "key":"-Fc%value%", "display":"Set input codepage to ", type:"string"} + ,{ "key":"-FC%value%", "display":"Set RC compiler binary name to ", 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 ", type:"filepath" } + ,{ "key":"-Ff%value%", "display":"Add to framework path", type:"string", "multiple": true + ,"condition":"darwin" } + ,{ "key":"-FE%value%", "display":"Set exe/unit output path to ", type: "dirpath" } + ,{ "key":"-Fi%value%", "display":"Add to include path", type: "dirpath", "multiple": true } + ,{ "key":"-Fl%value%", "display":"Add to library path", type: "dirpath", "multiple": true } + ,{ "key":"-FL%value%", "display":"Use as dynamic linker", type: "string" } + ,{ "key":"-Fm%value%", "display":"Load unicode conversion table from .txt in the compiler dir", type: "filepath" } + ,{ "key":"-Fo%value%", "display":"Add to object path", type: "dirpath", "multiple": true } + ,{ "key":"-Fr%value%", "display":"Load error message file ", type: "filepath" } + ,{ "key":"-FR%value%", "display":"Set resource (.res) linker to ", type: "filepath" } + ,{ "key":"-Fu%value%", "display":"Add to unit path", type: "dirpath", "multiple": true } + ,{ "key":"-FU%value%", "display":"Set unit output path to ", type: "dirpath" } + ,{ "key":"-FW%value%", "display":"Store generated whole-program optimization feedback in ", type: "filepath" } + ,{ "key":"-Fw%value%", "display":"Load previously stored whole-program optimization feedback from ", 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 to include path", "type":"dirpath", "multiple":true } + ,{ "key":"-k%value%", "display":"Pass to the linker", "type":"string", "multiple":true } + ,{ "key":"-M%value%", "display":"Set language mode to " + ,"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", "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", "display":"Generate whole-program optimization feedback for optimization , see fpc -i for possible values" } + ,{ "key":"-Ow", "display":"Perform whole-program optimization , 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":"@ 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 ", "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" } + ] +} diff --git a/components/cmdlinecfg/trunk/idecompopt/cfgcompopt.lpk b/components/cmdlinecfg/trunk/idecompopt/cfgcompopt.lpk new file mode 100644 index 000000000..b1620feee --- /dev/null +++ b/components/cmdlinecfg/trunk/idecompopt/cfgcompopt.lpk @@ -0,0 +1,97 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + <_ExternHelp Items="Count"/> + + + diff --git a/components/cmdlinecfg/trunk/idecompopt/cfgcompopt.pas b/components/cmdlinecfg/trunk/idecompopt/cfgcompopt.pas new file mode 100644 index 000000000..fc3066c5b --- /dev/null +++ b/components/cmdlinecfg/trunk/idecompopt/cfgcompopt.pas @@ -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. diff --git a/components/cmdlinecfg/trunk/idecompopt/cfgcompoptreg.pas b/components/cmdlinecfg/trunk/idecompopt/cfgcompoptreg.pas new file mode 100644 index 000000000..2044c5b61 --- /dev/null +++ b/components/cmdlinecfg/trunk/idecompopt/cfgcompoptreg.pas @@ -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. + diff --git a/components/cmdlinecfg/trunk/idecompopt/optviewform.lfm b/components/cmdlinecfg/trunk/idecompopt/optviewform.lfm new file mode 100644 index 000000000..c857685b4 --- /dev/null +++ b/components/cmdlinecfg/trunk/idecompopt/optviewform.lfm @@ -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 diff --git a/components/cmdlinecfg/trunk/idecompopt/optviewform.pas b/components/cmdlinecfg/trunk/idecompopt/optviewform.pas new file mode 100644 index 000000000..4a941f6c8 --- /dev/null +++ b/components/cmdlinecfg/trunk/idecompopt/optviewform.pas @@ -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. + diff --git a/components/cmdlinecfg/trunk/readme.txt b/components/cmdlinecfg/trunk/readme.txt new file mode 100644 index 000000000..8119b3aee --- /dev/null +++ b/components/cmdlinecfg/trunk/readme.txt @@ -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 + + + diff --git a/components/cmdlinecfg/trunk/test.copt b/components/cmdlinecfg/trunk/test.copt new file mode 100644 index 000000000..0a251c3fb --- /dev/null +++ b/components/cmdlinecfg/trunk/test.copt @@ -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" } + ] + } + ] +} \ No newline at end of file diff --git a/components/cmdlinecfg/trunk/testcmdlineparse.lpi b/components/cmdlinecfg/trunk/testcmdlineparse.lpi new file mode 100644 index 000000000..de5292cc6 --- /dev/null +++ b/components/cmdlinecfg/trunk/testcmdlineparse.lpi @@ -0,0 +1,72 @@ + + + + + + + + + + + + + + <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> diff --git a/components/cmdlinecfg/trunk/testcmdlineparse.lpr b/components/cmdlinecfg/trunk/testcmdlineparse.lpr new file mode 100644 index 000000000..48b09cc9f --- /dev/null +++ b/components/cmdlinecfg/trunk/testcmdlineparse.lpr @@ -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. + diff --git a/components/cmdlinecfg/trunk/testcompconfread.lpi b/components/cmdlinecfg/trunk/testcompconfread.lpi new file mode 100644 index 000000000..41c02c18a --- /dev/null +++ b/components/cmdlinecfg/trunk/testcompconfread.lpi @@ -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> diff --git a/components/cmdlinecfg/trunk/testcompconfread.pas b/components/cmdlinecfg/trunk/testcompconfread.pas new file mode 100644 index 000000000..8e603ad5a --- /dev/null +++ b/components/cmdlinecfg/trunk/testcompconfread.pas @@ -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. + diff --git a/components/cmdlinecfg/trunk/testgetversion.lpi b/components/cmdlinecfg/trunk/testgetversion.lpi new file mode 100644 index 000000000..7e058ec3f --- /dev/null +++ b/components/cmdlinecfg/trunk/testgetversion.lpi @@ -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> diff --git a/components/cmdlinecfg/trunk/testgetversion.lpr b/components/cmdlinecfg/trunk/testgetversion.lpr new file mode 100644 index 000000000..d74431829 --- /dev/null +++ b/components/cmdlinecfg/trunk/testgetversion.lpr @@ -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. + diff --git a/components/cmdlinecfg/trunk/testguibuild/conf.coptui b/components/cmdlinecfg/trunk/testguibuild/conf.coptui new file mode 100644 index 000000000..6efb86309 --- /dev/null +++ b/components/cmdlinecfg/trunk/testguibuild/conf.coptui @@ -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"] + } +} \ No newline at end of file diff --git a/components/cmdlinecfg/trunk/testguibuild/mainform.lfm b/components/cmdlinecfg/trunk/testguibuild/mainform.lfm new file mode 100644 index 000000000..68db8d464 --- /dev/null +++ b/components/cmdlinecfg/trunk/testguibuild/mainform.lfm @@ -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 diff --git a/components/cmdlinecfg/trunk/testguibuild/mainform.pas b/components/cmdlinecfg/trunk/testguibuild/mainform.pas new file mode 100644 index 000000000..1202c4057 --- /dev/null +++ b/components/cmdlinecfg/trunk/testguibuild/mainform.pas @@ -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. + diff --git a/components/cmdlinecfg/trunk/testguibuild/testguibuild.lpi b/components/cmdlinecfg/trunk/testguibuild/testguibuild.lpi new file mode 100644 index 000000000..345a130c6 --- /dev/null +++ b/components/cmdlinecfg/trunk/testguibuild/testguibuild.lpi @@ -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> diff --git a/components/cmdlinecfg/trunk/testguibuild/testguibuild.lpr b/components/cmdlinecfg/trunk/testguibuild/testguibuild.lpr new file mode 100644 index 000000000..2cca3663a --- /dev/null +++ b/components/cmdlinecfg/trunk/testguibuild/testguibuild.lpr @@ -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. + diff --git a/components/cmdlinecfg/trunk/testlazopt.lpi b/components/cmdlinecfg/trunk/testlazopt.lpi new file mode 100644 index 000000000..1f7c838fb --- /dev/null +++ b/components/cmdlinecfg/trunk/testlazopt.lpi @@ -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> diff --git a/components/cmdlinecfg/trunk/testlazopt.lpr b/components/cmdlinecfg/trunk/testlazopt.lpr new file mode 100644 index 000000000..537784d1c --- /dev/null +++ b/components/cmdlinecfg/trunk/testlazopt.lpr @@ -0,0 +1,14 @@ +program testlazopt; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX}{$IFDEF UseCThreads} + cthreads, + {$ENDIF}{$ENDIF} + Interfaces, + Classes; + +begin +end. + diff --git a/components/cmdlinecfg/trunk/testmakeline.lpi b/components/cmdlinecfg/trunk/testmakeline.lpi new file mode 100644 index 000000000..711fbd25b --- /dev/null +++ b/components/cmdlinecfg/trunk/testmakeline.lpi @@ -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> diff --git a/components/cmdlinecfg/trunk/testmakeline.lpr b/components/cmdlinecfg/trunk/testmakeline.lpr new file mode 100644 index 000000000..a11a6b749 --- /dev/null +++ b/components/cmdlinecfg/trunk/testmakeline.lpr @@ -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. + diff --git a/components/cmdlinecfg/trunk/testuijson.lpi b/components/cmdlinecfg/trunk/testuijson.lpi new file mode 100644 index 000000000..f0a973180 --- /dev/null +++ b/components/cmdlinecfg/trunk/testuijson.lpi @@ -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> diff --git a/components/cmdlinecfg/trunk/testuijson.lpr b/components/cmdlinecfg/trunk/testuijson.lpr new file mode 100644 index 000000000..0176b83a9 --- /dev/null +++ b/components/cmdlinecfg/trunk/testuijson.lpr @@ -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. +