← Back to branch summary

~ubuntu-branches/debian/lenny/fpc/lenny

« back to all changes in this revision

Viewing changes to fpcsrc/ide/fpmdebug.inc

  • Committer: Bazaar Package Importer
  • Author(s): Mazen Neifer, Torsten Werner, Mazen Neifer
  • Date: 2008-05-17 17:12:11 UTC
  • mfrom: (3.1.9 intrepid)
  • Revision ID: james.westby@ubuntu.com-20080517171211-9qi33xhd9evfa0kg
Tags: 2.2.0-dfsg1-9
http://bugs.debian.org/477743
[ Torsten Werner ]
* Add Mazen Neifer to Uploaders field.

[ Mazen Neifer ]
* Moved FPC sources into a version dependent directory from /usr/share/fpcsrc
  to /usr/share/fpcsrc/${FPCVERSION}. This allow installing more than on FPC
  release.
* Fixed far call issue in compiler preventing building huge binearies.
  (closes: #477743)
* Updated building dependencies, recomennded and suggested packages.
* Moved fppkg to fp-utils as it is just a helper tool and is not required by
  compiler.

Show diffs side-by-side

added added

removed removed

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