diff --git a/debugger/cmdlinedebugger.pp b/debugger/cmdlinedebugger.pp index a8906a475f..3111137942 100644 --- a/debugger/cmdlinedebugger.pp +++ b/debugger/cmdlinedebugger.pp @@ -96,6 +96,7 @@ var n, R, Max, Count: Integer; TimeOut: Integer; FDSWait, FDS: TFDSet; + Step: Integer; begin Result := 0; Max := 0; @@ -120,6 +121,7 @@ begin end; // wait for all handles + Step:=0; repeat FDSWait := FDS; TimeOut := 10; @@ -127,6 +129,11 @@ begin // R = -1 on error, 0 on timeout, >0 on success and is number of handles // FDSWait is changed, and indicates what descriptors have changed R := FpSelect(Max + 1, @FDSWait, nil, nil, TimeOut); + inc(Step); + if Step=50 then begin + Step:=0; + Application.Idle(false); + end; Application.ProcessMessages; if Application.Terminated then Break; until R <> 0; diff --git a/debugger/watchesdlg.lfm b/debugger/watchesdlg.lfm index ed039c4e8b..8308e73e82 100644 --- a/debugger/watchesdlg.lfm +++ b/debugger/watchesdlg.lfm @@ -1,7 +1,12 @@ object WatchesDlg: TWatchesDlg + ActiveControl = lvWatches Caption = 'Watch list' ClientHeight = 200 ClientWidth = 500 + OnClose = FormClose + OnCloseQuery = FormCloseQuery + OnCreate = FormCreate + OnDestroy = FormDestroy PixelsPerInch = 112 HorzScrollBar.Page = 499 VertScrollBar.Page = 199 diff --git a/debugger/watchesdlg.lrs b/debugger/watchesdlg.lrs index 161c22cfa8..a5c85d9e7a 100644 --- a/debugger/watchesdlg.lrs +++ b/debugger/watchesdlg.lrs @@ -1,24 +1,26 @@ { This is an automatically generated lazarus resource file } LazarusResources.Add('TWatchesDlg','FORMDATA',[ - 'TPF0'#11'TWatchesDlg'#10'WatchesDlg'#7'Caption'#6#10'Watch list'#12'ClientHe' - +'ight'#3#200#0#11'ClientWidth'#3#244#1#13'PixelsPerInch'#2'p'#18'HorzScrollB' - +'ar.Page'#3#243#1#18'VertScrollBar.Page'#3#199#0#4'Left'#3':'#1#6'Height'#3 - +#200#0#3'Top'#3#182#1#5'Width'#3#244#1#0#9'TListView'#9'lvWatches'#5'Align'#7 - +#8'alClient'#7'Columns'#14#1#7'Caption'#6#10'Expression'#5'Width'#2#10#0#1#7 - +'Caption'#6#5'Value'#5'Width'#2#10#0#0#11'MultiSelect'#9#9'PopupMenu'#7#8'mn' - +'uPopup'#9'RowSelect'#9#9'ViewStyle'#7#8'vsReport'#10'OnDblClick'#7#17'lvWat' - +'chesDblClick'#11'OnMouseDown'#7#18'lvWatchesMouseDown'#9'OnKeyDown'#7#16'lv' - +'WatchesKeyDown'#12'OnSelectItem'#7#19'lvWatchesSelectItem'#6'Height'#3#200#0 - +#5'Width'#3#244#1#0#0#10'TPopupMenu'#8'mnuPopup'#4'left'#2'd'#3'top'#2'`'#0#9 - +'TMenuItem'#6'popAdd'#7'Caption'#6#4'&Add'#7'OnClick'#7#11'popAddClick'#0#0#9 - +'TMenuItem'#2'N1'#7'Caption'#6#1'-'#0#0#9'TMenuItem'#13'popProperties'#7'Cap' - +'tion'#6#11'&Properties'#7'OnClick'#7#18'popPropertiesClick'#0#0#9'TMenuItem' - +#10'popEnabled'#7'Caption'#6#8'&Enabled'#7'OnClick'#7#15'popEnabledClick'#0#0 - +#9'TMenuItem'#9'popDelete'#7'Caption'#6#7'&Delete'#7'OnClick'#7#14'popDelete' - +'Click'#0#0#9'TMenuItem'#2'N2'#7'Caption'#6#1'-'#0#0#9'TMenuItem'#13'popDisa' - +'bleAll'#7'Caption'#6#12'D&isable All'#7'OnClick'#7#18'popDisableAllClick'#0 - +#0#9'TMenuItem'#12'popEnableAll'#7'Caption'#6#11'E&nable All'#7'OnClick'#7#17 - +'popEnableAllClick'#0#0#9'TMenuItem'#12'popDeleteAll'#7'Caption'#6#11'De&let' - +'e All'#7'OnClick'#7#17'popDeleteAllClick'#0#0#0#0 + 'TPF0'#11'TWatchesDlg'#10'WatchesDlg'#13'ActiveControl'#7#9'lvWatches'#7'Capt' + +'ion'#6#10'Watch list'#12'ClientHeight'#3#200#0#11'ClientWidth'#3#244#1#7'On' + +'Close'#7#9'FormClose'#12'OnCloseQuery'#7#14'FormCloseQuery'#8'OnCreate'#7#10 + +'FormCreate'#9'OnDestroy'#7#11'FormDestroy'#13'PixelsPerInch'#2'p'#18'HorzSc' + +'rollBar.Page'#3#243#1#18'VertScrollBar.Page'#3#199#0#4'Left'#3':'#1#6'Heigh' + +'t'#3#200#0#3'Top'#3#182#1#5'Width'#3#244#1#0#9'TListView'#9'lvWatches'#5'Al' + +'ign'#7#8'alClient'#7'Columns'#14#1#7'Caption'#6#10'Expression'#5'Width'#2#10 + +#0#1#7'Caption'#6#5'Value'#5'Width'#2#10#0#0#11'MultiSelect'#9#9'PopupMenu'#7 + +#8'mnuPopup'#9'RowSelect'#9#9'ViewStyle'#7#8'vsReport'#10'OnDblClick'#7#17'l' + +'vWatchesDblClick'#11'OnMouseDown'#7#18'lvWatchesMouseDown'#9'OnKeyDown'#7#16 + +'lvWatchesKeyDown'#12'OnSelectItem'#7#19'lvWatchesSelectItem'#6'Height'#3#200 + +#0#5'Width'#3#244#1#0#0#10'TPopupMenu'#8'mnuPopup'#4'left'#2'd'#3'top'#2'`'#0 + +#9'TMenuItem'#6'popAdd'#7'Caption'#6#4'&Add'#7'OnClick'#7#11'popAddClick'#0#0 + +#9'TMenuItem'#2'N1'#7'Caption'#6#1'-'#0#0#9'TMenuItem'#13'popProperties'#7'C' + +'aption'#6#11'&Properties'#7'OnClick'#7#18'popPropertiesClick'#0#0#9'TMenuIt' + +'em'#10'popEnabled'#7'Caption'#6#8'&Enabled'#7'OnClick'#7#15'popEnabledClick' + +#0#0#9'TMenuItem'#9'popDelete'#7'Caption'#6#7'&Delete'#7'OnClick'#7#14'popDe' + +'leteClick'#0#0#9'TMenuItem'#2'N2'#7'Caption'#6#1'-'#0#0#9'TMenuItem'#13'pop' + +'DisableAll'#7'Caption'#6#12'D&isable All'#7'OnClick'#7#18'popDisableAllClic' + +'k'#0#0#9'TMenuItem'#12'popEnableAll'#7'Caption'#6#11'E&nable All'#7'OnClick' + +#7#17'popEnableAllClick'#0#0#9'TMenuItem'#12'popDeleteAll'#7'Caption'#6#11'D' + +'e&lete All'#7'OnClick'#7#17'popDeleteAllClick'#0#0#0#0 ]); diff --git a/debugger/watchesdlg.pp b/debugger/watchesdlg.pp index 698760358a..0de87012e4 100644 --- a/debugger/watchesdlg.pp +++ b/debugger/watchesdlg.pp @@ -38,14 +38,15 @@ unit WatchesDlg; interface uses - Classes, SysUtils, Forms, Controls, Graphics, Dialogs, LResources, StdCtrls, - Buttons, Menus, ComCtrls, Debugger, DebuggerDlg, BaseDebugManager, LCLtype; + Classes, SysUtils, LCLProc, Forms, Controls, Graphics, Dialogs, LResources, + StdCtrls, Buttons, Menus, ComCtrls, LCLType, + Debugger, DebuggerDlg, BaseDebugManager; type -{ TWatchesDlg } + { TWatchesDlg } -TWatchesDlg = class(TDebuggerDlg) + TWatchesDlg = class(TDebuggerDlg) lvWatches: TListView; mnuPopup: TPopupMenu; popAdd: TMenuItem; @@ -57,6 +58,10 @@ TWatchesDlg = class(TDebuggerDlg) popDisableAll: TMenuItem; popEnableAll: TMenuItem; popDeleteAll: TMenuItem; + procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); + procedure FormCloseQuery(Sender: TObject; var CanClose: boolean); + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); procedure lvWatchesDblClick(Sender: TObject); procedure lvWatchesKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); @@ -97,28 +102,25 @@ implementation constructor TWatchesDlg.Create(AOwner: TComponent); begin inherited Create(AOwner); -// Name:='WatchesDlg'; FWatchesNotification := TIDEWatchesNotification.Create; FWatchesNotification.AddReference; FWatchesNotification.OnAdd := @WatchAdd; FWatchesNotification.OnUpdate := @WatchUpdate; FWatchesNotification.OnRemove := @WatchRemove; -{$IFDEF WIN32} - {$NOTE TODO repair TListView column widths and remove this hack} lvWatches.Column[0].Width := 100; lvWatches.Column[1].Width := 200; -{$ENDIF WIN32} end; destructor TWatchesDlg.Destroy; begin + //DebugLn('TWatchesDlg.Destroy ',DbgSName(Self)); SetWatches(nil); FWatchesNotification.OnAdd := nil; FWatchesNotification.OnUpdate := nil; FWatchesNotification.OnRemove := nil; FWatchesNotification.ReleaseReference; - inherited; + inherited Destroy; end; function TWatchesDlg.GetSelected: TIDEWatch; @@ -191,6 +193,25 @@ begin popAddClick(Sender); end; +procedure TWatchesDlg.FormCreate(Sender: TObject); +begin +end; + +procedure TWatchesDlg.FormDestroy(Sender: TObject); +begin + //DebugLn('TWatchesDlg.FormDestroy ',DbgSName(Self)); +end; + +procedure TWatchesDlg.FormCloseQuery(Sender: TObject; var CanClose: boolean); +begin + //DebugLn('TWatchesDlg.FormCloseQuery ',dbgs(CanClose)); +end; + +procedure TWatchesDlg.FormClose(Sender: TObject; var CloseAction: TCloseAction); +begin + //DebugLn('TWatchesDlg.FormClose ',dbgs(ord(CloseAction))); +end; + procedure TWatchesDlg.lvWatchesKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin diff --git a/lcl/forms.pp b/lcl/forms.pp index 6dd9157d7c..fc7e8e55f8 100644 --- a/lcl/forms.pp +++ b/lcl/forms.pp @@ -899,7 +899,7 @@ type FOnShortcut: TShortcutEvent; FOnShowHint: TShowHintEvent; FOnUserInput: TOnUserInputEvent; - FReleaseComponents: TList; + FReleaseComponents: TFPList; FShowHint: Boolean; FShowMainForm: Boolean; procedure DoOnIdleEnd; @@ -908,7 +908,6 @@ type function GetIconHandle: HICON; function GetTitle: string; procedure IconChanged(Sender: TObject); - procedure Idle; function InvokeHelp(Command: Word; Data: Longint): Boolean; function GetControlAtMouse: TControl; procedure SetNavigation(const AValue: TApplicationNavigationOptions); @@ -973,6 +972,7 @@ type procedure Minimize; procedure Notification(AComponent: TComponent; Operation: TOperation); override; Procedure ProcessMessages; + Procedure Idle(Wait: Boolean); procedure Run; procedure ShowException(E: Exception); override; procedure Terminate; override; diff --git a/lcl/include/application.inc b/lcl/include/application.inc index 3f5dd75aed..1945d24d1c 100644 --- a/lcl/include/application.inc +++ b/lcl/include/application.inc @@ -247,6 +247,41 @@ end; procedure TApplication.ProcessMessages; begin WidgetSet.AppProcessMessages; + DoFreeReleaseComponents; +end; + +{------------------------------------------------------------------------------ + Method: TApplication.Idle + Params: Wait: wait till something happens + Returns: Nothing + + Invoked when the application enters the idle state + ------------------------------------------------------------------------------} +procedure TApplication.Idle(Wait: boolean); +var + Done: Boolean; +begin + DoFreeReleaseComponents; + MouseIdle(GetControlAtMouse); + + Done := True; + if (FIdleLockCount=0) then begin + if Assigned(FOnIdle) then FOnIdle(Self, Done); + NotifyIdleHandler; + end; + if Done + then begin + // wait till something happens + if (FIdleLockCount=0) then + DoIdleActions; + Include(FFlags,AppWaiting); + Exclude(FFlags,AppIdleEndSent); + if Wait then + WidgetSet.AppWaitMessage; + if (FIdleLockCount=0) then + DoOnIdleEnd; + Exclude(FFlags,AppWaiting); + end; end; {------------------------------------------------------------------------------ @@ -321,40 +356,6 @@ begin end; end; -{------------------------------------------------------------------------------ - Method: TApplication.Idle - Params: None - Returns: Nothing - - Invoked when the application enters the idle state - ------------------------------------------------------------------------------} -procedure TApplication.Idle; -var - Done: Boolean; -begin - if FIdleLockCount=0 then - DoFreeReleaseComponents; - MouseIdle(GetControlAtMouse); - - Done := True; - if (FIdleLockCount=0) then begin - if Assigned(FOnIdle) then FOnIdle(Self, Done); - NotifyIdleHandler; - end; - if Done - then begin - // wait till something happens - if (FIdleLockCount=0) then - DoIdleActions; - Include(FFlags,AppWaiting); - Exclude(FFlags,AppIdleEndSent); - WidgetSet.AppWaitMessage; - if (FIdleLockCount=0) then - DoOnIdleEnd; - Exclude(FFlags,AppWaiting); - end; -end; - {------------------------------------------------------------------------------ function TApplication.InvokeHelp(Command: Word; Data: Longint): Boolean; ------------------------------------------------------------------------------} @@ -786,6 +787,7 @@ begin if FReleaseComponents=nil then exit; while FReleaseComponents.Count>0 do begin AComponent:=TComponent(FReleaseComponents[0]); + //DebugLn('TApplication.DoFreeReleaseComponents ',DbgSName(AComponent)); FReleaseComponents.Delete(0); AComponent.Free; end; @@ -847,7 +849,6 @@ end; Params: Sender Returns: Nothing - Handles all messages first then the Idle ------------------------------------------------------------------------------} procedure TApplication.HandleException(Sender: TObject); @@ -896,7 +897,7 @@ end; procedure TApplication.HandleMessage; begin WidgetSet.AppProcessMessages; // process all events - if not Terminated then Idle; + if not Terminated then Idle(true); end; {------------------------------------------------------------------------------ @@ -955,7 +956,7 @@ begin for i:=0 to Screen.CustomFormCount-1 do begin AForm:=Screen.CustomForms[i]; if AForm.FormStyle in fsAllStayOnTop then begin - DebugLn('TApplication.HideAllFormsWithStayOnTop ',AForm.Name,':',AForm.ClassName); + //DebugLn('TApplication.HideAllFormsWithStayOnTop ',AForm.Name,':',AForm.ClassName); AForm.Hide; end; end; @@ -1536,7 +1537,7 @@ begin if AppDoNotReleaseComponents in FFlags then raise Exception.Create('TApplication.ReleaseComponent already shut down'); if FReleaseComponents=nil then - FReleaseComponents:=TList.Create; + FReleaseComponents:=TFPList.Create; if FReleaseComponents.IndexOf(AComponent)<0 then FReleaseComponents.Add(AComponent); end; diff --git a/lcl/include/customform.inc b/lcl/include/customform.inc index 907ea909a2..d068325a59 100644 --- a/lcl/include/customform.inc +++ b/lcl/include/customform.inc @@ -634,6 +634,7 @@ begin i:=FFormHandlers[fhtClose].Count; while FFormHandlers[fhtClose].NextDownIndex(i) do TCloseEvent(FFormHandlers[fhtClose][i])(Self,CloseAction); + //DebugLn('TCustomForm.DoClose ',DbgSName(Self),' ',dbgs(ord(CloseAction))); end; {------------------------------------------------------------------------------ @@ -1343,6 +1344,7 @@ begin if fsModal in FFormState then ModalResult := mrCancel else begin + DebugLn('TCustomForm.Close A ',DbgSName(Self)); if CloseQuery then begin if FormStyle = fsMDIChild then begin @@ -1353,8 +1355,10 @@ begin end else begin CloseAction := caHide; end; + DebugLn('TCustomForm.Close B ',DbgSName(Self)); DoClose(CloseAction); if CloseAction <> caNone then begin + DebugLn('TCustomForm.Close C ',DbgSName(Self),' ',dbgs(ord(CloseAction))); if Application.MainForm = Self then Application.Terminate else if CloseAction = caHide then Hide else if CloseAction = caMinimize then WindowState := wsMinimized @@ -1839,7 +1843,7 @@ begin CloseModal; if ModalResult<>0 then break; end; - Application.Idle; + Application.Idle(true); until false; Result := ModalResult;