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