← Back to branch summary

~ubuntu-branches/ubuntu/dapper/fpc/dapper

« back to all changes in this revision

Viewing changes to ide/fpmdebug.inc

  • Committer: Bazaar Package Importer
  • Author(s): Carlos Laviola
  • Date: 2005-05-30 11:59:10 UTC
  • mfrom: (1.2.2 upstream)
  • Revision ID: james.westby@ubuntu.com-20050530115910-x5pbzm4qqta4i94h
Tags: 2.0.0-2
http://bugs.debian.org/310907
debian/fp-compiler.postinst.in: forgot to reapply the patch that
correctly creates the slave link to pc(1).  (Closes: #310907)

Show diffs side-by-side

added added

removed removed

Lines of Context:
ide/fpmdebug.inc
 
1
{
 
2
    $Id: fpmdebug.inc,v 1.10 2005/04/04 03:59:13 marco Exp $
 
3
    This file is part of the Free Pascal Integrated Development Environment
 
4
    Copyright (c) 1998 by Berczi Gabor
 
5
 
 
6
    Debug menu entries
 
7
 
 
8
    See the file COPYING.FPC, included in this distribution,
 
9
    for details about the copyright.
 
10
 
 
11
    This program is distributed in the hope that it will be useful,
 
12
    but WITHOUT ANY WARRANTY; without even the implied warranty of
 
13
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
14
 
 
15
 **********************************************************************}
 
16
 
 
17
{$ifdef SUPPORT_REMOTE}
 
18
function GetRemoteString : string;
 
19
var
 
20
  St : string;
 
21
begin
 
22
  St:=RemoteSendCommand;
 
23
  If RemoteConfig<>'' then
 
24
    ReplaceStrI(St,'$CONFIG','-F '+RemoteConfig)
 
25
  else
 
26
    ReplaceStrI(St,'$CONFIG','');
 
27
  If RemoteIdent<>'' then
 
28
    ReplaceStrI(St,'$IDENT','-i '+RemoteIdent)
 
29
  else
 
30
    ReplaceStrI(St,'$IDENT','');
 
31
  ReplaceStrI(St,'$LOCALFILE',GDBFileName(ExeFile));
 
32
  ReplaceStrI(St,'$REMOTEDIR',RemoteDir);
 
33
  ReplaceStrI(St,'$REMOTEMACHINE',RemoteMachine);
 
34
  GetRemoteString:=st;
 
35
end;
 
36
 
 
37
procedure TIDEApp.TransferRemote;
 
38
var
 
39
  S,SendCommand : string;
 
40
  Executed : boolean;
 
41
begin
 
42
  SendCommand:=GetRemoteString;
 
43
  if SendCommand<>'' then
 
44
    begin
 
45
      s:='scp'+exeext;
 
46
      if LocateExeFile(s) then
 
47
        Executed:=DoExecute(s,SendCommand,'','','',exNormal)
 
48
      else
 
49
        Executed:=DoExecute('scp',SendCommand,'','','',exNormal);
 
50
      if Executed then
 
51
        begin
 
52
         if (DosError<>0) or (DosExitCode<>0) then
 
53
          ErrorBox(#3'Execution of'#13#3+s+' '+SendCommand+#13#3+
 
54
            'returned ('+inttostr(DosError)+','+inttostr(DosExitCode)+')',nil);
 
55
        end
 
56
      else
 
57
        ErrorBox(#3'Unable to execute'#13#3+s+' '+SendCommand,nil);
 
58
 
 
59
    end
 
60
  else
 
61
    ErrorBox(#3'Unable to transfer executable',nil);
 
62
end;
 
63
{$endif SUPPORT_REMOTE}
 
64
 
 
65
procedure TIDEApp.DoUserScreenWindow;
 
66
begin
 
67
  if UserScreenWindow=nil then
 
68
    begin
 
69
     New(UserScreenWindow, Init(UserScreen, SearchFreeWindowNo));
 
70
     Desktop^.Insert(UserScreenWindow);
 
71
    end;
 
72
  UserScreenWindow^.MakeFirst;
 
73
end;
 
74
 
 
75
procedure TIDEApp.DoCloseUserScreenWindow;
 
76
begin
 
77
  if Assigned(UserScreenWindow) then
 
78
    Message(UserScreenWindow,evCommand,cmClose,nil);
 
79
end;
 
80
 
 
81
procedure TIDEApp.DoUserScreen;
 
82
var Event : TEvent;
 
83
    ev    : TMouseEvent;
 
84
    Clear : Boolean;
 
85
begin
 
86
  if UserScreen=nil then
 
87
   begin
 
88
     ErrorBox(msg_userscreennotavailable,nil);
 
89
     Exit;
 
90
   end;
 
91
 
 
92
  ShowUserScreen;
 
93
 
 
94
  InitKeyBoard;
 
95
  if UseMouse Then
 
96
    InitMouse;
 
97
  repeat
 
98
    repeat
 
99
      Drivers.GetKeyEvent(Event);
 
100
      if (Event.What and EvKeyboard)=evNothing then
 
101
        Begin
 
102
          If UseMouse Then
 
103
            Begin  
 
104
              Drivers.GetMouseEvent(Event);
 
105
              if (Event.What and evMouse)=evNothing then
 
106
               GiveUpTimeSlice
 
107
              else
 
108
                Event.what:=evMouse;
 
109
            End;
 
110
        End
 
111
      else
 
112
        Event.what:=evkeyboard;
 
113
    until Event.What in [evKeyboard,evmouse];
 
114
    if event.what=evmouse then
 
115
      Clear:=false
 
116
    else
 
117
      begin
 
118
        Clear:=true;
 
119
        if not UserScreen^.CanScroll then
 
120
          Clear:=false
 
121
       else
 
122
        case Event.keycode of
 
123
          kbPgUp : UserScreen^.Scroll(-20);
 
124
          kbPgDn : UserScreen^.Scroll(20);
 
125
          kbUp : UserScreen^.Scroll(-1);
 
126
          kbDown : UserScreen^.Scroll(1);
 
127
          kbHome : UserScreen^.Scroll(-1024);
 
128
          kbEnd : UserScreen^.Scroll(+1024);
 
129
        else
 
130
           Clear:=false;
 
131
        end;
 
132
      end;
 
133
    if Clear then
 
134
      ClearEvent(Event);
 
135
  until Event.what in [evKeyboard,evmouse];
 
136
  while (Keyboard.PollKeyEvent<>0) do
 
137
          Keyboard.GetKeyEvent;
 
138
  if UseMouse Then
 
139
    Begin
 
140
     while PollMouseEvent(Ev) do
 
141
       GetMouseEvent(ev);
 
142
     donemouse;
 
143
    End;
 
144
  DoneKeyboard;
 
145
 
 
146
  ShowIDEScreen;
 
147
end;
 
148
 
 
149
procedure TIDEApp.DoShowCallStack;
 
150
begin
 
151
{$ifdef NODEBUG}
 
152
  NoDebugger;
 
153
{$else}
 
154
  If not assigned(StackWindow) then
 
155
    InitStackWindow
 
156
  else
 
157
    StackWindow^.MakeFirst;
 
158
{$endif NODEBUG}
 
159
end;
 
160
 
 
161
 
 
162
procedure TIDEApp.DoShowDisassembly;
 
163
begin
 
164
{$ifdef NODEBUG}
 
165
  NoDebugger;
 
166
{$else}
 
167
  If not assigned(DisassemblyWindow) then
 
168
    InitDisassemblyWindow
 
169
  else
 
170
    DisassemblyWindow^.MakeFirst;
 
171
  DisassemblyWindow^.LoadFunction('');
 
172
{$endif NODEBUG}
 
173
end;
 
174
 
 
175
 
 
176
procedure TIDEApp.DoShowRegisters;
 
177
begin
 
178
{$ifdef NODEBUG}
 
179
  NoDebugger;
 
180
{$else}
 
181
  If not assigned(RegistersWindow) then
 
182
    InitRegistersWindow
 
183
  else
 
184
    RegistersWindow^.MakeFirst;
 
185
{$endif NODEBUG}
 
186
end;
 
187
 
 
188
procedure TIDEApp.DoShowFPU;
 
189
begin
 
190
{$ifdef NODEBUG}
 
191
  NoDebugger;
 
192
{$else}
 
193
  If not assigned(FPUWindow) then
 
194
    InitFPUWindow
 
195
  else
 
196
    FPUWindow^.MakeFirst;
 
197
{$endif NODEBUG}
 
198
end;
 
199
 
 
200
 
 
201
procedure TIDEApp.DoShowVector;
 
202
begin
 
203
{$ifdef NODEBUG}
 
204
  NoDebugger;
 
205
{$else}
 
206
  If not assigned(VectorWindow) then
 
207
    InitVectorWindow
 
208
  else
 
209
    VectorWindow^.MakeFirst;
 
210
{$endif NODEBUG}
 
211
end;
 
212
 
 
213
procedure TIDEApp.DoShowBreakpointList;
 
214
begin
 
215
{$ifdef NODEBUG}
 
216
  NoDebugger;
 
217
{$else}
 
218
  If assigned(BreakpointsWindow) then
 
219
    begin
 
220
      BreakpointsWindow^.Update;
 
221
      BreakpointsWindow^.Show;
 
222
      BreakpointsWindow^.MakeFirst;
 
223
    end
 
224
  else
 
225
    begin
 
226
      New(BreakpointsWindow,Init);
 
227
      Desktop^.Insert(BreakpointsWindow);
 
228
    end;
 
229
{$endif NODEBUG}
 
230
end;
 
231
 
 
232
procedure TIDEApp.DoShowWatches;
 
233
begin
 
234
{$ifdef NODEBUG}
 
235
  NoDebugger;
 
236
{$else}
 
237
  If assigned(WatchesWindow) then
 
238
    begin
 
239
      WatchesWindow^.Update;
 
240
      WatchesWindow^.MakeFirst;
 
241
    end
 
242
  else
 
243
    begin
 
244
      New(WatchesWindow,Init);
 
245
      Desktop^.Insert(WatchesWindow);
 
246
    end;
 
247
{$endif NODEBUG}
 
248
end;
 
249
 
 
250
procedure TIDEApp.DoAddWatch;
 
251
{$ifdef NODEBUG}
 
252
begin
 
253
  NoDebugger;
 
254
end;
 
255
{$else}
 
256
var
 
257
  P: PWatch;
 
258
  EditorWindow : PSourceWindow;
 
259
  EditorWasFirst : boolean;
 
260
  S : string;
 
261
begin
 
262
  EditorWindow:=FirstEditorWindow;
 
263
  { Leave the editor first, but only if there was already an WatchesWindow }
 
264
  EditorWasFirst:=(PWindow(Desktop^.First)=PWindow(EditorWindow)) and
 
265
                  assigned(WatchesWindow);
 
266
  If assigned(EditorWindow) then
 
267
    S:={LowerCaseStr(}EditorWindow^.Editor^.GetCurrentWord
 
268
  else
 
269
    S:='';
 
270
  P:=New(PWatch,Init(S));
 
271
  if ExecuteDialog(New(PWatchItemDialog,Init(P)),nil)<>cmCancel then
 
272
    begin
 
273
      WatchesCollection^.Insert(P);
 
274
      WatchesCollection^.Update;
 
275
      DoShowWatches;
 
276
      if EditorWasFirst then
 
277
       EditorWindow^.MakeFirst;
 
278
    end
 
279
  else
 
280
    dispose(P,Done);
 
281
end;
 
282
{$endif NODEBUG}
 
283
 
 
284
{
 
285
  $Log: fpmdebug.inc,v $
 
286
  Revision 1.10  2005/04/04 03:59:13  marco
 
287
   * fix for 3194: Use mouse to exit output screen
 
288
 
 
289
  Revision 1.9  2005/02/14 17:13:18  peter
 
290
    * truncate log
 
291
 
 
292
  Revision 1.8  2005/01/08 11:43:18  florian
 
293
    + vector unit window
 
294
 
 
295
  Revision 1.7  2005/01/07 21:52:23  florian
 
296
    * proper stepping in disassembler window now possible
 
297
    + disassembler window to menu added
 
298
 
 
299
}