1 {
2 /***************************************************************************
3 newdialog.pas
4 -------------
5
6
7 ***************************************************************************/
8
9 ***************************************************************************
10 * *
11 * This source is free software; you can redistribute it and/or modify *
12 * it under the terms of the GNU General Public License as published by *
13 * the Free Software Foundation; either version 2 of the License, or *
14 * (at your option) any later version. *
15 * *
16 * This code is distributed in the hope that it will be useful, but *
17 * WITHOUT ANY WARRANTY; without even the implied warranty of *
18 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
19 * General Public License for more details. *
20 * *
21 * A copy of the GNU General Public License is available on the World *
22 * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
23 * obtain it by writing to the Free Software Foundation, *
24 * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
25 * *
26 ***************************************************************************
27
28 Author: Mattias Gaertner
29
30 Abstract:
31 TNewOtherDialog is the dialog, which is shown, when the user selects the
32 File->New... menuitem and lets the user choose what to create.
33
34 }
35 unit NewDialog;
36
37 {$mode objfpc}{$H+}
38
39 interface
40
41 uses
42 SysUtils, Classes,
43 // LCL
44 ComCtrls, Controls, Dialogs, Forms, StdCtrls, ExtCtrls,
45 ButtonPanel, ListViewFilterEdit,
46 // LazUtils
47 LazUTF8, FileUtil,
48 // IdeIntf
49 IDEWindowIntf, IDEImagesIntf, NewItemIntf, ProjectIntf,
50 LazIDEIntf, IDEHelpIntf, IDEDialogs,
51 // IDE
52 InputHistory, LazarusIDEStrConsts, Project, MainIntf;
53
54 type
55 { TNewLazIDEItemCategory }
56
57 TNewLazIDEItemCategory = class(TNewIDEItemCategory)
58 public
Descriptionnull59 function Description: string; override;
60 end;
61
62
63 { TNewLazIDEItemCategories }
64
65 TNewLazIDEItemCategories = class(TNewIDEItemCategories)
66 private
67 FItems: TList;
68 protected
GetItemsnull69 function GetItems(Index: integer): TNewIDEItemCategory; override;
70 procedure SetItems(Index: integer; const AValue: TNewIDEItemCategory); override;
71 public
72 constructor Create;
73 destructor Destroy; override;
74 procedure Clear; override;
75 procedure Add(ACategory: TNewIDEItemCategory); override;
Countnull76 function Count: integer; override;
IndexOfnull77 function IndexOf(const CategoryName: string): integer; override;
FindByNamenull78 function FindByName(const CategoryName: string): TNewIDEItemCategory; override;
79 procedure RegisterItem(const Paths: string; NewItem: TNewIDEItemTemplate); override;
80 procedure UnregisterItem({%H-}NewItem: TNewIDEItemTemplate); override;
FindCategoryByPathnull81 function FindCategoryByPath(const Path: string;
82 ErrorOnNotFound: boolean): TNewIDEItemCategory; override;
83 end;
84
85
86 //----------------------------------------------------------------------------
87 // standard categories for new dialog
88
89 { TNewLazIDEItemCategoryFile }
90
91 TNewLazIDEItemCategoryFile = class(TNewLazIDEItemCategory)
92 public
LocalizedNamenull93 function LocalizedName: string; override;
Descriptionnull94 function Description: string; override;
95 end;
96
97 { TNewLazIDEItemCategoryInheritedItem }
98
99 TNewLazIDEItemCategoryInheritedItem = class(TNewLazIDEItemCategory)
100 public
LocalizedNamenull101 function LocalizedName: string; override;
Descriptionnull102 function Description: string; override;
103 end;
104
105 { TNewLazIDEItemCategoryProject }
106
107 TNewLazIDEItemCategoryProject = class(TNewLazIDEItemCategory)
108 public
LocalizedNamenull109 function LocalizedName: string; override;
Descriptionnull110 function Description: string; override;
111 end;
112
113 { TNewLazIDEItemCategoryPackage }
114
115 TNewLazIDEItemCategoryPackage = class(TNewLazIDEItemCategory)
116 public
LocalizedNamenull117 function LocalizedName: string; override;
Descriptionnull118 function Description: string; override;
119 end;
120
121 //----------------------------------------------------------------------------
122
123
124 { TNewOtherDialog }
125
126 TNewOtherDialog = class(TForm)
127 ButtonPanel: TButtonPanel;
128 DescriptionGroupBox: TGroupBox;
129 DescriptionLabel: TLabel;
130 ItemsTreeView: TTreeView;
131 InheritableComponentsListView: TListView;
132 CompFilterEdit: TListViewFilterEdit;
133 Panel1: TPanel;
134 Splitter1: TSplitter;
135 procedure FormClose(Sender: TObject; var {%H-}CloseAction: TCloseAction);
136 procedure FormCreate(Sender: TObject);
137 procedure HelpButtonClick(Sender: TObject);
138 procedure InheritableComponentsListViewSelectItem(Sender: TObject;
139 {%H-}Item: TListItem; {%H-}Selected: Boolean);
140 procedure ItemsTreeViewSelectionChanged(Sender: TObject);
141 procedure OKButtonClick(Sender: TObject);
142 private
143 ImageIndexFolder: integer;
144 ImageIndexTemplate: integer;
145 FNewItem: TNewIDEItemTemplate;
146 procedure FillProjectInheritableItemsList;
147 procedure FillItemsTree(AOnlyModules: boolean);
148 procedure SetupComponents;
149 procedure UpdateDescription;
FindItemnull150 function FindItem(const aName: string): TTreeNode;
151 public
152 constructor Create(TheOwner: TComponent; AOnlyModules: boolean); reintroduce;
153 destructor Destroy; override;
154 public
155 property NewItem: TNewIDEItemTemplate Read FNewItem;
156 end;
157
ShowNewIDEItemDialognull158 function ShowNewIDEItemDialog(out NewItem: TNewIDEItemTemplate;
159 AOnlyModules: boolean = false): TModalResult;
160
161
162 implementation
163
164 {$R *.lfm}
165
ShowNewIDEItemDialognull166 function ShowNewIDEItemDialog(out NewItem: TNewIDEItemTemplate;
167 AOnlyModules: boolean): TModalResult;
168 var
169 NewOtherDialog: TNewOtherDialog;
170 begin
171 NewItem := nil;
172 NewOtherDialog := TNewOtherDialog.Create(nil, AOnlyModules);
173 Result := NewOtherDialog.ShowModal;
174 if Result = mrOk then
175 NewItem := NewOtherDialog.NewItem;
176 IDEDialogLayoutList.SaveLayout(NewOtherDialog);
177 NewOtherDialog.Free;
178 end;
179
180 { TNewOtherDialog }
181
182 procedure TNewOtherDialog.OKButtonClick(Sender: TObject);
183 var
184 AInheritedNode: TListItem;
185 ANode: TTreeNode;
186 NewFile: TNewItemProjectFile;
187 AncestorComponent: TComponent;
188 AnUnitInfo: TUnitInfo;
189 InhCompItem: TFileDescInheritedComponent;
190 begin
191 ANode := ItemsTreeView.Selected;
192 if (ANode = nil) or (ANode.Data = nil) or
193 (not (TObject(ANode.Data) is TNewIDEItemTemplate)) then
194 begin
195 // don't show message, when double clicking in treeview
196 if not (Sender is TTreeView) then
197 IDEMessageDialog(lisNewDlgNoItemSelected,
198 lisNewDlgPleaseSelectAnItemFirst, mtInformation, [mbOK]);
199 FNewItem := nil;
200 ModalResult:=mrNone;
201 exit;
202 end;
203 FNewItem := TNewIDEItemTemplate(ANode.Data);
204
205 InputHistories.NewFileType:=FNewItem.Name;
206 //debugln(['TNewOtherDialog.OKButtonClick InputHistories.NewFileType=',InputHistories.NewFileType]);
207
208 // if the selected item is an inherited one
209 if FNewItem is TNewItemProjectFile then
210 begin
211 NewFile:=TNewItemProjectFile(FNewItem);
212 if (NewFile.Descriptor is TFileDescInheritedItem) then
213 begin
214 // If we are inheriting from a form
215 if (NewFile.Descriptor is TFileDescInheritedComponent) then begin
216 InhCompItem:=TFileDescInheritedComponent(NewFile.Descriptor);
217 AInheritedNode := InheritableComponentsListView.Selected;
218 if Assigned(AInheritedNode) then begin
219 // load the ancestor component
220 AnUnitInfo:=TUnitInfo(AInheritedNode.Data);
221
222 // Save the unit if not done yet.
223 if AnUnitInfo.IsVirtual then
224 begin
225 if IDEQuestionDialog(lisSave,
226 Format(lisUnitMustSaveBeforeInherit, [AnUnitInfo.Filename]),
227 mtInformation, [mrOK,mrCancel]) <> mrOK
228 then begin
229 FNewItem := nil;
230 ModalResult:=mrNone;
231 Exit;
232 end;
233 LazarusIDE.DoSaveProject([]);
234 end;
235 InputHistories.NewProjectType:=FNewItem.Name;
236
237 if LazarusIDE.DoOpenComponent(AnUnitInfo.Filename,
238 [ofOnlyIfExists,ofQuiet,ofLoadHiddenResource,ofUseCache],[],
239 AncestorComponent)<>mrOk then
240 begin
241 IDEMessageDialog(lisErrorOpeningComponent,
242 lisUnableToOpenAncestorComponent, mtError, [mbCancel]);
243 exit;
244 end;
245 // Set the resource class of the file descriptor
246 InhCompItem.ResourceClass := TPersistentClass(AncestorComponent.ClassType);
247 InhCompItem.InheritedUnit := AnUnitInfo;
248 InhCompItem.DeclareClassVariable := not AncestorComponent.ClassType.InheritsFrom(TFrame);
249 //DebugLn(['TNewOtherDialog.OKButtonClick ',InhCompItem.InheritedUnit.Filename,' ',dbgsname(InhCompItem.ResourceClass)]);
250 end;
251 end
252 else
253 begin
254 IDEMessageDialog(lisNewDlgNoItemSelected,
255 lisNewDlgPleaseSelectAnItemFirst, mtInformation, [mbOK]);
256 FNewItem := nil;
257 Exit;
258 end
259 end;
260 end;
261
262 ModalResult := mrOk;
263 end;
264
265 // Fill the list of inheritable items in the project
266 procedure TNewOtherDialog.FillProjectInheritableItemsList;
267 var
268 aComponentList: TStringListUTF8Fast;
269 i: integer;
270 ListItem: TListViewDataItem;
271 AnUnitInfo: TUnitInfo;
272 Begin
273 try
274 // Auxiliar stringlist to sort component list
275 aComponentList := TStringListUTF8Fast.Create;
276
277 // Loop trough project units which have a component
278 for i := 0 to Project1.UnitCount-1 do begin
279 AnUnitInfo := Project1.Units[i];
280 if AnUnitInfo.IsPartOfProject and FilenameHasPascalExt(AnUnitInfo.Filename)
281 and (AnUnitInfo.ComponentName<>'') then
282 aComponentList.AddObject(AnUnitInfo.ComponentName, AnUnitInfo);
283 end;
284 // Sort lists (by component name)
285 aComponentList.Sort;
286
287 // Populate components listview, keeping references to each UnitInfo
288 for i := 0 to aComponentList.Count-1 do
289 begin
290 AnUnitInfo := TUnitInfo(aComponentList.Objects[i]);
291 //ListItem.Initialize(2);
292 ListItem.Data := Nil;
293 SetLength(ListItem.StringArray, 2);
294 ListItem.StringArray[0] := aComponentList[i];
295 ListItem.StringArray[1] := AnUnitInfo.ShortFilename;
296 ListItem.Data := aComponentList.Objects[i];
297 CompFilterEdit.Items.Add(ListItem);
298 end;
299 CompFilterEdit.InvalidateFilter;
300 finally
301 aComponentList.Free;
302 end;
303 end;
304
305 procedure TNewOtherDialog.FillItemsTree(AOnlyModules: boolean);
306 var
307 NewParentNode, ChildNode: TTreeNode;
308 CategoryID, TemplateID, CategoryCount: integer;
309 Category: TNewIDEItemCategory;
310 Template: TNewIDEItemTemplate;
311 begin
312 ItemsTreeView.BeginUpdate;
313 ItemsTreeView.Items.Clear;
314 CategoryCount := NewIDEItems.Count;
315 if AOnlyModules and (CategoryCount > 1) then
316 CategoryCount := 1;
317 for CategoryID := 0 to CategoryCount-1 do
318 begin
319 Category := NewIDEItems[CategoryID];
320 if not Category.VisibleInNewDialog then continue;
321 NewParentNode := ItemsTreeView.Items.AddObject(nil,Category.LocalizedName, Category);
322 NewParentNode.ImageIndex := ImageIndexFolder;
323 NewParentNode.SelectedIndex := ImageIndexFolder;
324 for TemplateID := 0 to Category.Count - 1 do
325 begin
326 Template := Category[TemplateID];
327 //DebugLn('TNewOtherDialog.FillItemsTree ',Template.Name,' ',dbgs(Template.VisibleInNewDialog));
328 if Template.VisibleInNewDialog then
329 begin
330 ChildNode := ItemsTreeView.Items.AddChildObject(NewParentNode, Template.LocalizedName, Template);
331 ChildNode.ImageIndex := ImageIndexTemplate;
332 ChildNode.SelectedIndex := ImageIndexTemplate;
333 end;
334 end;
335 NewParentNode.Expand(True);
336 end;
337 ItemsTreeView.EndUpdate;
338 end;
339
340 procedure TNewOtherDialog.ItemsTreeViewSelectionChanged(Sender: TObject);
341 var
342 Node: TTreeNode;
343 begin
344 Node := ItemsTreeView.Selected;
345 // For inherited comps OKButton is enabled also later when a ListView item is selected.
346 if Assigned(Node) and (TObject(Node.Data) is TNewItemProjectFile) and
347 (TNewItemProjectFile(Node.Data).Descriptor is TFileDescInheritedComponent)
348 then
349 ButtonPanel.OKButton.Enabled := Assigned(InheritableComponentsListView.Selected)
350 else
351 ButtonPanel.OKButton.Enabled := Assigned(Node) and (TObject(Node.Data) is TNewIDEItemTemplate);
352 UpdateDescription;
353 end;
354
355 procedure TNewOtherDialog.InheritableComponentsListViewSelectItem(
356 Sender: TObject; Item: TListItem; Selected: Boolean);
357 begin
358 ButtonPanel.OKButton.Enabled := Assigned((Sender as TListView).Selected);
359 end;
360
361 procedure TNewOtherDialog.HelpButtonClick(Sender: TObject);
362 begin
363 LazarusHelp.ShowHelpForIDEControl(Self);
364 end;
365
366 procedure TNewOtherDialog.FormClose(Sender: TObject; var CloseAction: TCloseAction);
367 begin
368 IDEDialogLayoutList.SaveLayout(Self);
369 end;
370
371 procedure TNewOtherDialog.FormCreate(Sender: TObject);
372 begin
373 IDEDialogLayoutList.ApplyLayout(Self, 750, 410);
374 end;
375
376 procedure TNewOtherDialog.SetupComponents;
377 begin
378 ItemsTreeView.Images := IDEImages.Images_16;
379 ImageIndexTemplate := IDEImages.LoadImage('template');
380 ImageIndexFolder := IDEImages.LoadImage('folder');
381
382 DescriptionGroupBox.Caption := lisCodeHelpDescrTag;
383 DescriptionLabel.Caption := '';
384
385 ButtonPanel.OKButton.Caption := lisMenuOk;
386 ButtonPanel.HelpButton.Caption := lisMenuHelp;
387 ButtonPanel.CancelButton.Caption := lisCancel;
388 end;
389
390 procedure TNewOtherDialog.UpdateDescription;
391 var
392 Desc: string;
393 ANode: TTreeNode;
394 aNewItemTemplate: TNewIDEItemTemplate;
395 begin
396 ANode := ItemsTreeView.Selected;
397 CompFilterEdit.Visible := false;
398 InheritableComponentsListView.Visible := false;
399 if (ANode <> nil) and (ANode.Data <> nil) then
400 begin
401 if TObject(ANode.Data) is TNewLazIDEItemCategory then begin
402 Desc := TNewLazIDEItemCategory(ANode.Data).Description;
403 end else
404 begin
405 aNewItemTemplate := TNewIDEItemTemplate(ANode.Data);
406 Desc := aNewItemTemplate.LocalizedName + LineEnding+LineEnding
407 +aNewItemTemplate.Description;
408 if aNewItemTemplate is TNewItemProjectFile then
409 begin
410 if TNewItemProjectFile(aNewItemTemplate).Descriptor is TFileDescInheritedComponent
411 then begin
412 CompFilterEdit.Visible := true;
413 InheritableComponentsListView.Visible := true;
414 end;
415 end;
416 end;
417 end
418 else begin
419 Desc := '';
420 end;
421 DescriptionLabel.Caption := Desc;
422 end;
423
FindItemnull424 function TNewOtherDialog.FindItem(const aName: string): TTreeNode;
425 begin
426 if aName='' then exit(nil);
427 Result:=ItemsTreeView.Items.GetFirstNode;
428 while Result<>nil do begin
429 if (Result.Data<>nil)
430 and (TObject(Result.Data) is TNewIDEItemTemplate)
431 and (CompareText(TNewIDEItemTemplate(Result.Data).Name,aName)=0) then
432 exit;
433 Result:=Result.GetNext;
434 end;
435 end;
436
437 constructor TNewOtherDialog.Create(TheOwner: TComponent; AOnlyModules: boolean);
438 var
439 Node: TTreeNode;
440 begin
441 inherited Create(TheOwner);
442 Caption := lisMenuNewOther;
443 SetupComponents;
444 FillItemsTree(AOnlyModules);
445 FillProjectInheritableItemsList;
446 CompFilterEdit.Visible := false;
447 InheritableComponentsListView.Visible := false;
448
449 Node:=FindItem(InputHistories.NewFileType);
450 if Node=nil then
451 Node:=FindItem(InputHistories.NewProjectType);
452 if Node<>nil then
453 ItemsTreeView.Selected:=Node;
454 end;
455
456 destructor TNewOtherDialog.Destroy;
457 begin
458 inherited Destroy;
459 end;
460
461 { TNewLazIDEItemCategory }
462
Descriptionnull463 function TNewLazIDEItemCategory.Description: string;
464 begin
465 if Name = 'File' then
466 Result := Format(lisNewDlgCreateANewEditorFileChooseAType, [LineEnding])
467 else if Name = 'Project' then
468 Result := Format(lisNewDlgCreateANewProjectChooseAType, [LineEnding])
469 else
470 Result := '';
471 end;
472
473 { TNewLazIDEItemCategories }
474
GetItemsnull475 function TNewLazIDEItemCategories.GetItems(Index: integer): TNewIDEItemCategory;
476 begin
477 Result := TNewIDEItemCategory(FItems[Index]);
478 end;
479
480 procedure TNewLazIDEItemCategories.SetItems(Index: integer;
481 const AValue: TNewIDEItemCategory);
482 begin
483 FItems[Index] := AValue;
484 end;
485
486 constructor TNewLazIDEItemCategories.Create;
487 begin
488 FItems := TList.Create;
489 end;
490
491 destructor TNewLazIDEItemCategories.Destroy;
492 begin
493 Clear;
494 FItems.Free;
495 inherited Destroy;
496 end;
497
498 procedure TNewLazIDEItemCategories.Clear;
499 var
500 i: integer;
501 begin
502 for i := 0 to FItems.Count - 1 do
503 Items[i].Free;
504 FItems.Clear;
505 end;
506
507 procedure TNewLazIDEItemCategories.Add(ACategory: TNewIDEItemCategory);
508 begin
509 FItems.Add(ACategory);
510 end;
511
Countnull512 function TNewLazIDEItemCategories.Count: integer;
513 begin
514 Result := FItems.Count;
515 end;
516
IndexOfnull517 function TNewLazIDEItemCategories.IndexOf(const CategoryName: string): integer;
518 begin
519 Result := Count - 1;
520 while (Result >= 0) and (UTF8CompareLatinTextFast(CategoryName, Items[Result].Name) <> 0) do
521 Dec(Result);
522 end;
523
FindByNamenull524 function TNewLazIDEItemCategories.FindByName(
525 const CategoryName: string): TNewIDEItemCategory;
526 var
527 i: longint;
528 begin
529 i := IndexOf(CategoryName);
530 if i >= 0 then
531 Result := Items[i]
532 else
533 Result := nil;
534 end;
535
536 procedure TNewLazIDEItemCategories.RegisterItem(const Paths: string;
537 NewItem: TNewIDEItemTemplate);
538
539 procedure AddToPath(const Path: string);
540 var
541 CurCategory: TNewIDEItemCategory;
542 begin
543 CurCategory := FindCategoryByPath(Path, True);
544 CurCategory.Add(NewItem);
545 end;
546
547 var
548 StartPos: integer;
549 EndPos: integer;
550 Path: string;
551 begin
552 // go through all paths
553 EndPos := 1;
554 while EndPos <= length(Paths) do
555 begin
556 StartPos := EndPos;
557 while (StartPos <= length(Paths)) and (Paths[StartPos] = ';') do
558 Inc(StartPos);
559 EndPos := StartPos;
560 while (EndPos <= length(Paths)) and (Paths[EndPos] <> ';') do
561 Inc(EndPos);
562 if EndPos > StartPos then
563 begin
564 Path := copy(Paths, StartPos, EndPos - StartPos);
565 AddToPath(Path);
566 end;
567 end;
568 end;
569
570 procedure TNewLazIDEItemCategories.UnregisterItem(NewItem: TNewIDEItemTemplate);
571 begin
572 raise Exception.Create('TODO TNewLazIDEItemCategories.UnregisterItem');
573 end;
574
FindCategoryByPathnull575 function TNewLazIDEItemCategories.FindCategoryByPath(const Path: string;
576 ErrorOnNotFound: boolean): TNewIDEItemCategory;
577 var
578 StartPos: integer;
579 EndPos: integer;
580 CategoryName: string;
581 begin
582 Result := nil;
583 EndPos := 1;
584 while EndPos <= length(Path) do
585 begin
586 StartPos := EndPos;
587 while (StartPos <= length(Path)) and (Path[StartPos] = '/') do
588 Inc(StartPos);
589 EndPos := StartPos;
590 while (EndPos <= length(Path)) and (Path[EndPos] <> '/') do
591 Inc(EndPos);
592 if EndPos > StartPos then
593 begin
594 CategoryName := copy(Path, StartPos, EndPos - StartPos);
595 if Result = nil then
596 Result := FindByName(CategoryName)
597 else
598 Result := Result.FindCategoryByName(CategoryName);
599 if (Result = nil) then
600 if ErrorOnNotFound then
601 raise Exception.Create(
602 'Unknown category: ' + CategoryName + ' in Path ' + Path)
603 else
604 exit;
605 end;
606 end;
607 end;
608
609 { TNewLazIDEItemCategoryFile }
610
LocalizedNamenull611 function TNewLazIDEItemCategoryFile.LocalizedName: string;
612 begin
613 Result := lisDebugOptionsFrmModule;
614 end;
615
Descriptionnull616 function TNewLazIDEItemCategoryFile.Description: string;
617 begin
618 Result := lisChooseOneOfTheseItemsToCreateANewFile;
619 end;
620
621 { TNewLazIDEItemCategoryProject }
622
LocalizedNamenull623 function TNewLazIDEItemCategoryProject.LocalizedName: string;
624 begin
625 Result := dlgProject;
626 end;
627
Descriptionnull628 function TNewLazIDEItemCategoryProject.Description: string;
629 begin
630 Result := lisChooseOneOfTheseItemsToCreateANewProject;
631 end;
632
633 { TNewLazIDEItemCategoryPackage }
634
LocalizedNamenull635 function TNewLazIDEItemCategoryPackage.LocalizedName: string;
636 begin
637 Result := lisPackage;
638 end;
639
Descriptionnull640 function TNewLazIDEItemCategoryPackage.Description: string;
641 begin
642 Result := lisChooseOneOfTheseItemsToCreateANewPackage;
643 end;
644
645
646 { TNewLazIDEItemCategoryInheritedItem }
647
LocalizedNamenull648 function TNewLazIDEItemCategoryInheritedItem.LocalizedName: string;
649 begin
650 Result := lisInheritedItem;
651 end;
652
Descriptionnull653 function TNewLazIDEItemCategoryInheritedItem.Description: string;
654 begin
655 Result := lisChooseOneOfTheseItemsToInheritFromAnExistingOne;
656 end;
657
658 end.
659