paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-10-23 15:01:32 +02:00
Code Issues Packages Projects Releases Wiki Activity

LazLogger, introduce base and dummy classes

Browse Source 
git-svn-id: trunk@35778 -
This commit is contained in:
martin 2012-03-06 19:36:11 +00:00
parent 467acb1ea9
commit 5a1360baf1
23 changed files with 3029 additions and 1713 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
.gitattributes vendored
View File

@ -1764,6 +1764,8 @@ components/lazthread/reglazthread.pas svneol=native#text/plain
components/lazthread/threadoptionsdialog.lfm svneol=native#text/plain
components/lazthread/threadoptionsdialog.lrs svneol=native#text/pascal
components/lazthread/threadoptionsdialog.pas svneol=native#text/plain
components/lazutils/LazLoggerImpl.inc svneol=native#text/pascal
components/lazutils/LazLoggerIntf.inc svneol=native#text/pascal
components/lazutils/Makefile svneol=native#text/plain
components/lazutils/Makefile.compiled svneol=native#text/plain
components/lazutils/Makefile.fpc svneol=native#text/plain
@ -1792,11 +1794,14 @@ components/lazutils/laz_xmlcfg.pas svneol=native#text/pascal
components/lazutils/laz_xmlread.pas svneol=native#text/pascal
components/lazutils/laz_xmlstreaming.pas svneol=native#text/pascal
components/lazutils/laz_xmlwrite.pas svneol=native#text/pascal
components/lazutils/lazclasses.pas svneol=native#text/pascal
components/lazutils/lazdbglog.pas svneol=native#text/pascal
components/lazutils/lazfilecache.pas svneol=native#text/pascal
components/lazutils/lazfileutils.pas svneol=native#text/pascal
components/lazutils/lazfreetype.pas svneol=native#text/pascal
components/lazutils/lazlogger.pas svneol=native#text/pascal
components/lazutils/lazloggerbase.pas svneol=native#text/pascal
components/lazutils/lazloggerdummy.pas svneol=native#text/pascal
components/lazutils/lazmethodlist.pas svneol=native#text/pascal
components/lazutils/lazutf16.pas svneol=native#text/pascal
components/lazutils/lazutf8.pas svneol=native#text/pascal

2
components/IdeLazLogger/idelogger.pas
View File

@ -6,7 +6,7 @@ interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ComCtrls, ButtonPanel,
Buttons, CheckLst, EditBtn, ExtCtrls, IDEIntf, MenuIntf, LazLogger;
Buttons, CheckLst, EditBtn, ExtCtrls, IDEIntf, MenuIntf, LazLoggerBase, LazLogger;
type

582
components/lazutils/LazLoggerImpl.inc Normal file
View File

