1 {
2 /***************************************************************************
3 projectdefs.pas - project definitions file
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 }
29 unit ProjectDefs;
30
31 {$mode objfpc}{$H+}
32
33 {$ifdef Trace}
34 {$ASSERTIONS ON}
35 {$endif}
36
37 interface
38
39 uses
40 Classes, SysUtils,
41 // LCL
42 Controls, Forms,
43 // Codetools
44 FileProcs,
45 // LazUtils
46 LazFileUtils, LazUTF8, Laz2_XMLCfg,
47 // IdeIntf
48 ProjectIntf, LazIDEIntf,
49 // IDE
50 PublishModule;
51
52 type
53 TOnLoadSaveFilename = procedure(var Filename:string; Load:boolean) of object;
54
55 TProjectWriteFlag = (
56 pwfSkipClosedUnits, // skip history data
57 pwfSaveOnlyProjectUnits,
58 pwfSkipDebuggerSettings,
59 pwfSkipJumpPoints,
60 pwfSkipProjectInfo, // do not write lpi file
61 pwfSkipSeparateSessionInfo, // do not write lps file
62 pwfIgnoreModified // write always even if nothing modified (e.g. to upgrade to a newer lpi version)
63 );
64 TProjectWriteFlags = set of TProjectWriteFlag;
65 const
66 pwfSkipSessionInfo = [pwfSkipSeparateSessionInfo,pwfSaveOnlyProjectUnits,
67 pwfSkipDebuggerSettings,pwfSkipJumpPoints];
68
69 type
70 TNewUnitType = (
71 nuEmpty, // no code
72 nuUnit, // unit
73 nuForm, // unit with form
74 nuDataModule, // unit with data module
75 nuCGIDataModule, // unit with cgi data module
76 nuText,
77 nuCustomProgram // program
78 );
79
80 TUnitUsage = (uuIsPartOfProject, uuIsLoaded, uuIsModified, uuNotUsed);
81
82
83 { TLazProjectFileDescriptors }
84
85 TLazProjectFileDescriptors = class(TProjectFileDescriptors)
86 private
87 FDefaultPascalFileExt: string;
88 fDestroying: boolean;
89 fItems: TList; // list of TProjectFileDescriptor
90 procedure SetDefaultPascalFileExt(const AValue: string);
91 protected
GetItemsnull92 function GetItems(Index: integer): TProjectFileDescriptor; override;
93 public
94 constructor Create;
95 destructor Destroy; override;
Countnull96 function Count: integer; override;
GetUniqueNamenull97 function GetUniqueName(const Name: string): string; override;
IndexOfnull98 function IndexOf(const Name: string): integer; override;
IndexOfnull99 function IndexOf(FileDescriptor: TProjectFileDescriptor): integer; override;
FindByNamenull100 function FindByName(const Name: string): TProjectFileDescriptor; override;
101 procedure RegisterFileDescriptor(FileDescriptor: TProjectFileDescriptor); override;
102 procedure UnregisterFileDescriptor(FileDescriptor: TProjectFileDescriptor); override;
103 procedure UpdateDefaultPascalFileExtensions;
104 public
105 property DefaultPascalFileExt: string read FDefaultPascalFileExt write SetDefaultPascalFileExt;
106 end;
107
108
109 { TLazProjectDescriptors }
110
111 TLazProjectDescriptors = class(TProjectDescriptors)
112 private
113 fDestroying: boolean;
114 fItems: TList; // list of TProjectDescriptor
115 protected
GetItemsnull116 function GetItems(Index: integer): TProjectDescriptor; override;
117 public
118 constructor Create;
119 destructor Destroy; override;
Countnull120 function Count: integer; override;
GetUniqueNamenull121 function GetUniqueName(const Name: string): string; override;
IndexOfnull122 function IndexOf(const Name: string): integer; override;
IndexOfnull123 function IndexOf(Descriptor: TProjectDescriptor): integer; override;
FindByNamenull124 function FindByName(const Name: string): TProjectDescriptor; override;
125 procedure RegisterDescriptor(Descriptor: TProjectDescriptor); override;
126 procedure UnregisterDescriptor(Descriptor: TProjectDescriptor); override;
127 end;
128
129 var
130 LazProjectFileDescriptors: TLazProjectFileDescriptors;
131 LazProjectDescriptors: TLazProjectDescriptors;
132
133 type
134 //---------------------------------------------------------------------------
135 // bookmarks of a single file
136 TFileBookmark = class
137 private
138 fCursorPos: TPoint;
139 fID: integer;
140 public
141 constructor Create;
142 constructor Create(NewX,NewY,AnID: integer);
143 procedure SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string);
144 procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string);
Xnull145 function X: integer;
Ynull146 function Y: integer;
147 public
148 property CursorPos: TPoint read fCursorPos write fCursorPos;
149 property ID: integer read fID write fID;
150 end;
151
152 TFileBookmarks = class
153 private
154 FBookmarks:TList; // list of TFileBookmark
GetBookmarksnull155 function GetBookmarks(Index:integer):TFileBookmark;
156 procedure SetBookmarks(Index:integer; ABookmark: TFileBookmark);
157 public
158 constructor Create;
159 destructor Destroy; override;
160 property Items[Index:integer]:TFileBookmark
161 read GetBookmarks write SetBookmarks; default;
Countnull162 function Count:integer;
163 procedure Delete(Index:integer);
164 procedure Clear;
Addnull165 function Add(ABookmark: TFileBookmark):integer;
Addnull166 function Add(X,Y,ID: integer):integer;
IndexOfIDnull167 function IndexOfID(ID:integer):integer;
168 procedure SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string);
169 procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string);
170 end;
171
172 //---------------------------------------------------------------------------
173 // The currently visible bookmarks of the project
174
175 { TProjectBookmark }
176
177 TProjectBookmark = class
178 private
179 fCursorPos: TPoint;
180 FUnitInfo: TObject;
181 fID: integer;
182 public
183 constructor Create(X,Y, AnID: integer; AUnitInfo:TObject);
184 property CursorPos: TPoint read fCursorPos write fCursorPos;
185 property UnitInfo: TObject read FUnitInfo write FUnitInfo;
186 property ID:integer read fID write fID;
187 end;
188
189 { TProjectBookmarkList }
190
191 TProjectBookmarkList = class
192 private
193 FBookmarks:TList; // list of TProjectBookmark
GetBookmarksnull194 function GetBookmarks(Index:integer):TProjectBookmark;
195 procedure SetBookmarks(Index:integer; ABookmark: TProjectBookmark);
196 public
197 constructor Create;
198 destructor Destroy; override;
199 property Items[Index:integer]:TProjectBookmark
200 read GetBookmarks write SetBookmarks; default;
Countnull201 function Count:integer;
202 procedure Delete(Index:integer);
203 procedure Clear;
Addnull204 function Add(ABookmark: TProjectBookmark):integer;
Addnull205 function Add(X, Y, ID: integer; AUnitInfo: TObject):integer;
206 procedure DeleteAllWithUnitInfo(AUnitInfo:TObject);
IndexOfIDnull207 function IndexOfID(ID:integer):integer;
BookmarkWithIDnull208 function BookmarkWithID(ID: integer): TProjectBookmark;
UnitInfoForBookmarkWithIndexnull209 function UnitInfoForBookmarkWithIndex(ID: integer): TObject;
210 end;
211
212 type
213 //---------------------------------------------------------------------------
214 TProjectJumpHistoryPosition = class
215 private
216 FCaretXY: TPoint;
217 FFilename: string;
218 FTopLine: integer;
219 fOnLoadSaveFilename: TOnLoadSaveFilename;
220 public
221 procedure Assign(APosition: TProjectJumpHistoryPosition);
222 constructor Create(const AFilename: string; ACaretXY: TPoint;
223 ATopLine: integer);
224 constructor Create(APosition: TProjectJumpHistoryPosition);
IsEqualnull225 function IsEqual(APosition: TProjectJumpHistoryPosition): boolean;
IsSimilarnull226 function IsSimilar(APosition: TProjectJumpHistoryPosition): boolean;
227 procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string);
228 procedure SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string);
229 property CaretXY: TPoint read FCaretXY write FCaretXY; // logical (byte) position
230 property Filename: string read FFilename write FFilename;
231 property TopLine: integer read FTopLine write FTopLine;
232 property OnLoadSaveFilename: TOnLoadSaveFilename
233 read fOnLoadSaveFilename write fOnLoadSaveFilename;
234 end;
235
236 TCheckPositionEvent =
Positionnull237 function(APosition:TProjectJumpHistoryPosition): boolean of object;
238
239 { TProjectJumpHistory }
240
241 TProjectJumpHistory = class
242 private
243 FChangeStamp: integer;
244 FHistoryIndex: integer;
245 FOnCheckPosition: TCheckPositionEvent;
246 FPositions:TList; // list of TProjectJumpHistoryPosition
247 FMaxCount: integer;
248 fOnLoadSaveFilename: TOnLoadSaveFilename;
GetPositionsnull249 function GetPositions(Index:integer):TProjectJumpHistoryPosition;
250 procedure SetHistoryIndex(const AIndex : integer);
251 procedure SetPositions(Index:integer; APosition: TProjectJumpHistoryPosition);
252 procedure IncreaseChangeStamp;
253 public
Addnull254 function Add(APosition: TProjectJumpHistoryPosition):integer;
AddSmartnull255 function AddSmart(APosition: TProjectJumpHistoryPosition):integer;
256 constructor Create;
257 procedure Clear;
258 procedure DeleteInvalidPositions;
Countnull259 function Count:integer;
260 procedure Delete(Index:integer);
261 procedure DeleteFirst;
262 procedure DeleteForwardHistory;
263 procedure DeleteLast;
264 destructor Destroy; override;
IndexOfnull265 function IndexOf(APosition: TProjectJumpHistoryPosition): integer;
FindIndexOfFilenamenull266 function FindIndexOfFilename(const Filename: string;
267 StartIndex: integer): integer;
268 procedure Insert(Index: integer; APosition: TProjectJumpHistoryPosition);
269 procedure InsertSmart(Index: integer; APosition: TProjectJumpHistoryPosition);
270 procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string);
271 procedure SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string);
272 procedure WriteDebugReport;
273 property HistoryIndex: integer read FHistoryIndex write SetHistoryIndex;
274 property Items[Index:integer]:TProjectJumpHistoryPosition
275 read GetPositions write SetPositions; default;
276 property MaxCount: integer read FMaxCount write FMaxCount;
277 property OnCheckPosition: TCheckPositionEvent
278 read FOnCheckPosition write FOnCheckPosition;
279 property OnLoadSaveFilename: TOnLoadSaveFilename
280 read fOnLoadSaveFilename write fOnLoadSaveFilename;
281 property ChangeStamp: integer read FChangeStamp;
282 end;
283
284 //---------------------------------------------------------------------------
285
286 { TPublishProjectOptions }
287
288 TPublishProjectOptions = class(TPublishModuleOptions)
289 public
GetDefaultDestinationDirnull290 function GetDefaultDestinationDir: string; override;
WriteFlagsnull291 function WriteFlags: TProjectWriteFlags;
292 end;
293
294 implementation
295
296
297 { TProjectBookmark }
298
299 constructor TProjectBookmark.Create(X, Y, AnID: integer; AUnitInfo: TObject);
300 begin
301 inherited Create;
302 fCursorPos.X := X;
303 fCursorPos.Y := Y;
304 FUnitInfo := AUnitInfo;
305 fID := AnID;
306 end;
307
308 { TProjectBookmarkList }
309
310 constructor TProjectBookmarkList.Create;
311 begin
312 inherited Create;
313 fBookmarks:=TList.Create;
314 end;
315
316 destructor TProjectBookmarkList.Destroy;
317 begin
318 Clear;
319 fBookmarks.Free;
320 inherited Destroy;
321 end;
322
323 procedure TProjectBookmarkList.Clear;
324 var a:integer;
325 begin
326 for a:=0 to fBookmarks.Count-1 do Items[a].Free;
327 fBookmarks.Clear;
328 end;
329
Countnull330 function TProjectBookmarkList.Count:integer;
331 begin
332 Result:=fBookmarks.Count;
333 end;
334
GetBookmarksnull335 function TProjectBookmarkList.GetBookmarks(Index:integer):TProjectBookmark;
336 begin
337 Result:=TProjectBookmark(fBookmarks[Index]);
338 end;
339
340 procedure TProjectBookmarkList.SetBookmarks(Index:integer;
341 ABookmark: TProjectBookmark);
342 begin
343 fBookmarks[Index]:=ABookmark;
344 end;
345
IndexOfIDnull346 function TProjectBookmarkList.IndexOfID(ID:integer):integer;
347 begin
348 Result:=Count-1;
349 while (Result>=0) and (Items[Result].ID<>ID) do dec(Result);
350 end;
351
BookmarkWithIDnull352 function TProjectBookmarkList.BookmarkWithID(ID: integer): TProjectBookmark;
353 var
354 i: Integer;
355 begin
356 i:=IndexOfID(ID);
357 if i>=0 then
358 Result:=Items[i]
359 else
360 Result:=nil;
361 end;
362
UnitInfoForBookmarkWithIndexnull363 function TProjectBookmarkList.UnitInfoForBookmarkWithIndex(ID: integer): TObject;
364 var
365 Mark: TProjectBookmark;
366 begin
367 Mark := BookmarkWithID(ID);
368 if Mark <> nil then
369 Result := Mark.UnitInfo
370 else
371 Result:=nil;
372 end;
373
374 procedure TProjectBookmarkList.Delete(Index:integer);
375 begin
376 Items[Index].Free;
377 fBookmarks.Delete(Index);
378 end;
379
380 procedure TProjectBookmarkList.DeleteAllWithUnitInfo(AUnitInfo:TObject);
381 var i:integer;
382 begin
383 i:=Count-1;
384 while (i>=0) do begin
385 if Items[i].UnitInfo = AUnitInfo then Delete(i);
386 dec(i);
387 end;
388 end;
389
Addnull390 function TProjectBookmarkList.Add(ABookmark: TProjectBookmark):integer;
391 var
392 i: Integer;
393 begin
394 i:=IndexOfID(ABookmark.ID);
395 if i>=0 then Delete(i);
396 Result:=fBookmarks.Add(ABookmark);
397 end;
398
Addnull399 function TProjectBookmarkList.Add(X, Y, ID: integer;
400 AUnitInfo: TObject): integer;
401 begin
402 Result:=Add(TProjectBookmark.Create(X, Y, ID, AUnitInfo));
403 end;
404
405 { TProjectJumpHistoryPosition }
406
407 constructor TProjectJumpHistoryPosition.Create(const AFilename: string;
408 ACaretXY: TPoint; ATopLine: integer);
409 begin
410 inherited Create;
411 FCaretXY:=ACaretXY;
412 FFilename:=AFilename;
413 FTopLine:=ATopLine;
414 end;
415
416 constructor TProjectJumpHistoryPosition.Create(
417 APosition: TProjectJumpHistoryPosition);
418 begin
419 inherited Create;
420 Assign(APosition);
421 end;
422
423 procedure TProjectJumpHistoryPosition.Assign(
424 APosition: TProjectJumpHistoryPosition);
425 begin
426 FCaretXY:=APosition.CaretXY;
427 FFilename:=APosition.Filename;
428 FTopLine:=APosition.TopLine;
429 end;
430
TProjectJumpHistoryPosition.IsEqualnull431 function TProjectJumpHistoryPosition.IsEqual(
432 APosition: TProjectJumpHistoryPosition): boolean;
433 begin
434 Result:=(Filename=APosition.Filename)
435 and (CaretXY.X=APosition.CaretXY.X) and (CaretXY.Y=APosition.CaretXY.Y)
436 and (TopLine=APosition.TopLine);
437 end;
438
TProjectJumpHistoryPosition.IsSimilarnull439 function TProjectJumpHistoryPosition.IsSimilar(
440 APosition: TProjectJumpHistoryPosition): boolean;
441 begin
442 Result:=(Filename=APosition.Filename)
443 and (CaretXY.Y=APosition.CaretXY.Y);
444 end;
445
446 procedure TProjectJumpHistoryPosition.LoadFromXMLConfig(
447 XMLConfig: TXMLConfig; const Path: string);
448 var AFilename: string;
449 begin
450 FCaretXY.Y:=XMLConfig.GetValue(Path+'Caret/Line',1);
451 FCaretXY.X:=XMLConfig.GetValue(Path+'Caret/Column',1);
452 FTopLine:=XMLConfig.GetValue(Path+'Caret/TopLine',1);
453 AFilename:=XMLConfig.GetValue(Path+'Filename/Value','');
454 if Assigned(fOnLoadSaveFilename) then
455 fOnLoadSaveFilename(AFilename,true);
456 fFilename:=AFilename;
457 end;
458
459 procedure TProjectJumpHistoryPosition.SaveToXMLConfig(
460 XMLConfig: TXMLConfig; const Path: string);
461 var AFilename: string;
462 begin
463 AFilename:=Filename;
464 if Assigned(fOnLoadSaveFilename) then
465 fOnLoadSaveFilename(AFilename,false);
466 XMLConfig.SetValue(Path+'Filename/Value',AFilename);
467 XMLConfig.SetDeleteValue(Path+'Caret/Line',FCaretXY.Y,1);
468 XMLConfig.SetDeleteValue(Path+'Caret/Column',FCaretXY.X,1);
469 XMLConfig.SetDeleteValue(Path+'Caret/TopLine',FTopLine,1);
470 end;
471
472 { TProjectJumpHistory }
473
TProjectJumpHistory.GetPositionsnull474 function TProjectJumpHistory.GetPositions(
475 Index:integer):TProjectJumpHistoryPosition;
476 begin
477 if (Index<0) or (Index>=Count) then
478 raise Exception.Create('TProjectJumpHistory.GetPositions: Index '
479 +IntToStr(Index)+' out of bounds. Count='+IntToStr(Count));
480 Result:=TProjectJumpHistoryPosition(FPositions[Index]);
481 end;
482
483 procedure TProjectJumpHistory.SetHistoryIndex(const AIndex : integer);
484 begin
485 if FHistoryIndex=AIndex then exit;
486 FHistoryIndex := AIndex;
487 IncreaseChangeStamp;
488 end;
489
490 procedure TProjectJumpHistory.SetPositions(Index:integer;
491 APosition: TProjectJumpHistoryPosition);
492 begin
493 if (Index<0) or (Index>=Count) then
494 raise Exception.Create('TProjectJumpHistory.SetPositions: Index '
495 +IntToStr(Index)+' out of bounds. Count='+IntToStr(Count));
496 Items[Index].Assign(APosition);
497 IncreaseChangeStamp;
498 end;
499
500 procedure TProjectJumpHistory.IncreaseChangeStamp;
501 begin
502 CTIncreaseChangeStamp(FChangeStamp);
503 end;
504
Addnull505 function TProjectJumpHistory.Add(
506 APosition: TProjectJumpHistoryPosition):integer;
507 begin
508 Result:=FPositions.Add(APosition);
509 APosition.OnLoadSaveFilename:=OnLoadSaveFilename;
510 IncreaseChangeStamp;
511 HistoryIndex:=Count-1;
512 if Count>MaxCount then DeleteFirst;
513 end;
514
TProjectJumpHistory.AddSmartnull515 function TProjectJumpHistory.AddSmart(
516 APosition: TProjectJumpHistoryPosition):integer;
517 // add, if last Item is not equal to APosition
518 begin
519 if (Count=0) or (not Items[Count-1].IsEqual(APosition)) then
520 Result:=Add(APosition)
521 else begin
522 APosition.Free;
523 Result:=-1;
524 end;
525 end;
526
527 constructor TProjectJumpHistory.Create;
528 begin
529 inherited Create;
530 FChangeStamp:=CTInvalidChangeStamp;
531 FPositions:=TList.Create;
532 HistoryIndex:=-1;
533 FMaxCount:=30;
534 end;
535
536 procedure TProjectJumpHistory.Clear;
537 var i: integer;
538 begin
539 for i:=0 to Count-1 do
540 Items[i].Free;
541 FPositions.Clear;
542 HistoryIndex:=-1;
543 IncreaseChangeStamp;
544 end;
545
TProjectJumpHistory.Countnull546 function TProjectJumpHistory.Count:integer;
547 begin
548 Result:=FPositions.Count;
549 end;
550
551 procedure TProjectJumpHistory.Delete(Index:integer);
552 begin
553 Items[Index].Free;
554 FPositions.Delete(Index);
555 IncreaseChangeStamp;
556 if FHistoryIndex>=Index then HistoryIndex := FHistoryIndex - 1;
557 end;
558
559 destructor TProjectJumpHistory.Destroy;
560 begin
561 Clear;
562 FPositions.Free;
563 inherited Destroy;
564 end;
565
TProjectJumpHistory.IndexOfnull566 function TProjectJumpHistory.IndexOf(APosition: TProjectJumpHistoryPosition
567 ): integer;
568 begin
569 Result:=Count-1;
570 while (Result>=0) and (not APosition.IsEqual(Items[Result])) do
571 dec(Result);
572 end;
573
574 procedure TProjectJumpHistory.LoadFromXMLConfig(XMLConfig: TXMLConfig;
575 const Path: string);
576 var i, NewCount, NewHistoryIndex: integer;
577 NewPosition: TProjectJumpHistoryPosition;
578 begin
579 Clear;
580 NewCount:=XMLConfig.GetValue(Path+'JumpHistory/Count',0);
581 NewHistoryIndex:=XMLConfig.GetValue(Path+'JumpHistory/HistoryIndex',0);
582 NewPosition:=nil;
583 for i:=0 to NewCount-1 do begin
584 if NewPosition=nil then begin
585 NewPosition:=TProjectJumpHistoryPosition.Create('',Point(0,0),0);
586 NewPosition.OnLoadSaveFilename:=OnLoadSaveFilename;
587 end;
588 NewPosition.LoadFromXMLConfig(XMLConfig,
589 Path+'JumpHistory/Position'+IntToStr(i+1)+'/');
590 if (NewPosition.Filename<>'') and (NewPosition.CaretXY.Y>0)
591 and (NewPosition.CaretXY.X>0) and (NewPosition.TopLine>0)
592 and (NewPosition.TopLine<=NewPosition.CaretXY.Y) then begin
593 Add(NewPosition);
594 NewPosition:=nil;
595 end else if NewHistoryIndex>=i then
596 dec(NewHistoryIndex);
597 end;
598 if NewPosition<>nil then NewPosition.Free;
599 if (NewHistoryIndex<0) or (NewHistoryIndex>=Count) then
600 NewHistoryIndex:=Count-1;
601 HistoryIndex:=NewHistoryIndex;
602 end;
603
604 procedure TProjectJumpHistory.SaveToXMLConfig(XMLConfig: TXMLConfig;
605 const Path: string);
606 var i: integer;
607 begin
608 XMLConfig.SetDeleteValue(Path+'JumpHistory/Count',Count,0);
609 XMLConfig.SetDeleteValue(Path+'JumpHistory/HistoryIndex',HistoryIndex,0);
610 for i:=0 to Count-1 do begin
611 Items[i].SaveToXMLConfig(XMLConfig,
612 Path+'JumpHistory/Position'+IntToStr(i+1)+'/');
613 end;
614 end;
615
FindIndexOfFilenamenull616 function TProjectJumpHistory.FindIndexOfFilename(const Filename: string;
617 StartIndex: integer): integer;
618 begin
619 Result:=StartIndex;
620 while (Result<Count) do begin
621 if (CompareFilenames(Filename,Items[Result].Filename)=0) then exit;
622 inc(Result);
623 end;
624 Result:=-1;
625 end;
626
627 procedure TProjectJumpHistory.DeleteInvalidPositions;
628 var i: integer;
629 begin
630 i:=Count-1;
631 while (i>=0) do begin
632 if (Items[i].Filename='') or (Items[i].CaretXY.Y<1)
633 or (Items[i].CaretXY.X<1)
634 or (Assigned(FOnCheckPosition) and (not FOnCheckPosition(Items[i]))) then
635 begin
636 Delete(i);
637 end;
638 dec(i);
639 end;
640 end;
641
642 procedure TProjectJumpHistory.DeleteLast;
643 begin
644 if Count=0 then exit;
645 Delete(Count-1);
646 end;
647
648 procedure TProjectJumpHistory.DeleteFirst;
649 begin
650 if Count=0 then exit;
651 Delete(0);
652 end;
653
654 procedure TProjectJumpHistory.Insert(Index: integer;
655 APosition: TProjectJumpHistoryPosition);
656 begin
657 APosition.OnLoadSaveFilename:=OnLoadSaveFilename;
658 if Count=MaxCount then begin
659 if Index>0 then begin
660 DeleteFirst;
661 dec(Index);
662 end else
663 DeleteLast;
664 end;
665 if Index<0 then Index:=0;
666 if Index>Count then Index:=Count;
667 FPositions.Insert(Index,APosition);
668 IncreaseChangeStamp;
669 if (FHistoryIndex<0) and (Count=1) then
670 HistoryIndex:=0
671 else if FHistoryIndex>=Index then
672 HistoryIndex := FHistoryIndex + 1;
673 end;
674
675 procedure TProjectJumpHistory.InsertSmart(Index: integer;
676 APosition: TProjectJumpHistoryPosition);
677 // insert if item after or in front of Index is not similar to APosition
678 // else replace the similar with the new updated version
679 var
680 NewIndex: integer;
681 begin
682 if Index<0 then Index:=Count;
683 if (Index<=Count) then begin
684 if (Index>0) and Items[Index-1].IsSimilar(APosition) then begin
685 //debugln('TProjectJumpHistory.InsertSmart Replacing prev: Index=',Index,
686 // ' Old=',Items[Index-1].CaretXY.X,',',Items[Index-1].CaretXY.Y,' ',Items[Index-1].Filename,
687 // ' New=',APosition.CaretXY.X,',',APosition.CaretXY.Y,' ',APosition.Filename,
688 // ' ');
689 Items[Index-1]:=APosition;
690 IncreaseChangeStamp;
691 NewIndex:=Index-1;
692 APosition.Free;
693 end else if (Index<Count) and Items[Index].IsSimilar(APosition) then begin
694 //debugln('TProjectJumpHistory.InsertSmart Replacing next: Index=',Index,
695 // ' Old=',Items[Index].CaretXY.X,',',Items[Index].CaretXY.Y,' ',Items[Index].Filename,
696 // ' New=',APosition.CaretXY.X,',',APosition.CaretXY.Y,' ',APosition.Filename,
697 // ' ');
698 Items[Index]:=APosition;
699 IncreaseChangeStamp;
700 NewIndex:=Index;
701 APosition.Free;
702 end else begin
703 //debugln('TProjectJumpHistory.InsertSmart Adding: Index=',Index,
704 // ' New=',APosition.CaretXY.X,',',APosition.CaretXY.Y,' ',APosition.Filename,
705 // ' ');
706 Insert(Index,APosition);
707 NewIndex:=IndexOf(APosition);
708 end;
709 if (HistoryIndex<0) or (HistoryIndex=NewIndex-1) then
710 HistoryIndex:=NewIndex;
711 //debugln(' HistoryIndex=',HistoryIndex);
712 end else begin
713 APosition.Free;
714 end;
715 end;
716
717 procedure TProjectJumpHistory.DeleteForwardHistory;
718 var i, d: integer;
719 begin
720 d:=FHistoryIndex+1;
721 if d<0 then d:=0;
722 for i:=Count-1 downto d do Delete(i);
723 end;
724
725 procedure TProjectJumpHistory.WriteDebugReport;
726 var i: integer;
727 begin
728 DebugLn('[TProjectJumpHistory.WriteDebugReport] Count=',IntToStr(Count),
729 ' MaxCount=',IntToStr(MaxCount),' HistoryIndex=',IntToStr(HistoryIndex));
730 for i:=0 to Count-1 do begin
731 DebugLn(' ',IntToStr(i),': Line=',IntToStr(Items[i].CaretXY.Y),
732 ' Col=',IntToStr(Items[i].CaretXY.X), ' "',Items[i].Filename,'"');
733 end;
734 end;
735
736 { TPublishProjectOptions }
737
GetDefaultDestinationDirnull738 function TPublishProjectOptions.GetDefaultDestinationDir: string;
739 begin
740 Result:='$(TestDir)/publishedproject/';
741 end;
742
WriteFlagsnull743 function TPublishProjectOptions.WriteFlags: TProjectWriteFlags;
744 begin
745 Result:=[];
746 Include(Result,pwfSaveOnlyProjectUnits);
747 Include(Result,pwfSkipClosedUnits);
748 end;
749
750
751 { TFileBookmark }
752
753 constructor TFileBookmark.Create;
754 begin
755
756 end;
757
758 constructor TFileBookmark.Create(NewX, NewY, AnID: integer);
759 begin
760 fCursorPos.X:=NewX;
761 fCursorPos.Y:=NewY;
762 fID:=AnID;
763 end;
764
765 procedure TFileBookmark.SaveToXMLConfig(XMLConfig: TXMLConfig;
766 const Path: string);
767 begin
768 XMLConfig.SetDeleteValue(Path+'X',fCursorPos.X,1);
769 XMLConfig.SetDeleteValue(Path+'Y',fCursorPos.Y,1);
770 XMLConfig.SetDeleteValue(Path+'ID',fID,0);
771 end;
772
773 procedure TFileBookmark.LoadFromXMLConfig(XMLConfig: TXMLConfig;
774 const Path: string);
775 begin
776 fCursorPos.X:=XMLConfig.GetValue(Path+'X',1);
777 fCursorPos.Y:=XMLConfig.GetValue(Path+'Y',1);
778 fID:=XMLConfig.GetValue(Path+'ID',0);
779 end;
780
TFileBookmark.Xnull781 function TFileBookmark.X: integer;
782 begin
783 Result:=fCursorPos.X;
784 end;
785
TFileBookmark.Ynull786 function TFileBookmark.Y: integer;
787 begin
788 Result:=fCursorPos.Y;
789 end;
790
791 { TFileBookmarks }
792
GetBookmarksnull793 function TFileBookmarks.GetBookmarks(Index: integer): TFileBookmark;
794 begin
795 Result:=TFileBookmark(FBookmarks[Index]);
796 end;
797
798 procedure TFileBookmarks.SetBookmarks(Index: integer; ABookmark: TFileBookmark);
799 begin
800 FBookmarks[Index]:=ABookmark;
801 end;
802
803 constructor TFileBookmarks.Create;
804 begin
805 FBookmarks:=TList.Create;
806 Clear;
807 end;
808
809 destructor TFileBookmarks.Destroy;
810 begin
811 Clear;
812 FBookmarks.Free;
813 inherited Destroy;
814 end;
815
Countnull816 function TFileBookmarks.Count: integer;
817 begin
818 Result:=FBookmarks.Count;
819 end;
820
821 procedure TFileBookmarks.Delete(Index: integer);
822 begin
823 Items[Index].Free;
824 FBookmarks.Delete(Index);
825 end;
826
827 procedure TFileBookmarks.Clear;
828 var
829 i: Integer;
830 begin
831 for i:=0 to FBookmarks.Count-1 do Items[i].Free;
832 FBookmarks.Clear;
833 end;
834
Addnull835 function TFileBookmarks.Add(ABookmark: TFileBookmark): integer;
836 var
837 i: Integer;
838 begin
839 i:=IndexOfID(ABookmark.ID);
840 if i>=0 then Delete(i);
841 Result:=FBookmarks.Add(ABookmark);
842 end;
843
Addnull844 function TFileBookmarks.Add(X, Y, ID: integer): integer;
845 begin
846 Result:=Add(TFileBookmark.Create(X,Y,ID));
847 end;
848
TFileBookmarks.IndexOfIDnull849 function TFileBookmarks.IndexOfID(ID: integer): integer;
850 begin
851 Result:=Count-1;
852 while (Result>=0) and (Items[Result].ID<>ID) do dec(Result);
853 end;
854
855 procedure TFileBookmarks.SaveToXMLConfig(XMLConfig: TXMLConfig;
856 const Path: string);
857 var
858 i: Integer;
859 begin
860 XMLConfig.SetDeleteValue(Path+'Count',Count,0);
861 for i:=0 to Count-1 do
862 Items[i].SaveToXMLConfig(XMLConfig,Path+'Item'+IntToStr(i)+'/');
863 end;
864
865 procedure TFileBookmarks.LoadFromXMLConfig(XMLConfig: TXMLConfig;
866 const Path: string);
867 var
868 NewCount: Integer;
869 NewBookmark: TFileBookmark;
870 i: Integer;
871 begin
872 Clear;
873 NewCount:=XMLConfig.GetValue(Path+'Count',0);
874 for i:=0 to NewCount-1 do begin
875 NewBookmark:=TFileBookmark.Create;
876 NewBookmark.LoadFromXMLConfig(XMLConfig,Path+'Item'+IntToStr(i)+'/');
877 Add(NewBookmark);
878 end;
879 end;
880
881 { TLazProjectFileDescriptors }
882
883 procedure TLazProjectFileDescriptors.SetDefaultPascalFileExt(
884 const AValue: string);
885 begin
886 if FDefaultPascalFileExt=AValue then exit;
887 FDefaultPascalFileExt:=AValue;
888 UpdateDefaultPascalFileExtensions;
889 end;
890
GetItemsnull891 function TLazProjectFileDescriptors.GetItems(Index: integer): TProjectFileDescriptor;
892 begin
893 Result:=TProjectFileDescriptor(FItems[Index]);
894 end;
895
896 constructor TLazProjectFileDescriptors.Create;
897 begin
898 ProjectFileDescriptors:=Self;
899 FItems:=TList.Create;
900 end;
901
902 destructor TLazProjectFileDescriptors.Destroy;
903 var
904 i: Integer;
905 begin
906 fDestroying:=true;
907 for i:=Count-1 downto 0 do Items[i].Release;
908 FItems.Free;
909 FItems:=nil;
910 ProjectFileDescriptors:=nil;
911 inherited Destroy;
912 end;
913
Countnull914 function TLazProjectFileDescriptors.Count: integer;
915 begin
916 Result:=FItems.Count;
917 end;
918
TLazProjectFileDescriptors.GetUniqueNamenull919 function TLazProjectFileDescriptors.GetUniqueName(const Name: string): string;
920 var
921 i: Integer;
922 begin
923 Result:=Name;
924 if IndexOf(Result)<0 then exit;
925 i:=0;
926 repeat
927 inc(i);
928 Result:=Name+IntToStr(i);
929 until IndexOf(Result)<0;
930 end;
931
IndexOfnull932 function TLazProjectFileDescriptors.IndexOf(const Name: string): integer;
933 begin
934 Result:=Count-1;
935 while (Result>=0) and (UTF8CompareText(Name,Items[Result].Name)<>0) do
936 dec(Result);
937 end;
938
IndexOfnull939 function TLazProjectFileDescriptors.IndexOf(FileDescriptor: TProjectFileDescriptor): integer;
940 begin
941 Result:=Count-1;
942 while (Result>=0) and (Items[Result]<>FileDescriptor) do
943 dec(Result);
944 end;
945
TLazProjectFileDescriptors.FindByNamenull946 function TLazProjectFileDescriptors.FindByName(const Name: string): TProjectFileDescriptor;
947 var
948 i: LongInt;
949 begin
950 i:=IndexOf(Name);
951 if i>=0 then
952 Result:=Items[i]
953 else
954 Result:=nil;
955 end;
956
957 procedure TLazProjectFileDescriptors.RegisterFileDescriptor(
958 FileDescriptor: TProjectFileDescriptor);
959 var
960 DefPasExt: String;
961 begin
962 if FileDescriptor.Name='' then
963 raise Exception.Create('TLazProjectFileDescriptors.RegisterFileDescriptor FileDescriptor.Name empty');
964 if FileDescriptor.DefaultFilename='' then
965 raise Exception.Create('TLazProjectFileDescriptors.RegisterFileDescriptor FileDescriptor.DefaultFilename empty');
966 if IndexOf(FileDescriptor)>=0 then
967 raise Exception.Create('TLazProjectFileDescriptors.RegisterFileDescriptor FileDescriptor already registered');
968 // make name unique
969 FileDescriptor.Name:=GetUniqueName(FileDescriptor.Name);
970 // override pascal extension with users choice
971 DefPasExt:=DefaultPascalFileExt;
972 if DefPasExt<>'' then
973 FileDescriptor.UpdateDefaultPascalFileExtension(DefPasExt);
974 FItems.Add(FileDescriptor);
975
976 // register ResourceClass, so that the IDE knows, what means
977 // '= class(<ResourceClass.ClassName>)'
978 if FileDescriptor.ResourceClass<>nil then
979 RegisterClass(FileDescriptor.ResourceClass);
980 end;
981
982 procedure TLazProjectFileDescriptors.UnregisterFileDescriptor(
983 FileDescriptor: TProjectFileDescriptor);
984 var
985 i: LongInt;
986 begin
987 if fDestroying then exit;
988 i:=FItems.IndexOf(FileDescriptor);
989 if i<0 then
990 raise Exception.Create('TLazProjectFileDescriptors.UnregisterFileDescriptor');
991 FItems.Delete(i);
992 FileDescriptor.Release;
993 end;
994
995 procedure TLazProjectFileDescriptors.UpdateDefaultPascalFileExtensions;
996 var
997 i: Integer;
998 DefPasExt: String;
999 begin
1000 DefPasExt:=DefaultPascalFileExt;
1001 if DefPasExt='' then exit;
1002 for i:=0 to Count-1 do
1003 Items[i].UpdateDefaultPascalFileExtension(DefPasExt);
1004 end;
1005
1006 { TLazProjectDescriptors }
1007
TLazProjectDescriptors.GetItemsnull1008 function TLazProjectDescriptors.GetItems(Index: integer): TProjectDescriptor;
1009 begin
1010 Result:=TProjectDescriptor(FItems[Index]);
1011 end;
1012
1013 constructor TLazProjectDescriptors.Create;
1014 var
1015 EmptyProjectDesc: TProjectDescriptor;
1016 begin
1017 ProjectDescriptors:=Self;
1018 FItems:=TList.Create;
1019 EmptyProjectDesc:=TProjectDescriptor.Create;
1020 EmptyProjectDesc.Name:='Empty';
1021 EmptyProjectDesc.VisibleInNewDialog:=false;
1022 RegisterDescriptor(EmptyProjectDesc);
1023 //DebugLn('TLazProjectDescriptors.Create ',dbgs(EmptyProjectDesc.VisibleInNewDialog));
1024 end;
1025
1026 destructor TLazProjectDescriptors.Destroy;
1027 var
1028 i: Integer;
1029 begin
1030 fDestroying:=true;
1031 for i:=Count-1 downto 0 do Items[i].Release;
1032 FItems.Free;
1033 FItems:=nil;
1034 ProjectDescriptors:=nil;
1035 inherited Destroy;
1036 end;
1037
TLazProjectDescriptors.Countnull1038 function TLazProjectDescriptors.Count: integer;
1039 begin
1040 Result:=FItems.Count;
1041 end;
1042
TLazProjectDescriptors.GetUniqueNamenull1043 function TLazProjectDescriptors.GetUniqueName(const Name: string): string;
1044 var
1045 i: Integer;
1046 begin
1047 Result:=Name;
1048 if IndexOf(Result)<0 then exit;
1049 i:=0;
1050 repeat
1051 inc(i);
1052 Result:=Name+IntToStr(i);
1053 until IndexOf(Result)<0;
1054 end;
1055
IndexOfnull1056 function TLazProjectDescriptors.IndexOf(const Name: string): integer;
1057 begin
1058 Result:=Count-1;
1059 while (Result>=0) and (UTF8CompareText(Name,Items[Result].Name)<>0) do
1060 dec(Result);
1061 end;
1062
IndexOfnull1063 function TLazProjectDescriptors.IndexOf(Descriptor: TProjectDescriptor): integer;
1064 begin
1065 Result:=Count-1;
1066 while (Result>=0) and (Items[Result]<>Descriptor) do
1067 dec(Result);
1068 end;
1069
TLazProjectDescriptors.FindByNamenull1070 function TLazProjectDescriptors.FindByName(const Name: string): TProjectDescriptor;
1071 var
1072 i: LongInt;
1073 begin
1074 i:=IndexOf(Name);
1075 if i>=0 then
1076 Result:=Items[i]
1077 else
1078 Result:=nil;
1079 end;
1080
1081 procedure TLazProjectDescriptors.RegisterDescriptor(Descriptor: TProjectDescriptor);
1082 begin
1083 if Descriptor.Name='' then
1084 raise Exception.Create('TLazProjectDescriptors.RegisterDescriptor Descriptor.Name empty');
1085 if IndexOf(Descriptor)>=0 then
1086 raise Exception.Create('TLazProjectDescriptors.RegisterDescriptor Descriptor already registered');
1087 Descriptor.Name:=GetUniqueName(Descriptor.Name);
1088 FItems.Add(Descriptor);
1089 if Descriptor.VisibleInNewDialog then
1090 ;
1091 end;
1092
1093 procedure TLazProjectDescriptors.UnregisterDescriptor(Descriptor: TProjectDescriptor);
1094 var
1095 i: LongInt;
1096 begin
1097 if fDestroying then exit;
1098 i:=FItems.IndexOf(Descriptor);
1099 if i<0 then
1100 raise Exception.Create('TLazProjectDescriptors.UnregisterDescriptor');
1101 FItems.Delete(i);
1102 Descriptor.Release;
1103 end;
1104
1105 initialization
1106 LazProjectFileDescriptors:=nil;
1107
1108 end.
1109
1110