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

« back to all changes in this revision

Viewing changes to ide/fpviews.pas

  • 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
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:
 
1
{
 
2
    $Id: fpviews.pas,v 1.59 2005/03/07 17:16:56 peter Exp $
 
3
    This file is part of the Free Pascal Integrated Development Environment
 
4
    Copyright (c) 1998 by Berczi Gabor
 
5
 
 
6
    Views and view-related functions for the IDE
 
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
unit FPViews;
 
17
 
 
18
{$i globdir.inc}
 
19
 
 
20
interface
 
21
 
 
22
uses
 
23
  Dos,Objects,Drivers,
 
24
  FVConsts,
 
25
  Views,Menus,Dialogs,App,Gadgets,Tabs,
 
26
  ASCIITAB,
 
27
  WEditor,WCEdit,
 
28
  WUtils,WHelp,WHlpView,WViews,WANSI,
 
29
  Comphook,
 
30
  FPConst,FPUsrScr;
 
31
 
 
32
type
 
33
    TEditor = TCodeEditor;
 
34
    PEditor = PCodeEditor;
 
35
 
 
36
    PStoreCollection = ^TStoreCollection;
 
37
    TStoreCollection = object(TStringCollection)
 
38
      function Add(const S: string): PString;
 
39
    end;
 
40
 
 
41
    PIntegerLine = ^TIntegerLine;
 
42
    TIntegerLine = object(TInputLine)
 
43
      constructor Init(var Bounds: TRect; AMin, AMax: longint);
 
44
    end;
 
45
 
 
46
    PFPHeapView = ^TFPHeapView;
 
47
    TFPHeapView = object(THeapView)
 
48
      constructor Init(var Bounds: TRect);
 
49
      constructor InitKb(var Bounds: TRect);
 
50
      procedure   HandleEvent(var Event: TEvent); virtual;
 
51
    end;
 
52
 
 
53
    PFPClockView = ^TFPClockView;
 
54
    TFPClockView = object(TClockView)
 
55
      constructor Init(var Bounds: TRect);
 
56
      procedure   HandleEvent(var Event: TEvent); virtual;
 
57
      function    GetPalette: PPalette; virtual;
 
58
    end;
 
59
 
 
60
    PFPWindow = ^TFPWindow;
 
61
    TFPWindow = object(TWindow)
 
62
      AutoNumber: boolean;
 
63
      procedure   HandleEvent(var Event: TEvent); virtual;
 
64
      procedure   SetState(AState: Word; Enable: Boolean); virtual;
 
65
      procedure   UpdateCommands; virtual;
 
66
      constructor Load(var S: TStream);
 
67
      procedure   Store(var S: TStream);
 
68
      procedure   Update; virtual;
 
69
      procedure   SelectInDebugSession;
 
70
    end;
 
71
 
 
72
    PFPHelpViewer = ^TFPHelpViewer;
 
73
    TFPHelpViewer = object(THelpViewer)
 
74
      function    GetLocalMenu: PMenu; virtual;
 
75
      function    GetCommandTarget: PView; virtual;
 
76
    end;
 
77
 
 
78
    PFPHelpWindow = ^TFPHelpWindow;
 
79
    TFPHelpWindow = object(THelpWindow)
 
80
      constructor Init(var Bounds: TRect; ATitle: TTitleStr; ASourceFileID: word; AContext: THelpCtx; ANumber: Integer);
 
81
      destructor  Done;virtual;
 
82
      procedure   InitHelpView; virtual;
 
83
      procedure   Show; {virtual;}
 
84
      procedure   Hide; {virtual;}
 
85
      procedure   HandleEvent(var Event: TEvent); virtual;
 
86
      function    GetPalette: PPalette; virtual;
 
87
      constructor Load(var S: TStream);
 
88
      procedure   Store(var S: TStream);
 
89
    end;
 
90
 
 
91
    PTextScroller = ^TTextScroller;
 
92
    TTextScroller = object(TStaticText)
 
93
      TopLine: integer;
 
94
      Speed  : integer;
 
95
      Lines  : PUnsortedStringCollection;
 
96
      constructor Init(var Bounds: TRect; ASpeed: integer; AText: PUnsortedStringCollection);
 
97
      function    GetLineCount: integer; virtual;
 
98
      function    GetLine(I: integer): string; virtual;
 
99
      procedure   HandleEvent(var Event: TEvent); virtual;
 
100
      procedure   Update; virtual;
 
101
      procedure   Reset; virtual;
 
102
      procedure   Scroll; virtual;
 
103
      procedure   Draw; virtual;
 
104
      destructor  Done; virtual;
 
105
    private
 
106
      LastTT: longint;
 
107
    end;
 
108
 
 
109
    TAlign = (alLeft,alCenter,alRight);
 
110
 
 
111
    PFPToolTip = ^TFPToolTip;
 
112
    TFPToolTip = object(TView)
 
113
      constructor Init(var Bounds: TRect; const AText: string; AAlign: TAlign);
 
114
      procedure   Draw; virtual;
 
115
      function    GetText: string;
 
116
      procedure   SetText(const AText: string);
 
117
      function    GetAlign: TAlign;
 
118
      procedure   SetAlign(AAlign: TAlign);
 
119
      function    GetPalette: PPalette; virtual;
 
120
      destructor  Done; virtual;
 
121
    private
 
122
      Text: PString;
 
123
      Align: TAlign;
 
124
    end;
 
125
 
 
126
    PSourceEditor = ^TSourceEditor;
 
127
    TSourceEditor = object(TFileEditor)
 
128
      constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar:
 
129
          PScrollBar; AIndicator: PIndicator;const AFileName: string);
 
130
      CompileStamp : longint;
 
131
      CodeCompleteTip: PFPToolTip;
 
132
{$ifndef NODEBUG}
 
133
    private
 
134
      ShouldHandleBreakpoints : boolean;
 
135
{$endif NODEBUG}
 
136
    public
 
137
      { Syntax highlight }
 
138
      function  IsReservedWord(const S: string): boolean; virtual;
 
139
      function  IsAsmReservedWord(const S: string): boolean; virtual;
 
140
      function  GetSpecSymbolCount(SpecClass: TSpecSymbolClass): integer; virtual;
 
141
      function  GetSpecSymbol(SpecClass: TSpecSymbolClass; Index: integer): pstring; virtual;
 
142
      { CodeTemplates }
 
143
      function    TranslateCodeTemplate(var Shortcut: string; ALines: PUnsortedStringCollection): boolean; virtual;
 
144
      function    SelectCodeTemplate(var ShortCut: string): boolean; virtual;
 
145
      { CodeComplete }
 
146
      function    CompleteCodeWord(const WordS: string; var Text: string): boolean; virtual;
 
147
      procedure   FindMatchingDelimiter(ScanForward: boolean); virtual;
 
148
      procedure   SetCodeCompleteWord(const S: string); virtual;
 
149
      procedure   AlignCodeCompleteTip;
 
150
      procedure   HandleEvent(var Event: TEvent); virtual;
 
151
{$ifdef DebugUndo}
 
152
      procedure   DumpUndo;
 
153
      procedure   UndoAll;
 
154
      procedure   RedoAll;
 
155
{$endif DebugUndo}
 
156
      function    Valid(Command: Word): Boolean;virtual;
 
157
      function    GetLocalMenu: PMenu; virtual;
 
158
      function    GetCommandTarget: PView; virtual;
 
159
      function    CreateLocalMenuView(var Bounds: TRect; M: PMenu): PMenuPopup; virtual;
 
160
      procedure   ModifiedChanged; virtual;
 
161
      procedure   InsertOptions; virtual;
 
162
      procedure   PushInfo(Const st : string);virtual;
 
163
      procedure   PopInfo;virtual;
 
164
      procedure   DeleteLine(I: sw_integer); virtual;
 
165
      procedure   BackSpace; virtual;
 
166
      procedure   DelChar; virtual;
 
167
      procedure   DelSelect; virtual;
 
168
      function    InsertNewLine : Sw_integer;virtual;
 
169
      function    InsertLine(LineNo: sw_integer; const S: string): PCustomLine; virtual;
 
170
      procedure   AddLine(const S: string); virtual;
 
171
    end;
 
172
 
 
173
    PSourceWindow = ^TSourceWindow;
 
174
    TSourceWindow = object(TFPWindow)
 
175
      Editor    : PSourceEditor;
 
176
      Indicator : PIndicator;
 
177
      NoNameCount : longint;
 
178
      constructor Init(var Bounds: TRect; AFileName: string);
 
179
      function    GetTitle(MaxSize: sw_Integer): TTitleStr; virtual;
 
180
      procedure   SetTitle(ATitle: string); virtual;
 
181
      procedure   UpdateTitle; virtual;
 
182
      procedure   HandleEvent(var Event: TEvent); virtual;
 
183
      procedure   Update; virtual;
 
184
      procedure   UpdateCommands; virtual;
 
185
      function    GetPalette: PPalette; virtual;
 
186
      constructor Load(var S: TStream);
 
187
      procedure   Store(var S: TStream);
 
188
      procedure   Close; virtual;
 
189
      destructor  Done; virtual;
 
190
    end;
 
191
 
 
192
{$ifndef NODEBUG}
 
193
    PGDBSourceEditor = ^TGDBSourceEditor;
 
194
    TGDBSourceEditor = object(TSourceEditor)
 
195
      function   InsertNewLine : Sw_integer;virtual;
 
196
      function   Valid(Command: Word): Boolean; virtual;
 
197
      procedure  AddLine(const S: string); virtual;
 
198
      procedure  AddErrorLine(const S: string); virtual;
 
199
      { Syntax highlight }
 
200
      function  IsReservedWord(const S: string): boolean; virtual;
 
201
    private
 
202
      Silent,
 
203
      AutoRepeat,
 
204
      IgnoreStringAtEnd : boolean;
 
205
      LastCommand : String;
 
206
      end;
 
207
 
 
208
    PGDBWindow = ^TGDBWindow;
 
209
    TGDBWindow = object(TFPWindow)
 
210
      Editor    : PGDBSourceEditor;
 
211
      Indicator : PIndicator;
 
212
      constructor Init(var Bounds: TRect);
 
213
      procedure   HandleEvent(var Event: TEvent); virtual;
 
214
      procedure   WriteText(Buf : pchar;IsError : boolean);
 
215
      procedure   WriteString(Const S : string);
 
216
      procedure   WriteErrorString(Const S : string);
 
217
      procedure   WriteOutputText(Buf : pchar);
 
218
      procedure   WriteErrorText(Buf : pchar);
 
219
      function    GetPalette: PPalette;virtual;
 
220
      constructor Load(var S: TStream);
 
221
      procedure   Store(var S: TStream);
 
222
      procedure   UpdateCommands; virtual;
 
223
      destructor  Done; virtual;
 
224
    end;
 
225
 
 
226
    PDisasLine = ^TDisasLine;
 
227
    TDisasLine = object(TLine)
 
228
      address : cardinal;{ should be target size of address for cross debuggers }
 
229
    end;
 
230
 
 
231
    PDisasLineCollection = ^TDisasLineCollection;
 
232
    TDisasLineCollection = object(TLineCollection)
 
233
      function  At(Index: sw_Integer): PDisasLine;
 
234
    end;
 
235
 
 
236
    PDisassemblyEditor = ^TDisassemblyEditor;
 
237
    TDisassemblyEditor = object(TSourceEditor)
 
238
      CurrentSource : String;
 
239
      CurrentLine : longint;
 
240
      constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar:
 
241
          PScrollBar; AIndicator: PIndicator;const AFileName: string);
 
242
      procedure  ReleaseSource;
 
243
      destructor Done;virtual;
 
244
      procedure  AddSourceLine(const AFileName: string;line : longint); virtual;
 
245
      procedure  AddAssemblyLine(const S: string;AAddress : cardinal); virtual;
 
246
      function   GetCurrentLine(address : cardinal) : PDisasLine;
 
247
      private
 
248
        Source : PSourceWindow;
 
249
        OwnsSource : Boolean;
 
250
        DisasLines : PDisasLineCollection;
 
251
        MinAddress,MaxAddress : cardinal;
 
252
        CurL : PDisasLine;
 
253
      end;
 
254
 
 
255
    PDisassemblyWindow = ^TDisassemblyWindow;
 
256
    TDisassemblyWindow = object(TFPWindow)
 
257
      Editor    : PDisassemblyEditor;
 
258
      Indicator : PIndicator;
 
259
      constructor Init(var Bounds: TRect);
 
260
      procedure   LoadFunction(Const FuncName : string);
 
261
      procedure   LoadAddress(Addr : cardinal);
 
262
      function    ProcessPChar(p : pchar) : boolean;
 
263
      procedure   HandleEvent(var Event: TEvent); virtual;
 
264
      procedure   WriteSourceString(Const S : string;line : longint);
 
265
      procedure   WriteDisassemblyString(Const S : string;address : cardinal);
 
266
      procedure   SetCurAddress(address : cardinal);
 
267
      procedure   UpdateCommands; virtual;
 
268
      function    GetPalette: PPalette;virtual;
 
269
      destructor  Done; virtual;
 
270
    end;
 
271
{$endif NODEBUG}
 
272
 
 
273
    PClipboardWindow = ^TClipboardWindow;
 
274
    TClipboardWindow = object(TSourceWindow)
 
275
      constructor Init;
 
276
      procedure   Close; virtual;
 
277
      constructor Load(var S: TStream);
 
278
      procedure   Store(var S: TStream);
 
279
      destructor  Done; virtual;
 
280
    end;
 
281
 
 
282
    PMessageItem = ^TMessageItem;
 
283
    TMessageItem = object(TObject)
 
284
      TClass    : longint;
 
285
      Text      : PString;
 
286
      Module    : PString;
 
287
      Row,Col   : sw_integer;
 
288
      constructor Init(AClass: longint; const AText: string; AModule: PString; ARow, ACol: sw_integer);
 
289
      function    GetText(MaxLen: Sw_integer): string; virtual;
 
290
      procedure   Selected; virtual;
 
291
      function    GetModuleName: string; virtual;
 
292
      destructor  Done; virtual;
 
293
    end;
 
294
 
 
295
    PMessageListBox = ^TMessageListBox;
 
296
    TMessageListBox = object(THSListBox)
 
297
      Transparent : boolean;
 
298
      NoSelection : boolean;
 
299
      MaxWidth    : Sw_integer;
 
300
      ModuleNames : PStoreCollection;
 
301
      constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
 
302
      procedure   SetState(AState: Word; Enable: Boolean); virtual;
 
303
      procedure   AddItem(P: PMessageItem); virtual;
 
304
      function    AddModuleName(const Name: string): PString; virtual;
 
305
      function    GetText(Item,MaxLen: Sw_Integer): String; virtual;
 
306
      procedure   Clear; virtual;
 
307
      procedure   TrackSource; virtual;
 
308
      procedure   GotoSource; virtual;
 
309
      procedure   Draw; virtual;
 
310
      procedure   HandleEvent(var Event: TEvent); virtual;
 
311
      function    GetLocalMenu: PMenu; virtual;
 
312
      constructor Load(var S: TStream);
 
313
      procedure   Store(var S: TStream);
 
314
      destructor  Done; virtual;
 
315
    end;
 
316
 
 
317
 
 
318
    PFPDlgWindow = ^TFPDlgWindow;
 
319
    TFPDlgWindow = object(TDlgWindow)
 
320
      procedure   HandleEvent(var Event: TEvent); virtual;
 
321
    end;
 
322
 
 
323
(*
 
324
    PTabItem = ^TTabItem;
 
325
    TTabItem = record
 
326
      Next : PTabItem;
 
327
      View : PView;
 
328
      Dis  : boolean;
 
329
    end;
 
330
 
 
331
    PTabDef = ^TTabDef;
 
332
    TTabDef = record
 
333
      Next     : PTabDef;
 
334
      Name     : PString;
 
335
      Items    : PTabItem;
 
336
      DefItem  : PView;
 
337
      ShortCut : char;
 
338
    end;
 
339
 
 
340
    PTab = ^TTab;
 
341
    TTab = object(TGroup)
 
342
      TabDefs   : PTabDef;
 
343
      ActiveDef : integer;
 
344
      DefCount  : word;
 
345
      constructor Init(var Bounds: TRect; ATabDef: PTabDef);
 
346
      function    AtTab(Index: integer): PTabDef; virtual;
 
347
      procedure   SelectTab(Index: integer); virtual;
 
348
      function    TabCount: integer;
 
349
      procedure   SelectNextTab(Forwards: boolean);
 
350
      function    Valid(Command: Word): Boolean; virtual;
 
351
      procedure   ChangeBounds(var Bounds: TRect); virtual;
 
352
      procedure   HandleEvent(var Event: TEvent); virtual;
 
353
      function    GetPalette: PPalette; virtual;
 
354
      procedure   Draw; virtual;
 
355
      procedure   SetState(AState: Word; Enable: Boolean); virtual;
 
356
      destructor  Done; virtual;
 
357
    private
 
358
      InDraw: boolean;
 
359
    end;
 
360
*)
 
361
 
 
362
    PScreenView = ^TScreenView;
 
363
    TScreenView = object(TScroller)
 
364
      Screen: PScreen;
 
365
      constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar;
 
366
                    AScreen: PScreen);
 
367
      procedure   Draw; virtual;
 
368
      procedure   Update; virtual;
 
369
      procedure   HandleEvent(var Event: TEvent); virtual;
 
370
    end;
 
371
 
 
372
    PScreenWindow = ^TScreenWindow;
 
373
    TScreenWindow = object(TFPWindow)
 
374
      ScreenView : PScreenView;
 
375
      constructor Init(AScreen: PScreen; ANumber: integer);
 
376
      destructor  Done; virtual;
 
377
    end;
 
378
 
 
379
    PFPAboutDialog = ^TFPAboutDialog;
 
380
    TFPAboutDialog = object(TCenterDialog)
 
381
      constructor Init;
 
382
      procedure   ToggleInfo;
 
383
      procedure   HandleEvent(var Event: TEvent); virtual;
 
384
    private
 
385
      Scroller: PTextScroller;
 
386
      TitleST : PStaticText;
 
387
    end;
 
388
 
 
389
    PFPASCIIChart = ^TFPASCIIChart;
 
390
    TFPASCIIChart = object(TASCIIChart)
 
391
      constructor Init;
 
392
      constructor Load(var S: TStream);
 
393
      procedure   Store(var S: TStream);
 
394
      procedure   HandleEvent(var Event: TEvent); virtual;
 
395
      destructor  Done; virtual;
 
396
    end;
 
397
 
 
398
    PVideoModeListBox = ^TVideoModeListBox;
 
399
    TVideoModeListBox = object(TDropDownListBox)
 
400
      function    GetText(Item: pointer; MaxLen: sw_integer): string; virtual;
 
401
    end;
 
402
 
 
403
    PFPDesktop = ^TFPDesktop;
 
404
    TFPDesktop = object(TDesktop)
 
405
      constructor Init(var Bounds: TRect);
 
406
      procedure   InitBackground; virtual;
 
407
      constructor Load(var S: TStream);
 
408
      procedure   Store(var S: TStream);
 
409
    end;
 
410
 
 
411
    PFPMemo = ^TFPMemo;
 
412
    TFPMemo = object(TCodeEditor)
 
413
      constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar:
 
414
                    PScrollBar; AIndicator: PIndicator);
 
415
      function    IsReservedWord(const S: string): boolean; virtual;
 
416
      function    GetSpecSymbolCount(SpecClass: TSpecSymbolClass): integer; virtual;
 
417
      function    GetSpecSymbol(SpecClass: TSpecSymbolClass; Index: integer): pstring; virtual;
 
418
      function    GetPalette: PPalette; virtual;
 
419
    end;
 
420
 
 
421
    PFPCodeMemo = ^TFPCodeMemo;
 
422
    TFPCodeMemo = object(TFPMemo)
 
423
      constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar:
 
424
                    PScrollBar; AIndicator: PIndicator);
 
425
      function    IsReservedWord(const S: string): boolean; virtual;
 
426
      function    GetSpecSymbolCount(SpecClass: TSpecSymbolClass): integer; virtual;
 
427
      function    GetSpecSymbol(SpecClass: TSpecSymbolClass; Index: integer): pstring; virtual;
 
428
    end;
 
429
 
 
430
function  SearchFreeWindowNo: integer;
 
431
 
 
432
function IsWindow(P: PView): boolean;
 
433
function IsThereAnyEditor: boolean;
 
434
function IsThereAnyWindow: boolean;
 
435
function IsThereAnyVisibleWindow: boolean;
 
436
function IsThereAnyNumberedWindow: boolean;
 
437
function FirstEditorWindow: PSourceWindow;
 
438
function EditorWindowFile(const Name : String): PSourceWindow;
 
439
procedure AskToReloadAllModifiedFiles;
 
440
 
 
441
{$ifndef NODEBUG}
 
442
function InDisassemblyWindow :boolean;
 
443
{$endif NODEBUG}
 
444
 
 
445
function  NewTabItem(AView: PView; ANext: PTabItem): PTabItem;
 
446
procedure DisposeTabItem(P: PTabItem);
 
447
function  NewTabDef(AName: string; ADefItem: PView; AItems: PTabItem; ANext: PTabDef): PTabDef;
 
448
procedure DisposeTabDef(P: PTabDef);
 
449
 
 
450
function GetEditorCurWord(Editor: PEditor; ValidSpecChars: TCharSet): string;
 
451
procedure InitReservedWords;
 
452
procedure DoneReservedWords;
 
453
function GetReservedWordCount: integer;
 
454
function GetReservedWord(Index: integer): string;
 
455
function GetAsmReservedWordCount: integer;
 
456
function GetAsmReservedWord(Index: integer): string;
 
457
 
 
458
procedure TranslateMouseClick(View: PView; var Event: TEvent);
 
459
 
 
460
function GetNextEditorBounds(var Bounds: TRect): boolean;
 
461
function OpenEditorWindow(Bounds: PRect; FileName: string; CurX,CurY: sw_integer): PSourceWindow;
 
462
function IOpenEditorWindow(Bounds: PRect; FileName: string; CurX,CurY: sw_integer; ShowIt: boolean): PSourceWindow;
 
463
function LastSourceEditor : PSourceWindow;
 
464
function SearchOnDesktop(FileName : string;tryexts:boolean) : PSourceWindow;
 
465
function TryToOpenFile(Bounds: PRect; FileName: string; CurX,CurY: sw_integer;tryexts: boolean): PSourceWindow;
 
466
function ITryToOpenFile(Bounds: PRect; FileName: string; CurX,CurY: sw_integer;tryexts, ShowIt,
 
467
         ForceNewWindow:boolean): PSourceWindow;
 
468
function LocateSourceFile(const FileName: string; tryexts: boolean): string;
 
469
 
 
470
function SearchWindow(const Title: string): PWindow;
 
471
 
 
472
function StartEditor(Editor: PCodeEditor; FileName: string): boolean;
 
473
 
 
474
{$ifdef VESA}
 
475
procedure InitVESAScreenModes;
 
476
procedure DoneVESAScreenModes;
 
477
{$endif}
 
478
 
 
479
procedure NoDebugger;
 
480
 
 
481
const
 
482
      SourceCmds  : TCommandSet =
 
483
        ([cmSave,cmSaveAs,cmCompile,cmHide,cmDoReload]);
 
484
      EditorCmds  : TCommandSet =
 
485
        ([cmFind,cmReplace,cmSearchAgain,cmJumpLine,cmHelpTopicSearch]);
 
486
      CompileCmds : TCommandSet =
 
487
        ([cmMake,cmBuild,cmRun]);
 
488
 
 
489
      CalcClipboard   : extended = 0;
 
490
 
 
491
      OpenFileName    : string = '';
 
492
      OpenFileLastExt : string[12] = '*.pas';
 
493
      NewEditorOpened : boolean = false;
 
494
 
 
495
var  MsgParms : array[1..10] of
 
496
         record
 
497
           case byte of
 
498
             0 : (Ptr : pointer);
 
499
             1 : (Long: longint);
 
500
         end;
 
501
 
 
502
procedure RegisterFPViews;
 
503
 
 
504
implementation
 
505
 
 
506
uses
 
507
  Video,Strings,Keyboard,Validate,
 
508
  globtype,Tokens,Version,
 
509
  systems,cpubase,
 
510
  {$if defined(I386) or defined(x64_86)}
 
511
     rax86,
 
512
  {$endif}
 
513
{$ifdef USE_EXTERNAL_COMPILER}
 
514
   fpintf, { superseeds version_string of version unit }
 
515
{$endif USE_EXTERNAL_COMPILER}
 
516
{$ifndef NODEBUG}
 
517
  gdbint,
 
518
{$endif NODEBUG}
 
519
  {$ifdef VESA}Vesa,{$endif}
 
520
  FPString,FPSwitch,FPSymbol,FPDebug,FPVars,FPUtils,FPCompil,FPHelp,
 
521
  FPTools,FPIDE,FPCodTmp,FPCodCmp;
 
522
 
 
523
const
 
524
  RSourceEditor: TStreamRec = (
 
525
     ObjType: 1500;
 
526
     VmtLink: Ofs(TypeOf(TSourceEditor)^);
 
527
     Load:    @TSourceEditor.Load;
 
528
     Store:   @TSourceEditor.Store
 
529
  );
 
530
  RSourceWindow: TStreamRec = (
 
531
     ObjType: 1501;
 
532
     VmtLink: Ofs(TypeOf(TSourceWindow)^);
 
533
     Load:    @TSourceWindow.Load;
 
534
     Store:   @TSourceWindow.Store
 
535
  );
 
