Browse Source

Changes from Gabor

michael 25 years ago
parent
commit
550220b663

+ 9 - 2
ide/text/fp.pas

@@ -33,7 +33,7 @@ uses
   FPIDE,FPCalc,FPCompile,
   FPIni,FPViews,FPConst,FPVars,FPUtils,FPHelp,FPSwitch,FPUsrScr,
   FPTools,{$ifndef NODEBUG}FPDebug,{$endif}FPTemplt,FPCatch,FPRedir,FPDesk,
-  FPSymbol;
+  FPSymbol,FPCodTmp,FPCodCmp;
 
 
 procedure ProcessParams(BeforeINI: boolean);
@@ -155,6 +155,8 @@ BEGIN
   InitUserScreen;
   InitTools;
   InitTemplates;
+  InitCodeTemplates;
+  InitCodeComplete;
 
   ReadSwitches(SwitchesPath);
   IDEApp.Init;
@@ -184,6 +186,8 @@ BEGIN
   IDEApp.Done;
   WriteSwitches(SwitchesPath);
 
+  DoneCodeComplete;
+  DoneCodeTemplates;
   DoneTemplates;
   DoneTools;
   DoneUserScreen;
@@ -202,7 +206,10 @@ BEGIN
 END.
 {
   $Log$
-  Revision 1.34  1999-12-20 14:23:16  pierre
+  Revision 1.35  2000-01-03 11:38:33  michael
+  Changes from Gabor
+
+  Revision 1.34  1999/12/20 14:23:16  pierre
     * MyApp renamed IDEApp
     * TDebugController.ResetDebuggerRows added to
       get resetting of debugger rows

+ 6 - 1
ide/text/fpcompil.pas

@@ -455,7 +455,9 @@ begin
      if assigned(CompilerStatusDialog) then
       CompilerStatusDialog^.Update;
 {$ifdef DEBUG}
+ {$ifndef NODEBUG}
      def_gdb_stop(level);
+ {$endif}
 {$endif DEBUG}
 {$ifdef redircompiler}
       RedirEnableAll;
@@ -724,7 +726,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.46  1999-12-01 17:08:19  pierre
+  Revision 1.47  2000-01-03 11:38:33  michael
+  Changes from Gabor
+
+  Revision 1.46  1999/12/01 17:08:19  pierre
    * GetFileTime moved to wutils unit
 
   Revision 1.45  1999/11/22 15:58:40  pierre

+ 12 - 2
ide/text/fpconst.pas

@@ -40,6 +40,7 @@ const
      FPErrFileName        = 'fp___.err';
      GDBOutFileName       = 'gdb___.out';
      GDBOutPutFileName    = 'gdb___.txt';
+     DesktopTempName      = 'fp___.dsk';
 
      HelpFileExts         = '*.tph;*.htm*';
 
@@ -127,6 +128,7 @@ const
      cmWatches           = 238;
      cmUntilReturn       = 239;
      { WARNING these two are also defined in weditor.pas PM }
+     { and why aren't these defines then removed? Gabor }
      cmCopyWin           = 240;
      cmPasteWin          = 241;
 
@@ -206,6 +208,7 @@ const
      hcMessagesWindow    = 8006;
      hcGDBWindow         = 8007;
      hcBreakpointListWindow = 8008;
+     hcASCIITableWindow  = 8009;
 
      hcShift             = 10000;
 
@@ -345,6 +348,8 @@ const
 
      CFPClockView = #0#227;
 
+     CFPToolTip     = #228;
+
      CIDEAppColor = CAppColor +
          { CIDEHelpDialog }
 {128-143}#$70#$7F#$7A#$13#$13#$70#$70#$7F#$7E#$20#$2B#$2F#$78#$2E#$70#$30 + { 1-16}
@@ -358,14 +363,19 @@ const
          { CBrowserWindow }
 {215-226}#$31#$3F#$3A#$31#$31#$31#$71#$1F#$31#$2F#$3E#$3F +
          { CFPClockView }
-{227-   }#$70;
+{227-227}#$70 +
+         { CToolTip }
+{228-228}#$20;
 
 implementation
 
 END.
 {
   $Log$
-  Revision 1.30  1999-11-03 09:39:23  peter
+  Revision 1.31  2000-01-03 11:38:33  michael
+  Changes from Gabor
+
+  Revision 1.30  1999/11/03 09:39:23  peter
     * fixed uppercase filenames
     * savetostream did twice a -1 on the linecount, so the lastline of a
       file wasn't saved correctly

+ 51 - 23
ide/text/fpdesk.pas

@@ -18,7 +18,8 @@ unit FPDesk;
 interface
 
 const
-     DesktopVersion     = $0004; { <- if you change any Load&Store methods,
+     DesktopVersion     = $0005; { <- if you change any Load&Store methods,
+                                      default object properties (Options,State)
                                       then you should also change this }
 
      ResDesktopFlags    = 'FLAGS';
@@ -112,9 +113,11 @@ begin
 end;*)
 
 function ReadWatches(F: PResourceFile): boolean;
+{$ifndef NODEBUG}
 var S: PMemoryStream;
     OK: boolean;
     OWC : PWatchesCollection;
+{$endif}
 begin
 {$ifndef NODEBUG}
   PushStatus('Reading watches...');
@@ -163,9 +166,11 @@ begin
 end;
 
 function ReadBreakpoints(F: PResourceFile): boolean;
+{$ifndef NODEBUG}
 var S: PMemoryStream;
     OK: boolean;
     OBC : PBreakpointCollection;
+{$endif}
 begin
 {$ifndef NODEBUG}
   PushStatus('Reading breakpoints...');
@@ -274,33 +279,42 @@ end;
 function WriteOpenWindows(F: PResourceFile): boolean;
 var S: PMemoryStream;
     W: word;
+    OK: boolean;
 begin
   PushStatus('Storing desktop contents...');
 
   New(S, Init(30*1024,4096));
-  W:=DesktopVersion;
-  S^.Write(W,SizeOf(W));
-  S^.Put(Desktop);
-  with Desktop^ do
+  OK:=Assigned(S);
+  if OK then
   begin
-    PutSubViewPtr(S^,CompilerMessageWindow);
-    PutSubViewPtr(S^,CompilerStatusDialog);
-    PutSubViewPtr(S^,ClipboardWindow);
-    PutSubViewPtr(S^,CalcWindow);
-    PutSubViewPtr(S^,ProgramInfoWindow);
-    PutSubViewPtr(S^,GDBWindow);
-    PutSubViewPtr(S^,BreakpointsWindow);
-    PutSubViewPtr(S^,WatchesWindow);
-    PutSubViewPtr(S^,UserScreenWindow);
-    PutSubViewPtr(S^,ASCIIChart);
-    PutSubViewPtr(S^,MessagesWindow);
+    W:=DesktopVersion;
+    S^.Write(W,SizeOf(W));
+    S^.Put(Desktop);
+    with Desktop^ do
+    begin
+      PutSubViewPtr(S^,CompilerMessageWindow);
+      PutSubViewPtr(S^,CompilerStatusDialog);
+      PutSubViewPtr(S^,ClipboardWindow);
+      PutSubViewPtr(S^,CalcWindow);
+      PutSubViewPtr(S^,ProgramInfoWindow);
+      PutSubViewPtr(S^,GDBWindow);
+      PutSubViewPtr(S^,BreakpointsWindow);
+      PutSubViewPtr(S^,WatchesWindow);
+      PutSubViewPtr(S^,UserScreenWindow);
+      PutSubViewPtr(S^,ASCIIChart);
+      PutSubViewPtr(S^,MessagesWindow);
+    end;
+    OK:=(S^.Status=stOK);
+    if OK then
+    begin
+      S^.Seek(0);
+      OK:=F^.CreateResource(resDesktop,rcBinary,0);
+      OK:=OK and F^.AddResourceEntryFromStream(resDesktop,langDefault,0,S^,S^.GetSize);
+    end;
+    Dispose(S, Done);
   end;
-  S^.Seek(0);
-  F^.CreateResource(resDesktop,rcBinary,0);
-  F^.AddResourceEntryFromStream(resDesktop,langDefault,0,S^,S^.GetSize);
-  Dispose(S, Done);
   PopStatus;
-  WriteOpenWindows:=true;
+  WriteOpenWindows:=OK;
 end;
 
 function WriteFlags(F: PResourceFile): boolean;
@@ -415,9 +429,12 @@ end;
 function SaveDesktop: boolean;
 var OK: boolean;
     F: PResourceFile;
+    TempPath: string;
+    ff: file;
 begin
+  TempPath:=DirOf(DesktopPath)+DesktopTempName;
   PushStatus('Writing desktop file...');
-  New(F, CreateFile(DesktopPath));
+  New(F, CreateFile(TempPath));
 
   if Assigned(Clipboard) then
     if (DesktopFileFlags and dfClipboardContent)<>0 then
@@ -442,6 +459,14 @@ begin
   if {OK and} ((DesktopFileFlags and dfSymbolInformation)<>0) then
     OK:=OK and (WriteSymbols(F) or not Assigned(Modules));
   Dispose(F, Done);
+  if OK then
+  begin
+    if ExistsFile(DesktopPath) then
+      OK:=EraseFile(DesktopPath);
+    OK:=OK and RenameFile(TempPath,DesktopPath);
+    if OK=false then
+      ErrorBox('Failed to replace desktop file.',nil);
+  end;
   PopStatus;
   SaveDesktop:=OK;
 end;
@@ -449,7 +474,10 @@ end;
 END.
 {
   $Log$
-  Revision 1.17  1999-12-20 00:30:56  pierre
+  Revision 1.18  2000-01-03 11:38:33  michael
+  Changes from Gabor
+
+  Revision 1.17  1999/12/20 00:30:56  pierre
    * problem with VideoMode storing solved
 
   Revision 1.16  1999/12/10 13:02:05  pierre

+ 5 - 1
ide/text/fphelp.pas

@@ -93,6 +93,7 @@ begin
     hcClipboardWindow:S:='';
     hcBrowserWindow : S:='';
     hcMessagesWindow: S:='';
+    hcASCIITableWindow: S:='';
     hcGDBWindow     : S:='Raw GDB communication window';
     hcBreakpointListWindow : S:='All current breakpoints';
 
@@ -409,7 +410,10 @@ end;
 END.
 {
   $Log$
-  Revision 1.23  1999-09-09 16:31:45  pierre
+  Revision 1.24  2000-01-03 11:38:33  michael
+  Changes from Gabor
+
+  Revision 1.23  1999/09/09 16:31:45  pierre
    * some breakpoint related fixes and Help contexts
 
   Revision 1.22  1999/09/09 14:15:27  pierre

+ 12 - 3
ide/text/fpide.pas

@@ -387,6 +387,11 @@ begin
       NewStatusKey('~Alt+F10~ Local menu', kbAltF10, cmLocalMenu,
       StdStatusKeys(
       nil))))))),
