1 {
2  *****************************************************************************
3   This file is part of the EducationLaz package
4 
5   See the file COPYING.modifiedLGPL.txt, included in this distribution,
6   for details about the license.
7  *****************************************************************************
8 
9   Author: Mattias Gaertner
10 
11   Abstract:
12     Options.
13 }
14 unit EduOptions;
15 
16 {$mode objfpc}{$H+}
17 
18 interface
19 
20 uses
21   Classes, SysUtils, LCLProc, LazConfigStorage, Controls, Forms, BaseIDEIntf,
22   LazFileUtils, LazIDEIntf, IDEOptionsIntf, ProjectIntf;
23 
24 resourcestring
25   EduRSEducation = 'Education';
26   ersShowAll = 'Show all';
27   ersHideAll = 'Hide all';
28   ersShowExtended = 'Show Extended';
29   ersShowMinimal = 'Show Minimal';
30   ersVisibleComponents = 'Visible components';
31   ersShowAllChilds = 'Show all children';
32   ersIDEMenuItems = 'IDE menu items';
33   ersNewSingleFileProgram = 'New single file program';
34   ersNewSingleFileEducationProgram = 'New single file education program';
35   ersNewProgram = 'New program';
36   ersAddIcon = 'Add icon';
37   ersAddASpeedButtonToTheIDEToolbarToCreateANewProgram = 'Add a speed button '
38     +'to the IDE toolbar to create a new program';
39   ersAddMenuItem = 'Add menu item';
40   ersAddAnIDEMenuItemToCreateANewProgram = 'Add an IDE menu item to create a new program';
41   ersAddToNewDialog = 'Add to %sNew ...%s dialog';
42   ersAddAnEntryToTheNewDialogToCreateANewProgram = 'Add an entry to the %'
43     +'sNew ...%s dialog to create a new program';
44   ersSource = 'Source';
45   ersSingleFileProgram = 'Single file program';
46   ersASimpleProgramOnlyOneFileIsCreatedAndAddedToTheCur = 'A simple program. '
47     +'Only one file is created and added to the current project.';
48   ersLoadDefaultCode = 'Load default code?';
49   ersReplaceCurrentWithDefaultSourceCode = 'Replace current with default '
50     +'source code?';
51   ersReplaceCurrentSourceWithDefaultSourceCode = 'Replace current source with '
52     +'default source code';
53   ersLoadSourceFromFile = 'Load source from file';
54 
55   ersGrpBoxPropsMin = 'Properties: Minimal Configuration';
56   ersGrpBoxPropsExt = 'Properties: Extended Configuration';
57   ersGrpBoxPropsFull = 'Properties: Full Configuration';
58 
59   ersGrpBoxEventsMin = 'Events: Minimal Configuration';
60   ersGrpBoxEventsExt = 'Events: Extended Configuration';
61   ersGrpBoxEventsFull = 'Events: Full Configuration';
62 
63   ersStTextPropsMin = 'Name, Caption, Visible, Text, Checked, Items, Font, Color, Enabled, Height, Width, MaxLength, Picture, Columns';
64   ersStTextPropsExt ='Align, Left, Top, Hint, ShowHint, ParentFont, TabOrder, ParentShowHint, WordWrap, FixedCols, FixedRows, DefaultColWidth, DefaultRowHeight, ColCount, RowCount, Borderstyle, Glyph, State, Interval, DataSource, DataField + DB-Properties';
65   ersStTextPropsFull = 'All Properties available';
66 
67   ersStTextEventsMin = 'OnClick, OnChange, OnMouseMove';
68   ersStTextEventsExt = 'OnClick, OnChange, OnMouseMove, OnDblClick, OnCreate, OnKeyPress, OnFormCreate';
69   ersStTextEventsFull = 'All Events available';
70 
71   ersRdGrpPropsCaption = 'Properties';
72   ersRdGrpEventsCaption = 'Events';
73 
74   ersEduEnvOptsFrameTitle = 'General';
75   ersEduPropsEventsTitle = 'Properties and Events';
76   ersEduCompPaletteTitle = 'Component palette';
77   ersEduNewProgramTitle = 'New program';
78   ersEduMenuTitle = 'Menus';
79   ersEduOIPages = 'Object Inspector';
80 
81   ersRdBtnFull = 'Show All';
82   ersEnableEduCheckBoxCaption = 'Enable education settings';
83   ersShowOIPages = 'Show Object Inspector Pages';
84 
85   ersEduSBTitle = 'Speed Buttons';
86   ersShowSelection = 'Show Selection';
87   ersVisibleSpeedButtons = 'Visible SpeedButtons';
88 
89 
90 
91 
92 const
93   DefaultEduOptionsFilename = 'education.xml';
94 var
95   EduOptionID: integer = 2000;
96     EduOptionGeneralID: integer       = 100;
97     EduOptionCompPaletteID: integer   = 200;
98     EduOptionMenuID: integer          = 300;
99     EduOptionNewPrgID: integer        = 400;
100     EduPropsEventsOptionsID: integer  = 500;
101     EduOIPagesOptionsID: integer      = 600;
102     EduSpeedButtonsOptionsID: integer = 700;
103 
104 type
105 
106   { TEduOptionsNode }
107 
108   TEduOptionsNode = class(TPersistent)
109   private
110     FChilds: TFPList; // list of TEduOptionsNode
111     FName: string;
112     FNextSibling: TEduOptionsNode;
113     FParent: TEduOptionsNode;
114     FPrevSibling: TEduOptionsNode;
GetChildCountnull115     function GetChildCount: integer;
GetChildsnull116     function GetChilds(Index: integer): TEduOptionsNode;
117     procedure SetName(const AValue: string);
118   public
119     constructor Create; virtual;
120     destructor Destroy; override;
121     procedure Clear; virtual;
122     procedure Delete(Index: integer); virtual;
123     procedure Remove(Index: integer); virtual;
124     procedure Add(Node: TEduOptionsNode);
125     procedure Insert(Index: integer; Node: TEduOptionsNode);
126     procedure Unbind;
Loadnull127     function Load(Config: TConfigStorage): TModalResult; virtual;
Savenull128     function Save(Config: TConfigStorage): TModalResult; virtual;
129     procedure Changed; virtual;
130     procedure Apply(Enable: boolean); virtual;
131   public
132     property Name: string read FName write SetName;
133     property Parent: TEduOptionsNode read FParent;
134     property NextSibling: TEduOptionsNode read FNextSibling;
135     property PrevSibling: TEduOptionsNode read FPrevSibling;
136     property ChildCount: integer read GetChildCount;
137     property Children[Index: integer]: TEduOptionsNode read GetChilds; default;
138   end;
139 
140   { TEduOptsRootNode }
141 
142   TEduOptsRootNode = class(TEduOptionsNode)
143   private
144     FChangeStep: integer;
145     procedure SetChangeStep(const AValue: integer);
146   public
147     procedure Changed; override;
148     procedure IncreaseChangeStep;
149     property ChangeStep: integer read FChangeStep write SetChangeStep;
150   end;
151 
152   TEduOptions = class(TAbstractIDEEnvironmentOptions)
153   private
154     FEnabled: boolean;
155     FFilename: string;
156     FNeedLoad: boolean;
157     FRoot: TEduOptionsNode;
158     FLastSavedChangeStep: integer;
159     procedure SetEnabled(const AValue: boolean);
160     procedure SetFilename(const AValue: string);
161   public
162     constructor Create;
163     destructor Destroy; override;
GetGroupCaptionnull164     class function GetGroupCaption: string; override;
GetInstancenull165     class function GetInstance: TAbstractIDEOptions; override;
166     property Root: TEduOptionsNode read FRoot;
Loadnull167     function Load(Config: TConfigStorage): TModalResult; virtual;
Savenull168     function Save(Config: TConfigStorage): TModalResult; virtual;
LoadFromFilenull169     function LoadFromFile(Filename: string): TModalResult; virtual;
SaveToFilenull170     function SaveToFile(Filename: string): TModalResult; virtual;
Loadnull171     function Load: TModalResult; virtual;
Savenull172     function Save: TModalResult; virtual;
173     procedure DoAfterWrite(Restore: boolean); override;
174     procedure Apply; virtual;
GetFullFilenamenull175     function GetFullFilename: string;
OnProjectOpenednull176     function OnProjectOpened(Sender: TObject; {%H-}AProject: TLazProject): TModalResult;
177     property Filename: string read FFilename write SetFilename;
178     property Enabled: boolean read FEnabled write SetEnabled;
179     property NeedLoad: boolean read FNeedLoad write FNeedLoad;
180   end;
181 
182 type
183   EducationIDEOptionsClass = TAbstractIDEEnvironmentOptions;
184 
185 var
186   EducationOptions: TEduOptions = nil;
187 
188 implementation
189 
190 { TEduOptionsNode }
191 
192 procedure TEduOptionsNode.SetName(const AValue: string);
193 begin
194   if FName=AValue then exit;
195   FName:=AValue;
196 end;
197 
TEduOptionsNode.GetChildsnull198 function TEduOptionsNode.GetChilds(Index: integer): TEduOptionsNode;
199 begin
200   Result:=TEduOptionsNode(fChilds[Index]);
201 end;
202 
GetChildCountnull203 function TEduOptionsNode.GetChildCount: integer;
204 begin
205   Result:=fChilds.Count;
206 end;
207 
208 constructor TEduOptionsNode.Create;
209 begin
210   fChilds:=TFPList.Create;
211 end;
212 
213 destructor TEduOptionsNode.Destroy;
214 begin
215   Clear;
216   FreeAndNil(fChilds);
217   inherited Destroy;
218 end;
219 
220 procedure TEduOptionsNode.Clear;
221 begin
222   while ChildCount>0 do Delete(ChildCount-1);
223 end;
224 
225 procedure TEduOptionsNode.Delete(Index: integer);
226 var
227   Child: TEduOptionsNode;
228 begin
229   Child:=Children[Index];
230   Remove(Index);
231   Child.Free;
232 end;
233 
234 procedure TEduOptionsNode.Remove(Index: integer);
235 var
236   Child: TEduOptionsNode;
237 begin
238   Child:=Children[Index];
239   fChilds.Delete(Index);
240   Child.FParent:=nil;
241   Child.Unbind;
242 end;
243 
244 procedure TEduOptionsNode.Add(Node: TEduOptionsNode);
245 begin
246   Insert(ChildCount,Node);
247 end;
248 
249 procedure TEduOptionsNode.Insert(Index: integer; Node: TEduOptionsNode);
250 begin
251   Node.Unbind;
252   FChilds.Insert(Index,Node);
253   Node.FParent:=Self;
254   if Index>0 then begin
255     Node.FPrevSibling:=Children[Index-1];
256     Node.FPrevSibling.FNextSibling:=Node;
257   end;
258   if Index+1<ChildCount then begin
259     Node.FNextSibling:=Children[Index+1];
260     Node.FNextSibling.FPrevSibling:=Node;
261   end;
262 end;
263 
264 procedure TEduOptionsNode.Unbind;
265 begin
266   if FParent<>nil then
267     FParent.fChilds.Remove(Self);
268   FParent:=nil;
269   if FPrevSibling<>nil then
270     FPrevSibling.FNextSibling:=FNextSibling;
271   if FNextSibling<>nil then
272     FNextSibling.FPrevSibling:=FPrevSibling;
273   FPrevSibling:=nil;
274   FNextSibling:=nil;
275 end;
276 
Loadnull277 function TEduOptionsNode.Load(Config: TConfigStorage): TModalResult;
278 var
279   i: Integer;
280   Child: TEduOptionsNode;
281 begin
282   for i:=0 to ChildCount-1 do begin
283     Child:=Children[i];
284     if not IsValidIdent(Child.Name) then continue;
285     Config.AppendBasePath(Child.Name);
286     try
287       Result:=Child.Load(Config);
288       if Result<>mrOK then exit;
289     finally
290       Config.UndoAppendBasePath;
291     end;
292   end;
293   Result:=mrOk;
294 end;
295 
Savenull296 function TEduOptionsNode.Save(Config: TConfigStorage): TModalResult;
297 var
298   i: Integer;
299   Child: TEduOptionsNode;
300 begin
301   for i:=0 to ChildCount-1 do begin
302     Child:=Children[i];
303     if not IsValidIdent(Child.Name) then continue;
304     Config.AppendBasePath(Child.Name);
305     try
306       Result:=Child.Save(Config);
307       if Result<>mrOK then exit;
308     finally
309       Config.UndoAppendBasePath;
310     end;
311   end;
312   Result:=mrOk;
313 end;
314 
315 procedure TEduOptionsNode.Changed;
316 begin
317   if FParent<>nil then FParent.Changed;
318 end;
319 
320 procedure TEduOptionsNode.Apply(Enable: boolean);
321 var
322   i: Integer;
323 begin
324   for i:=0 to ChildCount-1 do
325     Children[i].Apply(Enable);
326 end;
327 
328 { TEduOptions }
329 
330 procedure TEduOptions.SetFilename(const AValue: string);
331 begin
332   if FFilename=AValue then exit;
333   FFilename:=AValue;
334 end;
335 
336 procedure TEduOptions.SetEnabled(const AValue: boolean);
337 begin
338   if FEnabled=AValue then exit;
339   FEnabled:=AValue;
340   Root.Changed;
341   Apply;
342 end;
343 
344 constructor TEduOptions.Create;
345 begin
346   FRoot:=TEduOptsRootNode.Create;
347   FFilename:=DefaultEduOptionsFilename;
348   FNeedLoad:=true;
349 end;
350 
351 destructor TEduOptions.Destroy;
352 begin
353   FreeAndNil(FRoot);
354   inherited Destroy;
355 end;
356 
TEduOptions.GetGroupCaptionnull357 class function TEduOptions.GetGroupCaption: string;
358 begin
359   Result:=EduRSEducation;
360 end;
361 
TEduOptions.GetInstancenull362 class function TEduOptions.GetInstance: TAbstractIDEOptions;
363 begin
364   Result:=EducationOptions;
365 end;
366 
Loadnull367 function TEduOptions.Load(Config: TConfigStorage): TModalResult;
368 begin
369   FEnabled:=Config.GetValue('Enabled',false);
370   Result:=FRoot.Load(Config);
371 end;
372 
TEduOptions.Savenull373 function TEduOptions.Save(Config: TConfigStorage): TModalResult;
374 begin
375   Config.SetDeleteValue('Enabled',Enabled,false);
376   Result:=FRoot.Save(Config);
377 end;
378 
LoadFromFilenull379 function TEduOptions.LoadFromFile(Filename: string): TModalResult;
380 var
381   Config: TConfigStorage;
382 begin
383   Config:=GetIDEConfigStorage(Filename,true);
384   try
385     Result:=Load(Config);
386   finally
387     Config.Free;
388   end;
389 end;
390 
SaveToFilenull391 function TEduOptions.SaveToFile(Filename: string): TModalResult;
392 var
393   Config: TConfigStorage;
394 begin
395   //DebugLn(['TEduOptions.SaveToFile ',Filename]);
396   Config:=GetIDEConfigStorage(Filename,false);
397   try
398     Result:=Save(Config);
399   finally
400     Config.Free;
401   end;
402 end;
403 
Loadnull404 function TEduOptions.Load: TModalResult;
405 begin
406   Result:=LoadFromFile(Filename);
407   FLastSavedChangeStep:=TEduOptsRootNode(Root).ChangeStep;
408 end;
409 
TEduOptions.Savenull410 function TEduOptions.Save: TModalResult;
411 var
412   FullFilename: String;
413 begin
414   FullFilename:=GetFullFilename;
415   if FileExistsUTF8(FullFilename)
416   and (FLastSavedChangeStep=TEduOptsRootNode(Root).ChangeStep) then
417     Result:=mrOK;
418   Result:=SaveToFile(Filename);
419   FLastSavedChangeStep:=TEduOptsRootNode(Root).ChangeStep;
420 end;
421 
422 procedure TEduOptions.DoAfterWrite(Restore: boolean);
423 begin
424   inherited DoAfterWrite(Restore);
425   if not Restore then begin
426     if EducationOptions.Save<>mrOk then
427       DebugLn(['TEduOptions.DoAfterWrite Failed']);
428     Apply;
429   end;
430 end;
431 
432 procedure TEduOptions.Apply;
433 begin
434   //DebugLn(['TEduOptions.Apply ']);
435   Root.Apply(Enabled);
436 end;
437 
GetFullFilenamenull438 function TEduOptions.GetFullFilename: string;
439 begin
440   Result:=Filename;
441   if FilenameIsAbsolute(Result) then exit;
442   Result:=AppendPathDelim(LazarusIDE.GetPrimaryConfigPath)+Result;
443 end;
444 
OnProjectOpenednull445 function TEduOptions.OnProjectOpened(Sender: TObject; AProject: TLazProject
446   ): TModalResult;
447 begin
448   Result:=mrOk;
449   if NeedLoad then
450     Load;
451   Apply;
452 end;
453 
454 { TEduOptsRootNode }
455 
456 procedure TEduOptsRootNode.SetChangeStep(const AValue: integer);
457 begin
458   if FChangeStep=AValue then exit;
459   FChangeStep:=AValue;
460 end;
461 
462 procedure TEduOptsRootNode.Changed;
463 begin
464   inherited Changed;
465   IncreaseChangeStep;
466 end;
467 
468 procedure TEduOptsRootNode.IncreaseChangeStep;
469 begin
470   if FChangeStep=High(FChangeStep) then
471     FChangeStep:=low(FChangeStep)
472   else
473     inc(FChangeStep);
474 end;
475 
476 initialization
477   EducationOptions:=TEduOptions.Create;
478 
479 finalization
480   FreeAndNil(EducationOptions);
481 
482 end.
483