536
  RFPHelpViewer: TStreamRec = (
 
537
     ObjType: 1502;
 
538
     VmtLink: Ofs(TypeOf(TFPHelpViewer)^);
 
539
     Load:    @TFPHelpViewer.Load;
 
540
     Store:   @TFPHelpViewer.Store
 
541
  );
 
542
  RFPHelpWindow: TStreamRec = (
 
543
     ObjType: 1503;
 
544
     VmtLink: Ofs(TypeOf(TFPHelpWindow)^);
 
545
     Load:    @TFPHelpWindow.Load;
 
546
     Store:   @TFPHelpWindow.Store
 
547
  );
 
548
  RClipboardWindow: TStreamRec = (
 
549
     ObjType: 1504;
 
550
     VmtLink: Ofs(TypeOf(TClipboardWindow)^);
 
551
     Load:    @TClipboardWindow.Load;
 
552
     Store:   @TClipboardWindow.Store
 
553
  );
 
554
  RMessageListBox: TStreamRec = (
 
555
     ObjType: 1505;
 
556
     VmtLink: Ofs(TypeOf(TMessageListBox)^);
 
557
     Load:    @TMessageListBox.Load;
 
558
     Store:   @TMessageListBox.Store
 
559
  );
 
560
  RFPDesktop: TStreamRec = (
 
561
     ObjType: 1506;
 
562
     VmtLink: Ofs(TypeOf(TFPDesktop)^);
 
563
     Load:    @TFPDesktop.Load;
 
564
     Store:   @TFPDesktop.Store
 
565
  );
 
566
 
 
567
  RFPASCIIChart: TStreamRec = (
 
568
     ObjType: 1509;
 
569
     VmtLink: Ofs(TypeOf(TFPASCIIChart)^);
 
570
     Load:    @TFPASCIIChart.Load;
 
571
     Store:   @TFPASCIIChart.Store
 
572
  );
 
573
  RFPDlgWindow: TStreamRec = (
 
574
     ObjType: 1511;
 
575
     VmtLink: Ofs(TypeOf(TFPDlgWindow)^);
 
576
     Load:    @TFPDlgWindow.Load;
 
577
     Store:   @TFPDlgWindow.Store
 
578
  );
 
579
{$ifndef NODEBUG}
 
580
  RGDBWindow: TStreamRec = (
 
581
     ObjType: 1508;
 
582
     VmtLink: Ofs(TypeOf(TGDBWindow)^);
 
583
     Load:    @TGDBWindow.Load;
 
584
     Store:   @TGDBWindow.Store
 
585
  );
 
586
  RGDBSourceEditor: TStreamRec = (
 
587
     ObjType: 1507;
 
588
     VmtLink: Ofs(TypeOf(TGDBSourceEditor)^);
 
589
     Load:    @TGDBSourceEditor.Load;
 
590
     Store:   @TGDBSourceEditor.Store
 
591
  );
 
592
  RDisassemblyEditor: TStreamRec = (
 
593
     ObjType: 1512;
 
594
     VmtLink: Ofs(TypeOf(TDisassemblyEditor)^);
 
595
     Load:    @TDisassemblyEditor.Load;
 
596
     Store:   @TDisassemblyEditor.Store
 
597
  );
 
598
  RDisassemblyWindow: TStreamRec = (
 
599
     ObjType: 1513;
 
600
     VmtLink: Ofs(TypeOf(TDisassemblyWindow)^);
 
601
     Load:    @TDisassemblyWindow.Load;
 
602
     Store:   @TDisassemblyWindow.Store
 
603
  );
 
604
{$endif NODEBUG}
 
605
const
 
606
  GlobalNoNameCount : integer = 0;
 
607
var
 
608
  ReservedWords  : array[1..ReservedWordMaxLen] of PStringCollection;
 
609
  AsmReservedWords  : array[1..ReservedWordMaxLen] of PStringCollection;
 
610
 
 
611
{****************************************************************************
 
612
                                TStoreCollection
 
613
****************************************************************************}
 
614
 
 
615
function TStoreCollection.Add(const S: string): PString;
 
616
var P: PString;
 
617
    Index: Sw_integer;
 
618
begin
 
619
  if S='' then P:=nil else
 
620
  if Search(@S,Index) then P:=At(Index) else
 
621
    begin
 
622
      P:=NewStr(S);
 
623
      Insert(P);
 
624
    end;
 
625
  Add:=P;
 
626
end;
 
627
 
 
628
 
 
629
function IsThereAnyEditor: boolean;
 
630
function EditorWindow(P: PView): boolean; {$ifndef FPC}far;{$endif}
 
631
begin
 
632
  EditorWindow:=(P^.HelpCtx=hcSourceWindow);
 
633
end;
 
634
begin
 
635
  IsThereAnyEditor:=Desktop^.FirstThat(@EditorWindow)<>nil;
 
636
end;
 
637
 
 
638
procedure AskToReloadAllModifiedFiles;
 
639
  procedure EditorWindowModifiedOnDisk(P: PView); {$ifndef FPC}far;{$endif}
 
640
begin
 
641
  if (P^.HelpCtx=hcSourceWindow) then
 
642
    PSourceWindow(P)^.Editor^.ReloadFile;
 
643
end;
 
644
begin
 
645
  Desktop^.ForEach(@EditorWindowModifiedOnDisk);
 
646
end;
 
647
 
 
648
function IsThereAnyHelpWindow: boolean;
 
649
begin
 
650
  IsThereAnyHelpWindow:=(HelpWindow<>nil) and (HelpWindow^.GetState(sfVisible));
 
651
end;
 
652
 
 
653
function IsThereAnyNumberedWindow: boolean;
 
654
var _Is: boolean;
 
655
begin
 
656
  _Is:=Message(Desktop,evBroadcast,cmSearchWindow,nil)<>nil;
 
657
  _Is:=_Is or ( (ClipboardWindow<>nil) and ClipboardWindow^.GetState(sfVisible));
 
658
  IsThereAnyNumberedWindow:=_Is;
 
659
end;
 
660
 
 
661
function IsWindow(P: PView): boolean;
 
662
var OK: boolean;
 
663
begin
 
664
  OK:=false;
 
665
  if (P^.HelpCtx=hcSourceWindow) or
 
666
     (P^.HelpCtx=hcHelpWindow) or
 
667
     (P^.HelpCtx=hcClipboardWindow) or
 
668
     (P^.HelpCtx=hcCalcWindow) or
 
669
     (P^.HelpCtx=hcInfoWindow) or
 
670
     (P^.HelpCtx=hcBrowserWindow) or
 
671
     (P^.HelpCtx=hcMessagesWindow) or
 
672
     (P^.HelpCtx=hcCompilerMessagesWindow) or
 
673
     (P^.HelpCtx=hcGDBWindow) or
 
674
     (P^.HelpCtx=hcdisassemblyWindow) or
 
675
     (P^.HelpCtx=hcWatchesWindow) or
 
676
     (P^.HelpCtx=hcRegistersWindow) or
 
677
     (P^.HelpCtx=hcFPURegisters) or
 
678
     (P^.HelpCtx=hcVectorRegisters) or
 
679
     (P^.HelpCtx=hcStackWindow) or
 
680
     (P^.HelpCtx=hcBreakpointListWindow) or
 
681
     (P^.HelpCtx=hcASCIITableWindow)
 
682
   then
 
683
     OK:=true;
 
684
   IsWindow:=OK;
 
685
end;
 
686
 
 
687
function IsThereAnyWindow: boolean;
 
688
function CheckIt(P: PView): boolean; {$ifndef FPC}far;{$endif}
 
689
begin
 
690
  CheckIt:=IsWindow(P);
 
691
end;
 
692
begin
 
693
  IsThereAnyWindow:=Desktop^.FirstThat(@CheckIt)<>nil;
 
694
end;
 
695
 
 
696
function IsThereAnyVisibleWindow: boolean;
 
697
function CheckIt(P: PView): boolean; {$ifndef FPC}far;{$endif}
 
698
begin
 
699
  CheckIt:=IsWindow(P) and P^.GetState(sfVisible);
 
700
end;
 
701
begin
 
702
  IsThereAnyVisibleWindow:=Desktop^.FirstThat(@CheckIt)<>nil;
 
703
end;
 
704
 
 
705
function FirstEditorWindow: PSourceWindow;
 
706
function EditorWindow(P: PView): boolean; {$ifndef FPC}far;{$endif}
 
707
begin
 
708
  EditorWindow:=(P^.HelpCtx=hcSourceWindow);
 
709
end;
 
710
begin
 
711
  FirstEditorWindow:=pointer(Desktop^.FirstThat(@EditorWindow));
 
712
end;
 
713
 
 
714
function EditorWindowFile(const Name : String): PSourceWindow;
 
715
var
 
716
  SName : string;
 
717
 
 
718
  function EditorWindow(P: PView): boolean; {$ifndef FPC}far;{$endif}
 
719
  begin
 
720
    EditorWindow:=(TypeOf(P^)=TypeOf(TSourceWindow)) and
 
721
                  (FixFileName(PSourceWindow(P)^.Editor^.FileName)=SName);
 
722
  end;
 
723
 
 
724
begin
 
725
  SName:=FixFileName(FExpand(Name));
 
726
  EditorWindowFile:=pointer(Desktop^.FirstThat(@EditorWindow));
 
727
end;
 
728
 
 
729
 
 
730
{$ifndef NODEBUG}
 
731
function InDisassemblyWindow :boolean;
 
732
var
 
733
  PW : PWindow;
 
734
 
 
735
function CheckIt(P: PView): boolean; {$ifndef FPC}far;{$endif}
 
736
begin
 
737
  CheckIt:=IsWindow(P) and P^.GetState(sfVisible) and
 
738
     (P^.HelpCtx <> hcWatchesWindow) and
 
739
     (P^.HelpCtx <> hcStackWindow) and
 
740
     (P^.HelpCtx <> hcRegistersWindow) and
 
741
     (P^.HelpCtx <> hcVectorRegisters) and
 
742
     (P^.HelpCtx <> hcFPURegisters);
 
743
end;
 
744
begin
 
745
  PW:=PWindow(Desktop^.FirstThat(@CheckIt));
 
746
  InDisassemblyWindow:=Assigned(PW) and
 
747
    (TypeOf(PW^)=TypeOf(TDisassemblyWindow));
 
748
end;
 
749
{$endif NODEBUG}
 
750
 
 
751
 
 
752
function GetEditorCurWord(Editor: PEditor; ValidSpecChars: TCharSet): string;
 
753
var S: string;
 
754
    PS,PE: byte;
 
755
function Trim(S: string): string;
 