+    NewStatusDef(hcASCIITableWindow, hcASCIITableWindow,
+      NewStatusKey('~F1~ Help', kbF1, cmHelp,
+      NewStatusKey('~Ctrl+Enter~ Transfer char', kbCtrlEnter, cmTransfer,
+      StdStatusKeys(
+      nil))),
     NewStatusDef(hcMessagesWindow, hcMessagesWindow,
       NewStatusKey('~F1~ Help', kbF1, cmHelp,
       NewStatusKey('~'+EnterSign+'~ Goto source', kbEnter, cmMsgGotoSource,
@@ -409,7 +414,7 @@ begin
       NewStatusKey('~Alt+F10~ Local menu', kbAltF10, cmLocalMenu,
       StdStatusKeys(
       nil)))))),
-    nil))))))));
+    nil)))))))));
 end;
 
 procedure TIDEApp.Idle;
@@ -623,7 +628,8 @@ begin
       CloseAllBrowsers;
       DOK:=SaveDesktop;
       if DOK=false then
-        ErrorBox('Error saving desktop file.',nil);
+        ErrorBox('Error saving desktop file.'#13+
+                 'Desktop layout could not be stored.',nil);
     end;
   AutoSave:=IOK and SOK and DOK;
 end;
@@ -861,7 +867,10 @@ end;
 END.
 {
   $Log$
-  Revision 1.47  1999-12-20 14:23:17  pierre
+  Revision 1.48  2000-01-03 11:38:33  michael
+  Changes from Gabor
+
+  Revision 1.47  1999/12/20 14:23:17  pierre
     * MyApp renamed IDEApp
     * TDebugController.ResetDebuggerRows added to
       get resetting of debugger rows

+ 6 - 1
ide/text/fpintf.pas

@@ -49,8 +49,10 @@ end;
 procedure SetRunParameters(const Params: string);
 begin
   RunParameters:=Params;
+{$ifndef NODEBUG}
   If assigned(Debugger) then
     Debugger^.SetArgs(RunParameters);
+{$endif}
 end;
 
 
@@ -111,7 +113,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.7  1999-09-16 14:34:59  pierre
+  Revision 1.8  2000-01-03 11:38:34  michael
+  Changes from Gabor
+
+  Revision 1.7  1999/09/16 14:34:59  pierre
     + TBreakpoint and TWatch registering
     + WatchesCollection and BreakpointsCollection stored in desk file
     * Syntax highlighting was broken

+ 19 - 1
ide/text/fputils.pas

@@ -47,6 +47,7 @@ function FixFileName(const s:string):string;
 function MakeExeName(const fn:string):string;
 function LExpand(const S: string; MinLen: byte): string;
 function RExpand(const S: string; MinLen: byte): string;
+function Center(const S: string; Len: byte): string;
 function FitStr(const S: string; Len: byte): string;
 function LTrim(const S: string): string;
 function RTrim(const S: string): string;
@@ -67,6 +68,7 @@ function MatchesMask(What, Mask: string): boolean;
 function MatchesMaskList(What, MaskList: string): boolean;
 function MatchesFileList(What, FileList: string): boolean;
 function EatIO: integer;
+function RenameFile(const OldFileName,NewFileName: string): boolean;
 function ExistsFile(const FileName: string): boolean;
 function CompleteDir(const Path: string): string;
 function LocateFile(FileList: string): string;
@@ -205,6 +207,11 @@ begin
 end;
 
 
+function Center(const S: string; Len: byte): string;
+begin
+  Center:=LExpand(S+CharStr(' ',Max(0,(Len-length(S)) div 2)),Len);
+end;
+
 function FitStr(const S: string; Len: byte): string;
 begin
   FitStr:=RExpand(copy(S,1,Len),Len);
@@ -494,6 +501,14 @@ begin
   EatIO:=IOResult;
 end;
 
+function RenameFile(const OldFileName,NewFileName: string): boolean;
+var f: file;
+begin
+  Assign(f,OldFileName);
+  Rename(f,NewFileName);
+  RenameFile:=(EatIO=0);
+end;
+
 function ExistsFile(const FileName: string): boolean;
 var
   Dir : SearchRec;
@@ -647,7 +662,10 @@ end;
 END.
 {
   $Log$
-  Revision 1.13  1999-04-15 08:58:07  peter
+  Revision 1.14  2000-01-03 11:38:34  michael
+  Changes from Gabor
+
+  Revision 1.13  1999/04/15 08:58:07  peter
     * syntax highlight fixes
     * browser updates
 

+ 193 - 4
ide/text/fpviews.pas

@@ -106,14 +106,40 @@ type
       LastTT: longint;
     end;
 
+    TAlign = (alLeft,alCenter,alRight);
+
+    PFPToolTip = ^TFPToolTip;
+    TFPToolTip = object(TView)
+      constructor Init(var Bounds: TRect; const AText: string; AAlign: TAlign);
+      procedure   Draw; virtual;
+      function    GetText: string;
+      procedure   SetText(const AText: string);
+      function    GetAlign: TAlign;
+      procedure   SetAlign(AAlign: TAlign);
+      function    GetPalette: PPalette; virtual;
+      destructor  Done; virtual;
+    private
+      Text: PString;
+      Align: TAlign;
+    end;
+
     PSourceEditor = ^TSourceEditor;
     TSourceEditor = object(TFileEditor)
       constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar:
           PScrollBar; AIndicator: PIndicator;const AFileName: string);
 {$ifndef EDITORS}
+    public
+      CodeCompleteTip: PFPToolTip;
+      { Syntax highlight }
       function  IsReservedWord(const S: string): boolean; virtual;
       function  GetSpecSymbolCount(SpecClass: TSpecSymbolClass): integer; virtual;
       function  GetSpecSymbol(SpecClass: TSpecSymbolClass; Index: integer): string; virtual;
+      { CodeTemplates }
+      function    TranslateCodeTemplate(const Shortcut: string; ALines: PUnsortedStringCollection): boolean; virtual;
+      { CodeComplete }
+      function    CompleteCodeWord(const WordS: string; var Text: string): boolean; virtual;
+      procedure   SetCodeCompleteWord(const S: string); virtual;
+      procedure   AlignCodeCompleteTip;
 {$endif}
       procedure   HandleEvent(var Event: TEvent); virtual;
 {$ifdef DebugUndo}
@@ -308,6 +334,8 @@ type
     PFPASCIIChart = ^TFPASCIIChart;
     TFPASCIIChart = object(TASCIIChart)
       constructor Init;
+      constructor Load(var S: TStream);
+      procedure   Store(var S: TStream);
       procedure   HandleEvent(var Event: TEvent); virtual;
       destructor  Done; virtual;
     end;
@@ -338,6 +366,8 @@ procedure DisposeTabDef(P: PTabDef);
 function  GetEditorCurWord(Editor: PEditor): string;
 procedure InitReservedWords;
 procedure DoneReservedWords;
+function GetReservedWordCount: integer;
+function GetReservedWord(Index: integer): string;
 
 procedure TranslateMouseClick(View: PView; var Event: TEvent);
 
@@ -380,6 +410,7 @@ procedure RegisterFPViews;
 implementation
 
 uses
+  {$ifdef GABOR}crt,{$endif}
   Video,Strings,Keyboard,Memory,MsgBox,Validate,
   Tokens,Version,
 {$ifndef NODEBUG}
@@ -387,7 +418,7 @@ uses
 {$endif NODEBUG}
   {$ifdef VESA}Vesa,{$endif}
   FPSwitch,FPSymbol,FPDebug,FPVars,FPUtils,FPCompile,FPHelp,
-  FPTools,FPIde;
+  FPTools,FPIDE,FPCodTmp,FPCodCmp;
 
 const
   RSourceEditor: TStreamRec = (
@@ -445,6 +476,12 @@ const
      Load:    @TGDBWindow.Load;
      Store:   @TGDBWindow.Store
   );
+  RFPASCIIChart: TStreamRec = (
+     ObjType: 1509;
+     VmtLink: Ofs(TypeOf(TFPASCIIChart)^);
+     Load:    @TFPASCIIChart.Load;
+     Store:   @TFPASCIIChart.Store
+  );
 const
   NoNameCount    : integer = 0;
 var
@@ -775,6 +812,61 @@ function TSourceEditor.IsReservedWord(const S: string): boolean;
 begin
   IsReservedWord:=IsFPReservedWord(S);
 end;
+
+function TSourceEditor.TranslateCodeTemplate(const Shortcut: string; ALines: PUnsortedStringCollection): boolean;
+begin
+  TranslateCodeTemplate:=FPTranslateCodeTemplate(ShortCut,ALines);
+end;
+
+function TSourceEditor.CompleteCodeWord(const WordS: string; var Text: string): boolean;
+begin
+  CompleteCodeWord:=FPCompleteCodeWord(WordS,Text);
+end;
+
+procedure TSourceEditor.SetCodeCompleteWord(const S: string);
+var R: TRect;
+begin
+  inherited SetCodeCompleteWord(S);
+  if S='' then
+    begin
+      if Assigned(CodeCompleteTip) then Dispose(CodeCompleteTip, Done);
+      CodeCompleteTip:=nil;
+    end
+  else
+    begin
+      R.Assign(0,0,20,1);
+      if Assigned(CodeCompleteTip)=false then
+        begin
+          New(CodeCompleteTip, Init(R, S, alCenter));
+          Application^.Insert(CodeCompleteTip);
+        end
+      else
+        CodeCompleteTip^.SetText(S);
+      AlignCodeCompleteTip;
+    end;
+end;
+
+procedure TSourceEditor.AlignCodeCompleteTip;
+var X,Y: integer;
+    S: string;
+    R: TRect;
+begin
+  if Assigned(CodeCompleteTip)=false then Exit;
+  S:=CodeCompleteTip^.GetText;
+  { determine the center of current word fragment }
+  X:=CurPos.X-(length(GetCodeCompleteFrag) div 2);
+  { calculate position for centering the complete word over/below the current }
+  X:=X-(length(S) div 2);
+  { ensure that the tooltip stays in screen }
+  X:=Min(Max(0,X),ScreenWidth-length(S)-2-1);
+  if CurPos.Y>round(ScreenHeight*3/4) then
+    Y:=CurPos.Y-1
+  else
+    Y:=CurPos.Y+1;
+  R.Assign(X,Y,X+1+length(S)+1,Y+1);
+  CodeCompleteTip^.Locate(R);
+end;
+
 {$endif EDITORS}
 
 procedure TSourceEditor.ModifiedChanged;
@@ -2697,7 +2789,7 @@ begin
 {$else NODEBUG}
   R2.Move(0,2);
 {$endif NODEBUG}
-  Insert(New(PStaticText, Init(R2, ^C'Copyright (C) 1998-99 by')));
+  Insert(New(PStaticText, Init(R2, ^C'Copyright (C) 1998-2000 by')));
   R2.Move(0,2);
   Insert(New(PStaticText, Init(R2, ^C'B‚rczi G bor')));
   R2.Move(0,1);
@@ -2774,12 +2866,23 @@ end;
 constructor TFPASCIIChart.Init;
 begin
   inherited Init;
-  HelpCtx:=hcASCIITable;
+  HelpCtx:=hcASCIITableWindow;
   Number:=SearchFreeWindowNo;
   ASCIIChart:=@Self;
 end;
 
+procedure TFPASCIIChart.Store(var S: TStream);
+begin
+  inherited Store(S);
+end;
+
+constructor TFPASCIIChart.Load(var S: TStream);
+begin
+  inherited Load(S);
+end;
+
 procedure TFPASCIIChart.HandleEvent(var Event: TEvent);
+var W: PSourceWindow;
 begin
   case Event.What of
     evKeyDown :
@@ -2790,6 +2893,16 @@ begin
             ClearEvent(Event);
           end;
       end;
+    evCommand :
+      case Event.Command of
+        cmTransfer :
+          begin
+            W:=FirstEditorWindow;
+            if Assigned(W) and Assigned(Report) then
+              Message(W,evCommand,cmAddChar,pointer(ord(Report^.AsciiChar)));
+            ClearEvent(Event);
+          end;
+      end;
   end;
   inherited HandleEvent(Event);
 end;
@@ -2823,6 +2936,78 @@ begin
   inherited Store(S);
 end;
 
+constructor TFPToolTip.Init(var Bounds: TRect; const AText: string; AAlign: TAlign);
+begin
+  inherited Init(Bounds);
+  SetAlign(AAlign);
+  SetText(AText);
+end;
+
+procedure TFPToolTip.Draw;
+var C: word;
+procedure DrawLine(Y: integer; S: string);
+var B: TDrawBuffer;
+begin
+  S:=copy(S,1,Size.X-2);
+  case Align of
+    alLeft   : S:=' '+S;
+    alRight  : S:=LExpand(' '+S,Size.X);
+    alCenter : S:=Center(S,Size.X);
+  end;
+  MoveChar(B,' ',C,Size.X);
+  MoveStr(B,S,C);
+  WriteLine(0,Y,Size.X,1,B);
+end;
+var S: string;
+    Y: integer;
+begin
+  C:=GetColor(1);
+  S:=GetText;
+  for Y:=0 to Size.Y-1 do
+    DrawLine(Y,S);
+end;
+
+function TFPToolTip.GetText: string;
+begin
+  GetText:=GetStr(Text);
+end;
+
+procedure TFPToolTip.SetText(const AText: string);
+begin
+  if AText<>GetText then
+  begin
+    if Assigned(Text) then DisposeStr(Text);
+    Text:=NewStr(AText);
+    DrawView;
+  end;
+end;
+
+function TFPToolTip.GetAlign: TAlign;
+begin
+  GetAlign:=Align;
+end;
+
+procedure TFPToolTip.SetAlign(AAlign: TAlign);
+begin
+  if AAlign<>Align then
+  begin
+    Align:=AAlign;
+    DrawView;
+  end;
+end;
+
+destructor TFPToolTip.Done;
+begin
+  if Assigned(Text) then DisposeStr(Text); Text:=nil;
+  inherited Done;
+end;
+
+function TFPToolTip.GetPalette: PPalette;
+const S: string[length(CFPToolTip)] = CFPToolTip;
+begin
+  GetPalette:=@S;
+end;
+
 {$ifdef VESA}
 function VESASetVideoModeProc(const VideoMode: TVideoMode; Params: Longint): Boolean; {$ifndef FPC}far;{$endif}
 begin
@@ -2863,13 +3048,17 @@ begin
   RegisterType(RFPDesktop);
   RegisterType(RGDBSourceEditor);
   RegisterType(RGDBWindow);
+  RegisterType(RFPASCIIChart);
 end;
 
 
 END.
 {
   $Log$
-  Revision 1.51  1999-12-20 14:23:17  pierre
+  Revision 1.52  2000-01-03 11:38:34  michael
+  Changes from Gabor
+
+  Revision 1.51  1999/12/20 14:23:17  pierre
     * MyApp renamed IDEApp
     * TDebugController.ResetDebuggerRows added to
       get resetting of debugger rows

+ 4 - 0
ide/text/globdir.inc

@@ -66,10 +66,14 @@
 {$ifdef GABOR}
   {.$define NOOBJREG}
   {$define NODEBUG}
+  {$define DEBUG}
 {$endif}
 
 { include Undo/Redo code from Visa Harvey }
 { let everybody try it out  PM }
+{ undo should be a bit improved - it does work only with "normal" keystorkes.
+  neither the block, nor any shortcut operations (like Ctrl-T - delete word)
+  do work... Gabor }
 {$define Undo}
 {$ifdef DEBUG}
   {$define DebugUndo}

+ 3 - 13
ide/text/vesa.pas

@@ -26,7 +26,7 @@ uses
   {$endif}
   {$ifdef FPC}
     {$ifdef GO32V2}
-    Go32,Video,
+    Go32,
     {$endif}
   {$endif}
   Objects,Strings,WUtils;
@@ -431,20 +431,10 @@ end;
 function VESASetMode(Mode: word): boolean;
 var r: registers;
     OK: boolean;
-{$ifdef FPC}
-    B: TVESAModeInfoBlock;
-{$endif FPC}
 begin
   r.ah:=$4f; r.al:=$02; r.bx:=Mode;
   dos.intr($10,r);
   OK:=(r.ax=$004f);
-{$ifdef FPC}
-  VESAGetModeInfo(Mode,B);
-  { cheat to get a correct mouse }
-  { mem[$40:$84]:=B.XResolution-1;
-    memw[$40:$4a]:=B.YResolution;}
-  { memw[$40:$4c]:=ScreenHeight*((ScreenWidth shl 1)-1); }
-{$endif FPC}
   VESASetMode:=OK;
 end;
 
@@ -492,8 +482,8 @@ BEGIN
 END.
 {
   $Log$
-  Revision 1.5  1999-12-23 23:33:43  pierre
-   * use FPC syntax for procvar args
+  Revision 1.6  2000-01-03 11:38:35  michael
+  Changes from Gabor
 
   Revision 1.4  1999/04/07 21:55:58  peter
     + object support for browser

+ 301 - 37
ide/text/weditor.pas

@@ -19,12 +19,13 @@ unit WEditor;
 interface
 
 uses
-  Dos,Objects,Drivers,Views,Menus,Commands;
+  Dos,Objects,Drivers,Views,Menus,Commands,
+  WUtils;
 
 
 { try to only do syntax on part of file until current position
   does not work correctly yet PM }
-{ $define TEST_PARTIAL_SYNTAX}
+{.$define TEST_PARTIAL_SYNTAX}
 
 const
       cmFileNameChanged      = 51234;
@@ -42,11 +43,15 @@ const
       cmReadBlock            = 51246;
       cmPrintBlock           = 51247;
       cmResetDebuggerRow     = 51248;
+      cmAddChar              = 51249;
+      cmExpandCodeTemplate   = 51250;
 
       EditorTextBufSize = {$ifdef FPC}32768{$else} 4096{$endif};
       MaxLineLength     = {$ifdef FPC}  255{$else}  255{$endif};
       MaxLineCount      = {$ifdef FPC}16380{$else}16380{$endif};
 
+      CodeCompleteMinLen = 4; { minimum length of text to try to complete }
+
       efBackupFiles         = $00000001;
       efInsertMode          = $00000002;
       efAutoIndent          = $00000004;
@@ -61,6 +66,7 @@ const
       efAutoBrackets        = $00000800;
       efExpandAllTabs       = $00001000;
       efKeepTrailingSpaces  = $00002000;
+      efCodeComplete        = $00004000;
       efStoreContent        = $80000000;
 
       attrAsm       = 1;
@@ -193,6 +199,15 @@ type
       Text      : PString;
       ActionCount : longint;
       Action    : byte;
+      TimeStamp : longint; { this is needed to keep track of line number &
+                             position changes (for ex. for symbol browser)
+                             the line&pos references (eg. symbol info) should
+                             also contain such a timestamp. this will enable
+                             to determine which changes have been made since
+                             storage of the information and thus calculate
+                             the (probably) changed line & position information,
+                             so, we can still jump to the right position in the
+                             editor even when it is heavily modified - Gabor }
       constructor init(act:byte; StartP,EndP:TPoint;Txt:String);
       constructor init_group(act:byte);
       function is_grouped_action : boolean;
@@ -212,6 +227,7 @@ type
       Text      : PString;
       ActionCount : longint;
       Action    : byte;
+      TimeStamp : longint; { see above! }
     end;
 
     PEditorActionCollection = ^TEditorActionCollection;
@@ -230,6 +246,8 @@ type
       Pos    : TPoint;
     end;
 
+    TCompleteState = (csInactive,csOffering,csDenied);
+
     PCodeEditor = ^TCodeEditor;
     TCodeEditor = object(TScroller)
       Indicator  : PIndicator;
@@ -249,6 +267,9 @@ type
       DebuggerRow: sw_integer;
       UndoList    : PEditorActionCollection;
       RedoList    : PEditorActionCollection;
+      CompleteState: TCompleteState;
+      CodeCompleteFrag: PString;
+      CodeCompleteWord: PString;
       constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar:
           PScrollBar; AIndicator: PIndicator; AbufSize:Sw_Word);
       procedure   SetFlags(AFlags: longint); virtual;
@@ -276,6 +297,9 @@ type
       procedure   SetHighlight(A, B: TPoint); virtual;
       procedure   SetHighlightRow(Row: sw_integer); virtual;
       procedure   SetDebuggerRow(Row: sw_integer); virtual;
+      procedure   SetCompleteState(AState: TCompleteState); virtual;
+      function    GetCodeCompleteFrag: string;
+      procedure   SetCodeCompleteFrag(const S: string);
       procedure   SelectAll(Enable: boolean); virtual;
       function    InsertFrom(Editor: PCodeEditor): Boolean; virtual;
       function    InsertText(const S: string): Boolean; virtual;
@@ -326,6 +350,9 @@ type
       function    Overwrite: boolean;
       function    GetLine(I: sw_integer): PLine;
       procedure   CheckSels;
+      procedure   CodeCompleteCheck;
+      procedure   CodeCompleteApply;
+      procedure   CodeCompleteCancel;
       procedure   UpdateUndoRedo(cm : word; action : byte);
       function    UpdateAttrs(FromLine: sw_integer; Attrs: byte): sw_integer;
       function    UpdateAttrsRange(FromLine, ToLine: sw_integer; Attrs: byte): sw_integer;
@@ -341,6 +368,13 @@ type
       function    GetSpecSymbolCount(SpecClass: TSpecSymbolClass): integer; virtual;
       function    GetSpecSymbol(SpecClass: TSpecSymbolClass; Index: integer): string; virtual;
       function    IsReservedWord(const S: string): boolean; virtual;
+     { CodeTemplate support }
+      function    TranslateCodeTemplate(const Shortcut: string; ALines: PUnsortedStringCollection): boolean; virtual;
+     { CodeComplete support }
+      function    CompleteCodeWord(const WordS: string; var Text: string): boolean; virtual;
+      function    GetCodeCompleteWord: string;
+      procedure   SetCodeCompleteWord(const S: string); virtual;
+      procedure   ClearCodeCompleteWord; virtual;
     public
       SearchRunCount: integer;
       InASCIIMode: boolean;
@@ -384,6 +418,7 @@ type
       procedure WriteBlock; virtual;
       procedure ReadBlock; virtual;
       procedure PrintBlock; virtual;
+      procedure ExpandCodeTemplate; virtual;
       procedure AddChar(C: char); virtual;
 {$ifdef WinClipSupported}
       function  ClipCopyWin: Boolean; virtual;
@@ -430,7 +465,7 @@ const
      DefaultCodeEditorFlags : longint =
        efBackupFiles+efInsertMode+efAutoIndent+efPersistentBlocks+
        {efUseTabCharacters+}efBackSpaceUnindents+efSyntaxHighlight+
-       efExpandAllTabs;
+       efExpandAllTabs+efCodeComplete;
      DefaultTabSize     : integer = 8;
      EOL : String[2] = {$ifdef Linux}#10;{$else}#13#10;{$endif}
 
@@ -485,7 +520,7 @@ uses
 {$ifdef WinClipSupported}
   Strings,WinClip,
 {$endif WinClipSupported}
-  WUtils,WViews;
+  WViews;
 
 {$ifndef NOOBJREG}
 const
@@ -540,14 +575,15 @@ const
      kbShift = kbLeftShift+kbRightShift;
 
 const
-  FirstKeyCount = 39;
+  FirstKeyCount = 40;
   FirstKeys: array[0..FirstKeyCount * 2] of Word = (FirstKeyCount,
-    Ord(^A), cmWordLeft, Ord(^B), cmASCIIChar, Ord(^C), cmPageDown,
+    Ord(^A), cmWordLeft, Ord(^B), cmJumpLine, Ord(^C), cmPageDown,
     Ord(^D), cmCharRight, Ord(^E), cmLineUp,
     Ord(^F), cmWordRight, Ord(^G), cmDelChar,
-    Ord(^H), cmBackSpace, Ord(^J), cmJumpLine,
+    Ord(^H), cmBackSpace, Ord(^J), cmExpandCodeTemplate,
     Ord(^K), $FF02, Ord(^L), cmSearchAgain,
-    Ord(^M), cmNewLine, Ord(^N), cmBreakLine, Ord(^Q), $FF01,
+    Ord(^M), cmNewLine, Ord(^N), cmBreakLine,
+    Ord(^P), cmASCIIChar, Ord(^Q), $FF01,
     Ord(^R), cmPageUp, Ord(^S), cmCharLeft,
     Ord(^T), cmDelWord, Ord(^U), cmUndo,
     Ord(^V), cmInsMode, Ord(^X), cmLineDown,
@@ -1162,7 +1198,10 @@ begin
   Lines^.Insert(NewLine(''));
   { ^^^ why? setlinetext() inserts automatically if neccessary and
     getlinetext() checks whether you're in range...
-    because otherwise you search for line with index -1 (PM) }
+    because otherwise you search for line with index -1 (PM)
+    Then I think the algorithm should be changed to handle this special case,
+    instead of applying this "work-around" - Gabor
+  }
   SetState(sfCursorVis,true);
   SetFlags(DefaultCodeEditorFlags); TabSize:=DefaultTabSize;
   SetHighlightRow(-1);
@@ -1178,8 +1217,12 @@ end;
 
 procedure TCodeEditor.SetFlags(AFlags: longint);
 var I: sw_integer;
+    OldFlags: longint;
 begin
+  OldFlags:=Flags;
   Flags:=AFlags;
+  if ((OldFlags xor Flags) and efCodeComplete)<>0 then
+    ClearCodeCompleteWord;
   SetInsertMode((Flags and efInsertMode)<>0);
   if (Flags and efSyntaxHighlight)<>0 then
     UpdateAttrs(0,attrAll) else
@@ -1386,17 +1429,22 @@ var DontClear : boolean;
     MakeLocal(Event.Where,P);
     Inc(P.X,Delta.X); Inc(P.Y,Delta.Y);
   end;
-
+type TCCAction = (ccCheck,ccClear,ccDontCare);
 var
   StartP,P: TPoint;
   E: TEvent;
   OldEvent : PEvent;
+  CCAction: TCCAction;
 begin
+  CCAction:=ccClear;
   E:=Event;
   OldEvent:=CurEvent;
-  if (E.what and (evMouse or evKeyboard))<>0 then
+  if (E.What and (evMouse or evKeyboard))<>0 then
     CurEvent:=@E;
   if (InASCIIMode=false) or (Event.What<>evKeyDown) then
+   if (Event.What<>evKeyDown) or
+      ((Event.KeyCode<>kbEnter) and (Event.KeyCode<>kbEsc)) or
+      (CompleteState<>csOffering) then
     ConvertEvent(Event);
   case Event.What of
     evMouseDown :
@@ -1425,13 +1473,34 @@ begin
     evKeyDown :
       begin
         { Scancode is almost never zero PM }
+        { this is supposed to enable entering of ASCII chars below 32,
+          which are normally interpreted as control chars. So, when you enter
+          Alt+24 (on the numeric pad) then this will normally move the cursor
+          one line down, but if you do it in ASCII mode (also after Ctrl+B)
+          then this will insert the ASCII #24 char (upper arrow) in the
+          source code. - Gabor }
         if InASCIIMode {and (Event.CharCode<>0)} then
-          AddChar(Event.CharCode)
+          begin
+            AddChar(Event.CharCode);
+            if (CompleteState<>csDenied) or (Event.CharCode=#32) then
+              CCAction:=ccCheck
+            else
+              CCAction:=ccClear;
+          end
         else
           begin
            DontClear:=false;
            case Event.KeyCode of
-             kbAltF10 : Message(@Self,evCommand,cmLocalMenu,@Self);
+             kbAltF10 :
+               Message(@Self,evCommand,cmLocalMenu,@Self);
+             kbEnter  :
+               if CompleteState=csOffering then
+                 CodeCompleteApply
+               else
+                 Message(@Self,evCommand,cmNewLine,nil);
+             kbEsc :
+               if CompleteState=csOffering then
+                 CodeCompleteCancel;
            else
             case Event.CharCode of
              #9,#32..#255 :
@@ -1439,6 +1508,10 @@ begin
                  NoSelect:=true;
                  AddChar(Event.CharCode);
                  NoSelect:=false;
+                 if (CompleteState<>csDenied) or (Event.CharCode=#32) then
+                   CCAction:=ccCheck
+                 else
+                   CCAction:=ccClear;
                end;
             else
               DontClear:=true;
@@ -1454,6 +1527,7 @@ begin
         DontClear:=false;
         case Event.Command of
           cmASCIIChar   : InASCIIMode:=not InASCIIMode;
+          cmAddChar     : AddChar(chr(longint(Event.InfoPtr)));
           cmCharLeft    : CharLeft;
           cmCharRight   : CharRight;
           cmWordLeft    : WordLeft;
@@ -1510,34 +1584,48 @@ begin
           cmUndo        : Undo;
           cmRedo        : Redo;
           cmClear       : DelSelect;
+          cmExpandCodeTemplate: ExpandCodeTemplate;
           cmLocalMenu :
             begin
               P:=CurPos; Inc(P.X); Inc(P.Y);
               LocalMenu(P);
             end;
-        else DontClear:=true;
+        else
+          begin
+            DontClear:=true;
+            CCAction:=ccDontCare;
+          end;
         end;
-        if DontClear=false then ClearEvent(Event);
+        if DontClear=false then
+          ClearEvent(Event);
       end;
     evBroadcast :
-      case Event.Command of
-        cmUpdate :
-          Update;
-        cmClearLineHighlights :
-          SetHighlightRow(-1);
-        cmResetDebuggerRow :
-          SetDebuggerRow(-1);
-        cmScrollBarChanged:
-          if (Event.InfoPtr = HScrollBar) or
-             (Event.InfoPtr = VScrollBar) then
-            begin
-              CheckScrollBar(HScrollBar, Delta.X);
-              CheckScrollBar(VScrollBar, Delta.Y);
-            end;
+      begin
+        CCAction:=ccDontCare;
+        case Event.Command of
+          cmUpdate :
+            Update;
+          cmClearLineHighlights :
+            SetHighlightRow(-1);
+          cmResetDebuggerRow :
+            SetDebuggerRow(-1);
+          cmScrollBarChanged:
+            if (Event.InfoPtr = HScrollBar) or
+               (Event.InfoPtr = VScrollBar) then
+              begin
+                CheckScrollBar(HScrollBar, Delta.X);
+                CheckScrollBar(VScrollBar, Delta.Y);
+              end;
+        end;
       end;
+  else CCAction:=ccDontCare;
   end;
   inherited HandleEvent(Event);
   CurEvent:=OldEvent;
+  case CCAction of
+    ccCheck : CodeCompleteCheck;
+    ccClear : ClearCodeCompleteWord;
+  end;
 end;
 
 procedure TCodeEditor.UpdateUndoRedo(cm : word; action : byte);
@@ -2021,6 +2109,37 @@ begin
   IsReservedWord:=false;
 end;
 
+function TCodeEditor.TranslateCodeTemplate(const Shortcut: string; ALines: PUnsortedStringCollection): boolean;
+begin
+  TranslateCodeTemplate:=false;
+end;
+
+function TCodeEditor.CompleteCodeWord(const WordS: string; var Text: string): boolean;
+begin
+  CompleteCodeWord:=false;
+end;
+
+function TCodeEditor.GetCodeCompleteWord: string;
+begin
+  GetCodeCompleteWord:=GetStr(CodeCompleteWord);
+end;
+
+procedure TCodeEditor.SetCodeCompleteWord(const S: string);
+begin
+  if Assigned(CodeCompleteWord) then DisposeStr(CodeCompleteWord);
+  CodeCompleteWord:=NewStr(S);
+  if S<>'' then
+    SetCompleteState(csOffering)
+  else
+    SetCompleteState(csInactive);
+end;
+
+procedure TCodeEditor.ClearCodeCompleteWord;
+begin
+  SetCodeCompleteWord('');
+  SetCompleteState(csInactive);
+end;
+
 procedure TCodeEditor.Indent;
 var S, PreS: string;
     Shift: integer;
@@ -2868,6 +2987,64 @@ begin
   NotImplemented; Exit;
 end;
 
+procedure TCodeEditor.ExpandCodeTemplate;
+var OSS,OSE: TPoint;
+    Line,ShortCut: string;
+    X,Y,I,LineIndent: sw_integer;
+    CodeLines: PUnsortedStringCollection;
+begin
+  {
+    The usage of editing primitives in this routine make it pretty slow, but
+    its speed is still acceptable and they make the implementation of Undo
+    much easier... - Gabor
+  }
+  if IsReadOnly then Exit;
+
+  Lock;
+
+  Line:=GetDisplayText(CurPos.Y);
+  X:=CurPos.X; ShortCut:='';
+  if X<=length(Line) then
+  while (X>0) and (Line[X] in (NumberChars+AlphaChars)) do
+  begin
+    ShortCut:=Line[X]+ShortCut;
+    Dec(X);
+  end;
+
+  if ShortCut<>'' then
+  begin
+    New(CodeLines, Init(10,10));
+    if TranslateCodeTemplate(ShortCut,CodeLines) then
+    begin
+      LineIndent:=X;
+      SetCurPtr(X,CurPos.Y);
+      for I:=1 to length(ShortCut) do
+        DelChar;
+      for Y:=0 to CodeLines^.Count-1 do
+      begin
+        if Y>0 then
+          for X:=1 to LineIndent do  { indent template lines to align }
+            AddChar(' ');            { them to the first line         }
+        Line:=CodeLines^.At(Y)^;
+        for X:=1 to length(Line) do
+          AddChar(Line[X]);
+        if Y<CodeLines^.Count-1 then
+          begin
+            InsertLine;               { line break }
+            while CurPos.X>0 do       { unindent }
+            begin
+              SetCurPtr(CurPos.X-1,CurPos.Y);
+              DelChar;
+            end;
+          end;
+      end;
+    end;
+    Dispose(CodeLines, Done);
+  end;
+
+  UnLock;
+end;
+
 procedure TCodeEditor.AddChar(C: char);
 const OpenBrackets  : string[10] = '[({';
       CloseBrackets : string[10] = '])}';
@@ -3663,8 +3840,10 @@ end;
 
 procedure TCodeEditor.SetInsertMode(InsertMode: boolean);
 begin
-  if InsertMode then Flags:=Flags or efInsertMode
-      else Flags:=Flags and (not efInsertMode);
+  if InsertMode then
+    Flags:=(Flags or efInsertMode)
+  else
+    Flags:=(Flags and (not efInsertMode));
   DrawCursor;
 end;
 
@@ -3755,6 +3934,74 @@ begin
        SetSelection(SelEnd,SelStart);
 end;
 
+procedure TCodeEditor.CodeCompleteApply;
+var S: string;
+    I: integer;
+begin
+  Lock;
+
+  { here should be some kind or "mark" or "break" inserted in the Undo
+    information, so activating it "undoes" only the completition first and
+    doesn't delete the complete word at once... - Gabor }
+
+  S:=GetCodeCompleteFrag;
+  SetCurPtr(CurPos.X-length(S),CurPos.Y);
+  for I:=1 to length(S) do
+    DelChar;
+  S:=GetCodeCompleteWord;
+  for I:=1 to length(S) do
+    AddChar(S[I]);
+
+  UnLock;
+  SetCompleteState(csInactive);
+end;
+
+procedure TCodeEditor.CodeCompleteCancel;
+begin
+  SetCompleteState(csDenied);
+end;
+
+procedure TCodeEditor.CodeCompleteCheck;
+var Line: string;
+    X,Y,I: sw_integer;
+    CurWord,NewWord: string;
+begin
+  SetCodeCompleteFrag('');
+  if ((Flags and efCodeComplete)=0) or (IsReadOnly=true) then Exit;
+
+  Lock;
+
+  Line:=GetDisplayText(CurPos.Y);
+  X:=CurPos.X; CurWord:='';
+  if X<=length(Line) then
+  while (X>0) and (Line[X] in (NumberChars+AlphaChars)) do
+  begin
+    CurWord:=Line[X]+CurWord;
+    Dec(X);
+  end;
+
+  if (length(CurWord)>=CodeCompleteMinLen) and CompleteCodeWord(CurWord,NewWord) then
+    begin
+      SetCodeCompleteFrag(CurWord);
+      SetCodeCompleteWord(NewWord);
+    end
+  else
+    ClearCodeCompleteWord;
+
+  UnLock;
+end;
+
+function TCodeEditor.GetCodeCompleteFrag: string;
+begin
+  GetCodeCompleteFrag:=GetStr(CodeCompleteFrag);
+end;
+
+procedure TCodeEditor.SetCodeCompleteFrag(const S: string);
+begin
+  if Assigned(CodeCompleteFrag) then DisposeStr(CodeCompleteFrag);
+  CodeCompleteFrag:=NewStr(S);
+end;
+
 function TCodeEditor.UpdateAttrs(FromLine: sw_integer; Attrs: byte): sw_integer;
 type
     TCharClass = (ccWhiteSpace,ccTab,ccAlpha,ccNumber,ccRealNumber,ccHash,ccSymbol);
@@ -4357,6 +4604,16 @@ begin
   DrawView;
 end;
 
+procedure TCodeEditor.SetCompleteState(AState: TCompleteState);
+begin
+  if AState<>CompleteState then
+  begin
+    CompleteState:=AState;
+    if CompleteState<>csOffering then
+      ClearCodeCompleteWord;
+  end;
+end;
+
 procedure TCodeEditor.SelectAll(Enable: boolean);
 var A,B: TPoint;
 begin
@@ -4417,7 +4674,11 @@ procedure TCodeEditor.SetState(AState: Word; Enable: Boolean);
 begin
   inherited SetState(AState,Enable);
   if (AState and (sfActive+sfSelected+sfFocused))<>0 then
-     SelectionChanged;
+    begin
+      SelectionChanged;
+      if ((State and sfFocused)=0) and (CompleteState=csOffering) then
+        ClearCodeCompleteWord;
+    end;
 end;
 
 function TCodeEditor.GetPalette: PPalette;
@@ -4589,6 +4850,10 @@ begin
       Dispose(RedoList,done);
   If assigned(UndoList) then
       Dispose(UndoList,done);
+  if Assigned(CodeCompleteFrag) then
+    DisposeStr(CodeCompleteFrag);
+  if Assigned(CodeCompleteWord) then
+    DisposeStr(CodeCompleteWord);
 end;
 
 {$ifdef Undo}
@@ -4658,7 +4923,7 @@ end;
 
 function TFileEditor.IsChangedOnDisk : boolean;
 begin
-  IsChangedOnDisk:=(OnDiskLoadTime<>GetFileTime(FileName)) and (OnDiskLoadTime<>-1);
+  IsChangedOnDisk:=OnDiskLoadTime<>GetFileTime(FileName);
 end;
 
 function TFileEditor.SaveFile: boolean;
@@ -4715,8 +4980,6 @@ begin
   begin
     FileName := FExpand(FileName);
     Message(Owner, evBroadcast, cmUpdateTitle, @Self);
-    { if we rename the file the OnDiskLoadTime is wrong so we reset it }
-    OnDiskLoadTime:=-1;
     SaveAs := SaveFile;
     if IsClipboard then FileName := '';
     Message(Application,evBroadcast,cmFileNameChanged,@Self);
@@ -5051,6 +5314,7 @@ begin
 {$ifndef FPC}
             ChDir(Copy(FileDir,1,2));
             { this sets InOutRes in win32 PM }
+            { is this bad? What about an EatIO? Gabor }
 {$endif not FPC}
           end;
         if FileDir<>'' then
@@ -5154,8 +5418,8 @@ end;
 END.
 {
   $Log$
-  Revision 1.66  1999-12-23 23:32:49  pierre
-   * avoid wrong warning for renamed files
+  Revision 1.67  2000-01-03 11:38:35  michael
+  Changes from Gabor
 
   Revision 1.65  1999/12/08 16:02:46  pierre
    * fix for bugs 746,748 and 750

+ 61 - 1
ide/text/wutils.pas

@@ -61,6 +61,12 @@ type
     S       : PStream;
   end;
 
+  PTextCollection = ^TTextCollection;
+  TTextCollection = object(TStringCollection)
+    function LookUp(const S: string; var Idx: sw_integer): string;
+    function Compare(Key1, Key2: Pointer): sw_Integer; virtual;
+  end;
+
 {$ifdef TPUNIXLF}
   procedure readln(var t:text;var s:string);
 {$endif}
@@ -450,6 +456,57 @@ begin
   S^.Write(Buf,Count);
 end;
 
+function TTextCollection.Compare(Key1, Key2: Pointer): Sw_Integer;
+var K1: PString absolute Key1;
+    K2: PString absolute Key2;
+    R: Sw_integer;
+    S1,S2: string;
+begin
+  S1:=UpCaseStr(K1^);
+  S2:=UpCaseStr(K2^);
+  if S1<S2 then R:=-1 else
+  if S1>S2 then R:=1 else
+  R:=0;
+  Compare:=R;
+end;
+
+function TTextCollection.LookUp(const S: string; var Idx: sw_integer): string;
+var OLI,ORI,Left,Right,Mid: integer;
+    LeftP,RightP,MidP: PString;
+    RL: integer;
+    LeftS,MidS,RightS: string;
+    FoundS: string;
+    UpS : string;
+begin
+  Idx:=-1; FoundS:='';
+  Left:=0; Right:=Count-1;
+  UpS:=UpCaseStr(S);
+  if Left<Right then
+  begin
+    while (Left<Right) do
+    begin
+      OLI:=Left; ORI:=Right;
+      Mid:=Left+(Right-Left) div 2;
+      LeftP:=At(Left); RightP:=At(Right); MidP:=At(Mid);
+      LeftS:=UpCaseStr(LeftP^); MidS:=UpCaseStr(MidP^);
+      RightS:=UpCaseStr(RightP^);
+      if copy(MidS,1,length(UpS))=UpS then
+        begin
+          Idx:=Mid; FoundS:=GetStr(MidP);
+        end;
+{      else}
+        if UpS<MidS then
+          Right:=Mid
+        else
+          Left:=Mid;
+      if (OLI=Left) and (ORI=Right) then
+        Break;
+    end;
+  end;
+  LookUp:=FoundS;
+end;
+
+
 procedure GiveUpTimeSlice;
 {$ifdef GO32V2}{$define DOS}{$endif}
 {$ifdef TP}{$define DOS}{$endif}
@@ -474,7 +531,10 @@ end;
 END.
 {
   $Log$
-  Revision 1.9  1999-12-01 16:19:46  pierre
+  Revision 1.10  2000-01-03 11:38:35  michael
+  Changes from Gabor
+
+  Revision 1.9  1999/12/01 16:19:46  pierre
    + GetFileTime moved here
 
   Revision 1.8  1999/10/25 16:39:03  pierre