PageRenderTime 23ms CodeModel.GetById 19ms app.highlight 1ms RepoModel.GetById 1ms app.codeStats 0ms

/ide/ideprotocol.pas

http://github.com/graemeg/lazarus
Pascal | 133 lines | 85 code | 18 blank | 30 comment | 2 complexity | 4ea8e413c414102ed2f54023ced79801 MD5 | raw file
  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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, 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}
 28unit IDEProtocol;
 29
 30{$mode objfpc}{$H+}
 31
 32interface
 33
 34uses
 35  Classes, SysUtils, LCLProc, LazConf, BaseIDEIntf, LazConfigStorage,
 36  LazFileUtils;
 37  
 38const
 39  IDEProtocolOptsVersion: integer = 1;
 40  IDEProtocolFilename = 'protocol.xml';
 41
 42type
 43
 44  { TIDEProtocol }
 45
 46  TIDEProtocol = class
 47  private
 48    FFilename: string;
 49    FLastProjectLoadingCrashed: boolean;
 50  public
 51    constructor Create;
 52    destructor Destroy; override;
 53    procedure Load;
 54    procedure Save;
 55    procedure LoadFromConfig(Config: TConfigStorage; const Path: string);
 56    procedure SaveToConfig(Config: TConfigStorage; const Path: string);
 57  public
 58    property Filename: string read FFilename write FFilename;
 59    property LastProjectLoadingCrashed: boolean read FLastProjectLoadingCrashed
 60                                               write FLastProjectLoadingCrashed;
 61  end;
 62  
 63var
 64  IDEProtocolOpts: TIDEProtocol;
 65
 66implementation
 67
 68{ TIDEProtocol }
 69
 70constructor TIDEProtocol.Create;
 71begin
 72end;
 73
 74destructor TIDEProtocol.Destroy;
 75begin
 76  inherited Destroy;
 77end;
 78
 79procedure TIDEProtocol.Load;
 80var
 81  Config: TConfigStorage;
 82begin
 83  if Filename='' then
 84    Filename:=AppendPathDelim(GetPrimaryConfigPath)+IDEProtocolFilename;
 85  try
 86    Config:=DefaultConfigClass.Create(Filename,true);
 87    try
 88      LoadFromConfig(Config,'Protocol/');
 89    finally
 90      Config.Free;
 91    end;
 92  except
 93    on E: Exception do begin
 94      DebugLn('[TIDEProtocol.Load]  error reading "',Filename,'": ',E.Message);
 95    end;
 96  end;
 97end;
 98
 99procedure TIDEProtocol.Save;
100var
101  Config: TConfigStorage;
102begin
103  if Filename='' then
104    Filename:=AppendPathDelim(GetPrimaryConfigPath)+IDEProtocolFilename;
105  try
106    Config:=DefaultConfigClass.Create(Filename,false);
107    try
108      SaveToConfig(Config,'Protocol/');
109      Config.WriteToDisk;
110    finally
111      Config.Free;
112    end;
113  except
114    on E: Exception do begin
115      DebugLn('[TIDEProtocol.Save]  error writing "',Filename,'": ',E.Message);
116    end;
117  end;
118end;
119
120procedure TIDEProtocol.LoadFromConfig(Config: TConfigStorage; const Path: string);
121begin
122  FLastProjectLoadingCrashed:=Config.GetValue(Path+'LastProjectLoading/Failed',false);
123end;
124
125procedure TIDEProtocol.SaveToConfig(Config: TConfigStorage; const Path: string);
126begin
127  Config.SetValue(Path+'Version',IDEProtocolOptsVersion);
128  Config.SetDeleteValue(Path+'LastProjectLoading/Failed',
129                        FLastProjectLoadingCrashed,false);
130end;
131
132end.
133