1 { 2 *************************************************************************** 3 * * 4 * This source is free software; you can redistribute it and/or modify * 5 * it under the terms of the GNU General Public License as published by * 6 * the Free Software Foundation; either version 2 of the License, or * 7 * (at your option) any later version. * 8 * * 9 * This code is distributed in the hope that it will be useful, but * 10 * WITHOUT ANY WARRANTY; without even the implied warranty of * 11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * 12 * General Public License for more details. * 13 * * 14 * A copy of the GNU General Public License is available on the World * 15 * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also * 16 * obtain it by writing to the Free Software Foundation, * 17 * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. * 18 * * 19 *************************************************************************** 20 21 Author: Mattias Gaertner 22 23 Abstract: 24 The IDE keeps book about loading projects and forms. When an error occurs, 25 that kills the IDE, it will not open it automatically again the next time. 26 27 } 28 unit IDEProtocol; 29 30 {$mode objfpc}{$H+} 31 32 interface 33 34 uses 35 Classes, SysUtils, 36 // LCL 37 LCLProc, 38 // LazUtils 39 LazConfigStorage, LazFileUtils, 40 // IdeIntf 41 BaseIDEIntf, 42 // IDE 43 LazConf; 44 45 const 46 IDEProtocolOptsVersion: integer = 1; 47 IDEProtocolFilename = 'protocol.xml'; 48 49 type 50 51 { TIDEProtocol } 52 53 TIDEProtocol = class 54 private 55 FFilename: string; 56 FLastProjectLoadingCrashed: boolean; 57 public 58 constructor Create; 59 destructor Destroy; override; 60 procedure Load; 61 procedure Save; 62 procedure LoadFromConfig(Config: TConfigStorage; const Path: string); 63 procedure SaveToConfig(Config: TConfigStorage; const Path: string); 64 public 65 property Filename: string read FFilename write FFilename; 66 property LastProjectLoadingCrashed: boolean read FLastProjectLoadingCrashed 67 write FLastProjectLoadingCrashed; 68 end; 69 70 var 71 IDEProtocolOpts: TIDEProtocol; 72 73 implementation 74 75 { TIDEProtocol } 76 77 constructor TIDEProtocol.Create; 78 begin 79 end; 80 81 destructor TIDEProtocol.Destroy; 82 begin 83 inherited Destroy; 84 end; 85 86 procedure TIDEProtocol.Load; 87 var 88 Config: TConfigStorage; 89 begin 90 if Filename='' then 91 Filename:=AppendPathDelim(GetPrimaryConfigPath)+IDEProtocolFilename; 92 try 93 Config:=DefaultConfigClass.Create(Filename,true); 94 try 95 LoadFromConfig(Config,'Protocol/'); 96 finally 97 Config.Free; 98 end; 99 except 100 on E: Exception do begin 101 DebugLn('[TIDEProtocol.Load] error reading "',Filename,'": ',E.Message); 102 end; 103 end; 104 end; 105 106 procedure TIDEProtocol.Save; 107 var 108 Config: TConfigStorage; 109 begin 110 if Filename='' then 111 Filename:=AppendPathDelim(GetPrimaryConfigPath)+IDEProtocolFilename; 112 try 113 Config:=DefaultConfigClass.Create(Filename,false); 114 try 115 SaveToConfig(Config,'Protocol/'); 116 Config.WriteToDisk; 117 finally 118 Config.Free; 119 end; 120 except 121 on E: Exception do begin 122 DebugLn('[TIDEProtocol.Save] error writing "',Filename,'": ',E.Message); 123 end; 124 end; 125 end; 126 127 procedure TIDEProtocol.LoadFromConfig(Config: TConfigStorage; const Path: string); 128 begin 129 FLastProjectLoadingCrashed:=Config.GetValue(Path+'LastProjectLoading/Failed',false); 130 end; 131 132 procedure TIDEProtocol.SaveToConfig(Config: TConfigStorage; const Path: string); 133 begin 134 Config.SetValue(Path+'Version',IDEProtocolOptsVersion); 135 Config.SetDeleteValue(Path+'LastProjectLoading/Failed', 136 FLastProjectLoadingCrashed,false); 137 end; 138 139 end. 140 141