756
const TrimChars : set of char = [#0,#9,' ',#255];
 
757
begin
 
758
  while (length(S)>0) and (S[1] in TrimChars) do Delete(S,1,1);
 
759
  while (length(S)>0) and (S[length(S)] in TrimChars) do Delete(S,length(S),1);
 
760
  Trim:=S;
 
761
end;
 
762
const AlphaNum : set of char = ['A'..'Z','0'..'9','_'];
 
763
begin
 
764
  with Editor^ do
 
765
  begin
 
766
    S:=GetDisplayText(CurPos.Y);
 
767
    PS:=CurPos.X; while (PS>0) and (Upcase(S[PS]) in AlphaNum) do Dec(PS);
 
768
    PE:=CurPos.X; while (PE<length(S)) and (Upcase(S[PE+1]) in (AlphaNum+ValidSpecChars)) do Inc(PE);
 
769
    S:=Trim(copy(S,PS+1,PE-PS));
 
770
  end;
 
771
  GetEditorCurWord:=S;
 
772
end;
 
773
 
 
774
 
 
775
{*****************************************************************************
 
776
                                   Tab
 
777
*****************************************************************************}
 
778
 
 
779
function NewTabItem(AView: PView; ANext: PTabItem): PTabItem;
 
780
var P: PTabItem;
 
781
begin
 
782
  New(P); FillChar(P^,SizeOf(P^),0);
 
783
  P^.Next:=ANext; P^.View:=AView;
 
784
  NewTabItem:=P;
 
785
end;
 
786
 
 
787
procedure DisposeTabItem(P: PTabItem);
 
788
begin
 
789
  if P<>nil then
 
790
  begin
 
791
    if P^.View<>nil then Dispose(P^.View, Done);
 
792
    Dispose(P);
 
793
  end;
 
794
end;
 
795
 
 
796
function NewTabDef(AName: string; ADefItem: PView; AItems: PTabItem; ANext: PTabDef): PTabDef;
 
797
var P: PTabDef;
 
798
    x: byte;
 
799
begin
 
800
  New(P);
 
801
  P^.Next:=ANext; P^.Name:=NewStr(AName); P^.Items:=AItems;
 
802
  x:=pos('~',AName);
 
803
  if (x<>0) and (x<length(AName)) then P^.ShortCut:=Upcase(AName[x+1])
 
804
                                  else P^.ShortCut:=#0;
 
805
  P^.DefItem:=ADefItem;
 
806
  NewTabDef:=P;
 
807
end;
 
808
 
 
809
procedure DisposeTabDef(P: PTabDef);
 
810
var PI,X: PTabItem;
 
811
begin
 
812
  DisposeStr(P^.Name);
 
813
  PI:=P^.Items;
 
814
  while PI<>nil do
 
815
    begin
 
816
      X:=PI^.Next;
 
817
      DisposeTabItem(PI);
 
818
      PI:=X;
 
819
    end;
 
820
  Dispose(P);
 
821
end;
 
822
 
 
823
 
 
824
{*****************************************************************************
 
825
                               Reserved Words
 
826
*****************************************************************************}
 
827
 
 
828
function GetReservedWordCount: integer;
 
829
var
 
830
  Count,I: integer;
 
831
begin
 
832
  Count:=0;
 
833
  for I:=ord(Low(tToken)) to ord(High(tToken)) do
 
834
  with TokenInfo^[TToken(I)] do
 
835
     if (str<>'') and (str[1] in['A'..'Z']) and (length(str)>1) then
 
836
       Inc(Count);
 
837
  GetReservedWordCount:=Count;
 
838
end;
 
839
 
 
840
function GetReservedWord(Index: integer): string;
 
841
var
 
842
  Count,Idx,I: integer;
 
843
  S: string;
 
844
begin
 
845
  Idx:=-1;
 
846
  Count:=-1;
 
847
  I:=ord(Low(tToken));
 
848
  while (I<=ord(High(tToken))) and (Idx=-1) do
 
849
   with TokenInfo^[TToken(I)] do
 
850
    begin
 
851
      if (str<>'') and (str[1] in['A'..'Z']) and (length(str)>1) then
 
852
        begin
 
853
          Inc(Count);
 
854
          if Count=Index then
 
855
           Idx:=I;
 
856
        end;
 
857
      Inc(I);
 
858
    end;
 
859
  if Idx=-1 then
 
860
    S:=''
 
861
  else
 
862
    S:=TokenInfo^[TToken(Idx)].str;
 
863
  GetReservedWord:=S;
 
864
end;
 
865
 
 
866
function GetAsmReservedWordCount: integer;
 
867
begin
 
868
  GetAsmReservedWordCount:=ord(lastop) - ord(firstop)
 
869
{$ifndef x86_64}
 
870
{$ifndef powerpc}
 
871
{$ifndef arm}
 
872
    + CondAsmOps*(ord(high(TasmCond))-ord(low(TasmCond)));
 
873
{$else arm}
 
874
   { the arm has an incredible amount of combinations of opcodes,
 
875
     we've to solve this different }
 
876
   ;
 
877
{$endif arm}
 
878
{$else powerpc}
 
879
   + CondAsmOps*(ord(high(TAsmCondFlag))-ord(low(TAsmCondFlag)));
 
880
{$endif powerpc}
 
881
{$endif x86_64}
 
882
end;
 
883
 
 
884
 
 
885
function GetAsmReservedWord(Index: integer): string;
 
886
var
 
887
  CondNum,CondOpNum : integer;
 
888
begin
 
889
{$ifdef I386}
 
890
  if index <= ord(lastop) - ord(firstop) then
 
891
    GetAsmReservedWord:=std_op2str[tasmop(Index+ord(firstop))]
 
892
  else
 
893
    begin
 
894
      index:=index - (ord(lastop) - ord(firstop) );
 
895
      CondOpNum:= index div (ord(high(TasmCond))-ord(low(TasmCond)));
 
896
      CondNum:=index - (CondOpNum * (ord(high(TasmCond))-ord(low(TasmCond))));
 
897
      GetAsmReservedWord:=CondAsmOpStr[CondOpNum]+cond2str[TasmCond(CondNum+ord(low(TAsmCond))+1)];
 
898
    end;
 
899
{$else not I386}
 
900
{$ifdef m68k}
 
901
  if index <= ord(lastop) - ord(firstop) then
 
902
    GetAsmReservedWord:=mot_op2str[tasmop(Index+ord(firstop))]
 
903
  else
 
904
    begin
 
905
      index:=index - (ord(lastop) - ord(firstop) );
 
906
      CondOpNum:= index div (ord(high(TasmCond))-ord(low(TasmCond)));
 
907
      CondNum:=index - (CondOpNum * (ord(high(TasmCond))-ord(low(TasmCond))));
 
908
      GetAsmReservedWord:=CondAsmOpStr[CondOpNum]+cond2str[TasmCond(CondNum+ord(low(TAsmCond))+1)];
 
909
    end;
 
910
{$else not m68k}
 
911
  GetAsmReservedWord:='';
 
912
{$endif m68k}
 
913
{$endif I386}
 
914
end;
 
915
 
 
916
procedure InitReservedWords;
 
917
var WordS: string;
 
918
    Idx,I,J : sw_integer;
 
919
begin
 
920
  InitTokens;
 
921
  for I:=Low(ReservedWords) to High(ReservedWords) do
 
922
    New(ReservedWords[I], Init(50,10));
 
923
  for I:=1 to GetReservedWordCount do
 
924
    begin
 
925
      WordS:=GetReservedWord(I-1); Idx:=length(WordS);
 
926
      if (Idx>=Low(ReservedWords)) and (Idx<=High(ReservedWords)) then
 
927
        ReservedWords[Idx]^.Insert(NewStr(WordS));
 
928
    end;
 
929
  for I:=Low(AsmReservedWords) to High(AsmReservedWords) do
 
930
    New(AsmReservedWords[I], Init(50,10));
 
931
  for I:=1 to GetAsmReservedWordCount do
 
932
    begin
 
933
      WordS:=UpcaseStr(GetAsmReservedWord(I-1)); Idx:=length(WordS);
 
934
      if (Idx>=Low(AsmReservedWords)) and (Idx<=High(AsmReservedWords)) then
 
935
        begin
 
936
          if not AsmReservedWords[Idx]^.Search(@WordS, J) then
 
937
            AsmReservedWords[Idx]^.Insert(NewStr(WordS));
 
938
        end;
 
939
    end;
 
940
end;
 
941
 
 
942
procedure DoneReservedWords;
 
943
var I: integer;
 
944
begin
 
945
  for I:=Low(ReservedWords) to High(ReservedWords) do
 
946
    if assigned(ReservedWords[I]) then
 
947
      begin
 
948
        dispose(ReservedWords[I],done);
 
949
        ReservedWords[I]:=nil;
 
950
      end;
 
951
  for I:=Low(AsmReservedWords) to High(AsmReservedWords) do
 
952
    if assigned(AsmReservedWords[I]) then
 
953
      begin
 
954
        dispose(AsmReservedWords[I],done);
 
955
        ReservedWords[I]:=nil;
 
956
      end;
 
957
  DoneTokens;
 
958
end;
 
959
 
 
960
function IsFPReservedWord(const S: string): boolean;
 
961
var _Is: boolean;
 
962
    Idx,Item: sw_integer;
 
963
    UpS: string;
 
964
begin
 
965
  Idx:=length(S); _Is:=false;
 
966
  if (Low(ReservedWords)<=Idx) and (Idx<=High(ReservedWords)) and
 
967
     (ReservedWords[Idx]<>nil) and (ReservedWords[Idx]^.Count<>0) then
 
968
    begin
 
969
      UpS:=UpcaseStr(S);
 
970
      _Is:=ReservedWords[Idx]^.Search(@UpS,Item);
 
971
    end;
 
972
  IsFPReservedWord:=_Is;
 
973
end;
 
974
 
 
975
function IsFPAsmReservedWord(S: string): boolean;
 
976
var _Is: boolean;
 
977
    Idx,Item,Len: sw_integer;
 
978
    LastC : Char;
 
979
    LastTwo : String[2];
 
980
begin
 
981
  Idx:=length(S); _Is:=false;
 
982
  if (Low(AsmReservedWords)<=Idx) and (Idx<=High(AsmReservedWords)) and
 
983
     (AsmReservedWords[Idx]<>nil) and (AsmReservedWords[Idx]^.Count<>0) then
 
984
    begin
 
985
      S:=UpcaseStr(S);
 
986
      _Is:=AsmReservedWords[Idx]^.Search(@S,Item);
 
987
{$ifdef i386}
 
988
      if not _Is and (Length(S)>1) then
 
989
        begin
 
990
          LastC:=S[Length(S)];
 
991
          if LastC in ['B','D','L','Q','S','T','V','W'] then
 
992
            begin
 
993
              Delete(S,Length(S),1);
 
994
              Dec(Idx);
 
995
              if (AsmReservedWords[Idx]<>nil) and (AsmReservedWords[Idx]^.Count<>0) then
 
996
                _Is:=AsmReservedWords[Idx]^.Search(@S,Item);
 
997
              if not _Is and (Length(S)>1) then
 
998
                begin
 
999
                  LastTwo:=S[Length(S)]+LastC;
 
1000
                  if (LastTwo='BL') or
 
1001
                     (LastTwo='WL') or
 
1002
                     (LastTwo='BW') then
 
1003
                    begin
 
1004
                      Delete(S,Length(S),1);
 
1005
                      Dec(Idx);
 
1006
                      if (AsmReservedWords[Idx]<>nil) and (AsmReservedWords[Idx]^.Count<>0) then
 
1007
                        _Is:=AsmReservedWords[Idx]^.Search(@S,Item);
 
1008
                    end;
 
1009
                end;
 
1010
            end;
 
1011
        end;
 
1012
{$endif i386}
 
1013
    end;
 
1014
  IsFPAsmReservedWord:=_Is;
 
1015
end;
 
1016
 
 
1017
 
 
1018
{*****************************************************************************
 
1019
                               SearchWindow
 
1020
*****************************************************************************}
 
1021
 
 
1022
function SearchWindowWithNo(No: integer): PWindow;
 
1023
var P: PWindow;
 
1024
begin
 
1025
  P:=Message(Desktop,evBroadcast,cmSearchWindow+No,nil);
 
1026
  if pointer(P)=pointer(Desktop) then P:=nil;
 
1027
  SearchWindowWithNo:=P;
 
1028
end;
 
1029
 
 
1030
function SearchWindow(const Title: string): PWindow;
 
1031
function Match(P: PView): boolean; {$ifndef FPC}far;{$endif}
 
1032
var W: PWindow;
 
1033
    OK: boolean;
 
1034
begin
 
1035
  W:=nil;
 
1036
  { we have a crash here because of the TStatusLine
 
1037
    that can also have one of these values
 
1038
    but is not a Window object PM }
 
1039
  if P<>pointer(StatusLine) then
 
1040
  if IsWindow(P) then
 
1041
    W:=PWindow(P);
 
1042
  OK:=(W<>nil);
 
1043
  if OK then
 
1044
  begin
 
1045
    OK:=CompareText(W^.GetTitle(255),Title)=0;
 
1046
  end;
 
1047
  Match:=OK;
 
1048
end;
 
1049
var W: PView;
 
1050
begin
 
1051
  W:=Application^.FirstThat(@Match);
 
1052
{    This is wrong because TStatusLine is also considered PM }
 
1053
  if not Assigned(W) then W:=Desktop^.FirstThat(@Match);
 
1054
  { But why do we need to check all ??
 
1055
    Probably because of the ones which were not inserted into
 
1056
    Desktop as the Messages view
 
1057
 
 
1058
    Exactly. Some windows are inserted directly in the Application and not
 
1059
    in the Desktop. btw. Does TStatusLine.HelpCtx really change? Why?
 
1060
    Only GetHelpCtx should return different values depending on the
 
1061
    focused view (and it's helpctx), but TStatusLine's HelpCtx field
 
1062
    shouldn't change...  Gabor
 
1063
 
 
1064
  if Assigned(W)=false then W:=Desktop^.FirstThat(@Match);}
 
1065
  SearchWindow:=PWindow(W);
 
1066
end;
 
1067
 
 
1068
function SearchFreeWindowNo: integer;
 
1069
var No: integer;
 
1070
begin
 
1071
  No:=1;
 
1072
  while (No<100) and (SearchWindowWithNo(No)<>nil) do
 
1073
    Inc(No);
 
1074
  if No=100 then No:=0;
 
1075
  SearchFreeWindowNo:=No;
 
1076
end;
 
1077
 
 
1078
 
 
1079
{*****************************************************************************
 
1080
                              TIntegerLine
 
1081
 *****************************************************************************}
 
1082
 
 
1083
constructor TIntegerLine.Init(var Bounds: TRect; AMin, AMax: longint);
 
1084
begin
 
1085
  if inherited Init(Bounds, Bounds.B.X-Bounds.A.X-1)=false then
 
1086
    Fail;
 
1087
  Validator:=New(PRangeValidator, Init(AMin, AMax));
 
1088
end;
 
1089
 
 
1090
 
 
1091
{*****************************************************************************
 
1092
                               SourceEditor
 
1093
*****************************************************************************}
 
1094
 
 
1095
function SearchCoreForFileName(AFileName: string): PCodeEditorCore;
 
1096
var EC: PCodeEditorCore;
 
1097
function Check(P: PView): boolean; {$ifndef FPC}far;{$endif}
 
1098
var OK: boolean;
 
1099
begin
 
1100
  OK:=P^.HelpCtx=hcSourceWindow;
 
1101
  if OK then
 
1102
    with PSourceWindow(P)^ do
 
1103
     if FixFileName(Editor^.FileName)=AFileName then
 
1104
       begin
 
1105
         EC:=Editor^.Core;
 
1106
         OK:=true;
 
1107
       end
 
1108
     else
 
1109
       OK:=false;
 
1110
  Check:=OK;
 
1111
end;
 
1112
begin
 
1113
  EC:=nil;
 
1114
  AFileName:=FixFileName(AFileName);
 
1115
  { do not use the same core for all new files }
 
1116
  if AFileName<>'' then
 
1117
    Desktop^.FirstThat(@Check);
 
1118
  SearchCoreForFileName:=EC;
 
1119
end;
 
1120
 
 
1121
constructor TSourceEditor.Init(var Bounds: TRect; AHScrollBar, AVScrollBar:
 
1122
          PScrollBar; AIndicator: PIndicator;const AFileName: string);
 
1123
var EC: PCodeEditorCore;
 
1124
begin
 
1125
  EC:=SearchCoreForFileName(AFileName);
 
1126
  inherited Init(Bounds,AHScrollBar,AVScrollBar,AIndicator,EC,AFileName);
 
1127
  SetStoreUndo(true);
 
1128
  CompileStamp:=0;
 
1129
end;
 
1130
 
 
1131
Const
 
1132
  FreePascalSpecSymbolCount : array [TSpecSymbolClass] of integer =
 
1133
  (
 
1134
    3,{ssCommentPrefix}
 
1135
    1,{ssCommentSingleLinePrefix}
 
1136
    2,{ssCommentSuffix}
 
1137
    1,{ssStringPrefix}
 
1138
    1,{ssStringSuffix}
 
1139
    1,{ssDirectivePrefix}
 
1140
    1,{ssDirectiveSuffix}
 
1141
    1,{ssAsmPrefix}
 
1142
    1 {ssAsmSuffix}
 
1143
  );
 
1144
 
 
1145
  FreePascalEmptyString : string[1] = '';
 
1146
  FreePascalCommentPrefix1 : string[1] = '{';
 
1147
  FreePascalCommentPrefix2 : string[2] = '(*';
 
1148
  FreePascalCommentPrefix3 : string[2] = '//';
 
1149
  FreePascalCommentSingleLinePrefix : string[2] = '//';
 
1150
  FreePascalCommentSuffix1 : string[1] = '}';
 
1151
  FreePascalCommentSuffix2 : string[2] = '*)';
 
1152
  FreePascalStringPrefix : string[1] = '''';
 
1153
  FreePascalStringSuffix : string[1] = '''';
 
1154
  FreePascalDirectivePrefix : string[2] = '{$';
 
1155
  FreePascalDirectiveSuffix : string[1] = '}';
 
1156
  FreePascalAsmPrefix : string[3] = 'ASM';
 
1157
  FreePascalAsmSuffix : string[3] = 'END';
 
1158
 
 
1159
function TSourceEditor.GetSpecSymbolCount(SpecClass: TSpecSymbolClass): integer;
 
1160
begin
 
1161
  GetSpecSymbolCount:=FreePascalSpecSymbolCount[SpecClass];
 
1162
end;
 
1163
 
 
1164
function TSourceEditor.GetSpecSymbol(SpecClass: TSpecSymbolClass; Index: integer): pstring;
 
1165
begin
 
1166
  GetSpecSymbol:=@FreePascalEmptyString;
 
1167
  case SpecClass of
 
1168
    ssCommentPrefix :
 
1169
      case Index of
 
1170
        0 : GetSpecSymbol:=@FreePascalCommentPrefix1;
 
1171
        1 : GetSpecSymbol:=@FreePascalCommentPrefix2;
 
1172
        2 : GetSpecSymbol:=@FreePascalCommentPrefix3;
 
1173
      end;
 
1174
    ssCommentSingleLinePrefix :
 
1175
      case Index of
 
1176
        0 : GetSpecSymbol:=@FreePascalCommentSingleLinePrefix;
 
1177
      end;
 
1178
    ssCommentSuffix :
 
1179
      case Index of
 
1180
        0 : GetSpecSymbol:=@FreePascalCommentSuffix1;
 
1181
        1 : GetSpecSymbol:=@FreePascalCommentSuffix2;
 
1182
      end;
 
1183
    ssStringPrefix :
 
1184
      GetSpecSymbol:=@FreePascalStringPrefix;
 
1185
    ssStringSuffix :
 
1186
      GetSpecSymbol:=@FreePascalStringSuffix;
 
1187
    { must be uppercased to avoid calling UpCaseStr in MatchesAnyAsmSymbol PM }
 
1188
    ssAsmPrefix :
 
1189
      GetSpecSymbol:=@FreePascalAsmPrefix;
 
1190
    ssAsmSuffix :
 
1191
      GetSpecSymbol:=@FreePascalAsmSuffix;
 
1192
    ssDirectivePrefix :
 
1193
      GetSpecSymbol:=@FreePascalDirectivePrefix;
 
1194
    ssDirectiveSuffix :
 
1195
      GetSpecSymbol:=@FreePascalDirectiveSuffix;
 
1196
  end;
 
1197
end;
 
1198
 
 
1199
function TSourceEditor.IsReservedWord(const S: string): boolean;
 
1200
begin
 
1201
  IsReservedWord:=IsFPReservedWord(S);
 
1202
end;
 
1203
 
 
1204
function TSourceEditor.IsAsmReservedWord(const S: string): boolean;
 
1205
begin
 
1206
  IsAsmReservedWord:=IsFPAsmReservedWord(S);
 
1207
end;
 
1208
 
 
1209
function TSourceEditor.TranslateCodeTemplate(var Shortcut: string; ALines: PUnsortedStringCollection): boolean;
 
1210
begin
 
1211
  TranslateCodeTemplate:=FPTranslateCodeTemplate(ShortCut,ALines);
 
1212
end;
 
1213
 
 
1214
function TSourceEditor.SelectCodeTemplate(var ShortCut: string): boolean;
 
1215
var D: PCodeTemplatesDialog;
 
1216
    OK: boolean;
 
1217
begin
 
1218
  New(D, Init(true,ShortCut));
 
1219
  OK:=Desktop^.ExecView(D)=cmOK;
 
1220
  if OK then ShortCut:=D^.GetSelectedShortCut;
 
1221
  Dispose(D, Done);
 
1222
  SelectCodeTemplate:=OK;
 
1223
end;
 
1224
 
 
1225
function TSourceEditor.CompleteCodeWord(const WordS: string; var Text: string): boolean;
 
1226
begin
 
1227
  CompleteCodeWord:=FPCompleteCodeWord(WordS,Text);
 
1228
end;
 
1229
 
 
1230
procedure TSourceEditor.FindMatchingDelimiter(ScanForward: boolean);
 
1231
var
 
1232
  St,nextResWord : String;
 
1233
  LineText,LineAttr: string;
 
1234
  Res,found,addit : boolean;
 
1235
  JumpPos: TPoint;
 
1236
  X,Y,lexchange,curlevel,linecount : sw_integer;
 
1237
 
 
1238
   function GetLexChange(const S : string) : sw_integer;
 
1239
   begin
 
1240
     if (S='END') or (S='THEN') or (S='UNTIL') then
 
1241
       GetLexChange:=-1
 
1242
     else if (S='ASM') or (S='BEGIN') or (S='CASE') or (S='CLASS') or
 
1243
        (S='IF') or (S='OBJECT') or (S='RECORD') or (S='REPEAT') then
 
1244
       GetLexChange:=+1
 
1245
     else
 
1246
       GetLexChange:=0;
 
1247
   end;
 
1248
 
 
1249
begin
 
1250
  st:=UpcaseStr(GetCurrentWord);
 
1251
  if st<>'' then
 
1252
    Res:=IsReservedWord(St)
 
1253
  else
 
1254
    Res:=false;
 
1255
  LexChange:=GetLexChange(St);
 
1256
  if not res or (LexChange=0) or not
 
1257
     IsFlagSet(efSyntaxHighlight) then
 
1258
    Inherited FindMatchingDelimiter(ScanForward)
 
1259
  else
 
1260
    begin
 
1261
      JumpPos.X:=-1; JumpPos.Y:=-1;
 
1262
      Y:=CurPos.Y; X:=CurPos.X;
 
1263
      found:=false;
 
1264
      LineCount:=0;
 
1265
      curlevel:=lexchange;
 
1266
      if LexChange>0 then
 
1267
        begin
 
1268
          repeat
 
1269
            Inc(LineCount);
 
1270
            NextResWord:='';
 
1271
            GetDisplayTextFormat(Y,LineText,LineAttr);
 
1272
            if LineCount<>1 then X:=-1
 
1273
            else if ord(LineAttr[X+1])<>coReservedWordColor then
 
1274
              exit;
 
1275
            repeat
 
1276
              Inc(X);
 
1277
              if X<length(LineText) then
 
1278
               begin
 
1279
                 AddIt:=ord(LineAttr[X+1])=coReservedWordColor;
 
1280
                 if AddIt then
 
1281
                   NextResWord:=NextResWord+UpCase(LineText[X+1]);
 
1282
               end;
 
1283
              if ((X=length(LineText)) or (Not AddIt)) and
 
1284
                 (NextResWord<>'') and
 
1285
                 IsReservedWord(NextResWord) then
 
1286
                begin
 
1287
                  LexChange:=GetLexChange(NextResWord);
 
1288
                  CurLevel:=CurLevel+LexChange;
 
1289
                  if CurLevel=0 then
 
1290
                    begin
 
1291
                      JumpPos.X:=X-Length(NextResWord);
 
1292
                      JumpPos.Y:=Y;
 
1293
                    end;
 
1294
                  NextResWord:='';
 
1295
                end;
 
1296
            until (X>=length(LineText)) or (JumpPos.X<>-1);
 
1297
            Inc(Y);
 
1298
          until (Y>=GetLineCount) or (JumpPos.X<>-1);
 
1299
          if (Y=GetLineCount) and (JumpPos.X=-1) then
 
1300
            begin
 
1301
              ErrorBox('No match',nil);
 
1302
              exit;
 
1303
            end;
 
1304
        end
 
1305
      else if (LexChange<0) then
 
1306
        begin
 
1307
          repeat
 
1308
            Inc(LineCount);
 
1309
            NextResWord:='';
 
1310
            GetDisplayTextFormat(Y,LineText,LineAttr);
 
1311
            if LineCount<>1 then
 
1312
              X:=Length(LineText)
 
1313
            else if ord(LineAttr[X+1])<>coReservedWordColor then
 
1314
              exit;
 
1315
            repeat
 
1316
              Dec(X);
 
1317
              if X>=0 then
 
1318
               begin
 
1319
                 AddIt:=ord(LineAttr[X+1])=coReservedWordColor;
 
1320
                 if AddIt then
 
1321
                   NextResWord:=UpCase(LineText[X+1])+NextResWord;
 
1322
               end;
 
1323
              if ((X=0) or (Not AddIt)) and
 
1324
                 (NextResWord<>'') and
 
1325
                 IsReservedWord(NextResWord) then
 
1326
                begin
 
1327
                  LexChange:=GetLexChange(NextResWord);
 
1328
                  CurLevel:=CurLevel+LexChange;
 
1329
                  if CurLevel=0 then
 
1330
                    begin
 
1331
                      if AddIt then
 
1332
                        JumpPos.X:=X
 
1333
                      else
 
1334
                        JumpPos.X:=X+1;
 
1335
                      JumpPos.Y:=Y;
 
1336
                    end;
 
1337
                  NextResWord:='';
 
1338
                end;
 
1339
            until (X<=0) or (JumpPos.X<>-1);
 
1340
            Dec(Y);
 
1341
          until (Y<0) or (JumpPos.X<>-1);
 
1342
          if (Y<0) and (JumpPos.X=-1) then
 
1343
            begin
 
1344
              ErrorBox('No match',nil);
 
1345
              exit;
 
1346
            end;
 
1347
        end;
 
1348
      if JumpPos.X<>-1 then
 
1349
      begin
 
1350
        SetCurPtr(JumpPos.X,JumpPos.Y);
 
1351
        TrackCursor(true);
 
1352
      end;
 
1353
    end;
 
1354
end;
 
1355
 
 
1356
procedure TSourceEditor.SetCodeCompleteWord(const S: string);
 
1357
var R: TRect;
 
1358
begin
 
1359
  inherited SetCodeCompleteWord(S);
 
1360
  if S='' then
 
1361
    begin
 
1362
      if Assigned(CodeCompleteTip) then Dispose(CodeCompleteTip, Done);
 
1363
      CodeCompleteTip:=nil;
 
1364
    end
 
1365
  else
 
1366
    begin
 
1367
      R.Assign(0,0,20,1);
 
1368
      if Assigned(CodeCompleteTip)=false then
 
1369
        begin
 
1370
          New(CodeCompleteTip, Init(R, S, alCenter));
 
1371
          CodeCompleteTip^.Hide;
 
1372
          Application^.Insert(CodeCompleteTip);
 
1373
        end
 
1374
      else
 
1375
        CodeCompleteTip^.SetText(S);
 
1376
      AlignCodeCompleteTip;
 
1377
    end;
 
1378
end;
 
1379
 
 
1380
procedure TSourceEditor.AlignCodeCompleteTip;
 
1381
var P: TPoint;
 
1382
    S: string;
 
1383
    R: TRect;
 
1384
begin
 
1385
  if Assigned(CodeCompleteTip)=false then Exit;
 
1386
  S:=CodeCompleteTip^.GetText;
 
1387
  P.Y:=CurPos.Y;
 
1388
  { determine the center of current word fragment }
 
1389
  P.X:=CurPos.X-(length(GetCodeCompleteFrag) div 2);
 
1390
  { calculate position for centering the complete word over/below the current }
 
1391
  P.X:=P.X-(length(S) div 2);
 
1392
 
 
1393
  P.X:=P.X-Delta.X;
 
1394
  P.Y:=P.Y-Delta.Y;
 
1395
  MakeGlobal(P,P);
 
1396
  if Assigned(CodeCompleteTip^.Owner) then
 
1397
    CodeCompleteTip^.Owner^.MakeLocal(P,P);
 
1398
 
 
1399
  { ensure that the tooltip stays in screen }
 
1400
  P.X:=Min(Max(0,P.X),ScreenWidth-length(S)-2-1);
 
1401
  { align it vertically }
 
1402
  if P.Y>round(ScreenHeight*3/4) then
 
1403
    Dec(P.Y)
 
1404
  else
 
1405
    Inc(P.Y);
 
1406
  R.Assign(P.X,P.Y,P.X+1+length(S)+1,P.Y+1);
 
1407
  CodeCompleteTip^.Locate(R);
 
1408
  if CodeCompleteTip^.GetState(sfVisible)=false then
 
1409
    CodeCompleteTip^.Show;
 
1410
end;
 
1411
 
 
1412
procedure TSourceEditor.ModifiedChanged;
 
1413
begin
 
1414
  inherited ModifiedChanged;
 
1415
  if (@Self<>Clipboard) and GetModified then
 
1416
    begin
 
1417
      { global flags }
 
1418
      EditorModified:=true;
 
1419
      { reset compile flags as the file is
 
1420
      not the same as at the compilation anymore }
 
1421
      CompileStamp:=-1;
 
1422
    end;
 
1423
end;
 
1424
 
 
1425
procedure TSourceEditor.InsertOptions;
 
1426
var C: PUnsortedStringCollection;
 
1427
    Y: sw_integer;
 
1428
    S: string;
 
1429
begin
 
1430
  Lock;
 
1431
  New(C, Init(10,10));
 
1432
  GetCompilerOptionLines(C);
 
1433
  if C^.Count>0 then
 
1434
  begin
 
1435
    for Y:=0 to C^.Count-1 do
 
1436
    begin
 
1437
      S:=C^.At(Y)^;
 
1438
      InsertLine(Y,S);
 
1439
    end;
 
1440
    AdjustSelectionPos(0,0,0,C^.Count);
 
1441
    UpdateAttrs(0,attrAll);
 
1442
    DrawLines(0);
 
1443
    SetModified(true);
 
1444
  end;
 
1445
  Dispose(C, Done);
 
1446
  UnLock;
 
1447
end;
 
1448
 
 
1449
procedure  TSourceEditor.PushInfo(Const st : string);
 
1450
begin
 
1451
  PushStatus(st);
 
1452
end;
 
1453
 
 
1454
procedure  TSourceEditor.PopInfo;
 
1455
begin
 
1456
  PopStatus;
 
1457
end;
 
1458
 
 
1459
procedure TSourceEditor.DeleteLine(I: sw_integer);
 
1460
begin
 
1461
  inherited DeleteLine(I);
 
1462
{$ifndef NODEBUG}
 
1463
  If ShouldHandleBreakpoints then
 
1464
    BreakpointsCollection^.AdaptBreakpoints(@Self,I,-1);
 
1465
{$endif NODEBUG}
 
1466
end;
 
1467
 
 
1468
procedure TSourceEditor.BackSpace;
 
1469
{$ifndef NODEBUG}
 
1470
var
 
1471
  MoveBreakpointToPreviousLine,WasEnabled : boolean;
 
1472
  PBStart,PBEnd : PBreakpoint;
 
1473
  I : longint;
 
1474
{$endif NODEBUG}
 
1475
begin
 
1476
{$ifdef NODEBUG}
 
1477
  inherited Backspace;
 
1478
{$else}
 
1479
  MoveBreakpointToPreviousLine:=(CurPos.X=0) and (CurPos.Y>0);
 
1480
  If MoveBreakpointToPreviousLine then
 
1481
    begin
 
1482
      ShouldHandleBreakpoints:=false;
 
1483
      I:=CurPos.Y+1;
 
1484
      PBEnd:=BreakpointsCollection^.FindBreakpointAt(@Self,I);
 
1485
      PBStart:=BreakpointsCollection^.FindBreakpointAt(@Self,I-1);
 
1486
    end;
 
1487
  inherited Backspace;
 
1488
  if MoveBreakpointToPreviousLine then
 
1489
    begin
 
1490
      ShouldHandleBreakpoints:=true;
 
1491
      if assigned(PBEnd) then
 
1492
        begin
 
1493
          if assigned(PBStart) then
 
1494
            begin
 
1495
              if PBEnd^.state=bs_enabled then
 
1496
                PBStart^.state:=bs_enabled;
 
1497
              BreakpointsCollection^.Free(PBEnd);
 
1498
            end
 
1499
          else
 
1500
            begin
 
1501
              WasEnabled:=PBEnd^.state=bs_enabled;
 
1502
              if WasEnabled then
 
1503
                begin
 
1504
                  PBEnd^.state:=bs_disabled;
 
1505
                  PBEnd^.UpdateSource;
 
1506
                end;
 
1507
              PBEnd^.line:=I-1;
 
1508
              if WasEnabled then
 
1509
                begin
 
1510
                  PBEnd^.state:=bs_enabled;
 
1511
                  PBEnd^.UpdateSource;
 
1512
                end;
 
1513
            end;
 
1514
        end;
 
1515
      BreakpointsCollection^.AdaptBreakpoints(@Self,I,-1);
 
1516
    end;
 
1517
{$endif NODEBUG}
 
1518
end;
 
1519
 
 
1520
function TSourceEditor.InsertNewLine : Sw_integer;
 
1521
{$ifndef NODEBUG}
 
1522
var
 
1523
  MoveBreakpointToNextLine : boolean;
 
1524
  I : longint;
 
1525
{$endif NODEBUG}
 
1526
begin
 
1527
{$ifdef NODEBUG}
 
1528
  InsertNewLine:=inherited InsertNewLine;
 
1529
{$else}
 
1530
  ShouldHandleBreakpoints:=false;
 
1531
  MoveBreakpointToNextLine:=Cursor.x<Length(RTrim(GetDisplayText(CurPos.Y)));
 
1532
  I:=CurPos.Y+1;
 
1533
  InsertNewLine:=inherited InsertNewLine;
 
1534
  if MoveBreakpointToNextLine then
 
1535
    BreakpointsCollection^.AdaptBreakpoints(@Self,I-1,1)
 
1536
  else
 
1537
    BreakpointsCollection^.AdaptBreakpoints(@Self,I,1);
 
1538
  ShouldHandleBreakpoints:=true;
 
1539
{$endif NODEBUG}
 
1540
end;
 
1541
 
 
1542
procedure TSourceEditor.DelChar;
 
1543
var
 
1544
  S: string;
 
1545
  I,CI : sw_integer;
 
1546
{$ifndef NODEBUG}
 
1547
  PBStart,PBEnd : PBreakpoint;
 
1548
  MoveBreakpointOneLineUp,WasEnabled : boolean;
 
1549
{$endif NODEBUG}
 
1550
begin
 
1551
  if IsReadOnly then Exit;
 
1552
  S:=GetLineText(CurPos.Y);
 
1553
  I:=CurPos.Y+1;
 
1554
  CI:=LinePosToCharIdx(CurPos.Y,CurPos.X);
 
1555
{$ifndef NODEBUG}
 
1556
  if ((CI>length(S)) or (S='')) and (CurPos.Y<GetLineCount-1) then
 
1557
    begin
 
1558
      MoveBreakpointOneLineUp:=true;
 
1559
      ShouldHandleBreakpoints:=false;
 
1560
      PBEnd:=BreakpointsCollection^.FindBreakpointAt(@Self,I+1);
 
1561
      PBStart:=BreakpointsCollection^.FindBreakpointAt(@Self,I);
 
1562
    end
 
1563
  else
 
1564
    MoveBreakpointOneLineUp:=false;
 
1565
{$endif NODEBUG}
 
1566
  Inherited DelChar;
 
1567
{$ifndef NODEBUG}
 
1568
  if MoveBreakpointOneLineUp then
 
1569
    begin
 
1570
      ShouldHandleBreakpoints:=true;
 
1571
      if assigned(PBEnd) then
 
1572
        begin
 
1573
          if assigned(PBStart) then
 
1574
            begin
 
1575
              if PBEnd^.state=bs_enabled then
 
1576
                PBStart^.state:=bs_enabled;
 
1577
              BreakpointsCollection^.Free(PBEnd);
 
1578
            end
 
1579
          else
 
1580
            begin
 
1581
              WasEnabled:=PBEnd^.state=bs_enabled;
 
1582
              if WasEnabled then
 
1583
                begin
 
1584
                  PBEnd^.state:=bs_disabled;
 
1585
                  PBEnd^.UpdateSource;
 
1586
                end;
 
1587
              PBEnd^.line:=I;
 
1588
              if WasEnabled then
 
1589
                begin
 
1590
                  PBEnd^.state:=bs_enabled;
 
1591
                  PBEnd^.UpdateSource;
 
1592
                end;
 
1593
            end;
 
1594
        end;
 
1595
      BreakpointsCollection^.AdaptBreakpoints(@Self,I,-1);
 
1596
    end;
 
1597
{$endif NODEBUG}
 
1598
end;
 
1599
 
 
1600
procedure TSourceEditor.DelSelect;
 
1601
{$ifndef NODEBUG}
 
1602
var
 
1603
  MoveBreakpointToFirstLine,WasEnabled : boolean;
 
1604
  PBStart,PBEnd : PBreakpoint;
 
1605
  I,J : longint;
 
1606
{$endif NODEBUG}
 
1607
begin
 
1608
{$ifdef NODEBUG}
 
1609
  inherited DelSelect;
 
1610
{$else}
 
1611
  ShouldHandleBreakpoints:=false;
 
1612
  J:=SelEnd.Y-SelStart.Y;
 
1613
  MoveBreakpointToFirstLine:=J>0;
 
1614
  PBEnd:=BreakpointsCollection^.FindBreakpointAt(@Self,SelEnd.Y);
 
1615
  PBStart:=BreakpointsCollection^.FindBreakpointAt(@Self,SelEnd.Y);
 
1616
  I:=SelStart.Y;
 
1617
  inherited DelSelect;
 
1618
  if MoveBreakpointToFirstLine and assigned(PBEnd) then
 
1619
    begin
 
1620
      If assigned(PBStart) then
 
1621
        begin
 
1622
          if PBEnd^.state=bs_enabled then
 
1623
            PBStart^.state:=bs_enabled;
 
1624
          BreakpointsCollection^.Free(PBEnd);
 
1625
        end
 
1626
      else
 
1627
        begin
 
1628
          WasEnabled:=PBEnd^.state=bs_enabled;
 
1629
          if WasEnabled then
 
1630
            begin
 
1631
              PBEnd^.state:=bs_disabled;
 
1632
              PBEnd^.UpdateSource;
 
1633
            end;
 
1634
          PBEnd^.line:=I;
 
1635
          if WasEnabled then
 
1636
            begin
 
1637
              PBEnd^.state:=bs_enabled;
 
1638
              PBEnd^.UpdateSource;
 
1639
            end;
 
1640
        end;
 
1641
    end;
 
1642
  BreakpointsCollection^.AdaptBreakpoints(@Self,I,-J);
 
1643
  ShouldHandleBreakpoints:=true;
 
1644
{$endif NODEBUG}
 
1645
end;
 
1646
 
 
1647
 
 
1648
function TSourceEditor.InsertLine(LineNo: sw_integer; const S: string): PCustomLine;
 
1649
begin
 
1650
  InsertLine := inherited InsertLine(LineNo,S);
 
1651
{$ifndef NODEBUG}
 
1652
  If ShouldHandleBreakpoints then
 
1653
    BreakpointsCollection^.AdaptBreakpoints(@Self,LineNo,1);
 
1654
{$endif NODEBUG}
 
1655
end;
 
1656
 
 
1657
procedure TSourceEditor.AddLine(const S: string);
 
1658
begin
 
1659
  inherited AddLine(S);
 
1660
{$ifndef NODEBUG}
 
1661
  BreakpointsCollection^.AdaptBreakpoints(@Self,GetLineCount,1);
 
1662
{$endif NODEBUG}
 
1663
end;
 
1664
 
 
1665
 
 
1666
 
 
1667
function TSourceEditor.GetLocalMenu: PMenu;
 
1668
var M: PMenu;
 
1669
    MI: PMenuItem;
 
1670
begin
 
1671
  MI:=
 
1672
    NewItem(menu_edit_cut,menu_key_edit_cut,kbShiftDel,cmCut,hcCut,
 
1673
    NewItem(menu_edit_copy,menu_key_edit_copy,kbCtrlIns,cmCopy,hcCopy,
 
1674
    NewItem(menu_edit_paste,menu_key_edit_paste,kbShiftIns,cmPaste,hcPaste,
 
1675
    NewItem(menu_edit_clear,menu_key_edit_clear,kbCtrlDel,cmClear,hcClear,
 
1676
    NewLine(
 
1677
    NewItem(menu_srclocal_openfileatcursor,'',kbNoKey,cmOpenAtCursor,hcOpenAtCursor,
 
1678
    NewItem(menu_srclocal_browseatcursor,'',kbNoKey,cmBrowseAtCursor,hcBrowseAtCursor,
 
1679
    NewItem(menu_srclocal_topicsearch,menu_key_help_topicsearch,kbCtrlF1,cmHelpTopicSearch,hcHelpTopicSearch,
 
1680
    NewLine(
 
1681
    NewItem(menu_srclocal_options,'',kbNoKey,cmEditorOptions,hcEditorOptions,
 
1682
    nil))))))))));
 
1683
  if IsChangedOnDisk then
 
1684
    MI:=NewItem(menu_srclocal_reload,'',kbNoKey,cmDoReload,hcDoReload,
 
1685
      MI);
 
1686
  M:=NewMenu(MI);
 
1687
  GetLocalMenu:=M;
 
1688
end;
 
1689
 
 
1690
function TSourceEditor.GetCommandTarget: PView;
 
1691
begin
 
1692
  GetCommandTarget:=@Self;
 
1693
end;
 
1694
 
 
1695
function TSourceEditor.CreateLocalMenuView(var Bounds: TRect; M: PMenu): PMenuPopup;
 
1696
var MV: PAdvancedMenuPopup;
 
1697
begin
 
1698
  New(MV, Init(Bounds,M));
 
1699
  CreateLocalMenuView:=MV;
 
1700
end;
 
1701
 
 
1702
{$ifdef DebugUndo}
 
1703
procedure TSourceEditor.DumpUndo;
 
1704
var
 
1705
  i : sw_integer;
 
1706
begin
 
1707
  ClearToolMessages;
 
1708
  AddToolCommand('UndoList Dump');
 
1709
  for i:=0 to Core^.UndoList^.count-1 do
 
1710
    with Core^.UndoList^.At(i)^ do
 
1711
      begin
 
1712
       if is_grouped_action then
 
1713
         AddToolMessage('','Group '+ActionString[action]+' '+IntToStr(ActionCount)+' elementary actions',0,0)
 
1714
       else
 
1715
         AddToolMessage('',ActionString[action]+' '+IntToStr(StartPos.Y+1)+':'+IntToStr(StartPos.X+1)+
 
1716
           ' '+IntToStr(EndPos.Y+1)+':'+IntToStr(EndPos.X+1)+' "'+GetStr(Text)+'"',0,0);
 
1717
      end;
 
1718
  if Core^.RedoList^.count>0 then
 
1719
    AddToolCommand('RedoList Dump');
 
1720
  for i:=0 to Core^.RedoList^.count-1 do
 
1721
    with Core^.RedoList^.At(i)^ do
 
1722
      begin
 
1723
       if is_grouped_action then
 
1724
         AddToolMessage('','Group '+ActionString[action]+' '+IntToStr(ActionCount)+' elementary actions',0,0)
 
1725
       else
 
1726
         AddToolMessage('',ActionString[action]+' '+IntToStr(StartPos.Y+1)+':'+IntToStr(StartPos.X+1)+
 
1727
         ' '+IntToStr(EndPos.Y+1)+':'+IntToStr(EndPos.X+1)+' "'+GetStr(Text)+'"',0,0);
 
1728
      end;
 
1729
  UpdateToolMessages;
 
1730
  if Assigned(MessagesWindow) then
 
1731
    MessagesWindow^.Focus;
 
1732
end;
 
1733
 
 
1734
procedure TSourceEditor.UndoAll;
 
1735
begin
 
1736
  While Core^.UndoList^.count>0 do
 
1737
    Undo;
 
1738
end;
 
1739
 
 
1740
procedure TSourceEditor.RedoAll;
 
1741
begin
 
1742
  While Core^.RedoList^.count>0 do
 
1743
    Redo;
 
1744
end;
 
1745
 
 
1746
{$endif DebugUndo}
 
1747
 
 
1748
function TSourceEditor.Valid(Command: Word): Boolean;
 
1749
var OK: boolean;
 
1750
begin
 
1751
  OK:=inherited Valid(Command);
 
1752
  if OK and ({(Command=cmClose) or already handled in TFileEditor.Valid PM }
 
1753
     (Command=cmAskSaveAll)) then
 
1754
    if IsClipboard=false then
 
1755
      OK:=SaveAsk(false);
 
1756
  Valid:=OK;
 
1757
end;
 
1758
 
 
1759
 
 
1760
procedure TSourceEditor.HandleEvent(var Event: TEvent);
 
1761
var DontClear: boolean;
 
1762
    S: string;
 
1763
begin
 
1764
  TranslateMouseClick(@Self,Event);
 
1765
  case Event.What of
 
1766
    evKeyDown :
 
1767
      begin
 
1768
        DontClear:=false;
 
1769
        case Event.KeyCode of
 
1770
          kbCtrlEnter :
 
1771
            Message(@Self,evCommand,cmOpenAtCursor,nil);
 
1772
        else DontClear:=true;
 
1773
        end;
 
1774
        if not DontClear then ClearEvent(Event);
 
1775
      end;
 
1776
  end;
 
1777
  inherited HandleEvent(Event);
 
1778
  case Event.What of
 
1779
    evBroadcast :
 
1780
      case Event.Command of
 
1781
          cmCalculatorPaste :
 
1782
            begin
 
1783
              InsertText(FloatToStr(CalcClipboard,0));
 
1784
              ClearEvent(Event);
 
1785
            end;
 
1786
      end;
 
1787
    evCommand :
 
1788
      begin
 
1789
        DontClear:=false;
 
1790
        case Event.Command of
 
1791
{$ifdef DebugUndo}
 
1792
          cmDumpUndo    : DumpUndo;
 
1793
          cmUndoAll     : UndoAll;
 
1794
          cmRedoAll     : RedoAll;
 
1795
{$endif DebugUndo}
 
1796
          cmDoReload : ReloadFile;
 
1797
          cmBrowseAtCursor:
 
1798
            begin
 
1799
              S:=LowerCaseStr(GetEditorCurWord(@Self,[]));
 
1800
              OpenOneSymbolBrowser(S);
 
1801
            end;
 
1802
          cmOpenAtCursor :
 
1803
            begin
 
1804
              S:=LowerCaseStr(GetEditorCurWord(@Self,['.']));
 
1805
              if Pos('.',S)<>0 then
 
1806
                OpenFileName:=S else
 
1807
              OpenFileName:=S+'.pp'+ListSeparator+
 
1808
                            S+'.pas'+ListSeparator+
 
1809
                            S+'.inc';
 
1810
              Message(Application,evCommand,cmOpen,nil);
 
1811
            end;
 
1812
          cmEditorOptions :
 
1813
            Message(Application,evCommand,cmEditorOptions,@Self);
 
1814
          cmHelp :
 
1815
            Message(@Self,evCommand,cmHelpTopicSearch,@Self);
 
1816
          cmHelpTopicSearch :
 
1817
            HelpTopicSearch(@Self);
 
1818
        else DontClear:=true;
 
1819
        end;
 
1820
        if not DontClear then ClearEvent(Event);
 
1821
      end;
 
1822
  end;
 
1823
end;
 
1824
 
 
1825
constructor TFPHeapView.Init(var Bounds: TRect);
 
1826
begin
 
1827
  if inherited Init(Bounds)=false then Fail;
 
1828
  Options:=Options or gfGrowHiX or gfGrowHiY;
 
1829
  EventMask:=EventMask or evIdle;
 
1830
  GrowMode:=gfGrowAll;
 
1831
end;
 
1832
 
 
1833
constructor TFPHeapView.InitKb(var Bounds: TRect);
 
1834
begin
 
1835
  if inherited InitKb(Bounds)=false then Fail;
 
1836
  Options:=Options or gfGrowHiX or gfGrowHiY;
 
1837
  EventMask:=EventMask or evIdle;
 
1838
  GrowMode:=gfGrowAll;
 
1839
end;
 
1840
 
 
1841
procedure TFPHeapView.HandleEvent(var Event: TEvent);
 
1842
begin
 
1843
  case Event.What of
 
1844
    evIdle :
 
1845
      Update;
 
1846
  end;
 
1847
  inherited HandleEvent(Event);
 
1848
end;
 
1849
 
 
1850
constructor TFPClockView.Init(var Bounds: TRect);
 
1851
begin
 
1852
  inherited Init(Bounds);
 
1853
  EventMask:=EventMask or evIdle;
 
1854
end;
 
1855
 
 
1856
procedure TFPClockView.HandleEvent(var Event: TEvent);
 
1857
begin
 
1858
  case Event.What of
 
1859
    evIdle :
 
1860
      Update;
 
1861
  end;
 
1862
  inherited HandleEvent(Event);
 
1863
end;
 
1864
 
 
1865
function TFPClockView.GetPalette: PPalette;
 
1866
const P: string[length(CFPClockView)] = CFPClockView;
 
1867
begin
 
1868
  GetPalette:=@P;
 
1869
end;
 
1870
 
 
1871
procedure TFPWindow.SetState(AState: Word; Enable: Boolean);
 
1872
var OldState: word;
 
1873
begin
 
1874
  OldState:=State;
 
1875
  inherited SetState(AState,Enable);
 
1876
  if AutoNumber then
 
1877
    if (AState and (sfVisible+sfExposed))<>0 then
 
1878
      if GetState(sfVisible+sfExposed) then
 
1879
        begin
 
1880
          if Number=0 then
 
1881
            Number:=SearchFreeWindowNo;
 
1882
          ReDraw;
 
1883
        end
 
1884
      else
 
1885
        Number:=0;
 
1886
  if ((AState and sfActive)<>0) and (((OldState xor State) and sfActive)<>0) then
 
1887
    UpdateCommands;
 
1888
end;
 
1889
 
 
1890
procedure TFPWindow.UpdateCommands;
 
1891
begin
 
1892
end;
 
1893
 
 
1894
procedure TFPWindow.Update;
 
1895
begin
 
1896
  ReDraw;
 
1897
end;
 
1898
 
 
1899
procedure   TFPWindow.SelectInDebugSession;
 
1900
var
 
1901
  F,PrevCurrent : PView;
 
1902
begin
 
1903
  DeskTop^.Lock;
 
1904
  PrevCurrent:=Desktop^.Current;
 
1905
  F:=PrevCurrent;
 
1906
  While assigned(F) and
 
1907
    ((F^.HelpCtx = hcGDBWindow) or
 
1908
     (F^.HelpCtx = hcdisassemblyWindow) or
 
1909
     (F^.HelpCtx = hcWatchesWindow) or
 
1910
     (F^.HelpCtx = hcStackWindow) or
 
1911
     (F^.HelpCtx = hcRegistersWindow) or
 
1912
     (F^.HelpCtx = hcVectorRegisters) or
 
1913
     (F^.HelpCtx = hcFPURegisters)) do
 
1914
    F:=F^.NextView;
 
1915
  if F<>@Self then
 
1916
    Select;
 
1917
  if PrevCurrent<>F then
 
1918
    Begin
 
1919
      Desktop^.InsertBefore(@self,F);
 
1920
      PrevCurrent^.Select;
 
1921
    End;
 
1922
  DeskTop^.Unlock;
 
1923
end;
 
1924
 
 
1925
procedure TFPWindow.HandleEvent(var Event: TEvent);
 
1926
begin
 
1927
  case Event.What of
 
1928
    evBroadcast :
 
1929
      case Event.Command of
 
1930
        cmUpdate :
 
1931
          Update;
 
1932
        cmSearchWindow+1..cmSearchWindow+99 :
 
1933
          if (Event.Command-cmSearchWindow=Number) then
 
1934
              ClearEvent(Event);
 
1935
      end;
 
1936
  end;
 
1937
  inherited HandleEvent(Event);
 
1938
end;
 
1939
 
 
1940
 
 
1941
constructor TFPWindow.Load(var S: TStream);
 
1942
begin
 
1943
  inherited Load(S);
 
1944
  S.Read(AutoNumber,SizeOf(AutoNumber));
 
1945
end;
 
1946
 
 
1947
procedure TFPWindow.Store(var S: TStream);
 
1948
begin
 
1949
  inherited Store(S);
 
1950
  S.Write(AutoNumber,SizeOf(AutoNumber));
 
1951
end;
 
1952
 
 
1953
function TFPHelpViewer.GetLocalMenu: PMenu;
 
1954
var M: PMenu;
 
1955
begin
 
1956
  M:=NewMenu(
 
1957
    NewItem(menu_hlplocal_contents,'',kbNoKey,cmHelpContents,hcHelpContents,
 
1958
    NewItem(menu_hlplocal_index,menu_key_hlplocal_index,kbShiftF1,cmHelpIndex,hcHelpIndex,
 
1959
    NewItem(menu_hlplocal_topicsearch,menu_key_hlplocal_topicsearch,kbCtrlF1,cmHelpTopicSearch,hcHelpTopicSearch,
 
1960
    NewItem(menu_hlplocal_prevtopic,menu_key_hlplocal_prevtopic,kbAltF1,cmHelpPrevTopic,hcHelpPrevTopic,
 
1961
    NewLine(
 
1962
    NewItem(menu_hlplocal_copy,menu_key_hlplocal_copy,kbCtrlIns,cmCopy,hcCopy,
 
1963
    nil)))))));
 
1964
  GetLocalMenu:=M;
 
1965
end;
 
1966
 
 
1967
function TFPHelpViewer.GetCommandTarget: PView;
 
1968
begin
 
1969
  GetCommandTarget:=Application;
 
1970
end;
 
1971
 
 
1972
constructor TFPHelpWindow.Init(var Bounds: TRect; ATitle: TTitleStr; ASourceFileID: word;
 
1973
  AContext: THelpCtx; ANumber: Integer);
 
1974
begin
 
1975
  inherited Init(Bounds,ATitle,ASourceFileID,AContext,ANumber);
 
1976
  HelpCtx:=hcHelpWindow;
 
1977
  HideOnClose:=true;
 
1978
end;
 
1979
 
 
1980
destructor TFPHelpWindow.Done;
 
1981
begin
 
1982
  if HelpWindow=@Self then
 
1983
    HelpWindow:=nil;
 
1984
  Inherited Done;
 
1985
end;
 
1986
 
 
1987
procedure TFPHelpWindow.InitHelpView;
 
1988
var R: TRect;
 
1989
begin
 
1990
  GetExtent(R); R.Grow(-1,-1);
 
1991
  HelpView:=New(PFPHelpViewer, Init(R, HSB, VSB));
 
1992
  HelpView^.GrowMode:=gfGrowHiX+gfGrowHiY;
 
1993
end;
 
1994
 
 
1995
procedure TFPHelpWindow.Show;
 
1996
begin
 
1997
  inherited Show;
 
1998
  if GetState(sfVisible) and (Number=0) then
 
1999
    begin
 
2000
      Number:=SearchFreeWindowNo;
 
2001
      ReDraw;
 
2002
    end;
 
2003
end;
 
2004
 
 
2005
procedure TFPHelpWindow.Hide;
 
2006
begin
 
2007
  inherited Hide;
 
2008
  if GetState(sfVisible)=false then
 
2009
    Number:=0;
 
2010
end;
 
2011
 
 
2012
procedure TFPHelpWindow.HandleEvent(var Event: TEvent);
 
2013
begin
 
2014
  case Event.What of
 
2015
    evBroadcast :
 
2016
      case Event.Command of
 
2017
        cmUpdate :
 
2018
          ReDraw;
 
2019
        cmSearchWindow+1..cmSearchWindow+99 :
 
2020
          if (Event.Command-cmSearchWindow=Number) then
 
2021
              ClearEvent(Event);
 
2022
      end;
 
2023
  end;
 
2024
  inherited HandleEvent(Event);
 
2025
end;
 
2026
 
 
2027
function TFPHelpWindow.GetPalette: PPalette;
 
2028
const P: string[length(CIDEHelpDialog)] = CIDEHelpDialog;
 
2029
begin
 
2030
  GetPalette:=@P;
 
2031
end;
 
2032
 
 
2033
constructor TFPHelpWindow.Load(var S: TStream);
 
2034
begin
 
2035
  Abstract;
 
2036
end;
 
2037
 
 
2038
procedure TFPHelpWindow.Store(var S: TStream);
 
2039
begin
 
2040
  Abstract;
 
2041
end;
 
2042
 
 
2043
constructor TSourceWindow.Init(var Bounds: TRect; AFileName: string);
 
2044
var HSB,VSB: PScrollBar;
 
2045
    R: TRect;
 
2046
    PA : Array[1..2] of pointer;
 
2047
    LoadFile: boolean;
 
2048
begin
 
2049
  inherited Init(Bounds,AFileName,{SearchFreeWindowNo}0);
 
2050
  AutoNumber:=true;
 
2051
  Options:=Options or ofTileAble;
 
2052
  GetExtent(R); R.A.Y:=R.B.Y-1; R.Grow(-1,0); R.A.X:=14;
 
2053
  New(HSB, Init(R)); HSB^.GrowMode:=gfGrowLoY+gfGrowHiX+gfGrowHiY; Insert(HSB);
 
2054
  GetExtent(R); R.A.X:=R.B.X-1; R.Grow(0,-1);
 
2055
  New(VSB, Init(R)); VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY; Insert(VSB);
 
2056
  GetExtent(R); R.A.X:=3; R.B.X:=14; R.A.Y:=R.B.Y-1;
 
2057
  New(Indicator, Init(R));
 
2058
  Indicator^.GrowMode:=gfGrowLoY+gfGrowHiY;
 
2059
  Insert(Indicator);
 
2060
  GetExtent(R); R.Grow(-1,-1);
 
2061
  LoadFile:=(AFileName<>'') and (AFileName<>'*');
 
2062
  if (AFileName='') then
 
2063
    begin
 
2064
      Inc(GlobalNoNameCount);
 
2065
      NoNameCount:=GlobalNoNameCount;
 
2066
    end
 
2067
  else
 
2068
    NoNameCount:=-1;
 
2069
  if AFileName='*' then
 
2070
    AFileName:='';
 
2071
  New(Editor, Init(R, HSB, VSB, Indicator,AFileName));
 
2072
  Editor^.GrowMode:=gfGrowHiX+gfGrowHiY;
 
2073
  if LoadFile then
 
2074
    begin
 
2075
      if Editor^.LoadFile=false then
 
2076
        ErrorBox(FormatStrStr(msg_errorreadingfile,AFileName),nil)
 
2077
      { warn if modified, but not if modified in another
 
2078
        already open window PM }
 
2079
      else if Editor^.GetModified and (Editor^.Core^.GetBindingCount=1) then
 
2080
        begin
 
2081
          PA[1]:=@AFileName;
 
2082
          Ptrint(PA[2]):={Editor^.ChangedLine}-1;
 
2083
          EditorDialog(edChangedOnloading,@PA);
 
2084
        end;
 
2085
   end;
 
2086
  Insert(Editor);
 
2087
{$ifndef NODEBUG}
 
2088
  If assigned(BreakpointsCollection) then
 
2089
    BreakpointsCollection^.ShowBreakpoints(@Self);
 
2090
{$endif NODEBUG}
 
2091
  UpdateTitle;
 
2092
end;
 
2093
 
 
2094
procedure TSourceWindow.UpdateTitle;
 
2095
var Name: string;
 
2096
    Count: sw_integer;
 
2097
begin
 
2098
  if Editor^.FileName<>'' then
 
2099
    begin
 
2100
      Name:=SmartPath(Editor^.FileName);
 
2101
      Count:=Editor^.Core^.GetBindingCount;
 
2102
      if Count>1 then
 
2103
      begin
 
2104
        Name:=Name+':'+IntToStr(Editor^.Core^.GetBindingIndex(Editor)+1);
 
2105
      end;
 
2106
      SetTitle(Name);
 
2107
    end
 
2108
  else if NoNameCount>=0 then
 
2109
    begin
 
2110
      SetTitle('noname'+IntToStrZ(NonameCount,2)+'.pas');
 
2111
    end;
 
2112
end;
 
2113
 
 
2114
function TSourceWindow.GetTitle(MaxSize: sw_Integer): TTitleStr;
 
2115
begin
 
2116
  GetTitle:=OptimizePath(inherited GetTitle(255),MaxSize);
 
2117
end;
 
2118
 
 
2119
procedure TSourceWindow.SetTitle(ATitle: string);
 
2120
begin
 
2121
  if Title<>nil then DisposeStr(Title);
 
2122
  Title:=NewStr(ATitle);
 
2123
  Frame^.DrawView;
 
2124
end;
 
2125
 
 
2126
procedure TSourceWindow.HandleEvent(var Event: TEvent);
 
2127
var DontClear: boolean;
 
2128
begin
 
2129
  case Event.What of
 
2130
    evBroadcast :
 
2131
      case Event.Command of
 
2132
        cmUpdate :
 
2133
          Update;
 
2134
        cmUpdateTitle :
 
2135
          UpdateTitle;
 
2136
        cmSearchWindow :
 
2137
          if @Self<>ClipboardWindow then
 
2138
            ClearEvent(Event);
 
2139
      end;
 
2140
    evCommand :
 
2141
      begin
 
2142
        DontClear:=false;
 
2143
        case Event.Command of
 
2144
          cmHide :
 
2145
            Hide;
 
2146
          cmSave :
 
2147
            if Editor^.IsClipboard=false then
 
2148
             if (Editor^.FileName='') and Editor^.GetModified then
 
2149
              Editor^.SaveAs
 
2150
             else
 
2151
              Editor^.Save;
 
2152
          cmSaveAs :
 
2153
            if Editor^.IsClipboard=false then
 
2154
              Editor^.SaveAs;
 
2155
        else DontClear:=true;
 
2156
        end;
 
2157
        if DontClear=false then ClearEvent(Event);
 
2158
      end;
 
2159
  end;
 
2160
  inherited HandleEvent(Event);
 
2161
end;
 
2162
 
 
2163
procedure TSourceWindow.UpdateCommands;
 
2164
var Active: boolean;
 
2165
begin
 
2166
  Active:=GetState(sfActive);
 
2167
  if Editor^.IsClipboard=false then
 
2168
  begin
 
2169
    SetCmdState(SourceCmds+CompileCmds,Active);
 
2170
    SetCmdState(EditorCmds,Active);
 
2171
  end;
 
2172
  SetCmdState(ToClipCmds+FromClipCmds+NulClipCmds+UndoCmd+RedoCmd,Active);
 
2173
  Message(Application,evBroadcast,cmCommandSetChanged,nil);
 
2174
end;
 
2175
 
 
2176
procedure TSourceWindow.Update;
 
2177
begin
 
2178
  ReDraw;
 
2179
end;
 
2180
 
 
2181
 
 
2182
function TSourceWindow.GetPalette: PPalette;
 
2183
const P: string[length(CSourceWindow)] = CSourceWindow;
 
2184
begin
 
2185
  GetPalette:=@P;
 
2186
end;
 
2187
 
 
2188
constructor TSourceWindow.Load(var S: TStream);
 
2189
begin
 
2190
  Title:=S.ReadStr;
 
2191
  PushStatus(FormatStrStr(msg_loadingfile,GetStr(Title)));
 
2192
  inherited Load(S);
 
2193
  GetSubViewPtr(S,Indicator);
 
2194
  GetSubViewPtr(S,Editor);
 
2195
{$ifndef NODEBUG}
 
2196
  If assigned(BreakpointsCollection) then
 
2197
    BreakpointsCollection^.ShowBreakpoints(@Self);
 
2198
{$endif NODEBUG}
 
2199
  PopStatus;
 
2200
end;
 
2201
 
 
2202
procedure TSourceWindow.Store(var S: TStream);
 
2203
begin
 
2204
  S.WriteStr(Title);
 
2205
  PushStatus(FormatStrStr(msg_storingfile,GetStr(Title)));
 
2206
  inherited Store(S);
 
2207
 
 
2208
  PutSubViewPtr(S,Indicator);
 
2209
  PutSubViewPtr(S,Editor);
 
2210
  PopStatus;
 
2211
end;
 
2212
 
 
2213
 
 
2214
procedure TSourceWindow.Close;
 
2215
begin
 
2216
  inherited Close;
 
2217
end;
 
2218
 
 
2219
destructor TSourceWindow.Done;
 
2220
begin
 
2221
  PushStatus(FormatStrStr(msg_closingfile,GetStr(Title)));
 
2222
  if not IDEApp.IsClosing then
 
2223
    Message(Application,evBroadcast,cmSourceWndClosing,@Self);
 
2224
  inherited Done;
 
2225
  IDEApp.SourceWindowClosed;
 
2226
{  if not IDEApp.IsClosing then
 
2227
    Message(Application,evBroadcast,cmUpdate,@Self);}
 
2228
  PopStatus;
 
2229
end;
 
2230
 
 
2231
 
 
2232
{$ifndef NODEBUG}
 
2233
 
 
2234
function TGDBSourceEditor.Valid(Command: Word): Boolean;
 
2235
var OK: boolean;
 
2236
begin
 
2237
  OK:=TCodeEditor.Valid(Command);
 
2238
  { do NOT ask for save !!
 
2239
  if OK and ((Command=cmClose) or (Command=cmQuit)) then
 
2240
     if IsClipboard=false then
 
2241
    OK:=SaveAsk;  }
 
2242
  Valid:=OK;
 
2243
end;
 
2244
 
 
2245
procedure  TGDBSourceEditor.AddLine(const S: string);
 
2246
begin
 
2247
   if Silent or (IgnoreStringAtEnd and (S=LastCommand)) then exit;
 
2248
   inherited AddLine(S);
 
2249
   LimitsChanged;
 
2250
end;
 
2251
 
 
2252
procedure  TGDBSourceEditor.AddErrorLine(const S: string);
 
2253
begin
 
2254
   if Silent then exit;
 
2255
   inherited AddLine(S);
 
2256
   { display like breakpoints in red }
 
2257
   SetLineFlagState(GetLineCount-1,lfBreakpoint,true);
 
2258
   LimitsChanged;
 
2259
end;
 
2260
 
 
2261
const
 
2262
  GDBReservedCount = 6;
 
2263
  GDBReservedLongest = 3;
 
2264
  GDBReserved : array[1..GDBReservedCount] of String[GDBReservedLongest] =
 
2265
  ('gdb','b','n','s','f','bt');
 
2266
 
 
2267
function IsGDBReservedWord(const S : string) : boolean;
 
2268
var
 
2269
  i : longint;
 
2270
begin
 
2271
  for i:=1 to GDBReservedCount do
 
2272
    if (S=GDBReserved[i]) then
 
2273
      begin
 
2274
        IsGDBReservedWord:=true;
 
2275
        exit;
 
2276
      end;
 
2277
  IsGDBReservedWord:=false;
 
2278
end;
 
2279
 
 
2280
function TGDBSourceEditor.IsReservedWord(const S: string): boolean;
 
2281
begin
 
2282
  IsReservedWord:=IsGDBReservedWord(S);
 
2283
end;
 
2284
 
 
2285
function TGDBSourceEditor.InsertNewLine: Sw_integer;
 
2286
Var
 
2287
  S : string;
 
2288
  CommandCalled : boolean;
 
2289
 
 
2290
begin
 
2291
  if IsReadOnly then begin InsertNewLine:=-1; Exit; end;
 
2292
  if CurPos.Y<GetLineCount then S:=GetDisplayText(CurPos.Y) else S:='';
 
2293
  s:=Copy(S,1,CurPos.X);
 
2294
  CommandCalled:=false;
 
2295
  if Pos(GDBPrompt,S)=1 then
 
2296
    Delete(S,1,length(GDBPrompt));
 
2297
{$ifndef NODEBUG}
 
2298
  if assigned(Debugger) then
 
2299
    if S<>'' then
 
2300
      begin
 
2301
        LastCommand:=S;
 
2302
        { should be true only if we are at the end ! }
 
2303
        IgnoreStringAtEnd:=(CurPos.Y=GetLineCount-1) and
 
2304
          (CurPos.X>=length(RTrim(GetDisplayText(GetLineCount-1))));
 
2305
        Debugger^.Command(S);
 
2306
        CommandCalled:=true;
 
2307
        IgnoreStringAtEnd:=false;
 
2308
      end
 
2309
    else if AutoRepeat and (CurPos.Y=GetLineCount-1) then
 
2310
      begin
 
2311
        Debugger^.Command(LastCommand);
 
2312
        CommandCalled:=true;
 
2313
      end;
 
2314
{$endif NODEBUG}
 
2315
  InsertNewLine:=inherited InsertNewLine;
 
2316
  If CommandCalled then
 
2317
    InsertText(GDBPrompt);
 
2318
end;
 
2319
 
 
2320
 
 
2321
constructor TGDBWindow.Init(var Bounds: TRect);
 
2322
var HSB,VSB: PScrollBar;
 
2323
    R: TRect;
 
2324
begin
 
2325
  inherited Init(Bounds,dialog_gdbwindow,0);
 
2326
  Options:=Options or ofTileAble;
 
2327
  AutoNumber:=true;
 
2328
  HelpCtx:=hcGDBWindow;
 
2329
  GetExtent(R); R.A.Y:=R.B.Y-1; R.Grow(-1,0); R.A.X:=14;
 
2330
  New(HSB, Init(R)); HSB^.GrowMode:=gfGrowLoY+gfGrowHiX+gfGrowHiY; Insert(HSB);
 
2331
  GetExtent(R); R.A.X:=R.B.X-1; R.Grow(0,-1);
 
2332
  New(VSB, Init(R)); VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY; Insert(VSB);
 
2333
  GetExtent(R); R.A.X:=3; R.B.X:=14; R.A.Y:=R.B.Y-1;
 
2334
  New(Indicator, Init(R));
 
2335
  Indicator^.GrowMode:=gfGrowLoY+gfGrowHiY;
 
2336
  Insert(Indicator);
 
2337
  GetExtent(R); R.Grow(-1,-1);
 
2338
  New(Editor, Init(R, HSB, VSB, Indicator, GDBOutputFile));
 
2339
  Editor^.GrowMode:=gfGrowHiX+gfGrowHiY;
 
2340
  Editor^.SetFlags(efInsertMode+efSyntaxHighlight+efNoIndent+efExpandAllTabs);
 
2341
  if ExistsFile(GDBOutputFile) then
 
2342
    begin
 
2343
      if Editor^.LoadFile=false then
 
2344
        ErrorBox(FormatStrStr(msg_errorreadingfile,GDBOutputFile),nil);
 
2345
    end
 
2346
  else
 
2347
  { Empty files are buggy !! }
 
2348
    Editor^.AddLine('');
 
2349
  Insert(Editor);
 
2350
{$ifndef NODEBUG}
 
2351
  if assigned(Debugger) then
 
2352
    Debugger^.SetWidth(Size.X-1);
 
2353
{$endif NODEBUG}
 
2354
  Editor^.silent:=false;
 
2355
  Editor^.AutoRepeat:=true;
 
2356
  Editor^.InsertText(GDBPrompt);
 
2357
end;
 
2358
 
 
2359
procedure TGDBWindow.HandleEvent(var Event: TEvent);
 
2360
var DontClear: boolean;
 
2361
begin
 
2362
  case Event.What of
 
2363
    evCommand :
 
2364
      begin
 
2365
        DontClear:=false;
 
2366
        case Event.Command of
 
2367
          cmSaveAs :
 
2368
              Editor^.SaveAs;
 
2369
        else DontClear:=true;
 
2370
        end;
 
2371
        if DontClear=false then ClearEvent(Event);
 
2372
      end;
 
2373
  end;
 
2374
  inherited HandleEvent(Event);
 
2375
end;
 
2376
 
 
2377
destructor TGDBWindow.Done;
 
2378
begin
 
2379
  if @Self=GDBWindow then
 
2380
    GDBWindow:=nil;
 
2381
  inherited Done;
 
2382
end;
 
2383
 
 
2384
constructor TGDBWindow.Load(var S: TStream);
 
2385
begin
 
2386
  inherited Load(S);
 
2387
  GetSubViewPtr(S,Indicator);
 
2388
  GetSubViewPtr(S,Editor);
 
2389
  GDBWindow:=@self;
 
2390
end;
 
2391
 
 
2392
procedure TGDBWindow.Store(var S: TStream);
 
2393
begin
 
2394
  inherited Store(S);
 
2395
  PutSubViewPtr(S,Indicator);
 
2396
  PutSubViewPtr(S,Editor);
 
2397
end;
 
2398
 
 
2399
function TGDBWindow.GetPalette: PPalette;
 
2400
const P: string[length(CSourceWindow)] = CSourceWindow;
 
2401
begin
 
2402
  GetPalette:=@P;
 
2403
end;
 
2404
 
 
2405
procedure TGDBWindow.WriteOutputText(Buf : pchar);
 
2406
begin
 
2407
  {selected normal color ?}
 
2408
  WriteText(Buf,false);
 
2409
end;
 
2410
 
 
2411
procedure TGDBWindow.WriteErrorText(Buf : pchar);
 
2412
begin
 
2413
  {selected normal color ?}
 
2414
  WriteText(Buf,true);
 
2415
end;
 
2416
 
 
2417
procedure TGDBWindow.WriteString(Const S : string);
 
2418
begin
 
2419
  Editor^.AddLine(S);
 
2420
end;
 
2421
 
 
2422
procedure TGDBWindow.WriteErrorString(Const S : string);
 
2423
begin
 
2424
  Editor^.AddErrorLine(S);
 
2425
end;
 
2426
 
 
2427
procedure TGDBWindow.WriteText(Buf : pchar;IsError : boolean);
 
2428
  var p,pe : pchar;
 
2429
      s : string;
 
2430
begin
 
2431
  p:=buf;
 
2432
  DeskTop^.Lock;
 
2433
  While assigned(p) and (p^<>#0) do
 
2434
    begin
 
2435
       pe:=strscan(p,#10);
 
2436
       if pe<>nil then
 
2437
         pe^:=#0;
 
2438
       s:=strpas(p);
 
2439
       If IsError then
 
2440
         Editor^.AddErrorLine(S)
 
2441
       else
 
2442
         Editor^.AddLine(S);
 
2443
       { restore for dispose }
 
2444
       if pe<>nil then
 
2445
         pe^:=#10;
 
2446
       if pe=nil then
 
2447
         p:=nil
 
2448
       else
 
2449
         begin
 
2450
           if pe-p > High(s) then
 
2451
             p:=p+High(s)-1
 
2452
           else
 
2453
             begin
 
2454
               p:=pe;
 
2455
               inc(p);
 
2456
             end;
 
2457
         end;
 
2458
    end;
 
2459
  DeskTop^.Unlock;
 
2460
  Editor^.Draw;
 
2461
end;
 
2462
 
 
2463
procedure TGDBWindow.UpdateCommands;
 
2464
var Active: boolean;
 
2465
begin
 
2466
  Active:=GetState(sfActive);
 
2467
  SetCmdState([cmSaveAs,cmHide,cmRun],Active);
 
2468
  SetCmdState(EditorCmds,Active);
 
2469
  SetCmdState(ToClipCmds+FromClipCmds+NulClipCmds+UndoCmd+RedoCmd,Active);
 
2470
  Message(Application,evBroadcast,cmCommandSetChanged,nil);
 
2471
end;
 
2472
 
 
2473
 
 
2474
function  TDisasLineCollection.At(Index: sw_Integer): PDisasLine;
 
2475
begin
 
2476
  At := PDisasLine(Inherited At(Index));
 
2477
end;
 
2478
 
 
2479
constructor TDisassemblyEditor.Init(var Bounds: TRect; AHScrollBar, AVScrollBar:
 
2480
          PScrollBar; AIndicator: PIndicator;const AFileName: string);
 
2481
begin
 
2482
  Inherited Init(Bounds,AHScrollBar,AVScrollBar,AIndicator,AFileName);
 
2483
  GrowMode:=gfGrowHiX+gfGrowHiY;
 
2484
  SetFlags(efInsertMode+efSyntaxHighlight+efNoIndent+efExpandAllTabs{+efHighlightRow});
 
2485
  New(DisasLines,Init(500,1000));
 
2486
  Core^.ChangeLinesTo(DisasLines);
 
2487
  { do not allow to write into that window }
 
2488
  ReadOnly:=true;
 
2489
  AddLine('');
 
2490
  MinAddress:=0;
 
2491
  MaxAddress:=0;
 
2492
  CurL:=nil;
 
2493
  OwnsSource:=false;
 
2494
  Source:=nil;
 
2495
end;
 
2496
 
 
2497
destructor TDisassemblyEditor.Done;
 
2498
begin
 
2499
  ReleaseSource;
 
2500
  Inherited Done;
 
2501
end;
 
2502
 
 
2503
procedure TDisassemblyEditor.ReleaseSource;
 
2504
begin
 
2505
  if OwnsSource and assigned(source) then
 
2506
    begin
 
2507
      Desktop^.Delete(Source);
 
2508
      Dispose(Source,Done);
 
2509
    end;
 
2510
  OwnsSource:=false;
 
2511
  Source:=nil;
 
2512
  CurrentSource:='';
 
2513
end;
 
2514
 
 
2515
procedure  TDisassemblyEditor.AddSourceLine(const AFileName: string;line : longint);
 
2516
var
 
2517
  S : String;
 
2518
begin
 
2519
   if AFileName<>CurrentSource then
 
2520
     begin
 
2521
       ReleaseSource;
 
2522
       Source:=SearchOnDesktop(FileName,false);
 
2523
       if not assigned(Source) then
 
2524
         begin
 
2525
           Source:=ITryToOpenFile(nil,AFileName,0,line,false,false,true);
 
2526
           OwnsSource:=true;
 
2527
         end
 
2528
       else
 
2529
         OwnsSource:=false;
 
2530
       CurrentSource:=AFileName;
 
2531
     end;
 
2532
   if Assigned(Source) and (line>0) then
 
2533
     S:=Trim(Source^.Editor^.GetLineText(line-1))
 
2534
   else
 
2535
     S:='<source not found>';
 
2536
   CurrentLine:=Line;
 
2537
   inherited AddLine(AFileName+':'+IntToStr(line)+' '+S);
 
2538
   { display differently }
 
2539
   SetLineFlagState(GetLineCount-1,lfSpecialRow,true);
 
2540
   LimitsChanged;
 
2541
end;
 
2542
 
 
2543
procedure  TDisassemblyEditor.AddAssemblyLine(const S: string;AAddress : cardinal);
 
2544
var
 
2545
  PL : PDisasLine;
 
2546
  LI : PEditorLineInfo;
 
2547
begin
 
2548
   if AAddress<>0 then
 
2549
     inherited AddLine('$'+hexstr(AAddress,8)+S)
 
2550
   else
 
2551
     inherited AddLine(S);
 
2552
   PL:=DisasLines^.At(DisasLines^.count-1);
 
2553
   PL^.Address:=AAddress;
 
2554
   LI:=PL^.GetEditorInfo(@Self);
 
2555
   if AAddress<>0 then
 
2556
     LI^.BeginsWithAsm:=true;
 
2557
   LimitsChanged;
 
2558
   if ((AAddress<minaddress) or (minaddress=0)) and (AAddress<>0) then
 
2559
     MinAddress:=AAddress;
 
2560
   if (AAddress>maxaddress) or (maxaddress=0) then
 
2561
     MaxAddress:=AAddress;
 
2562
end;
 
2563
 
 
2564
function   TDisassemblyEditor.GetCurrentLine(address : cardinal) : PDisasLine;
 
2565
 
 
2566
  function IsCorrectLine(PL : PDisasLine) : boolean;
 
2567
    begin
 
2568
      IsCorrectLine:=PL^.Address=Address;
 
2569
    end;
 
2570
  Var
 
2571
    PL : PDisasLine;
 
2572
begin
 
2573
  PL:=DisasLines^.FirstThat(@IsCorrectLine);
 
2574
  if Assigned(PL) then
 
2575
    begin
 
2576
      if assigned(CurL) then
 
2577
        CurL^.SetFlagState(lfDebuggerRow,false);
 
2578
      SetCurPtr(0,DisasLines^.IndexOf(PL));
 
2579
      PL^.SetFlags(lfDebuggerRow);
 
2580
      CurL:=PL;
 
2581
      TrackCursor(false);
 
2582
    end;
 
2583
  GetCurrentLine:=PL;
 
2584
end;
 
2585
 
 
2586
    { PDisassemblyWindow = ^TDisassemblyWindow;
 
2587
    TDisassemblyWindow = object(TFPWindow)
 
2588
      Editor    : PDisassemblyEditor;
 
2589
      Indicator : PIndicator; }
 
2590
constructor TDisassemblyWindow.Init(var Bounds: TRect);
 
2591
var HSB,VSB: PScrollBar;
 
2592
    R: TRect;
 
2593
begin
 
2594
  inherited Init(Bounds,dialog_disaswindow,0);
 
2595
  Options:=Options or ofTileAble;
 
2596
  AutoNumber:=true;
 
2597
  HelpCtx:=hcDisassemblyWindow;
 
2598
  GetExtent(R); R.A.Y:=R.B.Y-1; R.Grow(-1,0); R.A.X:=14;
 
2599
  New(HSB, Init(R)); HSB^.GrowMode:=gfGrowLoY+gfGrowHiX+gfGrowHiY; Insert(HSB);
 
2600
  GetExtent(R); R.A.X:=R.B.X-1; R.Grow(0,-1);
 
2601
  New(VSB, Init(R)); VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY; Insert(VSB);
 
2602
  GetExtent(R); R.A.X:=3; R.B.X:=14; R.A.Y:=R.B.Y-1;
 
2603
  New(Indicator, Init(R));
 
2604
  Indicator^.GrowMode:=gfGrowLoY+gfGrowHiY;
 
2605
  Insert(Indicator);
 
2606
  GetExtent(R); R.Grow(-1,-1);
 
2607
  New(Editor, Init(R, HSB, VSB, nil, GDBOutputFile));
 
2608
  Insert(Editor);
 
2609
  DisassemblyWindow:=@Self;
 
2610
end;
 
2611
 
 
2612
procedure   TDisassemblyWindow.LoadFunction(Const FuncName : string);
 
2613
var
 
2614
   p : pchar;
 
2615
begin
 
2616
{$ifndef NODEBUG}
 
2617
  If not assigned(Debugger) then Exit;
 
2618
  Debugger^.Command('set print sym on');
 
2619
  Debugger^.Command('set width 0xffffffff');
 
2620
  Debugger^.Command('disas '+FuncName);
 
2621
  p:=StrNew(Debugger^.GetOutput);
 
2622
  ProcessPChar(p);
 
2623
  if (Debugger^.IsRunning) and (FuncName='') then
 
2624
    Editor^.GetCurrentLine(Debugger^.current_pc);
 
2625
{$endif NODEBUG}
 
2626
end;
 
2627
 
 
2628
procedure   TDisassemblyWindow.LoadAddress(Addr : cardinal);
 
2629
var
 
2630
   p : pchar;
 
2631
begin
 
2632
{$ifndef NODEBUG}
 
2633
  If not assigned(Debugger) then Exit;
 
2634
  Debugger^.Command('set print sym on');
 
2635
  Debugger^.Command('set width 0xffffffff');
 
2636
  Debugger^.Command('disas 0x'+HexStr(Addr,8));
 
2637
  p:=StrNew(Debugger^.GetOutput);
 
2638
  ProcessPChar(p);
 
2639
  if Debugger^.IsRunning and
 
2640
     (Debugger^.current_pc>=Editor^.MinAddress) and
 
2641
     (Debugger^.current_pc<=Editor^.MaxAddress) then
 
2642
    Editor^.GetCurrentLine(Debugger^.current_pc);
 
2643
{$endif NODEBUG}
 
2644
end;
 
2645
 
 
2646
 
 
2647
function TDisassemblyWindow.ProcessPChar(p : pchar) : boolean;
 
2648
var
 
2649
  p1: pchar;
 
2650
  pline : pchar;
 
2651
  pos1, pos2, CurLine, PrevLine : longint;
 
2652
  CurAddr : cardinal;
 
2653
  err : word;
 
2654
  curaddress, cursymofs, CurFile,
 
2655
  PrevFile, line : string;
 
2656
begin
 
2657
  ProcessPChar:=true;
 
2658
  Lock;
 
2659
  Editor^.DisasLines^.FreeAll;
 
2660
  Editor^.SetFlags(Editor^.GetFlags or efSyntaxHighlight or efKeepLineAttr);
 
2661
 
 
2662
  Editor^.MinAddress:=0;
 
2663
  Editor^.MaxAddress:=0;
 
2664
  Editor^.CurL:=nil;
 
2665
  p1:=p;
 
2666
  PrevFile:='';
 
2667
  PrevLine:=0;
 
2668
  while assigned(p) do
 
2669
    begin
 
2670
      pline:=strscan(p,#10);
 
2671
      if assigned(pline) then
 
2672
        pline^:=#0;
 
2673
      line:=strpas(p);
 
2674
      CurAddr:=0;
 
2675
      if assigned(pline) then
 
2676
        begin
 
2677
          pline^:=#10;
 
2678
          p:=pline+1;
 
2679
        end
 
2680
      else
 
2681
        p:=nil;
 
2682
      { now process the line }
 
2683
      { line is hexaddr <symbol+sym_offset at filename:line> assembly }
 
2684
      pos1:=pos('<',line);
 
2685
      if pos1>0 then
 
2686
        begin
 
2687
          curaddress:=copy(line,1,pos1-1);
 
2688
          if copy(curaddress,1,2)='0x' then
 
2689
            curaddress:='$'+copy(curaddress,3,length(curaddress)-2);
 
2690
          val(curaddress,CurAddr,err);
 
2691
          if err>0 then
 
2692
            val(copy(curaddress,1,err-1),CurAddr,err);
 
2693
          system.delete(line,1,pos1);
 
2694
        end;
 
2695
      pos1:=pos(' at ',line);
 
2696
      pos2:=pos('>',line);
 
2697
      if (pos1>0) and (pos1 < pos2) then
 
2698
        begin
 
2699
          cursymofs:=copy(line,1,pos1-1);
 
2700
          CurFile:=copy(line,pos1+4,pos2-pos1-4);
 
2701
          pos1:=pos(':',CurFile);
 
2702
          if pos1>0 then
 
2703
            begin
 
2704
              val(copy(CurFile,pos1+1,high(CurFile)),CurLine,err);
 
2705
              system.delete(CurFile,pos1,high(CurFile));
 
2706
            end
 
2707
          else
 
2708
            CurLine:=0;
 
2709
          system.delete(line,1,pos2);
 
2710
        end
 
2711
      else    { no ' at ' found before '>' }
 
2712
        begin
 
2713
          cursymofs:=copy(line,1,pos2-1);
 
2714
          CurFile:='';
 
2715
          system.delete(line,1,pos2);
 
2716
        end;
 
2717
      if (CurFile<>'') and ((CurFile<>PrevFile) or (CurLine<>PrevLine)) then
 
2718
        begin
 
2719
          WriteSourceString(CurFile,CurLine);
 
2720
          PrevLine:=CurLine;
 
2721
          PrevFile:=CurFile;
 
2722
        end;
 
2723
      WriteDisassemblyString(line,curaddr);
 
2724
    end;
 
2725
  StrDispose(p1);
 
2726
  Editor^.ReleaseSource;
 
2727
  Editor^.UpdateAttrs(0,attrForceFull);
 
2728
  If assigned(BreakpointsCollection) then
 
2729
    BreakpointsCollection^.ShowBreakpoints(@Self);
 
2730
  Unlock;
 
2731
  ReDraw;
 
2732
end;
 
2733
 
 
2734
procedure   TDisassemblyWindow.HandleEvent(var Event: TEvent);
 
2735
begin
 
2736
  inherited HandleEvent(Event);
 
2737
end;
 
2738
 
 
2739
procedure   TDisassemblyWindow.WriteSourceString(Const S : string;line : longint);
 
2740
begin
 
2741
  Editor^.AddSourceLine(S,line);
 
2742
end;
 
2743
 
 
2744
procedure   TDisassemblyWindow.WriteDisassemblyString(Const S : string;address : cardinal);
 
2745
begin
 
2746
  Editor^.AddAssemblyLine(S,address);
 
2747
end;
 
2748
 
 
2749
procedure   TDisassemblyWindow.SetCurAddress(address : cardinal);
 
2750
begin
 
2751
  if (address<Editor^.MinAddress) or (address>Editor^.MaxAddress) then
 
2752
    LoadAddress(address);
 
2753
  Editor^.GetCurrentLine(address);
 
2754
end;
 
2755
 
 
2756
procedure TDisassemblyWindow.UpdateCommands;
 
2757
var Active: boolean;
 
2758
begin
 
2759
  Active:=GetState(sfActive);
 
2760
  SetCmdState(SourceCmds+CompileCmds,Active);
 
2761
  SetCmdState(EditorCmds,Active);
 
2762
  SetCmdState(ToClipCmds+FromClipCmds+NulClipCmds+UndoCmd+RedoCmd,false);
 
2763
  Message(Application,evBroadcast,cmCommandSetChanged,nil);
 
2764
end;
 
2765
 
 
2766
 
 
2767
function    TDisassemblyWindow.GetPalette: PPalette;
 
2768
const P: string[length(CSourceWindow)] = CSourceWindow;
 
2769
begin
 
2770
  GetPalette:=@P;
 
2771
end;
 
2772
 
 
2773
destructor  TDisassemblyWindow.Done;
 
2774
begin
 
2775
  if @Self=DisassemblyWindow then
 
2776
    DisassemblyWindow:=nil;
 
2777
  inherited Done;
 
2778
end;
 
2779
{$endif NODEBUG}
 
2780
 
 
2781
 
 
2782
 
 
2783
constructor TClipboardWindow.Init;
 
2784
var R: TRect;
 
2785
    HSB,VSB: PScrollBar;
 
2786
begin
 
2787
  Desktop^.GetExtent(R);
 
2788
  inherited Init(R, '*');
 
2789
  SetTitle(dialog_clipboard);
 
2790
  HelpCtx:=hcClipboardWindow;
 
2791
  Number:=wnNoNumber;
 
2792
  AutoNumber:=true;
 
2793
 
 
2794
  GetExtent(R); R.A.Y:=R.B.Y-1; R.Grow(-1,0); R.A.X:=14;
 
2795
  New(HSB, Init(R)); HSB^.GrowMode:=gfGrowLoY+gfGrowHiX+gfGrowHiY; Insert(HSB);
 
2796
  GetExtent(R); R.A.X:=R.B.X-1; R.Grow(0,-1);
 
2797
  New(VSB, Init(R)); VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY; Insert(VSB);
 
2798
  GetExtent(R); R.A.X:=3; R.B.X:=14; R.A.Y:=R.B.Y-1;
 
2799
  New(Indicator, Init(R));
 
2800
  Indicator^.GrowMode:=gfGrowLoY+gfGrowHiY;
 
2801
  Insert(Indicator);
 
2802
  GetExtent(R); R.Grow(-1,-1);
 
2803
  New(Editor, Init(R, HSB, VSB, Indicator, ''));
 
2804
  Editor^.GrowMode:=gfGrowHiX+gfGrowHiY;
 
2805
  Insert(Editor);
 
2806
 
 
2807
  Editor^.SetFlags(Editor^.GetFlags or efUseTabCharacters);
 
2808
  Hide;
 
2809
 
 
2810
  Clipboard:=Editor;
 
2811
end;
 
2812
 
 
2813
procedure TClipboardWindow.Close;
 
2814
begin
 
2815
  Hide;
 
2816
end;
 
2817
 
 
2818
constructor TClipboardWindow.Load(var S: TStream);
 
2819
begin
 
2820
  inherited Load(S);
 
2821
 
 
2822
  Clipboard:=Editor;
 
2823
end;
 
2824
 
 
2825
procedure TClipboardWindow.Store(var S: TStream);
 
2826
begin
 
2827
  inherited Store(S);
 
2828
end;
 
2829
 
 
2830
destructor TClipboardWindow.Done;
 
2831
begin
 
2832
  inherited Done;
 
2833
  Clipboard:=nil;
 
2834
  ClipboardWindow:=nil;
 
2835
end;
 
2836
 
 
2837
 
 
2838
constructor TMessageListBox.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
 
2839
begin
 
2840
  inherited Init(Bounds,1,AHScrollBar, AVScrollBar);
 
2841
  GrowMode:=gfGrowHiX+gfGrowHiY;
 
2842
  New(ModuleNames, Init(50,100));
 
2843
  NoSelection:=true;
 
2844
end;
 
2845
 
 
2846
 
 
2847
function TMessageListBox.GetLocalMenu: PMenu;
 
2848
var M: PMenu;
 
2849
begin
 
2850
  if (Owner<>nil) and (Owner^.GetState(sfModal)) then M:=nil else
 
2851
  M:=NewMenu(
 
2852
    NewItem(menu_msglocal_clear,'',kbNoKey,cmMsgClear,hcMsgClear,
 
2853
    NewLine(
 
2854
    NewItem(menu_msglocal_gotosource,'',kbNoKey,cmMsgGotoSource,hcMsgGotoSource,
 
2855
    NewItem(menu_msglocal_tracksource,'',kbNoKey,cmMsgTrackSource,hcMsgTrackSource,
 
2856
    NewLine(
 
2857
    NewItem(menu_msglocal_saveas,'',kbNoKey,cmSaveAs,hcSaveAs,
 
2858
    nil)))))));
 
2859
  GetLocalMenu:=M;
 
2860
end;
 
2861
 
 
2862
procedure TMessageListBox.SetState(AState: Word; Enable: Boolean);
 
2863
var OldState: word;
 
2864
begin
 
2865
  OldState:=State;
 
2866
  inherited SetState(AState,Enable);
 
2867
  if ((AState and sfActive)<>0) and (((OldState xor State) and sfActive)<>0) then
 
2868
    SetCmdState([cmSaveAs],Enable);
 
2869
end;
 
2870
 
 
2871
 
 
2872
procedure TMessageListBox.HandleEvent(var Event: TEvent);
 
2873
var DontClear: boolean;
 
2874
begin
 
2875
  case Event.What of
 
2876
    evKeyDown :
 
2877
      begin
 
2878
        DontClear:=false;
 
2879
        case Event.KeyCode of
 
2880
          kbEnter :
 
2881
            begin
 
2882
              Message(@Self,evCommand,cmMsgGotoSource,nil);
 
2883
              ClearEvent(Event);
 
2884
              exit;
 
2885
            end;
 
2886
        else
 
2887
          DontClear:=true;
 
2888
        end;
 
2889
        if not DontClear then
 
2890
          ClearEvent(Event);
 
2891
      end;
 
2892
    evBroadcast :
 
2893
      case Event.Command of
 
2894
        cmListItemSelected :
 
2895
          if Event.InfoPtr=@Self then
 
2896
            Message(@Self,evCommand,cmMsgTrackSource,nil);
 
2897
      end;
 
2898
    evCommand :
 
2899
      begin
 
2900
        DontClear:=false;
 
2901
        case Event.Command of
 
2902
          cmMsgGotoSource :
 
2903
            if Range>0 then
 
2904
              begin
 
2905
                GotoSource;
 
2906
                ClearEvent(Event);
 
2907
                exit;
 
2908
              end;
 
2909
          cmMsgTrackSource :
 
2910
            if Range>0 then
 
2911
              TrackSource;
 
2912
          cmMsgClear :
 
2913
            Clear;
 
2914
          cmSaveAs :
 
2915
            SaveAs;
 
2916
          else
 
2917
            DontClear:=true;
 
2918
        end;
 
2919
        if not DontClear then
 
2920
          ClearEvent(Event);
 
2921
      end;
 
2922
  end;
 
2923
  inherited HandleEvent(Event);
 
2924
end;
 
2925
 
 
2926
procedure TMessageListBox.AddItem(P: PMessageItem);
 
2927
var W : integer;
 
2928
begin
 
2929
  if List=nil then New(List, Init(500,500));
 
2930
  W:=length(P^.GetText(255));
 
2931
  if W>MaxWidth then
 
2932
  begin
 
2933
    MaxWidth:=W;
 
2934
    if HScrollBar<>nil then
 
2935
       HScrollBar^.SetRange(0,MaxWidth);
 
2936
  end;
 
2937
  List^.Insert(P);
 
2938
  SetRange(List^.Count);
 
2939
  if Focused=List^.Count-1-1 then
 
2940
     FocusItem(List^.Count-1);
 
2941
  DrawView;
 
2942
end;
 
2943
 
 
2944
function TMessageListBox.AddModuleName(const Name: string): PString;
 
2945
var P: PString;
 
2946
begin
 
2947
  if ModuleNames<>nil then
 
2948
    P:=ModuleNames^.Add(Name)
 
2949
  else
 
2950
    P:=nil;
 
2951
  AddModuleName:=P;
 
2952
end;
 
2953
 
 
2954
function TMessageListBox.GetText(Item,MaxLen: Sw_Integer): String;
 
2955
var P: PMessageItem;
 
2956
    S: string;
 
2957
begin
 
2958
  P:=List^.At(Item);
 
2959
  S:=P^.GetText(MaxLen);
 
2960
  GetText:=copy(S,1,MaxLen);
 
2961
end;
 
2962
 
 
2963
procedure TMessageListBox.Clear;
 
2964
begin
 
2965
  if assigned(List) then
 
2966
    Dispose(List, Done);
 
2967
  List:=nil;
 
2968
  MaxWidth:=0;
 
2969
  if assigned(ModuleNames) then
 
2970
    ModuleNames^.FreeAll;
 
2971
  SetRange(0); DrawView;
 
2972
  Message(Application,evBroadcast,cmClearLineHighlights,@Self);
 
2973
end;
 
2974
 
 
2975
procedure TMessageListBox.TrackSource;
 
2976
var W: PSourceWindow;
 
2977
    P: PMessageItem;
 
2978
    R: TRect;
 
2979
    Row,Col: sw_integer;
 
2980
    Found : boolean;
 
2981
begin
 
2982
  Message(Application,evBroadcast,cmClearLineHighlights,@Self);
 
2983
  if Range=0 then Exit;
 
2984
  P:=List^.At(Focused);
 
2985
  if P^.Row=0 then Exit;
 
2986
  Desktop^.Lock;
 
2987
  GetNextEditorBounds(R);
 
2988
  R.B.Y:=Owner^.Origin.Y;
 
2989
  if P^.Row>0 then Row:=P^.Row-1 else Row:=0;
 
2990
  if P^.Col>0 then Col:=P^.Col-1 else Col:=0;
 
2991
  W:=EditorWindowFile(P^.GetModuleName);
 
2992
  if assigned(W) then
 
2993
    begin
 
2994
      W^.GetExtent(R);
 
2995
      R.B.Y:=Owner^.Origin.Y;
 
2996
      W^.ChangeBounds(R);
 
2997
      W^.Editor^.SetCurPtr(Col,Row);
 
2998
    end
 
2999
  else
 
3000
    W:=TryToOpenFile(@R,P^.GetModuleName,Col,Row,true);
 
3001
  { Try to find it by browsing }
 
3002
  if W=nil then
 
3003
    begin
 
3004
      Desktop^.UnLock;
 
3005
      Found:=IDEApp.OpenSearch(P^.GetModuleName+'*');
 
3006
      if found then
 
3007
        W:=TryToOpenFile(nil,P^.GetModuleName,Col,Row,true);
 
3008
      Desktop^.Lock;
 
3009
    end;
 
3010
  if W<>nil then
 
3011
    begin
 
3012
      W^.Select;
 
3013
      W^.Editor^.TrackCursor(true);
 
3014
      W^.Editor^.SetLineFlagExclusive(lfHighlightRow,Row);
 
3015
    end;
 
3016
  if Assigned(Owner) then
 
3017
    Owner^.Select;
 
3018
  Desktop^.UnLock;
 
3019
end;
 
3020
 
 
3021
procedure TMessageListBox.GotoSource;
 
3022
var W: PSourceWindow;
 
3023
    P: PMessageItem;
 
3024
    R:TRect;
 
3025
    Row,Col: sw_integer;
 
3026
    Found : boolean;
 
3027
    Event : TEvent;
 
3028
begin
 
3029
  Message(Application,evBroadcast,cmClearLineHighlights,@Self);
 
3030
  if Range=0 then Exit;
 
3031
  P:=List^.At(Focused);
 
3032
  if P^.Row=0 then Exit;
 
3033
  Desktop^.Lock;
 
3034
  if P^.Row>0 then Row:=P^.Row-1 else Row:=0;
 
3035
  if P^.Col>0 then Col:=P^.Col-1 else Col:=0;
 
3036
  W:=EditorWindowFile(P^.GetModuleName);
 
3037
  if assigned(W) then
 
3038
    begin
 
3039
      W^.GetExtent(R);
 
3040
      if Owner^.Origin.Y>R.A.Y+4 then
 
3041
        R.B.Y:=Owner^.Origin.Y;
 
3042
      W^.ChangeBounds(R);
 
3043
      W^.Editor^.SetCurPtr(Col,Row);
 
3044
    end
 
3045
  else
 
3046
   W:=TryToOpenFile(nil,P^.GetModuleName,Col,Row,true);
 
3047
  { Try to find it by browsing }
 
3048
  if W=nil then
 
3049
    begin
 
3050
      Desktop^.UnLock;
 
3051
      Found:=IDEApp.OpenSearch(P^.GetModuleName+'*');
 
3052
      if found then
 
3053
        W:=TryToOpenFile(nil,P^.GetModuleName,Col,Row,true);
 
3054
      Desktop^.Lock;
 
3055
    end;
 
3056
  if assigned(W) then
 
3057
    begin
 
3058
      { Message(Owner,evCommand,cmClose,nil);
 
3059
        This calls close on StackWindow
 
3060
        rendering P invalid
 
3061
        so postpone it PM }
 
3062
      W^.GetExtent(R);
 
3063
      if (P^.TClass<>0) then
 
3064
        W^.Editor^.SetErrorMessage(P^.GetText(R.B.X-R.A.X));
 
3065
      W^.Select;
 
3066
      Owner^.Hide;
 
3067
    end;
 
3068
  Desktop^.UnLock;
 
3069
  if assigned(W) then
 
3070
    begin
 
3071
      Event.What:=evCommand;
 
3072
      Event.command:=cmClose;
 
3073
      Event.InfoPtr:=nil;
 
3074
      fpide.PutEvent(Owner,Event);
 
3075
    end;
 
3076
end;
 
3077
 
 
3078
procedure TMessageListBox.Draw;
 
3079
var
 
3080
  I, J, Item: Sw_Integer;
 
3081
  NormalColor, SelectedColor, FocusedColor, Color: Word;
 
3082
  ColWidth, CurCol, Indent: Integer;
 
3083
  B: TDrawBuffer;
 
3084
  Text: String;
 
3085
  SCOff: Byte;
 
3086
  TC: byte;
 
3087
procedure MT(var C: word); begin if TC<>0 then C:=(C and $ff0f) or (TC and $f0); end;
 
3088
begin
 
3089
  if (Owner<>nil) then TC:=ord(Owner^.GetColor(6)) else TC:=0;
 
3090
  if State and (sfSelected + sfActive) = (sfSelected + sfActive) then
 
3091
  begin
 
3092
    NormalColor := GetColor(1);
 
3093
    FocusedColor := GetColor(3);
 
3094
    SelectedColor := GetColor(4);
 
3095
  end else
 
3096
  begin
 
3097
    NormalColor := GetColor(2);
 
3098
    SelectedColor := GetColor(4);
 
3099
  end;
 
3100
  if Transparent then
 
3101
    begin MT(NormalColor); MT(SelectedColor); end;
 
3102
  if NoSelection then
 
3103
     SelectedColor:=NormalColor;
 
3104
  if HScrollBar <> nil then Indent := HScrollBar^.Value
 
3105
  else Indent := 0;
 
3106
  ColWidth := Size.X div NumCols + 1;
 
3107
  for I := 0 to Size.Y - 1 do
 
3108
  begin
 
3109
    for J := 0 to NumCols-1 do
 
3110
    begin
 
3111
      Item := J*Size.Y + I + TopItem;
 
3112
      CurCol := J*ColWidth;
 
3113
      if (State and (sfSelected + sfActive) = (sfSelected + sfActive)) and
 
3114
        (Focused = Item) and (Range > 0) then
 
3115
      begin
 
3116
        Color := FocusedColor;
 
3117
        SetCursor(CurCol+1,I);
 
3118
        SCOff := 0;
 
3119
      end
 
3120
      else if (Item < Range) and IsSelected(Item) then
 
3121
      begin
 
3122
        Color := SelectedColor;
 
3123
        SCOff := 2;
 
3124
      end
 
3125
      else
 
3126
      begin
 
3127
        Color := NormalColor;
 
3128
        SCOff := 4;
 
3129
      end;
 
3130
      MoveChar(B[CurCol], ' ', Color, ColWidth);
 
3131
      if Item < Range then
 
3132
      begin
 
3133
        Text := GetText(Item, ColWidth + Indent);
 
3134
        Text := Copy(Text,Indent,ColWidth);
 
3135
        MoveStr(B[CurCol+1], Text, Color);
 
3136
        if ShowMarkers then
 
3137
        begin
 
3138
          WordRec(B[CurCol]).Lo := Byte(SpecialChars[SCOff]);
 
3139
          WordRec(B[CurCol+ColWidth-2]).Lo := Byte(SpecialChars[SCOff+1]);
 
3140
        end;
 
3141
      end;
 
3142
      MoveChar(B[CurCol+ColWidth-1], #179, GetColor(5), 1);
 
3143
    end;
 
3144
    WriteLine(0, I, Size.X, 1, B);
 
3145
  end;
 
3146
end;
 
3147
 
 
3148
constructor TMessageListBox.Load(var S: TStream);
 
3149
begin
 
3150
  inherited Load(S);
 
3151
  New(ModuleNames, Init(50,100));
 
3152
  NoSelection:=true;
 
3153
end;
 
3154
 
 
3155
procedure TMessageListBox.Store(var S: TStream);
 
3156
var OL: PCollection;
 
3157
    ORV: sw_integer;
 
3158
begin
 
3159
  OL:=List; ORV:=Range;
 
3160
 
 
3161
  New(List, Init(1,1)); Range:=0;
 
3162
 
 
3163
  inherited Store(S);
 
3164
 
 
3165
  Dispose(List, Done);
 
3166
  List:=OL; Range:=ORV;
 
3167
  { ^^^ nasty trick - has anyone a better idea how to avoid storing the
 
3168
    collection? Pasting here a modified version of TListBox.Store+
 
3169
    TAdvancedListBox.Store isn't a better solution, since by eventually
 
3170
    changing the obj-hierarchy you'll always have to modify this, too - BG }
 
3171
end;
 
3172
 
 
3173
destructor TMessageListBox.Done;
 
3174
begin
 
3175
  inherited Done;
 
3176
  if List<>nil then Dispose(List, Done);
 
3177
  if ModuleNames<>nil then Dispose(ModuleNames, Done);
 
3178
end;
 
3179
 
 
3180
constructor TMessageItem.Init(AClass: longint; const AText: string; AModule: PString; ARow, ACol: sw_integer);
 
3181
begin
 
3182
  inherited Init;
 
3183
  TClass:=AClass;
 
3184
  Text:=NewStr(AText);
 
3185
  Module:=AModule;
 
3186
  Row:=ARow; Col:=ACol;
 
3187
end;
 
3188
 
 
3189
function TMessageItem.GetText(MaxLen: Sw_integer): string;
 
3190
var S: string;
 
3191
begin
 
3192
  if Text=nil then S:='' else S:=Text^;
 
3193
  if (Module<>nil) then
 
3194
     S:=NameAndExtOf(Module^)+'('+IntToStr(Row)+') '+S;
 
3195
  if length(S)>MaxLen then S:=copy(S,1,MaxLen-2)+'..';
 
3196
  GetText:=S;
 
3197
end;
 
3198
 
 
3199
procedure TMessageItem.Selected;
 
3200
begin
 
3201
end;
 
3202
 
 
3203
function TMessageItem.GetModuleName: string;
 
3204
begin
 
3205
  GetModuleName:=GetStr(Module);
 
3206
end;
 
3207
 
 
3208
destructor TMessageItem.Done;
 
3209
begin
 
3210
  inherited Done;
 
3211
  if Text<>nil then DisposeStr(Text);
 
3212
{  if Module<>nil then DisposeStr(Module);}
 
3213
end;
 
3214
 
 
3215
 
 
3216
procedure  TFPDlgWindow.HandleEvent(var Event: TEvent);
 
3217
begin
 
3218
  case Event.What of
 
3219
    evBroadcast :
 
3220
      case Event.Command of
 
3221
        cmSearchWindow+1..cmSearchWindow+99 :
 
3222
          if (Event.Command-cmSearchWindow=Number) then
 
3223
              ClearEvent(Event);
 
3224
      end;
 
3225
  end;
 
3226
  inherited HandleEvent(Event);
 
3227
end;
 
3228
 
 
3229
 
 
3230
(*
 
3231
constructor TTab.Init(var Bounds: TRect; ATabDef: PTabDef);
 
3232
begin
 
3233
  inherited Init(Bounds);
 
3234
  Options:=Options or ofSelectable or ofFirstClick or ofPreProcess or ofPostProcess;
 
3235
  GrowMode:=gfGrowHiX+gfGrowHiY+gfGrowRel;
 
3236
  TabDefs:=ATabDef;
 
3237
  ActiveDef:=-1;
 
3238
  SelectTab(0);
 
3239
  ReDraw;
 
3240
end;
 
3241
 
 
3242
function TTab.TabCount: integer;
 
3243
var i: integer;
 
3244
    P: PTabDef;
 
3245
begin
 
3246
  I:=0; P:=TabDefs;
 
3247
  while (P<>nil) do
 
3248
    begin
 
3249
      Inc(I);
 
3250
      P:=P^.Next;
 
3251
    end;
 
3252
  TabCount:=I;
 
3253
end;
 
3254
 
 
3255
function TTab.AtTab(Index: integer): PTabDef;
 
3256
var i: integer;
 
3257
    P: PTabDef;
 
3258
begin
 
3259
  i:=0; P:=TabDefs;
 
3260
  while (I<Index) do
 
3261
    begin
 
3262
      if P=nil then RunError($AA);
 
3263
      P:=P^.Next;
 
3264
      Inc(i);
 
3265
    end;
 
3266
  AtTab:=P;
 
3267
end;
 
3268
 
 
3269
procedure TTab.SelectTab(Index: integer);
 
3270
var P: PTabItem;
 
3271
    V: PView;
 
3272
begin
 
3273
  if ActiveDef<>Index then
 
3274
  begin
 
3275
    if Owner<>nil then Owner^.Lock;
 
3276
    Lock;
 
3277
    { --- Update --- }
 
3278
    if TabDefs<>nil then
 
3279
       begin
 
3280
         DefCount:=1;
 
3281
         while AtTab(DefCount-1)^.Next<>nil do Inc(DefCount);
 
3282
       end
 
3283
       else DefCount:=0;
 
3284
    if ActiveDef<>-1 then
 
3285
    begin
 
3286
      P:=AtTab(ActiveDef)^.Items;
 
3287
      while P<>nil do
 
3288
        begin
 
3289
          if P^.View<>nil then Delete(P^.View);
 
3290
          P:=P^.Next;
 
3291
        end;
 
3292
    end;
 
3293
    ActiveDef:=Index;
 
3294
    P:=AtTab(ActiveDef)^.Items;
 
3295
    while P<>nil do
 
3296
      begin
 
3297
        if P^.View<>nil then Insert(P^.View);
 
3298
        P:=P^.Next;
 
3299
      end;
 
3300
    V:=AtTab(ActiveDef)^.DefItem;
 
3301
    if V<>nil then V^.Select;
 
3302
    ReDraw;
 
3303
    { --- Update --- }
 
3304
    UnLock;
 
3305
    if Owner<>nil then Owner^.UnLock;
 
3306
    DrawView;
 
3307
  end;
 
3308
end;
 
3309
 
 
3310
procedure TTab.ChangeBounds(var Bounds: TRect);
 
3311
var D: TPoint;
 
3312
procedure DoCalcChange(P: PView); {$ifndef FPC}far;{$endif}
 
3313
var
 
3314
  R: TRect;
 
3315
begin
 
3316
  if P^.Owner=nil then Exit; { it think this is a bug in TV }
 
3317
  P^.CalcBounds(R, D);
 
3318
  P^.ChangeBounds(R);
 
3319
end;
 
3320
var
 
3321
    P: PTabItem;
 
3322
    I: integer;
 
3323
begin
 
3324
  D.X := Bounds.B.X - Bounds.A.X - Size.X;
 
3325
  D.Y := Bounds.B.Y - Bounds.A.Y - Size.Y;
 
3326
  inherited ChangeBounds(Bounds);
 
3327
  for I:=0 to TabCount-1 do
 
3328
  if I<>ActiveDef then
 
3329
    begin
 
3330
      P:=AtTab(I)^.Items;
 
3331
      while P<>nil do
 
3332
        begin
 
3333
          if P^.View<>nil then DoCalcChange(P^.View);
 
3334
          P:=P^.Next;
 
3335
        end;
 
3336
    end;
 
3337
end;
 
3338
 
 
3339
procedure TTab.SelectNextTab(Forwards: boolean);
 
3340
var Index: integer;
 
3341
begin
 
3342
  Index:=ActiveDef;
 
3343
  if Index=-1 then Exit;
 
3344
  if Forwards then Inc(Index) else Dec(Index);
 
3345
  if Index<0 then Index:=DefCount-1 else
 
3346
  if Index>DefCount-1 then Index:=0;
 
3347
  SelectTab(Index);
 
3348
end;
 
3349
 
 
3350
procedure TTab.HandleEvent(var Event: TEvent);
 
3351
var Index : integer;
 
3352
    I     : integer;
 
3353
    X     : integer;
 
3354
    Len   : byte;
 
3355
    P     : TPoint;
 
3356
    V     : PView;
 
3357
    CallOrig: boolean;
 
3358
    LastV : PView;
 
3359
    FirstV: PView;
 
3360
function FirstSelectable: PView;
 
3361
var
 
3362
    FV : PView;
 
3363
begin
 
3364
  FV := First;
 
3365
  while (FV<>nil) and ((FV^.Options and ofSelectable)=0) and (FV<>Last) do
 
3366
        FV:=FV^.Next;
 
3367
  if FV<>nil then
 
3368
    if (FV^.Options and ofSelectable)=0 then FV:=nil;
 
3369
  FirstSelectable:=FV;
 
3370
end;
 
3371
function LastSelectable: PView;
 
3372
var
 
3373
    LV : PView;
 
3374
begin
 
3375
  LV := Last;
 
3376
  while (LV<>nil) and ((LV^.Options and ofSelectable)=0) and (LV<>First) do
 
3377
        LV:=LV^.Prev;
 
3378
  if LV<>nil then
 
3379
    if (LV^.Options and ofSelectable)=0 then LV:=nil;
 
3380
  LastSelectable:=LV;
 
3381
end;
 
3382
begin
 
3383
  if (Event.What and evMouseDown)<>0 then
 
3384
     begin
 
3385
       MakeLocal(Event.Where,P);
 
3386
       if P.Y<3 then
 
3387
          begin
 
3388
            Index:=-1; X:=1;
 
3389
            for i:=0 to DefCount-1 do
 
3390
                begin
 
3391
                  Len:=CStrLen(AtTab(i)^.Name^);
 
3392
                  if (P.X>=X) and (P.X<=X+Len+1) then Index:=i;
 
3393
                  X:=X+Len+3;
 
3394
                end;
 
3395
            if Index<>-1 then
 
3396
               SelectTab(Index);
 
3397
          end;
 
3398
     end;
 
3399
  if Event.What=evKeyDown then
 
3400
     begin
 
3401
       Index:=-1;
 
3402
       case Event.KeyCode of
 
3403
            kbCtrlTab :
 
3404
              begin
 
3405
                SelectNextTab((Event.KeyShift and kbShift)=0);
 
3406
                ClearEvent(Event);
 
3407
              end;
 
3408
            kbTab,kbShiftTab  :
 
3409
              if GetState(sfSelected) then
 
3410
                 begin
 
3411
                   if Current<>nil then
 
3412
                   begin
 
3413
                   LastV:=LastSelectable; FirstV:=FirstSelectable;
 
3414
                   if ((Current=LastV) or (Current=PLabel(LastV)^.Link)) and (Event.KeyCode=kbShiftTab) then
 
3415
                      begin
 
3416
                        if Owner<>nil then Owner^.SelectNext(true);
 
3417
                      end else
 
3418
                   if ((Current=FirstV) or (Current=PLabel(FirstV)^.Link)) and (Event.KeyCode=kbTab) then
 
3419
                      begin
 
3420
                        Lock;
 
3421
                        if Owner<>nil then Owner^.SelectNext(false);
 
3422
                        UnLock;
 
3423
                      end else
 
3424
                   SelectNext(Event.KeyCode=kbShiftTab);
 
3425
                   ClearEvent(Event);
 
3426
                   end;
 
3427
                 end;
 
3428
       else
 
3429
       for I:=0 to DefCount-1 do
 
3430
           begin
 
3431
             if Upcase(GetAltChar(Event.KeyCode))=AtTab(I)^.ShortCut
 
3432
                then begin
 
3433
                       Index:=I;
 
3434
                       ClearEvent(Event);
 
3435
                       Break;
 
3436
                     end;
 
3437
           end;
 
3438
       end;
 
3439
       if Index<>-1 then
 
3440
          begin
 
3441
            Select;
 
3442
            SelectTab(Index);
 
3443
            V:=AtTab(ActiveDef)^.DefItem;
 
3444
            if V<>nil then V^.Focus;
 
3445
          end;
 
3446
     end;
 
3447
  CallOrig:=true;
 
3448
  if Event.What=evKeyDown then
 
3449
     begin
 
3450
     if ((Owner<>nil) and (Owner^.Phase=phPostProcess) and (GetAltChar(Event.KeyCode)<>#0)) or GetState(sfFocused)
 
3451
        then
 
3452
        else CallOrig:=false;
 
3453
     end;
 
3454
  if CallOrig then inherited HandleEvent(Event);
 
3455
end;
 
3456
 
 
3457
function TTab.GetPalette: PPalette;
 
3458
begin
 
3459
  GetPalette:=nil;
 
3460
end;
 
3461
 
 
3462
procedure TTab.Draw;
 
3463
var B     : TDrawBuffer;
 
3464
    i     : integer;
 
3465
    C1,C2,C3,C : word;
 
3466
    HeaderLen  : integer;
 
3467
    X,X2       : integer;
 
3468
    Name       : PString;
 
3469
    ActiveKPos : integer;
 
3470
    ActiveVPos : integer;
 
3471
    FC   : char;
 
3472
    ClipR      : TRect;
 
3473
procedure SWriteBuf(X,Y,W,H: integer; var Buf);
 
3474
var i: integer;
 
3475
begin
 
3476
  if Y+H>Size.Y then H:=Size.Y-Y;
 
3477
  if X+W>Size.X then W:=Size.X-X;
 
3478
  if Buffer=nil then WriteBuf(X,Y,W,H,Buf)
 
3479
                else for i:=1 to H do
 
3480
                         Move(Buf,Buffer^[X+(Y+i-1)*Size.X],W*2);
 
3481
end;
 
3482
procedure ClearBuf;
 
3483
begin
 
3484
  MoveChar(B,' ',C1,Size.X);
 
3485
end;
 
3486
begin
 
3487
  if InDraw then Exit;
 
3488
  InDraw:=true;
 
3489
  { - Start of TGroup.Draw - }
 
3490
{  if Buffer = nil then
 
3491
  begin
 
3492
    GetBuffer;
 
3493
  end; }
 
3494
  { - Start of TGroup.Draw - }
 
3495
 
 
3496
  C1:=GetColor(1); C2:=(GetColor(7) and $f0 or $08)+GetColor(9)*256; C3:=GetColor(8)+GetColor({9}8)*256;
 
3497
  HeaderLen:=0; for i:=0 to DefCount-1 do HeaderLen:=HeaderLen+CStrLen(AtTab(i)^.Name^)+3; Dec(HeaderLen);
 
3498
  if HeaderLen>Size.X-2 then HeaderLen:=Size.X-2;
 
3499
 
 
3500
  { --- 1. sor --- }
 
3501
  ClearBuf; MoveChar(B[0],'�',C1,1); MoveChar(B[HeaderLen+1],'�',C1,1);
 
3502
  X:=1;
 
3503
  for i:=0 to DefCount-1 do
 
3504
      begin
 
3505
        Name:=AtTab(i)^.Name; X2:=CStrLen(Name^);
 
3506
        if i=ActiveDef
 
3507
           then begin
 
3508
                  ActiveKPos:=X-1;
 
3509
                  ActiveVPos:=X+X2+2;
 
3510
                  if GetState(sfFocused) then C:=C3 else C:=C2;
 
3511
                end
 
3512
           else C:=C2;
 
3513
        MoveCStr(B[X],' '+Name^+' ',C); X:=X+X2+3;
 
3514
        MoveChar(B[X-1],'�',C1,1);
 
3515
      end;
 
3516
  SWriteBuf(0,1,Size.X,1,B);
 
3517
 
 
3518
  { --- 0. sor --- }
 
3519
  ClearBuf; MoveChar(B[0],'�',C1,1);
 
3520
  X:=1;
 
3521
  for i:=0 to DefCount-1 do
 
3522
      begin
 
3523
        if I<ActiveDef then FC:='�'
 
3524
                       else FC:='�';
 
3525
        X2:=CStrLen(AtTab(i)^.Name^)+2;
 
3526
        MoveChar(B[X+X2],{'�'}FC,C1,1);
 
3527
        if i=DefCount-1 then X2:=X2+1;
 
3528
        if X2>0 then
 
3529
        MoveChar(B[X],'�',C1,X2);
 
3530
        X:=X+X2+1;
 
3531
      end;
 
3532
  MoveChar(B[HeaderLen+1],'�',C1,1);
 
3533
  MoveChar(B[ActiveKPos],'�',C1,1); MoveChar(B[ActiveVPos],'�',C1,1);
 
3534
  SWriteBuf(0,0,Size.X,1,B);
 
3535
 
 
3536
  { --- 2. sor --- }
 
3537
  MoveChar(B[1],'�',C1,Max(HeaderLen,0)); MoveChar(B[HeaderLen+2],'�',C1,Max(Size.X-HeaderLen-3,0));
 
3538
  MoveChar(B[Size.X-1],'�',C1,1);
 
3539
  MoveChar(B[ActiveKPos],'�',C1,1);
 
3540
  if ActiveDef=0 then MoveChar(B[0],'�',C1,1)
 
3541
                 else MoveChar(B[0],{'�'}'�',C1,1);
 
3542
  MoveChar(B[HeaderLen+1],'�'{'�'},C1,1); MoveChar(B[ActiveVPos],'�',C1,1);
 
3543
  MoveChar(B[ActiveKPos+1],' ',C1,Max(ActiveVPos-ActiveKPos-1,0));
 
3544
  SWriteBuf(0,2,Size.X,1,B);
 
3545
 
 
3546
  { --- marad�k sor --- }
 
3547
  ClearBuf; MoveChar(B[0],'�',C1,1); MoveChar(B[Size.X-1],'�',C1,1);
 
3548
  for i:=3 to Size.Y-1 do
 
3549
    SWriteBuf(0,i,Size.X,1,B);
 
3550
  { SWriteBuf(0,3,Size.X,Size.Y-4,B); this was wrong
 
3551
    because WriteBuf then expect a buffer of size size.x*(size.y-4)*2 PM }
 
3552
 
 
3553
  { --- Size.X . sor --- }
 
3554
  MoveChar(B[0],'�',C1,1); MoveChar(B[1],'�',C1,Max(Size.X-2,0)); MoveChar(B[Size.X-1],'�',C1,1);
 
3555
  SWriteBuf(0,Size.Y-1,Size.X,1,B);
 
3556
 
 
3557
  { - End of TGroup.Draw - }
 
3558
  if Buffer <> nil then
 
3559
  begin
 
3560
    Lock;
 
3561
    Redraw;
 
3562
    UnLock;
 
3563
  end;
 
3564
  if Buffer <> nil then WriteBuf(0, 0, Size.X, Size.Y, Buffer^) else
 
3565
  begin
 
3566
    GetClipRect(ClipR);
 
3567
    Redraw;
 
3568
    GetExtent(ClipR);
 
3569
  end;
 
3570
  { - End of TGroup.Draw - }
 
3571
  InDraw:=false;
 
3572
end;
 
3573
 
 
3574
function TTab.Valid(Command: Word): Boolean;
 
3575
var PT : PTabDef;
 
3576
    PI : PTabItem;
 
3577
    OK : boolean;
 
3578
begin
 
3579
  OK:=true;
 
3580
  PT:=TabDefs;
 
3581
  while (PT<>nil) and (OK=true) do
 
3582
        begin
 
3583
          PI:=PT^.Items;
 
3584
          while (PI<>nil) and (OK=true) do
 
3585
                begin
 
3586
                  if PI^.View<>nil then OK:=OK and PI^.View^.Valid(Command);
 
3587
                  PI:=PI^.Next;
 
3588
                end;
 
3589
          PT:=PT^.Next;
 
3590
        end;
 
3591
  Valid:=OK;
 
3592
end;
 
3593
 
 
3594
procedure TTab.SetState(AState: Word; Enable: Boolean);
 
3595
begin
 
3596
  inherited SetState(AState,Enable);
 
3597
  if (AState and sfFocused)<>0 then DrawView;
 
3598
end;
 
3599
 
 
3600
destructor TTab.Done;
 
3601
var P,X: PTabDef;
 
3602
procedure DeleteViews(P: PView); {$ifndef FPC}far;{$endif}
 
3603
begin
 
3604
  if P<>nil then Delete(P);
 
3605
end;
 
3606
begin
 
3607
  ForEach(@DeleteViews);
 
3608
  inherited Done;
 
3609
  P:=TabDefs;
 
3610
  while P<>nil do
 
3611
        begin
 
3612
          X:=P^.Next;
 
3613
          DisposeTabDef(P);
 
3614
          P:=X;
 
3615
        end;
 
3616
end;
 
3617
*)
 
3618
 
 
3619
 
 
3620
constructor TScreenView.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar;
 
3621
              AScreen: PScreen);
 
3622
begin
 
3623
  inherited Init(Bounds,AHScrollBar,AVScrollBar);
 
3624
  Screen:=AScreen;
 
3625
  if Screen=nil then
 
3626
   Fail;
 
3627
  SetState(sfCursorVis,true);
 
3628
  Update;
 
3629
end;
 
3630
 
 
3631
procedure TScreenView.Update;
 
3632
begin
 
3633
  SetLimit(UserScreen^.GetWidth,UserScreen^.GetHeight);
 
3634
  DrawView;
 
3635
end;
 
3636
 
 
3637
procedure TScreenView.HandleEvent(var Event: TEvent);
 
3638
begin
 
3639
  case Event.What of
 
3640
    evBroadcast :
 
3641
      case Event.Command of
 
3642
        cmUpdate  : Update;
 
3643
      end;
 
3644
  end;
 
3645
  inherited HandleEvent(Event);
 
3646
end;
 
3647
 
 
3648
procedure TScreenView.Draw;
 
3649
var B: TDrawBuffer;
 
3650
    X,Y: integer;
 
3651
    Text,Attr: string;
 
3652
    P: TPoint;
 
3653
begin
 
3654
  Screen^.GetCursorPos(P);
 
3655
  for Y:=Delta.Y to Delta.Y+Size.Y-1 do
 
3656
  begin
 
3657
    if Y<Screen^.GetHeight then
 
3658
      Screen^.GetLine(Y,Text,Attr)
 
3659
    else
 
3660
       begin Text:=''; Attr:=''; end;
 
3661
    Text:=copy(Text,Delta.X+1,255); Attr:=copy(Attr,Delta.X+1,255);
 
3662
    MoveChar(B,' ',GetColor(1),Size.X);
 
3663
    for X:=1 to length(Text) do
 
3664
      MoveChar(B[X-1],Text[X],ord(Attr[X]),1);
 
3665
    WriteLine(0,Y-Delta.Y,Size.X,1,B);
 
3666
  end;
 
3667
  SetCursor(P.X-Delta.X,P.Y-Delta.Y);
 
3668
end;
 
3669
 
 
3670
constructor TScreenWindow.Init(AScreen: PScreen; ANumber: integer);
 
3671
var R: TRect;
 
3672
    VSB,HSB: PScrollBar;
 
3673
begin
 
3674
  Desktop^.GetExtent(R);
 
3675
  inherited Init(R, dialog_userscreen, ANumber);
 
3676
  Options:=Options or ofTileAble;
 
3677
  GetExtent(R); R.Grow(-1,-1); R.Move(1,0); R.A.X:=R.B.X-1;
 
3678
  New(VSB, Init(R)); VSB^.Options:=VSB^.Options or ofPostProcess;
 
3679
  VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY; Insert(VSB);
 
3680
  GetExtent(R); R.Grow(-1,-1); R.Move(0,1); R.A.Y:=R.B.Y-1;
 
3681
  New(HSB, Init(R)); HSB^.Options:=HSB^.Options or ofPostProcess;
 
3682
  HSB^.GrowMode:=gfGrowLoY+gfGrowHiX+gfGrowHiY; Insert(HSB);
 
3683
  GetExtent(R); R.Grow(-1,-1);
 
3684
  New(ScreenView, Init(R, HSB, VSB, AScreen));
 
3685
  ScreenView^.GrowMode:=gfGrowHiX+gfGrowHiY;
 
3686
  Insert(ScreenView);
 
3687
  UserScreenWindow:=@Self;
 
3688
end;
 
3689
 
 
3690
destructor TScreenWindow.Done;
 
3691
begin
 
3692
  inherited Done;
 
3693
  UserScreenWindow:=nil;
 
3694
end;
 
3695
 
 
3696
const InTranslate : boolean = false;
 
3697
 
 
3698
procedure TranslateMouseClick(View: PView; var Event: TEvent);
 
3699
procedure TranslateAction(Action: integer);
 
3700
var E: TEvent;
 
3701
begin
 
3702
  if Action<>acNone then
 
3703
  begin
 
3704
    E:=Event;
 
3705
    E.What:=evMouseDown; E.Buttons:=mbLeftButton;
 
3706
    View^.HandleEvent(E);
 
3707
    Event.What:=evCommand;
 
3708
    Event.Command:=ActionCommands[Action];
 
3709
  end;
 
3710
end;
 
3711
begin
 
3712
  if InTranslate then Exit;
 
3713
  InTranslate:=true;
 
3714
  case Event.What of
 
3715
    evMouseDown :
 
3716
      if (GetShiftState and kbAlt)<>0 then
 
3717
        TranslateAction(AltMouseAction) else
 
3718
      if (GetShiftState and kbCtrl)<>0 then
 
3719
        TranslateAction(CtrlMouseAction);
 
3720
  end;
 
3721
  InTranslate:=false;
 
3722
end;
 
3723
 
 
3724
function GetNextEditorBounds(var Bounds: TRect): boolean;
 
3725
var P: PView;
 
3726
begin
 
3727
  P:=Desktop^.Current;
 
3728
  while P<>nil do
 
3729
  begin
 
3730
    if P^.HelpCtx=hcSourceWindow then Break;
 
3731
    P:=P^.NextView;
 
3732
    if P=Desktop^.Current then
 
3733
      begin
 
3734
        P:=nil;
 
3735
        break;
 
3736
      end;
 
3737
  end;
 
3738
  if P=nil then Desktop^.GetExtent(Bounds) else
 
3739
     begin
 
3740
       P^.GetBounds(Bounds);
 
3741
       Inc(Bounds.A.X); Inc(Bounds.A.Y);
 
3742
     end;
 
3743
  GetNextEditorBounds:=P<>nil;
 
3744
end;
 
3745
 
 
3746
function IOpenEditorWindow(Bounds: PRect; FileName: string; CurX,CurY: sw_integer; ShowIt: boolean): PSourceWindow;
 
3747
var R: TRect;
 
3748
    W: PSourceWindow;
 
3749
begin
 
3750
  if Assigned(Bounds) then R.Copy(Bounds^) else
 
3751
    GetNextEditorBounds(R);
 
3752
  PushStatus(FormatStrStr(msg_openingsourcefile,SmartPath(FileName)));
 
3753
  New(W, Init(R, FileName));
 
3754
  if ShowIt=false then
 
3755
    W^.Hide;
 
3756
  if W<>nil then
 
3757
  begin
 
3758
    if (CurX<>0) or (CurY<>0) then
 
3759
       with W^.Editor^ do
 
3760
       begin
 
3761
         SetCurPtr(CurX,CurY);
 
3762
         TrackCursor(true);
 
3763
       end;
 
3764
    W^.HelpCtx:=hcSourceWindow;
 
3765
    Desktop^.Insert(W);
 
3766
    Message(Application,evBroadcast,cmUpdate,nil);
 
3767
  end;
 
3768
  PopStatus;
 
3769
  IOpenEditorWindow:=W;
 
3770
end;
 
3771
 
 
3772
function OpenEditorWindow(Bounds: PRect; FileName: string; CurX,CurY: sw_integer): PSourceWindow;
 
3773
begin
 
3774
  OpenEditorWindow:=IOpenEditorWindow(Bounds,FileName,CurX,CurY,true);
 
3775
end;
 
3776
 
 
3777
 
 
3778
function LastSourceEditor : PSourceWindow;
 
3779
 
 
3780
  function IsSearchedSource(P: PView) : boolean; {$ifndef FPC}far;{$endif}
 
3781
  begin
 
3782
    if assigned(P) and
 
3783
       (TypeOf(P^)=TypeOf(TSourceWindow)) then
 
3784
         IsSearchedSource:=true
 
3785
       else
 
3786
         IsSearchedSource:=false;
 
3787
  end;
 
3788
 
 
3789
begin
 
3790
  LastSourceEditor:=PSourceWindow(Desktop^.FirstThat(@IsSearchedSource));
 
3791
end;
 
3792
 
 
3793
 
 
3794
function SearchOnDesktop(FileName : string;tryexts:boolean) : PSourceWindow;
 
3795
var
 
3796
    D,DS : DirStr;
 
3797
    N,NS : NameStr;
 
3798
    E,ES : ExtStr;
 
3799
    SName : string;
 
3800
 
 
3801
function IsSearchedFile(W : PSourceWindow) : boolean;
 
3802
  var Found: boolean;
 
3803
  begin
 
3804
    Found:=false;
 
3805
    if (W<>nil) and (W^.HelpCtx=hcSourceWindow) then
 
3806
      begin
 
3807
        if (D='') then
 
3808
          SName:=NameAndExtOf(PSourceWindow(W)^.Editor^.FileName)
 
3809
        else
 
3810
          SName:=PSourceWindow(W)^.Editor^.FileName;
 
3811
        FSplit(SName,DS,NS,ES);
 
3812
        SName:=UpcaseStr(NS+ES);
 
3813
 
 
3814
        if (E<>'') or (not tryexts) then
 
3815
          begin
 
3816
            if D<>'' then
 
3817
              Found:=UpCaseStr(DS)+SName=UpcaseStr(D+N+E)
 
3818
            else
 
3819
              Found:=SName=UpcaseStr(N+E);
 
3820
          end
 
3821
        else
 
3822
          begin
 
3823
            Found:=SName=UpcaseStr(N+'.pp');
 
3824
            if Found=false then
 
3825
              Found:=SName=UpcaseStr(N+'.pas');
 
3826
          end;
 
3827
      end;
 
3828
    IsSearchedFile:=found;
 
3829
  end;
 
3830
function IsSearchedSource(P: PView) : boolean; {$ifndef FPC}far;{$endif}
 
3831
begin
 
3832
  if assigned(P) and
 
3833
     (TypeOf(P^)=TypeOf(TSourceWindow)) then
 
3834
       IsSearchedSource:=IsSearchedFile(PSourceWindow(P))
 
3835
     else
 
3836
       IsSearchedSource:=false;
 
3837
end;
 
3838
 
 
3839
begin
 
3840
  FSplit(FileName,D,N,E);
 
3841
  SearchOnDesktop:=PSourceWindow(Desktop^.FirstThat(@IsSearchedSource));
 
3842
end;
 
3843
 
 
3844
function TryToOpenFile(Bounds: PRect; FileName: string; CurX,CurY: sw_integer;tryexts:boolean): PSourceWindow;
 
3845
begin
 
3846
  TryToOpenFile:=ITryToOpenFile(Bounds,FileName,CurX,CurY,tryexts,true,false);
 
3847
end;
 
3848
 
 
3849
function LocateSingleSourceFile(const FileName: string; tryexts: boolean): string;
 
3850
var D : DirStr;
 
3851
    N : NameStr;
 
3852
    E : ExtStr;
 
3853
 
 
3854
  function CheckDir(NewDir: DirStr; NewName: NameStr; NewExt: ExtStr): boolean;
 
3855
  var OK: boolean;
 
3856
  begin
 
3857
    NewDir:=CompleteDir(NewDir);
 
3858
    OK:=ExistsFile(NewDir+NewName+NewExt);
 
3859
    if OK then begin D:=NewDir; N:=NewName; E:=NewExt; end;
 
3860
    CheckDir:=OK;
 
3861
  end;
 
3862
 
 
3863
  function CheckExt(NewExt: ExtStr): boolean;
 
3864
  var OK: boolean;
 
3865
  begin
 
3866
    OK:=false;
 
3867
    if D<>'' then OK:=CheckDir(D,N,NewExt) else
 
3868
      if CheckDir('.'+DirSep,N,NewExt) then OK:=true;
 
3869
    CheckExt:=OK;
 
3870
  end;
 
3871
 
 
3872
  function TryToLocateIn(const DD : dirstr): boolean;
 
3873
  var Found: boolean;
 
3874
  begin
 
3875
    D:=CompleteDir(DD);
 
3876
    Found:=true;
 
3877
    if (E<>'') or (not tryexts) then
 
3878
     Found:=CheckExt(E)
 
3879
    else
 
3880
     if CheckExt('.pp') then
 
3881
      Found:=true
 
3882
    else
 
3883
     if CheckExt('.pas') then
 
3884
      Found:=true
 
3885
    else
 
3886
     if CheckExt('.inc') then
 
3887
      Found:=true
 
3888
    { try also without extension if no other exist }
 
3889
    else
 
3890
     if CheckExt('') then
 
3891
      Found:=true
 
3892
    else
 
3893
      Found:=false;
 
3894
    TryToLocateIn:=Found;
 
3895
  end;
 
3896
var Path,DrStr: string;
 
3897
    Found: boolean;
 
3898
begin
 
3899
  FSplit(FileName,D,N,E);
 
3900
  Found:=CheckDir(D,N,E);
 
3901
  if not found then
 
3902
    Found:=TryToLocateIn('.');
 
3903
  DrStr:=GetSourceDirectories;
 
3904
  if not Found then
 
3905
   While pos(ListSeparator,DrStr)>0 do
 
3906
    Begin
 
3907
      Found:=TryToLocateIn(Copy(DrStr,1,pos(ListSeparator,DrStr)-1));
 
3908
      if Found then
 
3909
        break;
 
3910
      DrStr:=Copy(DrStr,pos(ListSeparator,DrStr)+1,High(DrStr));
 
3911
    End;
 
3912
  if Found then Path:=FExpand(D+N+E) else Path:='';
 
3913
  LocateSingleSourceFile:=Path;
 
3914
end;
 
3915
 
 
3916
function LocateSourceFile(const FileName: string; tryexts: boolean): string;
 
3917
var P: integer;
 
3918
    FN,S: string;
 
3919
    FFN: string;
 
3920
begin
 
3921
  FN:=FileName;
 
3922
  repeat
 
3923
    P:=Pos(ListSeparator,FN); if P=0 then P:=length(FN)+1;
 
3924
    S:=copy(FN,1,P-1); Delete(FN,1,P);
 
3925
    FFN:=LocateSingleSourceFile(S,tryexts);
 
3926
  until (FFN<>'') or (FN='');
 
3927
  LocateSourceFile:=FFN;
 
3928
end;
 
3929
 
 
3930
function ITryToOpenFile(Bounds: PRect; FileName: string; CurX,CurY: sw_integer;tryexts:boolean;
 
3931
         ShowIt,ForceNewWindow: boolean): PSourceWindow;
 
3932
var
 
3933
  W : PSourceWindow;
 
3934
  DrStr: string;
 
3935
begin
 
3936
  W:=nil;
 
3937
  if ForceNewWindow then
 
3938
    W:=nil
 
3939
  else
 
3940
    W:=SearchOnDesktop(FileName,tryexts);
 
3941
  if W<>nil then
 
3942
    begin
 
3943
      NewEditorOpened:=false;
 
3944
{      if assigned(Bounds) then
 
3945
        W^.ChangeBounds(Bounds^);}
 
3946
      W^.Editor^.SetCurPtr(CurX,CurY);
 
3947
    end
 
3948
  else
 
3949
    begin
 
3950
      DrStr:=LocateSourceFile(FileName,tryexts);
 
3951
      if DrStr<>'' then
 
3952
        W:=IOpenEditorWindow(Bounds,DrStr,CurX,CurY,ShowIt);
 
3953
      NewEditorOpened:=W<>nil;
 
3954
      if assigned(W) then
 
3955
        W^.Editor^.SetCurPtr(CurX,CurY);
 
3956
    end;
 
3957
  ITryToOpenFile:=W;
 
3958
end;
 
3959
 
 
3960
function StartEditor(Editor: PCodeEditor; FileName: string): boolean;
 
3961
var OK: boolean;
 
3962
    E: PFileEditor;
 
3963
    R: TRect;
 
3964
begin
 
3965
  R.Assign(0,0,0,0);
 
3966
  New(E, Init(R,nil,nil,nil,nil,FileName));
 
3967
  OK:=E<>nil;
 
3968
  if OK then
 
3969
  begin
 
3970
    PushStatus(FormatStrStr(msg_readingfileineditor,FileName));
 
3971
    OK:=E^.LoadFile;
 
3972
    PopStatus;
 
3973
   end;
 
3974
  if OK then
 
3975
    begin
 
3976
      Editor^.Lock;
 
3977
      E^.SelectAll(true);
 
3978
      Editor^.InsertFrom(E);
 
3979
      Editor^.SetCurPtr(0,0);
 
3980
      Editor^.SelectAll(false);
 
3981
      Editor^.UnLock;
 
3982
      Dispose(E, Done);
 
3983
    end;
 
3984
  StartEditor:=OK;
 
3985
end;
 
3986
 
 
3987
constructor TTextScroller.Init(var Bounds: TRect; ASpeed: integer; AText: PUnsortedStringCollection);
 
3988
begin
 
3989
  inherited Init(Bounds,'');
 
3990
  EventMask:=EventMask or evIdle;
 
3991
  Speed:=ASpeed; Lines:=AText;
 
3992
end;
 
3993
 
 
3994
function TTextScroller.GetLineCount: integer;
 
3995
var Count: integer;
 
3996
begin
 
3997
  if Lines=nil then Count:=0 else
 
3998
    Count:=Lines^.Count;
 
3999
  GetLineCount:=Count;
 
4000
end;
 
4001
 
 
4002
function TTextScroller.GetLine(I: integer): string;
 
4003
var S: string;
 
4004
begin
 
4005
  if I<Lines^.Count then
 
4006
    S:=GetStr(Lines^.At(I))
 
4007
  else
 
4008
    S:='';
 
4009
  GetLine:=S;
 
4010
end;
 
4011
 
 
4012
procedure TTextScroller.HandleEvent(var Event: TEvent);
 
4013
begin
 
4014
  case Event.What of
 
4015
    evIdle :
 
4016
      Update;
 
4017
  end;
 
4018
  inherited HandleEvent(Event);
 
4019
end;
 
4020
 
 
4021
procedure TTextScroller.Update;
 
4022
begin
 
4023
  if abs(GetDosTicks-LastTT)<Speed then Exit;
 
4024
  Scroll;
 
4025
  LastTT:=GetDosTicks;
 
4026
end;
 
4027
 
 
4028
procedure TTextScroller.Reset;
 
4029
begin
 
4030
  TopLine:=0;
 
4031
  LastTT:=GetDosTicks;
 
4032
  DrawView;
 
4033
end;
 
4034
 
 
4035
procedure TTextScroller.Scroll;
 
4036
begin
 
4037
  Inc(TopLine);
 
4038
  if TopLine>=GetLineCount then
 
4039
    Reset;
 
4040
  DrawView;
 
4041
end;
 
4042
 
 
4043
procedure TTextScroller.Draw;
 
4044
var B: TDrawBuffer;
 
4045
    C: word;
 
4046
    Count,Y: integer;
 
4047
    S: string;
 
4048
begin
 
4049
  C:=GetColor(1);
 
4050
  Count:=GetLineCount;
 
4051
  for Y:=0 to Size.Y-1 do
 
4052
    begin
 
4053
      if Count=0 then S:='' else
 
4054
        S:=GetLine((TopLine+Y) mod Count);
 
4055
      if copy(S,1,1)=^C then
 
4056
        S:=CharStr(' ',Max(0,(Size.X-(length(S)-1)) div 2))+copy(S,2,255);
 
4057
      MoveChar(B,' ',C,Size.X);
 
4058
      MoveStr(B,S,C);
 
4059
      WriteLine(0,Y,Size.X,1,B);
 
4060
    end;
 
4061
end;
 
4062
 
 
4063
destructor TTextScroller.Done;
 
4064
begin
 
4065
  inherited Done;
 
4066
  if Lines<>nil then Dispose(Lines, Done);
 
4067
end;
 
4068
 
 
4069
constructor TFPAboutDialog.Init;
 
4070
var R,R2: TRect;
 
4071
    C: PUnsortedStringCollection;
 
4072
    I: integer;
 
4073
    OSStr: string;
 
4074
procedure AddLine(S: string);
 
4075
begin
 
4076
  C^.Insert(NewStr(S));
 
4077
end;
 
4078
begin
 
4079
  R.Assign(0,0,58,14{$ifdef NODEBUG}-1{$endif});
 
4080
  inherited Init(R, dialog_about);
 
4081
  HelpCtx:=hcAbout;
 
4082
  GetExtent(R); R.Grow(-3,-2);
 
4083
  R2.Copy(R); R2.B.Y:=R2.A.Y+1;
 
4084
  Insert(New(PStaticText, Init(R2, ^C'FreePascal IDE for '+source_info.name)));
 
4085
  R2.Move(0,1);
 
4086
  Insert(New(PStaticText, Init(R2, ^C'Target CPU: '+target_cpu_string)));
 
4087
  R2.Move(0,1);
 
4088
  Insert(New(PStaticText, Init(R2, ^C'Version '+VersionStr+' '+{$i %date%})));
 
4089
  R2.Move(0,1);
 
4090
{$ifdef USE_GRAPH_SWITCH}
 
4091
  Insert(New(PStaticText, Init(R2, ^C'With Graphic Support')));
 
4092
  R2.Move(0,1);
 
4093
{$endif USE_GRAPH_SWITCH}
 
4094
  Insert(New(PStaticText, Init(R2, FormatStrStr2(^C'(%s %s)',label_about_compilerversion,Version_String))));
 
4095
{$ifndef NODEBUG}
 
4096
  if pos('Fake',GDBVersion)=0 then
 
4097
    begin
 
4098
      R2.Move(0,1);
 
4099
      Insert(New(PStaticText, Init(R2, FormatStrStr2(^C'(%s %s)',label_about_debugger,GDBVersion))));
 
4100
      R2.Move(0,1);
 
4101
    end
 
4102
  else
 
4103
{$endif NODEBUG}
 
4104
    R2.Move(0,2);
 
4105
  Insert(New(PStaticText, Init(R2, ^C'Copyright (C) 1998-2005 by')));
 
4106
  R2.Move(0,2);
 
4107
  Insert(New(PStaticText, Init(R2, ^C'B�rczi G�bor')));
 
4108
  R2.Move(0,1);
 
4109
  Insert(New(PStaticText, Init(R2, ^C'Pierre Muller')));
 
4110
  R2.Move(0,1);
 
4111
  Insert(New(PStaticText, Init(R2, ^C'and')));
 
4112
  R2.Move(0,1);
 
4113
  Insert(New(PStaticText, Init(R2, ^C'Peter Vreman')));
 
4114
  New(C, Init(50,10));
 
4115
  for I:=1 to 7 do
 
4116
  AddLine('');
 
4117
  AddLine(^C'< Original concept >');
 
4118
  AddLine(^C'Borland International, Inc.');
 
4119
  AddLine('');
 
4120
  AddLine(^C'< Compiler development >');
 
4121
  AddLine(^C'Carl-Eric Codere');
 
4122
  AddLine(^C'Daniel Mantione');
 
4123
  AddLine(^C'Florian Kl�mpfl');
 
4124
  AddLine(^C'Jonas Maebe');
 
4125
  AddLine(^C'Mich�el Van Canneyt');
 
4126
  AddLine(^C'Peter Vreman');
 
4127
  AddLine(^C'Pierre Muller');
 
4128
  AddLine('');
 
4129
  AddLine(^C'< IDE development >');
 
4130
  AddLine(^C'B�rczi G�bor');
 
4131
  AddLine(^C'Peter Vreman');
 
4132
  AddLine(^C'Pierre Muller');
 
4133
  AddLine('');
 
4134
 
 
4135
  GetExtent(R);
 
4136
  R.Grow(-1,-1); Inc(R.A.Y,3);
 
4137
  New(Scroller, Init(R, 10, C));
 
4138
  Scroller^.Hide;
 
4139
  Insert(Scroller);
 
4140
  R.Move(0,-1); R.B.Y:=R.A.Y+1;
 
4141
  New(TitleST, Init(R, ^C'Team'));
 
4142
  TitleST^.Hide;
 
4143
  Insert(TitleST);
 
4144
 
 
4145
  InsertOK(@Self);
 
4146
end;
 
4147
 
 
4148
procedure TFPAboutDialog.ToggleInfo;
 
4149
begin
 
4150
  if Scroller=nil then Exit;
 
4151
  if Scroller^.GetState(sfVisible) then
 
4152
    begin
 
4153
      Scroller^.Hide;
 
4154
      TitleST^.Hide;
 
4155
    end
 
4156
  else
 
4157
    begin
 
4158
      Scroller^.Reset;
 
4159
      Scroller^.Show;
 
4160
      TitleST^.Show;
 
4161
    end;
 
4162
end;
 
4163
 
 
4164
procedure TFPAboutDialog.HandleEvent(var Event: TEvent);
 
4165
begin
 
4166
  case Event.What of
 
4167
    evKeyDown :
 
4168
      case Event.KeyCode of
 
4169
        kbAltI : { just like in BP }
 
4170
          begin
 
4171
            ToggleInfo;
 
4172
            ClearEvent(Event);
 
4173
          end;
 
4174
      end;
 
4175
  end;
 
4176
  inherited HandleEvent(Event);
 
4177
end;
 
4178
 
 
4179
constructor TFPASCIIChart.Init;
 
4180
begin
 
4181
  inherited Init;
 
4182
  HelpCtx:=hcASCIITableWindow;
 
4183
  Number:=SearchFreeWindowNo;
 
4184
  ASCIIChart:=@Self;
 
4185
end;
 
4186
 
 
4187
procedure TFPASCIIChart.Store(var S: TStream);
 
4188
begin
 
4189
  inherited Store(S);
 
4190
end;
 
4191
 
 
4192
constructor TFPASCIIChart.Load(var S: TStream);
 
4193
begin
 
4194
  inherited Load(S);
 
4195
end;
 
4196
 
 
4197
procedure TFPASCIIChart.HandleEvent(var Event: TEvent);
 
4198
var W: PSourceWindow;
 
4199
begin
 
4200
  case Event.What of
 
4201
    evKeyDown :
 
4202
      case Event.KeyCode of
 
4203
        kbEsc :
 
4204
          begin
 
4205
            Close;
 
4206
            ClearEvent(Event);
 
4207
          end;
 
4208
      end;
 
4209
    evCommand :
 
4210
      case Event.Command of
 
4211
        cmTransfer :
 
4212
          begin
 
4213
            W:=FirstEditorWindow;
 
4214
            if Assigned(W) and Assigned(Report) then
 
4215
              Message(W,evCommand,cmAddChar,pointer(ptrint(ord(Report^.AsciiChar))));
 
4216
            ClearEvent(Event);
 
4217
          end;
 
4218
        cmSearchWindow+1..cmSearchWindow+99 :
 
4219
          if (Event.Command-cmSearchWindow=Number) then
 
4220
              ClearEvent(Event);
 
4221
      end;
 
4222
  end;
 
4223
  inherited HandleEvent(Event);
 
4224
end;
 
4225
 
 
4226
destructor TFPASCIIChart.Done;
 
4227
begin
 
4228
  ASCIIChart:=nil;
 
4229
  inherited Done;
 
4230
end;
 
4231
 
 
4232
function TVideoModeListBox.GetText(Item: pointer; MaxLen: sw_integer): string;
 
4233
var P: PVideoMode;
 
4234
    S: string;
 
4235
begin
 
4236
  P:=Item;
 
4237
  S:=IntToStr(P^.Col)+'x'+IntToStr(P^.Row)+' ';
 
4238
  if P^.Color then
 
4239
    S:=S+'color'
 
4240
  else
 
4241
    S:=S+'mono';
 
4242
  GetText:=copy(S,1,MaxLen);
 
4243
end;
 
4244
 
 
4245
constructor TFPDesktop.Init(var Bounds: TRect);
 
4246
begin
 
4247
  inherited Init(Bounds);
 
4248
end;
 
4249
 
 
4250
procedure TFPDesktop.InitBackground;
 
4251
var AV: PANSIBackground;
 
4252
    FileName: string;
 
4253
    R: TRect;
 
4254
begin
 
4255
  AV:=nil;
 
4256
  FileName:=LocateFile(BackgroundPath);
 
4257
  if FileName<>'' then
 
4258
  begin
 
4259
    GetExtent(R);
 
4260
    New(AV, Init(R));
 
4261
    AV^.GrowMode:=gfGrowHiX+gfGrowHiY;
 
4262
    if AV^.LoadFile(FileName)=false then
 
4263
    begin
 
4264
      Dispose(AV, Done); AV:=nil;
 
4265
    end;
 
4266
    if Assigned(AV) then
 
4267
      Insert(AV);
 
4268
  end;
 
4269
  Background:=AV;
 
4270
  if Assigned(Background)=false then
 
4271
    inherited InitBackground;
 
4272
end;
 
4273
 
 
4274
constructor TFPDesktop.Load(var S: TStream);
 
4275
begin
 
4276
  inherited Load(S);
 
4277
end;
 
4278
 
 
4279
procedure TFPDesktop.Store(var S: TStream);
 
4280
begin
 
4281
  inherited Store(S);
 
4282
end;
 
4283
 
 
4284
constructor TFPToolTip.Init(var Bounds: TRect; const AText: string; AAlign: TAlign);
 
4285
begin
 
4286
  inherited Init(Bounds);
 
4287
  SetAlign(AAlign);
 
4288
  SetText(AText);
 
4289
end;
 
4290
 
 
4291
procedure TFPToolTip.Draw;
 
4292
var C: word;
 
4293
procedure DrawLine(Y: integer; S: string);
 
4294
var B: TDrawBuffer;
 
4295
begin
 
4296
  S:=copy(S,1,Size.X-2);
 
4297
  case Align of
 
4298
    alLeft   : S:=' '+S;
 
4299
    alRight  : S:=LExpand(' '+S,Size.X);
 
4300
    alCenter : S:=Center(S,Size.X);
 
4301
  end;
 
4302
  MoveChar(B,' ',C,Size.X);
 
4303
  MoveStr(B,S,C);
 
4304
  WriteLine(0,Y,Size.X,1,B);
 
4305
end;
 
4306
var S: string;
 
4307
    Y: integer;
 
4308
begin
 
4309
  C:=GetColor(1);
 
4310
  S:=GetText;
 
4311
  for Y:=0 to Size.Y-1 do
 
4312
    DrawLine(Y,S);
 
4313
end;
 
4314
 
 
4315
function TFPToolTip.GetText: string;
 
4316
begin
 
4317
  GetText:=GetStr(Text);
 
4318
end;
 
4319
 
 
4320
procedure TFPToolTip.SetText(const AText: string);
 
4321
begin
 
4322
  if AText<>GetText then
 
4323
  begin
 
4324
    if Assigned(Text) then DisposeStr(Text);
 
4325
    Text:=NewStr(AText);
 
4326
    DrawView;
 
4327
  end;
 
4328
end;
 
4329
 
 
4330
function TFPToolTip.GetAlign: TAlign;
 
4331
begin
 
4332
  GetAlign:=Align;
 
4333
end;
 
4334
 
 
4335
procedure TFPToolTip.SetAlign(AAlign: TAlign);
 
4336
begin
 
4337
  if AAlign<>Align then
 
4338
  begin
 
4339
    Align:=AAlign;
 
4340
    DrawView;
 
4341
  end;
 
4342
end;
 
4343
 
 
4344
destructor TFPToolTip.Done;
 
4345
begin
 
4346
  if Assigned(Text) then DisposeStr(Text); Text:=nil;
 
4347
  inherited Done;
 
4348
end;
 
4349
 
 
4350
function TFPToolTip.GetPalette: PPalette;
 
4351
const S: string[length(CFPToolTip)] = CFPToolTip;
 
4352
begin
 
4353
  GetPalette:=@S;
 
4354
end;
 
4355
 
 
4356
constructor TFPMemo.Init(var Bounds: TRect; AHScrollBar, AVScrollBar:
 
4357
          PScrollBar; AIndicator: PIndicator);
 
4358
begin
 
4359
  inherited Init(Bounds,AHScrollBar,AVScrollBar,AIndicator,nil);
 
4360
  SetFlags(Flags and not (efPersistentBlocks) or efSyntaxHighlight);
 
4361
end;
 
4362
 
 
4363
function TFPMemo.GetPalette: PPalette;
 
4364
const P: string[length(CFPMemo)] = CFPMemo;
 
4365
begin
 
4366
  GetPalette:=@P;
 
4367
end;
 
4368
 
 
4369
function TFPMemo.GetSpecSymbolCount(SpecClass: TSpecSymbolClass): integer;
 
4370
begin
 
4371
  GetSpecSymbolCount:=0;
 
4372
end;
 
4373
 
 
4374
function TFPMemo.GetSpecSymbol(SpecClass: TSpecSymbolClass; Index: integer): pstring;
 
4375
begin
 
4376
  Abstract;
 
4377
  GetSpecSymbol:=nil;
 
4378
end;
 
4379
 
 
4380
function TFPMemo.IsReservedWord(const S: string): boolean;
 
4381
begin
 
4382
  IsReservedWord:=false;
 
4383
end;
 
4384
 
 
4385
constructor TFPCodeMemo.Init(var Bounds: TRect; AHScrollBar, AVScrollBar:
 
4386
          PScrollBar; AIndicator: PIndicator);
 
4387
begin
 
4388
  inherited Init(Bounds,AHScrollBar,AVScrollBar,AIndicator);
 
4389
end;
 
4390
 
 
4391
function TFPCodeMemo.GetSpecSymbolCount(SpecClass: TSpecSymbolClass): integer;
 
4392
begin
 
4393
  GetSpecSymbolCount:=FreePascalSpecSymbolCount[SpecClass];
 
4394
end;
 
4395
 
 
4396
function TFPCodeMemo.GetSpecSymbol(SpecClass: TSpecSymbolClass; Index: integer): pstring;
 
4397
begin
 
4398
  GetSpecSymbol:=@FreePascalEmptyString;
 
4399
  case SpecClass of
 
4400
    ssCommentPrefix :
 
4401
      case Index of
 
4402
        0 : GetSpecSymbol:=@FreePascalCommentPrefix1;
 
4403
        1 : GetSpecSymbol:=@FreePascalCommentPrefix2;
 
4404
        2 : GetSpecSymbol:=@FreePascalCommentPrefix3;
 
4405
      end;
 
4406
    ssCommentSingleLinePrefix :
 
4407
      case Index of
 
4408
        0 : GetSpecSymbol:=@FreePascalCommentSingleLinePrefix;
 
4409
      end;
 
4410
    ssCommentSuffix :
 
4411
      case Index of
 
4412
        0 : GetSpecSymbol:=@FreePascalCommentSuffix1;
 
4413
        1 : GetSpecSymbol:=@FreePascalCommentSuffix2;
 
4414
      end;
 
4415
    ssStringPrefix :
 
4416
      GetSpecSymbol:=@FreePascalStringPrefix;
 
4417
    ssStringSuffix :
 
4418
      GetSpecSymbol:=@FreePascalStringSuffix;
 
4419
    { must be uppercased to avoid calling UpCaseStr in MatchesAnyAsmSymbol PM }
 
4420
    ssAsmPrefix :
 
4421
      GetSpecSymbol:=@FreePascalAsmPrefix;
 
4422
    ssAsmSuffix :
 
4423
      GetSpecSymbol:=@FreePascalAsmSuffix;
 
4424
    ssDirectivePrefix :
 
4425
      GetSpecSymbol:=@FreePascalDirectivePrefix;
 
4426
    ssDirectiveSuffix :
 
4427
      GetSpecSymbol:=@FreePascalDirectiveSuffix;
 
4428
  end;
 
4429
end;
 
4430
 
 
4431
function TFPCodeMemo.IsReservedWord(const S: string): boolean;
 
4432
begin
 
4433
  IsReservedWord:=IsFPReservedWord(S);
 
4434
end;
 
4435
 
 
4436
 
 
4437
{$ifdef VESA}
 
4438
function VESASetVideoModeProc(const VideoMode: TVideoMode; Params: Longint): Boolean; {$ifndef FPC}far;{$endif}
 
4439
begin
 
4440
  VESASetVideoModeProc:=VESASetMode(Params);
 
4441
end;
 
4442
 
 
4443
procedure InitVESAScreenModes;
 
4444
var ML: TVESAModeList;
 
4445
    MI: TVESAModeInfoBlock;
 
4446
    I: integer;
 
4447
begin
 
4448
  if VESAInit=false then Exit;
 
4449
  if VESAGetModeList(ML)=false then Exit;
 
4450
  for I:=1 to ML.Count do
 
4451
    begin
 
4452
      if VESAGetModeInfo(ML.Modes[I],MI) then
 
4453
      with MI do
 
4454
{$ifndef DEBUG}
 
4455
        if (Attributes and vesa_vma_GraphicsMode)=0 then
 
4456
{$else DEBUG}
 
4457
        if ((Attributes and vesa_vma_GraphicsMode)=0) or
 
4458
        { only allow 4 bit i.e. 16 color modes }
 
4459
          (((Attributes and vesa_vma_CanBeSetInCurrentConfig)<>0) and
 
4460
           (BitsPerPixel=8)) then
 
4461
{$endif DEBUG}
 
4462
          RegisterVesaVideoMode(ML.Modes[I]);
 
4463
    end;
 
4464
end;
 
4465
 
 
4466
procedure DoneVESAScreenModes;
 
4467
begin
 
4468
  FreeVesaModes;
 
4469
end;
 
4470
{$endif}
 
4471
 
 
4472
procedure NoDebugger;
 
4473
begin
 
4474
  InformationBox(msg_nodebuggersupportavailable,nil);
 
4475
end;
 
4476
 
 
4477
procedure RegisterFPViews;
 
4478
begin
 
4479
  RegisterType(RSourceEditor);
 
4480
  RegisterType(RSourceWindow);
 
4481
  RegisterType(RFPHelpViewer);
 
4482
  RegisterType(RFPHelpWindow);
 
4483
  RegisterType(RClipboardWindow);
 
4484
  RegisterType(RMessageListBox);
 
4485
  RegisterType(RFPDesktop);
 
4486
  RegisterType(RFPASCIIChart);
 
4487
  RegisterType(RFPDlgWindow);
 
4488
{$ifndef NODEBUG}
 
4489
  RegisterType(RGDBWindow);
 
4490
  RegisterType(RGDBSourceEditor);
 
4491
{$endif NODEBUG}
 
4492
end;
 
4493
 
 
4494
 
 
4495
END.
 
4496
{
 
4497
  $Log: fpviews.pas,v $
 
4498
  Revision 1.59  2005/03/07 17:16:56  peter
 
4499
    * ignore reserved tokens of length 1
 
4500
 
 
4501
  Revision 1.58  2005/02/14 17:13:18  peter
 
4502
    * truncate log
 
4503
 
 
4504
  Revision 1.57  2005/01/16 00:43:03  florian
 
4505
    * fixed disassembly window on sparc
 
4506
 
 
4507
  Revision 1.56  2005/01/08 13:43:44  florian
 
4508
    * updated version and copyright
 
4509
 
 
4510
  Revision 1.55  2005/01/08 11:43:18  florian
 
4511
    + vector unit window
 
4512
 
 
4513
  Revision 1.54  2005/01/07 19:09:28  florian
 
4514
    * highlight keywords of all language modes
 
4515
 
 
4516
}