From a1fbd92fdba68743bcf0e229d8a57ec4cfc1e361 Mon Sep 17 00:00:00 2001 From: Basile Burg Date: Wed, 16 Jul 2014 06:28:34 +0200 Subject: [PATCH] '-of' extensions are automatically patched --- src/ce_common.pas | 46 ++++++++++++++++++++++++++ src/ce_dmdwrap.pas | 80 ++++++++++++++++++++++++++++++++++------------ src/ce_search.pas | 6 ++-- 3 files changed, 109 insertions(+), 23 deletions(-) diff --git a/src/ce_common.pas b/src/ce_common.pas index f3fe4fd5..ca87ae0f 100644 --- a/src/ce_common.pas +++ b/src/ce_common.pas @@ -74,6 +74,13 @@ type function patchPlateformPath(const aPath: string): string; 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 *) @@ -293,6 +300,45 @@ begin 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; const Btns = [mbOK,mbCancel]; diff --git a/src/ce_dmdwrap.pas b/src/ce_dmdwrap.pas index cf2f973e..32d9c0f9 100644 --- a/src/ce_dmdwrap.pas +++ b/src/ce_dmdwrap.pas @@ -47,8 +47,8 @@ type procedure setDocDir(const aValue: string); procedure setJSONFile(const aValue: string); published - property generateDocumentation: boolean read fGenDoc write setGenDoc; - property generateJSON: boolean read fGenJson write setGenJSON; + property generateDocumentation: boolean read fGenDoc write setGenDoc default false; + property generateJSON: boolean read fGenJson write setGenJSON default false; property DocumentationDirectory: string read fDocDir write setDocDir; property JSONFilename: string read fJsonFname write setJSONFile; public @@ -73,19 +73,22 @@ type fWarnEx: boolean; fVtls: boolean; fQuiet: boolean; + fVgc: boolean; procedure setDepHandling(const aValue: TDepHandling); procedure setVerb(const aValue: boolean); procedure setWarn(const aValue: boolean); procedure setWarnEx(const aValue: boolean); procedure setVtls(const aValue: boolean); procedure setQuiet(const aValue: boolean); + procedure setVgc(const aValue: boolean); published - property depreciationHandling: TDepHandling read fDepHandling write setDepHandling; - property verbose: boolean read fVerb write setVerb; - property warnings: boolean read fWarn write setWarn; - property additionalWarnings: boolean read fWarnEx write setWarnEx; - property tlsInformations: boolean read fVtls write setVtls; - property quiet: boolean read fQuiet write setQuiet; + property depreciationHandling: TDepHandling read fDepHandling write setDepHandling default warning; + property verbose: boolean read fVerb write setVerb default false; + property warnings: boolean read fWarn write setWarn default true; + property additionalWarnings: boolean read fWarnEx write setWarnEx default false; + property tlsInformations: boolean read fVtls write setVtls default false; + property quiet: boolean read fQuiet write setQuiet default false; + property showHiddenAlloc: boolean read fVgc write setVgc default false; public constructor create; procedure assign(aValue: TPersistent); override; @@ -124,7 +127,10 @@ type fGenStack: boolean; fMain: boolean; fRelease: boolean; + fAllInst: boolean; + fStackStomp: boolean; procedure depPatch; + procedure setAllInst(const aValue: boolean); procedure setUt(const aValue: boolean); procedure setVerId(const aValue: string); procedure setTrgKind(const aValue: TTargetSystem); @@ -137,19 +143,22 @@ type procedure setMain(const aValue: boolean); procedure setRelease(const aValue: boolean); procedure setVerIds(const aValue: TStringList); + procedure setStackStomp(const aValue: boolean); published - property targetKind: TTargetSystem read fTrgKind write setTrgKind; - property binaryKind: TBinaryKind read fBinKind write setBinKind; - property inlining: boolean read fInline write setInline; + property targetKind: TTargetSystem read fTrgKind write setTrgKind default auto; + property binaryKind: TBinaryKind read fBinKind write setBinKind default executable; + property inlining: boolean read fInline write setInline default false; property noBoundsCheck: boolean read fNoBounds write setNoBounds; property boundsCheck: TBoundCheckKind read fBoundsCheck write setBoundsCheck; - property optimizations: boolean read fOptimz write setOptims; - property generateStackFrame: boolean read fGenStack write setGenStack; - property addMain: boolean read fMain write setMain; - property release: boolean read fRelease write setRelease; - property unittest: boolean read fUt write setUt; + property optimizations: boolean read fOptimz write setOptims default false; + property generateStackFrame: boolean read fGenStack write setGenStack default false; + property addMain: boolean read fMain write setMain default false; + property release: boolean read fRelease write setRelease default false; + property unittest: boolean read fUt write setUt default false; property versionIdentifier: string read fVerId write setVerId; // TODO-ccleaning:remove on beta1 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 constructor create; destructor destroy; override; @@ -180,13 +189,13 @@ type procedure setDbgLevel(const aValue: Integer); procedure setDbgIdents(const aValue: TStringList); 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 debugIdentifiers: TStringList read fDbgIdents write setDbgIdents; - property debugLevel: Integer read fDbgLevel write setDbgLevel; - property addDInformations: boolean read fDbgD write setDbgD; - property addCInformations: boolean read fDbgC write setDbgC; - property generateMapFile: boolean read fMap write setMap; + property debugLevel: Integer read fDbgLevel write setDbgLevel default 0; + property addDInformations: boolean read fDbgD write setDbgD default false; + property addCInformations: boolean read fDbgC write setDbgC default false; + property generateMapFile: boolean read fMap write setMap default false; public constructor create; destructor destroy; override; @@ -422,6 +431,7 @@ end; constructor TMsgOpts.create; begin fDepHandling := TDepHandling.warning; + fWarn := true; end; procedure TMsgOpts.getOpts(const aList: TStrings); @@ -437,6 +447,7 @@ begin if fWarnEx then aList.Add('-wi'); if fVtls then aList.Add('-vtls'); if fQuiet then aList.Add('-quiet'); + //if fVgc then aList.Add('-vgc'); end; procedure TMsgOpts.assign(aValue: TPersistent); @@ -452,6 +463,7 @@ begin fWarnEx := src.fWarnEx; fVtls := src.fVtls; fQuiet := src.fQuiet; + fVgc := src.fVgc; end else inherited; end; @@ -497,6 +509,13 @@ begin fQuiet := aValue; doChanged; end; + +procedure TMsgOpts.setVgc(const aValue: boolean); +begin + if fVgc = aValue then exit; + fVgc := aValue; + doChanged; +end; {$ENDREGION} {$REGION TOutputOpts ***********************************************************} @@ -541,6 +560,8 @@ begin if fNoBounds then aList.Add('-noboundscheck'); if fOptimz then aList.Add('-O'); 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 fRelease then aList.Add('-release'); for opt in fVerIds do @@ -575,6 +596,8 @@ begin fGenStack := src.fGenStack; fMain := src.fMain; fRelease := src.fRelease; + fAllinst := src.fAllInst; + fStackStomp := src.fStackStomp; // depPatch; end @@ -588,6 +611,13 @@ begin doChanged; end; +procedure TOutputOpts.setAllInst(const aValue: boolean); +begin + if fAllinst = aValue then exit; + fAllinst := aValue; + doChanged; +end; + procedure TOutputOpts.setVerId(const aValue: string); begin if fVerId = aValue then exit; @@ -665,6 +695,13 @@ begin fRelease := aValue; doChanged; end; + +procedure TOutputOpts.setStackStomp(const aValue: boolean); +begin + if fStackStomp = aValue then exit; + fStackStomp := aValue; + doChanged; +end; {$ENDREGION} {$REGION TDebugOpts ************************************************************} @@ -837,6 +874,7 @@ procedure TPathsOpts.setFname(const aValue: string); begin if fFname = aValue then exit; fFname := patchPlateformPath(aValue); + fFname := patchPlateformExt(fFname); doChanged; end; diff --git a/src/ce_search.pas b/src/ce_search.pas index 7e21e9bb..576d4989 100644 --- a/src/ce_search.pas +++ b/src/ce_search.pas @@ -40,9 +40,8 @@ type fCancelAll: boolean; fHasSearched: boolean; function getOptions: TSynSearchOptions; - procedure actFindNextExecute(sender: TObject); procedure actReplaceAllExecute(sender: TObject); - procedure actReplaceNextExecute(sender: TObject); + procedure replaceEvent(Sender: TObject; const ASearch, AReplace: string; Line, Column: integer; var ReplaceAction: TSynReplaceAction); protected @@ -57,6 +56,9 @@ type function contextName: string; override; function contextActionCount: integer; override; function contextAction(index: integer): TAction; override; + // + procedure actFindNextExecute(sender: TObject); + procedure actReplaceNextExecute(sender: TObject); end; implementation