paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2026-01-04 01:40:31 +01:00
Code Issues Packages Projects Releases Wiki Activity

MG: added publish project

Browse Source 
git-svn-id: trunk@2805 -
This commit is contained in:
lazarus 2002-08-18 08:54:24 +00:00
parent 43beb75448
commit 4d77e6e3dc
4 changed files with 396 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

216
components/codetools/fileprocs.pas
View File

@ -43,6 +43,14 @@ uses
const
// ToDo: find the constant in the fpc units.
EndOfLine:shortstring={$IFDEF win32}#13+{$ENDIF}#10;
{$ifdef win32}
SpecialChar = '/'; // used to use PathDelim, e.g. /\
{$else}
SpecialChar = '\';
{$endif}
{$ifdef win32}
{$define CaseInsensitiveFilenames}
{$endif}
// files
@ -58,8 +66,12 @@ function FileIsWritable(const AFilename: string): boolean;
function FileIsText(const AFilename: string): boolean;
function TrimFilename(const AFilename: string): string;
function AppendPathDelim(const Path: string): string;
function ChompPathDelim(const Path: string): string;
function SearchFileInPath(const Filename, BasePath, SearchPath,
Delimiter: string; SearchLoUpCase: boolean): string;
function FilenameIsMatching(const Mask, Filename: string;
MatchExactly: boolean): boolean;
implementation
@ -131,7 +143,7 @@ begin
DoDirSeparators(TheFilename);
{$IFDEF win32}
// windows
Result:=(copy(TheFilename,1,2)='\\') or ((length(TheFilename)>3) and
Result:=(copy(TheFilename,1,2)='\\') or ((length(TheFilename)>3) and
(upcase(TheFilename[1]) in ['A'..'Z']) and (copy(TheFilename,2,2)=':\'));
{$ELSE}
Result:=(TheFilename<>'') and (TheFilename[1]='/');
@ -165,6 +177,7 @@ begin
if not Result then exit;
end;
end;
inc(i);
end;
Result:=true;
end;
@ -349,6 +362,14 @@ begin
Result:=Path;
end;
function ChompPathDelim(const Path: string): string;
begin
if (Path<>'') and (Path[length(Path)]=PathDelim) then
Result:=LeftStr(Path,length(Path)-1)
else
Result:=Path;
end;
function SearchFileInPath(const Filename, BasePath, SearchPath,
Delimiter: string; SearchLoUpCase: boolean): string;
@ -412,6 +433,199 @@ begin
end;
function FilenameIsMatching(const Mask, Filename: string;
MatchExactly: boolean): boolean;
(*
check if Filename matches Mask
if MatchExactly then the complete Filename must match, else only the
start
Filename matches exactly or is a file/directory in a subdirectory of mask
Mask can contain the wildcards * and ? and the set operator {,}
The wildcards will _not_ match PathDelim
If you need the asterisk, the question mark or the PathDelim as character
just put the SpecialChar character in front of it.
Examples:
/abc matches /abc, /abc/p, /abc/xyz/filename
but not /abcd
/abc/x?z/www matches /abc/xyz/www, /abc/xaz/www
but not /abc/x/z/www
/abc/x*z/www matches /abc/xz/www, /abc/xyz/www, /abc/xAAAz/www
but not /abc/x/z/www
/abc/x\*z/www matches /abc/x*z/www, /abc/x*z/www/ttt
/a{b,c,d}e matches /abe, /ace, /ade
*)
function FindDirectoryStart(const AFilename: string;
CurPos: integer): integer;
begin
Result:=CurPos;
while (Result<=length(AFilename))
and (AFilename[Result]=PathDelim) do
inc(Result);
end;
function FindDirectoryEnd(const AFilename: string; CurPos: integer): integer;
begin
Result:=CurPos;
while (Result<=length(AFilename)) do begin
if AFilename[Result]=SpecialChar then
inc(Result,2)
else if (AFilename[Result]=PathDelim) then
break
else
inc(Result);
end;
end;
function CharsEqual(c1, c2: char): boolean;
begin
{$ifdef CaseInsensitiveFilenames}
Result:=(UpChars[c1]=UpChars[c2]);
{$else}
Result:=(c1=c2);
{$endif}
end;
var
DirStartMask, DirEndMask,
DirStartFile, DirEndFile,
AsteriskPos,
BracketMaskPos, BracketFilePos: integer;
begin
//writeln('[FilenameIsMatching] Mask="',Mask,'" Filename="',Filename,'" MatchExactly=',MatchExactly);
Result:=false;
if (Filename='') then exit;
if (Mask='') then begin
Result:=true; exit;
end;
// test every directory
DirStartMask:=1;
DirStartFile:=1;
repeat
// find start of directories
DirStartMask:=FindDirectoryStart(Mask,DirStartMask);
DirStartFile:=FindDirectoryStart(Filename,DirStartFile);
// find ends of directories
DirEndMask:=FindDirectoryEnd(Mask,DirStartMask);
DirEndFile:=FindDirectoryEnd(Filename,DirStartFile);
// writeln(' Compare "',copy(Mask,DirStartMask,DirEndMask-DirStartMask),'"',
// ' "',copy(Filename,DirStartFile,DirEndFile-DirStartFile),'"');
// compare directories
AsteriskPos:=0;
BracketMaskPos:=0;
while (DirStartMask<DirEndMask) and (DirStartFile<DirEndFile) do begin
//writeln('AAA1 ',DirStartMask,' ',Mask[DirStartMask],' - ',DirStartFile,' ',Filename[DirStartFile]);
case Mask[DirStartMask] of
'?':
begin
inc(DirStartMask);
inc(DirStartFile);
continue;
end;
'*':
begin
inc(DirStartMask);
AsteriskPos:=DirStartMask;
continue;
end;
'{':
if BracketMaskPos<1 then begin
inc(DirStartMask);
BracketMaskPos:=DirStartMask;
BracketFilePos:=DirStartFile;
continue;
end;
',':
if BracketMaskPos>0 then begin
// Bracket operator fits complete
// -> skip rest of Bracket operator
repeat
inc(DirStartMask);
if DirStartMask>=DirEndMask then exit; // error, missing }
if Mask[DirStartMask]=SpecialChar then begin
// special char -> next char is normal char
inc(DirStartMask);
end else if Mask[DirStartMask]='}' then begin
// bracket found (= end of Or operator)
inc(DirStartMask);
break;
end;
until false;
BracketMaskPos:=0;
continue;
end;
'}':
begin
if BracketMaskPos>0 then begin
// Bracket operator fits complete
inc(DirStartMask);
BracketMaskPos:=0;
continue;
end;
end;
end;
if Mask[DirStartMask]=SpecialChar then begin
inc(DirStartMask);
if (DirStartMask>=DirEndMask) then exit;
end;
// compare char
if CharsEqual(Mask[DirStartMask],Filename[DirStartFile]) then begin
inc(DirStartMask);
inc(DirStartFile);
end else begin
// chars different
if BracketMaskPos>0 then begin
// try next Or
repeat
inc(DirStartMask);
if DirStartMask>=DirEndMask then exit; // error, missing }
if Mask[DirStartMask]=SpecialChar then begin
// special char -> next char is normal char
inc(DirStartMask);
end else if Mask[DirStartMask]='}' then begin
// bracket found (= end of Or operator)
// -> filename does not match
exit;
end else if Mask[DirStartMask]=',' then begin
// next Or found
// -> reset filename position and compare
inc(DirStartMask);
DirStartFile:=BracketFilePos;
break;
end;
until false;
end else if AsteriskPos>0 then begin
// * operator always fits
inc(DirStartFile);
end else begin
// filename does not match
exit;
end;
end;
end;
if BracketMaskPos>0 then exit;
if (DirStartMask<DirEndmask) or (DirStartFile<DirEndFile) then exit;
// find starts of next directories
DirStartMask:=DirEndMask+1;
DirStartFile:=DirEndFile+1;
until (DirStartFile>length(Filename)) or (DirStartMask>length(Mask));
DirStartMask:=FindDirectoryStart(Mask,DirStartMask);
// check that complete mask matches
Result:=(DirStartMask>length(Mask));
if MatchExactly then begin
DirStartFile:=FindDirectoryStart(Filename,DirStartFile);
// check that the complete Filename matches
Result:=(Result and (DirStartFile>length(Filename)));
end;
//writeln(' [FilenameIsMatching] Result=',Result,' ',DirStartMask,',',length(Mask),' ',DirStartFile,',',length(Filename));
end;
end.

2
ide/editdefinetree.pas
View File

@ -36,7 +36,7 @@ interface
uses
Classes, SysUtils, IDEProcs, CodeToolManager, DefineTemplates,
CompilerOptions, TransferMacros, LinkScanner;
CompilerOptions, TransferMacros, LinkScanner, FileProcs;
procedure CreateProjectDefineTemplate(CompOpts: TCompilerOptions;
const SrcPath: string);

157
ide/main.pp
View File

@ -369,6 +369,12 @@ type
// methods for open project, create project from source
function DoCompleteLoadingProjectInfo: TModalResult;
// methods for publish project
procedure OnCopyFile(const Filename: string; var Copy: boolean;
Data: TObject);
procedure OnCopyError(const ErrorData: TCopyErrorData;
var Handled: boolean; Data: TObject);
public
class procedure ParseCmdLineOptions;
@ -494,6 +500,7 @@ type
function GetTargetUnitFilename(AnUnitInfo: TUnitInfo): string;
function IsTestUnitFilename(const AFilename: string): boolean; override;
function GetRunCommandLine: string; override;
function GetProjPublishDir: string;
procedure OnMacroSubstitution(TheMacro: TTransferMacro; var s:string;
var Handled, Abort: boolean);
function OnMacroPromptFunction(const s:string; var Abort: boolean):string;
@ -1138,8 +1145,12 @@ begin
lisTargetFilenameOfProject,nil,[]));
MacroList.Add(TTransferMacro.Create('TargetCmdLine','',
lisTargetFilenamePlusParams,nil,[]));
MacroList.Add(TTransferMacro.Create('TestDir','',
lisTestDirectory,nil,[]));
MacroList.Add(TTransferMacro.Create('RunCmdLine','',
lisLaunchingCmdLine,nil,[]));
MacroList.Add(TTransferMacro.Create('ProjPublishDir','',
lisPublishProjDir,nil,[]));
MacroList.OnSubstitution:=@OnMacroSubstitution;
end;
@ -3428,6 +3439,36 @@ begin
Project1.ProjectInfoFile);
end;
procedure TMainIDE.OnCopyFile(const Filename: string; var Copy: boolean;
Data: TObject);
begin
if Data=nil then exit;
if Data is TPublishProjectOptions then begin
Copy:=TPublishProjectOptions(Data).FileCanBePublished(Filename);
//writeln('TMainIDE.OnCopyFile "',Filename,'" ',Copy);
end;
end;
procedure TMainIDE.OnCopyError(const ErrorData: TCopyErrorData;
var Handled: boolean; Data: TObject);
begin
case ErrorData.Error of
ceSrcDirDoesNotExists:
MessageDlg('Copy error',
'Source directory "'+ErrorData.Param1+'" does not exists.',
mtError,[mbCancel],0);
ceCreatingDirectory:
MessageDlg('Copy error',
'Unable to create directory "'+ErrorData.Param1+'".',
mtError,[mbCancel],0);
ceCopyFileError:
MessageDlg('Copy error',
'Unable to copy file "'+ErrorData.Param1+'"'#13
+'to "'+ErrorData.Param1+'"',
mtError,[mbCancel],0);
end;
end;
function TMainIDE.DoOpenFileInSourceNotebook(AnUnitInfo: TUnitInfo;
PageIndex: integer; Flags: TOpenFlags): TModalResult;
var NewSrcEdit: TSourceEditor;
@ -4303,7 +4344,7 @@ writeln('TMainIDE.DoSaveProject A SaveAs=',sfSaveAs in Flags,' SaveToTestDir=',s
// save project info file
if not (sfSaveToTestDir in Flags) then begin
Result:=Project1.WriteProject;
Result:=Project1.WriteProject([],'');
if Result=mrAbort then exit;
EnvironmentOptions.LastSavedProjectFile:=Project1.ProjectInfoFile;
EnvironmentOptions.Save(false);
@ -4540,22 +4581,19 @@ end;
function TMainIDE.DoPublishProject(Flags: TSaveFlags;
ShowDialog: boolean): TModalResult;
procedure OnCopyFile(const Filename: string; var Copy: boolean);
begin
// ToDo
end;
procedure OnCopyError(const ErrorMsg: string; var Handled: boolean);
begin
Handled:=MessageDlg(lisCopyError,ErrorMsg,mtError,[mbIgnore,mbAbort],0)
=mrIgnore;
end;
var
SrcDir, DestDir: string;
NewProjectFilename: string;
Tool: TExternalToolOptions;
CommandAfter, CmdAfterExe, CmdAfterParams: string;
procedure ShowErrorForCommandAfter;
begin
MessageDlg('Invalid command',
'The command after "'+CmdAfterExe+'" is not executable.',
mtError,[mbCancel],0);
end;
begin
// save project
Result:=DoSaveProject(Flags);
@ -4567,23 +4605,61 @@ begin
if Result<>mrOk then exit;
end;
// check command after
CommandAfter:=Project1.PublishOptions.CommandAfter;
if not MacroList.SubstituteStr(CommandAfter) then begin
Result:=mrCancel;
exit;
end;
writeln('TMainIDE.DoPublishProject A "',CommandAfter,'"');
SplitCmdLine(CommandAfter,CmdAfterExe,CmdAfterParams);
writeln('TMainIDE.DoPublishProject B "',CmdAfterExe,'" "',CmdAfterParams,'"');
if (CmdAfterExe<>'') and not FileIsExecutable(CmdAfterExe) then begin
ShowErrorForCommandAfter;
Result:=mrCancel;
exit;
end;
// copy the project directory
SrcDir:=Project1.ProjectDirectory;
MacroList.SubstituteStr(SrcDir);
SrcDir:=ExpandFilename(SrcDir);
DestDir:=Project1.PublishOptions.DestinationDirectory;
MacroList.SubstituteStr(DestDir);
DestDir:=ExpandFilename(DestDir);
{if not CopyDirectory(SrcDir,DestDir,@OnCopyFile,@OnCopyError) then
SrcDir:=AppendPathDelim(Project1.ProjectDirectory);
DestDir:=GetProjPublishDir;
writeln('TMainIDE.DoPublishProject C ',DestDir);
if (DestDir='') then begin
MessageDlg('Invalid destination directory',
'Destination directory "'+DestDir+'" is invalid.'#13
+'Please choose a complete path.',
mtError,[mbOk],0);
Result:=mrCancel;
exit;
end;
if not CopyDirectoryWithMethods(SrcDir,DestDir,
@OnCopyFile,@OnCopyError,Project1.PublishOptions) then
begin
Result:=mrCancel;
exit;
end;}
end;
// write a filtered .lpi file
NewProjectFilename:=DestDir+ExtractFilename(Project1.ProjectInfoFile);
writeln('TMainIDE.DoPublishProject C ',NewProjectFilename);
Result:=Project1.WriteProject(Project1.PublishOptions.WriteFlags,
NewProjectFilename);
if Result<>mrOk then exit;
// execute 'CommandAfter'
if (CmdAfterExe<>'') and FileIsExecutable(CmdAfterExe) then begin
Tool:=TExternalToolOptions.Create;
Tool.Filename:=CmdAfterExe;
Tool.Title:='Command after publishing project';
Tool.WorkingDirectory:=DestDir;
Tool.CmdLineParams:=CmdAfterParams;
Result:=EnvironmentOptions.ExternalTools.Run(Tool,MacroList);
if Result<>mrOk then exit;
end else begin
ShowErrorForCommandAfter;
Result:=mrCancel;
exit;
end;
end;
function TMainIDE.DoCreateProjectForProgram(
@ -4905,7 +4981,10 @@ begin
WorkingDir:=Project1.RunParameterOptions.WorkingDirectory;
if WorkingDir='' then
WorkingDir:=ExtractFilePath(GetProjectTargetFilename);
MacroList.SubstituteStr(WorkingDir);
if not MacroList.SubstituteStr(WorkingDir) then begin
Result:=mrCancel;
exit;
end;
FRunProcess.CurrentDirectory:=ExpandFilename(WorkingDir);
Project1.RunParameterOptions.AssignEnvironmentTo(FRunProcess.Environment);
@ -5501,7 +5580,13 @@ procedure TMainIDE.OnMacroSubstitution(TheMacro: TTransferMacro; var s:string;
var Handled, Abort: boolean);
var MacroName:string;
begin
if TheMacro=nil then exit;
if TheMacro=nil then begin
MessageDlg('Unknown Macro',
'Macro not defined: "'+s+'".',
mtError,[mbAbort],0);
Abort:=true;
exit;
end;
MacroName:=lowercase(TheMacro.Name);
if MacroName='save' then begin
Handled:=true;
@ -5574,6 +5659,9 @@ begin
end else if MacroName='runcmdline' then begin
Handled:=true;
s:=GetRunCommandLine;
end else if MacroName='projpublishdir' then begin
Handled:=true;
s:=GetProjPublishDir;
end;
end;
@ -5784,6 +5872,20 @@ begin
end;
end;
function TMainIDE.GetProjPublishDir: string;
begin
Result:=Project1.PublishOptions.DestinationDirectory;
if MacroList.SubstituteStr(Result) then begin
if FilenameIsAbsolute(Result) then begin
Result:=AppendPathDelim(TrimFilename(Result));
end else begin
Result:='';
end;
end else begin
Result:='';
end;
end;
function TMainIDE.FindUnitFile(const AFilename: string): string;
var
SearchPath, ProjectDir: string;
@ -7287,6 +7389,9 @@ end.
{ =============================================================================
$Log$
Revision 1.409 2002/10/13 09:35:34 lazarus
MG: added publish project
Revision 1.408 2002/10/09 20:08:39 lazarus
Cleanups

59
ide/transfermacros.pp
View File

@ -75,6 +75,8 @@ type
function MF_Path(const Filename:string; var Abort: boolean):string; virtual;
function MF_Name(const Filename:string; var Abort: boolean):string; virtual;
function MF_NameOnly(const Filename:string; var Abort: boolean):string; virtual;
function MF_MakeDir(const Filename:string; var Abort: boolean):string; virtual;
function MF_MakeFile(const Filename:string; var Abort: boolean):string; virtual;
public
constructor Create;
destructor Destroy; override;
@ -119,6 +121,10 @@ begin
@MF_Name,[]));
Add(TTransferMacro.Create('NameOnly','','Function: extract file name only',
@MF_NameOnly,[]));
Add(TTransferMacro.Create('MakeDir','','Function: append path delimiter',
@MF_MakeDir,[]));
Add(TTransferMacro.Create('MakeFile','','Function: chomp path delimiter',
@MF_MakeFile,[]));
end;
destructor TTransferMacroList.Destroy;
@ -196,16 +202,13 @@ begin
MacroStart:=1;
repeat
while (MacroStart<=length(s)) do begin
if s[MacroStart]='$' then begin
if (MacroStart>1) and (s[MacroStart-1]='\') then begin
System.Delete(s,MacroStart-1,1);
end else begin
break;
end;
end else
if (s[MacroStart]='$') and ((MacroStart=1) or (s[MacroStart-1]<>'\')) then
break
else
inc(MacroStart);
end;
if MacroStart>length(s) then exit;
if MacroStart>length(s) then break;
MacroEnd:=MacroStart+1;
while (MacroEnd<=length(s))
and (s[MacroEnd] in ['a'..'z','A'..'Z','0'..'9','_']) do
@ -213,7 +216,7 @@ begin
MacroName:=copy(s,MacroStart+1,MacroEnd-MacroStart-1);
if (MacroEnd<length(s)) and (s[MacroEnd] in ['(','{']) then begin
MacroEnd:=SearchBracketClose(MacroEnd)+1;
if MacroEnd>length(s)+1 then exit;
if MacroEnd>length(s)+1 then break;
MacroStr:=copy(s,MacroStart,MacroEnd-MacroStart);
// Macro found
Handled:=false;
@ -252,14 +255,28 @@ begin
Result:=false;
exit;
end;
if (not Handled) and (AMacro<>nil) then
if (not Handled) and (AMacro<>nil) then begin
// standard macro
MacroStr:=AMacro.Value;
Handled:=true;
end;
if not Handled then
MacroStr:='(unknown macro: '+MacroStr+')';
end;
s:=copy(s,1,MacroStart-1)+MacroStr+copy(s,MacroEnd,length(s)-MacroEnd+1);
MacroEnd:=MacroStart+length(MacroStr);
end;
MacroStart:=MacroEnd;
until false;
// convert \$ chars
MacroStart:=2;
while (MacroStart<=length(s)) do begin
if (s[MacroStart]='$') and (s[MacroStart-1]='\') then begin
System.Delete(s,MacroStart-1,1);
end else
inc(MacroStart);
end;
end;
function TTransferMacroList.FindByName(MacroName: string): TTransferMacro;
@ -301,5 +318,27 @@ begin
Result:=copy(Result,1,length(Result)-length(Ext));
end;
function TTransferMacroList.MF_MakeDir(const Filename: string;
var Abort: boolean): string;
begin
Result:=Filename;
if (Result<>'') and (Result[length(Result)]<>PathDelim) then
Result:=Result+PathDelim;
end;
function TTransferMacroList.MF_MakeFile(const Filename: string;
var Abort: boolean): string;
var
ChompLen: integer;
begin
Result:=Filename;
ChompLen:=0;
while (length(Filename)>ChompLen)
and (Filename[length(Filename)-ChompLen]=PathDelim) do
inc(ChompLen);
if ChompLen>0 then
Result:=LeftStr(Result,length(Filename)-ChompLen);
end;
end.