From 438ccb831ce38a6b1b4aed596b890c32c8dda7ee Mon Sep 17 00:00:00 2001 From: Daniel Kamil Kozar Date: Sun, 21 Jul 2024 12:24:41 +0200 Subject: [PATCH] Make the application somewhat runnable in debug mode --- baseform.pas | 22 +++- connoptions.lfm | 136 +++++++++++----------- lineinfo2.pp | 304 ------------------------------------------------ main.lfm | 1 - main.pas | 44 +------ transgui.lpi | 21 +--- utils.pas | 40 ------- 7 files changed, 91 insertions(+), 477 deletions(-) delete mode 100644 lineinfo2.pp diff --git a/baseform.pas b/baseform.pas index 581344f7..347f96ce 100644 --- a/baseform.pas +++ b/baseform.pas @@ -65,13 +65,25 @@ implementation var ScaleMultiplier, ScaleDivider: integer; +type THackControl = class(TWinControl) end; + +procedure CalcPreferredSize(c: TControl; var w: integer; var h: integer); +begin + { this is the only reason why the project needs to be compiled without -CR + also known as in LPI XML. } + try + THackControl(c).CalculatePreferredSize(w, h, True); + except + on Exception + do + end; +end; + function ScaleInt(i: integer): integer; begin Result:=i*ScaleMultiplier div ScaleDivider; end; -type THackControl = class(TWinControl) end; - procedure AutoSizeForm(Form: TCustomForm); var i, ht, w, h: integer; @@ -87,7 +99,7 @@ procedure AutoSizeForm(Form: TCustomForm); TButtonPanel(C).HandleNeeded; w:=0; h:=0; - THackControl(C).CalculatePreferredSize(w, h, True); + CalcPreferredSize(c, w, h); end else h:=Height; @@ -174,7 +186,7 @@ procedure TBaseForm.DoScale(C: TControl); if C.Visible and (C is TCustomLabel) and C.AutoSize and (TLabel(C).Alignment = taLeftJustify) and (C.Anchors*[akLeft, akRight] = [akRight]) then begin w:=0; h:=0; - THackControl(C).CalculatePreferredSize(w, h, True); + CalcPreferredSize(C, w, h); C.Width:=w; end; {$ifdef darwin} @@ -182,7 +194,7 @@ procedure TBaseForm.DoScale(C: TControl); if C.Visible and (C is TCustomButton) then begin w:=0; h:=0; - THackControl(C).CalculatePreferredSize(w, h, True); + CalcPreferredSize(C, w, h); C.Height:=h; end; // Add extra top spacing for group box diff --git a/connoptions.lfm b/connoptions.lfm index e2debc50..a1455472 100644 --- a/connoptions.lfm +++ b/connoptions.lfm @@ -1,6 +1,6 @@ inherited ConnOptionsForm: TConnOptionsForm Left = 495 - Height = 394 + Height = 484 Top = 186 Width = 529 HorzScrollBar.Page = 349 @@ -9,7 +9,7 @@ inherited ConnOptionsForm: TConnOptionsForm BorderIcons = [biSystemMenu] BorderStyle = bsDialog Caption = 'Manage connections to Transmission' - ClientHeight = 394 + ClientHeight = 484 ClientWidth = 529 Constraints.MinHeight = 280 Constraints.MinWidth = 471 @@ -18,7 +18,7 @@ inherited ConnOptionsForm: TConnOptionsForm Position = poMainFormCenter object Page: TPageControl[0] Left = 8 - Height = 283 + Height = 372 Top = 69 Width = 513 ActivePage = tabConnection @@ -29,13 +29,13 @@ inherited ConnOptionsForm: TConnOptionsForm TabOrder = 1 object tabConnection: TTabSheet Caption = 'Transmission' - ClientHeight = 255 - ClientWidth = 505 + ClientHeight = 340 + ClientWidth = 509 object txPassword: TLabel Left = 24 Height = 15 Top = 157 - Width = 53 + Width = 61 Caption = 'Password:' ParentColor = False end @@ -43,7 +43,7 @@ inherited ConnOptionsForm: TConnOptionsForm Left = 24 Height = 15 Top = 128 - Width = 59 + Width = 70 Caption = 'User name:' ParentColor = False end @@ -51,7 +51,7 @@ inherited ConnOptionsForm: TConnOptionsForm Left = 8 Height = 15 Top = 76 - Width = 25 + Width = 28 Caption = 'Port:' ParentColor = False end @@ -59,7 +59,7 @@ inherited ConnOptionsForm: TConnOptionsForm Left = 8 Height = 15 Top = 48 - Width = 70 + Width = 80 Caption = 'Remote host:' ParentColor = False end @@ -67,7 +67,7 @@ inherited ConnOptionsForm: TConnOptionsForm Left = 180 Height = 23 Top = 153 - Width = 316 + Width = 320 Anchors = [akTop, akLeft, akRight] EchoMode = emPassword PasswordChar = '*' @@ -77,13 +77,13 @@ inherited ConnOptionsForm: TConnOptionsForm Left = 180 Height = 23 Top = 125 - Width = 316 + Width = 320 Anchors = [akTop, akLeft, akRight] TabOrder = 4 end object edPort: TSpinEdit Left = 180 - Height = 23 + Height = 24 Top = 73 Width = 70 MaxValue = 65535 @@ -93,9 +93,9 @@ inherited ConnOptionsForm: TConnOptionsForm end object cbSSL: TCheckBox Left = 260 - Height = 19 + Height = 21 Top = 77 - Width = 60 + Width = 74 Caption = 'Use SSL' OnClick = cbSSLClick TabOrder = 2 @@ -104,7 +104,7 @@ inherited ConnOptionsForm: TConnOptionsForm Left = 180 Height = 23 Top = 45 - Width = 316 + Width = 320 Anchors = [akTop, akLeft, akRight] OnChange = edHostChange TabOrder = 0 @@ -113,7 +113,7 @@ inherited ConnOptionsForm: TConnOptionsForm Left = 8 Height = 31 Top = 9 - Width = 488 + Width = 492 Anchors = [akTop, akLeft, akRight] AutoSize = False Caption = 'Please specify how %s will connect to a remote host running Transmission daemon (service).' @@ -122,9 +122,9 @@ inherited ConnOptionsForm: TConnOptionsForm end object cbAuth: TCheckBox Left = 8 - Height = 19 + Height = 21 Top = 101 - Width = 146 + Width = 167 Caption = 'Authentication required' OnClick = cbAuthClick TabOrder = 3 @@ -140,15 +140,15 @@ inherited ConnOptionsForm: TConnOptionsForm Left = 8 Height = 15 Top = 212 - Width = 52 + Width = 60 Caption = 'RPC path:' ParentColor = False end object cbShowAdvanced: TCheckBox Left = 8 - Height = 19 + Height = 21 Top = 232 - Width = 146 + Width = 168 Caption = 'Show advanced options' OnClick = cbShowAdvancedClick TabOrder = 8 @@ -156,9 +156,9 @@ inherited ConnOptionsForm: TConnOptionsForm end object cbAskPassword: TCheckBox Left = 180 - Height = 19 + Height = 21 Top = 181 - Width = 110 + Width = 128 Caption = 'Ask for password' OnClick = cbAskPasswordClick TabOrder = 6 @@ -176,7 +176,7 @@ inherited ConnOptionsForm: TConnOptionsForm Left = 8 Height = 15 Top = 245 - Width = 91 + Width = 105 Caption = 'Client Certificate:' ParentColor = False end @@ -191,7 +191,7 @@ inherited ConnOptionsForm: TConnOptionsForm Left = 8 Height = 15 Top = 274 - Width = 61 + Width = 71 Caption = 'Private Key:' ParentColor = False end @@ -207,13 +207,13 @@ inherited ConnOptionsForm: TConnOptionsForm end object tabProxy: TTabSheet Caption = 'Proxy' - ClientHeight = 255 - ClientWidth = 505 + ClientHeight = 340 + ClientWidth = 509 object txProxy: TLabel Left = 8 Height = 15 Top = 37 - Width = 67 + Width = 79 Caption = 'Proxy server:' ParentColor = False end @@ -221,7 +221,7 @@ inherited ConnOptionsForm: TConnOptionsForm Left = 8 Height = 15 Top = 65 - Width = 58 + Width = 66 Caption = 'Proxy port:' ParentColor = False end @@ -229,7 +229,7 @@ inherited ConnOptionsForm: TConnOptionsForm Left = 24 Height = 15 Top = 116 - Width = 91 + Width = 105 Caption = 'Proxy user name:' ParentColor = False end @@ -237,24 +237,24 @@ inherited ConnOptionsForm: TConnOptionsForm Left = 24 Height = 15 Top = 144 - Width = 86 + Width = 98 Caption = 'Proxy password:' ParentColor = False end object cbUseProxy: TCheckBox Left = 8 - Height = 19 + Height = 21 Top = 10 - Width = 250 + Width = 287 Caption = 'Connect to Transmission using proxy server' OnClick = cbUseProxyClick TabOrder = 0 end object cbUseSocks5: TCheckBox Left = 260 - Height = 19 + Height = 21 Top = 64 - Width = 65 + Width = 78 Caption = 'SOCKS 5' OnClick = cbUseProxyClick TabOrder = 3 @@ -263,13 +263,13 @@ inherited ConnOptionsForm: TConnOptionsForm Left = 180 Height = 23 Top = 34 - Width = 316 + Width = 320 Anchors = [akTop, akLeft, akRight] TabOrder = 1 end object edProxyPort: TSpinEdit Left = 180 - Height = 23 + Height = 24 Top = 62 Width = 70 MaxValue = 65535 @@ -281,7 +281,7 @@ inherited ConnOptionsForm: TConnOptionsForm Left = 180 Height = 23 Top = 113 - Width = 316 + Width = 320 Anchors = [akTop, akLeft, akRight] TabOrder = 4 end @@ -289,7 +289,7 @@ inherited ConnOptionsForm: TConnOptionsForm Left = 180 Height = 23 Top = 141 - Width = 316 + Width = 320 Anchors = [akTop, akLeft, akRight] EchoMode = emPassword PasswordChar = '*' @@ -297,9 +297,9 @@ inherited ConnOptionsForm: TConnOptionsForm end object cbProxyAuth: TCheckBox Left = 8 - Height = 19 + Height = 21 Top = 89 - Width = 146 + Width = 167 Caption = 'Authentication required' OnClick = cbProxyAuthClick TabOrder = 6 @@ -307,14 +307,14 @@ inherited ConnOptionsForm: TConnOptionsForm end object tabPaths: TTabSheet Caption = 'Paths' - ClientHeight = 255 - ClientWidth = 505 + ClientHeight = 340 + ClientWidth = 509 OnShow = tabPathsShow object txPaths: TLabel Left = 8 - Height = 60 + Height = 57 Top = 32 - Width = 488 + Width = 492 Anchors = [akTop, akLeft, akRight] Caption = 'Remote to local path mappings.'#13#10'Examples:'#13#10'/share=\\pch\share'#13#10'/var/downloads/music=Z:\music' ParentColor = False @@ -322,9 +322,9 @@ inherited ConnOptionsForm: TConnOptionsForm end object edPaths: TMemo Left = 8 - Height = 137 + Height = 222 Top = 96 - Width = 488 + Width = 492 Anchors = [akTop, akLeft, akRight, akBottom] ScrollBars = ssAutoVertical TabOrder = 0 @@ -332,7 +332,7 @@ inherited ConnOptionsForm: TConnOptionsForm end object edMaxFolder: TSpinEdit Left = 8 - Height = 23 + Height = 24 Top = 8 Width = 70 MaxValue = 99 @@ -343,7 +343,7 @@ inherited ConnOptionsForm: TConnOptionsForm object Label1: TLabel Left = 88 Height = 23 - Top = 9 + Top = 16 Width = 385 Anchors = [akLeft] AutoSize = False @@ -354,23 +354,23 @@ inherited ConnOptionsForm: TConnOptionsForm end object tabMisc: TTabSheet Caption = 'Misc' - ClientHeight = 255 - ClientWidth = 505 + ClientHeight = 340 + ClientWidth = 509 object gbSpeed: TGroupBox Left = 8 Height = 125 Top = 6 - Width = 488 + Width = 492 Anchors = [akTop, akLeft, akRight] Caption = 'Speed limit menu items' - ClientHeight = 105 - ClientWidth = 484 + ClientHeight = 125 + ClientWidth = 492 TabOrder = 0 object txDownSpeeds: TLabel Left = 8 Height = 15 Top = 4 - Width = 131 + Width = 150 Caption = 'Download speeds (KB/s):' ParentColor = False end @@ -378,7 +378,7 @@ inherited ConnOptionsForm: TConnOptionsForm Left = 8 Height = 15 Top = 52 - Width = 115 + Width = 132 Caption = 'Upload speeds (KB/s):' ParentColor = False end @@ -386,7 +386,7 @@ inherited ConnOptionsForm: TConnOptionsForm Left = 8 Height = 23 Top = 24 - Width = 468 + Width = 476 Anchors = [akTop, akLeft, akRight] TabOrder = 0 end @@ -394,16 +394,16 @@ inherited ConnOptionsForm: TConnOptionsForm Left = 8 Height = 23 Top = 72 - Width = 468 + Width = 476 Anchors = [akTop, akLeft, akRight] TabOrder = 1 end end object edTranslateForm: TCheckBox Left = 18 - Height = 19 + Height = 21 Top = 136 - Width = 444 + Width = 516 Caption = 'Activate the translated version of the application (need to restart the application)' OnChange = edTranslateFormChange TabOrder = 1 @@ -411,9 +411,9 @@ inherited ConnOptionsForm: TConnOptionsForm end object edTranslateMsg: TCheckBox Left = 18 - Height = 19 + Height = 21 Top = 160 - Width = 286 + Width = 331 Caption = 'Activate the translation of the Transmission strings' TabOrder = 2 Visible = False @@ -422,7 +422,7 @@ inherited ConnOptionsForm: TConnOptionsForm Left = 18 Height = 15 Top = 189 - Width = 55 + Width = 64 Caption = 'Language:' ParentColor = False Visible = False @@ -441,7 +441,7 @@ inherited ConnOptionsForm: TConnOptionsForm Left = 18 Height = 15 Top = 216 - Width = 58 + Width = 65 Caption = 'Config file:' ParentColor = False Visible = False @@ -460,8 +460,8 @@ inherited ConnOptionsForm: TConnOptionsForm end object Buttons: TButtonPanel[1] Left = 8 - Height = 26 - Top = 360 + Height = 27 + Top = 449 Width = 513 BorderSpacing.Left = 8 BorderSpacing.Top = 8 @@ -496,7 +496,7 @@ inherited ConnOptionsForm: TConnOptionsForm Left = 0 Height = 15 Top = 4 - Width = 98 + Width = 110 Caption = 'Connection name:' ParentColor = False end @@ -506,7 +506,7 @@ inherited ConnOptionsForm: TConnOptionsForm Top = 1 Width = 342 Anchors = [akTop, akLeft, akRight] - ItemHeight = 15 + ItemHeight = 23 OnSelect = cbConnectionSelect Style = csDropDownList TabOrder = 0 diff --git a/lineinfo2.pp b/lineinfo2.pp deleted file mode 100644 index 85dce2ee..00000000 --- a/lineinfo2.pp +++ /dev/null @@ -1,304 +0,0 @@ -{ - This file is part of the Free Pascal run time library. - Copyright (c) 2000 by Peter Vreman - - Stabs Line Info Retriever - - See the file COPYING.FPC, included in this distribution, - for details about the copyright. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. - - **********************************************************************} -{ - This unit should not be compiled in objfpc mode, since this would make it - dependent on objpas unit. -} -unit lineinfo2; -interface - -{$S-} -{$Q-} - -function GetLineInfo(addr:ptruint;var func,source:string;var line:longint) : boolean; - -implementation - -uses - exeinfo,strings; - -const - N_Function = $24; - N_TextLine = $44; - N_DataLine = $46; - N_BssLine = $48; - N_SourceFile = $64; - N_IncludeFile = $84; - - maxstabs = 40; { size of the stabs buffer } - -var - { GDB after 4.18 uses offset to function begin - in text section but OS/2 version still uses 4.16 PM } - StabsFunctionRelative: boolean; - -type - pstab=^tstab; - tstab=packed record - strpos : longint; - ntype : byte; - nother : byte; - ndesc : word; - nvalue : dword; - end; - -{ We use static variable so almost no stack is required, and is thus - more safe when an error has occured in the program } -var - e : TExeFile; - staberr : boolean = false; - stabcnt, { amount of stabs } - stablen, - stabofs, { absolute stab section offset in executable } - stabstrlen, - stabstrofs : longint; { absolute stabstr section offset in executable } - dirlength : longint; { length of the dirctory part of the source file } - stabs : array[0..maxstabs-1] of tstab; { buffer } - funcstab, { stab with current function info } - linestab, { stab with current line info } - dirstab, { stab with current directory info } - filestab : tstab; { stab with current file info } - filename, - dbgfn : string; - - -function OpenStabs(addr : pointer) : boolean; - var - baseaddr : pointer; -begin - OpenStabs:=false; - if staberr then - exit; - - GetModuleByAddr(addr,baseaddr,filename); -{$ifdef DEBUG_LINEINFO} - writeln(stderr,filename,' Baseaddr: ',hexstr(ptruint(baseaddr),sizeof(baseaddr)*2)); -{$endif DEBUG_LINEINFO} - - if not OpenExeFile(e,filename) then - exit; - if ReadDebugLink(e,dbgfn) then - begin - CloseExeFile(e); - if not OpenExeFile(e,dbgfn) then - exit; - end; - e.processaddress:=ptruint(baseaddr)-e.processaddress; - StabsFunctionRelative := E.FunctionRelative; - if FindExeSection(e,'.stab',stabofs,stablen) and - FindExeSection(e,'.stabstr',stabstrofs,stabstrlen) then - begin - stabcnt:=stablen div sizeof(tstab); - OpenStabs:=true; - end - else - begin - CloseExeFile(e); -// staberr:=true; - exit; - end; -end; - - -procedure CloseStabs; -begin - CloseExeFile(e); -end; - - -function GetLineInfo(addr:ptruint;var func,source:string;var line:longint) : boolean; -var - res, - stabsleft, - stabscnt,i : longint; - found : boolean; - lastfunc : tstab; -begin - GetLineInfo:=false; -{$ifdef DEBUG_LINEINFO} - writeln(stderr,'GetLineInfo called'); -{$endif DEBUG_LINEINFO} - fillchar(func,high(func)+1,0); - fillchar(source,high(source)+1,0); - line:=0; - if staberr then - exit; - if not e.isopen then - begin - if not OpenStabs(pointer(addr)) then - exit; - end; - - { correct the value to the correct address in the file } - { processaddress is set in OpenStabs } - addr := dword(addr - e.processaddress); - -{$ifdef DEBUG_LINEINFO} - writeln(stderr,'Addr: ',hexstr(addr,sizeof(addr)*2)); -{$endif DEBUG_LINEINFO} - - fillchar(funcstab,sizeof(tstab),0); - fillchar(filestab,sizeof(tstab),0); - fillchar(dirstab,sizeof(tstab),0); - fillchar(linestab,sizeof(tstab),0); - fillchar(lastfunc,sizeof(tstab),0); - found:=false; - seek(e.f,stabofs); - stabsleft:=stabcnt; - repeat - if stabsleft>maxstabs then - stabscnt:=maxstabs - else - stabscnt:=stabsleft; - blockread(e.f,stabs,stabscnt*sizeof(tstab),res); - stabscnt:=res div sizeof(tstab); - for i:=0 to stabscnt-1 do - begin - case stabs[i].ntype of - N_BssLine, - N_DataLine, - N_TextLine : - begin - if (stabs[i].ntype=N_TextLine) and StabsFunctionRelative then - inc(stabs[i].nvalue,lastfunc.nvalue); - if (stabs[i].nvalue<=addr) and - (stabs[i].nvalue>linestab.nvalue) then - begin - { if it's equal we can stop and take the last info } - if stabs[i].nvalue=addr then - found:=true - else - linestab:=stabs[i]; - end; - end; - N_Function : - begin - lastfunc:=stabs[i]; - if (stabs[i].nvalue<=addr) and - (stabs[i].nvalue>funcstab.nvalue) then - begin - funcstab:=stabs[i]; - fillchar(linestab,sizeof(tstab),0); - end; - end; - N_SourceFile, - N_IncludeFile : - begin - if (stabs[i].nvalue<=addr) and - (stabs[i].nvalue>=filestab.nvalue) then - begin - { if same value and type then the first one - contained the directory PM } - if (stabs[i].nvalue=filestab.nvalue) and - (stabs[i].ntype=filestab.ntype) then - dirstab:=filestab - else - fillchar(dirstab,sizeof(tstab),0); - filestab:=stabs[i]; - fillchar(linestab,sizeof(tstab),0); - { if new file then func is not valid anymore PM } - if stabs[i].ntype=N_SourceFile then - begin - fillchar(funcstab,sizeof(tstab),0); - fillchar(lastfunc,sizeof(tstab),0); - end; - end; - end; - end; - end; - dec(stabsleft,stabscnt); - until found or (stabsleft=0); - -{ get the line,source,function info } - line:=linestab.ndesc; - if dirstab.ntype<>0 then - begin - seek(e.f,stabstrofs+dirstab.strpos); - blockread(e.f,source[1],high(source)-1,res); - dirlength:=strlen(@source[1]); - source[0]:=chr(dirlength); - end - else - dirlength:=0; - if filestab.ntype<>0 then - begin - seek(e.f,stabstrofs+filestab.strpos); - blockread(e.f,source[dirlength+1],high(source)-(dirlength+1),res); - source[0]:=chr(strlen(@source[1])); - end; - if funcstab.ntype<>0 then - begin - seek(e.f,stabstrofs+funcstab.strpos); - blockread(e.f,func[1],high(func)-1,res); - func[0]:=chr(strlen(@func[1])); - i:=pos(':',func); - if i>0 then - Delete(func,i,255); - end; - if e.isopen then - CloseStabs; - GetLineInfo:=true; -end; - - -function StabBackTraceStr(addr:Pointer):shortstring; -var - func, - source : string; - hs : string[32]; - line : longint; - Store : TBackTraceStrFunc; - Success : boolean; -begin -{$ifdef DEBUG_LINEINFO} - writeln(stderr,'StabBackTraceStr called'); -{$endif DEBUG_LINEINFO} - { reset to prevent infinite recursion if problems inside the code PM } - Success:=false; - Store:=BackTraceStrFunc; - BackTraceStrFunc:=@SysBackTraceStr; - Success:=GetLineInfo(ptruint(addr),func,source,line); -{ create string } -{$ifdef netware} - { we need addr relative to code start on netware } - dec(addr,ptruint(system.NWGetCodeStart)); - StabBackTraceStr:=' CodeStart + $'+HexStr(ptruint(addr),sizeof(ptruint)*2); -{$else} - StabBackTraceStr:=' $'+HexStr(ptruint(addr),sizeof(ptruint)*2); -{$endif} - if func<>'' then - StabBackTraceStr:=StabBackTraceStr+' '+func; - if source<>'' then - begin - if func<>'' then - StabBackTraceStr:=StabBackTraceStr+', '; - if line<>0 then - begin - str(line,hs); - StabBackTraceStr:=StabBackTraceStr+' line '+hs; - end; - StabBackTraceStr:=StabBackTraceStr+' of '+source; - end; - if Success then - BackTraceStrFunc:=Store; -end; - -initialization -// BackTraceStrFunc:=@StabBackTraceStr; - -finalization - if e.isopen then - CloseStabs; -end. diff --git a/main.lfm b/main.lfm index 4c155571..1c9acef4 100644 --- a/main.lfm +++ b/main.lfm @@ -3809,7 +3809,6 @@ inherited MainForm: TMainForm end end object FilterTimer: TTimer[21] - Interval = 100 OnTimer = FilterTimerTimer Left = 76 Top = 28 diff --git a/main.pas b/main.pas index 8eb4f400..e4a82ed5 100644 --- a/main.pas +++ b/main.pas @@ -623,7 +623,6 @@ TMainForm = class(TBaseForm) procedure acUpdateGeoIPExecute(Sender: TObject); procedure acVerifyTorrentExecute(Sender: TObject); procedure ApplicationPropertiesEndSession(Sender: TObject); - procedure ApplicationPropertiesException(Sender: TObject; E: Exception); procedure ApplicationPropertiesIdle(Sender: TObject; var Done: Boolean); procedure ApplicationPropertiesMinimize(Sender: TObject); procedure ApplicationPropertiesRestore(Sender: TObject); @@ -724,7 +723,6 @@ TMainForm = class(TBaseForm) FFilesCapt: string; FCalcAvg: boolean; FPasswords: TStringList; - FAppProps:TApplicationProperties; procedure UpdateUI; procedure UpdateUIRpcVersion(RpcVersion: integer); @@ -1654,10 +1652,6 @@ procedure TMainForm.FormCreate(Sender: TObject); {$if FPC_FULlVERSION>=30101} AllowReuseOfLineInfoData:=false; {$endif} - FAppProps := TApplicationProperties.Create(Self); - FAppProps.OnException := @_onException; - FAppProps.CaptureExceptions := True; - Application.Title:=AppName + ' v' + AppVersion; Caption:=Application.Title; @@ -1831,7 +1825,6 @@ procedure TMainForm.FormCreate(Sender: TObject); acTrackerGrouping.Checked:=Ini.ReadBool('Interface', 'TrackerGrouping', True); FLinksFromClipboard:=Ini.ReadBool('Interface', 'LinksFromClipboard', True); Application.OnActivate:=@FormActivate; - Application.OnException:=@ApplicationPropertiesException; {$ifdef windows} FFileManagerDefault:=Ini.ReadString('Interface','FileManagerDefault','explorer.exe'); @@ -1920,8 +1913,10 @@ procedure TMainForm.FormCreate(Sender: TObject); Ini.WriteInteger('StatusBarPanels',IntToStr(i),Statusbar.Panels[i].Width); end; {$IF LCL_FULLVERSION >= 1080000} - PageInfo.Options := PageInfo.Options + [nboDoChangeOnSetIndex] + PageInfo.Options := PageInfo.Options + [nboDoChangeOnSetIndex]; {$ENDIF} + + FilterTimer.Interval := 100; end; procedure TMainForm.FormDestroy(Sender: TObject); @@ -4143,39 +4138,6 @@ procedure TMainForm.ApplicationPropertiesEndSession(Sender: TObject); BeforeCloseApp; end; -procedure TMainForm.ApplicationPropertiesException(Sender: TObject; E: Exception); -var - msg: string; -{$ifdef CALLSTACK} - sl: TStringList; -{$endif CALLSTACK} -begin - ForceAppNormal; - msg:=E.Message; -{$ifdef CALLSTACK} - try - sl:=TStringList.Create; - try - sl.Text:=GetLastExceptionCallStack; - Clipboard.AsText:=msg + LineEnding + sl.Text; - DebugLn(msg + LineEnding + sl.Text); - if sl.Count > 20 then begin - while sl.Count > 20 do - sl.Delete(20); - sl.Add('...'); - end; - msg:=msg + LineEnding + '---' + LineEnding + 'The error details has been copied to the clipboard.' + LineEnding + '---'; - msg:=msg + LineEnding + sl.Text; - finally - sl.Free; - end; - except - ; // suppress exception - end; -{$endif CALLSTACK} - MessageDlg(TranslateString(msg, True), mtError, [mbOK], 0); -end; - procedure TMainForm.ApplicationPropertiesIdle(Sender: TObject; var Done: Boolean); begin UpdateUI; diff --git a/transgui.lpi b/transgui.lpi index b381e71a..792948c5 100644 --- a/transgui.lpi +++ b/transgui.lpi @@ -540,12 +540,13 @@ - + + + - @@ -566,20 +567,4 @@ - - - - - - - - - - - - - - - - diff --git a/utils.pas b/utils.pas index 60dd648c..5f80a070 100644 --- a/utils.pas +++ b/utils.pas @@ -102,10 +102,6 @@ function CorrectPath (path: string): string; function Base32Decode(const s: ansistring): ansistring; -{$ifdef CALLSTACK} -function GetLastExceptionCallStack: string; -{$endif CALLSTACK} - {$ifdef mswindows} procedure AllowSetForegroundWindow(dwProcessId: DWORD); {$endif mswindows} @@ -113,9 +109,6 @@ procedure AllowSetForegroundWindow(dwProcessId: DWORD); implementation uses -{$ifdef CALLSTACK} - lineinfo2, -{$endif CALLSTACK} FileUtil, LazUTF8, LazFileUtils, StdCtrls, Graphics; function CorrectPath (path: string): string; // PETROV @@ -551,39 +544,6 @@ function GetCmdSwitchValue(const Switch: string): string; end; end; -{$ifdef CALLSTACK} -function GetLastExceptionCallStack: string; - - function GetAddrInfo(addr: pointer): string; - var - func, - source : shortstring; - line : longint; - begin - GetLineInfo(ptruint(addr), func, source, line); - Result:='$' + HexStr(ptruint(addr), sizeof(ptruint) * 2); - if func<>'' then - Result:=Result + ' ' + func; - if source<>'' then begin - if func<>'' then - Result:=Result + ', '; - if line<>0 then - Result:=Result + ' line ' + IntToStr(line); - Result:=Result + ' of ' + source; - end; - end; - -var - I: Integer; - Frames: PPointer; -begin - Result := GetAddrInfo(ExceptAddr); - Frames := ExceptFrames; - for I := 0 to ExceptFrameCount - 1 do - Result := Result + LineEnding + GetAddrInfo(Frames[I]); -end; -{$endif CALLSTACK} - procedure CenterOnParent(C: TControl); var R: TRect;