'-of' extensions are automatically patched

This commit is contained in:
Basile Burg 2014-07-16 06:28:34 +02:00
parent fe9fecde64
commit a1fbd92fdb
3 changed files with 109 additions and 23 deletions

View File

@ -74,6 +74,13 @@ type
function patchPlateformPath(const aPath: string): string; function patchPlateformPath(const aPath: string): string;
procedure patchPlateformPaths(const sPaths: TStrings); procedure patchPlateformPaths(const sPaths: TStrings);
(**
* Patches the file extension from a string.
* This is used to ensure that a project saved on a platform can be loaded
* on another one. Note that the ext which are handled are specific to coedit projects.
*)
function patchPlateformExt(const aFilename: string): string;
(** (**
* Ok/Cancel modal dialog * Ok/Cancel modal dialog
*) *)
@ -293,6 +300,45 @@ begin
end; end;
end; end;
function patchPlateformExt(const aFilename: string): string;
var
ext, newext: string;
begin
ext := extractFileExt(aFilename);
newext := '';
result := aFilename[1..length(aFilename)-length(ext)];
{$IFDEF MSWINDOWS}
case ext of
'.so': newext := '.dll';
'.dylib': newext := '.dll';
'.a': newext := '.lib';
'.o': newext := '.obj';
else newext := ext;
end;
{$ENDIF}
{$IFDEF LINUX}
case ext of
'.dll': newext := '.so';
'.dylib': newext := '.so';
'.lib': newext := '.a';
'.obj': newext := '.o';
'.exe': newext := '';
else newext := ext;
end;
{$ENDIF}
{$IFDEF MACOS}
case ext of
'.dll': newext := '.dylib';
'.so': newext := '.dylib';
'.lib': newext := '.a';
'.obj': newext := '.o';
'.exe': newext := '';
else newext := ext;
end;
{$ENDIF}
result += newext;
end;
function dlgOkCancel(const aMsg: string): TModalResult; function dlgOkCancel(const aMsg: string): TModalResult;
const const
Btns = [mbOK,mbCancel]; Btns = [mbOK,mbCancel];

View File