@ -0,0 +1,582 @@
(*
Used by:
- LazLogger
- LazLoggerBase
- LazLoggerDummy
*)
procedure DebuglnStack(const s: string);
begin
{$IFnDEF LazLoggerDummy}
DebugLogger.DebuglnStack(s);
{$ENDIF}
end;
procedure DbgOut(const s: string);
begin
{$IFnDEF USED_BY_LAZLOGGER_DUMMY}
DebugLogger.DbgOut(s);
{$ENDIF}
end;
procedure DbgOut(Args: array of const);
begin
{$IFnDEF USED_BY_LAZLOGGER_DUMMY}
DebugLogger.DbgOut(Args);
{$ENDIF}
end;
procedure DbgOut(const S: String; Args: array of const);
begin
{$IFnDEF USED_BY_LAZLOGGER_DUMMY}
DebugLogger.DbgOut(S, Args);
{$ENDIF}
end;
procedure DbgOut(const s1, s2: string; const s3: string; const s4: string; const s5: string;
const s6: string; const s7: string; const s8: string; const s9: string; const s10: string;
const s11: string; const s12: string; const s13: string; const s14: string;
const s15: string; const s16: string; const s17: string; const s18: string);
begin
{$IFnDEF USED_BY_LAZLOGGER_DUMMY}
DebugLogger.DbgOut(s1, s2, s3, s4, s5, s6, s7, s8, s9, s10, s11, s12, s13, s14, s15, s16, s17, s18);
{$ENDIF}
end;
procedure DebugLn(const s: string);
begin
{$IFnDEF USED_BY_LAZLOGGER_DUMMY}
DebugLogger.DebugLn(s);
{$ENDIF}
end;
procedure DebugLn(Args: array of const);
begin
{$IFnDEF USED_BY_LAZLOGGER_DUMMY}
DebugLogger.DebugLn(Args);
{$ENDIF}
end;
procedure DebugLn(const S: String; Args: array of const);
begin
{$IFnDEF USED_BY_LAZLOGGER_DUMMY}
DebugLogger.DebugLn(S, Args);
{$ENDIF}
end;
procedure DebugLn(const s1, s2: string; const s3: string; const s4: string; const s5: string;
const s6: string; const s7: string; const s8: string; const s9: string; const s10: string;
const s11: string; const s12: string; const s13: string; const s14: string;
const s15: string; const s16: string; const s17: string; const s18: string);
begin
{$IFnDEF USED_BY_LAZLOGGER_DUMMY}
DebugLogger.DebugLn(s1, s2, s3, s4, s5, s6, s7, s8, s9, s10, s11, s12, s13, s14, s15, s16, s17, s18);
{$ENDIF}
end;
procedure DebugLnEnter(const s: string);
begin
{$IFnDEF USED_BY_LAZLOGGER_DUMMY}
DebugLogger.DebugLnEnter(s);
{$ENDIF}
end;
procedure DebugLnEnter(Args: array of const);
begin
{$IFnDEF USED_BY_LAZLOGGER_DUMMY}
DebugLogger.DebugLnEnter(Args);
{$ENDIF}
end;
procedure DebugLnEnter(s: string; Args: array of const);
begin
{$IFnDEF USED_BY_LAZLOGGER_DUMMY}
DebugLogger.DebugLnEnter(s, Args);
{$ENDIF}
end;
procedure DebugLnEnter(const s1, s2: string; const s3: string; const s4: string;
const s5: string; const s6: string; const s7: string; const s8: string; const s9: string;
const s10: string; const s11: string; const s12: string; const s13: string;
const s14: string; const s15: string; const s16: string; const s17: string;
const s18: string);
begin
{$IFnDEF USED_BY_LAZLOGGER_DUMMY}
DebugLogger.DebugLnEnter(s1, s2, s3, s4, s5, s6, s7, s8, s9, s10, s11, s12, s13, s14, s15, s16, s17, s18);
{$ENDIF}
end;
procedure DebugLnExit(const s: string);
begin
{$IFnDEF USED_BY_LAZLOGGER_DUMMY}
DebugLogger.DebugLnExit(s);
{$ENDIF}
end;
procedure DebugLnExit(Args: array of const);
begin
{$IFnDEF USED_BY_LAZLOGGER_DUMMY}
DebugLogger.DebugLnExit(Args);
{$ENDIF}
end;
procedure DebugLnExit(s: string; Args: array of const);
begin
{$IFnDEF USED_BY_LAZLOGGER_DUMMY}
DebugLogger.DebugLnExit(s, Args);
{$ENDIF}
end;
procedure DebugLnExit(const s1, s2: string; const s3: string; const s4: string;
const s5: string; const s6: string; const s7: string; const s8: string; const s9: string;
const s10: string; const s11: string; const s12: string; const s13: string;
const s14: string; const s15: string; const s16: string; const s17: string;
const s18: string);
begin
{$IFnDEF USED_BY_LAZLOGGER_DUMMY}
DebugLogger.DebugLnExit(s1, s2, s3, s4, s5, s6, s7, s8, s9, s10, s11, s12, s13, s14, s15, s16, s17, s18);
{$ENDIF}
end;
procedure DebuglnStack(LogGroup: PLazLoggerLogGroup; const s: string);
begin
{$IFnDEF USED_BY_LAZLOGGER_DUMMY}
DebugLogger.DebuglnStack(LogGroup, s);
{$ENDIF}
end;
procedure DbgOut(LogGroup: PLazLoggerLogGroup; const s: string);
begin
{$IFnDEF USED_BY_LAZLOGGER_DUMMY}
DebugLogger.DbgOut(LogGroup, s);
{$ENDIF}
end;
procedure DbgOut(LogGroup: PLazLoggerLogGroup; Args: array of const);
begin
{$IFnDEF USED_BY_LAZLOGGER_DUMMY}
DebugLogger.DbgOut(LogGroup, Args);
{$ENDIF}
end;
procedure DbgOut(LogGroup: PLazLoggerLogGroup; const S: String; Args: array of const);
begin
{$IFnDEF USED_BY_LAZLOGGER_DUMMY}
DebugLogger.DbgOut(LogGroup, s, Args);
{$ENDIF}
end;
procedure DbgOut(LogGroup: PLazLoggerLogGroup; const s1, s2: string; const s3: string;
const s4: string; const s5: string; const s6: string; const s7: string; const s8: string;
const s9: string; const s10: string; const s11: string; const s12: string;
const s13: string; const s14: string; const s15: string; const s16: string;
const s17: string; const s18: string);
begin
{$IFnDEF USED_BY_LAZLOGGER_DUMMY}
DebugLogger.DbgOut(LogGroup, s1, s2, s3, s4, s5, s6, s7, s8, s9, s10, s11, s12, s13, s14, s15, s16, s17, s18);
{$ENDIF}
end;
procedure DebugLn(LogGroup: PLazLoggerLogGroup; const s: string);
begin
{$IFnDEF USED_BY_LAZLOGGER_DUMMY}
DebugLogger.DebugLn(LogGroup, s);
{$ENDIF}
end;
procedure DebugLn(LogGroup: PLazLoggerLogGroup; Args: array of const);
begin
{$IFnDEF USED_BY_LAZLOGGER_DUMMY}
DebugLogger.DebugLn(LogGroup, Args);
{$ENDIF}
end;
procedure DebugLn(LogGroup: PLazLoggerLogGroup; const S: String; Args: array of const);
begin
{$IFnDEF USED_BY_LAZLOGGER_DUMMY}
DebugLogger.DebugLn(LogGroup, s, Args);
{$ENDIF}
end;
procedure DebugLn(LogGroup: PLazLoggerLogGroup; const s1, s2: string; const s3: string;
const s4: string; const s5: string; const s6: string; const s7: string; const s8: string;
const s9: string; const s10: string; const s11: string; const s12: string;
const s13: string; const s14: string; const s15: string; const s16: string;
const s17: string; const s18: string);
begin
{$IFnDEF USED_BY_LAZLOGGER_DUMMY}
DebugLogger.DebugLn(LogGroup, s1, s2, s3, s4, s5, s6, s7, s8, s9, s10, s11, s12, s13, s14, s15, s16, s17, s18);
{$ENDIF}
end;
procedure DebugLnEnter(LogGroup: PLazLoggerLogGroup; const s: string);
begin
{$IFnDEF USED_BY_LAZLOGGER_DUMMY}
DebugLogger.DebugLnEnter(LogGroup, s);
{$ENDIF}
end;
procedure DebugLnEnter(LogGroup: PLazLoggerLogGroup; Args: array of const);
begin
{$IFnDEF USED_BY_LAZLOGGER_DUMMY}
DebugLogger.DebugLnEnter(LogGroup, Args);
{$ENDIF}
end;
procedure DebugLnEnter(LogGroup: PLazLoggerLogGroup; s: string; Args: array of const);
begin
{$IFnDEF USED_BY_LAZLOGGER_DUMMY}
DebugLogger.DebugLnEnter(LogGroup, s, Args);
{$ENDIF}
end;
procedure DebugLnEnter(LogGroup: PLazLoggerLogGroup; const s1, s2: string; const s3: string;
const s4: string; const s5: string; const s6: string; const s7: string; const s8: string;
const s9: string; const s10: string; const s11: string; const s12: string;
const s13: string; const s14: string; const s15: string; const s16: string;
const s17: string; const s18: string);
begin
{$IFnDEF USED_BY_LAZLOGGER_DUMMY}
DebugLogger.DebugLnEnter(LogGroup, s1, s2, s3, s4, s5, s6, s7, s8, s9, s10, s11, s12, s13, s14, s15, s16, s17, s18);
{$ENDIF}
end;
procedure DebugLnExit(LogGroup: PLazLoggerLogGroup; const s: string);
begin
{$IFnDEF USED_BY_LAZLOGGER_DUMMY}
DebugLogger.DebugLnExit(LogGroup, s);
{$ENDIF}
end;
procedure DebugLnExit(LogGroup: PLazLoggerLogGroup; Args: array of const);
begin
{$IFnDEF USED_BY_LAZLOGGER_DUMMY}
DebugLogger.DebugLnExit(LogGroup, Args);
{$ENDIF}
end;
procedure DebugLnExit(LogGroup: PLazLoggerLogGroup; s: string; Args: array of const);
begin
{$IFnDEF USED_BY_LAZLOGGER_DUMMY}
DebugLogger.DebugLnExit(LogGroup, s, Args);
{$ENDIF}
end;
procedure DebugLnExit(LogGroup: PLazLoggerLogGroup; const s1, s2: string; const s3: string;
const s4: string; const s5: string; const s6: string; const s7: string; const s8: string;
const s9: string; const s10: string; const s11: string; const s12: string;
const s13: string; const s14: string; const s15: string; const s16: string;
const s17: string; const s18: string);
begin
{$IFnDEF USED_BY_LAZLOGGER_DUMMY}
DebugLogger.DebugLnExit(LogGroup, s1, s2, s3, s4, s5, s6, s7, s8, s9, s10, s11, s12, s13, s14, s15, s16, s17, s18);
{$ENDIF}
end;
function DbgS(const c: cardinal): string;
begin
{$IFnDEF USED_BY_LAZLOGGER_DUMMY}
Result:=IntToStr(c);
{$ELSE}
Result := '';
{$ENDIF}
end;
function DbgS(const i: longint): string;
begin
{$IFnDEF USED_BY_LAZLOGGER_DUMMY}
Result:=IntToStr(i);
{$ELSE}
Result := '';
{$ENDIF}
end;
function DbgS(const i: int64): string;
begin
{$IFnDEF USED_BY_LAZLOGGER_DUMMY}
Result:=IntToStr(i);
{$ELSE}
Result := '';
{$ENDIF}
end;
function DbgS(const q: qword): string;
begin
{$IFnDEF USED_BY_LAZLOGGER_DUMMY}
Result:=IntToStr(q);
{$ELSE}
Result := '';
{$ENDIF}
end;
function DbgS(const r: TRect): string;
begin
{$IFnDEF USED_BY_LAZLOGGER_DUMMY}
Result:='l='+IntToStr(r.Left)+',t='+IntToStr(r.Top)
+',r='+IntToStr(r.Right)+',b='+IntToStr(r.Bottom);
{$ELSE}
Result := '';
{$ENDIF}
end;
function DbgS(const p: TPoint): string;
begin
{$IFnDEF USED_BY_LAZLOGGER_DUMMY}
Result:='(x='+IntToStr(p.x)+',y='+IntToStr(p.y)+')';
{$ELSE}
Result := '';
{$ENDIF}
end;
function DbgS(const p: pointer): string;
begin
{$IFnDEF USED_BY_LAZLOGGER_DUMMY}
Result:=HexStr(PtrUInt(p),2*sizeof(PtrInt));
{$ELSE}
Result := '';
{$ENDIF}
end;
function DbgS(const e: extended; MaxDecimals: integer): string;
begin
{$IFnDEF USED_BY_LAZLOGGER_DUMMY}
Result:=copy(FloatToStr(e),1,MaxDecimals);
{$ELSE}
Result := '';
{$ENDIF}
end;
function DbgS(const b: boolean): string;
begin
{$IFnDEF USED_BY_LAZLOGGER_DUMMY}
if b then Result:='True' else Result:='False';
{$ELSE}
Result := '';
{$ENDIF}
end;
function DbgS(const m: TMethod): string;
{$IFnDEF USED_BY_LAZLOGGER_DUMMY}
var
o: TObject;
aMethodName: ShortString;
{$ENDIF}
begin
{$IFnDEF USED_BY_LAZLOGGER_DUMMY}
o:=TObject(m.Data);
Result:=dbgsname(o)+'.'+dbgs(m.Code);
if (o<>nil) and (m.Code<>nil) then begin
aMethodName:=o.MethodName(m.Code);
Result:=Result+'='''+aMethodName+'''';
end;
{$ELSE}
Result := '';
{$ENDIF}
end;
function DbgSName(const p: TObject): string;
begin
{$IFnDEF USED_BY_LAZLOGGER_DUMMY}
if p=nil then
Result:='nil'
else if p is TComponent then
Result:=TComponent(p).Name+':'+p.ClassName
else
Result:=p.ClassName;
{$ELSE}
Result := '';
{$ENDIF}
end;
function DbgSName(const p: TClass): string;
begin
{$IFnDEF USED_BY_LAZLOGGER_DUMMY}
if p=nil then
Result:='nil'
else
Result:=p.ClassName;
{$ELSE}
Result := '';
{$ENDIF}
end;
function DbgS(const ASize: TSize): string;
begin
{$IFnDEF USED_BY_LAZLOGGER_DUMMY}
Result := 'cx: ' + DbgS(ASize.cx) + ' cy: ' + DbgS(ASize.cy);
{$ELSE}
Result := '';
{$ENDIF}
end;
function DbgSJoin(const s1, s2: string): string;
begin
{$IFnDEF USED_BY_LAZLOGGER_DUMMY}
if s1 <> '' then
Result := s1 + ',' + s2
else
Result := s1 + s2;
{$ELSE}
Result := '';
{$ENDIF}
end;
function DbgS(const s: TComponentState): string;
{$IFnDEF USED_BY_LAZLOGGER_DUMMY}
type
TComponentStateEnum = low(TComponentState)..high(TComponentState);
function DbgSComponentStateEnum(const se: TComponentStateEnum): string;
begin
WriteStr(Result, se);
end;
var
i: TComponentStateEnum;
{$ENDIF}
begin
{$IFnDEF USED_BY_LAZLOGGER_DUMMY}
Result:='';
for i := low(TComponentState) to high(TComponentState) do
if i in s then
Result := Result + DbgSJoin(Result, dbgsComponentStateEnum(i));
Result:='['+Result+']';
{$ELSE}
Result := '';
{$ENDIF}
end;
function dbgObjMem(AnObject: TObject): string;
begin
{$IFnDEF USED_BY_LAZLOGGER_DUMMY}
Result:='';
if AnObject=nil then exit;
Result:=dbgMemRange(PByte(AnObject),AnObject.InstanceSize);
{$ELSE}
Result := '';
{$ENDIF}
end;
function dbghex(i: Int64): string;
{$IFnDEF USED_BY_LAZLOGGER_DUMMY}
const
Hex = '0123456789ABCDEF';
var
Negated: Boolean;
{$ENDIF}
begin
{$IFnDEF USED_BY_LAZLOGGER_DUMMY}
Result:='';
if i<0 then begin
Negated:=true;
i:=-i;
end else
Negated:=false;
repeat
Result:=Hex[(i mod 16)+1]+Result;
i:=i div 16;
until i=0;
if Negated then
Result:='-'+Result;
{$ELSE}
Result := '';
{$ENDIF}
end;
function DbgS(const i1, i2, i3, i4: integer): string;
begin
{$IFnDEF USED_BY_LAZLOGGER_DUMMY}
Result:=dbgs(i1)+','+dbgs(i2)+','+dbgs(i3)+','+dbgs(i4);
{$ELSE}
Result := '';
{$ENDIF}
end;
function DbgS(const Shift: TShiftStateEnum): string;
begin
{$IFnDEF USED_BY_LAZLOGGER_DUMMY}
WriteStr(Result, Shift);
{$ELSE}
Result := '';
{$ENDIF}
end;
function DbgS(const Shift: TShiftState): string;
{$IFnDEF USED_BY_LAZLOGGER_DUMMY}
var
i: TShiftStateEnum;
{$ENDIF}
begin
{$IFnDEF USED_BY_LAZLOGGER_DUMMY}
Result:='';
for i := low(TShiftStateEnum) to high(TShiftStateEnum) do
if i in Shift then
Result := Result + DbgSJoin(Result, DbgS(i));
Result:='['+Result+']';
{$ELSE}
Result := '';
{$ENDIF}
end;
function dbgMemRange(P: Pointer; Count: integer; Width: integer): string;
{$IFnDEF USED_BY_LAZLOGGER_DUMMY}
const
HexChars: array[0..15] of char = '0123456789ABCDEF';
LineEnd: shortstring = LineEnding;
var
i: Integer;
NewLen: Integer;
Dest: PChar;
Col: Integer;
j: Integer;
{$ENDIF}
begin
{$IFnDEF USED_BY_LAZLOGGER_DUMMY}
Result:='';
if (p=nil) or (Count<=0) then exit;
NewLen:=Count*2;
if Width>0 then begin
inc(NewLen,(Count div Width)*length(LineEnd));
end;
SetLength(Result,NewLen);
Dest:=PChar(Result);
Col:=1;
for i:=0 to Count-1 do begin
Dest^:=HexChars[PByte(P)[i] shr 4];
inc(Dest);
Dest^:=HexChars[PByte(P)[i] and $f];
inc(Dest);
inc(Col);
if (Width>0) and (Col>Width) then begin
Col:=1;
for j:=1 to length(LineEnd) do begin
Dest^:=LineEnd[j];
inc(Dest);
end;
end;
end;
{$ELSE}
Result := '';
{$ENDIF}
end;
function dbgMemStream(MemStream: TCustomMemoryStream; Count: integer): string;
{$IFnDEF USED_BY_LAZLOGGER_DUMMY}
var
s: string;
{$ENDIF}
begin
{$IFnDEF USED_BY_LAZLOGGER_DUMMY}
Result:='';
if (MemStream=nil) or (not (MemStream is TCustomMemoryStream)) or (Count<=0)
then exit;
Count:=Min(Count,MemStream.Size);
if Count<=0 then exit;
SetLength(s,Count);
Count:=MemStream.Read(s[1],Count);
Result:=dbgMemRange(PByte(s),Count);
{$ELSE}
Result := '';
{$ENDIF}
end;

112
components/lazutils/LazLoggerIntf.inc Normal file
View File

@ -0,0 +1,112 @@
procedure DebuglnStack(const s: string = '');
procedure DbgOut(const s: string = ''); inline; overload;
procedure DbgOut(Args: array of const); {inline;} overload;
procedure DbgOut(const S: String; Args: array of const); {inline;} overload;// similar to Format(s,Args)
procedure DbgOut(const s1, s2: string; const s3: string = '';
const s4: string = ''; const s5: string = ''; const s6: string = '';
const s7: string = ''; const s8: string = ''; const s9: string = '';
const s10: string = ''; const s11: string = ''; const s12: string = '';
const s13: string = ''; const s14: string = ''; const s15: string = '';
const s16: string = ''; const s17: string = ''; const s18: string = ''); inline; overload;
procedure DebugLn(const s: string = ''); inline; overload;
procedure DebugLn(Args: array of const); {inline;} overload;
procedure DebugLn(const S: String; Args: array of const); {inline;} overload;// similar to Format(s,Args)
procedure DebugLn(const s1, s2: string; const s3: string = '';
const s4: string = ''; const s5: string = ''; const s6: string = '';
const s7: string = ''; const s8: string = ''; const s9: string = '';
const s10: string = ''; const s11: string = ''; const s12: string = '';
const s13: string = ''; const s14: string = ''; const s15: string = '';
const s16: string = ''; const s17: string = ''; const s18: string = ''); inline; overload;
procedure DebugLnEnter(const s: string = ''); inline; overload;
procedure DebugLnEnter(Args: array of const); {inline;} overload;
procedure DebugLnEnter(s: string; Args: array of const); {inline;} overload;
procedure DebugLnEnter(const s1, s2: string; const s3: string = '';
const s4: string = ''; const s5: string = ''; const s6: string = '';
const s7: string = ''; const s8: string = ''; const s9: string = '';
const s10: string = ''; const s11: string = ''; const s12: string = '';
const s13: string = ''; const s14: string = ''; const s15: string = '';
const s16: string = ''; const s17: string = ''; const s18: string = ''); inline; overload;
procedure DebugLnExit(const s: string = ''); inline; overload;
procedure DebugLnExit(Args: array of const); {inline;} overload;
procedure DebugLnExit(s: string; Args: array of const); {inline;} overload;
procedure DebugLnExit (const s1, s2: string; const s3: string = '';
const s4: string = ''; const s5: string = ''; const s6: string = '';
const s7: string = ''; const s8: string = ''; const s9: string = '';
const s10: string = ''; const s11: string = ''; const s12: string = '';
const s13: string = ''; const s14: string = ''; const s15: string = '';
const s16: string = ''; const s17: string = ''; const s18: string = ''); inline; overload;
procedure DebuglnStack(LogGroup: PLazLoggerLogGroup; const s: string = '');
procedure DbgOut(LogGroup: PLazLoggerLogGroup; const s: string = ''); overload;
procedure DbgOut(LogGroup: PLazLoggerLogGroup; Args: array of const); overload;
procedure DbgOut(LogGroup: PLazLoggerLogGroup; const S: String; Args: array of const); overload;// similar to Format(s,Args)
procedure DbgOut(LogGroup: PLazLoggerLogGroup; const s1, s2: string; const s3: string = '';
const s4: string = ''; const s5: string = ''; const s6: string = '';
const s7: string = ''; const s8: string = ''; const s9: string = '';
const s10: string = ''; const s11: string = ''; const s12: string = '';
const s13: string = ''; const s14: string = ''; const s15: string = '';
const s16: string = ''; const s17: string = ''; const s18: string = ''); overload;
procedure DebugLn(LogGroup: PLazLoggerLogGroup; const s: string = ''); overload;
procedure DebugLn(LogGroup: PLazLoggerLogGroup; Args: array of const); overload;
procedure DebugLn(LogGroup: PLazLoggerLogGroup; const S: String; Args: array of const); overload;// similar to Format(s,Args)
procedure DebugLn(LogGroup: PLazLoggerLogGroup; const s1, s2: string; const s3: string = '';
const s4: string = ''; const s5: string = ''; const s6: string = '';
const s7: string = ''; const s8: string = ''; const s9: string = '';
const s10: string = ''; const s11: string = ''; const s12: string = '';
const s13: string = ''; const s14: string = ''; const s15: string = '';
const s16: string = ''; const s17: string = ''; const s18: string = ''); overload;
procedure DebugLnEnter(LogGroup: PLazLoggerLogGroup; const s: string = ''); overload;
procedure DebugLnEnter(LogGroup: PLazLoggerLogGroup; Args: array of const); overload;
procedure DebugLnEnter(LogGroup: PLazLoggerLogGroup; s: string; Args: array of const); overload;
procedure DebugLnEnter(LogGroup: PLazLoggerLogGroup; const s1, s2: string; const s3: string = '';
const s4: string = ''; const s5: string = ''; const s6: string = '';
const s7: string = ''; const s8: string = ''; const s9: string = '';
const s10: string = ''; const s11: string = ''; const s12: string = '';
const s13: string = ''; const s14: string = ''; const s15: string = '';
const s16: string = ''; const s17: string = ''; const s18: string = ''); overload;
procedure DebugLnExit(LogGroup: PLazLoggerLogGroup; const s: string = ''); overload;
procedure DebugLnExit(LogGroup: PLazLoggerLogGroup; Args: array of const); overload;
procedure DebugLnExit(LogGroup: PLazLoggerLogGroup; s: string; Args: array of const); overload;
procedure DebugLnExit(LogGroup: PLazLoggerLogGroup; const s1, s2: string; const s3: string = '';
const s4: string = ''; const s5: string = ''; const s6: string = '';
const s7: string = ''; const s8: string = ''; const s9: string = '';
const s10: string = ''; const s11: string = ''; const s12: string = '';
const s13: string = ''; const s14: string = ''; const s15: string = '';
const s16: string = ''; const s17: string = ''; const s18: string = ''); overload;
function DbgS(const c: cardinal): string; overload;
function DbgS(const i: longint): string; overload;
function DbgS(const i: int64): string; overload;
function DbgS(const q: qword): string; overload;
function DbgS(const r: TRect): string; overload;
function DbgS(const p: TPoint): string; overload;
function DbgS(const p: pointer): string; overload;
function DbgS(const e: extended; MaxDecimals: integer = 999): string; overload;
function DbgS(const b: boolean): string; overload;
function DbgS(const m: TMethod): string; overload;
function DbgS(const ASize: TSize): string; overload;
function DbgS(const s: TComponentState): string; overload;
function DbgS(const i1,i2,i3,i4: integer): string; overload;
function DbgS(const Shift: TShiftStateEnum): string; overload;
function DbgS(const Shift: TShiftState): string; overload;
function DbgSJoin(const s1, s2: string): string;
function DbgSName(const p: TObject): string; overload;
function DbgSName(const p: TClass): string; overload;
function dbgObjMem(AnObject: TObject): string; overload;
function dbghex(i: Int64): string; overload;
function dbgMemRange(P: Pointer; Count: integer; Width: integer = 0): string; overload;
function dbgMemStream(MemStream: TCustomMemoryStream; Count: integer): string; overload;

133
components/lazutils/lazclasses.pas Normal file
View File

@ -0,0 +1,133 @@
unit LazClasses;
{$mode objfpc}{$H+}
interface
uses
sysutils, Classes, LazMethodList;
type
{ TFreeNotifyingObject }
TFreeNotifyingObject = class
private
FFreeNotificationList: TMethodList;
public
constructor Create;
destructor Destroy; override;
procedure AddFreeeNotification(ANotification: TNotifyEvent);
procedure RemoveFreeeNotification(ANotification: TNotifyEvent);
end;
{ TRefCountedObject }
TRefCountedObject = class(TFreeNotifyingObject)
private
FRefCount: Integer;
protected
procedure DoFree; virtual;
property RefCount: Integer read FRefCount;
public
constructor Create;
destructor Destroy; override;
procedure AddReference;
procedure ReleaseReference;
end;
{ TRefCntObjList }
TRefCntObjList = class(TList)
protected
procedure Notify(Ptr: Pointer; Action: TListNotification); override;
end;
procedure ReleaseRefAndNil(var ARefCountedObject);
implementation
{ TFreeNotifyingObject }
constructor TFreeNotifyingObject.Create;
begin
FFreeNotificationList := TMethodList.Create;
inherited Create;
end;
destructor TFreeNotifyingObject.Destroy;
begin
FFreeNotificationList.CallNotifyEvents(Self);
inherited Destroy;
FreeAndNil(FFreeNotificationList);
end;
procedure TFreeNotifyingObject.AddFreeeNotification(ANotification: TNotifyEvent);
begin
FFreeNotificationList.Add(TMethod(ANotification));
end;
procedure TFreeNotifyingObject.RemoveFreeeNotification(ANotification: TNotifyEvent);
begin
FFreeNotificationList.Remove(TMethod(ANotification));
end;
{ TRefCountedObject }
procedure TRefCountedObject.AddReference;
begin
Inc(FRefcount);
end;
procedure TRefCountedObject.DoFree;
begin
Self.Free;
end;
constructor TRefCountedObject.Create;
begin
FRefCount := 0;
inherited;
end;
destructor TRefCountedObject.Destroy;
begin
Assert(FRefcount = 0, 'Destroying referenced object');
inherited;
end;
procedure TRefCountedObject.ReleaseReference;
begin
Assert(FRefCount > 0, 'TRefCountedObject.ReleaseReference RefCount > 0');
Dec(FRefCount);
if FRefCount = 0 then DoFree;
end;
{ TRefCntObjList }
procedure TRefCntObjList.Notify(Ptr: Pointer; Action: TListNotification);
begin
case Action of
lnAdded: TRefCountedObject(Ptr).AddReference;
lnExtracted,
lnDeleted: TRefCountedObject(Ptr).ReleaseReference;
end;
end;
procedure ReleaseRefAndNil(var ARefCountedObject);
begin
Assert( (Pointer(ARefCountedObject) = nil) or
(TObject(ARefCountedObject) is TRefCountedObject),
'ReleaseRefAndNil requires TRefCountedObject');
if Pointer(ARefCountedObject) = nil then
exit;
if (TObject(ARefCountedObject) is TRefCountedObject) then
TRefCountedObject(ARefCountedObject).ReleaseReference;
Pointer(ARefCountedObject) := nil;
end;
end.

2086
components/lazutils/lazlogger.pas
View File

File diff suppressed because it is too large Load Diff

1085
components/lazutils/lazloggerbase.pas Normal file
View File

File diff suppressed because it is too large Load Diff

545
components/lazutils/lazloggerdummy.pas Normal file
View File

@ -0,0 +1,545 @@
unit LazLoggerDummy;
{$mode objfpc}{$H+}
(*
Provide an empty re-implementation of LazLoggerBase
The aim is to allow
- RegisterLogGroup
- debugln
to be called, and translate into empty method, or even inline no code at all
Any function above that may be limited
*)
interface
uses
Classes, SysUtils, FileUtil, types, LazClasses;
type
TLazLoggerLogGroupFlag =
( lgfAddedByParamParser, // Not added via Register. This is a placeholder for the enabled-state given by the user, via cmd-line
lgfNoDefaultEnabledSpecified // Registered without default
);
TLazLoggerLogGroupFlags = set of TLazLoggerLogGroupFlag;
TLazLoggerLogGroup = record
ConfigName: String; // case insensitive
Enabled: Boolean;
Flags: TLazLoggerLogGroupFlags;
FOpenedIndents: Integer;
end;
PLazLoggerLogGroup = ^TLazLoggerLogGroup;
TLazLoggerWriteEvent = procedure (Sender: TObject; S: string; var Handled: Boolean) of object;
{$DEFINE USED_BY_LAZLOGGER_DUMMY}
{$I LazLoggerIntf.inc}
type
(* All empty methods *)
{ TLazLoggerLogGroupList }
TLazLoggerLogGroupList = class(TRefCountedObject)
private
function GetItem(Index: Integer): PLazLoggerLogGroup;
public
procedure Assign(Src: TLazLoggerLogGroupList);
function IndexOf(const AConfigName: String): integer;
function IndexOf(const AnEntry: PLazLoggerLogGroup): integer;
function Find(const AConfigName: String): PLazLoggerLogGroup;
function Count: integer;
property Item[Index: Integer]: PLazLoggerLogGroup read GetItem; default;
end;
{ TLazLogger }
TLazLogger = class(TRefCountedObject)
private
FMaxNestPrefixLen: Integer;
FNestLvlIndent: Integer;
FUseGlobalLogGroupList: Boolean;
function GetLogGroupList: TLazLoggerLogGroupList;
procedure SetMaxNestPrefixLen(AValue: Integer);
procedure SetNestLvlIndent(AValue: Integer);
procedure SetUseGlobalLogGroupList(AValue: Boolean);
public
procedure Assign(Src: TLazLogger); virtual;
procedure Init;
procedure Finish;
property NestLvlIndent: Integer read FNestLvlIndent write SetNestLvlIndent;
property MaxNestPrefixLen: Integer read FMaxNestPrefixLen write SetMaxNestPrefixLen;
public
function RegisterLogGroup(const AConfigName: String; ADefaulEnabled: Boolean) : PLazLoggerLogGroup; virtual;
function RegisterLogGroup(const AConfigName: String) : PLazLoggerLogGroup; virtual;
function FindOrRegisterLogGroup(const AConfigName: String; ADefaulEnabled: Boolean) : PLazLoggerLogGroup; virtual;
function FindOrRegisterLogGroup(const AConfigName: String) : PLazLoggerLogGroup; virtual;
property LogGroupList: TLazLoggerLogGroupList read GetLogGroupList;
property UseGlobalLogGroupList: Boolean read FUseGlobalLogGroupList write SetUseGlobalLogGroupList;
public
procedure DebuglnStack(const s: string = '');
procedure DbgOut(const s: string = ''); overload;
procedure DbgOut(Args: array of const); overload;
procedure DbgOut(const S: String; Args: array of const); overload;// similar to Format(s,Args)
procedure DbgOut(const s1, s2: string; const s3: string = '';
const s4: string = ''; const s5: string = ''; const s6: string = '';
const s7: string = ''; const s8: string = ''; const s9: string = '';
const s10: string = ''; const s11: string = ''; const s12: string = '';
const s13: string = ''; const s14: string = ''; const s15: string = '';
const s16: string = ''; const s17: string = ''; const s18: string = ''); overload;
procedure DebugLn(const s: string = ''); overload;
procedure DebugLn(Args: array of const); overload;
procedure DebugLn(const S: String; Args: array of const); overload;// similar to Format(s,Args)
procedure DebugLn(const s1, s2: string; const s3: string = '';
const s4: string = ''; const s5: string = ''; const s6: string = '';
const s7: string = ''; const s8: string = ''; const s9: string = '';
const s10: string = ''; const s11: string = ''; const s12: string = '';
const s13: string = ''; const s14: string = ''; const s15: string = '';
const s16: string = ''; const s17: string = ''; const s18: string = ''); overload;
procedure DebugLnEnter(const s: string = ''); overload;
procedure DebugLnEnter(Args: array of const); overload;
procedure DebugLnEnter(s: string; Args: array of const); overload;
procedure DebugLnEnter(const s1, s2: string; const s3: string = '';
const s4: string = ''; const s5: string = ''; const s6: string = '';
const s7: string = ''; const s8: string = ''; const s9: string = '';
const s10: string = ''; const s11: string = ''; const s12: string = '';
const s13: string = ''; const s14: string = ''; const s15: string = '';
const s16: string = ''; const s17: string = ''; const s18: string = ''); overload;
procedure DebugLnExit(const s: string = ''); overload;
procedure DebugLnExit(Args: array of const); overload;
procedure DebugLnExit(s: string; Args: array of const); overload;
procedure DebugLnExit(const s1, s2: string; const s3: string = '';
const s4: string = ''; const s5: string = ''; const s6: string = '';
const s7: string = ''; const s8: string = ''; const s9: string = '';
const s10: string = ''; const s11: string = ''; const s12: string = '';
const s13: string = ''; const s14: string = ''; const s15: string = '';
const s16: string = ''; const s17: string = ''; const s18: string = ''); overload;
procedure DebuglnStack(LogGroup: PLazLoggerLogGroup; const s: string = '');
procedure DbgOut(LogGroup: PLazLoggerLogGroup; const s: string = ''); overload;
procedure DbgOut(LogGroup: PLazLoggerLogGroup; Args: array of const); overload;
procedure DbgOut(LogGroup: PLazLoggerLogGroup; const S: String; Args: array of const); overload;// similar to Format(s,Args)
procedure DbgOut(LogGroup: PLazLoggerLogGroup; const s1, s2: string; const s3: string = '';
const s4: string = ''; const s5: string = ''; const s6: string = '';
const s7: string = ''; const s8: string = ''; const s9: string = '';
const s10: string = ''; const s11: string = ''; const s12: string = '';
const s13: string = ''; const s14: string = ''; const s15: string = '';
const s16: string = ''; const s17: string = ''; const s18: string = ''); overload;
procedure DebugLn(LogGroup: PLazLoggerLogGroup; const s: string = ''); overload;
procedure DebugLn(LogGroup: PLazLoggerLogGroup; Args: array of const); overload;
procedure DebugLn(LogGroup: PLazLoggerLogGroup; const S: String; Args: array of const); overload;// similar to Format(s,Args)
procedure DebugLn(LogGroup: PLazLoggerLogGroup; const s1, s2: string; const s3: string = '';
const s4: string = ''; const s5: string = ''; const s6: string = '';
const s7: string = ''; const s8: string = ''; const s9: string = '';
const s10: string = ''; const s11: string = ''; const s12: string = '';
const s13: string = ''; const s14: string = ''; const s15: string = '';
const s16: string = ''; const s17: string = ''; const s18: string = ''); overload;
procedure DebugLnEnter(LogGroup: PLazLoggerLogGroup; const s: string = ''); overload;
procedure DebugLnEnter(LogGroup: PLazLoggerLogGroup; Args: array of const); overload;
procedure DebugLnEnter(LogGroup: PLazLoggerLogGroup; s: string; Args: array of const); overload;
procedure DebugLnEnter(LogGroup: PLazLoggerLogGroup; const s1, s2: string; const s3: string = '';
const s4: string = ''; const s5: string = ''; const s6: string = '';
const s7: string = ''; const s8: string = ''; const s9: string = '';
const s10: string = ''; const s11: string = ''; const s12: string = '';
const s13: string = ''; const s14: string = ''; const s15: string = '';
const s16: string = ''; const s17: string = ''; const s18: string = ''); overload;
procedure DebugLnExit(LogGroup: PLazLoggerLogGroup; const s: string = ''); overload;
procedure DebugLnExit(LogGroup: PLazLoggerLogGroup; Args: array of const); overload;
procedure DebugLnExit(LogGroup: PLazLoggerLogGroup; s: string; Args: array of const); overload;
procedure DebugLnExit(LogGroup: PLazLoggerLogGroup; const s1, s2: string; const s3: string = '';
const s4: string = ''; const s5: string = ''; const s6: string = '';
const s7: string = ''; const s8: string = ''; const s9: string = '';
const s10: string = ''; const s11: string = ''; const s12: string = '';
const s13: string = ''; const s14: string = ''; const s15: string = '';
const s16: string = ''; const s17: string = ''; const s18: string = ''); overload;
end;
function GetDebugLoggerGroups: TLazLoggerLogGroupList; inline;
procedure SetDebugLoggerGroups(ALogGroups: TLazLoggerLogGroupList);
function GetDebugLogger: TLazLogger; inline;
function GetExistingDebugLogger: TLazLogger; inline; // No Autocreate
procedure SetDebugLogger(ALogger: TLazLogger);
procedure RecreateDebugLogger;
property DebugLogger: TLazLogger read GetDebugLogger write SetDebugLogger;
property DebugLoggerGroups: TLazLoggerLogGroupList read GetDebugLoggerGroups write SetDebugLoggerGroups;
type
TLazDebugLoggerCreator = function: TRefCountedObject;
// Using base TRefCountedObject, so if none of the functions is used in the app, then even the class should be smart linked
var
LazDebugLoggerCreator: TLazDebugLoggerCreator = nil;
OnWidgetSetDebugLn: TLazLoggerWriteEvent;
OnWidgetSetDbgOut: TLazLoggerWriteEvent;
implementation
var // Using base TRefCountedObject, so if none of the functions is used in the app, then even the class should be smart linked
TheLazLogger: TRefCountedObject = nil;
TheLazLoggerGroups: TRefCountedObject = nil;
{$I LazLoggerImpl.inc}
procedure CreateDebugLogger;
begin
if (TheLazLogger <> nil) then
exit;
if (TheLazLogger = nil) then
TheLazLogger := TLazLogger.Create;
TheLazLogger.AddReference;
end;
function GetDebugLogger: TLazLogger;
begin
if (TheLazLogger = nil) then
CreateDebugLogger;
Result := TLazLogger(TheLazLogger);
end;
function GetExistingDebugLogger: TLazLogger;
begin
Result := TLazLogger(TheLazLogger);
end;
procedure SetDebugLogger(ALogger: TLazLogger);
begin
end;
procedure RecreateDebugLogger;
begin
end;
function GetDebugLoggerGroups: TLazLoggerLogGroupList;
begin
if (TheLazLoggerGroups = nil) then begin
TheLazLoggerGroups := TLazLoggerLogGroupList.Create;
TheLazLoggerGroups.AddReference;
end;
Result := TLazLoggerLogGroupList(TheLazLoggerGroups);
end;
procedure SetDebugLoggerGroups(ALogGroups: TLazLoggerLogGroupList);
begin
end;
function TLazLogger.GetLogGroupList: TLazLoggerLogGroupList;
begin
Result := DebugLoggerGroups;
end;
procedure TLazLogger.SetMaxNestPrefixLen(AValue: Integer);
begin
FMaxNestPrefixLen := AValue;
end;
procedure TLazLogger.SetNestLvlIndent(AValue: Integer);
begin
FNestLvlIndent := AValue;
end;
procedure TLazLogger.SetUseGlobalLogGroupList(AValue: Boolean);
begin
FUseGlobalLogGroupList := AValue;
end;
procedure TLazLogger.Assign(Src: TLazLogger);
begin
end;
procedure TLazLogger.Init;
begin
end;
procedure TLazLogger.Finish;
begin
end;
function TLazLogger.RegisterLogGroup(const AConfigName: String;
ADefaulEnabled: Boolean): PLazLoggerLogGroup;
begin
Result := nil;
end;
function TLazLogger.RegisterLogGroup(const AConfigName: String): PLazLoggerLogGroup;
begin
Result := nil;
end;
function TLazLogger.FindOrRegisterLogGroup(const AConfigName: String;
ADefaulEnabled: Boolean): PLazLoggerLogGroup;
begin
Result := nil;
end;
function TLazLogger.FindOrRegisterLogGroup(const AConfigName: String): PLazLoggerLogGroup;
begin
Result := nil;
end;
procedure TLazLogger.DebuglnStack(const s: string);
begin
end;
procedure TLazLogger.DbgOut(const s: string);
begin
end;
procedure TLazLogger.DbgOut(Args: array of const);
begin
end;
procedure TLazLogger.DbgOut(const S: String; Args: array of const);
begin
end;
procedure TLazLogger.DbgOut(const s1, s2: string; const s3: string; const s4: string;
const s5: string; const s6: string; const s7: string; const s8: string; const s9: string;
const s10: string; const s11: string; const s12: string; const s13: string;
const s14: string; const s15: string; const s16: string; const s17: string;
const s18: string);
begin
end;
procedure TLazLogger.DebugLn(const s: string);
begin
end;
procedure TLazLogger.DebugLn(Args: array of const);
begin
end;
procedure TLazLogger.DebugLn(const S: String; Args: array of const);
begin
end;
procedure TLazLogger.DebugLn(const s1, s2: string; const s3: string; const s4: string;
const s5: string; const s6: string; const s7: string; const s8: string; const s9: string;
const s10: string; const s11: string; const s12: string; const s13: string;
const s14: string; const s15: string; const s16: string; const s17: string;
const s18: string);
begin
end;
procedure TLazLogger.DebugLnEnter(const s: string);
begin
end;
procedure TLazLogger.DebugLnEnter(Args: array of const);
begin
end;
procedure TLazLogger.DebugLnEnter(s: string; Args: array of const);
begin
end;
procedure TLazLogger.DebugLnEnter(const s1, s2: string; const s3: string; const s4: string;
const s5: string; const s6: string; const s7: string; const s8: string; const s9: string;
const s10: string; const s11: string; const s12: string; const s13: string;
const s14: string; const s15: string; const s16: string; const s17: string;
const s18: string);
begin
end;
procedure TLazLogger.DebugLnExit(const s: string);
begin
end;
procedure TLazLogger.DebugLnExit(Args: array of const);
begin
end;
procedure TLazLogger.DebugLnExit(s: string; Args: array of const);
begin
end;
procedure TLazLogger.DebugLnExit(const s1, s2: string; const s3: string; const s4: string;
const s5: string; const s6: string; const s7: string; const s8: string; const s9: string;
const s10: string; const s11: string; const s12: string; const s13: string;
const s14: string; const s15: string; const s16: string; const s17: string;
const s18: string);
begin
end;
procedure TLazLogger.DebuglnStack(LogGroup: PLazLoggerLogGroup; const s: string);
begin
end;
procedure TLazLogger.DbgOut(LogGroup: PLazLoggerLogGroup; const s: string);
begin
end;
procedure TLazLogger.DbgOut(LogGroup: PLazLoggerLogGroup; Args: array of const);
begin
end;
procedure TLazLogger.DbgOut(LogGroup: PLazLoggerLogGroup; const S: String;
Args: array of const);
begin
end;
procedure TLazLogger.DbgOut(LogGroup: PLazLoggerLogGroup; const s1, s2: string;
const s3: string; const s4: string; const s5: string; const s6: string; const s7: string;
const s8: string; const s9: string; const s10: string; const s11: string; const s12: string;
const s13: string; const s14: string; const s15: string; const s16: string;
const s17: string; const s18: string);
begin
end;
procedure TLazLogger.DebugLn(LogGroup: PLazLoggerLogGroup; const s: string);
begin
end;
procedure TLazLogger.DebugLn(LogGroup: PLazLoggerLogGroup; Args: array of const);
begin
end;
procedure TLazLogger.DebugLn(LogGroup: PLazLoggerLogGroup; const S: String;
Args: array of const);
begin
end;
procedure TLazLogger.DebugLn(LogGroup: PLazLoggerLogGroup; const s1, s2: string;
const s3: string; const s4: string; const s5: string; const s6: string; const s7: string;
const s8: string; const s9: string; const s10: string; const s11: string; const s12: string;
const s13: string; const s14: string; const s15: string; const s16: string;
const s17: string; const s18: string);
begin
end;
procedure TLazLogger.DebugLnEnter(LogGroup: PLazLoggerLogGroup; const s: string);
begin
end;
procedure TLazLogger.DebugLnEnter(LogGroup: PLazLoggerLogGroup; Args: array of const);
begin
end;
procedure TLazLogger.DebugLnEnter(LogGroup: PLazLoggerLogGroup; s: string;
Args: array of const);
begin
end;
procedure TLazLogger.DebugLnEnter(LogGroup: PLazLoggerLogGroup; const s1, s2: string;
const s3: string; const s4: string; const s5: string; const s6: string; const s7: string;
const s8: string; const s9: string; const s10: string; const s11: string; const s12: string;
const s13: string; const s14: string; const s15: string; const s16: string;
const s17: string; const s18: string);
begin
end;
procedure TLazLogger.DebugLnExit(LogGroup: PLazLoggerLogGroup; const s: string);
begin
end;
procedure TLazLogger.DebugLnExit(LogGroup: PLazLoggerLogGroup; Args: array of const);
begin
end;
procedure TLazLogger.DebugLnExit(LogGroup: PLazLoggerLogGroup; s: string;
Args: array of const);
begin
end;
procedure TLazLogger.DebugLnExit(LogGroup: PLazLoggerLogGroup; const s1, s2: string;
const s3: string; const s4: string; const s5: string; const s6: string; const s7: string;
const s8: string; const s9: string; const s10: string; const s11: string; const s12: string;
const s13: string; const s14: string; const s15: string; const s16: string;
const s17: string; const s18: string);
begin
end;
{ TLazLoggerLogGroupList }
function TLazLoggerLogGroupList.GetItem(Index: Integer): PLazLoggerLogGroup;
begin
Result := nil;
end;
procedure TLazLoggerLogGroupList.Assign(Src: TLazLoggerLogGroupList);
begin
end;
function TLazLoggerLogGroupList.IndexOf(const AConfigName: String): integer;
begin
Result := -1;
end;
function TLazLoggerLogGroupList.IndexOf(const AnEntry: PLazLoggerLogGroup): integer;
begin
Result := -1;
end;
function TLazLoggerLogGroupList.Find(const AConfigName: String): PLazLoggerLogGroup;
begin
Result := nil;
end;
function TLazLoggerLogGroupList.Count: integer;
begin
Result := 0;
end;
finalization // Using TObject, so if none of the functions is used in the app, then even the rlass should be smart linked
ReleaseRefAndNil(TheLazLogger);
ReleaseRefAndNil(TheLazLoggerGroups);
end.

18
components/lazutils/lazutils.lpk
View File

@ -19,7 +19,7 @@
<Description Value="Useful units for Lazarus packages."/>
<License Value="Modified LGPL-2"/>
<Version Major="1"/>
<Files Count="58">
<Files Count="62">
<Item1>
<Filename Value="laz2_dom.pas"/>
<UnitName Value="laz2_DOM"/>
@ -252,6 +252,22 @@
<Filename Value="easylazfreetype.pas"/>
<UnitName Value="EasyLazFreeType"/>
</Item58>
<Item59>
<Filename Value="lazloggerbase.pas"/>
<UnitName Value="LazLoggerBase"/>
</Item59>
<Item60>
<Filename Value="LazLoggerIntf.inc"/>
<Type Value="Include"/>
</Item60>
<Item61>
<Filename Value="lazloggerdummy.pas"/>
<UnitName Value="LazLoggerDummy"/>
</Item61>
<Item62>
<Filename Value="lazclasses.pas"/>
<UnitName Value="LazClasses"/>
</Item62>
</Files>
<LazDoc Paths="../../docs/xml/lazutils"/>
<i18n>

15
components/lazutils/lazutils.pas
View File

@ -7,14 +7,13 @@ unit LazUtils;
interface
uses
laz2_DOM, Laz2_XMLCfg, laz2_XMLRead, laz2_xmlutils, laz2_XMLWrite, Laz_DOM,
Laz_XMLCfg, Laz_XMLRead, Laz_XMLStreaming, Laz_XMLWrite, LazFileUtils,
LazFileCache, LUResStrings, LazUTF8, LazDbgLog, paswstring, FileUtil,
lazutf8classes, Masks, LazUtilsStrConsts, LConvEncoding, lazutf16,
lazutf8sysutils, LazMethodList, AvgLvlTree, LazLogger, LazFreeType, TTCache,
TTCalc, TTCMap, TTDebug, TTError, TTFile, TTGLoad, TTInterp, TTLoad,
TTMemory, TTObjs, TTProfile, TTRASTER, TTTables, TTTypes, EasyLazFreeType,
LazarusPackageIntf;
laz2_DOM, Laz2_XMLCfg, laz2_XMLRead, laz2_xmlutils, laz2_XMLWrite, Laz_DOM, Laz_XMLCfg,
Laz_XMLRead, Laz_XMLStreaming, Laz_XMLWrite, LazFileUtils, LazFileCache, LUResStrings,
LazUTF8, LazDbgLog, paswstring, FileUtil, lazutf8classes, Masks, LazUtilsStrConsts,
LConvEncoding, lazutf16, lazutf8sysutils, LazMethodList, AvgLvlTree, LazLogger,
LazFreeType, TTCache, TTCalc, TTCMap, TTDebug, TTError, TTFile, TTGLoad, TTInterp, TTLoad,
TTMemory, TTObjs, TTProfile, TTRASTER, TTTables, TTTypes, EasyLazFreeType, LazLoggerBase,
LazLoggerDummy, LazClasses, LazarusPackageIntf;
implementation

2
components/synedit/syneditfoldedview.pp
View File

@ -45,7 +45,7 @@ unit SynEditFoldedView;
interface
uses
LCLProc, LazLogger, Graphics,
LCLProc, LazLoggerBase, Graphics,
Classes, SysUtils, LazSynEditText, SynEditTypes, SynEditMiscClasses,
SynEditMiscProcs, SynEditPointClasses,
SynEditHighlighter, SynEditHighlighterFoldBase;

2
debugger/callstackdlg.pp
View File

@ -36,7 +36,7 @@ unit CallStackDlg;
interface
uses
SysUtils, Classes, Controls, Forms, LCLProc, LazLogger,
SysUtils, Classes, Controls, Forms, LCLProc, LazLoggerBase,
IDEWindowIntf, DebuggerStrConst,
ComCtrls, Debugger, DebuggerDlg, Menus, ClipBrd, ExtCtrls, StdCtrls,
ActnList, IDEImagesIntf, IDECommands;

104
debugger/debugger.pp
View File

@ -38,7 +38,7 @@ unit Debugger;
interface
uses
TypInfo, Classes, SysUtils, Laz_XMLCfg, math, FileUtil, LazLogger,
TypInfo, Classes, SysUtils, Laz_XMLCfg, math, FileUtil, LazLoggerBase, LazClasses,
LCLProc, LazConfigStorage, IDEProcs, DebugUtils, maps;
type
@ -205,40 +205,6 @@ type
published
end;
{ TFreeNotifyingObject }
TFreeNotifyingObject = class
private
FFreeNotificationList: TMethodList;
public
constructor Create;
destructor Destroy; override;
procedure AddFreeeNotification(ANotification: TNotifyEvent);
procedure RemoveFreeeNotification(ANotification: TNotifyEvent);
end;
{ TRefCountedObject }
TRefCountedObject = class(TFreeNotifyingObject)
private
FRefCount: Integer;
protected
procedure DoFree; virtual;
property RefCount: Integer read FRefCount;
public
constructor Create;
destructor Destroy; override;
procedure AddReference;
procedure ReleaseReference;
end;
{ TRefCntObjList }
TRefCntObjList = class(TList)
protected
procedure Notify(Ptr: Pointer; Action: TListNotification); override;
end;
{ TRefCountedColectionItem }
TRefCountedColectionItem = class(TDelayedUdateItem)
@ -3232,31 +3198,6 @@ begin
Result := FList.Count;
end;
{ TFreeNotifyingObject }
constructor TFreeNotifyingObject.Create;
begin
FFreeNotificationList := TMethodList.Create;
inherited Create;
end;
destructor TFreeNotifyingObject.Destroy;
begin
FFreeNotificationList.CallNotifyEvents(Self);
inherited Destroy;
FreeAndNil(FFreeNotificationList);
end;
procedure TFreeNotifyingObject.AddFreeeNotification(ANotification: TNotifyEvent);
begin
FFreeNotificationList.Add(TMethod(ANotification));
end;
procedure TFreeNotifyingObject.RemoveFreeeNotification(ANotification: TNotifyEvent);
begin
FFreeNotificationList.Remove(TMethod(ANotification));
end;
{ TDebuggerWatchesDlgConfig }
constructor TDebuggerWatchesDlgConfig.Create;
@ -5921,49 +5862,6 @@ begin
end;
{ =========================================================================== }
{ TRefCountedObject }
{ =========================================================================== }
procedure TRefCountedObject.AddReference;
begin
Inc(FRefcount);
end;
procedure TRefCountedObject.DoFree;
begin
Self.Free;
end;
constructor TRefCountedObject.Create;
begin
FRefCount := 0;
inherited;
end;
destructor TRefCountedObject.Destroy;
begin
Assert(FRefcount = 0, 'Destroying referenced object');
inherited;
end;
procedure TRefCountedObject.ReleaseReference;
begin
Assert(FRefCount > 0, 'TRefCountedObject.ReleaseReference RefCount > 0');
Dec(FRefCount);
if FRefCount = 0 then DoFree;
end;
{ TRefCntObjList }
procedure TRefCntObjList.Notify(Ptr: Pointer; Action: TListNotification);
begin
case Action of
lnAdded: TRefCountedObject(Ptr).AddReference;
lnExtracted,
lnDeleted: TRefCountedObject(Ptr).ReleaseReference;
end;
end;
{ TRefCountedColectionItem }
constructor TRefCountedColectionItem.Create(ACollection: TCollection);

2
debugger/debuggerdlg.pp
View File

@ -37,7 +37,7 @@ unit DebuggerDlg;
interface
uses
Classes, Forms, Controls, IDEProcs, FileUtil, LCLProc, LazLogger, Debugger,
Classes, Forms, Controls, IDEProcs, FileUtil, LCLProc, LazLoggerBase, Debugger,
IDEImagesIntf, MainIntf, EditorOptions, IDECommands, BaseDebugManager;
type

2
debugger/gdbmidebugger.pp
View File

@ -39,7 +39,7 @@ unit GDBMIDebugger;
interface
uses
Classes, SysUtils, Controls, Math, Variants, LCLProc, LazLogger, Dialogs,
Classes, SysUtils, Controls, Math, Variants, LCLProc, LazClasses, LazLoggerBase, Dialogs,
DebugUtils, Debugger, FileUtil, CmdLineDebugger, GDBTypeInfo, Maps, LCLIntf,
{$IFdef MSWindows}
Windows,

2
debugger/gdbtypeinfo.pp
View File

@ -34,7 +34,7 @@ unit GDBTypeInfo;
interface
uses
Classes, SysUtils, Debugger, LclProc, LazLogger, DebugUtils, GDBMIMiscClasses;
Classes, SysUtils, Debugger, LclProc, LazLoggerBase, DebugUtils, GDBMIMiscClasses;
(*
ptype = {

2
debugger/localsdlg.pp
View File

@ -36,7 +36,7 @@ unit LocalsDlg;
interface
uses
SysUtils, Classes, Forms, ClipBrd, LCLProc, LazLogger,
SysUtils, Classes, Forms, ClipBrd, LCLProc, LazLoggerBase,
IDEWindowIntf, DebuggerStrConst,
ComCtrls, ActnList, Menus, BaseDebugManager, Debugger, DebuggerDlg;

2
debugger/threaddlg.pp
View File

@ -5,7 +5,7 @@ unit ThreadDlg;
interface
uses
Classes, SysUtils, ComCtrls, LCLProc, LazLogger,
Classes, SysUtils, ComCtrls, LCLProc, LazLoggerBase,
Debugger, DebuggerDlg, Forms, LazarusIDEStrConsts, IDEWindowIntf, DebuggerStrConst,
BaseDebugManager, IDEImagesIntf;

2
debugger/watchesdlg.pp
View File

@ -38,7 +38,7 @@ unit WatchesDlg;
interface
uses
Classes, Forms, Controls, math, LCLProc, LazLogger,
Classes, Forms, Controls, math, LazLoggerBase,
IDEWindowIntf, Menus, ComCtrls, ActnList, IDEImagesIntf, LazarusIDEStrConsts, DebuggerStrConst,
Debugger, DebuggerDlg, BaseDebugManager;

2
ide/debugmanager.pas
View File

@ -42,7 +42,7 @@ uses
{$ENDIF}
// LCL
Classes, SysUtils, Forms, Controls, Dialogs, Menus, ExtCtrls, FileUtil, LCLProc,
LCLType, LCLIntf, LazLogger,
LCLType, LCLIntf, LazLoggerBase,
// SynEdit, codetools
Laz_XMLCfg, SynEdit, CodeCache, CodeToolManager,
// IDEIntf

2
lcl/interfaces/customdrawn/customdrawnint.pas
View File

@ -54,7 +54,7 @@ uses
lazcanvas, lazregions, lazdeviceapis,
InterfaceBase,
Controls, Forms, lclproc, IntfGraphics, GraphType,
LCLType, LMessages, Graphics, LCLStrConsts, LazLogger;
LCLType, LMessages, Graphics, LCLStrConsts, LazLoggerBase;
type
{$ifdef CD_Windows}

4
lcl/interfaces/customdrawn/customdrawnobject_android.inc
View File

@ -729,8 +729,8 @@ procedure TCDWidgetSet.BackendCreate;
begin
// Setup DebugLn
{$IFnDEF WithOldDebugln}
DebugLogger.OnDebugLn := @AndroidDebugLn;
DebugLogger.OnDbgOut := @AccumulatingDebugOut;
OnWidgetSetDebugLn := @AndroidDebugLn;
OnWidgetSetDbgOut := @AccumulatingDebugOut;
{$ELSE}
DebugLnProc := @AndroidDebugLn;
DebugOutProc := @AccumulatingDebugOut;

31
test/lazutils/testlazloggercase.pas
View File

@ -5,7 +5,7 @@ unit TestLazLoggerCase;
interface
uses
Classes, SysUtils, fpcunit, testutils, testregistry, LazLogger;
Classes, SysUtils, fpcunit, testutils, testregistry, LazLoggerBase, LazLogger, LazClasses;
type
TStringArray = array of string;
@ -14,7 +14,7 @@ type
TTestLazLogger = class(TTestCase)
protected
FTheLogger: TLazLogger;
FTheLogger: TLazLoggerFile;
FOnDbgOutCount, FOnDebugLnCount: Integer;
FOnDbgOutText, FOnDebugLnText: string;
FArgcMem, FArgVSaved: PPChar;
@ -33,6 +33,10 @@ type
published
procedure TestEvent;
procedure TestFilter;
procedure TestReCreate;
end;
TLazLoggerForTest = class(TLazLogger)
end;
implementation
@ -54,7 +58,7 @@ end;
procedure TTestLazLogger.InitLogger;
begin
FreeAndNil(FTheLogger);
FTheLogger := TLazLogger.Create;
FTheLogger := TLazLoggerFile.Create;
FTheLogger.OnDebugLn := @TestOnDebugln;
FTheLogger.OnDbgOut := @TestOnDbgOut;
FOnDebugLnCount := 0;
@ -426,6 +430,27 @@ begin
end;
end;
function CreateDebugLogger: TRefCountedObject;
begin
Result := TLazLoggerForTest.Create;
TLazLoggerFile(Result).Assign(GetExistingDebugLogger);
end;
procedure TTestLazLogger.TestReCreate;
begin
AssertTrue('DebugLogger is TLazLoggerFile', DebugLogger is TLazLoggerFile);
DebugLogger.MaxNestPrefixLen := 122;
LazDebugLoggerCreator := @CreateDebugLogger;
AssertTrue('still DebugLogger is TLazLoggerFile', DebugLogger is TLazLoggerFile);
RecreateDebugLogger;
AssertTrue('DebugLogger is TLazLoggerForTest', LazLoggerBase.DebugLogger is TLazLoggerForTest);
AssertEquals('MaxNestPrefixLen = 122', 122, TLazLoggerForTest(LazLoggerBase.DebugLogger).MaxNestPrefixLen);
end;
initialization