← Back to branch summary

~ubuntu-branches/ubuntu/saucy/lazarus/saucy

« back to all changes in this revision

Viewing changes to components/lazutils/lazloggerbase.pas

  • Committer: Package Import Robot
  • Author(s): Paul Gevers, Abou Al Montacir, Bart Martens, Paul Gevers
  • Date: 2013-06-08 14:12:17 UTC
  • mfrom: (1.1.9)
  • Revision ID: package-import@ubuntu.com-20130608141217-7k0cy9id8ifcnutc
Tags: 1.0.8+dfsg-1
http://bugs.debian.org/708695
[ Abou Al Montacir ]
* New upstream major release and multiple maintenace release offering many
  fixes and new features marking a new milestone for the Lazarus development
  and its stability level.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_fixes_branch
* LCL changes:
  - LCL is now a normal package.
      + Platform independent parts of the LCL are now in the package LCLBase
      + LCL is automatically recompiled when switching the target platform,
        unless pre-compiled binaries for this target are already installed.
      + No impact on existing projects.
      + Linker options needed by LCL are no more added to projects that do
        not use the LCL package.
  - Minor changes in LCL basic classes behaviour
      + TCustomForm.Create raises an exception if a form resource is not
        found.
      + TNotebook and TPage: a new implementation of these classes was added.
      + TDBNavigator: It is now possible to have focusable buttons by setting
        Options = [navFocusableButtons] and TabStop = True, useful for
        accessibility and for devices with neither mouse nor touch screen.
      + Names of TControlBorderSpacing.GetSideSpace and GetSpace were swapped
        and are now consistent. GetSideSpace = Around + GetSpace.
      + TForm.WindowState=wsFullscreen was added
      + TCanvas.TextFitInfo was added to calculate how many characters will
        fit into a specified Width. Useful for word-wrapping calculations.
      + TControl.GetColorResolvingParent and
        TControl.GetRGBColorResolvingParent were added, simplifying the work
        to obtain the final color of the control while resolving clDefault
        and the ParentColor.
      + LCLIntf.GetTextExtentExPoint now has a good default implementation
        which works in any platform not providing a specific implementation.
        However, Widgetset specific implementation is better, when available.
      + TTabControl was reorganized. Now it has the correct class hierarchy
        and inherits from TCustomTabControl as it should.
  - New unit in the LCL:
      + lazdialogs.pas: adds non-native versions of various native dialogs,
        for example TLazOpenDialog, TLazSaveDialog, TLazSelectDirectoryDialog.
        It is used by widgetsets which either do not have a native dialog, or
        do not wish to use it because it is limited. These dialogs can also be
        used by user applications directly.
      + lazdeviceapis.pas: offers an interface to more hardware devices such
        as the accelerometer, GPS, etc. See LazDeviceAPIs
      + lazcanvas.pas: provides a TFPImageCanvas descendent implementing
        drawing in a LCL-compatible way, but 100% in Pascal.
      + lazregions.pas. LazRegions is a wholly Pascal implementation of
        regions for canvas clipping, event clipping, finding in which control
        of a region tree one an event should reach, for drawing polygons, etc.
      + customdrawncontrols.pas, customdrawndrawers.pas,
        customdrawn_common.pas, customdrawn_android.pas and
        customdrawn_winxp.pas: are the Lazarus Custom Drawn Controls -controls
        which imitate the standard LCL ones, but with the difference that they
        are non-native and support skinning.
  - New APIs added to the LCL to improve support of accessibility software
    such as screen readers.
* IDE changes:
  - Many improvments.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/New_IDE_features_since#v1.0_.282012-08-29.29
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes#IDE_Changes
* Debugger / Editor changes:
  - Added pascal sources and breakpoints to the disassembler
  - Added threads dialog.