@ -47,8 +47,8 @@ type
procedure setDocDir(const aValue: string); procedure setDocDir(const aValue: string);
procedure setJSONFile(const aValue: string); procedure setJSONFile(const aValue: string);
published published
property generateDocumentation: boolean read fGenDoc write setGenDoc; property generateDocumentation: boolean read fGenDoc write setGenDoc default false;
property generateJSON: boolean read fGenJson write setGenJSON; property generateJSON: boolean read fGenJson write setGenJSON default false;
property DocumentationDirectory: string read fDocDir write setDocDir; property DocumentationDirectory: string read fDocDir write setDocDir;
property JSONFilename: string read fJsonFname write setJSONFile; property JSONFilename: string read fJsonFname write setJSONFile;
public public
@ -73,19 +73,22 @@ type
fWarnEx: boolean; fWarnEx: boolean;
fVtls: boolean; fVtls: boolean;
fQuiet: boolean; fQuiet: boolean;
fVgc: boolean;
procedure setDepHandling(const aValue: TDepHandling); procedure setDepHandling(const aValue: TDepHandling);
procedure setVerb(const aValue: boolean); procedure setVerb(const aValue: boolean);
procedure setWarn(const aValue: boolean); procedure setWarn(const aValue: boolean);
procedure setWarnEx(const aValue: boolean); procedure setWarnEx(const aValue: boolean);
procedure setVtls(const aValue: boolean); procedure setVtls(const aValue: boolean);
procedure setQuiet(const aValue: boolean); procedure setQuiet(const aValue: boolean);
procedure setVgc(const aValue: boolean);
published published
property depreciationHandling: TDepHandling read fDepHandling write setDepHandling; property depreciationHandling: TDepHandling read fDepHandling write setDepHandling default warning;
property verbose: boolean read fVerb write setVerb; property verbose: boolean read fVerb write setVerb default false;
property warnings: boolean read fWarn write setWarn; property warnings: boolean read fWarn write setWarn default true;
property additionalWarnings: boolean read fWarnEx write setWarnEx; property additionalWarnings: boolean read fWarnEx write setWarnEx default false;
property tlsInformations: boolean read fVtls write setVtls; property tlsInformations: boolean read fVtls write setVtls default false;
property quiet: boolean read fQuiet write setQuiet; property quiet: boolean read fQuiet write setQuiet default false;
property showHiddenAlloc: boolean read fVgc write setVgc default false;
public public
constructor create; constructor create;
procedure assign(aValue: TPersistent); override; procedure assign(aValue: TPersistent); override;
@ -124,7 +127,10 @@ type
fGenStack: boolean; fGenStack: boolean;
fMain: boolean; fMain: boolean;
fRelease: boolean; fRelease: boolean;
fAllInst: boolean;
fStackStomp: boolean;
procedure depPatch; procedure depPatch;
procedure setAllInst(const aValue: boolean);
procedure setUt(const aValue: boolean); procedure setUt(const aValue: boolean);
procedure setVerId(const aValue: string); procedure setVerId(const aValue: string);
procedure setTrgKind(const aValue: TTargetSystem); procedure setTrgKind(const aValue: TTargetSystem);
@ -137,19 +143,22 @@ type
procedure setMain(const aValue: boolean); procedure setMain(const aValue: boolean);
procedure setRelease(const aValue: boolean); procedure setRelease(const aValue: boolean);
procedure setVerIds(const aValue: TStringList); procedure setVerIds(const aValue: TStringList);
procedure setStackStomp(const aValue: boolean);
published published
property targetKind: TTargetSystem read fTrgKind write setTrgKind; property targetKind: TTargetSystem read fTrgKind write setTrgKind default auto;
property binaryKind: TBinaryKind read fBinKind write setBinKind; property binaryKind: TBinaryKind read fBinKind write setBinKind default executable;
property inlining: boolean read fInline write setInline; property inlining: boolean read fInline write setInline default false;
property noBoundsCheck: boolean read fNoBounds write setNoBounds; property noBoundsCheck: boolean read fNoBounds write setNoBounds;
property boundsCheck: TBoundCheckKind read fBoundsCheck write setBoundsCheck; property boundsCheck: TBoundCheckKind read fBoundsCheck write setBoundsCheck;
property optimizations: boolean read fOptimz write setOptims; property optimizations: boolean read fOptimz write setOptims default false;
property generateStackFrame: boolean read fGenStack write setGenStack; property generateStackFrame: boolean read fGenStack write setGenStack default false;
property addMain: boolean read fMain write setMain; property addMain: boolean read fMain write setMain default false;
property release: boolean read fRelease write setRelease; property release: boolean read fRelease write setRelease default false;
property unittest: boolean read fUt write setUt; property unittest: boolean read fUt write setUt default false;
property versionIdentifier: string read fVerId write setVerId; // TODO-ccleaning:remove on beta1 property versionIdentifier: string read fVerId write setVerId; // TODO-ccleaning:remove on beta1
property versionIdentifiers: TStringList read fVerIds write setVerIds; property versionIdentifiers: TStringList read fVerIds write setVerIds;
property generateAllTmpCode: boolean read fAllInst write setAllInst default false;
property addStackStompCode: boolean read fStackStomp write setStackStomp default false;
public public
constructor create; constructor create;
destructor destroy; override; destructor destroy; override;
@ -180,13 +189,13 @@ type
procedure setDbgLevel(const aValue: Integer); procedure setDbgLevel(const aValue: Integer);
procedure setDbgIdents(const aValue: TStringList); procedure setDbgIdents(const aValue: TStringList);
published published
property debug: boolean read fDbg write setDbg; property debug: boolean read fDbg write setDbg default false;
property debugIdentifier: string read fDbgIdent write setDbgIdent; // TODO-ccleaning:remove on beta1 property debugIdentifier: string read fDbgIdent write setDbgIdent; // TODO-ccleaning:remove on beta1
property debugIdentifiers: TStringList read fDbgIdents write setDbgIdents; property debugIdentifiers: TStringList read fDbgIdents write setDbgIdents;
property debugLevel: Integer read fDbgLevel write setDbgLevel; property debugLevel: Integer read fDbgLevel write setDbgLevel default 0;
property addDInformations: boolean read fDbgD write setDbgD; property addDInformations: boolean read fDbgD write setDbgD default false;
property addCInformations: boolean read fDbgC write setDbgC; property addCInformations: boolean read fDbgC write setDbgC default false;
property generateMapFile: boolean read fMap write setMap; property generateMapFile: boolean read fMap write setMap default false;
public public
constructor create; constructor create;
destructor destroy; override; destructor destroy; override;
@ -422,6 +431,7 @@ end;
constructor TMsgOpts.create; constructor TMsgOpts.create;
begin begin
fDepHandling := TDepHandling.warning; fDepHandling := TDepHandling.warning;
fWarn := true;
end; end;
procedure TMsgOpts.getOpts(const aList: TStrings); procedure TMsgOpts.getOpts(const aList: TStrings);
@ -437,6 +447,7 @@ begin
if fWarnEx then aList.Add('-wi'); if fWarnEx then aList.Add('-wi');
if fVtls then aList.Add('-vtls'); if fVtls then aList.Add('-vtls');
if fQuiet then aList.Add('-quiet'); if fQuiet then aList.Add('-quiet');
//if fVgc then aList.Add('-vgc');
end; end;
procedure TMsgOpts.assign(aValue: TPersistent); procedure TMsgOpts.assign(aValue: TPersistent);
@ -452,6 +463,7 @@ begin
fWarnEx := src.fWarnEx; fWarnEx := src.fWarnEx;
fVtls := src.fVtls; fVtls := src.fVtls;
fQuiet := src.fQuiet; fQuiet := src.fQuiet;
fVgc := src.fVgc;
end end
else inherited; else inherited;
end; end;
@ -497,6 +509,13 @@ begin
fQuiet := aValue; fQuiet := aValue;
doChanged; doChanged;
end; end;
procedure TMsgOpts.setVgc(const aValue: boolean);
begin
if fVgc = aValue then exit;
fVgc := aValue;
doChanged;
end;
{$ENDREGION} {$ENDREGION}
{$REGION TOutputOpts ***********************************************************} {$REGION TOutputOpts ***********************************************************}
@ -541,6 +560,8 @@ begin
if fNoBounds then aList.Add('-noboundscheck'); if fNoBounds then aList.Add('-noboundscheck');
if fOptimz then aList.Add('-O'); if fOptimz then aList.Add('-O');
if fGenStack then aList.Add('-gs'); if fGenStack then aList.Add('-gs');
//if fStackStomp then aList.Add('-gx');
//if fAllInst then aList.Add('-allinst');
if fMain then aList.Add('-main'); if fMain then aList.Add('-main');
if fRelease then aList.Add('-release'); if fRelease then aList.Add('-release');
for opt in fVerIds do for opt in fVerIds do
@ -575,6 +596,8 @@ begin
fGenStack := src.fGenStack; fGenStack := src.fGenStack;
fMain := src.fMain; fMain := src.fMain;
fRelease := src.fRelease; fRelease := src.fRelease;
fAllinst := src.fAllInst;
fStackStomp := src.fStackStomp;
// //
depPatch; depPatch;
end end
@ -588,6 +611,13 @@ begin
doChanged; doChanged;
end; end;
procedure TOutputOpts.setAllInst(const aValue: boolean);
begin
if fAllinst = aValue then exit;
fAllinst := aValue;
doChanged;
end;
procedure TOutputOpts.setVerId(const aValue: string); procedure TOutputOpts.setVerId(const aValue: string);
begin begin
if fVerId = aValue then exit; if fVerId = aValue then exit;
@ -665,6 +695,13 @@ begin
fRelease := aValue; fRelease := aValue;
doChanged; doChanged;
end; end;
procedure TOutputOpts.setStackStomp(const aValue: boolean);
begin
if fStackStomp = aValue then exit;
fStackStomp := aValue;
doChanged;
end;
{$ENDREGION} {$ENDREGION}
{$REGION TDebugOpts ************************************************************} {$REGION TDebugOpts ************************************************************}
@ -837,6 +874,7 @@ procedure TPathsOpts.setFname(const aValue: string);
begin begin
if fFname = aValue then exit; if fFname = aValue then exit;
fFname := patchPlateformPath(aValue); fFname := patchPlateformPath(aValue);
fFname := patchPlateformExt(fFname);
doChanged; doChanged;
end; end;

View File

@ -40,9 +40,8 @@ type
fCancelAll: boolean; fCancelAll: boolean;
fHasSearched: boolean; fHasSearched: boolean;
function getOptions: TSynSearchOptions; function getOptions: TSynSearchOptions;
procedure actFindNextExecute(sender: TObject);
procedure actReplaceAllExecute(sender: TObject); procedure actReplaceAllExecute(sender: TObject);
procedure actReplaceNextExecute(sender: TObject);
procedure replaceEvent(Sender: TObject; const ASearch, AReplace: procedure replaceEvent(Sender: TObject; const ASearch, AReplace:
string; Line, Column: integer; var ReplaceAction: TSynReplaceAction); string; Line, Column: integer; var ReplaceAction: TSynReplaceAction);
protected protected
@ -57,6 +56,9 @@ type
function contextName: string; override; function contextName: string; override;
function contextActionCount: integer; override; function contextActionCount: integer; override;
function contextAction(index: integer): TAction; override; function contextAction(index: integer): TAction; override;
//
procedure actFindNextExecute(sender: TObject);
procedure actReplaceNextExecute(sender: TObject);
end; end;
implementation implementation