mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-07 14:20:29 +02:00
730 lines
23 KiB
ObjectPascal
730 lines
23 KiB
ObjectPascal
{
|
|
/***************************************************************************
|
|
dialogprocs.pas
|
|
---------------
|
|
|
|
***************************************************************************/
|
|
|
|
***************************************************************************
|
|
* *
|
|
* This source is free software; you can redistribute it and/or modify *
|
|
* it under the terms of the GNU General Public License as published by *
|
|
* the Free Software Foundation; either version 2 of the License, or *
|
|
* (at your option) any later version. *
|
|
* *
|
|
* This code is distributed in the hope that it will be useful, but *
|
|
* WITHOUT ANY WARRANTY; without even the implied warranty of *
|
|
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
|
|
* General Public License for more details. *
|
|
* *
|
|
* A copy of the GNU General Public License is available on the World *
|
|
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
|
|
* obtain it by writing to the Free Software Foundation, *
|
|
* Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
|
|
* *
|
|
***************************************************************************
|
|
|
|
Author: Mattias Gaertner
|
|
|
|
Abstract:
|
|
Common IDE functions with MessageDlg(s) for errors.
|
|
}
|
|
unit DialogProcs;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils,
|
|
// LCL
|
|
LCLProc, LResources, Forms, Controls, Dialogs, ComCtrls,
|
|
// LazUtils
|
|
FileUtil, LazFileUtils, LazFileCache, Laz2_XMLCfg,
|
|
// CodeTools
|
|
FileProcs, CodeToolsConfig, CodeCache, CodeToolManager,
|
|
// IdeIntf
|
|
LazIDEIntf, IDEDialogs,
|
|
// IDE
|
|
IDEProcs, LazarusIDEStrConsts;
|
|
|
|
type
|
|
// load buffer flags
|
|
TLoadBufferFlag = (
|
|
lbfUpdateFromDisk,
|
|
lbfRevert,
|
|
lbfCheckIfText,
|
|
lbfQuiet,
|
|
lbfCreateClearOnError,
|
|
lbfIgnoreMissing
|
|
);
|
|
TLoadBufferFlags = set of TLoadBufferFlag;
|
|
|
|
TOnBackupFileInteractive =
|
|
function(const Filename: string): TModalResult of object;
|
|
|
|
TOnDragOverTreeView = function(Sender, Source: TObject; X, Y: Integer;
|
|
out TargetTVNode: TTreeNode; out TargetTVType: TTreeViewInsertMarkType
|
|
): boolean of object;
|
|
|
|
var
|
|
OnBackupFileInteractive: TOnBackupFileInteractive = nil;
|
|
|
|
function BackupFileInteractive(const Filename: string): TModalResult;
|
|
function RenameFileWithErrorDialogs(const SrcFilename, DestFilename: string;
|
|
ExtraButtons: TMsgDlgButtons = []): TModalResult;
|
|
function CopyFileWithErrorDialogs(const SrcFilename, DestFilename: string;
|
|
ExtraButtons: TMsgDlgButtons = []): TModalResult;
|
|
function LoadCodeBuffer(out ACodeBuffer: TCodeBuffer; const AFilename: string;
|
|
Flags: TLoadBufferFlags; ShowAbort: boolean): TModalResult;
|
|
function SaveCodeBuffer(ACodeBuffer: TCodeBuffer): TModalResult;
|
|
function SaveCodeBufferToFile(ACodeBuffer: TCodeBuffer;
|
|
const Filename: string; Backup: boolean = false): TModalResult;
|
|
function LoadStringListFromFile(const Filename, ListTitle: string;
|
|
var sl: TStrings): TModalResult;
|
|
function SaveStringListToFile(const Filename, ListTitle: string;
|
|
var sl: TStrings): TModalResult;
|
|
function LoadXMLConfigFromCodeBuffer(const Filename: string; Config: TXMLConfig;
|
|
out ACodeBuffer: TCodeBuffer; Flags: TLoadBufferFlags;
|
|
ShowAbort: boolean
|
|
): TModalResult;
|
|
function SaveXMLConfigToCodeBuffer(const Filename: string; Config: TXMLConfig;
|
|
var ACodeBuffer: TCodeBuffer;
|
|
KeepFileAttributes: boolean): TModalResult;
|
|
function CheckCreatingFile(const AFilename: string;
|
|
CheckReadable: boolean;
|
|
WarnOverwrite: boolean = false;
|
|
CreateBackup: boolean = false
|
|
): TModalResult;
|
|
function CheckFileIsWritable(const Filename: string;
|
|
ErrorButtons: TMsgDlgButtons = []): TModalResult;
|
|
function CheckDirectoryIsWritable(const Filename: string;
|
|
ErrorButtons: TMsgDlgButtons = []): TModalResult;
|
|
function CheckExecutable(const OldFilename,
|
|
NewFilename: string; const ErrorCaption, ErrorMsg: string;
|
|
SearchInPath: boolean = true): boolean;
|
|
function CheckDirPathExists(const Dir, ErrorCaption, ErrorMsg: string): TModalResult;
|
|
function ChooseSymlink(var Filename: string; const TargetFilename: string): TModalResult;
|
|
function CreateSymlinkInteractive(const {%H-}LinkFilename, {%H-}TargetFilename: string;
|
|
{%H-}ErrorButtons: TMsgDlgButtons = []): TModalResult;
|
|
function ForceDirectoryInteractive(Directory: string;
|
|
ErrorButtons: TMsgDlgButtons = []): TModalResult;
|
|
function DeleteFileInteractive(const Filename: string;
|
|
ErrorButtons: TMsgDlgButtons = []): TModalResult;
|
|
function SaveStringToFile(const Filename, Content: string;
|
|
ErrorButtons: TMsgDlgButtons; const Context: string = ''
|
|
): TModalResult;
|
|
function ConvertLFMToLRSFileInteractive(const LFMFilename,
|
|
LRSFilename: string; ShowAbort: boolean): TModalResult;
|
|
function IfNotOkJumpToCodetoolErrorAndAskToAbort(Ok: boolean;
|
|
Ask: boolean; out NewResult: TModalResult): boolean;
|
|
function JumpToCodetoolErrorAndAskToAbort(Ask: boolean): TModalResult;
|
|
procedure NotImplementedDialog(const Feature: string);
|
|
|
|
implementation
|
|
|
|
{$IFDEF Unix}
|
|
uses
|
|
baseunix;
|
|
{$ENDIF}
|
|
|
|
function BackupFileInteractive(const Filename: string): TModalResult;
|
|
begin
|
|
if Assigned(OnBackupFileInteractive) then
|
|
Result:=OnBackupFileInteractive(Filename)
|
|
else
|
|
Result:=mrOk;
|
|
end;
|
|
|
|
function RenameFileWithErrorDialogs(const SrcFilename, DestFilename: string;
|
|
ExtraButtons: TMsgDlgButtons): TModalResult;
|
|
var
|
|
DlgButtons: TMsgDlgButtons;
|
|
begin
|
|
if SrcFilename=DestFilename then
|
|
exit(mrOk);
|
|
repeat
|
|
if RenameFileUTF8(SrcFilename,DestFilename) then begin
|
|
InvalidateFileStateCache(SrcFilename);
|
|
InvalidateFileStateCache(DestFilename);
|
|
break;
|
|
end else begin
|
|
DlgButtons:=[mbRetry]+ExtraButtons;
|
|
Result:=IDEMessageDialog(lisUnableToRenameFile,
|
|
Format(lisUnableToRenameFileTo2, [SrcFilename, LineEnding, DestFilename]),
|
|
mtError,DlgButtons);
|
|
if (Result<>mrRetry) then exit;
|
|
end;
|
|
until false;
|
|
Result:=mrOk;
|
|
end;
|
|
|
|
function CopyFileWithErrorDialogs(const SrcFilename, DestFilename: string;
|
|
ExtraButtons: TMsgDlgButtons): TModalResult;
|
|
var
|
|
DlgButtons: TMsgDlgButtons;
|
|
begin
|
|
if CompareFilenames(SrcFilename,DestFilename)=0 then begin
|
|
Result:=mrAbort;
|
|
IDEMessageDialog(lisUnableToCopyFile,
|
|
Format(lisSourceAndDestinationAreTheSame, [LineEnding, SrcFilename]),
|
|
mtError, [mbAbort]);
|
|
exit;
|
|
end;
|
|
repeat
|
|
if CopyFile(SrcFilename,DestFilename) then begin
|
|
InvalidateFileStateCache(DestFilename);
|
|
break;
|
|
end else begin
|
|
DlgButtons:=[mbCancel,mbRetry]+ExtraButtons;
|
|
Result:=IDEMessageDialog(lisUnableToCopyFile,
|
|
Format(lisUnableToCopyFileTo, [SrcFilename, LineEnding, DestFilename]),
|
|
mtError,DlgButtons);
|
|
if (Result<>mrRetry) then exit;
|
|
end;
|
|
until false;
|
|
Result:=mrOk;
|
|
end;
|
|
|
|
function LoadCodeBuffer(out ACodeBuffer: TCodeBuffer; const AFilename: string;
|
|
Flags: TLoadBufferFlags; ShowAbort: boolean): TModalResult;
|
|
var
|
|
ACaption, AText: string;
|
|
FileReadable: boolean;
|
|
begin
|
|
ACodeBuffer:=nil;
|
|
if not FilenameIsAbsolute(AFilename) then
|
|
Flags:=Flags-[lbfUpdateFromDisk,lbfRevert];
|
|
if lbfCreateClearOnError in Flags then
|
|
Exclude(Flags,lbfIgnoreMissing);
|
|
if [lbfUpdateFromDisk,lbfRevert]*Flags=[] then begin
|
|
// can use cache
|
|
ACodeBuffer:=CodeToolBoss.LoadFile(AFilename,false,false);
|
|
if ACodeBuffer<>nil then begin
|
|
// file is in cache
|
|
if (not (lbfCheckIfText in Flags)) or ACodeBuffer.SourceIsText then
|
|
exit(mrOk);
|
|
ACodeBuffer:=nil;
|
|
end;
|
|
end;
|
|
repeat
|
|
FileReadable:=true;
|
|
if (lbfCheckIfText in Flags)
|
|
and (not FileIsText(AFilename,FileReadable)) and FileReadable
|
|
then begin
|
|
if lbfQuiet in Flags then begin
|
|
Result:=mrCancel;
|
|
end else begin
|
|
ACaption:=lisFileNotText;
|
|
AText:=Format(lisFileDoesNotLookLikeATextFileOpenItAnyway,[AFilename,LineEnding,LineEnding]);
|
|
Result:=IDEMessageDialogAb(ACaption, AText, mtConfirmation,
|
|
[mbOk, mbIgnore],ShowAbort);
|
|
end;
|
|
if Result<>mrOk then break;
|
|
end;
|
|
if FileReadable then
|
|
ACodeBuffer:=CodeToolBoss.LoadFile(AFilename,lbfUpdateFromDisk in Flags,
|
|
lbfRevert in Flags)
|
|
else
|
|
ACodeBuffer:=nil;
|
|
|
|
if ACodeBuffer<>nil then begin
|
|
Result:=mrOk;
|
|
end else begin
|
|
// read error
|
|
if lbfIgnoreMissing in Flags then begin
|
|
if (FilenameIsAbsolute(AFilename) and not FileExistsCached(AFilename))
|
|
then
|
|
exit(mrIgnore);
|
|
end;
|
|
if lbfQuiet in Flags then
|
|
Result:=mrCancel
|
|
else begin
|
|
ACaption:=lisReadError;
|
|
AText:=Format(lisUnableToReadFile2, [AFilename]);
|
|
Result:=IDEMessageDialogAb(ACaption,AText,mtError,[mbRetry,mbIgnore],ShowAbort);
|
|
if Result=mrAbort then exit;
|
|
end;
|
|
end;
|
|
until Result<>mrRetry;
|
|
if (ACodeBuffer=nil) and (lbfCreateClearOnError in Flags) then begin
|
|
ACodeBuffer:=CodeToolBoss.CreateFile(AFilename);
|
|
if ACodeBuffer<>nil then
|
|
Result:=mrOk;
|
|
end;
|
|
end;
|
|
|
|
function SaveCodeBuffer(ACodeBuffer: TCodeBuffer): TModalResult;
|
|
begin
|
|
repeat
|
|
if ACodeBuffer.Save then begin
|
|
Result:=mrOk;
|
|
end else begin
|
|
Result:=IDEMessageDialog(lisCodeToolsDefsWriteError,
|
|
Format(lisUnableToWrite2, [ACodeBuffer.Filename]),
|
|
mtError,[mbAbort,mbRetry,mbIgnore]);
|
|
end;
|
|
until Result<>mrRetry;
|
|
end;
|
|
|
|
function SaveCodeBufferToFile(ACodeBuffer: TCodeBuffer; const Filename: string;
|
|
Backup: boolean): TModalResult;
|
|
var
|
|
ACaption,AText:string;
|
|
begin
|
|
if Backup then begin
|
|
Result:=BackupFileInteractive(Filename);
|
|
if Result<>mrOk then begin
|
|
debugln(['Error: (lazarus) unable to backup file: "',Filename,'"']);
|
|
exit;
|
|
end;
|
|
end else
|
|
Result:=mrOk;
|
|
repeat
|
|
if ACodeBuffer.SaveToFile(Filename) then begin
|
|
Result:=mrOk;
|
|
end else begin
|
|
ACaption:=lisWriteError;
|
|
AText:=Format(lisUnableToWriteToFile2, [Filename]);
|
|
Result:=IDEMessageDialog(ACaption,AText,mtError,[mbAbort, mbRetry, mbIgnore]);
|
|
if Result=mrAbort then exit;
|
|
if Result=mrIgnore then Result:=mrOk;
|
|
end;
|
|
until Result<>mrRetry;
|
|
end;
|
|
|
|
function LoadStringListFromFile(const Filename, ListTitle: string;
|
|
var sl: TStrings): TModalResult;
|
|
begin
|
|
Result:=mrCancel;
|
|
if sl=nil then
|
|
sl:=TStringList.Create;
|
|
try
|
|
sl.LoadFromFile(Filename);
|
|
Result:=mrOk;
|
|
except
|
|
on E: Exception do begin
|
|
IDEMessageDialog(lisCCOErrorCaption,
|
|
Format(lisErrorLoadingFrom,
|
|
[ListTitle, LineEnding, Filename, LineEnding+LineEnding, E.Message]),
|
|
mtError, [mbOk]);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function SaveStringListToFile(const Filename, ListTitle: string;
|
|
var sl: TStrings): TModalResult;
|
|
begin
|
|
Result:=mrCancel;
|
|
if sl=nil then
|
|
sl:=TStringList.Create;
|
|
try
|
|
sl.SaveToFile(Filename);
|
|
Result:=mrOk;
|
|
except
|
|
on E: Exception do begin
|
|
IDEMessageDialog(lisCCOErrorCaption, Format(lisErrorSavingTo, [ListTitle,
|
|
LineEnding, Filename, LineEnding+LineEnding, E.Message]), mtError, [mbOk]);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function LoadXMLConfigFromCodeBuffer(const Filename: string;
|
|
Config: TXMLConfig; out ACodeBuffer: TCodeBuffer; Flags: TLoadBufferFlags;
|
|
ShowAbort: boolean): TModalResult;
|
|
var
|
|
ms: TMemoryStream;
|
|
begin
|
|
Result:=LoadCodeBuffer(ACodeBuffer,Filename,Flags,ShowAbort);
|
|
if Result<>mrOk then begin
|
|
Config.Clear;
|
|
exit;
|
|
end;
|
|
ms:=TMemoryStream.Create;
|
|
try
|
|
ACodeBuffer.SaveToStream(ms);
|
|
ms.Position:=0;
|
|
try
|
|
if Config is TCodeBufXMLConfig then
|
|
TCodeBufXMLConfig(Config).KeepFileAttributes:=true;
|
|
Config.ReadFromStream(ms);
|
|
except
|
|
on E: Exception do begin
|
|
if (lbfQuiet in Flags) then begin
|
|
Result:=mrCancel;
|
|
end else begin
|
|
Result:=IDEMessageDialog(lisXMLError,
|
|
Format(lisXMLParserErrorInFileError, [Filename, LineEnding, E.Message]),
|
|
mtError, [mbCancel]);
|
|
end;
|
|
end;
|
|
end;
|
|
finally
|
|
ms.Free;
|
|
end;
|
|
end;
|
|
|
|
function SaveXMLConfigToCodeBuffer(const Filename: string;
|
|
Config: TXMLConfig; var ACodeBuffer: TCodeBuffer; KeepFileAttributes: boolean
|
|
): TModalResult;
|
|
var
|
|
ms: TMemoryStream;
|
|
begin
|
|
if ACodeBuffer=nil then begin
|
|
if KeepFileAttributes and FileExistsCached(Filename) then
|
|
ACodeBuffer:=CodeToolBoss.LoadFile(Filename,true,false)
|
|
else
|
|
ACodeBuffer:=CodeToolBoss.CreateFile(Filename);
|
|
if ACodeBuffer=nil then
|
|
exit(mrCancel);
|
|
end;
|
|
ms:=TMemoryStream.Create;
|
|
try
|
|
try
|
|
Config.WriteToStream(ms);
|
|
except
|
|
on E: Exception do begin
|
|
Result:=IDEMessageDialog(lisXMLError,
|
|
Format(lisUnableToWriteXmlStreamToError, [Filename, LineEnding, E.Message]),
|
|
mtError, [mbCancel]);
|
|
end;
|
|
end;
|
|
ms.Position:=0;
|
|
ACodeBuffer.LoadFromStream(ms);
|
|
Result:=SaveCodeBuffer(ACodeBuffer);
|
|
finally
|
|
ms.Free;
|
|
end;
|
|
end;
|
|
|
|
function CheckCreatingFile(const AFilename: string;
|
|
CheckReadable: boolean; WarnOverwrite: boolean; CreateBackup: boolean
|
|
): TModalResult;
|
|
var
|
|
fs: TFileStream;
|
|
c: char;
|
|
begin
|
|
// create if not yet done
|
|
if not FileExistsCached(AFilename) then begin
|
|
try
|
|
InvalidateFileStateCache;
|
|
fs:=TFileStream.Create(AFilename,fmCreate);
|
|
fs.Free;
|
|
except
|
|
Result:=IDEMessageDialog(lisUnableToCreateFile,
|
|
Format(lisUnableToCreateFile2, [AFilename]),
|
|
mtError, [mbCancel, mbAbort]);
|
|
exit;
|
|
end;
|
|
end else begin
|
|
// file already exists
|
|
if WarnOverwrite then begin
|
|
Result:=IDEQuestionDialog(lisOverwriteFile,
|
|
Format(lisAFileAlreadyExistsReplaceIt, [AFilename, LineEnding]),
|
|
mtConfirmation, [mrYes, lisOverwriteFileOnDisk,
|
|
mrCancel]);
|
|
if Result=mrCancel then exit;
|
|
end;
|
|
if CreateBackup then begin
|
|
Result:=BackupFileInteractive(AFilename);
|
|
if Result in [mrCancel,mrAbort] then exit;
|
|
Result:=CheckCreatingFile(AFilename,CheckReadable,false,false);
|
|
exit;
|
|
end;
|
|
end;
|
|
// check writable
|
|
try
|
|
if CheckReadable then begin
|
|
InvalidateFileStateCache;
|
|
fs:=TFileStream.Create(AFilename,fmOpenWrite or fmShareDenyNone)
|
|
end else
|
|
fs:=TFileStream.Create(AFilename,fmOpenReadWrite);
|
|
try
|
|
fs.Position:=fs.Size;
|
|
c := ' ';
|
|
fs.Write(c,1);
|
|
finally
|
|
fs.Free;
|
|
end;
|
|
except
|
|
Result:=IDEMessageDialog(lisUnableToWriteFile,
|
|
Format(lisUnableToWriteToFile2, [AFilename]), mtError, [mbCancel, mbAbort]);
|
|
exit;
|
|
end;
|
|
// check readable
|
|
try
|
|
InvalidateFileStateCache;
|
|
fs:=TFileStream.Create(AFilename,fmOpenReadWrite);
|
|
try
|
|
fs.Position:=fs.Size-1;
|
|
fs.Read(c,1);
|
|
finally
|
|
fs.Free;
|
|
end;
|
|
except
|
|
Result:=IDEMessageDialog(lisUnableToReadFile,
|
|
Format(lisUnableToReadFile2, [AFilename]),
|
|
mtError, [mbCancel, mbAbort]);
|
|
exit;
|
|
end;
|
|
Result:=mrOk;
|
|
end;
|
|
|
|
function CheckFileIsWritable(const Filename: string;
|
|
ErrorButtons: TMsgDlgButtons): TModalResult;
|
|
begin
|
|
while not FileIsWritable(Filename) do begin
|
|
Result:=IDEMessageDialog(lisFileIsNotWritable,
|
|
Format(lisUnableToWriteToFile2, [Filename]), mtError,
|
|
ErrorButtons+[mbCancel,mbRetry]);
|
|
if Result<>mrRetry then exit;
|
|
end;
|
|
Result:=mrOk;
|
|
end;
|
|
|
|
function ChooseSymlink(var Filename: string; const TargetFilename: string): TModalResult;
|
|
begin
|
|
// ask which filename to use
|
|
case IDEQuestionDialog(lisFileIsSymlink,
|
|
Format(lisTheFileIsASymlinkOpenInstead,[Filename,LineEnding+LineEnding,TargetFilename]),
|
|
mtConfirmation, [mrYes, lisOpenTarget,
|
|
mrNo, lisOpenSymlink,
|
|
mrCancel])
|
|
of
|
|
mrYes: Filename:=TargetFilename;
|
|
mrNo: ;
|
|
else exit(mrCancel);
|
|
end;
|
|
Result:=mrOk;
|
|
end;
|
|
|
|
function CreateSymlinkInteractive(const LinkFilename, TargetFilename: string;
|
|
ErrorButtons: TMsgDlgButtons): TModalResult;
|
|
begin
|
|
{$IFDEF Unix}
|
|
if FpReadLink(LinkFilename)=TargetFilename then exit(mrOk);
|
|
while FPSymLink(PChar(TargetFilename),PChar(LinkFilename)) <> 0 do begin
|
|
Result:=IDEMessageDialog(lisCodeToolsDefsWriteError,
|
|
Format(lisUnableToCreateLinkWithTarget, [LinkFilename, TargetFilename]),
|
|
mtError,ErrorButtons+[mbCancel,mbRetry],'');
|
|
if Result<>mrRetry then exit;
|
|
end;
|
|
InvalidateFileStateCache;
|
|
Result:=mrOk;
|
|
{$ELSE}
|
|
Result:=mrIgnore;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function ForceDirectoryInteractive(Directory: string;
|
|
ErrorButtons: TMsgDlgButtons): TModalResult;
|
|
var
|
|
i: integer;
|
|
Dir: string;
|
|
begin
|
|
ForcePathDelims(Directory);
|
|
Directory:=AppendPathDelim(Directory);
|
|
if DirPathExists(Directory) then exit(mrOk);
|
|
// skip UNC path
|
|
i := Length(ExtractUNCVolume(Directory)) + 1;
|
|
while i <= Length(Directory) do begin
|
|
if Directory[i]=PathDelim then begin
|
|
Dir:=copy(Directory,1,i-1);
|
|
if not DirPathExists(Dir) then begin
|
|
while not CreateDirUTF8(Dir) do begin
|
|
Result:=IDEMessageDialog(lisPkgMangUnableToCreateDirectory,
|
|
Format(lisUnableToCreateDirectory, [Dir]),
|
|
mtError,ErrorButtons+[mbCancel]);
|
|
if Result<>mrRetry then exit;
|
|
end;
|
|
InvalidateFileStateCache;
|
|
end;
|
|
end;
|
|
inc(i);
|
|
end;
|
|
Result:=mrOk;
|
|
end;
|
|
|
|
function CheckDirectoryIsWritable(const Filename: string;
|
|
ErrorButtons: TMsgDlgButtons): TModalResult;
|
|
begin
|
|
while not DirectoryIsWritable(Filename) do begin
|
|
Result:=IDEMessageDialog(lisDirectoryNotWritable,
|
|
Format(lisTheDirectoryIsNotWritable, [Filename]),
|
|
mtError,ErrorButtons+[mbCancel,mbRetry]);
|
|
if Result<>mrRetry then exit;
|
|
end;
|
|
Result:=mrOk;
|
|
end;
|
|
|
|
function CheckExecutable(const OldFilename,
|
|
NewFilename: string; const ErrorCaption, ErrorMsg: string;
|
|
SearchInPath: boolean): boolean;
|
|
var
|
|
Filename: String;
|
|
begin
|
|
Result:=true;
|
|
if OldFilename=NewFilename then exit;
|
|
Filename:=NewFilename;
|
|
if (not FilenameIsAbsolute(NewFilename)) and SearchInPath then begin
|
|
Filename:=FindDefaultExecutablePath(NewFilename);
|
|
if Filename='' then
|
|
Filename:=NewFilename;
|
|
end;
|
|
|
|
if (not FileIsExecutable(Filename)) then begin
|
|
if IDEMessageDialog(ErrorCaption,Format(ErrorMsg,[Filename]),
|
|
mtWarning,[mbIgnore,mbCancel])=mrCancel
|
|
then begin
|
|
Result:=false;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function CheckDirPathExists(const Dir, ErrorCaption, ErrorMsg: string): TModalResult;
|
|
begin
|
|
if not DirPathExists(Dir) then begin
|
|
Result:=IDEMessageDialog(ErrorCaption,Format(ErrorMsg,[Dir]),mtWarning,
|
|
[mbIgnore,mbCancel]);
|
|
end else
|
|
Result:=mrOk;
|
|
end;
|
|
|
|
function DeleteFileInteractive(const Filename: string;
|
|
ErrorButtons: TMsgDlgButtons): TModalResult;
|
|
begin
|
|
repeat
|
|
Result:=mrOk;
|
|
if not FileExistsUTF8(Filename) then exit;
|
|
if not DeleteFileUTF8(Filename) then begin
|
|
Result:=IDEMessageDialogAb(lisDeleteFileFailed,
|
|
Format(lisPkgMangUnableToDeleteFile, [Filename]),
|
|
mtError,[mbCancel,mbRetry]+ErrorButtons-[mbAbort],mbAbort in ErrorButtons);
|
|
if Result<>mrRetry then exit;
|
|
end;
|
|
until false;
|
|
end;
|
|
|
|
function SaveStringToFile(const Filename, Content: string;
|
|
ErrorButtons: TMsgDlgButtons; const Context: string): TModalResult;
|
|
var
|
|
fs: TFileStream;
|
|
begin
|
|
try
|
|
InvalidateFileStateCache;
|
|
fs:=TFileStream.Create(Filename,fmCreate);
|
|
try
|
|
if Content<>'' then
|
|
fs.Write(Content[1],length(Content));
|
|
finally
|
|
fs.Free;
|
|
end;
|
|
Result:=mrOk;
|
|
except
|
|
on E: Exception do begin
|
|
Result:=IDEMessageDialog(lisCodeToolsDefsWriteError,
|
|
Format(lisWriteErrorFile, [E.Message, LineEnding, Filename, LineEnding, Context]),
|
|
mtError,[mbAbort]+ErrorButtons);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function ConvertLFMToLRSFileInteractive(const LFMFilename,
|
|
LRSFilename: string; ShowAbort: boolean): TModalResult;
|
|
var
|
|
LFMMemStream, LRSMemStream: TMemoryStream;
|
|
LFMBuffer: TCodeBuffer;
|
|
LRSBuffer: TCodeBuffer;
|
|
FormClassName: String;
|
|
BinStream: TMemoryStream;
|
|
begin
|
|
// read lfm file
|
|
Result:=LoadCodeBuffer(LFMBuffer,LFMFilename,[lbfUpdateFromDisk],ShowAbort);
|
|
if Result<>mrOk then exit;
|
|
//debugln(['ConvertLFMToLRSFileInteractive ',LFMBuffer.Filename,' DiskEncoding=',LFMBuffer.DiskEncoding,' MemEncoding=',LFMBuffer.MemEncoding]);
|
|
LFMMemStream:=nil;
|
|
LRSMemStream:=nil;
|
|
try
|
|
LFMMemStream:=TMemoryStream.Create;
|
|
LFMBuffer.SaveToStream(LFMMemStream);
|
|
LFMMemStream.Position:=0;
|
|
LRSMemStream:=TMemoryStream.Create;
|
|
try
|
|
FormClassName:=FindLFMClassName(LFMMemStream);
|
|
//debugln(['ConvertLFMToLRSFileInteractive FormClassName="',FormClassName,'"']);
|
|
BinStream:=TMemoryStream.Create;
|
|
try
|
|
LRSObjectTextToBinary(LFMMemStream,BinStream);
|
|
BinStream.Position:=0;
|
|
BinaryToLazarusResourceCode(BinStream,LRSMemStream,FormClassName,'FORMDATA');
|
|
finally
|
|
BinStream.Free;
|
|
end;
|
|
except
|
|
on E: Exception do begin
|
|
{$IFNDEF DisableChecks}
|
|
DebugLn('LFMtoLRSstream ',E.Message);
|
|
{$ENDIF}
|
|
debugln(['Error: (lazarus) [ConvertLFMToLRSFileInteractive] unable to convert '+LFMFilename+' to '+LRSFilename+':'+LineEnding
|
|
+E.Message]);
|
|
Result:=IDEMessageDialogAb('Error',
|
|
'Error while converting '+LFMFilename+' to '+LRSFilename+':'+LineEnding
|
|
+E.Message,mtError,[mbCancel,mbIgnore],ShowAbort);
|
|
exit;
|
|
end;
|
|
end;
|
|
LRSMemStream.Position:=0;
|
|
// save lrs file
|
|
LRSBuffer:=CodeToolBoss.CreateFile(LRSFilename);
|
|
if (LRSBuffer<>nil) then begin
|
|
LRSBuffer.LoadFromStream(LRSMemStream);
|
|
Result:=SaveCodeBuffer(LRSBuffer);
|
|
end else begin
|
|
Result:=mrCancel;
|
|
debugln('Error: (lazarus) [ConvertLFMToLRSFileInteractive] unable to create codebuffer ',LRSFilename);
|
|
end;
|
|
finally
|
|
LFMMemStream.Free;
|
|
LRSMemStream.Free;
|
|
end;
|
|
end;
|
|
|
|
function IfNotOkJumpToCodetoolErrorAndAskToAbort(Ok: boolean;
|
|
Ask: boolean; out NewResult: TModalResult): boolean;
|
|
begin
|
|
if Ok then begin
|
|
NewResult:=mrOk;
|
|
Result:=true;
|
|
end else begin
|
|
NewResult:=JumpToCodetoolErrorAndAskToAbort(Ask);
|
|
Result:=NewResult<>mrAbort;
|
|
end;
|
|
end;
|
|
|
|
function JumpToCodetoolErrorAndAskToAbort(Ask: boolean): TModalResult;
|
|
// returns mrCancel or mrAbort
|
|
var
|
|
ErrMsg: String;
|
|
begin
|
|
ErrMsg:=CodeToolBoss.ErrorMessage;
|
|
LazarusIDE.DoJumpToCodeToolBossError;
|
|
if Ask then begin
|
|
Result:=IDEQuestionDialog(lisCCOErrorCaption,
|
|
Format(lisTheCodetoolsFoundAnError, [LineEnding, ErrMsg]),
|
|
mtWarning, [mrIgnore, lisIgnoreAndContinue,
|
|
mrAbort]);
|
|
if Result=mrIgnore then Result:=mrCancel;
|
|
end else begin
|
|
Result:=mrCancel;
|
|
end;
|
|
end;
|
|
|
|
procedure NotImplementedDialog(const Feature: string);
|
|
begin
|
|
IDEMessageDialog(lisNotImplemented,
|
|
Format(lisNotImplementedYet, [LineEnding, Feature]), mtError, [mbCancel]);
|
|
end;
|
|
|
|
end.
|
|
|