* Components changes:
  - TAChart: many fixes and new features
  - CodeTool: support Delphi style generics and new syntax extensions.
  - AggPas: removed to honor free licencing. (Closes: Bug#708695)
[Bart Martens]
* New debian/watch file fixing issues with upstream RC release.
[Abou Al Montacir]
* Avoid changing files in .pc hidden directory, these are used by quilt for
  internal purpose and could lead to surprises during build.
[Paul Gevers]
* Updated get-orig-source target and it compinion script orig-tar.sh so that they
  repack the source file, allowing bug 708695 to be fixed.

Show diffs side-by-side

added added

removed removed

Lines of Context:
components/lazutils/lazloggerbase.pas
 
1
unit LazLoggerBase;
 
2
{$mode objfpc}{$H+}
 
3
 
 
4
(*
 
5
  - All globas variables, initialization and finalization uses TObject instead
 
6
    of TLazLogger.
 
7
    This means, using the unit, without calling any of the functions, will not
 
8
    make any reference to the classes, and they should be smart-linked away.
 
9
*)
 
10
 
 
11
interface
 
12
 
 
13
uses
 
14
  Classes, SysUtils, FileUtil, types, math, LazClasses;
 
15
 
 
16
type
 
17
 
 
18
  TLazLoggerLogGroupFlag =
 
19
  ( lgfAddedByParamParser,        // Not added via Register. This is a placeholder for the enabled-state given by the user, via cmd-line
 
20
    lgfNoDefaultEnabledSpecified  // Registered without default
 
21
 
 
22
  );
 
23
  TLazLoggerLogGroupFlags = set of TLazLoggerLogGroupFlag;
 
24
 
 
25
  TLazLoggerLogGroup = record
 
26
    ConfigName: String;  // case insensitive
 
27
    Enabled: Boolean;
 
28
    Flags: TLazLoggerLogGroupFlags;
 
29
    FOpenedIndents: Integer;
 
30
  end;
 
31
  PLazLoggerLogGroup = ^TLazLoggerLogGroup;
 
32
 
 
33
  TLazLoggerWriteTarget = (
 
34
    lwtNone,
 
35
    lwtStdOut, lwtStdErr,
 
36
    lwtTextFile  // Data will be ^Text
 
37
  );
 
38
 
 
39
  TLazLoggerWriteEvent = procedure(Sender: TObject; S: string; var Handled: Boolean) of object;
 
40
  TLazLoggerWidgetSetWriteEvent = procedure(Sender: TObject;
 
41
      S: string;
 
42
      var Handled: Boolean;
 
43
      Target: TLazLoggerWriteTarget;
 
44
      Data: Pointer) of object;
 
45
 
 
46
type
 
47
 
 
48
  { TLazLoggerLogGroupList }
 
49
 
 
50
  TLazLoggerLogGroupList = class(TRefCountedObject)
 
51
  private
 
52
    FList: TFPList;
 
53
    procedure Clear;
 
54
    function GetItem(Index: Integer): PLazLoggerLogGroup;
 
55
    function  NewItem(const AConfigName: String; ADefaulEnabled: Boolean = False) : PLazLoggerLogGroup;
 
56
  protected
 
57
    function  Add(const AConfigName: String; ADefaulEnabled: Boolean = False) : PLazLoggerLogGroup;
 
58
    function  FindOrAdd(const AConfigName: String; ADefaulEnabled: Boolean = False) : PLazLoggerLogGroup;
 
59
    procedure Remove(const AConfigName: String);
 
60
    procedure Remove(const AnEntry: PLazLoggerLogGroup);
 
61
  public
 
62
    constructor Create;
 
63
    destructor  Destroy; override;
 
64
    procedure Assign(Src: TLazLoggerLogGroupList);
 
65
    function  IndexOf(const AConfigName: String): integer;
 
66
    function  IndexOf(const AnEntry: PLazLoggerLogGroup): integer;
 
67
    function  Find(const AConfigName: String): PLazLoggerLogGroup;
 
68
    function  Count: integer;
 
69
    property  Item[Index: Integer]: PLazLoggerLogGroup read GetItem; default;
 
70
  end;
 
71
 
 
72
  { TLazLogger }
 
73
 
 
74
  TLazLogger = class(TRefCountedObject)
 
75
  private
 
76
    FIsInitialized: Boolean;
 
77
 
 
78
    FMaxNestPrefixLen: Integer;
 
79
    FNestLvlIndent: Integer;
 
80
 
 
81
    FLogGroupList: TRefCountedObject; // Using TObject, so if none of the functions is used in the app, then even the rlass should be smart linked
 
82
    FUseGlobalLogGroupList: Boolean;
 
83
 
 
84
    procedure SetMaxNestPrefixLen(AValue: Integer);
 
85
    procedure SetNestLvlIndent(AValue: Integer);
 
86
 
 
87
    function  GetLogGroupList: TLazLoggerLogGroupList;
 
88
    procedure SetUseGlobalLogGroupList(AValue: Boolean);
 
89
  protected
 
90
    procedure DoInit; virtual;
 
91
    procedure DoFinsh; virtual;
 
92
 
 
93
    procedure IncreaseIndent; overload; virtual;
 
94
    procedure DecreaseIndent; overload; virtual;
 
95
    procedure IncreaseIndent({%H-}LogGroup: PLazLoggerLogGroup); overload; virtual;
 
96
    procedure DecreaseIndent({%H-}LogGroup: PLazLoggerLogGroup); overload; virtual;
 
97
    procedure IndentChanged; virtual;
 
98
 
 
99
    procedure DoDbgOut(const {%H-}s: string); virtual;
 
100
    procedure DoDebugLn(const {%H-}s: string); virtual;
 
101
    procedure DoDebuglnStack(const {%H-}s: string); virtual;
 
102
 
 
103
    function  ArgsToString(Args: array of const): string;
 
104
    property  IsInitialized: Boolean read FIsInitialized;
 
105
  public
 
106
    constructor Create;
 
107
    destructor  Destroy; override;
 
108
    procedure Assign(Src: TLazLogger); virtual;
 
109
    procedure Init;
 
110
    procedure Finish;
 
111
 
 
112
    property  NestLvlIndent: Integer read FNestLvlIndent write SetNestLvlIndent;
 
113
    property  MaxNestPrefixLen: Integer read FMaxNestPrefixLen write SetMaxNestPrefixLen;
 
114
 
 
115
  public
 
116
    function  RegisterLogGroup(const AConfigName: String; ADefaulEnabled: Boolean) : PLazLoggerLogGroup; virtual;
 
117
    function  RegisterLogGroup(const AConfigName: String) : PLazLoggerLogGroup; virtual;
 
118
    function  FindOrRegisterLogGroup(const AConfigName: String; ADefaulEnabled: Boolean) : PLazLoggerLogGroup; virtual;
 
119
    function  FindOrRegisterLogGroup(const AConfigName: String) : PLazLoggerLogGroup; virtual;
 
120
    property  LogGroupList: TLazLoggerLogGroupList read GetLogGroupList;
 
121
    property  UseGlobalLogGroupList: Boolean read FUseGlobalLogGroupList write SetUseGlobalLogGroupList;
 
122
  public
 
123
    procedure DebuglnStack(const s: string = '');
 
124
 
 
125
    procedure DbgOut(const s: string = ''); overload;
 
126
    procedure DbgOut(Args: array of const); overload;
 
127
    procedure DbgOut(const S: String; Args: array of const); overload;// similar to Format(s,Args)
 
128
    procedure DbgOut(const s1, s2: string; const s3: string = '';
 
129
                     const s4: string = ''; const s5: string = ''; const s6: string = '';
 
130
                     const s7: string = ''; const s8: string = ''; const s9: string = '';
 
131
                     const s10: string = ''; const s11: string = ''; const s12: string = '';
 
132
                     const s13: string = ''; const s14: string = ''; const s15: string = '';
 
133
                     const s16: string = ''; const s17: string = ''; const s18: string = ''); overload;
 
134
 
 
135
    procedure DebugLn(const s: string = ''); overload;
 
136
    procedure DebugLn(Args: array of const); overload;
 
137
    procedure DebugLn(const S: String; Args: array of const); overload;// similar to Format(s,Args)
 
138
    procedure DebugLn(const s1, s2: string; const s3: string = '';
 
139
                      const s4: string = ''; const s5: string = ''; const s6: string = '';
 
140
                      const s7: string = ''; const s8: string = ''; const s9: string = '';
 
141
                      const s10: string = ''; const s11: string = ''; const s12: string = '';
 
142
                      const s13: string = ''; const s14: string = ''; const s15: string = '';
 
143
                      const s16: string = ''; const s17: string = ''; const s18: string = ''); overload;
 
144
 
 
145
    procedure DebugLnEnter(const s: string = ''); overload;
 
146
    procedure DebugLnEnter(Args: array of const); overload;
 
147
    procedure DebugLnEnter(s: string; Args: array of const); overload;
 
148
    procedure DebugLnEnter(const s1, s2: string; const s3: string = '';
 
149
                           const s4: string = ''; const s5: string = ''; const s6: string = '';
 
150
                           const s7: string = ''; const s8: string = ''; const s9: string = '';
 
151
                           const s10: string = ''; const s11: string = ''; const s12: string = '';
 
152
                           const s13: string = ''; const s14: string = ''; const s15: string = '';
 
153
                           const s16: string = ''; const s17: string = ''; const s18: string = ''); overload;
 
154
 
 
155
    procedure DebugLnExit(const s: string = ''); overload;
 
156
    procedure DebugLnExit(Args: array of const); overload;
 
157
    procedure DebugLnExit(s: string; Args: array of const); overload;
 
158
    procedure DebugLnExit(const s1, s2: string; const s3: string = '';
 
159
                          const s4: string = ''; const s5: string = ''; const s6: string = '';
 
160
                          const s7: string = ''; const s8: string = ''; const s9: string = '';
 
161
                          const s10: string = ''; const s11: string = ''; const s12: string = '';
 
162
                          const s13: string = ''; const s14: string = ''; const s15: string = '';
 
163
                          const s16: string = ''; const s17: string = ''; const s18: string = ''); overload;
 
164
 
 
165
 
 
166
    procedure DebuglnStack(LogGroup: PLazLoggerLogGroup; const s: string = '');
 
167
 
 
168
    procedure DbgOut(LogGroup: PLazLoggerLogGroup; const s: string = ''); overload;
 
169
    procedure DbgOut(LogGroup: PLazLoggerLogGroup; Args: array of const); overload;
 
170
    procedure DbgOut(LogGroup: PLazLoggerLogGroup; const S: String; Args: array of const); overload;// similar to Format(s,Args)
 
171
    procedure DbgOut(LogGroup: PLazLoggerLogGroup; const s1, s2: string; const s3: string = '';
 
172
                     const s4: string = ''; const s5: string = ''; const s6: string = '';
 
173
                     const s7: string = ''; const s8: string = ''; const s9: string = '';
 
174
                     const s10: string = ''; const s11: string = ''; const s12: string = '';
 
175
                     const s13: string = ''; const s14: string = ''; const s15: string = '';
 
176
                     const s16: string = ''; const s17: string = ''; const s18: string = ''); overload;
 
177
 
 
178
    procedure DebugLn(LogGroup: PLazLoggerLogGroup; const s: string = ''); overload;
 
179
    procedure DebugLn(LogGroup: PLazLoggerLogGroup; Args: array of const); overload;
 
180
    procedure DebugLn(LogGroup: PLazLoggerLogGroup; const S: String; Args: array of const); overload;// similar to Format(s,Args)
 
181
    procedure DebugLn(LogGroup: PLazLoggerLogGroup; const s1, s2: string; const s3: string = '';
 
182
                      const s4: string = ''; const s5: string = ''; const s6: string = '';
 
183
                      const s7: string = ''; const s8: string = ''; const s9: string = '';
 
184
                      const s10: string = ''; const s11: string = ''; const s12: string = '';
 
185
                      const s13: string = ''; const s14: string = ''; const s15: string = '';
 
186
                      const s16: string = ''; const s17: string = ''; const s18: string = ''); overload;
 
187
 
 
188
    procedure DebugLnEnter(LogGroup: PLazLoggerLogGroup; const s: string = ''); overload;
 
189
    procedure DebugLnEnter(LogGroup: PLazLoggerLogGroup; Args: array of const); overload;
 
190
    procedure DebugLnEnter(LogGroup: PLazLoggerLogGroup; s: string; Args: array of const); overload;
 
191
    procedure DebugLnEnter(LogGroup: PLazLoggerLogGroup; const s1, s2: string; const s3: string = '';
 
192
                           const s4: string = ''; const s5: string = ''; const s6: string = '';
 
193
                           const s7: string = ''; const s8: string = ''; const s9: string = '';
 
194
                           const s10: string = ''; const s11: string = ''; const s12: string = '';
 
195
                           const s13: string = ''; const s14: string = ''; const s15: string = '';
 
196
                           const s16: string = ''; const s17: string = ''; const s18: string = ''); overload;
 
197
 
 
198
    procedure DebugLnExit(LogGroup: PLazLoggerLogGroup; const s: string = ''); overload;
 
199
    procedure DebugLnExit(LogGroup: PLazLoggerLogGroup; Args: array of const); overload;
 
200
    procedure DebugLnExit(LogGroup: PLazLoggerLogGroup; s: string; Args: array of const); overload;
 
201
    procedure DebugLnExit(LogGroup: PLazLoggerLogGroup; const s1, s2: string; const s3: string = '';
 
202
                          const s4: string = ''; const s5: string = ''; const s6: string = '';
 
203
                          const s7: string = ''; const s8: string = ''; const s9: string = '';
 
204
                          const s10: string = ''; const s11: string = ''; const s12: string = '';
 
205
                          const s13: string = ''; const s14: string = ''; const s15: string = '';
 
206
                          const s16: string = ''; const s17: string = ''; const s18: string = ''); overload;
 
207
 
 
208
  end;
 
209
 
 
210
  { TLazLoggerWithGroupParam
 
211
    - Provides Enabling/disabling groups from commandline
 
212
    - TLazLogger provides only storage for LogGroups, it does not need to
 
213
      enable/disable them, as it discards all logging anyway
 
214
  }
 
215
 
 
216
  TLazLoggerWithGroupParam = class(TLazLogger)
 
217
  private
 
218
    FLogAllDefaultDisabled: Boolean;
 
219
    FLogDefaultEnabled: Boolean;
 
220
    FLogParamParsed: Boolean;
 
221
    FParamForEnabledLogGroups: String;
 
222
    procedure SetParamForEnabledLogGroups(AValue: String);
 
223
    procedure ParseParamForEnabledLogGroups;
 
224
  public
 
225
    constructor Create;
 
226
    procedure Assign(Src: TLazLogger); override;
 
227
    function RegisterLogGroup(const AConfigName: String): PLazLoggerLogGroup; override;
 
228
    function RegisterLogGroup(const AConfigName: String; ADefaulEnabled: Boolean): PLazLoggerLogGroup; override;
 
229
    function FindOrRegisterLogGroup(const AConfigName: String): PLazLoggerLogGroup; override;
 
230
    function FindOrRegisterLogGroup(const AConfigName: String; ADefaulEnabled: Boolean): PLazLoggerLogGroup; override;
 
231
    // A param on the commandline, that may contain enabled/disabled LogGroups
 
232
    // comma separated list / not present = defaults (none unless emabled in code) / - means none
 
233
    property  ParamForEnabledLogGroups: String read FParamForEnabledLogGroups write SetParamForEnabledLogGroups;
 
234
  end;
 
235
 
 
236
  TLazLoggerNoOutput = class(TLazLogger)
 
237
  end;
 
238
 
 
239
 
 
240
{$DEFINE USED_BY_LAZLOGGER_BASE}
 
241
{$I LazLoggerIntf.inc}
 
242
 
 
243
function ConvertLineEndings(const s: string): string;
 
244
 
 
245
function GetParamByNameCount(const AName: String): integer;
 
246
function GetParamByName(const AName: String; AnIndex: Integer): string;
 
247
 
 
248
function GetDebugLoggerGroups: TLazLoggerLogGroupList; inline;
 
249
procedure SetDebugLoggerGroups(ALogGroups: TLazLoggerLogGroupList);
 
250
 
 
251
function GetDebugLogger: TLazLogger; inline;
 
252
function GetExistingDebugLogger: TLazLogger; inline; // No Autocreate
 
253
procedure SetDebugLogger(ALogger: TLazLogger);
 
254
 
 
255
procedure RecreateDebugLogger;
 
256
 
 
257
property DebugLogger: TLazLogger read GetDebugLogger write SetDebugLogger;
 
258
property DebugLoggerGroups: TLazLoggerLogGroupList read GetDebugLoggerGroups write SetDebugLoggerGroups;
 
259
 
 
260
type
 
261
  TLazDebugLoggerCreator = function: TRefCountedObject;
 
262
 
 
263
// Using base TRefCountedObject, so if none of the functions is used in the app, then even the class should be smart linked
 
264
var
 
265
  LazDebugLoggerCreator: TLazDebugLoggerCreator = nil;
 
266
  OnWidgetSetDebugLn: TLazLoggerWidgetSetWriteEvent;
 
267
  OnWidgetSetDbgOut:  TLazLoggerWidgetSetWriteEvent;
 
268
 
 
269
implementation
 
270
 
 
271
{$I LazLoggerImpl.inc}
 
272
 
 
273
var // Using base TRefCountedObject, so if none of the functions is used in the app, then even the class should be smart linked
 
274
  TheLazLogger: TRefCountedObject = nil;
 
275
  PrevLazLogger: TRefCountedObject = nil;
 
276
  TheLazLoggerGroups: TRefCountedObject = nil;
 
277
 
 
278
procedure CreateDebugLogger;
 
279
begin
 
280
  if (TheLazLogger <> nil) then
 
281
    exit;
 
282
  if (LazDebugLoggerCreator <> nil) then
 
283
    TheLazLogger := LazDebugLoggerCreator();
 
284
  if (TheLazLogger = nil) then
 
285
    TheLazLogger := TLazLoggerNoOutput.Create;
 
286
  TLazLogger(TheLazLogger).UseGlobalLogGroupList := True;
 
287
  TheLazLogger.AddReference;
 
288
end;
 
289
 
 
290
function GetDebugLogger: TLazLogger;
 
291
begin
 
292
  if (TheLazLogger = nil) then
 
293
    CreateDebugLogger;
 
294
  Result := TLazLogger(TheLazLogger);
 
295
end;
 
296
 
 
297
function GetExistingDebugLogger: TLazLogger;
 
298
begin
 
299
  if TheLazLogger <> nil then
 
300
    Result := TLazLogger(TheLazLogger)
 
301
  else
 
302
    Result := TLazLogger(PrevLazLogger);  // Pretend it still exists
 
303
end;
 
304
 
 
305
procedure SetDebugLogger(ALogger: TLazLogger);
 
306
begin
 
307
  ReleaseRefAndNil(TheLazLogger);
 
308
  TheLazLogger := ALogger;
 
309
  TheLazLogger.AddReference;
 
310
end;
 
311
 
 
312
procedure RecreateDebugLogger;
 
313
begin
 
314
  ReleaseRefAndNil(PrevLazLogger);
 
315
  PrevLazLogger := TheLazLogger; // Pretend it still exists
 
316
  TheLazLogger := nil;           // Force creation
 
317
end;
 
318
 
 
319
function GetDebugLoggerGroups: TLazLoggerLogGroupList;
 
320
begin
 
321
  if (TheLazLoggerGroups = nil) then begin
 
322
    TheLazLoggerGroups := TLazLoggerLogGroupList.Create;
 
323
    TheLazLoggerGroups.AddReference;
 
324
  end;
 
325
  Result := TLazLoggerLogGroupList(TheLazLoggerGroups);
 
326
end;
 
327
 
 
328
procedure SetDebugLoggerGroups(ALogGroups: TLazLoggerLogGroupList);
 
329
begin
 
330
  ReleaseRefAndNil(TheLazLoggerGroups);
 
331
  TheLazLoggerGroups := ALogGroups;
 
332
  TheLazLoggerGroups.AddReference;
 
333
end;
 
334
 
 
335
function GetParamByNameCount(const AName: String): integer;
 
336
var
 
337
  i, l: Integer;
 
338
begin
 
339
  Result := 0;;
 
340
  l := Length(AName);
 
341
  for i:= 1 to Paramcount do begin
 
342
    if copy(ParamStrUTF8(i),1, l) = AName then
 
343
      inc(Result);
 
344
  end;
 
345
end;
 
346
 
 
347
function GetParamByName(const AName: String; AnIndex: Integer): string;
 
348
var
 
349
  i, l: Integer;
 
350
begin
 
351
  l := Length(AName);
 
352
  for i:= 1 to Paramcount do begin
 
353
    if copy(ParamStrUTF8(i),1, l) = AName then begin
 
354
      dec(AnIndex);
 
355
      if AnIndex < 0 then begin
 
356
        Result := copy(ParamStrUTF8(i), l+1, Length(ParamStrUTF8(i))-l);
 
357
        break;
 
358
      end;
 
359
    end;
 
360
  end;
 
361
end;
 
362
 
 
363
{ TLazLoggerLogGroupList }
 
364
 
 
365
procedure TLazLoggerLogGroupList.Clear;
 
366
begin
 
367
  while FList.Count > 0 do begin
 
368
    Dispose(Item[0]);
 
369
    FList.Delete(0);
 
370
  end;
 
371
end;
 
372
 
 
373
function TLazLoggerLogGroupList.GetItem(Index: Integer): PLazLoggerLogGroup;
 
374
begin
 
375
  Result := PLazLoggerLogGroup(FList[Index])
 
376
end;
 
377
 
 
378
function TLazLoggerLogGroupList.NewItem(const AConfigName: String;
 
379
  ADefaulEnabled: Boolean): PLazLoggerLogGroup;
 
380
begin
 
381
  New(Result);
 
382
  Result^.ConfigName := UpperCase(AConfigName);
 
383
  Result^.Enabled := ADefaulEnabled;
 
384
  Result^.Flags := [];
 
385
  Result^.FOpenedIndents := 0;
 
386
end;
 
387
 
 
388
constructor TLazLoggerLogGroupList.Create;
 
389
begin
 
390
  FList := TFPList.Create;
 
391
end;
 
392
 
 
393
destructor TLazLoggerLogGroupList.Destroy;
 
394
begin
 
395
  Clear;
 
396
  FreeAndNil(FList);
 
397
  inherited Destroy;
 
398
end;
 
399
 
 
400
procedure TLazLoggerLogGroupList.Assign(Src: TLazLoggerLogGroupList);
 
401
var
 
402
  i: Integer;
 
403
begin
 
404
  Clear;
 
405
  if (Src = nil) then
 
406
    exit;
 
407
  for i := 0 to Src.Count - 1 do
 
408
    Add('')^ := Src.Item[i]^;
 
409
end;
 
410
 
 
411
function TLazLoggerLogGroupList.Add(const AConfigName: String;
 
412
  ADefaulEnabled: Boolean): PLazLoggerLogGroup;
 
413
begin
 
414
  if Find(AConfigName) <> nil then
 
415
    raise Exception.Create('Duplicate LogGroup ' + AConfigName);
 
416
  Result := NewItem(AConfigName, ADefaulEnabled);
 
417
  FList.Add(Result);
 
418
end;
 
419
 
 
420
function TLazLoggerLogGroupList.FindOrAdd(const AConfigName: String;
 
421
  ADefaulEnabled: Boolean): PLazLoggerLogGroup;
 
422
begin
 
423
  Result := Find(AConfigName);
 
424
  if Result <> nil then exit;
 
425
  Result := NewItem(AConfigName, ADefaulEnabled);
 
426
  FList.Add(Result);
 
427
end;
 
428
 
 
429
function TLazLoggerLogGroupList.IndexOf(const AConfigName: String): integer;
 
430
var
 
431
  s: String;
 
432
begin
 
433
  Result := Count - 1;
 
434
  s := UpperCase(AConfigName);
 
435
  while (Result >= 0) and (Item[Result]^.ConfigName <> s) do
 
436
    dec(Result);
 
437
end;
 
438
 
 
439
function TLazLoggerLogGroupList.IndexOf(const AnEntry: PLazLoggerLogGroup): integer;
 
440
begin
 
441
  Result := Count - 1;
 
442
  while (Result >= 0) and (Item[Result] <> AnEntry) do
 
443
    dec(Result);
 
444
end;
 
445
 
 
446
function TLazLoggerLogGroupList.Find(const AConfigName: String): PLazLoggerLogGroup;
 
447
var
 
448
  i: Integer;
 
449
begin
 
450
  Result := nil;
 
451
  i := IndexOf(AConfigName);
 
452
  if i >= 0 then
 
453
    Result := Item[i];
 
454
end;
 
455
 
 
456
procedure TLazLoggerLogGroupList.Remove(const AConfigName: String);
 
457
var
 
458
  i: Integer;
 
459
begin
 
460
  i := IndexOf(AConfigName);
 
461
  if i >= 0 then begin
 
462
    Dispose(Item[i]);
 
463
    FList.Delete(i);
 
464
  end;
 
465
end;
 
466
 
 
467
procedure TLazLoggerLogGroupList.Remove(const AnEntry: PLazLoggerLogGroup);
 
468
var
 
469
  i: Integer;
 
470
begin
 
471
  i := IndexOf(AnEntry);
 
472
  if i >= 0 then begin
 
473
    Dispose(Item[i]);
 
474
    FList.Delete(i);
 
475
  end;
 
476
end;
 
477
 
 
478
function TLazLoggerLogGroupList.Count: integer;
 
479
begin
 
480
  Result := FList.Count;
 
481
end;
 
482
 
 
483
{ TLazLogger }
 
484
 
 
485
function TLazLogger.GetLogGroupList: TLazLoggerLogGroupList;
 
486
begin
 
487
  if UseGlobalLogGroupList then begin
 
488
    Result := DebugLoggerGroups;
 
489
    exit;
 
490
  end;
 
491
 
 
492
  if FLogGroupList = nil then begin
 
493
    FLogGroupList := TLazLoggerLogGroupList.Create;
 
494
    FLogGroupList.AddReference;
 
495
  end;
 
496
  Result := TLazLoggerLogGroupList(FLogGroupList);
 
497
end;
 
498
 
 
499
procedure TLazLogger.SetUseGlobalLogGroupList(AValue: Boolean);
 
500
begin
 
501
  if FUseGlobalLogGroupList = AValue then Exit;
 
502
  FUseGlobalLogGroupList := AValue;
 
503
end;
 
504
 
 
505
procedure TLazLogger.SetMaxNestPrefixLen(AValue: Integer);
 
506
begin
 
507
  if FMaxNestPrefixLen = AValue then Exit;
 
508
  FMaxNestPrefixLen := AValue;
 
509
  IndentChanged;
 
510
end;
 
511
 
 
512
procedure TLazLogger.SetNestLvlIndent(AValue: Integer);
 
513
begin
 
514
  if FNestLvlIndent = AValue then Exit;
 
515
  FNestLvlIndent := AValue;
 
516
  IndentChanged;
 
517
end;
 
518
 
 
519
procedure TLazLogger.DoInit;
 
520
begin
 
521
  //
 
522
end;
 
523
 
 
524
procedure TLazLogger.DoFinsh;
 
525
begin
 
526
  //
 
527
end;
 
528
 
 
529
procedure TLazLogger.DoDebuglnStack(const s: string);
 
530
begin
 
531
  //
 
532
end;
 
533
 
 
534
procedure TLazLogger.IncreaseIndent;
 
535
begin
 
536
  //
 
537
end;
 
538
 
 
539
procedure TLazLogger.DecreaseIndent;
 
540
begin
 
541
  //
 
542
end;
 
543
 
 
544
procedure TLazLogger.IncreaseIndent(LogGroup: PLazLoggerLogGroup);
 
545
begin
 
546
  //
 
547
end;
 
548
 
 
549
procedure TLazLogger.DecreaseIndent(LogGroup: PLazLoggerLogGroup);
 
550
begin
 
551
  //
 
552
end;
 
553
 
 
554
procedure TLazLogger.IndentChanged;
 
555
begin
 
556
  //
 
557
end;
 
558
 
 
559
procedure TLazLogger.DoDbgOut(const s: string);
 
560
begin
 
561
  //
 
562
end;
 
563
 
 
564
procedure TLazLogger.DoDebugLn(const s: string);
 
565
begin
 
566
  //
 
567
end;
 
568
 
 
569
function TLazLogger.ArgsToString(Args: array of const): string;
 
570
var
 
571
  i: Integer;
 
572
begin
 
573
  Result := '';
 
574
  for i:=Low(Args) to High(Args) do begin
 
575
    case Args[i].VType of
 
576
      vtInteger:    Result := Result + dbgs(Args[i].vinteger);
 
577
      vtInt64:      Result := Result + dbgs(Args[i].VInt64^);
 
578
      vtQWord:      Result := Result + dbgs(Args[i].VQWord^);
 
579
      vtBoolean:    Result := Result + dbgs(Args[i].vboolean);
 
580
      vtExtended:   Result := Result + dbgs(Args[i].VExtended^);
 
581
  {$ifdef FPC_CURRENCY_IS_INT64}
 
582
      // MWE:
 
583
      // fpc 2.x has troubles in choosing the right dbgs()
 
584
      // so we convert here
 
585
      vtCurrency:   Result := Result + dbgs(int64(Args[i].vCurrency^)/10000, 4);
 
586
  {$else}
 
587
      vtCurrency:   Result := Result + dbgs(Args[i].vCurrency^);
 
588
  {$endif}
 
589
      vtString:     Result := Result + Args[i].VString^;
 
590
      vtAnsiString: Result := Result + AnsiString(Args[i].VAnsiString);
 
591
      vtChar:       Result := Result + Args[i].VChar;
 
592
      vtPChar:      Result := Result + Args[i].VPChar;
 
593
      vtPWideChar:  Result := {%H-}Result {%H-}+ Args[i].VPWideChar;
 
594
      vtWideChar:   Result := Result + AnsiString(Args[i].VWideChar);
 
595
      vtWidestring: Result := Result + AnsiString(WideString(Args[i].VWideString));
 
596
      vtObject:     Result := Result + DbgSName(Args[i].VObject);
 
597
      vtClass:      Result := Result + DbgSName(Args[i].VClass);
 
598
      vtPointer:    Result := Result + Dbgs(Args[i].VPointer);
 
599
      else          Result := Result + '?unknown variant?';
 
600
    end;
 
601
  end;
 
602
end;
 
603
 
 
604
constructor TLazLogger.Create;
 
605
begin
 
606
  FIsInitialized := False;
 
607
  FUseGlobalLogGroupList := False;
 
608
 
 
609
  FMaxNestPrefixLen := 15;
 
610
  FNestLvlIndent := 2;
 
611
 
 
612
  FLogGroupList := nil;
 
613
end;
 
614
 
 
615
destructor TLazLogger.Destroy;
 
616
begin
 
617
  Finish;
 
618
  if TheLazLogger = Self then TheLazLogger := nil;
 
619
  ReleaseRefAndNil(FLogGroupList);
 
620
  inherited Destroy;
 
621
end;
 
622
 
 
623
procedure TLazLogger.Assign(Src: TLazLogger);
 
624
begin
 
625
  if (Src = nil) then
 
626
    exit;
 
627
  FMaxNestPrefixLen := Src.FMaxNestPrefixLen;
 
628
  FNestLvlIndent    := Src.FNestLvlIndent;
 
629
 
 
630
  FUseGlobalLogGroupList := Src.FUseGlobalLogGroupList;
 
631
  if (not FUseGlobalLogGroupList) and (Src.FLogGroupList <> nil) then
 
632
    LogGroupList.Assign(Src.LogGroupList);
 
633
end;
 
634
 
 
635
procedure TLazLogger.Init;
 
636
begin
 
637
  if FIsInitialized then exit;
 
638
  DoInit;
 
639
  FIsInitialized := True;
 
640
end;
 
641
 
 
642
procedure TLazLogger.Finish;
 
643
begin
 
644
  if FIsInitialized then
 
645
    DoFinsh;
 
646
  FIsInitialized := False;
 
647
end;
 
648
 
 
649
function TLazLogger.RegisterLogGroup(const AConfigName: String;
 
650
  ADefaulEnabled: Boolean): PLazLoggerLogGroup;
 
651
begin
 
652
  // The basic logger does not add entries from parsig cmd-line. So no need to check
 
653
  Result := LogGroupList.Add(AConfigName, ADefaulEnabled);
 
654
end;
 
655
 
 
656
function TLazLogger.RegisterLogGroup(const AConfigName: String): PLazLoggerLogGroup;
 
657
begin
 
658
  Result := LogGroupList.Add(AConfigName);
 
659
  Result^.Flags := Result^.Flags + [lgfNoDefaultEnabledSpecified];
 
660
end;
 
661
 
 
662
function TLazLogger.FindOrRegisterLogGroup(const AConfigName: String;
 
663
  ADefaulEnabled: Boolean): PLazLoggerLogGroup;
 
664
begin
 
665
  Result := LogGroupList.FindOrAdd(AConfigName, ADefaulEnabled);
 
666
end;
 
667
 
 
668
function TLazLogger.FindOrRegisterLogGroup(const AConfigName: String): PLazLoggerLogGroup;
 
669
begin
 
670
  Result := LogGroupList.FindOrAdd(AConfigName);
 
671
  Result^.Flags := Result^.Flags + [lgfNoDefaultEnabledSpecified];
 
672
end;
 
673
 
 
674
procedure TLazLogger.DebuglnStack(const s: string);
 
675
begin
 
676
  DoDebuglnStack(s);
 
677
end;
 
678
 
 
679
procedure TLazLogger.DbgOut(const s: string);
 
680
begin
 
681
  DoDbgOut(s);
 
682
end;
 
683
 
 
684
procedure TLazLogger.DbgOut(Args: array of const);
 
685
begin
 
686
  DoDbgOut(ArgsToString(Args));
 
687
end;
 
688
 
 
689
procedure TLazLogger.DbgOut(const S: String; Args: array of const);
 
690
begin
 
691
  DoDbgOut(Format(S, Args));
 
692
end;
 
693
 
 
694
procedure TLazLogger.DbgOut(const s1, s2: string; const s3: string; const s4: string;
 
695
  const s5: string; const s6: string; const s7: string; const s8: string; const s9: string;
 
696
  const s10: string; const s11: string; const s12: string; const s13: string;
 
697
  const s14: string; const s15: string; const s16: string; const s17: string;
 
698
  const s18: string);
 
699
begin
 
700
  DoDbgOut(s1+s2+s3+s4+s5+s6+s7+s8+s9+s10+s11+s12+s13+s14+s15+s16+s17+s18);
 
701
end;
 
702
 
 
703
procedure TLazLogger.DebugLn(const s: string);
 
704
begin
 
705
  DoDebugLn(s);
 
706
end;
 
707
 
 
708
procedure TLazLogger.DebugLn(Args: array of const);
 
709
begin
 
710
  DoDebugLn(ArgsToString(Args));
 
711
end;
 
712
 
 
713
procedure TLazLogger.DebugLn(const S: String; Args: array of const);
 
714
begin
 
715
  DoDebugLn(Format(S, Args));
 
716
end;
 
717
 
 
718
procedure TLazLogger.DebugLn(const s1, s2: string; const s3: string; const s4: string;
 
719
  const s5: string; const s6: string; const s7: string; const s8: string; const s9: string;
 
720
  const s10: string; const s11: string; const s12: string; const s13: string;
 
721
  const s14: string; const s15: string; const s16: string; const s17: string;
 
722
  const s18: string);
 
723
begin
 
724
  DoDebugLn(s1+s2+s3+s4+s5+s6+s7+s8+s9+s10+s11+s12+s13+s14+s15+s16+s17+s18);
 
725
end;
 
726
 
 
727
procedure TLazLogger.DebugLnEnter(const s: string);
 
728
begin
 
729
  DoDebugLn(s);
 
730
  IncreaseIndent;
 
731
end;
 
732
 
 
733
procedure TLazLogger.DebugLnEnter(Args: array of const);
 
734
begin
 
735
  DoDebugLn(ArgsToString(Args));
 
736
  IncreaseIndent;
 
737
end;
 
738
 
 
739
procedure TLazLogger.DebugLnEnter(s: string; Args: array of const);
 
740
begin
 
741
  DoDebugLn(Format(S, Args));
 
742
  IncreaseIndent;
 
743
end;
 
744
 
 
745
procedure TLazLogger.DebugLnEnter(const s1, s2: string; const s3: string; const s4: string;
 
746
  const s5: string; const s6: string; const s7: string; const s8: string; const s9: string;
 
747
  const s10: string; const s11: string; const s12: string; const s13: string;
 
748
  const s14: string; const s15: string; const s16: string; const s17: string;
 
749
  const s18: string);
 
750
begin
 
751
  DoDebugLn(s1+s2+s3+s4+s5+s6+s7+s8+s9+s10+s11+s12+s13+s14+s15+s16+s17+s18);
 
752
  IncreaseIndent;
 
753
end;
 
754
 
 
755
procedure TLazLogger.DebugLnExit(const s: string);
 
756
begin
 
757
  DecreaseIndent;
 
758
  DoDebugLn(s);
 
759
end;
 
760
 
 
761
procedure TLazLogger.DebugLnExit(Args: array of const);
 
762
begin
 
763
  DecreaseIndent;
 
764
  DoDebugLn(ArgsToString(Args));
 
765
end;
 
766
 
 
767
procedure TLazLogger.DebugLnExit(s: string; Args: array of const);
 
768
begin
 
769
  DecreaseIndent;
 
770
  DoDebugLn(Format(S, Args));
 
771
end;
 
772
 
 
773
procedure TLazLogger.DebugLnExit(const s1, s2: string; const s3: string; const s4: string;
 
774
  const s5: string; const s6: string; const s7: string; const s8: string; const s9: string;
 
775
  const s10: string; const s11: string; const s12: string; const s13: string;
 
776
  const s14: string; const s15: string; const s16: string; const s17: string;
 
777
  const s18: string);
 
778
begin
 
779
  DecreaseIndent;
 
780
  DoDebugLn(s1+s2+s3+s4+s5+s6+s7+s8+s9+s10+s11+s12+s13+s14+s15+s16+s17+s18);
 
781
end;
 
782
 
 
783
procedure TLazLogger.DebuglnStack(LogGroup: PLazLoggerLogGroup; const s: string);
 
784
begin
 
785
  if (LogGroup <> nil) and (not LogGroup^.Enabled) then exit;
 
786
  DebuglnStack(s);
 
787
end;
 
788
 
 
789
procedure TLazLogger.DbgOut(LogGroup: PLazLoggerLogGroup; const s: string);
 
790
begin
 
791
  if (LogGroup <> nil) and (not LogGroup^.Enabled) then exit;
 
792
  DoDbgOut(s);
 
793
end;
 
794
 
 
795
procedure TLazLogger.DbgOut(LogGroup: PLazLoggerLogGroup; Args: array of const);
 
796
begin
 
797
  if (LogGroup <> nil) and (not LogGroup^.Enabled) then exit;
 
798
  DoDbgOut(ArgsToString(Args));
 
799
end;
 
800
 
 
801
procedure TLazLogger.DbgOut(LogGroup: PLazLoggerLogGroup; const S: String;
 
802
  Args: array of const);
 
803
begin
 
804
  if (LogGroup <> nil) and (not LogGroup^.Enabled) then exit;
 
805
  DoDbgOut(Format(S, Args));
 
806
end;
 
807
 
 
808
procedure TLazLogger.DbgOut(LogGroup: PLazLoggerLogGroup; const s1, s2: string;
 
809
  const s3: string; const s4: string; const s5: string; const s6: string; const s7: string;
 
810
  const s8: string; const s9: string; const s10: string; const s11: string; const s12: string;
 
811
  const s13: string; const s14: string; const s15: string; const s16: string;
 
812
  const s17: string; const s18: string);
 
813
begin
 
814
  if (LogGroup <> nil) and (not LogGroup^.Enabled) then exit;
 
815
  DoDbgOut(s1+s2+s3+s4+s5+s6+s7+s8+s9+s10+s11+s12+s13+s14+s15+s16+s17+s18);
 
816
end;
 
817
 
 
818
procedure TLazLogger.DebugLn(LogGroup: PLazLoggerLogGroup; const s: string);
 
819
begin
 
820
  if (LogGroup <> nil) and (not LogGroup^.Enabled) then exit;
 
821
  DoDebugLn(s);
 
822
end;
 
823
 
 
824
procedure TLazLogger.DebugLn(LogGroup: PLazLoggerLogGroup; Args: array of const);
 
825
begin
 
826
  if (LogGroup <> nil) and (not LogGroup^.Enabled) then exit;
 
827
  DoDebugLn(ArgsToString(Args));
 
828
end;
 
829
 
 
830
procedure TLazLogger.DebugLn(LogGroup: PLazLoggerLogGroup; const S: String;
 
831
  Args: array of const);
 
832
begin
 
833
  if (LogGroup <> nil) and (not LogGroup^.Enabled) then exit;
 
834
  DoDebugLn(Format(S, Args));
 
835
end;
 
836
 
 
837
procedure TLazLogger.DebugLn(LogGroup: PLazLoggerLogGroup; const s1, s2: string;
 
838
  const s3: string; const s4: string; const s5: string; const s6: string; const s7: string;
 
839
  const s8: string; const s9: string; const s10: string; const s11: string; const s12: string;
 
840
  const s13: string; const s14: string; const s15: string; const s16: string;
 
841
  const s17: string; const s18: string);
 
842
begin
 
843
  if (LogGroup <> nil) and (not LogGroup^.Enabled) then exit;
 
844
  DoDebugLn(s1+s2+s3+s4+s5+s6+s7+s8+s9+s10+s11+s12+s13+s14+s15+s16+s17+s18);
 
845
end;
 
846
 
 
847
procedure TLazLogger.DebugLnEnter(LogGroup: PLazLoggerLogGroup; const s: string);
 
848
begin
 
849
  if not( (LogGroup <> nil) and (not LogGroup^.Enabled) ) then
 
850
    DoDebugLn(s);
 
851
  IncreaseIndent(LogGroup);
 
852
end;
 
853
 
 
854
procedure TLazLogger.DebugLnEnter(LogGroup: PLazLoggerLogGroup; Args: array of const);
 
855
begin
 
856
  if not( (LogGroup <> nil) and (not LogGroup^.Enabled) ) then
 
857
    DoDebugLn(ArgsToString(Args));
 
858
  IncreaseIndent(LogGroup);
 
859
end;
 
860
 
 
861
procedure TLazLogger.DebugLnEnter(LogGroup: PLazLoggerLogGroup; s: string;
 
862
  Args: array of const);
 
863
begin
 
864
  if not( (LogGroup <> nil) and (not LogGroup^.Enabled) ) then
 
865
    DoDebugLn(Format(S, Args));
 
866
  IncreaseIndent(LogGroup);
 
867
end;
 
868
 
 
869
procedure TLazLogger.DebugLnEnter(LogGroup: PLazLoggerLogGroup; const s1, s2: string;
 
870
  const s3: string; const s4: string; const s5: string; const s6: string; const s7: string;
 
871
  const s8: string; const s9: string; const s10: string; const s11: string; const s12: string;
 
872
  const s13: string; const s14: string; const s15: string; const s16: string;
 
873
  const s17: string; const s18: string);
 
874
begin
 
875
  if not( (LogGroup <> nil) and (not LogGroup^.Enabled) ) then
 
876
    DoDebugLn(s1+s2+s3+s4+s5+s6+s7+s8+s9+s10+s11+s12+s13+s14+s15+s16+s17+s18);
 
877
  IncreaseIndent(LogGroup);
 
878
end;
 
879
 
 
880
procedure TLazLogger.DebugLnExit(LogGroup: PLazLoggerLogGroup; const s: string);
 
881
begin
 
882
  DecreaseIndent(LogGroup);
 
883
  if (LogGroup <> nil) and (not LogGroup^.Enabled) then exit;
 
884
  DoDebugLn(s);
 
885
end;
 
886
 
 
887
procedure TLazLogger.DebugLnExit(LogGroup: PLazLoggerLogGroup; Args: array of const);
 
888
begin
 
889
  DecreaseIndent(LogGroup);
 
890
  if (LogGroup <> nil) and (not LogGroup^.Enabled) then exit;
 
891
  DoDebugLn(ArgsToString(Args));
 
892
end;
 
893
 
 
894
procedure TLazLogger.DebugLnExit(LogGroup: PLazLoggerLogGroup; s: string;
 
895
  Args: array of const);
 
896
begin
 
897
  DecreaseIndent(LogGroup);
 
898
  if (LogGroup <> nil) and (not LogGroup^.Enabled) then exit;
 
899
  DoDebugLn(Format(S, Args));
 
900
end;
 
901
 
 
902
procedure TLazLogger.DebugLnExit(LogGroup: PLazLoggerLogGroup; const s1, s2: string;
 
903
  const s3: string; const s4: string; const s5: string; const s6: string; const s7: string;
 
904
  const s8: string; const s9: string; const s10: string; const s11: string; const s12: string;
 
905
  const s13: string; const s14: string; const s15: string; const s16: string;
 
906
  const s17: string; const s18: string);
 
907
begin
 
908
  DecreaseIndent(LogGroup);
 
909
  if (LogGroup <> nil) and (not LogGroup^.Enabled) then exit;
 
910
  DoDebugLn(s1+s2+s3+s4+s5+s6+s7+s8+s9+s10+s11+s12+s13+s14+s15+s16+s17+s18);
 
911
end;
 
912
 
 
913
{ TLazLoggerWithGroupParam }
 
914
 
 
915
procedure TLazLoggerWithGroupParam.SetParamForEnabledLogGroups(AValue: String);
 
916
begin
 
917
  if FParamForEnabledLogGroups = AValue then Exit;
 
918
  FParamForEnabledLogGroups := AValue;
 
919
  ParseParamForEnabledLogGroups;
 
920
end;
 
921
 
 
922
procedure TLazLoggerWithGroupParam.ParseParamForEnabledLogGroups;
 
923
var
 
924
  i, j, c: Integer;
 
925
  list: TStringList;
 
926
  g: PLazLoggerLogGroup;
 
927
  s: String;
 
928
  e: Boolean;
 
929
begin
 
930
  c := GetParamByNameCount(FParamForEnabledLogGroups);
 
931
  FLogDefaultEnabled := False;
 
932
  FLogAllDefaultDisabled := FAlse;
 
933
 
 
934
  list := TStringList.Create;
 
935
  for i := 0 to c - 1 do begin
 
936
    s := GetParamByName(FParamForEnabledLogGroups, i);
 
937
 
 
938
    if s = '-' then begin
 
939
      // clear all
 
940
      FLogDefaultEnabled := False;
 
941
      for j := 0 to LogGroupList.Count - 1 do
 
942
        LogGroupList[j]^.Enabled := False;
 
943
      FLogAllDefaultDisabled := True;
 
944
    end
 
945
    else
 
946
    begin
 
947
      list.CommaText := s;
 
948
      for j := 0 to list.Count - 1 do begin
 
949
        s := list[j];
 
950
        if (s = '-') or (s='') then
 
951
          continue; // invalid, within comma list
 
952
        if s[1] = '-' then
 
953
          e := False
 
954
        else
 
955
          e := True;
 
956
        if s[1] in ['-', '+'] then delete(s,1,1);
 
957
        if (s='') then
 
958
          continue;
 
959
 
 
960
        if e then
 
961
          FLogDefaultEnabled := False;
 
962
 
 
963
        g := LogGroupList.Find(s);
 
964
        if g <> nil then begin
 
965
          g^.Enabled := e;
 
966
          g^.Flags := g^.Flags - [lgfNoDefaultEnabledSpecified];
 
967
        end
 
968
        else begin
 
969
          g := LogGroupList.Add(s, e);
 
970
          g^.Flags := g^.Flags + [lgfAddedByParamParser];
 
971
        end;
 
972
      end;
 
973
    end;
 
974
  end;
 
975
  list.Free;
 
976
 
 
977
  if not FLogParamParsed then begin
 
978
    // first parse, reset default unless specified in RegisterLogGroup();
 
979
    for i := 0 to LogGroupList.Count - 1 do
 
980
      if lgfNoDefaultEnabledSpecified in LogGroupList[i]^.Flags then
 
981
        LogGroupList[i]^.Enabled := FLogDefaultEnabled;
 
982
  end;
 
983
 
 
984
  FLogParamParsed := True;
 
985
end;
 
986
 
 
987
constructor TLazLoggerWithGroupParam.Create;
 
988
begin
 
989
  inherited;
 
990
  FLogDefaultEnabled := False;
 
991
  FLogAllDefaultDisabled := False;
 
992
end;
 
993
 
 
994
procedure TLazLoggerWithGroupParam.Assign(Src: TLazLogger);
 
995
begin
 
996
  inherited Assign(Src);
 
997
  if (Src <> nil) and (Src is TLazLoggerWithGroupParam) then begin
 
998
    FLogParamParsed := False;
 
999
    FParamForEnabledLogGroups := TLazLoggerWithGroupParam(Src).FParamForEnabledLogGroups;
 
1000
  end;
 
1001
end;
 
1002
 
 
1003
function TLazLoggerWithGroupParam.RegisterLogGroup(const AConfigName: String): PLazLoggerLogGroup;
 
1004
var
 
1005
  Default, DefaultFound: Boolean;
 
1006
begin
 
1007
  Result := LogGroupList.Find(AConfigName);
 
1008
  Default := FLogDefaultEnabled;
 
1009
  DefaultFound := False;
 
1010
  if Result <> nil then begin
 
1011
    Default := Result^.Enabled;
 
1012
    DefaultFound := not(lgfNoDefaultEnabledSpecified in Result^.Flags);
 
1013
  end;
 
1014
 
 
1015
  Result := RegisterLogGroup(AConfigName, Default);
 
1016
 
 
1017
  if not DefaultFound then
 
1018
    Result^.Flags := Result^.Flags + [lgfNoDefaultEnabledSpecified];
 
1019
end;
 
1020
 
 
1021
function TLazLoggerWithGroupParam.RegisterLogGroup(const AConfigName: String;
 
1022
  ADefaulEnabled: Boolean): PLazLoggerLogGroup;
 
1023
begin
 
1024
  if FLogAllDefaultDisabled then
 
1025
    ADefaulEnabled := False;
 
1026
  Result := LogGroupList.Find(AConfigName);
 
1027
  if Result <> nil then begin
 
1028
    if not(lgfAddedByParamParser in Result^.Flags) then
 
1029
      raise Exception.Create('Duplicate LogGroup ' + AConfigName);
 
1030
    if ADefaulEnabled and not(lgfAddedByParamParser in Result^.Flags) then
 
1031
      Result^.Enabled := True;
 
1032
    Result^.Flags := Result^.Flags - [lgfAddedByParamParser];
 
1033
  end
 
1034
  else
 
1035
    Result := LogGroupList.Add(AConfigName, ADefaulEnabled);
 
1036
end;
 
1037
 
 
1038
function TLazLoggerWithGroupParam.FindOrRegisterLogGroup(const AConfigName: String): PLazLoggerLogGroup;
 
1039
begin
 
1040
  Result := LogGroupList.Find(AConfigName);
 
1041
  if Result = nil then
 
1042
    Result := RegisterLogGroup(AConfigName)
 
1043
  else
 
1044
    Result^.Flags := Result^.Flags - [lgfAddedByParamParser];
 
1045
end;
 
1046
 
 
1047
function TLazLoggerWithGroupParam.FindOrRegisterLogGroup(const AConfigName: String;
 
1048
  ADefaulEnabled: Boolean): PLazLoggerLogGroup;
 
1049
begin
 
1050
  Result := LogGroupList.Find(AConfigName);
 
1051
  if Result = nil then
 
1052
    Result := RegisterLogGroup(AConfigName, ADefaulEnabled)
 
1053
  else
 
1054
  begin
 
1055
    if (lgfNoDefaultEnabledSpecified in Result^.Flags) and
 
1056
       not(lgfAddedByParamParser in Result^.Flags)
 
1057
    then
 
1058
      Result^.Enabled := ADefaulEnabled;
 
1059
    Result^.Flags := Result^.Flags - [lgfNoDefaultEnabledSpecified, lgfAddedByParamParser];
 
1060
  end;
 
1061
end;
 
1062
 
 
1063
function ConvertLineEndings(const s: string): string;
 
1064
var
 
1065
  i: Integer;
 
1066
  EndingStart: LongInt;
 
1067
begin
 
1068
  Result:=s;
 
1069
  i:=1;
 
1070
  while (i<=length(Result)) do begin
 
1071
    if Result[i] in [#10,#13] then begin
 
1072
      EndingStart:=i;
 
1073
      inc(i);
 
1074
      if (i<=length(Result)) and (Result[i] in [#10,#13])
 
1075
      and (Result[i]<>Result[i-1]) then begin
 
1076
        inc(i);
 
1077
      end;
 
1078
      if (length(LineEnding)<>i-EndingStart)
 
1079
      or (LineEnding<>copy(Result,EndingStart,length(LineEnding))) then begin
 
1080
        // line end differs => replace with current LineEnding
 
1081
        Result:=
 
1082
          copy(Result,1,EndingStart-1)+LineEnding+copy(Result,i,length(Result));
 
1083
        i:=EndingStart+length(LineEnding);
 
1084
      end;
 
1085
    end else
 
1086
      inc(i);
 
1087
  end;
 
1088
end;
 
1089
 
 
1090
finalization // Using TObject, so if none of the functions is used in the app, then even the rlass should be smart linked
 
1091
  ReleaseRefAndNil(TheLazLogger);
 
1092
  ReleaseRefAndNil(PrevLazLogger);
 
1093
  ReleaseRefAndNil(TheLazLoggerGroups);
 
1094
 
 
1095
end.
 
1096