1 {
2 /***************************************************************************
3 ideoptionsdefs.pp - Toolbar
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 unit IDEOptionDefs;
29
30 {$mode objfpc}{$H+}
31
32 interface
33
34 uses
35 Classes, SysUtils, types,
36 // LCL
37 LCLProc, Forms, Controls,
38 // LazUtils
39 LazFileUtils, LazConfigStorage, Laz2_XMLCfg, LazUTF8,
40 // IdeIntf
41 BaseIDEIntf, IDEExternToolIntf,
42 // IDE
43 LazConf;
44
45 type
46 { TXMLOptionsStorage }
47
48 TXMLOptionsStorage = class(TConfigStorage)
49 private
50 FFreeXMLConfig: boolean;
51 FXMLConfig: TXMLConfig;
52 protected
GetFullPathValuenull53 function GetFullPathValue(const APath, ADefault: String): String; override;
GetFullPathValuenull54 function GetFullPathValue(const APath: String; ADefault: Integer): Integer; override;
GetFullPathValuenull55 function GetFullPathValue(const APath: String; ADefault: Boolean): Boolean; override;
56 procedure SetFullPathValue(const APath, AValue: String); override;
57 procedure SetDeleteFullPathValue(const APath, AValue, DefValue: String); override;
58 procedure SetFullPathValue(const APath: String; AValue: Integer); override;
59 procedure SetDeleteFullPathValue(const APath: String; AValue, DefValue: Integer); override;
60 procedure SetFullPathValue(const APath: String; AValue: Boolean); override;
61 procedure SetDeleteFullPathValue(const APath: String; AValue, DefValue: Boolean); override;
62 procedure DeleteFullPath(const APath: string); override;
63 procedure DeleteFullPathValue(const APath: string); override;
64 public
65 constructor Create(const Filename: string; LoadFromDisk: Boolean); override;
66 constructor Create(TheXMLConfig: TXMLConfig);
67 constructor Create(TheXMLConfig: TXMLConfig; const StartPath: string);
68 destructor Destroy; override;
69 procedure Clear; override;
70 property XMLConfig: TXMLConfig read FXMLConfig;
71 property FreeXMLConfig: boolean read FFreeXMLConfig write FFreeXMLConfig;
72 procedure WriteToDisk; override;
GetFilenamenull73 function GetFilename: string; override;
74 end;
75
76
77 { non modal IDE windows }
78 type
79 TNonModalIDEWindow = (
80 nmiwNone, // empty/none/undefined
81 nmiwMainIDE,
82 nmiwSourceNoteBook,
83 nmiwMessagesView,
84 nmiwUnitDependencies,
85 nmiwCodeExplorer,
86 nmiwFPDocEditor,
87 nmiwClipbrdHistory,
88 nmiwPkgGraphExplorer,
89 nmiwProjectInspector,
90 nmiwEditorFileManager,
91 nmiwSearchResultsView,
92 nmiwAnchorEditor,
93 nmiwTabOrderEditor,
94 nmiwCodeBrowser,
95 nmiwIssueBrowser,
96 nmiwJumpHistory,
97 nmiwComponentList
98 );
99
100 const
101 // This is the list of IDE windows, that will not be automatically reopened
102 // on startup. These windows are opened automatically when needed.
103 { NonModalIDEWindowManualOpen = [
104 nmiwNone,
105 nmiwMainIDE,
106 nmiwSourceNoteBook,
107 //nmiwDbgOutput,
108 //nmiwDbgEvents,
109 nmiwSearchResultsView,
110 nmiwAnchorEditor
111 ];
112 }
113 // form names for non modal IDE windows:
114 NonModalIDEWindowNames: array[TNonModalIDEWindow] of string = (
115 '?',
116 'MainIDE',
117 'SourceNotebook',
118 'MessagesView',
119 'UnitDependencies',
120 'CodeExplorerView',
121 'FPDocEditor',
122 'ClipBrdHistory',
123 'PkgGraphExplorer',
124 'ProjectInspector',
125 'EditorFileManager',
126 // not shown at startup
127 'SearchResults',
128 'AnchorEditor',
129 'TabOrderEditor',
130 'CodeBrowser',
131 'IssueBrowser',
132 'JumpHistory',
133 'ComponentList'
134 );
135
136 type
137 TLMsgViewFilter = class;
138
139 { TLMVFilterMsgType - read/write by main, read by worker thread }
140
141 TLMVFilterMsgType = class
142 private
143 FFilter: TLMsgViewFilter;
144 FIndex: integer;
145 FMsgID: integer;
146 FSubTool: string;
147 procedure SetMsgID(AValue: integer);
148 procedure SetSubTool(AValue: string);
149 procedure Changed;
150 procedure InternalAssign(Src: TLMVFilterMsgType);
151 public
152 constructor Create(aFilter: TLMsgViewFilter);
IsEqualnull153 function IsEqual(Src: TLMVFilterMsgType): boolean;
154 procedure Assign(Src: TLMVFilterMsgType);
155 property Filter: TLMsgViewFilter read FFilter;
156 property SubTool: string read FSubTool write SetSubTool;
157 property MsgID: integer read FMsgID write SetMsgID;
158 property Index: integer read FIndex;
159 end;
160
161 { TLMsgViewFilter
162 Note: The View.Filter is protected by View.Enter/LeaveCriticalSection,
163 read/write by main thread, read by worker thread.
164 }
165
166 TLMsgViewFilter = class
167 private
168 FCaption: string;
169 FFilterNotesWithoutPos: boolean;
170 FMinUrgency: TMessageLineUrgency;
171 FOnChanged: TNotifyEvent;
172 fFilterMsgTypes: array of TLMVFilterMsgType; // sorted for SubTool, MsgID
GetFilterMsgTypesnull173 function GetFilterMsgTypes(Index: integer): TLMVFilterMsgType; inline;
174 procedure SetCaption(AValue: string);
175 procedure SetFilterNotesWithoutPos(AValue: boolean);
176 procedure SetMinUrgency(AValue: TMessageLineUrgency);
177 procedure Changed;
178 procedure UpdateFilterMsgTypeIndex(Item: TLMVFilterMsgType);
179 public
180 constructor Create;
181 destructor Destroy; override;
182 procedure Clear;
183 procedure SetToFitsAll;
IsEqualnull184 function IsEqual(Src: TLMsgViewFilter): boolean; // does not check Caption
185 procedure Assign(Src: TLMsgViewFilter); // does not copy Caption
LineFitsnull186 function LineFits(Line: TMessageLine): boolean; virtual;
187 property Caption: string read FCaption write SetCaption;
188 property MinUrgency: TMessageLineUrgency read FMinUrgency write SetMinUrgency;
189 property FilterNotesWithoutPos: boolean read FFilterNotesWithoutPos write SetFilterNotesWithoutPos;
FilterMsgTypeCountnull190 function FilterMsgTypeCount: integer; inline;
191 property FilterMsgTypes[Index: integer]: TLMVFilterMsgType read GetFilterMsgTypes;
AddFilterMsgTypenull192 function AddFilterMsgType(SubTool: string; MsgID: integer): TLMVFilterMsgType;
193 procedure DeleteFilterMsgType(Index: integer);
194 procedure ClearFilterMsgTypes;
IndexOfFilterMsgTypenull195 function IndexOfFilterMsgType(Line: TMessageLine): integer;
196 property OnChanged: TNotifyEvent read FOnChanged write FOnChanged;
197 procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string);
198 procedure SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string);
199 procedure ConsistencyCheck;
200 end;
201
202 { TLMsgViewFilters }
203
204 TLMsgViewFilters = class(TComponent)
205 private
206 FActiveFilter: TLMsgViewFilter;
207 fFilters: TFPList; // list of TLMsgViewFilter
208 FOnChanged: TNotifyEvent;
GetFiltersnull209 function GetFilters(Index: integer): TLMsgViewFilter;
210 procedure OnFilterChanged(Sender: TObject);
211 procedure SetActiveFilter(AValue: TLMsgViewFilter);
212 public
213 constructor Create(AOwner: TComponent); override;
214 destructor Destroy; override;
215 procedure Clear;
Countnull216 function Count: integer; inline;
217 property Filters[Index: integer]: TLMsgViewFilter read GetFilters; default;
GetFilternull218 function GetFilter(aCaption: string; CreateIfNotExist: boolean): TLMsgViewFilter;
219 procedure Delete(Index: integer);
IndexOfnull220 function IndexOf(Filter: TLMsgViewFilter): integer; inline;
Addnull221 function Add(Filter: TLMsgViewFilter): integer;
222 procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string);
223 procedure SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string);
224 property ActiveFilter: TLMsgViewFilter read FActiveFilter write SetActiveFilter;
225 property OnChanged: TNotifyEvent read FOnChanged write FOnChanged;
226 end;
227
CompareFilterMsgTypenull228 function CompareFilterMsgType(FilterMsgType1, FilterMsgType2: Pointer): integer;
CompareLineAndFilterMsgTypenull229 function CompareLineAndFilterMsgType(MessageLine1, FilterMsgType1: Pointer): integer;
230
CreateNiceWindowPositionnull231 function CreateNiceWindowPosition(Width, Height: integer): TRect;
NonModalIDEFormIDToEnumnull232 function NonModalIDEFormIDToEnum(const FormID: string): TNonModalIDEWindow;
233
GetLazIDEConfigStoragenull234 function GetLazIDEConfigStorage(const Filename: string; LoadFromDisk: Boolean
235 ): TConfigStorage; // load errors: raises exceptions
236
237
238 implementation
239
240
CreateNiceWindowPositionnull241 function CreateNiceWindowPosition(Width, Height: integer): TRect;
242
FindFormAtnull243 function FindFormAt(x,y: integer): TCustomForm;
244 var
245 i: Integer;
246 begin
247 for i := 0 to Screen.CustomFormCount - 1 do
248 begin
249 Result := Screen.CustomForms[i];
250 if Result.HandleAllocated and Result.Visible
251 and (Result.Left >= x - 5) and (Result.Left <= x + 5)
252 and (Result.Top >= y - 5) and (Result.Top <= y + 5)
253 then
254 exit;
255 end;
256 Result := nil;
257 end;
258
259 var
260 MinX: Integer;
261 MinY: Integer;
262 MaxX: Integer;
263 MaxY: Integer;
264 x: Integer;
265 y: Integer;
266 MidX: Integer;
267 MidY: Integer;
268 Step: Integer;
269 ABounds: TRect;
270 begin
271 if Screen.ActiveCustomForm <> nil then
272 ABounds := Screen.ActiveCustomForm.Monitor.BoundsRect
273 else
274 if Application.MainForm <> nil then
275 ABounds := Application.MainForm.Monitor.BoundsRect
276 else
277 ABounds := Screen.PrimaryMonitor.BoundsRect;
278
279 MinX := ABounds.Left;
280 MinY := ABounds.Top;
281 MaxX := ABounds.Right - Width - 10;
282 if MaxX < MinX + 10 then MaxX := MinX + 10;
283 MaxY := ABounds.Bottom - Height - 100; // why -100?
284 if MaxY < MinY + 10 then MaxY := MinY + 10;
285 MidX := (MaxX + MinX) div 2;
286 MidY := (MaxY + MinY) div 2;
287 Step := 0;
288 repeat
289 x := MidX - Step * 20;
290 y := MidY - Step * 20;
291 if (x < MinX) or (x > MaxX) or (y < MinY) or (y > MaxY) then break;
292 if (FindFormAt(x, y)=nil) or (Step > 1000) then break;
293 inc(Step);
294 until False;
295 Result.Left := x;
296 Result.Top := y;
297 Result.Right := x + Width;
298 Result.Bottom := y + Height;
299 end;
300
NonModalIDEFormIDToEnumnull301 function NonModalIDEFormIDToEnum(const FormID: string): TNonModalIDEWindow;
302 begin
303 for Result:=Low(TNonModalIDEWindow) to High(TNonModalIDEWindow) do
304 if NonModalIDEWindowNames[Result]=FormID then
305 exit;
306 Result:=nmiwNone;
307 end;
308
GetLazIDEConfigStoragenull309 function GetLazIDEConfigStorage(const Filename: string; LoadFromDisk: Boolean
310 ): TConfigStorage;
311 var
312 ConfigFilename: String;
313 begin
314 if CompareFilenames(ExtractFilePath(Filename),GetPrimaryConfigPath)=0 then
315 ConfigFilename:=ExtractFileName(Filename)
316 else
317 ConfigFilename:=Filename;
318
319 if LoadFromDisk and (ExtractFilePath(ConfigFilename)='')
320 then begin
321 // copy template config file to users config directory
322 CopySecondaryConfigFile(ConfigFilename);
323 end;
324 // create storage
325 if not FilenameIsAbsolute(ConfigFilename) then
326 ConfigFilename:=AppendPathDelim(GetPrimaryConfigPath)+ConfigFilename;
327 Result:=TXMLOptionsStorage.Create(ConfigFilename,LoadFromDisk);
328 end;
329
CompareFilterMsgTypenull330 function CompareFilterMsgType(FilterMsgType1, FilterMsgType2: Pointer): integer;
331 var
332 Item1: TLMVFilterMsgType absolute FilterMsgType1;
333 Item2: TLMVFilterMsgType absolute FilterMsgType2;
334 begin
335 Result:=SysUtils.CompareText(Item1.SubTool,Item2.SubTool);
336 if Result<>0 then exit;
337 if Item1.MsgID<Item2.MsgID then
338 exit(-1)
339 else if Item1.MsgID>Item2.MsgID then
340 exit(1);
341 Result:=0;
342 end;
343
CompareLineAndFilterMsgTypenull344 function CompareLineAndFilterMsgType(MessageLine1, FilterMsgType1: Pointer
345 ): integer;
346 var
347 Line: TMessageLine absolute MessageLine1;
348 Item: TLMVFilterMsgType absolute FilterMsgType1;
349 begin
350 Result:=SysUtils.CompareText(Line.SubTool,Item.SubTool);
351 if Result<>0 then exit;
352 if Line.MsgID<Item.MsgID then
353 exit(-1)
354 else if Line.MsgID>Item.MsgID then
355 exit(1);
356 Result:=0;
357 end;
358
359 { TLMsgViewFilters }
360
361 // inline
TLMsgViewFilters.Countnull362 function TLMsgViewFilters.Count: integer;
363 begin
364 Result:=FFilters.Count;
365 end;
366
367 // inline
TLMsgViewFilters.IndexOfnull368 function TLMsgViewFilters.IndexOf(Filter: TLMsgViewFilter): integer;
369 begin
370 Result:=fFilters.IndexOf(Filter);
371 end;
372
TLMsgViewFilters.GetFiltersnull373 function TLMsgViewFilters.GetFilters(Index: integer): TLMsgViewFilter;
374
375 procedure RaiseOutOfBounds;
376 begin
377 raise Exception.Create('TLMsgViewFilters.GetFilters '+IntToStr(Index)+' out of bounds '+IntToStr(Count));
378 end;
379
380 begin
381 if (Index<0) or (Index>=Count) then
382 RaiseOutOfBounds;
383 Result:=TLMsgViewFilter(fFilters[Index]);
384 end;
385
386 procedure TLMsgViewFilters.OnFilterChanged(Sender: TObject);
387 begin
388 if csDestroying in ComponentState then exit;
389 if Assigned(OnChanged) then
390 OnChanged(Self);
391 end;
392
393 procedure TLMsgViewFilters.SetActiveFilter(AValue: TLMsgViewFilter);
394 var
395 i: Integer;
396 begin
397 if FActiveFilter=AValue then Exit;
398 i:=IndexOf(AValue);
399 if i<0 then begin
400 if FActiveFilter.IsEqual(AValue) then exit;
401 FActiveFilter.Assign(AValue);
402 end else
403 FActiveFilter:=AValue;
404 OnFilterChanged(AValue);
405 end;
406
407 constructor TLMsgViewFilters.Create(AOwner: TComponent);
408 begin
409 inherited;
410 fFilters:=TFPList.Create;
411 FActiveFilter:=TLMsgViewFilter.Create;
412 FActiveFilter.Caption:='Default';
413 FActiveFilter.OnChanged:=@OnFilterChanged;
414 fFilters.Add(FActiveFilter);
415 end;
416
417 destructor TLMsgViewFilters.Destroy;
418 begin
419 Clear;
420 ActiveFilter.Free;
421 FreeAndNil(fFilters);
422 inherited Destroy;
423 end;
424
425 procedure TLMsgViewFilters.Clear;
426 var
427 i: Integer;
428 begin
429 ActiveFilter:=Filters[0];
430 for i:=Count-1 downto 1 do
431 Delete(i);
432 Filters[0].Clear;
433 end;
434
TLMsgViewFilters.GetFilternull435 function TLMsgViewFilters.GetFilter(aCaption: string; CreateIfNotExist: boolean
436 ): TLMsgViewFilter;
437 var
438 i: Integer;
439 begin
440 for i:=0 to Count-1 do begin
441 Result:=Filters[i];
442 if SysUtils.CompareText(Result.Caption,aCaption)=0 then exit;
443 end;
444 if not CreateIfNotExist then
445 exit(nil);
446 Result:=TLMsgViewFilter.Create;
447 Result.Caption:=aCaption;
448 Result.OnChanged:=@OnFilterChanged;
449 Add(Result);
450 end;
451
452 procedure TLMsgViewFilters.Delete(Index: integer);
453 var
454 Filter: TLMsgViewFilter;
455 begin
456 if (Index=0) and (Count=1) then begin
457 ActiveFilter.Clear;
458 end else begin
459 Filter:=Filters[Index];
460 Filter.OnChanged:=nil;
461 fFilters.Delete(Index);
462 if ActiveFilter=Filter then
463 FActiveFilter:=Filters[0];
464 Filter.Free;
465 OnFilterChanged(Self);
466 end;
467 end;
468
Addnull469 function TLMsgViewFilters.Add(Filter: TLMsgViewFilter): integer;
470 begin
471 Filter.OnChanged:=@OnFilterChanged;
472 Result:=fFilters.Add(Filter);
473 OnFilterChanged(Self);
474 end;
475
476 procedure TLMsgViewFilters.LoadFromXMLConfig(XMLConfig: TXMLConfig;
477 const Path: string);
478 var
479 NewCnt: Integer;
480 ActiveIndex: Integer;
481 i: Integer;
482 Filter: TLMsgViewFilter;
483 begin
484 Clear;
485 NewCnt:=XMLConfig.GetValue(Path+'Count',1);
486 ActiveIndex:=XMLConfig.GetValue(Path+'Active',1);
487 for i:=1 to NewCnt do begin
488 if i>Count then begin
489 Filter:=TLMsgViewFilter.Create;
490 Add(Filter);
491 end else begin
492 Filter:=Filters[i-1];
493 end;
494 Filter.LoadFromXMLConfig(XMLConfig,Path+'Filter'+IntToStr(i)+'/');
495 end;
496 if (ActiveIndex>0) and (ActiveIndex<=Count) then
497 ActiveFilter:=Filters[ActiveIndex-1];
498 for i:=Count downto NewCnt+1 do
499 Delete(i-1);
500 end;
501
502 procedure TLMsgViewFilters.SaveToXMLConfig(XMLConfig: TXMLConfig;
503 const Path: string);
504 var
505 i: Integer;
506 begin
507 XMLConfig.SetDeleteValue(Path+'Count',Count,1);
508 XMLConfig.SetDeleteValue(Path+'Active',IndexOf(ActiveFilter)+1,1);
509 for i:=1 to Count do
510 Filters[i-1].SaveToXMLConfig(XMLConfig,Path+'Filter'+IntToStr(i)+'/');
511 end;
512
513 { TXMLOptionsStorage }
514
TXMLOptionsStorage.GetFullPathValuenull515 function TXMLOptionsStorage.GetFullPathValue(const APath, ADefault: String): String;
516 begin
517 Result:=XMLConfig.GetValue(APath, ADefault);
518 end;
519
TXMLOptionsStorage.GetFullPathValuenull520 function TXMLOptionsStorage.GetFullPathValue(const APath: String;
521 ADefault: Integer): Integer;
522 begin
523 Result:=XMLConfig.GetValue(APath, ADefault);
524 end;
525
TXMLOptionsStorage.GetFullPathValuenull526 function TXMLOptionsStorage.GetFullPathValue(const APath: String;
527 ADefault: Boolean): Boolean;
528 begin
529 Result:=XMLConfig.GetValue(APath, ADefault);
530 end;
531
532 procedure TXMLOptionsStorage.SetFullPathValue(const APath, AValue: String);
533 begin
534 XMLConfig.SetValue(APath, AValue);
535 end;
536
537 procedure TXMLOptionsStorage.SetDeleteFullPathValue(const APath, AValue,
538 DefValue: String);
539 begin
540 XMLConfig.SetDeleteValue(APath, AValue, DefValue);
541 end;
542
543 procedure TXMLOptionsStorage.SetFullPathValue(const APath: String;
544 AValue: Integer);
545 begin
546 XMLConfig.SetValue(APath, AValue);
547 end;
548
549 procedure TXMLOptionsStorage.SetDeleteFullPathValue(const APath: String;
550 AValue, DefValue: Integer);
551 begin
552 XMLConfig.SetDeleteValue(APath, AValue, DefValue);
553 end;
554
555 procedure TXMLOptionsStorage.SetFullPathValue(const APath: String;
556 AValue: Boolean);
557 begin
558 XMLConfig.SetValue(APath, AValue);
559 end;
560
561 procedure TXMLOptionsStorage.SetDeleteFullPathValue(const APath: String;
562 AValue, DefValue: Boolean);
563 begin
564 XMLConfig.SetDeleteValue(APath, AValue, DefValue);
565 end;
566
567 procedure TXMLOptionsStorage.DeleteFullPath(const APath: string);
568 begin
569 XMLConfig.DeletePath(APath);
570 end;
571
572 procedure TXMLOptionsStorage.DeleteFullPathValue(const APath: string);
573 begin
574 XMLConfig.DeleteValue(APath);
575 end;
576
577 constructor TXMLOptionsStorage.Create(const Filename: string;
578 LoadFromDisk: Boolean);
579 begin
580 if LoadFromDisk then
581 FXMLConfig:=TXMLConfig.Create(Filename)
582 else
583 FXMLConfig:=TXMLConfig.CreateClean(Filename);
584 FFreeXMLConfig:=true;
585 end;
586
587 constructor TXMLOptionsStorage.Create(TheXMLConfig: TXMLConfig);
588 begin
589 FXMLConfig:=TheXMLConfig;
590 if FXMLConfig=nil then
591 raise Exception.Create('');
592 end;
593
594 constructor TXMLOptionsStorage.Create(TheXMLConfig: TXMLConfig;
595 const StartPath: string);
596 begin
597 Create(TheXMLConfig);
598 AppendBasePath(StartPath);
599 end;
600
601 destructor TXMLOptionsStorage.Destroy;
602 begin
603 if FreeXMLConfig then FreeAndNil(FXMLConfig);
604 inherited Destroy;
605 end;
606
607 procedure TXMLOptionsStorage.Clear;
608 begin
609 FXMLConfig.Clear;
610 end;
611
612 procedure TXMLOptionsStorage.WriteToDisk;
613 begin
614 FXMLConfig.Flush;
615 end;
616
TXMLOptionsStorage.GetFilenamenull617 function TXMLOptionsStorage.GetFilename: string;
618 begin
619 Result:=FXMLConfig.Filename;
620 end;
621
622 { TLMVFilterMsgType }
623
624 procedure TLMVFilterMsgType.SetMsgID(AValue: integer);
625 begin
626 if FMsgID=AValue then Exit;
627 FMsgID:=AValue;
628 Changed;
629 end;
630
631 procedure TLMVFilterMsgType.SetSubTool(AValue: string);
632 begin
633 if FSubTool=AValue then Exit;
634 FSubTool:=AValue;
635 Changed;
636 end;
637
638 procedure TLMVFilterMsgType.Changed;
639 begin
640 Filter.UpdateFilterMsgTypeIndex(Self);
641 Filter.Changed;
642 end;
643
644 procedure TLMVFilterMsgType.InternalAssign(Src: TLMVFilterMsgType);
645 begin
646 fSubTool:=Src.SubTool;
647 fMsgID:=Src.MsgID;
648 end;
649
650 constructor TLMVFilterMsgType.Create(aFilter: TLMsgViewFilter);
651 begin
652 FFilter:=aFilter;
653 end;
654
TLMVFilterMsgType.IsEqualnull655 function TLMVFilterMsgType.IsEqual(Src: TLMVFilterMsgType): boolean;
656 begin
657 if Self=Src then exit(true);
658 Result:=(SubTool=Src.SubTool)
659 and (MsgID=Src.MsgID);
660 end;
661
662 procedure TLMVFilterMsgType.Assign(Src: TLMVFilterMsgType);
663 begin
664 if IsEqual(Src) then exit;
665 InternalAssign(Src);
666 Changed;
667 end;
668
669 { TLMsgViewFilter }
670
671 // inline
TLMsgViewFilter.FilterMsgTypeCountnull672 function TLMsgViewFilter.FilterMsgTypeCount: integer;
673 begin
674 Result:=length(fFilterMsgTypes);
675 end;
676
677 // inline
GetFilterMsgTypesnull678 function TLMsgViewFilter.GetFilterMsgTypes(Index: integer): TLMVFilterMsgType;
679 begin
680 Result:=fFilterMsgTypes[Index];
681 end;
682
683 procedure TLMsgViewFilter.SetCaption(AValue: string);
684 begin
685 AValue:=UTF8Trim(AValue,[]);
686 if FCaption=AValue then Exit;
687 FCaption:=AValue;
688 end;
689
690 procedure TLMsgViewFilter.SetMinUrgency(AValue: TMessageLineUrgency);
691 begin
692 if FMinUrgency=AValue then Exit;
693 FMinUrgency:=AValue;
694 Changed;
695 end;
696
697 procedure TLMsgViewFilter.SetFilterNotesWithoutPos(AValue: boolean);
698 begin
699 if FFilterNotesWithoutPos=AValue then Exit;
700 FFilterNotesWithoutPos:=AValue;
701 Changed;
702 end;
703
704 procedure TLMsgViewFilter.Changed;
705 begin
706 if Assigned(OnChanged) then
707 OnChanged(Self);
708 end;
709
710 procedure TLMsgViewFilter.UpdateFilterMsgTypeIndex(Item: TLMVFilterMsgType);
711 var
712 OldIndex: Integer;
713 l: Integer;
714 r: Integer;
715 m: Integer;
716 cmp: Integer;
717 StartIndex: Integer;
718 EndIndex: Integer;
719 NewIndex: Integer;
720 begin
721 if FilterMsgTypeCount=1 then exit;
722 OldIndex:=Item.FIndex;
723 if (OldIndex>0) and (CompareFilterMsgType(Item,fFilterMsgTypes[OldIndex-1])<0)
724 then begin
725 StartIndex:=0;
726 EndIndex:=OldIndex-1;
727 end else if (OldIndex<FilterMsgTypeCount-1)
728 and (CompareFilterMsgType(Item,fFilterMsgTypes[OldIndex+1])>0) then begin
729 StartIndex:=OldIndex+1;
730 EndIndex:=FilterMsgTypeCount-1;
731 end else
732 exit;
733
734 l:=StartIndex;
735 r:=EndIndex;
736 m:=0;
737 cmp:=0;
738 while l<=r do begin
739 m:=(l+r) div 2;
740 cmp:=CompareFilterMsgType(Item,fFilterMsgTypes[m]);
741 if cmp<0 then
742 r:=m-1
743 else if cmp>0 then
744 l:=m+1
745 else
746 break;
747 end;
748 if cmp<=0 then
749 NewIndex:=m
750 else
751 NewIndex:=m+1;
752 if OldIndex<NewIndex then begin
753 system.Move(fFilterMsgTypes[OldIndex+1],fFilterMsgTypes[OldIndex],
754 SizeOf(TLMVFilterMsgType)*(NewIndex-OldIndex));
755 end else if OldIndex>NewIndex then begin
756 system.Move(fFilterMsgTypes[NewIndex],fFilterMsgTypes[NewIndex+1],
757 SizeOf(TLMVFilterMsgType)*(OldIndex-NewIndex));
758 end else
759 exit;
760 fFilterMsgTypes[NewIndex]:=Item;
761
762 {$IFDEF CheckExtTools}
763 ConsistencyCheck;
764 {$ENDIF}
765 end;
766
767 constructor TLMsgViewFilter.Create;
768 begin
769 FMinUrgency:=mluHint;
770 FFilterNotesWithoutPos:=true;
771 end;
772
773 destructor TLMsgViewFilter.Destroy;
774 begin
775 ClearFilterMsgTypes;
776 inherited Destroy;
777 end;
778
779 procedure TLMsgViewFilter.Clear;
780 begin
781 MinUrgency:=mluHint;
782 FilterNotesWithoutPos:=true;
783 ClearFilterMsgTypes;
784 end;
785
786 procedure TLMsgViewFilter.SetToFitsAll;
787 begin
788 MinUrgency:=mluNone;
789 FilterNotesWithoutPos:=false;
790 ClearFilterMsgTypes;
791 end;
792
TLMsgViewFilter.IsEqualnull793 function TLMsgViewFilter.IsEqual(Src: TLMsgViewFilter): boolean;
794 var
795 i: Integer;
796 begin
797 Result:=false;
798 if Self=Src then exit(true);
799 if (MinUrgency<>Src.MinUrgency)
800 or (FilterNotesWithoutPos<>Src.FilterNotesWithoutPos)
801 or (FilterMsgTypeCount<>Src.FilterMsgTypeCount)
802 then exit;
803 for i:=0 to FilterMsgTypeCount-1 do
804 if not FilterMsgTypes[i].IsEqual(Src.FilterMsgTypes[i]) then exit;
805 Result:=true;
806 end;
807
808 procedure TLMsgViewFilter.Assign(Src: TLMsgViewFilter);
809 var
810 NewCnt: Integer;
811 OldCnt: Integer;
812 i: Integer;
813 begin
814 if IsEqual(Src) then exit;
815 fMinUrgency:=Src.MinUrgency;
816 FFilterNotesWithoutPos:=Src.FilterNotesWithoutPos;
817
818 // filter msg type
819 NewCnt:=Src.FilterMsgTypeCount;
820 OldCnt:=FilterMsgTypeCount;
821 for i:=NewCnt to OldCnt-1 do
822 FreeAndNil(fFilterMsgTypes[i]);
823 SetLength(fFilterMsgTypes,NewCnt);
824 for i:=0 to NewCnt-1 do begin
825 if fFilterMsgTypes[i]=nil then
826 fFilterMsgTypes[i]:=TLMVFilterMsgType.Create(Self);
827 fFilterMsgTypes[i].InternalAssign(Src.FilterMsgTypes[i]);
828 end;
829
830 Changed;
831 end;
832
LineFitsnull833 function TLMsgViewFilter.LineFits(Line: TMessageLine): boolean;
834 begin
835 Result:=false;
836
837 if ord(Line.Urgency)<ord(MinUrgency) then exit;
838
839 if [mlfHiddenByIDEDirective,mlfFixed]*Line.Flags<>[] then exit;
840
841 if FilterNotesWithoutPos and (Line.Urgency<=mluNote)
842 and ((Line.Filename='') or (Line.Line<1)) then exit;
843
844 if IndexOfFilterMsgType(Line)>=0 then exit;
845
846 Result:=true;
847 end;
848
TLMsgViewFilter.AddFilterMsgTypenull849 function TLMsgViewFilter.AddFilterMsgType(SubTool: string;
850 MsgID: integer): TLMVFilterMsgType;
851 var
852 i: Integer;
853 begin
854 i:=length(fFilterMsgTypes);
855 SetLength(fFilterMsgTypes,i+1);
856 Result:=TLMVFilterMsgType.Create(Self);
857 fFilterMsgTypes[i]:=Result;
858 Result.FSubTool:=SubTool;
859 Result.FMsgID:=MsgID;
860 UpdateFilterMsgTypeIndex(Result);
861 Changed;
862 end;
863
864 procedure TLMsgViewFilter.DeleteFilterMsgType(Index: integer);
865 begin
866 if (Index<0) or (Index>=FilterMsgTypeCount) then
867 raise Exception.Create('');
868 fFilterMsgTypes[Index].Free;
869 if Index<FilterMsgTypeCount-1 then
870 system.Move(fFilterMsgTypes[Index+1],fFilterMsgTypes[Index],
871 SizeOf(TLMVFilterMsgType)*(FilterMsgTypeCount-Index-1));
872 SetLength(fFilterMsgTypes,length(fFilterMsgTypes)-1);
873 Changed;
874 end;
875
876 procedure TLMsgViewFilter.ClearFilterMsgTypes;
877 var
878 i: Integer;
879 begin
880 if FilterMsgTypeCount=0 then exit;
881 for i:=0 to FilterMsgTypeCount-1 do
882 fFilterMsgTypes[i].Free;
883 SetLength(fFilterMsgTypes,0);
884 Changed;
885 end;
886
IndexOfFilterMsgTypenull887 function TLMsgViewFilter.IndexOfFilterMsgType(Line: TMessageLine): integer;
888 var
889 l: Integer;
890 r: Integer;
891 m: Integer;
892 cmp: Integer;
893 begin
894 l:=0;
895 r:=FilterMsgTypeCount-1;
896 while l<=r do begin
897 m:=(l+r) div 2;
898 cmp:=CompareLineAndFilterMsgType(Line,fFilterMsgTypes[m]);
899 if cmp<0 then
900 r:=m-1
901 else if cmp>0 then
902 l:=m+1
903 else
904 exit(m);
905 end;
906 Result:=-1;
907 end;
908
909 procedure TLMsgViewFilter.LoadFromXMLConfig(XMLConfig: TXMLConfig;
910 const Path: string);
911 var
912 NewCnt: Integer;
913 i: Integer;
914 p: String;
915 SubTool: String;
916 MsgId: Integer;
917 begin
918 fCaption:=XMLConfig.GetValue(Path+'Caption','Default');
919 FMinUrgency:=StrToMsgLineUrgency(XMLConfig.GetValue(Path+'MinUrgency',
920 MessageLineUrgencyNames[mluHint]));
921 FFilterNotesWithoutPos:=XMLConfig.GetValue(Path+'FilterNotesWithoutPos',true);
922 NewCnt:=XMLConfig.GetValue(Path+'MsgType/Count',0);
923 ClearFilterMsgTypes;
924 for i:=1 to NewCnt do begin
925 p:=Path+'MsgType/Item'+IntToStr(i)+'/';
926 SubTool:=XMLConfig.GetValue(p+'SubTool',SubToolFPC);
927 MsgId:=XMLConfig.GetValue(p+'MsgId',0);
928 if (SubTool='') or (MsgId=0) then continue;
929 AddFilterMsgType(SubTool,MsgId);
930 end;
931 end;
932
933 procedure TLMsgViewFilter.SaveToXMLConfig(XMLConfig: TXMLConfig;
934 const Path: string);
935 var
936 i: Integer;
937 p: String;
938 Item: TLMVFilterMsgType;
939 begin
940 XMLConfig.SetDeleteValue(Path+'Caption',Caption,'Default');
941 XMLConfig.SetDeleteValue(Path+'MinUrgency',
942 MessageLineUrgencyNames[MinUrgency],MessageLineUrgencyNames[mluHint]);
943 XMLConfig.SetDeleteValue(Path+'FilterNotesWithoutPos',FilterNotesWithoutPos,true);
944 XMLConfig.SetDeleteValue(Path+'MsgType/Count',FilterMsgTypeCount,0);
945 for i:=1 to FilterMsgTypeCount do begin
946 Item:=FilterMsgTypes[i-1];
947 p:=Path+'MsgType/Item'+IntToStr(i)+'/';
948 XMLConfig.SetDeleteValue(p+'SubTool',Item.SubTool,SubToolFPC);
949 XMLConfig.SetDeleteValue(p+'MsgId',Item.MsgID,0);
950 end;
951 end;
952
953 procedure TLMsgViewFilter.ConsistencyCheck;
954
955 procedure E(Msg: string);
956 begin
957 raise Exception.Create(Msg);
958 end;
959
960 var
961 i: Integer;
962 begin
963 for i:=0 to FilterMsgTypeCount-2 do begin
964 if CompareFilterMsgType(fFilterMsgTypes[i],fFilterMsgTypes[i+1])>0 then
965 E(IntToStr(i));
966 end;
967 end;
968
969 initialization
970 DefaultConfigClass:=TXMLOptionsStorage;
971 GetIDEConfigStorage:=@GetLazIDEConfigStorage;
972
973 end.
974
975