1 {
2 /***************************************************************************
3 dialogprocs.pas
4 ---------------
5
6 ***************************************************************************/
7
8 ***************************************************************************
9 * *
10 * This source is free software; you can redistribute it and/or modify *
11 * it under the terms of the GNU General Public License as published by *
12 * the Free Software Foundation; either version 2 of the License, or *
13 * (at your option) any later version. *
14 * *
15 * This code is distributed in the hope that it will be useful, but *
16 * WITHOUT ANY WARRANTY; without even the implied warranty of *
17 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
18 * General Public License for more details. *
19 * *
20 * A copy of the GNU General Public License is available on the World *
21 * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
22 * obtain it by writing to the Free Software Foundation, *
23 * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
24 * *
25 ***************************************************************************
26
27 Author: Mattias Gaertner
28
29 Abstract:
30 Common IDE functions with MessageDlg(s) for errors.
31 }
32 unit DialogProcs;
33
34 {$mode objfpc}{$H+}
35
36 interface
37
38 uses
39 Classes, SysUtils,
40 // LCL
41 LCLProc, LResources, Forms, Controls, Dialogs, ComCtrls,
42 // LazUtils
43 FileUtil, LazFileUtils, LazFileCache, Laz2_XMLCfg,
44 // CodeTools
45 FileProcs, CodeToolsConfig, CodeCache, CodeToolManager,
46 // IdeIntf
47 LazIDEIntf, IDEDialogs,
48 // IDE
49 IDEProcs, LazarusIDEStrConsts;
50
51 type
52 // load buffer flags
53 TLoadBufferFlag = (
54 lbfUpdateFromDisk,
55 lbfRevert,
56 lbfCheckIfText,
57 lbfQuiet,
58 lbfCreateClearOnError,
59 lbfIgnoreMissing
60 );
61 TLoadBufferFlags = set of TLoadBufferFlag;
62
63 TOnBackupFileInteractive =
onstnull64 function(const Filename: string): TModalResult of object;
65
endernull66 TOnDragOverTreeView = function(Sender, Source: TObject; X, Y: Integer;
67 out TargetTVNode: TTreeNode; out TargetTVType: TTreeViewInsertMarkType
68 ): boolean of object;
69
70 var
71 OnBackupFileInteractive: TOnBackupFileInteractive = nil;
72
BackupFileInteractivenull73 function BackupFileInteractive(const Filename: string): TModalResult;
RenameFileWithErrorDialogsnull74 function RenameFileWithErrorDialogs(const SrcFilename, DestFilename: string;
75 ExtraButtons: TMsgDlgButtons = []): TModalResult;
CopyFileWithErrorDialogsnull76 function CopyFileWithErrorDialogs(const SrcFilename, DestFilename: string;
77 ExtraButtons: TMsgDlgButtons = []): TModalResult;
LoadCodeBuffernull78 function LoadCodeBuffer(out ACodeBuffer: TCodeBuffer; const AFilename: string;
79 Flags: TLoadBufferFlags; ShowAbort: boolean): TModalResult;
SaveCodeBuffernull80 function SaveCodeBuffer(ACodeBuffer: TCodeBuffer): TModalResult;
SaveCodeBufferToFilenull81 function SaveCodeBufferToFile(ACodeBuffer: TCodeBuffer;
82 const Filename: string; Backup: boolean = false): TModalResult;
LoadStringListFromFilenull83 function LoadStringListFromFile(const Filename, ListTitle: string;
84 var sl: TStrings): TModalResult;
SaveStringListToFilenull85 function SaveStringListToFile(const Filename, ListTitle: string;
86 var sl: TStrings): TModalResult;
LoadXMLConfigFromCodeBuffernull87 function LoadXMLConfigFromCodeBuffer(const Filename: string; Config: TXMLConfig;
88 out ACodeBuffer: TCodeBuffer; Flags: TLoadBufferFlags;
89 ShowAbort: boolean
90 ): TModalResult;
SaveXMLConfigToCodeBuffernull91 function SaveXMLConfigToCodeBuffer(const Filename: string; Config: TXMLConfig;
92 var ACodeBuffer: TCodeBuffer;
93 KeepFileAttributes: boolean): TModalResult;
CheckCreatingFilenull94 function CheckCreatingFile(const AFilename: string;
95 CheckReadable: boolean;
96 WarnOverwrite: boolean = false;
97 CreateBackup: boolean = false
98 ): TModalResult;
CheckFileIsWritablenull99 function CheckFileIsWritable(const Filename: string;
100 ErrorButtons: TMsgDlgButtons = []): TModalResult;
CheckDirectoryIsWritablenull101 function CheckDirectoryIsWritable(const Filename: string;
102 ErrorButtons: TMsgDlgButtons = []): TModalResult;
CheckExecutablenull103 function CheckExecutable(const OldFilename,
104 NewFilename: string; const ErrorCaption, ErrorMsg: string;
105 SearchInPath: boolean = true): boolean;
CheckDirPathExistsnull106 function CheckDirPathExists(const Dir, ErrorCaption, ErrorMsg: string): TModalResult;
ChooseSymlinknull107 function ChooseSymlink(var Filename: string; const TargetFilename: string): TModalResult;
CreateSymlinkInteractivenull108 function CreateSymlinkInteractive(const {%H-}LinkFilename, {%H-}TargetFilename: string;
109 {%H-}ErrorButtons: TMsgDlgButtons = []): TModalResult;
ForceDirectoryInteractivenull110 function ForceDirectoryInteractive(Directory: string;
111 ErrorButtons: TMsgDlgButtons = []): TModalResult;
DeleteFileInteractivenull112 function DeleteFileInteractive(const Filename: string;
113 ErrorButtons: TMsgDlgButtons = []): TModalResult;
SaveStringToFilenull114 function SaveStringToFile(const Filename, Content: string;
115 ErrorButtons: TMsgDlgButtons; const Context: string = ''
116 ): TModalResult;
ConvertLFMToLRSFileInteractivenull117 function ConvertLFMToLRSFileInteractive(const LFMFilename,
118 LRSFilename: string; ShowAbort: boolean): TModalResult;
IfNotOkJumpToCodetoolErrorAndAskToAbortnull119 function IfNotOkJumpToCodetoolErrorAndAskToAbort(Ok: boolean;
120 Ask: boolean; out NewResult: TModalResult): boolean;
JumpToCodetoolErrorAndAskToAbortnull121 function JumpToCodetoolErrorAndAskToAbort(Ask: boolean): TModalResult;
122 procedure NotImplementedDialog(const Feature: string);
123
124 implementation
125
126 {$IFDEF Unix}
127 uses
128 baseunix;
129 {$ENDIF}
130
BackupFileInteractivenull131 function BackupFileInteractive(const Filename: string): TModalResult;
132 begin
133 if Assigned(OnBackupFileInteractive) then
134 Result:=OnBackupFileInteractive(Filename)
135 else
136 Result:=mrOk;
137 end;
138
RenameFileWithErrorDialogsnull139 function RenameFileWithErrorDialogs(const SrcFilename, DestFilename: string;
140 ExtraButtons: TMsgDlgButtons): TModalResult;
141 var
142 DlgButtons: TMsgDlgButtons;
143 begin
144 if SrcFilename=DestFilename then
145 exit(mrOk);
146 repeat
147 if RenameFileUTF8(SrcFilename,DestFilename) then begin
148 InvalidateFileStateCache(SrcFilename);
149 InvalidateFileStateCache(DestFilename);
150 break;
151 end else begin
152 DlgButtons:=[mbRetry]+ExtraButtons;
153 Result:=IDEMessageDialog(lisUnableToRenameFile,
154 Format(lisUnableToRenameFileTo2, [SrcFilename, LineEnding, DestFilename]),
155 mtError,DlgButtons);
156 if (Result<>mrRetry) then exit;
157 end;
158 until false;
159 Result:=mrOk;
160 end;
161
CopyFileWithErrorDialogsnull162 function CopyFileWithErrorDialogs(const SrcFilename, DestFilename: string;
163 ExtraButtons: TMsgDlgButtons): TModalResult;
164 var
165 DlgButtons: TMsgDlgButtons;
166 begin
167 if CompareFilenames(SrcFilename,DestFilename)=0 then begin
168 Result:=mrAbort;
169 IDEMessageDialog(lisUnableToCopyFile,
170 Format(lisSourceAndDestinationAreTheSame, [LineEnding, SrcFilename]),
171 mtError, [mbAbort]);
172 exit;
173 end;
174 repeat
175 if CopyFile(SrcFilename,DestFilename) then begin
176 InvalidateFileStateCache(DestFilename);
177 break;
178 end else begin
179 DlgButtons:=[mbCancel,mbRetry]+ExtraButtons;
180 Result:=IDEMessageDialog(lisUnableToCopyFile,
181 Format(lisUnableToCopyFileTo, [SrcFilename, LineEnding, DestFilename]),
182 mtError,DlgButtons);
183 if (Result<>mrRetry) then exit;
184 end;
185 until false;
186 Result:=mrOk;
187 end;
188
LoadCodeBuffernull189 function LoadCodeBuffer(out ACodeBuffer: TCodeBuffer; const AFilename: string;
190 Flags: TLoadBufferFlags; ShowAbort: boolean): TModalResult;
191 var
192 ACaption, AText: string;
193 FileReadable: boolean;
194 begin
195 ACodeBuffer:=nil;
196 if not FilenameIsAbsolute(AFilename) then
197 Flags:=Flags-[lbfUpdateFromDisk,lbfRevert];
198 if lbfCreateClearOnError in Flags then
199 Exclude(Flags,lbfIgnoreMissing);
200 if [lbfUpdateFromDisk,lbfRevert]*Flags=[] then begin
201 // can use cache
202 ACodeBuffer:=CodeToolBoss.LoadFile(AFilename,false,false);
203 if ACodeBuffer<>nil then begin
204 // file is in cache
205 if (not (lbfCheckIfText in Flags)) or ACodeBuffer.SourceIsText then
206 exit(mrOk);
207 ACodeBuffer:=nil;
208 end;
209 end;
210 repeat
211 FileReadable:=true;
212 if (lbfCheckIfText in Flags)
213 and (not FileIsText(AFilename,FileReadable)) and FileReadable
214 then begin
215 if lbfQuiet in Flags then begin
216 Result:=mrCancel;
217 end else begin
218 ACaption:=lisFileNotText;
219 AText:=Format(lisFileDoesNotLookLikeATextFileOpenItAnyway,[AFilename,LineEnding,LineEnding]);
220 Result:=IDEMessageDialogAb(ACaption, AText, mtConfirmation,
221 [mbOk, mbIgnore],ShowAbort);
222 end;
223 if Result<>mrOk then break;
224 end;
225 if FileReadable then
226 ACodeBuffer:=CodeToolBoss.LoadFile(AFilename,lbfUpdateFromDisk in Flags,
227 lbfRevert in Flags)
228 else
229 ACodeBuffer:=nil;
230
231 if ACodeBuffer<>nil then begin
232 Result:=mrOk;
233 end else begin
234 // read error
235 if lbfIgnoreMissing in Flags then begin
236 if (FilenameIsAbsolute(AFilename) and not FileExistsCached(AFilename))
237 then
238 exit(mrIgnore);
239 end;
240 if lbfQuiet in Flags then
241 Result:=mrCancel
242 else begin
243 ACaption:=lisReadError;
244 AText:=Format(lisUnableToReadFile2, [AFilename]);
245 Result:=IDEMessageDialogAb(ACaption,AText,mtError,[mbRetry,mbIgnore],ShowAbort);
246 if Result=mrAbort then exit;
247 end;
248 end;
249 until Result<>mrRetry;
250 if (ACodeBuffer=nil) and (lbfCreateClearOnError in Flags) then begin
251 ACodeBuffer:=CodeToolBoss.CreateFile(AFilename);
252 if ACodeBuffer<>nil then
253 Result:=mrOk;
254 end;
255 end;
256
SaveCodeBuffernull257 function SaveCodeBuffer(ACodeBuffer: TCodeBuffer): TModalResult;
258 begin
259 repeat
260 if ACodeBuffer.Save then begin
261 Result:=mrOk;
262 end else begin
263 Result:=IDEMessageDialog(lisCodeToolsDefsWriteError,
264 Format(lisUnableToWrite2, [ACodeBuffer.Filename]),
265 mtError,[mbAbort,mbRetry,mbIgnore]);
266 end;
267 until Result<>mrRetry;
268 end;
269
SaveCodeBufferToFilenull270 function SaveCodeBufferToFile(ACodeBuffer: TCodeBuffer; const Filename: string;
271 Backup: boolean): TModalResult;
272 var
273 ACaption,AText:string;
274 begin
275 if Backup then begin
276 Result:=BackupFileInteractive(Filename);
277 if Result<>mrOk then begin
278 debugln(['Error: (lazarus) unable to backup file: "',Filename,'"']);
279 exit;
280 end;
281 end else
282 Result:=mrOk;
283 repeat
284 if ACodeBuffer.SaveToFile(Filename) then begin
285 Result:=mrOk;
286 end else begin
287 ACaption:=lisWriteError;
288 AText:=Format(lisUnableToWriteToFile2, [Filename]);
289 Result:=IDEMessageDialog(ACaption,AText,mtError,[mbAbort, mbRetry, mbIgnore]);
290 if Result=mrAbort then exit;
291 if Result=mrIgnore then Result:=mrOk;
292 end;
293 until Result<>mrRetry;
294 end;
295
LoadStringListFromFilenull296 function LoadStringListFromFile(const Filename, ListTitle: string;
297 var sl: TStrings): TModalResult;
298 begin
299 Result:=mrCancel;
300 if sl=nil then
301 sl:=TStringList.Create;
302 try
303 sl.LoadFromFile(Filename);
304 Result:=mrOk;
305 except
306 on E: Exception do begin
307 IDEMessageDialog(lisCCOErrorCaption,
308 Format(lisErrorLoadingFrom,
309 [ListTitle, LineEnding, Filename, LineEnding+LineEnding, E.Message]),
310 mtError, [mbOk]);
311 end;
312 end;
313 end;
314
SaveStringListToFilenull315 function SaveStringListToFile(const Filename, ListTitle: string;
316 var sl: TStrings): TModalResult;
317 begin
318 Result:=mrCancel;
319 if sl=nil then
320 sl:=TStringList.Create;
321 try
322 sl.SaveToFile(Filename);
323 Result:=mrOk;
324 except
325 on E: Exception do begin
326 IDEMessageDialog(lisCCOErrorCaption, Format(lisErrorSavingTo, [ListTitle,
327 LineEnding, Filename, LineEnding+LineEnding, E.Message]), mtError, [mbOk]);
328 end;
329 end;
330 end;
331
LoadXMLConfigFromCodeBuffernull332 function LoadXMLConfigFromCodeBuffer(const Filename: string;
333 Config: TXMLConfig; out ACodeBuffer: TCodeBuffer; Flags: TLoadBufferFlags;
334 ShowAbort: boolean): TModalResult;
335 var
336 ms: TMemoryStream;
337 begin
338 Result:=LoadCodeBuffer(ACodeBuffer,Filename,Flags,ShowAbort);
339 if Result<>mrOk then begin
340 Config.Clear;
341 exit;
342 end;
343 ms:=TMemoryStream.Create;
344 try
345 ACodeBuffer.SaveToStream(ms);
346 ms.Position:=0;
347 try
348 if Config is TCodeBufXMLConfig then
349 TCodeBufXMLConfig(Config).KeepFileAttributes:=true;
350 Config.ReadFromStream(ms);
351 except
352 on E: Exception do begin
353 if (lbfQuiet in Flags) then begin
354 Result:=mrCancel;
355 end else begin
356 Result:=IDEMessageDialog(lisXMLError,
357 Format(lisXMLParserErrorInFileError, [Filename, LineEnding, E.Message]),
358 mtError, [mbCancel]);
359 end;
360 end;
361 end;
362 finally
363 ms.Free;
364 end;
365 end;
366
SaveXMLConfigToCodeBuffernull367 function SaveXMLConfigToCodeBuffer(const Filename: string;
368 Config: TXMLConfig; var ACodeBuffer: TCodeBuffer; KeepFileAttributes: boolean
369 ): TModalResult;
370 var
371 ms: TMemoryStream;
372 begin
373 if ACodeBuffer=nil then begin
374 if KeepFileAttributes and FileExistsCached(Filename) then
375 ACodeBuffer:=CodeToolBoss.LoadFile(Filename,true,false)
376 else
377 ACodeBuffer:=CodeToolBoss.CreateFile(Filename);
378 if ACodeBuffer=nil then
379 exit(mrCancel);
380 end;
381 ms:=TMemoryStream.Create;
382 try
383 try
384 Config.WriteToStream(ms);
385 except
386 on E: Exception do begin
387 Result:=IDEMessageDialog(lisXMLError,
388 Format(lisUnableToWriteXmlStreamToError, [Filename, LineEnding, E.Message]),
389 mtError, [mbCancel]);
390 end;
391 end;
392 ms.Position:=0;
393 ACodeBuffer.LoadFromStream(ms);
394 Result:=SaveCodeBuffer(ACodeBuffer);
395 finally
396 ms.Free;
397 end;
398 end;
399
CheckCreatingFilenull400 function CheckCreatingFile(const AFilename: string;
401 CheckReadable: boolean; WarnOverwrite: boolean; CreateBackup: boolean
402 ): TModalResult;
403 var
404 fs: TFileStream;
405 c: char;
406 begin
407 // create if not yet done
408 if not FileExistsCached(AFilename) then begin
409 try
410 InvalidateFileStateCache;
411 fs:=TFileStream.Create(AFilename,fmCreate);
412 fs.Free;
413 except
414 Result:=IDEMessageDialog(lisUnableToCreateFile,
415 Format(lisUnableToCreateFile2, [AFilename]),
416 mtError, [mbCancel, mbAbort]);
417 exit;
418 end;
419 end else begin
420 // file already exists
421 if WarnOverwrite then begin
422 Result:=IDEQuestionDialog(lisOverwriteFile,
423 Format(lisAFileAlreadyExistsReplaceIt, [AFilename, LineEnding]),
424 mtConfirmation, [mrYes, lisOverwriteFileOnDisk,
425 mrCancel]);
426 if Result=mrCancel then exit;
427 end;
428 if CreateBackup then begin
429 Result:=BackupFileInteractive(AFilename);
430 if Result in [mrCancel,mrAbort] then exit;
431 Result:=CheckCreatingFile(AFilename,CheckReadable,false,false);
432 exit;
433 end;
434 end;
435 // check writable
436 try
437 if CheckReadable then begin
438 InvalidateFileStateCache;
439 fs:=TFileStream.Create(AFilename,fmOpenWrite or fmShareDenyNone)
440 end else
441 fs:=TFileStream.Create(AFilename,fmOpenReadWrite);
442 try
443 fs.Position:=fs.Size;
444 c := ' ';
445 fs.Write(c,1);
446 finally
447 fs.Free;
448 end;
449 except
450 Result:=IDEMessageDialog(lisUnableToWriteFile,
451 Format(lisUnableToWriteToFile2, [AFilename]), mtError, [mbCancel, mbAbort]);
452 exit;
453 end;
454 // check readable
455 try
456 InvalidateFileStateCache;
457 fs:=TFileStream.Create(AFilename,fmOpenReadWrite);
458 try
459 fs.Position:=fs.Size-1;
460 fs.Read(c,1);
461 finally
462 fs.Free;
463 end;
464 except
465 Result:=IDEMessageDialog(lisUnableToReadFile,
466 Format(lisUnableToReadFile2, [AFilename]),
467 mtError, [mbCancel, mbAbort]);
468 exit;
469 end;
470 Result:=mrOk;
471 end;
472
CheckFileIsWritablenull473 function CheckFileIsWritable(const Filename: string;
474 ErrorButtons: TMsgDlgButtons): TModalResult;
475 begin
476 while not FileIsWritable(Filename) do begin
477 Result:=IDEMessageDialog(lisFileIsNotWritable,
478 Format(lisUnableToWriteToFile2, [Filename]), mtError,
479 ErrorButtons+[mbCancel,mbRetry]);
480 if Result<>mrRetry then exit;
481 end;
482 Result:=mrOk;
483 end;
484
ChooseSymlinknull485 function ChooseSymlink(var Filename: string; const TargetFilename: string): TModalResult;
486 begin
487 // ask which filename to use
488 case IDEQuestionDialog(lisFileIsSymlink,
489 Format(lisTheFileIsASymlinkOpenInstead,[Filename,LineEnding+LineEnding,TargetFilename]),
490 mtConfirmation, [mrYes, lisOpenTarget,
491 mrNo, lisOpenSymlink,
492 mrCancel])
493 of
494 mrYes: Filename:=TargetFilename;
495 mrNo: ;
496 else exit(mrCancel);
497 end;
498 Result:=mrOk;
499 end;
500
CreateSymlinkInteractivenull501 function CreateSymlinkInteractive(const LinkFilename, TargetFilename: string;
502 ErrorButtons: TMsgDlgButtons): TModalResult;
503 begin
504 {$IFDEF Unix}
505 if FpReadLink(LinkFilename)=TargetFilename then exit(mrOk);
506 while FPSymLink(PChar(TargetFilename),PChar(LinkFilename)) <> 0 do begin
507 Result:=IDEMessageDialog(lisCodeToolsDefsWriteError,
508 Format(lisUnableToCreateLinkWithTarget, [LinkFilename, TargetFilename]),
509 mtError,ErrorButtons+[mbCancel,mbRetry],'');
510 if Result<>mrRetry then exit;
511 end;
512 InvalidateFileStateCache;
513 Result:=mrOk;
514 {$ELSE}
515 Result:=mrIgnore;
516 {$ENDIF}
517 end;
518
ForceDirectoryInteractivenull519 function ForceDirectoryInteractive(Directory: string;
520 ErrorButtons: TMsgDlgButtons): TModalResult;
521 var
522 i: integer;
523 Dir: string;
524 begin
525 ForcePathDelims(Directory);
526 Directory:=AppendPathDelim(Directory);
527 if DirPathExists(Directory) then exit(mrOk);
528 // skip UNC path
529 i := Length(ExtractUNCVolume(Directory)) + 1;
530 while i <= Length(Directory) do begin
531 if Directory[i]=PathDelim then begin
532 Dir:=copy(Directory,1,i-1);
533 if not DirPathExists(Dir) then begin
534 while not CreateDirUTF8(Dir) do begin
535 Result:=IDEMessageDialog(lisPkgMangUnableToCreateDirectory,
536 Format(lisUnableToCreateDirectory, [Dir]),
537 mtError,ErrorButtons+[mbCancel]);
538 if Result<>mrRetry then exit;
539 end;
540 InvalidateFileStateCache;
541 end;
542 end;
543 inc(i);
544 end;
545 Result:=mrOk;
546 end;
547
CheckDirectoryIsWritablenull548 function CheckDirectoryIsWritable(const Filename: string;
549 ErrorButtons: TMsgDlgButtons): TModalResult;
550 begin
551 while not DirectoryIsWritable(Filename) do begin
552 Result:=IDEMessageDialog(lisDirectoryNotWritable,
553 Format(lisTheDirectoryIsNotWritable, [Filename]),
554 mtError,ErrorButtons+[mbCancel,mbRetry]);
555 if Result<>mrRetry then exit;
556 end;
557 Result:=mrOk;
558 end;
559
CheckExecutablenull560 function CheckExecutable(const OldFilename,
561 NewFilename: string; const ErrorCaption, ErrorMsg: string;
562 SearchInPath: boolean): boolean;
563 var
564 Filename: String;
565 begin
566 Result:=true;
567 if OldFilename=NewFilename then exit;
568 Filename:=NewFilename;
569 if (not FilenameIsAbsolute(NewFilename)) and SearchInPath then begin
570 Filename:=FindDefaultExecutablePath(NewFilename);
571 if Filename='' then
572 Filename:=NewFilename;
573 end;
574
575 if (not FileIsExecutable(Filename)) then begin
576 if IDEMessageDialog(ErrorCaption,Format(ErrorMsg,[Filename]),
577 mtWarning,[mbIgnore,mbCancel])=mrCancel
578 then begin
579 Result:=false;
580 end;
581 end;
582 end;
583
CheckDirPathExistsnull584 function CheckDirPathExists(const Dir, ErrorCaption, ErrorMsg: string): TModalResult;
585 begin
586 if not DirPathExists(Dir) then begin
587 Result:=IDEMessageDialog(ErrorCaption,Format(ErrorMsg,[Dir]),mtWarning,
588 [mbIgnore,mbCancel]);
589 end else
590 Result:=mrOk;
591 end;
592
DeleteFileInteractivenull593 function DeleteFileInteractive(const Filename: string;
594 ErrorButtons: TMsgDlgButtons): TModalResult;
595 begin
596 repeat
597 Result:=mrOk;
598 if not FileExistsUTF8(Filename) then exit;
599 if not DeleteFileUTF8(Filename) then begin
600 Result:=IDEMessageDialogAb(lisDeleteFileFailed,
601 Format(lisPkgMangUnableToDeleteFile, [Filename]),
602 mtError,[mbCancel,mbRetry]+ErrorButtons-[mbAbort],mbAbort in ErrorButtons);
603 if Result<>mrRetry then exit;
604 end;
605 until false;
606 end;
607
SaveStringToFilenull608 function SaveStringToFile(const Filename, Content: string;
609 ErrorButtons: TMsgDlgButtons; const Context: string): TModalResult;
610 var
611 fs: TFileStream;
612 begin
613 try
614 InvalidateFileStateCache;
615 fs:=TFileStream.Create(Filename,fmCreate);
616 try
617 if Content<>'' then
618 fs.Write(Content[1],length(Content));
619 finally
620 fs.Free;
621 end;
622 Result:=mrOk;
623 except
624 on E: Exception do begin
625 Result:=IDEMessageDialog(lisCodeToolsDefsWriteError,
626 Format(lisWriteErrorFile, [E.Message, LineEnding, Filename, LineEnding, Context]),
627 mtError,[mbAbort]+ErrorButtons);
628 end;
629 end;
630 end;
631
ConvertLFMToLRSFileInteractivenull632 function ConvertLFMToLRSFileInteractive(const LFMFilename,
633 LRSFilename: string; ShowAbort: boolean): TModalResult;
634 var
635 LFMMemStream, LRSMemStream: TMemoryStream;
636 LFMBuffer: TCodeBuffer;
637 LRSBuffer: TCodeBuffer;
638 FormClassName: String;
639 BinStream: TMemoryStream;
640 begin
641 // read lfm file
642 Result:=LoadCodeBuffer(LFMBuffer,LFMFilename,[lbfUpdateFromDisk],ShowAbort);
643 if Result<>mrOk then exit;
644 //debugln(['ConvertLFMToLRSFileInteractive ',LFMBuffer.Filename,' DiskEncoding=',LFMBuffer.DiskEncoding,' MemEncoding=',LFMBuffer.MemEncoding]);
645 LFMMemStream:=nil;
646 LRSMemStream:=nil;
647 try
648 LFMMemStream:=TMemoryStream.Create;
649 LFMBuffer.SaveToStream(LFMMemStream);
650 LFMMemStream.Position:=0;
651 LRSMemStream:=TMemoryStream.Create;
652 try
653 FormClassName:=FindLFMClassName(LFMMemStream);
654 //debugln(['ConvertLFMToLRSFileInteractive FormClassName="',FormClassName,'"']);
655 BinStream:=TMemoryStream.Create;
656 try
657 LRSObjectTextToBinary(LFMMemStream,BinStream);
658 BinStream.Position:=0;
659 BinaryToLazarusResourceCode(BinStream,LRSMemStream,FormClassName,'FORMDATA');
660 finally
661 BinStream.Free;
662 end;
663 except
664 on E: Exception do begin
665 {$IFNDEF DisableChecks}
666 DebugLn('LFMtoLRSstream ',E.Message);
667 {$ENDIF}
668 debugln(['Error: (lazarus) [ConvertLFMToLRSFileInteractive] unable to convert '+LFMFilename+' to '+LRSFilename+':'+LineEnding
669 +E.Message]);
670 Result:=IDEMessageDialogAb('Error',
671 'Error while converting '+LFMFilename+' to '+LRSFilename+':'+LineEnding
672 +E.Message,mtError,[mbCancel,mbIgnore],ShowAbort);
673 exit;
674 end;
675 end;
676 LRSMemStream.Position:=0;
677 // save lrs file
678 LRSBuffer:=CodeToolBoss.CreateFile(LRSFilename);
679 if (LRSBuffer<>nil) then begin
680 LRSBuffer.LoadFromStream(LRSMemStream);
681 Result:=SaveCodeBuffer(LRSBuffer);
682 end else begin
683 Result:=mrCancel;
684 debugln('Error: (lazarus) [ConvertLFMToLRSFileInteractive] unable to create codebuffer ',LRSFilename);
685 end;
686 finally
687 LFMMemStream.Free;
688 LRSMemStream.Free;
689 end;
690 end;
691
IfNotOkJumpToCodetoolErrorAndAskToAbortnull692 function IfNotOkJumpToCodetoolErrorAndAskToAbort(Ok: boolean;
693 Ask: boolean; out NewResult: TModalResult): boolean;
694 begin
695 if Ok then begin
696 NewResult:=mrOk;
697 Result:=true;
698 end else begin
699 NewResult:=JumpToCodetoolErrorAndAskToAbort(Ask);
700 Result:=NewResult<>mrAbort;
701 end;
702 end;
703
JumpToCodetoolErrorAndAskToAbortnull704 function JumpToCodetoolErrorAndAskToAbort(Ask: boolean): TModalResult;
705 // returns mrCancel or mrAbort
706 var
707 ErrMsg: String;
708 begin
709 ErrMsg:=CodeToolBoss.ErrorMessage;
710 LazarusIDE.DoJumpToCodeToolBossError;
711 if Ask then begin
712 Result:=IDEQuestionDialog(lisCCOErrorCaption,
713 Format(lisTheCodetoolsFoundAnError, [LineEnding, ErrMsg]),
714 mtWarning, [mrIgnore, lisIgnoreAndContinue,
715 mrAbort]);
716 if Result=mrIgnore then Result:=mrCancel;
717 end else begin
718 Result:=mrCancel;
719 end;
720 end;
721
722 procedure NotImplementedDialog(const Feature: string);
723 begin
724 IDEMessageDialog(lisNotImplemented,
725 Format(lisNotImplementedYet, [LineEnding, Feature]), mtError, [mbCancel]);
726 end;
727
728 end.
729
730