Explorar el Código

Move Free Vision units to include files.

Margers hace 1 mes
padre
commit
5fc7c81b0b

+ 344 - 0
packages/fv/src/asciitab.inc

@@ -0,0 +1,344 @@
+{********[ SOURCE FILE OF GRAPHICAL FREE VISION ]**********}
+{                                                          }
+{   System independent GRAPHICAL clone of ASCIITAB.PAS     }
+{                                                          }
+{   Interface Copyright (c) 1992 Borland International     }
+{                                                          }
+{   Copyright (c) 2002 by Pierre Muller                    }
+{   [email protected]                                  }
+{****************[ THIS CODE IS FREEWARE ]*****************}
+{                                                          }
+{     This sourcecode is released for the purpose to       }
+{   promote the pascal language on all platforms. You may  }
+{   redistribute it and/or modify with the following       }
+{   DISCLAIMER.                                            }
+{                                                          }
+{     This SOURCE CODE is distributed "AS IS" WITHOUT      }
+{   WARRANTIES AS TO PERFORMANCE OF MERCHANTABILITY OR     }
+{   ANY OTHER WARRANTIES WHETHER EXPRESSED OR IMPLIED.     }
+{                                                          }
+{*****************[ SUPPORTED PLATFORMS ]******************}
+{     16 and 32 Bit compilers                              }
+{        DPMI     - FPC 0.9912+ (GO32V2)    (32 Bit)       }
+{        WIN95/NT - FPC 0.9912+             (32 Bit)       }
+{                                                          }
+
+{$IFNDEF FPC_DOTTEDUNITS}
+UNIT AsciiTab;
+{$ENDIF FPC_DOTTEDUNITS}
+
+{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
+                                  INTERFACE
+{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
+
+{====Include file to sort compiler platform out =====================}
+{$I platform.inc}
+{====================================================================}
+
+{==== Compiler directives ===========================================}
+{$H-}
+{$X+} { Extended syntax is ok }
+{$R-} { Disable range checking }
+{$S-} { Disable Stack Checking }
+{$I-} { Disable IO Checking }
+{$Q-} { Disable Overflow Checking }
+{$V-} { Turn off strict VAR strings }
+
+{====================================================================}
+
+{$IFDEF FPC_DOTTEDUNITS}
+USES FreeVision.Fvconsts, System.Objects, FreeVision.Drivers, FreeVision.Views, FreeVision.App;      { Standard GFV units }
+{$ELSE FPC_DOTTEDUNITS}
+USES FVConsts, Objects, Drivers, Views, App;      { Standard GFV units }
+{$ENDIF FPC_DOTTEDUNITS}
+
+{***************************************************************************}
+{                        PUBLIC OBJECT DEFINITIONS                          }
+{***************************************************************************}
+
+
+{---------------------------------------------------------------------------}
+{                  TTABLE OBJECT - 32x32 matrix of all chars                }
+{---------------------------------------------------------------------------}
+
+type
+  PTable = ^TTable;
+  TTable = object(TView)
+    procedure Draw; virtual;
+    procedure HandleEvent(var Event:TEvent); virtual;
+  private
+    procedure DrawCurPos(enable : boolean);
+  end;
+
+{---------------------------------------------------------------------------}
+{                  TREPORT OBJECT - View with details of current AnsiChar       }
+{---------------------------------------------------------------------------}
+  PReport = ^TReport;
+  TReport = object(TView)
+    ASCIIChar: LongInt;
+    constructor Load(var S: TStream);
+    procedure Draw; virtual;
+    procedure HandleEvent(var Event:TEvent); virtual;
+    procedure Store(var S: TStream);
+  end;
+
+{---------------------------------------------------------------------------}
+{                  TASCIIChart OBJECT - the complete AsciiChar window       }
+{---------------------------------------------------------------------------}
+
+  PASCIIChart = ^TASCIIChart;
+  TASCIIChart = object(TWindow)
+    Report: PReport;
+    Table: PTable;
+    constructor Init;
+    constructor Load(var S: TStream);
+    procedure   Store(var S: TStream);
+    procedure HandleEvent(var Event:TEvent); virtual;
+    procedure SizeLimits (Var Min, Max: TPoint); Virtual;
+  end;
+
+{---------------------------------------------------------------------------}
+{ AsciiTableCommandBase                                                     }
+{---------------------------------------------------------------------------}
+
+const
+  AsciiTableCommandBase: Word = 910;
+
+{---------------------------------------------------------------------------}
+{ Registrations records                                                     }
+{---------------------------------------------------------------------------}
+
+  RTable: TStreamRec = (
+     ObjType: idTable;
+     VmtLink: Ofs(TypeOf(TTable)^);
+     Load:    @TTable.Load;
+     Store:   @TTable.Store
+  );
+  RReport: TStreamRec = (
+     ObjType: idReport;
+     VmtLink: Ofs(TypeOf(TReport)^);
+     Load:    @TReport.Load;
+     Store:   @TReport.Store
+  );
+  RASCIIChart: TStreamRec = (
+     ObjType: idASCIIChart;
+     VmtLink: Ofs(TypeOf(TASCIIChart)^);
+     Load:    @TASCIIChart.Load;
+     Store:   @TASCIIChart.Store
+  );
+
+{---------------------------------------------------------------------------}
+{ Registration procedure                                                    }
+{---------------------------------------------------------------------------}
+procedure RegisterASCIITab;
+
+
+
+{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
+                             IMPLEMENTATION
+{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
+
+{***************************************************************************}
+{                              OBJECT METHODS                               }
+{***************************************************************************}
+
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+{                          TTable OBJECT METHODS                            }
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+
+procedure TTable.Draw;
+var
+  NormColor : byte;
+  B : TDrawBuffer;
+  x,y : sw_integer;
+begin
+  NormColor:=GetColor(1);
+  For y:=0 to size.Y-1 do begin
+    For x:=0 to size.X-1 do
+      B[x]:=(NormColor shl 8) or ((y*Size.X+x) and $ff);
+    WriteLine(0,Y,Size.X,1,B);
+  end;
+  DrawCurPos(true);
+end;
+
+procedure TTable.DrawCurPos(enable : boolean);
+var
+  Color : byte;
+  B : word;
+begin
+  Color:=GetColor(1);
+  { add blinking if enable }
+  If Enable then
+    Color:=((Color and $F) shl 4) or (Color shr 4);
+  B:=(Color shl 8) or ((Cursor.Y*Size.X+Cursor.X) and $ff);
+  WriteLine(Cursor.X,Cursor.Y,1,1,B);
+end;
+
+procedure TTable.HandleEvent(var Event:TEvent);
+var
+  CurrentPos : TPoint;
+  Handled : boolean;
+
+  procedure SetTo(xpos, ypos : sw_integer;press:SmallInt);
+  var
+    newchar : ptrint;
+  begin
+    newchar:=(ypos*size.X+xpos) and $ff;
+    DrawCurPos(false);
+    SetCursor(xpos,ypos);
+    Message(Owner,evCommand,AsciiTableCommandBase,
+      pointer(newchar));
+    if press>0 then
+      begin
+        Message(Owner,evCommand,AsciiTableCommandBase+press,pointer(newchar));
+      end;
+    DrawCurPos(true);
+    ClearEvent(Event);
+  end;
+
+begin
+  case Event.What of
+    evMouseDown :
+      begin
+        If MouseInView(Event.Where) then
+          begin
+            MakeLocal(Event.Where, CurrentPos);
+            SetTo(CurrentPos.X, CurrentPos.Y,1);
+            exit;
+          end;
+      end;
+    evKeyDown :
+      begin
+        Handled:=true;
+        case Event.Keycode of
+          kbUp   : if Cursor.Y>0 then
+                   SetTo(Cursor.X,Cursor.Y-1,0);
+          kbDown : if Cursor.Y<Size.Y-1 then
+                   SetTo(Cursor.X,Cursor.Y+1,0);
+          kbLeft : if Cursor.X>0 then
+                   SetTo(Cursor.X-1,Cursor.Y,0);
+          kbRight: if Cursor.X<Size.X-1 then
+                   SetTo(Cursor.X+1,Cursor.Y,0);
+          kbHome : SetTo(0,0,0);
+          kbEnd  : SetTo(Size.X-1,Size.Y-1,0);
+          kbEnter: SetTo(Cursor.X,Cursor.Y,1);
+        else
+          Handled:=false;
+        end;
+        if Handled then
+          exit;
+      end;
+  end;
+  inherited HandleEvent(Event);
+end;
+
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+{                        TReport OBJECT METHODS                             }
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+
+constructor TReport.Load(var S: TStream);
+begin
+  Inherited Load(S);
+  S.Read(AsciiChar,Sizeof(AsciiChar));
+end;
+
+procedure TReport.Draw;
+  var
+    stHex,stDec : string[3];
+    s : string;
+begin
+  Str(AsciiChar,StDec);
+  while length(stDec)<3 do
+    stDec:=' '+stDec;
+  stHex:=hexstr(AsciiChar,2);
+  s:='AnsiChar "'+chr(AsciiChar)+'" Decimal: '+
+     StDec+' Hex: $'+StHex+
+     '  '; // //{!ss:fill gap. FormatStr function using be better}
+  WriteStr(0,0,S,1);
+end;
+
+procedure TReport.HandleEvent(var Event:TEvent);
+begin
+  if (Event.what=evCommand) and
+     (Event.Command =  AsciiTableCommandBase) then
+    begin
+      AsciiChar:=PtrInt(Event.InfoPtr);
+      Draw;
+      ClearEvent(Event);
+    end
+  else inherited HandleEvent(Event);
+end;
+
+procedure TReport.Store(var S: TStream);
+begin
+  Inherited Store(S);
+  S.Write(AsciiChar,Sizeof(AsciiChar));
+end;
+
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+{                        TAsciiChart OBJECT METHODS                         }
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+
+constructor TASCIIChart.Init;
+var
+  R : Trect;
+begin
+  R.Assign(0,0,34,12);
+  Inherited Init(R,'Ascii table',wnNoNumber);
+  Flags:=Flags and not (wfGrow or wfZoom);
+  Palette:=wpGrayWindow;
+  R.Assign(1,10,33,11);
+  New(Report,Init(R));
+  Report^.Options:=Report^.Options or ofFramed;
+  Insert(Report);
+  R.Assign(1,1,33,9);
+  New(Table,Init(R));
+  Table^.Options:=Table^.Options or (ofSelectable+ofTopSelect);
+  Insert(Table);
+  Table^.Select;
+end;
+
+constructor TASCIIChart.Load(var S: TStream);
+begin
+  Inherited Load(S);
+  GetSubViewPtr(S,Table);
+  GetSubViewPtr(S,Report);
+end;
+
+procedure TASCIIChart.Store(var S: TStream);
+begin
+  Inherited Store(S);
+  PutSubViewPtr(S,Table);
+  PutSubViewPtr(S,Report);
+end;
+
+procedure TASCIIChart.HandleEvent(var Event:TEvent);
+begin
+  {writeln(stderr,'ascii cmd',event.what, ' ', event.command);}
+  if (Event.what=evCommand) and
+     (Event.Command =  AsciiTableCommandBase) then
+    begin
+      Report^.HandleEvent(Event);
+    end
+  else inherited HandleEvent(Event);
+end;
+
+procedure TASCIIChart.SizeLimits (Var Min, Max: TPoint);
+begin
+  Min.X:=34;
+  Min.Y:=12;
+  Max:=Min;  { make sure no resize can take place }
+end;
+
+{---------------------------------------------------------------------------}
+{ Registration procedure                                                    }
+{---------------------------------------------------------------------------}
+procedure RegisterASCIITab;
+begin
+  RegisterType(RTable);
+  RegisterType(RReport);
+  RegisterType(RAsciiChart);
+end;
+
+
+END.

+ 1 - 344
packages/fv/src/asciitab.pas

@@ -1,344 +1 @@
-{********[ SOURCE FILE OF GRAPHICAL FREE VISION ]**********}
-{                                                          }
-{   System independent GRAPHICAL clone of ASCIITAB.PAS     }
-{                                                          }
-{   Interface Copyright (c) 1992 Borland International     }
-{                                                          }
-{   Copyright (c) 2002 by Pierre Muller                    }
-{   [email protected]                                  }
-{****************[ THIS CODE IS FREEWARE ]*****************}
-{                                                          }
-{     This sourcecode is released for the purpose to       }
-{   promote the pascal language on all platforms. You may  }
-{   redistribute it and/or modify with the following       }
-{   DISCLAIMER.                                            }
-{                                                          }
-{     This SOURCE CODE is distributed "AS IS" WITHOUT      }
-{   WARRANTIES AS TO PERFORMANCE OF MERCHANTABILITY OR     }
-{   ANY OTHER WARRANTIES WHETHER EXPRESSED OR IMPLIED.     }
-{                                                          }
-{*****************[ SUPPORTED PLATFORMS ]******************}
-{     16 and 32 Bit compilers                              }
-{        DPMI     - FPC 0.9912+ (GO32V2)    (32 Bit)       }
-{        WIN95/NT - FPC 0.9912+             (32 Bit)       }
-{                                                          }
-
-{$IFNDEF FPC_DOTTEDUNITS}
-UNIT AsciiTab;
-{$ENDIF FPC_DOTTEDUNITS}
-
-{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
-                                  INTERFACE
-{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
-
-{====Include file to sort compiler platform out =====================}
-{$I platform.inc}
-{====================================================================}
-
-{==== Compiler directives ===========================================}
-{$H-}
-{$X+} { Extended syntax is ok }
-{$R-} { Disable range checking }
-{$S-} { Disable Stack Checking }
-{$I-} { Disable IO Checking }
-{$Q-} { Disable Overflow Checking }
-{$V-} { Turn off strict VAR strings }
-
-{====================================================================}
-
-{$IFDEF FPC_DOTTEDUNITS}
-USES FreeVision.Fvconsts, System.Objects, FreeVision.Drivers, FreeVision.Views, FreeVision.App;      { Standard GFV units }
-{$ELSE FPC_DOTTEDUNITS}
-USES FVConsts, Objects, Drivers, Views, App;      { Standard GFV units }
-{$ENDIF FPC_DOTTEDUNITS}
-
-{***************************************************************************}
-{                        PUBLIC OBJECT DEFINITIONS                          }
-{***************************************************************************}
-
-
-{---------------------------------------------------------------------------}
-{                  TTABLE OBJECT - 32x32 matrix of all chars                }
-{---------------------------------------------------------------------------}
-
-type
-  PTable = ^TTable;
-  TTable = object(TView)
-    procedure Draw; virtual;
-    procedure HandleEvent(var Event:TEvent); virtual;
-  private
-    procedure DrawCurPos(enable : boolean);
-  end;
-
-{---------------------------------------------------------------------------}
-{                  TREPORT OBJECT - View with details of current AnsiChar       }
-{---------------------------------------------------------------------------}
-  PReport = ^TReport;
-  TReport = object(TView)
-    ASCIIChar: LongInt;
-    constructor Load(var S: TStream);
-    procedure Draw; virtual;
-    procedure HandleEvent(var Event:TEvent); virtual;
-    procedure Store(var S: TStream);
-  end;
-
-{---------------------------------------------------------------------------}
-{                  TASCIIChart OBJECT - the complete AsciiChar window       }
-{---------------------------------------------------------------------------}
-
-  PASCIIChart = ^TASCIIChart;
-  TASCIIChart = object(TWindow)
-    Report: PReport;
-    Table: PTable;
-    constructor Init;
-    constructor Load(var S: TStream);
-    procedure   Store(var S: TStream);
-    procedure HandleEvent(var Event:TEvent); virtual;
-    procedure SizeLimits (Var Min, Max: TPoint); Virtual;
-  end;
-
-{---------------------------------------------------------------------------}
-{ AsciiTableCommandBase                                                     }
-{---------------------------------------------------------------------------}
-
-const
-  AsciiTableCommandBase: Word = 910;
-
-{---------------------------------------------------------------------------}
-{ Registrations records                                                     }
-{---------------------------------------------------------------------------}
-
-  RTable: TStreamRec = (
-     ObjType: idTable;
-     VmtLink: Ofs(TypeOf(TTable)^);
-     Load:    @TTable.Load;
-     Store:   @TTable.Store
-  );
-  RReport: TStreamRec = (
-     ObjType: idReport;
-     VmtLink: Ofs(TypeOf(TReport)^);
-     Load:    @TReport.Load;
-     Store:   @TReport.Store
-  );
-  RASCIIChart: TStreamRec = (
-     ObjType: idASCIIChart;
-     VmtLink: Ofs(TypeOf(TASCIIChart)^);
-     Load:    @TASCIIChart.Load;
-     Store:   @TASCIIChart.Store
-  );
-
-{---------------------------------------------------------------------------}
-{ Registration procedure                                                    }
-{---------------------------------------------------------------------------}
-procedure RegisterASCIITab;
-
-
-
-{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
-                             IMPLEMENTATION
-{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
-
-{***************************************************************************}
-{                              OBJECT METHODS                               }
-{***************************************************************************}
-
-{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
-{                          TTable OBJECT METHODS                            }
-{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
-
-procedure TTable.Draw;
-var
-  NormColor : byte;
-  B : TDrawBuffer;
-  x,y : sw_integer;
-begin
-  NormColor:=GetColor(1);
-  For y:=0 to size.Y-1 do begin
-    For x:=0 to size.X-1 do
-      B[x]:=(NormColor shl 8) or ((y*Size.X+x) and $ff);
-    WriteLine(0,Y,Size.X,1,B);
-  end;
-  DrawCurPos(true);
-end;
-
-procedure TTable.DrawCurPos(enable : boolean);
-var
-  Color : byte;
-  B : word;
-begin
-  Color:=GetColor(1);
-  { add blinking if enable }
-  If Enable then
-    Color:=((Color and $F) shl 4) or (Color shr 4);
-  B:=(Color shl 8) or ((Cursor.Y*Size.X+Cursor.X) and $ff);
-  WriteLine(Cursor.X,Cursor.Y,1,1,B);
-end;
-
-procedure TTable.HandleEvent(var Event:TEvent);
-var
-  CurrentPos : TPoint;
-  Handled : boolean;
-
-  procedure SetTo(xpos, ypos : sw_integer;press:SmallInt);
-  var
-    newchar : ptrint;
-  begin
-    newchar:=(ypos*size.X+xpos) and $ff;
-    DrawCurPos(false);
-    SetCursor(xpos,ypos);
-    Message(Owner,evCommand,AsciiTableCommandBase,
-      pointer(newchar));
-    if press>0 then
-      begin
-        Message(Owner,evCommand,AsciiTableCommandBase+press,pointer(newchar));
-      end;
-    DrawCurPos(true);
-    ClearEvent(Event);
-  end;
-
-begin
-  case Event.What of
-    evMouseDown :
-      begin
-        If MouseInView(Event.Where) then
-          begin
-            MakeLocal(Event.Where, CurrentPos);
-            SetTo(CurrentPos.X, CurrentPos.Y,1);
-            exit;
-          end;
-      end;
-    evKeyDown :
-      begin
-        Handled:=true;
-        case Event.Keycode of
-          kbUp   : if Cursor.Y>0 then
-                   SetTo(Cursor.X,Cursor.Y-1,0);
-          kbDown : if Cursor.Y<Size.Y-1 then
-                   SetTo(Cursor.X,Cursor.Y+1,0);
-          kbLeft : if Cursor.X>0 then
-                   SetTo(Cursor.X-1,Cursor.Y,0);
-          kbRight: if Cursor.X<Size.X-1 then
-                   SetTo(Cursor.X+1,Cursor.Y,0);
-          kbHome : SetTo(0,0,0);
-          kbEnd  : SetTo(Size.X-1,Size.Y-1,0);
-          kbEnter: SetTo(Cursor.X,Cursor.Y,1);
-        else
-          Handled:=false;
-        end;
-        if Handled then
-          exit;
-      end;
-  end;
-  inherited HandleEvent(Event);
-end;
-
-{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
-{                        TReport OBJECT METHODS                             }
-{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
-
-constructor TReport.Load(var S: TStream);
-begin
-  Inherited Load(S);
-  S.Read(AsciiChar,Sizeof(AsciiChar));
-end;
-
-procedure TReport.Draw;
-  var
-    stHex,stDec : string[3];
-    s : string;
-begin
-  Str(AsciiChar,StDec);
-  while length(stDec)<3 do
-    stDec:=' '+stDec;
-  stHex:=hexstr(AsciiChar,2);
-  s:='AnsiChar "'+chr(AsciiChar)+'" Decimal: '+
-     StDec+' Hex: $'+StHex+
-     '  '; // //{!ss:fill gap. FormatStr function using be better}
-  WriteStr(0,0,S,1);
-end;
-
-procedure TReport.HandleEvent(var Event:TEvent);
-begin
-  if (Event.what=evCommand) and
-     (Event.Command =  AsciiTableCommandBase) then
-    begin
-      AsciiChar:=PtrInt(Event.InfoPtr);
-      Draw;
-      ClearEvent(Event);
-    end
-  else inherited HandleEvent(Event);
-end;
-
-procedure TReport.Store(var S: TStream);
-begin
-  Inherited Store(S);
-  S.Write(AsciiChar,Sizeof(AsciiChar));
-end;
-
-{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
-{                        TAsciiChart OBJECT METHODS                         }
-{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
-
-constructor TASCIIChart.Init;
-var
-  R : Trect;
-begin
-  R.Assign(0,0,34,12);
-  Inherited Init(R,'Ascii table',wnNoNumber);
-  Flags:=Flags and not (wfGrow or wfZoom);
-  Palette:=wpGrayWindow;
-  R.Assign(1,10,33,11);
-  New(Report,Init(R));
-  Report^.Options:=Report^.Options or ofFramed;
-  Insert(Report);
-  R.Assign(1,1,33,9);
-  New(Table,Init(R));
-  Table^.Options:=Table^.Options or (ofSelectable+ofTopSelect);
-  Insert(Table);
-  Table^.Select;
-end;
-
-constructor TASCIIChart.Load(var S: TStream);
-begin
-  Inherited Load(S);
-  GetSubViewPtr(S,Table);
-  GetSubViewPtr(S,Report);
-end;
-
-procedure TASCIIChart.Store(var S: TStream);
-begin
-  Inherited Store(S);
-  PutSubViewPtr(S,Table);
-  PutSubViewPtr(S,Report);
-end;
-
-procedure TASCIIChart.HandleEvent(var Event:TEvent);
-begin
-  {writeln(stderr,'ascii cmd',event.what, ' ', event.command);}
-  if (Event.what=evCommand) and
-     (Event.Command =  AsciiTableCommandBase) then
-    begin
-      Report^.HandleEvent(Event);
-    end
-  else inherited HandleEvent(Event);
-end;
-
-procedure TASCIIChart.SizeLimits (Var Min, Max: TPoint);
-begin
-  Min.X:=34;
-  Min.Y:=12;
-  Max:=Min;  { make sure no resize can take place }
-end;
-
-{---------------------------------------------------------------------------}
-{ Registration procedure                                                    }
-{---------------------------------------------------------------------------}
-procedure RegisterASCIITab;
-begin
-  RegisterType(RTable);
-  RegisterType(RReport);
-  RegisterType(RAsciiChart);
-end;
-
-
-END.
+{$I asciitab.inc}

+ 1128 - 0
packages/fv/src/colorsel.inc

@@ -0,0 +1,1128 @@
+{
+   This unit is part of the Free Vision package
+
+   Copyright 2008,2024 by Marco van de Voort, Andreas Jakobsche and Margers
+
+   Color select dialog.
+
+   See the file COPYING.FPC, included in this distribution,
+   for details about the copyright.
+
+   This library is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+   Library General Public License for more details.
+
+   You should have received a copy of the GNU Library General Public
+   License along with this library; if not, write to the Free
+   Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
+   MA 02110-1301, USA.
+
+ ****************************************************************************}
+
+{$IFNDEF FPC_DOTTEDUNITS}
+unit ColorSel;
+{$ENDIF FPC_DOTTEDUNITS}
+{====Include file to sort compiler platform out =====================}
+{$I platform.inc}
+interface
+
+{$IFDEF FPC_DOTTEDUNITS}
+uses
+  System.Objects, FreeVision.Drivers, FreeVision.Dialogs, FreeVision.Views, 
+  FreeVision.Fvconsts;
+{$ELSE FPC_DOTTEDUNITS}
+uses
+  Objects, Drivers, Dialogs, Views, fvconsts;
+{$ENDIF FPC_DOTTEDUNITS}
+
+const dialog_colorsel_colors        = 'Colors';
+      label_colorsel_group          = '~G~roup';
+      label_colorsel_item           = '~I~tem';
+      label_colorsel_foreground     = '~F~oreground';
+      label_colorsel_background     = '~B~ackground';
+      label_colorsel_displaytext    = 'Text Text Text';
+
+      label_colors_framepassive     = 'Frame passive';
+      label_colors_frameactive      = 'Frame active';
+      label_colors_frameicon        = 'Frame icons';
+      label_colors_scrollbarpage    = 'Scroll bar page';
+      label_colors_scrollbaricons   = 'Scroll bar icons';
+      label_colors_normaltext       = 'Normal text';
+      label_colors_selectedtext     = 'Selected text';
+      label_colors_activeitem       = 'Active item';
+      label_colors_inactiveitem     = 'Inactive item';
+      label_colors_focuseditem      = 'Focused item';
+      label_colors_selecteditem     = 'Selected item';
+      label_colors_divider          = 'Divider';
+      label_colors_normal           = 'Normal';
+      label_colors_selected         = 'Selected';
+      label_colors_disabled         = 'Disabled';
+      label_colors_shortcut         = 'Shortcut';
+      label_colors_selecteddisabled = 'Selected disabled';
+      label_colors_shortcutselected = 'Shortcut selected';
+      label_colors_color            = 'Color';
+      label_colors_framebackground  = 'Frame/background';
+      label_colors_statictext       = 'Static text';
+      label_colors_normallabel      = 'Label normal';
+      label_colors_selectedlabel    = 'Label selected';
+      label_colors_shortcutlabel    = 'Label shortcut';
+      label_colors_normalbutton     = 'Button normal';
+      label_colors_defaultbutton    = 'Button default';
+      label_colors_selectedbutton   = 'Button selected';
+      label_colors_disabledbutton   = 'Button disabled';
+      label_colors_buttonshadow     = 'Button shadow';
+      label_colors_shortcutbutton   = 'Button shortcut';
+      label_colors_normalcluster    = 'Cluster normal';
+      label_colors_selectedcluster  = 'Cluster selected';
+      label_colors_shortcutcluster  = 'Cluster shortcut';
+      label_colors_disabledcluster  = 'Cluster disabled';
+      label_colors_normalinput      = 'Input normal';
+      label_colors_selectedinput    = 'Input selected';
+      label_colors_inputarrow       = 'Input arrow';
+      label_colors_historybutton    = 'History button';
+      label_colors_historysides     = 'History sides';
+      label_colors_historybarpage   = 'History bar page';
+      label_colors_historybaricon   = 'History bar icons';
+      label_colors_normallist       = 'List normal';
+      label_colors_selectedlist     = 'List selected';
+      label_colors_focusedlist      = 'List focused';
+      label_colors_listdivider      = 'List divider';
+      label_colors_infopane         = 'Information pane';
+
+type
+  TColorSel = (csBackground, csForeground);
+
+  PColorItem = ^TColorItem;
+  TColorItem = record
+    Name: PString;
+    Index: Byte;
+    Next: PColorItem;
+  end;
+
+  PColorGroup = ^TColorGroup;
+  TColorGroup = record
+    Name: PString;
+    Index: Byte;
+    Items: PColorItem;
+    Next: PColorGroup;
+  end;
+
+  PColorIndex = ^TColorIndex;
+  TColorIndex = record
+    GroupIndex: Byte;
+    ColorSize: Byte;
+    ColorIndex: array[0 .. 255] of Byte;
+  end;
+
+  PColorGroupList = ^TColorGroupList;
+  TColorGroupList = object(TListViewer)
+    Groups: PColorGroup;
+    constructor Init(var Bounds: TRect; AScrollBar: PScrollBar; AGroups: PColorGroup);
+    constructor Load(var S: TStream);
+    procedure Store(var S: TStream);
+    procedure FocusItem(Item: Sw_Integer); virtual;
+    function GetText(Item: Sw_Integer; MaxLen: Sw_Integer): String; virtual;
+    procedure HandleEvent(var Event: TEvent); virtual;
+    procedure SetGroupIndex(GroupNum, ItemNum: Byte);
+    function GetGroup(GroupNum: Byte): PColorGroup;
+    function GetGroupIndex(GroupNum: Byte): Byte;
+    function GetNumGroups: byte;
+    destructor Done; Virtual;
+  end;
+
+  PColorItemList = ^TColorItemList;
+  TColorItemList = object(TListViewer)
+    Items: PColorItem;
+    constructor Init(var Bounds: TRect; AScrollBar: PScrollBar; AItems: PColorItem);
+    procedure FocusItem(Item: Sw_Integer); virtual;
+    function GetText(Item: Sw_Integer; MaxLen: Sw_Integer): String; virtual;
+    procedure HandleEvent(var Event: TEvent); virtual;
+    procedure SetItems(AItems: PColorItem);
+    function GetColorIndex(Item: Sw_integer): Sw_integer;
+  end;
+
+  PColorSelector = ^TColorSelector;
+  TColorSelector = object(TView)
+    Color: Byte;
+    SelType: TColorSel;
+    constructor Init(var Bounds: TRect; ASelType: TColorSel);
+    constructor Load(var S: TStream);
+    procedure Store(var S: TStream);
+    procedure HandleEvent(var Event: TEvent); virtual;
+    procedure Draw; Virtual;
+  end;
+
+  PColorDisplay = ^TColorDisplay;
+  TColorDisplay = object(TView)
+    Color: PByte;
+    Text: PString;
+    constructor Init(var Bounds: TRect; AText: PString);
+    constructor Load(var S: TStream);
+    procedure Store(var S: TStream);
+    procedure HandleEvent(var Event: TEvent); virtual;
+    procedure SetColor(var AColor: Byte); virtual;
+    procedure Draw; Virtual;
+    destructor Done; Virtual;
+  end;
+
+  PColorDialog = ^TColorDialog;
+  TColorDialog = object(TDialog)
+    BakLabel: PLabel;
+    BakSel: PColorSelector;
+    ForLabel: PLabel;
+    ForSel: PColorSelector;
+    Groups: PColorGroupList;
+    GroupIndex: Byte;
+    Items: PColorItemList;
+    Display: PColorDisplay;
+    Pal: TPalette;
+    constructor Init(APalette: TPalette; AGroups: PColorGroup);
+    constructor Load(var S: TStream);
+    procedure Store(var S: TStream);
+    procedure HandleEvent (var Event: TEvent); virtual;
+    function DataSize: sw_word; virtual;
+    procedure GetData (var Rec); virtual;
+    procedure SetData (var Rec); virtual;
+    {procedure GetIndexes (var Colors: PColorIndex);
+    procedure SetIndexes (var Colors: PColorIndex);}
+    private
+    procedure ItemChanged;
+  end;
+
+
+const ColorIndexes : PColorIndex = nil;
+
+procedure RegisterColorsel;
+
+function ColorGroup(Name: string; Items: PColorItem; Next: PColorGroup): PColorGroup;
+function ColorItem(Name: string; Index: Byte; Next: PColorItem): PColorItem;
+
+procedure LoadIndexes(var S: TStream);
+procedure StoreIndexes(var S: TStream);
+
+function WindowColorItems (Palette: Sw_Word; const Next: PColorItem): PColorItem;
+function DialogColorItems (Palette: Sw_Word; const Next: PColorItem): PColorItem;
+function MenuColorItems(const Next: PColorItem): PColorItem;
+function DesktopColorItems(const Next: PColorItem): PColorItem;
+
+
+{--------------------------------------------------------------------}
+{                      implementation                                }
+{--------------------------------------------------------------------}
+implementation
+
+const
+  RColorItemList: TStreamRec = (
+     ObjType: idColorItemList;
+     VmtLink: Ofs(TypeOf(TColorItemList)^);
+     Load:    @TColorItemList.Load;
+     Store:   @TColorItemList.Store
+  );
+  RColorGroupList: TStreamRec = (
+     ObjType: idColorGroupList;
+     VmtLink: Ofs(TypeOf(TColorGroupList)^);
+     Load:    @TColorGroupList.Load;
+     Store:   @TColorGroupList.Store
+  );
+  RColorSelector: TStreamRec = (
+     ObjType: idColorSelector;
+     VmtLink: Ofs(TypeOf(TColorSelector)^);
+     Load:    @TColorSelector.Load;
+     Store:   @TColorSelector.Store
+  );
+  RColorDisplay: TStreamRec = (
+     ObjType: idColorDisplay;
+     VmtLink: Ofs(TypeOf(TColorDisplay)^);
+     Load:    @TColorDisplay.Load;
+     Store:   @TColorDisplay.Store
+  );
+  RColorDialog: TStreamRec = (
+     ObjType: idColorDialog;
+     VmtLink: Ofs(TypeOf(TColorDialog)^);
+     Load:    @TColorDialog.Load;
+     Store:   @TColorDialog.Store
+  );
+
+procedure RegisterColorsel;
+begin
+ // according to help should register TColorSelector,     TMonoSelector, TColorDisplay, TColorGroupList, TColorItemList,     TColorDialog
+ // probably don't bother with the mono variants. Except for (P/T)colordialog, these don't grep in FV/IDE src.
+
+ // TColorSelector -> the square colorselection widget (instantiated twice once for front, once for back?)
+ // TColorGrouplist-> the selection of the color group (left list)  (TListbox or whatever the TV eq is?)
+ // TColorItemList -> the selection of the color identifier (right list)  (TListbox or whatever the TV eq is?)
+
+ RegisterType(RColorItemList);
+ RegisterType(RColorGroupList);
+ RegisterType(RColorSelector);
+ RegisterType(RColorDisplay);
+ RegisterType(RColorDialog);
+end;
+
+
+function ColorGroup(Name: string; Items: PColorItem; Next: PColorGroup): PColorGroup;
+var
+  R: PColorGroup;
+begin
+  New(R);
+  R^.Name := NewStr(Name);
+  R^.Items := Items;
+  R^.Next := Next;
+  ColorGroup := R;
+end;
+
+function ColorItem(Name: string; Index: Byte; Next: PColorItem): PColorItem;
+var R: PColorItem;
+begin
+  New(R);
+  R^.Name := NewStr(Name);
+  R^.Index := Index;
+  R^.Next := Next;
+  ColorItem := R
+end;
+
+procedure LoadIndexes(var S: TStream);
+var A: TColorIndex;
+begin
+  fillchar(A,sizeof(A),0);
+  S.Read(A.GroupIndex, SizeOf(A.GroupIndex));
+  S.Read(A.ColorSize, SizeOf(A.ColorSize));
+  if A.ColorSize > 0 then
+    S.Read(A.ColorIndex, SizeOf(A.ColorSize));
+  if ColorIndexes<>nil then ColorIndexes^:=A;
+end;
+
+procedure StoreIndexes(var S: TStream);
+var A: TColorIndex;
+begin
+  fillchar(A,sizeof(A),0);
+  if ColorIndexes<>nil then A:=ColorIndexes^;
+  S.Write(A.GroupIndex, SizeOf(A.GroupIndex));
+  S.Write(A.ColorSize, SizeOf(A.ColorSize));
+  if A.ColorSize>0 then
+    S.Write(A.ColorIndex, SizeOf(A.ColorSize));
+end;
+
+{--------------------------------------------------------------------}
+{                      TColorSelector                                }
+{--------------------------------------------------------------------}
+
+constructor TColorSelector.Init(var Bounds: TRect; ASelType: TColorSel);
+begin
+  inherited init(Bounds);
+  Options:=Options or ofSelectable or ofFirstClick or ofFramed;
+  EventMask := EventMask OR evBroadcast;
+  SelType:=ASelType;
+end;
+
+constructor TColorSelector.Load(var S: TStream);
+begin
+  inherited Load(S);
+  S.Read(Color, SizeOf(Color));
+  S.Read(SelType, SizeOf(SelType));
+end;
+
+procedure TColorSelector.Store(var S: TStream);
+begin
+  inherited Store(S);
+  S.Write(Color, SizeOf(Color));
+  S.Write(SelType, SizeOf(SelType));
+end;
+
+procedure TColorSelector.HandleEvent(var Event: TEvent);
+var newColor,oldColor : sw_integer;
+   sColor : byte;
+   NeedClear : boolean;
+   Mouse: TPoint;
+   Mx : sw_integer;
+   n15, n11, n16 : sw_integer;
+begin
+  inherited HandleEvent(Event);
+  NeedClear:=false;
+  oldColor:=Color;
+  newColor:=Color;
+  Case Event.What Of
+    evKeyDown: Begin                                 { Key down event }
+      NeedClear:=true;
+      n15:=15; n11:=11; n16:=16;
+      if (SelType = csBackground) then
+      begin
+        n15:=7; n11:=3; n16:=8;
+      end;
+      Case CtrlToArrow(Event.KeyCode) Of
+         kbUp: begin
+           newColor:=newColor-4;
+           if newColor<0 then
+           begin
+              newColor:=(newColor+n15) ;
+              if NewColor=n11 then NewColor:=n15;
+           end;
+         end;
+         kbDown: begin
+           newColor:=newColor+4;
+           if newColor>=n16 then
+           begin
+             newColor:=(newColor+1) - n16;
+             if newColor=4 then newColor:=0;
+           end;
+         end;
+         kbRight: begin newColor:=newColor+1; if newColor>=n16 then newColor:=0; end;
+         kbLeft: begin newColor:=newColor-1; if newColor=-1 then newColor:=n15; end;
+      otherwise
+        NeedClear:=false;
+      end;
+    end;
+    evMouseDown: Begin                               { Mouse down event }
+      if (Event.Buttons=mbLeftButton ) and MouseInView(Event.Where) Then
+      begin
+        NeedClear:=true;
+        MakeLocal(Event.Where, Mouse);               { Localize mouse }
+        mx:=Mouse.X;
+        if (mx>=0) and (mx<=12) then
+          if ((Mouse.Y >= 0) and (Mouse.Y <= 3) and (SelType = csForeground))
+          or ((Mouse.Y >= 0) and (Mouse.Y <= 1) and (SelType = csBackground)) then
+          begin
+            mx:=mx div 3;
+            newColor:=(Mouse.Y)*4+mx;
+         end;
+      end;
+    end;
+    evBroadcast: Begin                               { Broadcast event }
+      case Event.Command of
+        cmColorSet:begin
+          if SelType = csForeground then
+            sColor:= Event.InfoByte and $0f
+          else
+            sColor:= (Event.InfoByte shr 4) and $0f;
+          if Color<>sColor then
+          begin
+            Color:=sColor;
+            DrawView;
+          end;
+        end;
+      end;
+    End;
+  end;
+  if NeedClear then
+    ClearEvent(Event);
+  if oldColor<>newColor then
+  begin
+    Color:=newColor;
+    if SelType = csForeground then          {intended type cast byte to pointer}
+      Message(Owner, evBroadcast, cmColorForegroundChanged, pointer(byte(Color)))
+    else
+      Message(Owner, evBroadcast, cmColorBackgroundChanged, pointer(byte(Color)));
+    Owner^.DrawView;
+  end;
+end;
+
+procedure TColorSelector.Draw;
+var
+  FrameColor : Byte;
+  SelColor,CurColor : Byte;
+  Frame : AnsiChar;
+  B     : TDrawBuffer;
+
+procedure DrawColorLine (LineNr : sw_word);
+var k: sw_integer;
+begin
+  for k:=0 to 3 do
+  begin
+    MoveChar (B[0+k*3], #219, SelColor, 3);
+    if CurColor = Color then
+    begin
+      if ((k = 0) or (k = 1)) and (CurColor<2) then
+        SelColor:=SelColor or $70
+      else
+        SelColor:=SelColor and $f;
+      MoveChar (B[0+k*3+1], #8, SelColor, 1);
+      SelColor:=SelColor or $10;
+      SelColor:=SelColor and $1f;
+    end;
+    inc(CurColor);
+    inc(SelColor,1);
+  end;
+  WriteBuf (0, LineNr, Size.X, 1, B);
+end;
+
+begin
+  FrameColor := GetColor (2);
+  MoveChar (B, ' ', FrameColor, Size.X);
+  SelColor:=$10;
+  CurColor:=0;
+  DrawColorLine(0);
+  DrawColorLine(1);
+  if SelType = csForeground then
+  begin
+    DrawColorLine(2);
+    DrawColorLine(3);
+  end;
+end;
+
+{--------------------------------------------------------------------}
+{                      TColorDisplay                                 }
+{--------------------------------------------------------------------}
+
+constructor TColorDisplay.Init(var Bounds: TRect; AText: PString);
+begin
+  inherited init(Bounds);
+  EventMask := EventMask OR evBroadcast;
+  Text:=AText;
+end;
+
+constructor TColorDisplay.Load(var S: TStream);
+begin
+  inherited Load(S);
+  if not Assigned(Color) then
+    GetMem(Color,1);
+  S.Read(Color^, SizeOf(Color^));
+  Text:=S.ReadStr;
+end;
+
+procedure TColorDisplay.Store(var S: TStream);
+var vColor : byte;
+begin
+  inherited Store(S);
+  vColor:=0;
+  if Assigned(Color) then vColor:=Color^;
+  S.Write(vColor, SizeOf(vColor));
+  S.WriteStr(Text);
+end;
+
+procedure TColorDisplay.HandleEvent(var Event: TEvent);
+begin
+  inherited HandleEvent(Event);
+  Case Event.What Of
+    evBroadcast:                                { Broadcast event }
+      case Event.Command of
+        cmColorForegroundChanged:if assigned(Color) then begin
+          Color^:=(Color^ and  $f0) or (Event.InfoByte and $0f);
+          DrawView;
+          ClearEvent(Event);                             { Event was handled }
+        end;
+        cmColorBackgroundChanged:if assigned(Color) then begin
+          Color^:= (Color^ and $0f) or((Event.InfoByte shl 4) and $f0);
+          DrawView;
+          ClearEvent(Event);                             { Event was handled }
+        end;
+      end;
+  end;
+end;
+
+procedure TColorDisplay.SetColor(var AColor: Byte);
+begin
+  Color:=@AColor;
+  Message(Owner, evBroadcast, cmColorSet, pointer(byte(Color^))); {intended type cast byte to pointer}
+  DrawView;
+end;
+
+procedure TColorDisplay.Draw;
+var
+  FColor : Byte;
+  Y      : sw_integer;
+  S      : String;
+  B      : TDrawBuffer;
+begin
+  if Assigned(Color) then
+  begin
+    FColor:=Color^;
+    if FColor = 0 then
+       FColor:=128;
+  end else
+    FColor := GetColor (2);
+  MoveChar (B, ' ', FColor, Size.X);
+  if Assigned(Text) then
+    S:=Text^
+  else
+    S:='';
+  if length(S) < Size.X then
+    MoveStr (B[(Size.X-length(S)) div 2], S, FColor)
+  else
+    MoveStr (B, S, FColor);
+  if Size.Y > 0 then
+    for Y :=0 to Size.Y-1 do
+    begin
+      WriteBuf (0, Y, Size.X, 1, B);
+    end;
+end;
+
+destructor TColorDisplay.Done;
+begin
+  if assigned(Text) then
+  begin
+    Dispose(Text);
+    Text:=nil;
+  end;
+  inherited Done;
+end;
+
+{--------------------------------------------------------------------}
+{                      TColorGroupList                               }
+{--------------------------------------------------------------------}
+
+constructor TColorGroupList.Init(var Bounds: TRect; AScrollBar: PScrollBar; AGroups: PColorGroup);
+var
+  x: PColorGroup;
+begin
+  inherited Init(Bounds, 1, nil, AScrollBar);
+  EventMask := EventMask OR evBroadcast;
+  Range := 0;
+  Groups := AGroups;
+  x := AGroups;
+  while Assigned(x) do begin
+    x^.Index:=0;
+    Inc(Range);
+    x := x^.Next
+  end;
+  SetRange(Range);
+end;
+
+constructor TColorGroupList.Load(var S: TStream);
+var x,z: PColorGroup;
+  R,Q: PColorItem;
+  num,numItems,iG,iI : word;
+begin
+  inherited Load(S);
+  S.Read(num, SizeOf(num));
+  Groups:=nil;
+  { read PColorGroup linked list }
+  z:=nil;
+  for iG:=1 to num do
+  begin
+    S.Read(numItems, SizeOf(numItems));
+    new(x);
+    x^.Items:=nil;
+    Q:=nil;
+    {read items}
+    for iI:=1 to numItems do
+    begin
+      New(R);
+      R^.Name:=S.ReadStr;
+      S.Read(R^.Index, SizeOf(R^.Index));
+      R^.Next:=nil;
+      if assigned(Q) then
+        Q^.Next:=R;
+      Q:=R;
+      if iI=1 then x^.Items:=R;
+    end;
+    {read group}
+    x^.Name:=S.ReadStr;
+    S.Read(x^.Index, SizeOf(x^.Index));
+    x^.Next:=nil;
+    if assigned(z) then
+      z^.Next:=x;
+    z:=x;
+    if iG = 1 then
+      Groups:=x; { Group starts with first entry }
+  end;
+end;
+
+procedure TColorGroupList.Store(var S: TStream);
+var x,z: PColorGroup;
+  R,Q: PColorItem;
+  num,numItems : word;
+begin
+  inherited Store(S);
+  num:=GetNumGroups;
+  S.Write(num,Sizeof(num));
+  x := Groups;
+  {Write PColorGroup linked list}
+  while Assigned(x) do begin
+    R:=x^.Items;
+    {count items}
+    Q:=R;
+    numItems:=0;
+    while Assigned(Q) do begin
+      inc(numItems);
+      Q:=Q^.Next;
+    end;
+    S.Write(numItems,Sizeof(numItems)); {  write Item count }
+    {write items}
+    while Assigned(R) do begin
+      S.WriteStr(R^.Name);
+      S.Write(R^.Index,Sizeof(R^.Index));
+      R := R^.Next;
+    end;
+    {write gropu}
+    S.WriteStr(x^.Name);
+    S.Write(x^.Index,Sizeof(x^.Index));
+    x := x^.Next;
+  end;
+end;
+
+procedure TColorGroupList.FocusItem(Item: Sw_Integer);
+var oFocus : sw_integer;
+begin
+  oFocus:=Focused;
+  inherited FocusItem(Item);
+  if Item < Range then
+  begin
+    if oFocus<>Focused then
+      Message(Owner, evBroadcast, cmNewColorItem, @Self);{ Send message }
+  end;
+end;
+
+function TColorGroupList.GetText(Item: Sw_Integer; MaxLen: Sw_Integer): String;
+var x: PColorGroup;
+    Num : sw_integer;
+begin
+  GetText:='';
+  x := Groups;
+  Num:=0;
+  while Assigned(x) do begin
+    if Num = Item then
+    begin
+      GetText:=x^.Name^;
+      exit;
+    end;
+    inc(Num);
+    x := x^.Next;
+  end;
+end;
+
+procedure TColorGroupList.HandleEvent(var Event: TEvent);
+begin
+  inherited HandleEvent(Event);
+  Case Event.What Of
+    evBroadcast:                                { Broadcast event }
+      case Event.Command of
+        cmSaveColorIndex: begin
+          SetGroupIndex(Focused,Event.InfoByte);
+          ClearEvent(Event);                    { Event was handled }
+        end;
+      end;
+  end;
+end;
+
+procedure TColorGroupList.SetGroupIndex(GroupNum, ItemNum: Byte);
+var x: PColorGroup;
+begin
+  x:=GetGroup(GroupNum);
+  if Assigned(x) then
+    x^.Index:=ItemNum;
+end;
+
+function TColorGroupList.GetGroup(GroupNum: Byte): PColorGroup;
+var x: PColorGroup;
+    Num : sw_integer;
+begin
+  GetGroup:=nil;
+  x := Groups;
+  Num:=0;
+  while Assigned(x) do begin
+    if Num = GroupNum then
+    begin
+      GetGroup:=x;
+      exit;
+    end;
+    inc(Num);
+    x := x^.Next;
+  end;
+end;
+
+function TColorGroupList.GetGroupIndex(GroupNum: Byte): Byte;
+var x: PColorGroup;
+begin
+  GetGroupIndex:=0;
+  x:=GetGroup(GroupNum);
+  if Assigned(x) then
+    GetGroupIndex:=x^.Index;
+end;
+
+function TColorGroupList.GetNumGroups: byte;
+var x: PColorGroup;
+    Num : sw_integer;
+begin
+  x := Groups;
+  Num:=0;
+  while Assigned(x) do begin
+    inc(Num);
+    x := x^.Next;
+  end;
+  GetNumGroups:=Num;
+end;
+
+destructor TColorGroupList.Done;
+var x,z: PColorGroup;
+  R,Q: PColorItem;
+begin
+  x := Groups;
+  inherited Done;
+  Groups:=nil;
+  {Disopse PColorGroup linked list}
+  while Assigned(x) do begin
+    R:=x^.Items;
+    while Assigned(R) do begin
+      Dispose(R^.Name);
+      Q:=R;
+      R := R^.Next;
+      Dispose(Q);
+    end;
+    Dispose(x^.Name);
+    z:=x;
+    x := x^.Next;
+    Dispose(z);
+  end;
+end;
+
+{--------------------------------------------------------------------}
+{                      TColorItemList                                }
+{--------------------------------------------------------------------}
+
+constructor TColorItemList.Init(var Bounds: TRect; AScrollBar: PScrollBar; AItems: PColorItem);
+begin
+  inherited Init(Bounds, 1, nil, AScrollBar);
+  EventMask := EventMask OR evBroadcast;
+  SetItems(AItems);
+end;
+
+procedure TColorItemList.FocusItem(Item: Sw_Integer);
+var oFocus:sw_integer;
+begin
+  oFocus:=Focused;
+  inherited FocusItem(Item);
+  if Item < Range then
+  begin
+    if oFocus<>Focused then
+    begin
+      {one for TColorGroupList and other for TColorDialog }
+      Message(Owner, evBroadcast, cmSaveColorIndex, pointer(byte(Focused)));{intended type cast byte to pointer}
+      Message(Owner, evBroadcast, cmNewColorIndex, @Self);{ Send message }
+    end;
+  end;
+end;
+
+function TColorItemList.GetText(Item: Sw_Integer; MaxLen: Sw_Integer): String;
+var count : sw_integer;
+    x :PColorItem;
+begin
+  GetText:= '';
+  count:=0;
+  if Assigned(Items) then
+  begin
+    x:=Items;
+    while Assigned(x) do
+    begin
+      if count=Item then
+      begin
+        GetText:=x^.Name^;
+        {SetLength(GetText,Min(Length(GetText),MaxLen));}
+        exit;
+      end;
+      inc(count);
+      x:=x^.Next;
+    end;
+  end;
+end;
+
+procedure TColorItemList.HandleEvent(var Event: TEvent);
+var Groups : PColorGroupList;
+    x:PColorGroup;
+    GroupIndex,ItemIndex:sw_integer;
+begin
+  inherited HandleEvent(Event);
+  Case Event.What Of
+    evBroadcast: Begin                               { Broadcast event }
+      case Event.Command of
+        cmNewColorItem: begin
+          Groups:=PColorGroupList(Event.Infoptr);
+          GroupIndex:=Groups^.Focused;
+          ItemIndex:=Groups^.GetGroupIndex(GroupIndex);
+          x:=Groups^.GetGroup(GroupIndex);
+          if assigned(x) then
+            SetItems(x^.Items)
+          else SetItems(nil);
+          FocusItem(ItemIndex);
+          DrawView;
+          ClearEvent(Event);                             { Event was handled }
+        end;
+      end;
+    end;
+  end;
+end;
+
+procedure TColorItemList.SetItems(AItems: PColorItem);
+var count : sw_integer;
+    x :PColorItem;
+begin
+  Items:=AItems;
+  Focused:=-1;
+  count:=0;
+    x:=Items;
+    while Assigned(x) do
+    begin
+      inc(count);
+      x:=x^.Next;
+    end;
+  SetRange(count);
+end;
+
+function TColorItemList.GetColorIndex(Item: Sw_integer): Sw_integer;
+var count : sw_integer;
+    x :PColorItem;
+begin
+  GetColorIndex:=0;
+  count:=0;
+  if Assigned(Items) then
+  begin
+    x:=Items;
+    while Assigned(x) do
+    begin
+      if count=Item then
+      begin
+        GetColorIndex:=x^.Index;
+        exit;
+      end;
+      inc(count);
+      x:=x^.Next;
+    end;
+  end;
+end;
+
+{--------------------------------------------------------------------}
+{                      TColorDialog                                  }
+{--------------------------------------------------------------------}
+
+constructor TColorDialog.Init(APalette: TPalette; AGroups: PColorGroup);
+var
+  R,R2: TRect;
+  OkButton,CancelButton : PButton;
+  VScrollBar: PScrollBar;
+  x:PColorGroup;
+  xItems: PColorItem;
+begin
+  R.Assign(0, 0, 62, 19);
+  inherited Init(R, dialog_colorsel_colors);
+  Options := Options or ofCentered;
+  EventMask := EventMask OR evBroadcast;             { Set event mask }
+  Pal := APalette;
+  {-- Groups list --}
+  R.Assign(3, 3, 18, 15);
+  R2.Copy(R); R2.A.X:=R2.B.X; Inc(R2.B.X);
+  VScrollBar := New(PScrollBar, Init(R2));
+  Insert(VScrollBar);
+  Groups := New(PColorGroupList, Init(R, VScrollBar, AGroups));
+  Insert(Groups);
+  R2.Copy(R); Dec(R2.A.Y); R2.B.Y:=R2.A.Y+1;
+  Insert(New(PLabel, Init(R2, label_colorsel_group, Groups)));
+  {-- Item list --}
+  GroupIndex:=Groups^.Focused;
+  x:=Groups^.GetGroup(GroupIndex);
+  if assigned(x) then
+    xItems:=x^.Items
+  else xItems:=nil;
+  R.Assign(21, 3, 42, 15);
+  R2.Copy(R); R2.A.X:=R2.B.X; Inc(R2.B.X);
+  VScrollBar := New(PScrollBar, Init(R2));
+  Insert(VScrollBar);
+  Items := New(PColorItemList, Init(R, VScrollBar,xItems));
+  Insert(Items);
+  R2.Copy(R); Dec(R2.A.Y); R2.B.Y:=R2.A.Y+1;
+  Insert(New(PLabel, Init(R2, label_colorsel_item, Items)));
+  {-- Color selector foreground --}
+  R.Assign(46, 3, 58, 7);
+  R2.Copy(R); R2.B.Y:=R2.A.Y; Dec(R2.A.Y);
+  ForSel:=New(PColorSelector, Init(R, csForeground));
+  ForLabel:=New(PLabel, Init(R2, label_colorsel_foreground, ForSel));
+  Insert(ForSel);
+  Insert(ForLabel);
+  {-- Color selector background --}
+  R.Assign(46, 9, 58, 11);
+  R2.Copy(R); R2.B.Y:=R2.A.Y; Dec(R2.A.Y);
+  BakSel:=New(PColorSelector, Init(R, csBackground));
+  BakLabel:=New(PLabel, Init(R2, label_colorsel_background, BakSel));
+  Insert(BakSel);
+  Insert(BakLabel);
+  {-- Color Display --}
+  R.Assign(45, 12, 59, 15);
+  Display:=New(PColorDisplay,Init(R,NewStr(label_colorsel_displaytext)));
+  Insert(Display);
+  {-- Buttons --}
+  R.Assign(37, 16, 47, 18);
+  OkButton := New(PButton, Init(R, slOk, cmOK, bfDefault));
+  Insert(OkButton);
+  Inc(R.A.X,12); Inc(R.B.X,12);
+  CancelButton := New(PButton, Init(R, slCancel, cmCancel, bfDefault));
+  Insert(CancelButton);
+  {--set focus--}
+  Items^.FocusItem(0);
+  SelectNext(False);
+end;
+
+constructor TColorDialog.Load(var S: TStream);
+begin
+  if not TDialog.Load(S) then
+    Fail;
+  S.Read(GroupIndex, SizeOf(GroupIndex));
+  S.Read(Pal, SizeOf(Pal));
+  if (S.Status <> stOk) then
+  begin
+    TDialog.Done;
+    Fail;
+  end;
+  GetSubViewPtr(S,BakLabel);
+  GetSubViewPtr(S,BakSel);
+  GetSubViewPtr(S,ForLabel);
+  GetSubViewPtr(S,ForSel);
+  GetSubViewPtr(S,Groups);
+  GetSubViewPtr(S,Items);
+  GetSubViewPtr(S,Display);
+  if assigned(Items) then
+    if assigned(Groups) then
+      Items^.Items:=Groups^.GetGroup(Groups^.Focused)^.Items;
+end;
+
+procedure TColorDialog.Store(var S: TStream);
+begin
+  inherited Store(S);
+  S.Write(GroupIndex, SizeOf(GroupIndex));
+  S.Write(Pal, SizeOf(Pal));
+  PutSubViewPtr(S,BakLabel);
+  PutSubViewPtr(S,BakSel);
+  PutSubViewPtr(S,ForLabel);
+  PutSubViewPtr(S,ForSel);
+  PutSubViewPtr(S,Groups);
+  PutSubViewPtr(S,Items);
+  PutSubViewPtr(S,Display);
+end;
+
+procedure TColorDialog.ItemChanged;
+const NoItemSelectedColor : byte = $7f;
+var ColorIndex,ItemIndex : sw_integer;
+begin
+  GroupIndex:=Groups^.Focused;
+  if Items^.Range > 0 then
+    begin
+      ItemIndex:=Items^.Focused;
+      ColorIndex:=Items^.GetColorIndex(ItemIndex);
+      Display^.SetColor(byte(Pal[ColorIndex]));
+    end
+  else
+    Display^.SetColor(NoItemSelectedColor);
+end;
+
+procedure TColorDialog.HandleEvent (var Event: TEvent);
+begin
+  inherited HandleEvent(Event);
+  Case Event.What Of
+    evBroadcast:                                     { Broadcast event }
+      case Event.Command of
+        cmNewColorIndex: begin
+          ItemChanged;
+          ClearEvent(Event);                         { Event was handled }
+        end;
+      end;
+  end;
+end;
+
+function TColorDialog.DataSize: sw_Word;
+begin
+  DataSize:=Sizeof(Pal);
+end;
+
+procedure TColorDialog.GetData (var Rec);
+begin
+  TPalette(Rec):=Pal;
+end;
+
+procedure TColorDialog.SetData (var Rec);
+begin
+  Pal:=TPalette(Rec);
+  ItemChanged;
+end;
+
+function WindowColorItems (Palette: Sw_Word; const Next: PColorItem): PColorItem;
+const
+  COffset: array[wpBlueWindow..wpGrayWindow] of Byte =
+    (8, 16, 24);
+var
+  Offset: Word;
+begin
+  //WindowColorItems:=ColorItem('Normal',12,Next); {place holder}
+  Offset := COffset[Palette];
+  WindowColorItems :=
+    ColorItem(label_colors_framepassive,     Offset + 0,
+    ColorItem(label_colors_frameactive,      Offset + 1,
+    ColorItem(label_colors_frameicon,        Offset + 2,
+    ColorItem(label_colors_scrollbarpage,    Offset + 3,
+    ColorItem(label_colors_scrollbaricons,   Offset + 4,
+    ColorItem(label_colors_normaltext,       Offset + 5,
+    Next))))));
+end;
+
+function DialogColorItems(Palette: Sw_Word; const Next: PColorItem): PColorItem;
+const
+  COffset: array[dpBlueDialog..dpGrayDialog] of Byte =
+    (64, 96, 32);
+  var
+    Offset: Byte;
+begin
+  //DialogColorItems:=ColorItem('Normal',13,Next); {place holder}
+  Offset := COffset[Palette];
+  DialogColorItems :=
+    ColorItem(label_colors_framebackground,  Offset + 1,
+    ColorItem(label_colors_frameicon,        Offset + 2,
+    ColorItem(label_colors_scrollbarpage,    Offset + 3,
+    ColorItem(label_colors_scrollbaricons,   Offset + 4,
+    ColorItem(label_colors_statictext,       Offset + 5,
+
+    ColorItem(label_colors_normallabel,      Offset + 6,
+    ColorItem(label_colors_selectedlabel,    Offset + 7,
+    ColorItem(label_colors_shortcutlabel,    Offset + 8,
+
+    ColorItem(label_colors_normalbutton,     Offset + 9,
+    ColorItem(label_colors_defaultbutton,    Offset + 10,
+    ColorItem(label_colors_selectedbutton,   Offset + 11,
+    ColorItem(label_colors_disabledbutton,   Offset + 12,
+    ColorItem(label_colors_shortcutbutton,   Offset + 13,
+    ColorItem(label_colors_buttonshadow,     Offset + 14,
+
+    ColorItem(label_colors_normalcluster,    Offset + 15,
+    ColorItem(label_colors_selectedcluster,  Offset + 16,
+    ColorItem(label_colors_shortcutcluster,  Offset + 17,
+    ColorItem(label_colors_disabledcluster,  Offset + 30,
+
+    ColorItem(label_colors_normalinput,      Offset + 18,
+    ColorItem(label_colors_selectedinput,    Offset + 19,
+    ColorItem(label_colors_inputarrow,       Offset + 20,
+
+    ColorItem(label_colors_historybutton,    Offset + 21,
+    ColorItem(label_colors_historysides,     Offset + 22,
+    ColorItem(label_colors_historybarpage,   Offset + 23,
+    ColorItem(label_colors_historybaricon,   Offset + 24,
+
+    ColorItem(label_colors_normallist,       Offset + 25,
+    ColorItem(label_colors_selectedlist,     Offset + 26,
+    ColorItem(label_colors_focusedlist,      Offset + 27,
+    ColorItem(label_colors_listdivider,      Offset + 28,
+
+    ColorItem(label_colors_infopane,         Offset + 29,
+    Next))))))))))))))))))))))))))))));
+end;
+
+function MenuColorItems(const Next: PColorItem): PColorItem;
+begin
+  MenuColorItems :=
+    ColorItem(label_colors_normal,2,
+    ColorItem(label_colors_disabled,3,
+    ColorItem(label_colors_shortcut,4,
+    ColorItem(label_colors_selected,5,
+    ColorItem(label_colors_selecteddisabled, 6,
+    ColorItem(label_colors_shortcutselected, 7,
+    Next)))))) ;
+end;
+
+function DesktopColorItems(const Next: PColorItem): PColorItem;
+begin
+  DesktopColorItems := ColorItem(label_colors_color,1,Next);
+end;
+
+end.
+
+{
+
+fvconsts.pas:  idColorSelector = 92;
+fvconsts.pas:  idMonoSelector = 93;
+
+}

+ 1 - 1128
packages/fv/src/colorsel.pas

@@ -1,1128 +1 @@
-{
-   This unit is part of the Free Vision package
-
-   Copyright 2008,2024 by Marco van de Voort, Andreas Jakobsche and Margers
-
-   Color select dialog.
-
-   See the file COPYING.FPC, included in this distribution,
-   for details about the copyright.
-
-   This library is distributed in the hope that it will be useful,
-   but WITHOUT ANY WARRANTY; without even the implied warranty of
-   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-   Library General Public License for more details.
-
-   You should have received a copy of the GNU Library General Public
-   License along with this library; if not, write to the Free
-   Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
-   MA 02110-1301, USA.
-
- ****************************************************************************}
-
-{$IFNDEF FPC_DOTTEDUNITS}
-unit ColorSel;
-{$ENDIF FPC_DOTTEDUNITS}
-{====Include file to sort compiler platform out =====================}
-{$I platform.inc}
-interface
-
-{$IFDEF FPC_DOTTEDUNITS}
-uses
-  System.Objects, FreeVision.Drivers, FreeVision.Dialogs, FreeVision.Views, 
-  FreeVision.Fvconsts;
-{$ELSE FPC_DOTTEDUNITS}
-uses
-  Objects, Drivers, Dialogs, Views, fvconsts;
-{$ENDIF FPC_DOTTEDUNITS}
-
-const dialog_colorsel_colors        = 'Colors';
-      label_colorsel_group          = '~G~roup';
-      label_colorsel_item           = '~I~tem';
-      label_colorsel_foreground     = '~F~oreground';
-      label_colorsel_background     = '~B~ackground';
-      label_colorsel_displaytext    = 'Text Text Text';
-
-      label_colors_framepassive     = 'Frame passive';
-      label_colors_frameactive      = 'Frame active';
-      label_colors_frameicon        = 'Frame icons';
-      label_colors_scrollbarpage    = 'Scroll bar page';
-      label_colors_scrollbaricons   = 'Scroll bar icons';
-      label_colors_normaltext       = 'Normal text';
-      label_colors_selectedtext     = 'Selected text';
-      label_colors_activeitem       = 'Active item';
-      label_colors_inactiveitem     = 'Inactive item';
-      label_colors_focuseditem      = 'Focused item';
-      label_colors_selecteditem     = 'Selected item';
-      label_colors_divider          = 'Divider';
-      label_colors_normal           = 'Normal';
-      label_colors_selected         = 'Selected';
-      label_colors_disabled         = 'Disabled';
-      label_colors_shortcut         = 'Shortcut';
-      label_colors_selecteddisabled = 'Selected disabled';
-      label_colors_shortcutselected = 'Shortcut selected';
-      label_colors_color            = 'Color';
-      label_colors_framebackground  = 'Frame/background';
-      label_colors_statictext       = 'Static text';
-      label_colors_normallabel      = 'Label normal';
-      label_colors_selectedlabel    = 'Label selected';
-      label_colors_shortcutlabel    = 'Label shortcut';
-      label_colors_normalbutton     = 'Button normal';
-      label_colors_defaultbutton    = 'Button default';
-      label_colors_selectedbutton   = 'Button selected';
-      label_colors_disabledbutton   = 'Button disabled';
-      label_colors_buttonshadow     = 'Button shadow';
-      label_colors_shortcutbutton   = 'Button shortcut';
-      label_colors_normalcluster    = 'Cluster normal';
-      label_colors_selectedcluster  = 'Cluster selected';
-      label_colors_shortcutcluster  = 'Cluster shortcut';
-      label_colors_disabledcluster  = 'Cluster disabled';
-      label_colors_normalinput      = 'Input normal';
-      label_colors_selectedinput    = 'Input selected';
-      label_colors_inputarrow       = 'Input arrow';
-      label_colors_historybutton    = 'History button';
-      label_colors_historysides     = 'History sides';
-      label_colors_historybarpage   = 'History bar page';
-      label_colors_historybaricon   = 'History bar icons';
-      label_colors_normallist       = 'List normal';
-      label_colors_selectedlist     = 'List selected';
-      label_colors_focusedlist      = 'List focused';
-      label_colors_listdivider      = 'List divider';
-      label_colors_infopane         = 'Information pane';
-
-type
-  TColorSel = (csBackground, csForeground);
-
-  PColorItem = ^TColorItem;
-  TColorItem = record
-    Name: PString;
-    Index: Byte;
-    Next: PColorItem;
-  end;
-
-  PColorGroup = ^TColorGroup;
-  TColorGroup = record
-    Name: PString;
-    Index: Byte;
-    Items: PColorItem;
-    Next: PColorGroup;
-  end;
-
-  PColorIndex = ^TColorIndex;
-  TColorIndex = record
-    GroupIndex: Byte;
-    ColorSize: Byte;
-    ColorIndex: array[0 .. 255] of Byte;
-  end;
-
-  PColorGroupList = ^TColorGroupList;
-  TColorGroupList = object(TListViewer)
-    Groups: PColorGroup;
-    constructor Init(var Bounds: TRect; AScrollBar: PScrollBar; AGroups: PColorGroup);
-    constructor Load(var S: TStream);
-    procedure Store(var S: TStream);
-    procedure FocusItem(Item: Sw_Integer); virtual;
-    function GetText(Item: Sw_Integer; MaxLen: Sw_Integer): String; virtual;
-    procedure HandleEvent(var Event: TEvent); virtual;
-    procedure SetGroupIndex(GroupNum, ItemNum: Byte);
-    function GetGroup(GroupNum: Byte): PColorGroup;
-    function GetGroupIndex(GroupNum: Byte): Byte;
-    function GetNumGroups: byte;
-    destructor Done; Virtual;
-  end;
-
-  PColorItemList = ^TColorItemList;
-  TColorItemList = object(TListViewer)
-    Items: PColorItem;
-    constructor Init(var Bounds: TRect; AScrollBar: PScrollBar; AItems: PColorItem);
-    procedure FocusItem(Item: Sw_Integer); virtual;
-    function GetText(Item: Sw_Integer; MaxLen: Sw_Integer): String; virtual;
-    procedure HandleEvent(var Event: TEvent); virtual;
-    procedure SetItems(AItems: PColorItem);
-    function GetColorIndex(Item: Sw_integer): Sw_integer;
-  end;
-
-  PColorSelector = ^TColorSelector;
-  TColorSelector = object(TView)
-    Color: Byte;
-    SelType: TColorSel;
-    constructor Init(var Bounds: TRect; ASelType: TColorSel);
-    constructor Load(var S: TStream);
-    procedure Store(var S: TStream);
-    procedure HandleEvent(var Event: TEvent); virtual;
-    procedure Draw; Virtual;
-  end;
-
-  PColorDisplay = ^TColorDisplay;
-  TColorDisplay = object(TView)
-    Color: PByte;
-    Text: PString;
-    constructor Init(var Bounds: TRect; AText: PString);
-    constructor Load(var S: TStream);
-    procedure Store(var S: TStream);
-    procedure HandleEvent(var Event: TEvent); virtual;
-    procedure SetColor(var AColor: Byte); virtual;
-    procedure Draw; Virtual;
-    destructor Done; Virtual;
-  end;
-
-  PColorDialog = ^TColorDialog;
-  TColorDialog = object(TDialog)
-    BakLabel: PLabel;
-    BakSel: PColorSelector;
-    ForLabel: PLabel;
-    ForSel: PColorSelector;
-    Groups: PColorGroupList;
-    GroupIndex: Byte;
-    Items: PColorItemList;
-    Display: PColorDisplay;
-    Pal: TPalette;
-    constructor Init(APalette: TPalette; AGroups: PColorGroup);
-    constructor Load(var S: TStream);
-    procedure Store(var S: TStream);
-    procedure HandleEvent (var Event: TEvent); virtual;
-    function DataSize: sw_word; virtual;
-    procedure GetData (var Rec); virtual;
-    procedure SetData (var Rec); virtual;
-    {procedure GetIndexes (var Colors: PColorIndex);
-    procedure SetIndexes (var Colors: PColorIndex);}
-    private
-    procedure ItemChanged;
-  end;
-
-
-const ColorIndexes : PColorIndex = nil;
-
-procedure RegisterColorsel;
-
-function ColorGroup(Name: string; Items: PColorItem; Next: PColorGroup): PColorGroup;
-function ColorItem(Name: string; Index: Byte; Next: PColorItem): PColorItem;
-
-procedure LoadIndexes(var S: TStream);
-procedure StoreIndexes(var S: TStream);
-
-function WindowColorItems (Palette: Sw_Word; const Next: PColorItem): PColorItem;
-function DialogColorItems (Palette: Sw_Word; const Next: PColorItem): PColorItem;
-function MenuColorItems(const Next: PColorItem): PColorItem;
-function DesktopColorItems(const Next: PColorItem): PColorItem;
-
-
-{--------------------------------------------------------------------}
-{                      implementation                                }
-{--------------------------------------------------------------------}
-implementation
-
-const
-  RColorItemList: TStreamRec = (
-     ObjType: idColorItemList;
-     VmtLink: Ofs(TypeOf(TColorItemList)^);
-     Load:    @TColorItemList.Load;
-     Store:   @TColorItemList.Store
-  );
-  RColorGroupList: TStreamRec = (
-     ObjType: idColorGroupList;
-     VmtLink: Ofs(TypeOf(TColorGroupList)^);
-     Load:    @TColorGroupList.Load;
-     Store:   @TColorGroupList.Store
-  );
-  RColorSelector: TStreamRec = (
-     ObjType: idColorSelector;
-     VmtLink: Ofs(TypeOf(TColorSelector)^);
-     Load:    @TColorSelector.Load;
-     Store:   @TColorSelector.Store
-  );
-  RColorDisplay: TStreamRec = (
-     ObjType: idColorDisplay;
-     VmtLink: Ofs(TypeOf(TColorDisplay)^);
-     Load:    @TColorDisplay.Load;
-     Store:   @TColorDisplay.Store
-  );
-  RColorDialog: TStreamRec = (
-     ObjType: idColorDialog;
-     VmtLink: Ofs(TypeOf(TColorDialog)^);
-     Load:    @TColorDialog.Load;
-     Store:   @TColorDialog.Store
-  );
-
-procedure RegisterColorsel;
-begin
- // according to help should register TColorSelector,     TMonoSelector, TColorDisplay, TColorGroupList, TColorItemList,     TColorDialog
- // probably don't bother with the mono variants. Except for (P/T)colordialog, these don't grep in FV/IDE src.
-
- // TColorSelector -> the square colorselection widget (instantiated twice once for front, once for back?)
- // TColorGrouplist-> the selection of the color group (left list)  (TListbox or whatever the TV eq is?)
- // TColorItemList -> the selection of the color identifier (right list)  (TListbox or whatever the TV eq is?)
-
- RegisterType(RColorItemList);
- RegisterType(RColorGroupList);
- RegisterType(RColorSelector);
- RegisterType(RColorDisplay);
- RegisterType(RColorDialog);
-end;
-
-
-function ColorGroup(Name: string; Items: PColorItem; Next: PColorGroup): PColorGroup;
-var
-  R: PColorGroup;
-begin
-  New(R);
-  R^.Name := NewStr(Name);
-  R^.Items := Items;
-  R^.Next := Next;
-  ColorGroup := R;
-end;
-
-function ColorItem(Name: string; Index: Byte; Next: PColorItem): PColorItem;
-var R: PColorItem;
-begin
-  New(R);
-  R^.Name := NewStr(Name);
-  R^.Index := Index;
-  R^.Next := Next;
-  ColorItem := R
-end;
-
-procedure LoadIndexes(var S: TStream);
-var A: TColorIndex;
-begin
-  fillchar(A,sizeof(A),0);
-  S.Read(A.GroupIndex, SizeOf(A.GroupIndex));
-  S.Read(A.ColorSize, SizeOf(A.ColorSize));
-  if A.ColorSize > 0 then
-    S.Read(A.ColorIndex, SizeOf(A.ColorSize));
-  if ColorIndexes<>nil then ColorIndexes^:=A;
-end;
-
-procedure StoreIndexes(var S: TStream);
-var A: TColorIndex;
-begin
-  fillchar(A,sizeof(A),0);
-  if ColorIndexes<>nil then A:=ColorIndexes^;
-  S.Write(A.GroupIndex, SizeOf(A.GroupIndex));
-  S.Write(A.ColorSize, SizeOf(A.ColorSize));
-  if A.ColorSize>0 then
-    S.Write(A.ColorIndex, SizeOf(A.ColorSize));
-end;
-
-{--------------------------------------------------------------------}
-{                      TColorSelector                                }
-{--------------------------------------------------------------------}
-
-constructor TColorSelector.Init(var Bounds: TRect; ASelType: TColorSel);
-begin
-  inherited init(Bounds);
-  Options:=Options or ofSelectable or ofFirstClick or ofFramed;
-  EventMask := EventMask OR evBroadcast;
-  SelType:=ASelType;
-end;
-
-constructor TColorSelector.Load(var S: TStream);
-begin
-  inherited Load(S);
-  S.Read(Color, SizeOf(Color));
-  S.Read(SelType, SizeOf(SelType));
-end;
-
-procedure TColorSelector.Store(var S: TStream);
-begin
-  inherited Store(S);
-  S.Write(Color, SizeOf(Color));
-  S.Write(SelType, SizeOf(SelType));
-end;
-
-procedure TColorSelector.HandleEvent(var Event: TEvent);
-var newColor,oldColor : sw_integer;
-   sColor : byte;
-   NeedClear : boolean;
-   Mouse: TPoint;
-   Mx : sw_integer;
-   n15, n11, n16 : sw_integer;
-begin
-  inherited HandleEvent(Event);
-  NeedClear:=false;
-  oldColor:=Color;
-  newColor:=Color;
-  Case Event.What Of
-    evKeyDown: Begin                                 { Key down event }
-      NeedClear:=true;
-      n15:=15; n11:=11; n16:=16;
-      if (SelType = csBackground) then
-      begin
-        n15:=7; n11:=3; n16:=8;
-      end;
-      Case CtrlToArrow(Event.KeyCode) Of
-         kbUp: begin
-           newColor:=newColor-4;
-           if newColor<0 then
-           begin
-              newColor:=(newColor+n15) ;
-              if NewColor=n11 then NewColor:=n15;
-           end;
-         end;
-         kbDown: begin
-           newColor:=newColor+4;
-           if newColor>=n16 then
-           begin
-             newColor:=(newColor+1) - n16;
-             if newColor=4 then newColor:=0;
-           end;
-         end;
-         kbRight: begin newColor:=newColor+1; if newColor>=n16 then newColor:=0; end;
-         kbLeft: begin newColor:=newColor-1; if newColor=-1 then newColor:=n15; end;
-      otherwise
-        NeedClear:=false;
-      end;
-    end;
-    evMouseDown: Begin                               { Mouse down event }
-      if (Event.Buttons=mbLeftButton ) and MouseInView(Event.Where) Then
-      begin
-        NeedClear:=true;
-        MakeLocal(Event.Where, Mouse);               { Localize mouse }
-        mx:=Mouse.X;
-        if (mx>=0) and (mx<=12) then
-          if ((Mouse.Y >= 0) and (Mouse.Y <= 3) and (SelType = csForeground))
-          or ((Mouse.Y >= 0) and (Mouse.Y <= 1) and (SelType = csBackground)) then
-          begin
-            mx:=mx div 3;
-            newColor:=(Mouse.Y)*4+mx;
-         end;
-      end;
-    end;
-    evBroadcast: Begin                               { Broadcast event }
-      case Event.Command of
-        cmColorSet:begin
-          if SelType = csForeground then
-            sColor:= Event.InfoByte and $0f
-          else
-            sColor:= (Event.InfoByte shr 4) and $0f;
-          if Color<>sColor then
-          begin
-            Color:=sColor;
-            DrawView;
-          end;
-        end;
-      end;
-    End;
-  end;
-  if NeedClear then
-    ClearEvent(Event);
-  if oldColor<>newColor then
-  begin
-    Color:=newColor;
-    if SelType = csForeground then          {intended type cast byte to pointer}
-      Message(Owner, evBroadcast, cmColorForegroundChanged, pointer(byte(Color)))
-    else
-      Message(Owner, evBroadcast, cmColorBackgroundChanged, pointer(byte(Color)));
-    Owner^.DrawView;
-  end;
-end;
-
-procedure TColorSelector.Draw;
-var
-  FrameColor : Byte;
-  SelColor,CurColor : Byte;
-  Frame : AnsiChar;
-  B     : TDrawBuffer;
-
-procedure DrawColorLine (LineNr : sw_word);
-var k: sw_integer;
-begin
-  for k:=0 to 3 do
-  begin
-    MoveChar (B[0+k*3], #219, SelColor, 3);
-    if CurColor = Color then
-    begin
-      if ((k = 0) or (k = 1)) and (CurColor<2) then
-        SelColor:=SelColor or $70
-      else
-        SelColor:=SelColor and $f;
-      MoveChar (B[0+k*3+1], #8, SelColor, 1);
-      SelColor:=SelColor or $10;
-      SelColor:=SelColor and $1f;
-    end;
-    inc(CurColor);
-    inc(SelColor,1);
-  end;
-  WriteBuf (0, LineNr, Size.X, 1, B);
-end;
-
-begin
-  FrameColor := GetColor (2);
-  MoveChar (B, ' ', FrameColor, Size.X);
-  SelColor:=$10;
-  CurColor:=0;
-  DrawColorLine(0);
-  DrawColorLine(1);
-  if SelType = csForeground then
-  begin
-    DrawColorLine(2);
-    DrawColorLine(3);
-  end;
-end;
-
-{--------------------------------------------------------------------}
-{                      TColorDisplay                                 }
-{--------------------------------------------------------------------}
-
-constructor TColorDisplay.Init(var Bounds: TRect; AText: PString);
-begin
-  inherited init(Bounds);
-  EventMask := EventMask OR evBroadcast;
-  Text:=AText;
-end;
-
-constructor TColorDisplay.Load(var S: TStream);
-begin
-  inherited Load(S);
-  if not Assigned(Color) then
-    GetMem(Color,1);
-  S.Read(Color^, SizeOf(Color^));
-  Text:=S.ReadStr;
-end;
-
-procedure TColorDisplay.Store(var S: TStream);
-var vColor : byte;
-begin
-  inherited Store(S);
-  vColor:=0;
-  if Assigned(Color) then vColor:=Color^;
-  S.Write(vColor, SizeOf(vColor));
-  S.WriteStr(Text);
-end;
-
-procedure TColorDisplay.HandleEvent(var Event: TEvent);
-begin
-  inherited HandleEvent(Event);
-  Case Event.What Of
-    evBroadcast:                                { Broadcast event }
-      case Event.Command of
-        cmColorForegroundChanged:if assigned(Color) then begin
-          Color^:=(Color^ and  $f0) or (Event.InfoByte and $0f);
-          DrawView;
-          ClearEvent(Event);                             { Event was handled }
-        end;
-        cmColorBackgroundChanged:if assigned(Color) then begin
-          Color^:= (Color^ and $0f) or((Event.InfoByte shl 4) and $f0);
-          DrawView;
-          ClearEvent(Event);                             { Event was handled }
-        end;
-      end;
-  end;
-end;
-
-procedure TColorDisplay.SetColor(var AColor: Byte);
-begin
-  Color:=@AColor;
-  Message(Owner, evBroadcast, cmColorSet, pointer(byte(Color^))); {intended type cast byte to pointer}
-  DrawView;
-end;
-
-procedure TColorDisplay.Draw;
-var
-  FColor : Byte;
-  Y      : sw_integer;
-  S      : String;
-  B      : TDrawBuffer;
-begin
-  if Assigned(Color) then
-  begin
-    FColor:=Color^;
-    if FColor = 0 then
-       FColor:=128;
-  end else
-    FColor := GetColor (2);
-  MoveChar (B, ' ', FColor, Size.X);
-  if Assigned(Text) then
-    S:=Text^
-  else
-    S:='';
-  if length(S) < Size.X then
-    MoveStr (B[(Size.X-length(S)) div 2], S, FColor)
-  else
-    MoveStr (B, S, FColor);
-  if Size.Y > 0 then
-    for Y :=0 to Size.Y-1 do
-    begin
-      WriteBuf (0, Y, Size.X, 1, B);
-    end;
-end;
-
-destructor TColorDisplay.Done;
-begin
-  if assigned(Text) then
-  begin
-    Dispose(Text);
-    Text:=nil;
-  end;
-  inherited Done;
-end;
-
-{--------------------------------------------------------------------}
-{                      TColorGroupList                               }
-{--------------------------------------------------------------------}
-
-constructor TColorGroupList.Init(var Bounds: TRect; AScrollBar: PScrollBar; AGroups: PColorGroup);
-var
-  x: PColorGroup;
-begin
-  inherited Init(Bounds, 1, nil, AScrollBar);
-  EventMask := EventMask OR evBroadcast;
-  Range := 0;
-  Groups := AGroups;
-  x := AGroups;
-  while Assigned(x) do begin
-    x^.Index:=0;
-    Inc(Range);
-    x := x^.Next
-  end;
-  SetRange(Range);
-end;
-
-constructor TColorGroupList.Load(var S: TStream);
-var x,z: PColorGroup;
-  R,Q: PColorItem;
-  num,numItems,iG,iI : word;
-begin
-  inherited Load(S);
-  S.Read(num, SizeOf(num));
-  Groups:=nil;
-  { read PColorGroup linked list }
-  z:=nil;
-  for iG:=1 to num do
-  begin
-    S.Read(numItems, SizeOf(numItems));
-    new(x);
-    x^.Items:=nil;
-    Q:=nil;
-    {read items}
-    for iI:=1 to numItems do
-    begin
-      New(R);
-      R^.Name:=S.ReadStr;
-      S.Read(R^.Index, SizeOf(R^.Index));
-      R^.Next:=nil;
-      if assigned(Q) then
-        Q^.Next:=R;
-      Q:=R;
-      if iI=1 then x^.Items:=R;
-    end;
-    {read group}
-    x^.Name:=S.ReadStr;
-    S.Read(x^.Index, SizeOf(x^.Index));
-    x^.Next:=nil;
-    if assigned(z) then
-      z^.Next:=x;
-    z:=x;
-    if iG = 1 then
-      Groups:=x; { Group starts with first entry }
-  end;
-end;
-
-procedure TColorGroupList.Store(var S: TStream);
-var x,z: PColorGroup;
-  R,Q: PColorItem;
-  num,numItems : word;
-begin
-  inherited Store(S);
-  num:=GetNumGroups;
-  S.Write(num,Sizeof(num));
-  x := Groups;
-  {Write PColorGroup linked list}
-  while Assigned(x) do begin
-    R:=x^.Items;
-    {count items}
-    Q:=R;
-    numItems:=0;
-    while Assigned(Q) do begin
-      inc(numItems);
-      Q:=Q^.Next;
-    end;
-    S.Write(numItems,Sizeof(numItems)); {  write Item count }
-    {write items}
-    while Assigned(R) do begin
-      S.WriteStr(R^.Name);
-      S.Write(R^.Index,Sizeof(R^.Index));
-      R := R^.Next;
-    end;
-    {write gropu}
-    S.WriteStr(x^.Name);
-    S.Write(x^.Index,Sizeof(x^.Index));
-    x := x^.Next;
-  end;
-end;
-
-procedure TColorGroupList.FocusItem(Item: Sw_Integer);
-var oFocus : sw_integer;
-begin
-  oFocus:=Focused;
-  inherited FocusItem(Item);
-  if Item < Range then
-  begin
-    if oFocus<>Focused then
-      Message(Owner, evBroadcast, cmNewColorItem, @Self);{ Send message }
-  end;
-end;
-
-function TColorGroupList.GetText(Item: Sw_Integer; MaxLen: Sw_Integer): String;
-var x: PColorGroup;
-    Num : sw_integer;
-begin
-  GetText:='';
-  x := Groups;
-  Num:=0;
-  while Assigned(x) do begin
-    if Num = Item then
-    begin
-      GetText:=x^.Name^;
-      exit;
-    end;
-    inc(Num);
-    x := x^.Next;
-  end;
-end;
-
-procedure TColorGroupList.HandleEvent(var Event: TEvent);
-begin
-  inherited HandleEvent(Event);
-  Case Event.What Of
-    evBroadcast:                                { Broadcast event }
-      case Event.Command of
-        cmSaveColorIndex: begin
-          SetGroupIndex(Focused,Event.InfoByte);
-          ClearEvent(Event);                    { Event was handled }
-        end;
-      end;
-  end;
-end;
-
-procedure TColorGroupList.SetGroupIndex(GroupNum, ItemNum: Byte);
-var x: PColorGroup;
-begin
-  x:=GetGroup(GroupNum);
-  if Assigned(x) then
-    x^.Index:=ItemNum;
-end;
-
-function TColorGroupList.GetGroup(GroupNum: Byte): PColorGroup;
-var x: PColorGroup;
-    Num : sw_integer;
-begin
-  GetGroup:=nil;
-  x := Groups;
-  Num:=0;
-  while Assigned(x) do begin
-    if Num = GroupNum then
-    begin
-      GetGroup:=x;
-      exit;
-    end;
-    inc(Num);
-    x := x^.Next;
-  end;
-end;
-
-function TColorGroupList.GetGroupIndex(GroupNum: Byte): Byte;
-var x: PColorGroup;
-begin
-  GetGroupIndex:=0;
-  x:=GetGroup(GroupNum);
-  if Assigned(x) then
-    GetGroupIndex:=x^.Index;
-end;
-
-function TColorGroupList.GetNumGroups: byte;
-var x: PColorGroup;
-    Num : sw_integer;
-begin
-  x := Groups;
-  Num:=0;
-  while Assigned(x) do begin
-    inc(Num);
-    x := x^.Next;
-  end;
-  GetNumGroups:=Num;
-end;
-
-destructor TColorGroupList.Done;
-var x,z: PColorGroup;
-  R,Q: PColorItem;
-begin
-  x := Groups;
-  inherited Done;
-  Groups:=nil;
-  {Disopse PColorGroup linked list}
-  while Assigned(x) do begin
-    R:=x^.Items;
-    while Assigned(R) do begin
-      Dispose(R^.Name);
-      Q:=R;
-      R := R^.Next;
-      Dispose(Q);
-    end;
-    Dispose(x^.Name);
-    z:=x;
-    x := x^.Next;
-    Dispose(z);
-  end;
-end;
-
-{--------------------------------------------------------------------}
-{                      TColorItemList                                }
-{--------------------------------------------------------------------}
-
-constructor TColorItemList.Init(var Bounds: TRect; AScrollBar: PScrollBar; AItems: PColorItem);
-begin
-  inherited Init(Bounds, 1, nil, AScrollBar);
-  EventMask := EventMask OR evBroadcast;
-  SetItems(AItems);
-end;
-
-procedure TColorItemList.FocusItem(Item: Sw_Integer);
-var oFocus:sw_integer;
-begin
-  oFocus:=Focused;
-  inherited FocusItem(Item);
-  if Item < Range then
-  begin
-    if oFocus<>Focused then
-    begin
-      {one for TColorGroupList and other for TColorDialog }
-      Message(Owner, evBroadcast, cmSaveColorIndex, pointer(byte(Focused)));{intended type cast byte to pointer}
-      Message(Owner, evBroadcast, cmNewColorIndex, @Self);{ Send message }
-    end;
-  end;
-end;
-
-function TColorItemList.GetText(Item: Sw_Integer; MaxLen: Sw_Integer): String;
-var count : sw_integer;
-    x :PColorItem;
-begin
-  GetText:= '';
-  count:=0;
-  if Assigned(Items) then
-  begin
-    x:=Items;
-    while Assigned(x) do
-    begin
-      if count=Item then
-      begin
-        GetText:=x^.Name^;
-        {SetLength(GetText,Min(Length(GetText),MaxLen));}
-        exit;
-      end;
-      inc(count);
-      x:=x^.Next;
-    end;
-  end;
-end;
-
-procedure TColorItemList.HandleEvent(var Event: TEvent);
-var Groups : PColorGroupList;
-    x:PColorGroup;
-    GroupIndex,ItemIndex:sw_integer;
-begin
-  inherited HandleEvent(Event);
-  Case Event.What Of
-    evBroadcast: Begin                               { Broadcast event }
-      case Event.Command of
-        cmNewColorItem: begin
-          Groups:=PColorGroupList(Event.Infoptr);
-          GroupIndex:=Groups^.Focused;
-          ItemIndex:=Groups^.GetGroupIndex(GroupIndex);
-          x:=Groups^.GetGroup(GroupIndex);
-          if assigned(x) then
-            SetItems(x^.Items)
-          else SetItems(nil);
-          FocusItem(ItemIndex);
-          DrawView;
-          ClearEvent(Event);                             { Event was handled }
-        end;
-      end;
-    end;
-  end;
-end;
-
-procedure TColorItemList.SetItems(AItems: PColorItem);
-var count : sw_integer;
-    x :PColorItem;
-begin
-  Items:=AItems;
-  Focused:=-1;
-  count:=0;
-    x:=Items;
-    while Assigned(x) do
-    begin
-      inc(count);
-      x:=x^.Next;
-    end;
-  SetRange(count);
-end;
-
-function TColorItemList.GetColorIndex(Item: Sw_integer): Sw_integer;
-var count : sw_integer;
-    x :PColorItem;
-begin
-  GetColorIndex:=0;
-  count:=0;
-  if Assigned(Items) then
-  begin
-    x:=Items;
-    while Assigned(x) do
-    begin
-      if count=Item then
-      begin
-        GetColorIndex:=x^.Index;
-        exit;
-      end;
-      inc(count);
-      x:=x^.Next;
-    end;
-  end;
-end;
-
-{--------------------------------------------------------------------}
-{                      TColorDialog                                  }
-{--------------------------------------------------------------------}
-
-constructor TColorDialog.Init(APalette: TPalette; AGroups: PColorGroup);
-var
-  R,R2: TRect;
-  OkButton,CancelButton : PButton;
-  VScrollBar: PScrollBar;
-  x:PColorGroup;
-  xItems: PColorItem;
-begin
-  R.Assign(0, 0, 62, 19);
-  inherited Init(R, dialog_colorsel_colors);
-  Options := Options or ofCentered;
-  EventMask := EventMask OR evBroadcast;             { Set event mask }
-  Pal := APalette;
-  {-- Groups list --}
-  R.Assign(3, 3, 18, 15);
-  R2.Copy(R); R2.A.X:=R2.B.X; Inc(R2.B.X);
-  VScrollBar := New(PScrollBar, Init(R2));
-  Insert(VScrollBar);
-  Groups := New(PColorGroupList, Init(R, VScrollBar, AGroups));
-  Insert(Groups);
-  R2.Copy(R); Dec(R2.A.Y); R2.B.Y:=R2.A.Y+1;
-  Insert(New(PLabel, Init(R2, label_colorsel_group, Groups)));
-  {-- Item list --}
-  GroupIndex:=Groups^.Focused;
-  x:=Groups^.GetGroup(GroupIndex);
-  if assigned(x) then
-    xItems:=x^.Items
-  else xItems:=nil;
-  R.Assign(21, 3, 42, 15);
-  R2.Copy(R); R2.A.X:=R2.B.X; Inc(R2.B.X);
-  VScrollBar := New(PScrollBar, Init(R2));
-  Insert(VScrollBar);
-  Items := New(PColorItemList, Init(R, VScrollBar,xItems));
-  Insert(Items);
-  R2.Copy(R); Dec(R2.A.Y); R2.B.Y:=R2.A.Y+1;
-  Insert(New(PLabel, Init(R2, label_colorsel_item, Items)));
-  {-- Color selector foreground --}
-  R.Assign(46, 3, 58, 7);
-  R2.Copy(R); R2.B.Y:=R2.A.Y; Dec(R2.A.Y);
-  ForSel:=New(PColorSelector, Init(R, csForeground));
-  ForLabel:=New(PLabel, Init(R2, label_colorsel_foreground, ForSel));
-  Insert(ForSel);
-  Insert(ForLabel);
-  {-- Color selector background --}
-  R.Assign(46, 9, 58, 11);
-  R2.Copy(R); R2.B.Y:=R2.A.Y; Dec(R2.A.Y);
-  BakSel:=New(PColorSelector, Init(R, csBackground));
-  BakLabel:=New(PLabel, Init(R2, label_colorsel_background, BakSel));
-  Insert(BakSel);
-  Insert(BakLabel);
-  {-- Color Display --}
-  R.Assign(45, 12, 59, 15);
-  Display:=New(PColorDisplay,Init(R,NewStr(label_colorsel_displaytext)));
-  Insert(Display);
-  {-- Buttons --}
-  R.Assign(37, 16, 47, 18);
-  OkButton := New(PButton, Init(R, slOk, cmOK, bfDefault));
-  Insert(OkButton);
-  Inc(R.A.X,12); Inc(R.B.X,12);
-  CancelButton := New(PButton, Init(R, slCancel, cmCancel, bfDefault));
-  Insert(CancelButton);
-  {--set focus--}
-  Items^.FocusItem(0);
-  SelectNext(False);
-end;
-
-constructor TColorDialog.Load(var S: TStream);
-begin
-  if not TDialog.Load(S) then
-    Fail;
-  S.Read(GroupIndex, SizeOf(GroupIndex));
-  S.Read(Pal, SizeOf(Pal));
-  if (S.Status <> stOk) then
-  begin
-    TDialog.Done;
-    Fail;
-  end;
-  GetSubViewPtr(S,BakLabel);
-  GetSubViewPtr(S,BakSel);
-  GetSubViewPtr(S,ForLabel);
-  GetSubViewPtr(S,ForSel);
-  GetSubViewPtr(S,Groups);
-  GetSubViewPtr(S,Items);
-  GetSubViewPtr(S,Display);
-  if assigned(Items) then
-    if assigned(Groups) then
-      Items^.Items:=Groups^.GetGroup(Groups^.Focused)^.Items;
-end;
-
-procedure TColorDialog.Store(var S: TStream);
-begin
-  inherited Store(S);
-  S.Write(GroupIndex, SizeOf(GroupIndex));
-  S.Write(Pal, SizeOf(Pal));
-  PutSubViewPtr(S,BakLabel);
-  PutSubViewPtr(S,BakSel);
-  PutSubViewPtr(S,ForLabel);
-  PutSubViewPtr(S,ForSel);
-  PutSubViewPtr(S,Groups);
-  PutSubViewPtr(S,Items);
-  PutSubViewPtr(S,Display);
-end;
-
-procedure TColorDialog.ItemChanged;
-const NoItemSelectedColor : byte = $7f;
-var ColorIndex,ItemIndex : sw_integer;
-begin
-  GroupIndex:=Groups^.Focused;
-  if Items^.Range > 0 then
-    begin
-      ItemIndex:=Items^.Focused;
-      ColorIndex:=Items^.GetColorIndex(ItemIndex);
-      Display^.SetColor(byte(Pal[ColorIndex]));
-    end
-  else
-    Display^.SetColor(NoItemSelectedColor);
-end;
-
-procedure TColorDialog.HandleEvent (var Event: TEvent);
-begin
-  inherited HandleEvent(Event);
-  Case Event.What Of
-    evBroadcast:                                     { Broadcast event }
-      case Event.Command of
-        cmNewColorIndex: begin
-          ItemChanged;
-          ClearEvent(Event);                         { Event was handled }
-        end;
-      end;
-  end;
-end;
-
-function TColorDialog.DataSize: sw_Word;
-begin
-  DataSize:=Sizeof(Pal);
-end;
-
-procedure TColorDialog.GetData (var Rec);
-begin
-  TPalette(Rec):=Pal;
-end;
-
-procedure TColorDialog.SetData (var Rec);
-begin
-  Pal:=TPalette(Rec);
-  ItemChanged;
-end;
-
-function WindowColorItems (Palette: Sw_Word; const Next: PColorItem): PColorItem;
-const
-  COffset: array[wpBlueWindow..wpGrayWindow] of Byte =
-    (8, 16, 24);
-var
-  Offset: Word;
-begin
-  //WindowColorItems:=ColorItem('Normal',12,Next); {place holder}
-  Offset := COffset[Palette];
-  WindowColorItems :=
-    ColorItem(label_colors_framepassive,     Offset + 0,
-    ColorItem(label_colors_frameactive,      Offset + 1,
-    ColorItem(label_colors_frameicon,        Offset + 2,
-    ColorItem(label_colors_scrollbarpage,    Offset + 3,
-    ColorItem(label_colors_scrollbaricons,   Offset + 4,
-    ColorItem(label_colors_normaltext,       Offset + 5,
-    Next))))));
-end;
-
-function DialogColorItems(Palette: Sw_Word; const Next: PColorItem): PColorItem;
-const
-  COffset: array[dpBlueDialog..dpGrayDialog] of Byte =
-    (64, 96, 32);
-  var
-    Offset: Byte;
-begin
-  //DialogColorItems:=ColorItem('Normal',13,Next); {place holder}
-  Offset := COffset[Palette];
-  DialogColorItems :=
-    ColorItem(label_colors_framebackground,  Offset + 1,
-    ColorItem(label_colors_frameicon,        Offset + 2,
-    ColorItem(label_colors_scrollbarpage,    Offset + 3,
-    ColorItem(label_colors_scrollbaricons,   Offset + 4,
-    ColorItem(label_colors_statictext,       Offset + 5,
-
-    ColorItem(label_colors_normallabel,      Offset + 6,
-    ColorItem(label_colors_selectedlabel,    Offset + 7,
-    ColorItem(label_colors_shortcutlabel,    Offset + 8,
-
-    ColorItem(label_colors_normalbutton,     Offset + 9,
-    ColorItem(label_colors_defaultbutton,    Offset + 10,
-    ColorItem(label_colors_selectedbutton,   Offset + 11,
-    ColorItem(label_colors_disabledbutton,   Offset + 12,
-    ColorItem(label_colors_shortcutbutton,   Offset + 13,
-    ColorItem(label_colors_buttonshadow,     Offset + 14,
-
-    ColorItem(label_colors_normalcluster,    Offset + 15,
-    ColorItem(label_colors_selectedcluster,  Offset + 16,
-    ColorItem(label_colors_shortcutcluster,  Offset + 17,
-    ColorItem(label_colors_disabledcluster,  Offset + 30,
-
-    ColorItem(label_colors_normalinput,      Offset + 18,
-    ColorItem(label_colors_selectedinput,    Offset + 19,
-    ColorItem(label_colors_inputarrow,       Offset + 20,
-
-    ColorItem(label_colors_historybutton,    Offset + 21,
-    ColorItem(label_colors_historysides,     Offset + 22,
-    ColorItem(label_colors_historybarpage,   Offset + 23,
-    ColorItem(label_colors_historybaricon,   Offset + 24,
-
-    ColorItem(label_colors_normallist,       Offset + 25,
-    ColorItem(label_colors_selectedlist,     Offset + 26,
-    ColorItem(label_colors_focusedlist,      Offset + 27,
-    ColorItem(label_colors_listdivider,      Offset + 28,
-
-    ColorItem(label_colors_infopane,         Offset + 29,
-    Next))))))))))))))))))))))))))))));
-end;
-
-function MenuColorItems(const Next: PColorItem): PColorItem;
-begin
-  MenuColorItems :=
-    ColorItem(label_colors_normal,2,
-    ColorItem(label_colors_disabled,3,
-    ColorItem(label_colors_shortcut,4,
-    ColorItem(label_colors_selected,5,
-    ColorItem(label_colors_selecteddisabled, 6,
-    ColorItem(label_colors_shortcutselected, 7,
-    Next)))))) ;
-end;
-
-function DesktopColorItems(const Next: PColorItem): PColorItem;
-begin
-  DesktopColorItems := ColorItem(label_colors_color,1,Next);
-end;
-
-end.
-
-{
-
-fvconsts.pas:  idColorSelector = 92;
-fvconsts.pas:  idMonoSelector = 93;
-
-}
+{$I colorsel.inc}

+ 153 - 0
packages/fv/src/colortxt.inc

@@ -0,0 +1,153 @@
+{$IFNDEF FPC_DOTTEDUNITS}
+unit ColorTxt;
+{$ENDIF FPC_DOTTEDUNITS}
+{
+    This file is part of the Free Vision package
+
+    Copyright (c) 1999-2022 by Peter Vreman
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{
+  TColoredText is a descendent of TStaticText designed to allow the writing
+  of colored text when color monitors are used.  With a monochrome or BW
+  monitor, TColoredText acts the same as TStaticText.
+
+  TColoredText is used in exactly the same way as TStaticText except that
+  the constructor has an extra Byte parameter specifying the attribute
+  desired.  (Do not use a 0 attribute, black on black).
+}
+
+{$i platform.inc}
+
+{$ifdef PPC_FPC}
+  {$H-}
+{$else}
+  {$F+,O+,E+,N+}
+{$endif}
+{$X+,R-,I-,Q-,V-}
+{$ifndef OS_UNIX}
+  {$S-}
+{$endif}
+
+interface
+
+{$IFDEF FPC_DOTTEDUNITS}
+uses
+  System.Objects, FreeVision.Drivers, FreeVision.Views, FreeVision.Dialogs, FreeVision.App, FreeVision.Fvconsts;
+{$ELSE FPC_DOTTEDUNITS}
+uses
+  objects, drivers, views, dialogs, app, fvconsts;
+{$ENDIF FPC_DOTTEDUNITS}
+
+type
+  PColoredText = ^TColoredText;
+  TColoredText = object(TStaticText)
+    Attr : Byte;
+    constructor Init(var Bounds: TRect; const AText: String; Attribute : Byte);
+    constructor Load(var S: TStream);
+    function GetTheColor : byte; virtual;
+    procedure Draw; virtual;
+    procedure Store(var S: TStream);
+  end;
+
+const
+  RColoredText: TStreamRec = (
+     ObjType: idColoredText;
+     VmtLink: Ofs(TypeOf(TColoredText)^);
+     Load:    @TColoredText.Load;
+     Store:   @TColoredText.Store
+  );
+
+implementation
+
+constructor TColoredText.Init(var Bounds: TRect; const AText: String;
+                                  Attribute : Byte);
+begin
+TStaticText.Init(Bounds, AText);
+Attr := Attribute;
+end;
+
+constructor TColoredText.Load(var S: TStream);
+begin
+TStaticText.Load(S);
+S.Read(Attr, Sizeof(Attr));
+end;
+
+procedure TColoredText.Store(var S: TStream);
+begin
+TStaticText.Store(S);
+S.Write(Attr, Sizeof(Attr));
+end;
+
+function TColoredText.GetTheColor : byte;
+begin
+if AppPalette = apColor then
+  GetTheColor := Attr
+else
+  GetTheColor := GetColor(1);
+end;
+
+procedure TColoredText.Draw;
+var
+  Color: Byte;
+  Center: Boolean;
+  I, J, L, P, Y: Sw_Integer;
+  B: TDrawBuffer;
+  S: String;
+begin
+  Color := GetTheColor;
+  GetText(S);
+  L := Length(S);
+  P := 1;
+  Y := 0;
+  Center := False;
+  while Y < Size.Y do
+  begin
+    MoveChar(B, ' ', Color, Size.X);
+    if P <= L then
+    begin
+      if S[P] = #3 then
+      begin
+        Center := True;
+        Inc(P);
+      end;
+      I := P;
+      repeat
+        J := P;
+        while (P <= L) and (S[P] = ' ') do Inc(P);
+        while (P <= L) and (S[P] <> ' ') and ((S[P] <> #13) and (S[P] <> #10)) do Inc(P);
+      until (P > L) or (P >= I + Size.X) or ((S[P] = #13) or (S[P] = #10));  { line ending #13 or #10 }
+      if P > I + Size.X then
+        if J > I then P := J else P := I + Size.X;
+      if Center then J := (Size.X - P + I) div 2 else J := 0;
+      MoveBuf(B[J], S[I], Color, P - I);
+      while (P <= L) and (S[P] = ' ') do Inc(P);
+      if (P <= L) and ((S[P] = #13) or (S[P] = #10)) then
+      begin
+        Center := False;
+        if (S[P] = #13) then
+        begin
+          Inc(P);
+          if (P <= L) and (S[P] = #10) then Inc(P);  { line ending #13#10 }
+        end else
+        begin
+          Inc(P);
+          if (P <= L) and (S[P] = #13) then Inc(P);  { line ending #10#13 }
+        end;
+      end;
+    end;
+    WriteLine(0, Y, Size.X, 1, B);
+    Inc(Y);
+  end;
+end;
+
+
+end.

+ 1 - 153
packages/fv/src/colortxt.pas

@@ -1,153 +1 @@
-{$IFNDEF FPC_DOTTEDUNITS}
-unit ColorTxt;
-{$ENDIF FPC_DOTTEDUNITS}
-{
-    This file is part of the Free Vision package
-
-    Copyright (c) 1999-2022 by Peter Vreman
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
-{
-  TColoredText is a descendent of TStaticText designed to allow the writing
-  of colored text when color monitors are used.  With a monochrome or BW
-  monitor, TColoredText acts the same as TStaticText.
-
-  TColoredText is used in exactly the same way as TStaticText except that
-  the constructor has an extra Byte parameter specifying the attribute
-  desired.  (Do not use a 0 attribute, black on black).
-}
-
-{$i platform.inc}
-
-{$ifdef PPC_FPC}
-  {$H-}
-{$else}
-  {$F+,O+,E+,N+}
-{$endif}
-{$X+,R-,I-,Q-,V-}
-{$ifndef OS_UNIX}
-  {$S-}
-{$endif}
-
-interface
-
-{$IFDEF FPC_DOTTEDUNITS}
-uses
-  System.Objects, FreeVision.Drivers, FreeVision.Views, FreeVision.Dialogs, FreeVision.App, FreeVision.Fvconsts;
-{$ELSE FPC_DOTTEDUNITS}
-uses
-  objects, drivers, views, dialogs, app, fvconsts;
-{$ENDIF FPC_DOTTEDUNITS}
-
-type
-  PColoredText = ^TColoredText;
-  TColoredText = object(TStaticText)
-    Attr : Byte;
-    constructor Init(var Bounds: TRect; const AText: String; Attribute : Byte);
-    constructor Load(var S: TStream);
-    function GetTheColor : byte; virtual;
-    procedure Draw; virtual;
-    procedure Store(var S: TStream);
-  end;
-
-const
-  RColoredText: TStreamRec = (
-     ObjType: idColoredText;
-     VmtLink: Ofs(TypeOf(TColoredText)^);
-     Load:    @TColoredText.Load;
-     Store:   @TColoredText.Store
-  );
-
-implementation
-
-constructor TColoredText.Init(var Bounds: TRect; const AText: String;
-                                  Attribute : Byte);
-begin
-TStaticText.Init(Bounds, AText);
-Attr := Attribute;
-end;
-
-constructor TColoredText.Load(var S: TStream);
-begin
-TStaticText.Load(S);
-S.Read(Attr, Sizeof(Attr));
-end;
-
-procedure TColoredText.Store(var S: TStream);
-begin
-TStaticText.Store(S);
-S.Write(Attr, Sizeof(Attr));
-end;
-
-function TColoredText.GetTheColor : byte;
-begin
-if AppPalette = apColor then
-  GetTheColor := Attr
-else
-  GetTheColor := GetColor(1);
-end;
-
-procedure TColoredText.Draw;
-var
-  Color: Byte;
-  Center: Boolean;
-  I, J, L, P, Y: Sw_Integer;
-  B: TDrawBuffer;
-  S: String;
-begin
-  Color := GetTheColor;
-  GetText(S);
-  L := Length(S);
-  P := 1;
-  Y := 0;
-  Center := False;
-  while Y < Size.Y do
-  begin
-    MoveChar(B, ' ', Color, Size.X);
-    if P <= L then
-    begin
-      if S[P] = #3 then
-      begin
-        Center := True;
-        Inc(P);
-      end;
-      I := P;
-      repeat
-        J := P;
-        while (P <= L) and (S[P] = ' ') do Inc(P);
-        while (P <= L) and (S[P] <> ' ') and ((S[P] <> #13) and (S[P] <> #10)) do Inc(P);
-      until (P > L) or (P >= I + Size.X) or ((S[P] = #13) or (S[P] = #10));  { line ending #13 or #10 }
-      if P > I + Size.X then
-        if J > I then P := J else P := I + Size.X;
-      if Center then J := (Size.X - P + I) div 2 else J := 0;
-      MoveBuf(B[J], S[I], Color, P - I);
-      while (P <= L) and (S[P] = ' ') do Inc(P);
-      if (P <= L) and ((S[P] = #13) or (S[P] = #10)) then
-      begin
-        Center := False;
-        if (S[P] = #13) then
-        begin
-          Inc(P);
-          if (P <= L) and (S[P] = #10) then Inc(P);  { line ending #13#10 }
-        end else
-        begin
-          Inc(P);
-          if (P <= L) and (S[P] = #13) then Inc(P);  { line ending #10#13 }
-        end;
-      end;
-    end;
-    WriteLine(0, Y, Size.X, 1, B);
-    Inc(Y);
-  end;
-end;
-
-
-end.
+{$I colortxt.inc}

+ 3868 - 0
packages/fv/src/editors.inc

@@ -0,0 +1,3868 @@
+{$IFNDEF FPC_DOTTEDUNITS}
+unit Editors;
+{$ENDIF FPC_DOTTEDUNITS}
+{
+    This file is part of the Free Vision package
+   
+    The main source editor
+
+    Copyright (c) 1999-2022 by Peter Vreman
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$i platform.inc}
+
+{$ifdef PPC_FPC}
+  {$H-}
+{$else}
+  {$F+,O+,E+,N+}
+{$endif}
+{$X+,R-,I-,Q-,V-}
+{$ifndef OS_UNIX}
+  {$S-}
+{$endif}
+
+
+{$define UNIXLF}
+
+{2.0 compatibility}
+{$ifdef VER2_0}
+  {$macro on}
+  {$define resourcestring := const}
+{$endif}
+
+interface
+
+{$IFDEF FPC_DOTTEDUNITS}
+uses
+  System.Objects, FreeVision.Drivers, FreeVision.Views, FreeVision.Dialogs,
+  FreeVision.Fvcommon, FreeVision.Fvconsts;
+{$ELSE FPC_DOTTEDUNITS}
+uses
+  Objects, Drivers,Views,Dialogs,FVCommon,FVConsts;
+{$ENDIF FPC_DOTTEDUNITS}
+
+const
+  { Length constants. }
+  Tab_Stop_Length = 74;
+
+{$ifdef BIT_16}
+  MaxLineLength  = 1024;
+  MinBufLength   = $1000;
+  MaxBufLength   = $ff00;
+  NotFoundValue  = $ffff;
+  LineInfoGrow   = 256;
+  MaxLines       = 16000;
+{$else}
+  MaxLineLength  = 4096;
+  MinBufLength   = $1000;
+  MaxBufLength   = $7fffff00;
+  NotFoundValue  = $ffffffff;
+  LineInfoGrow   = 1024;
+  MaxLines       = $7ffffff;
+{$endif}
+
+
+  { Editor constants for dialog boxes. }
+  edOutOfMemory   = 0;
+  edReadError     = 1;
+  edWriteError    = 2;
+  edCreateError   = 3;
+  edSaveModify    = 4;
+  edSaveUntitled  = 5;
+  edSaveAs        = 6;
+  edFind          = 7;
+  edSearchFailed  = 8;
+  edReplace       = 9;
+  edReplacePrompt = 10;
+
+  edJumpToLine         = 11;
+  edPasteNotPossible   = 12;
+  edReformatDocument   = 13;
+  edReformatNotAllowed = 14;
+  edReformNotPossible  = 15;
+  edReplaceNotPossible = 16;
+  edRightMargin        = 17;
+  edSetTabStops        = 18;
+  edWrapNotPossible    = 19;
+
+  { Editor flag constants for dialog options. }
+  efCaseSensitive   = $0001;
+  efWholeWordsOnly  = $0002;
+  efPromptOnReplace = $0004;
+  efReplaceAll      = $0008;
+  efDoReplace       = $0010;
+  efBackupFiles     = $0100;
+
+  { Constants for object palettes. }
+  CIndicator = #2#3;
+  CEditor    = #6#7;
+  CMemo      = #26#27;
+
+type
+  TEditorDialog = function (Dialog : SmallInt; Info : Pointer) : Word;
+
+  PIndicator = ^TIndicator;
+  TIndicator = object (TView)
+    Location   : TPoint;
+    Modified   : Boolean;
+    AutoIndent : Boolean;          { Added boolean for AutoIndent mode. }
+    WordWrap   : Boolean;          { Added boolean for WordWrap mode.   }
+    constructor Init (var Bounds : TRect);
+    procedure   Draw; virtual;
+    function    GetPalette : PPalette; virtual;
+    procedure   SetState (AState : Word; Enable : Boolean); virtual;
+    procedure   SetValue (ALocation : TPoint; IsAutoIndent : Boolean;
+                                                      IsModified   : Boolean;
+                                                      IsWordWrap   : Boolean);
+  end;
+
+  TLineInfoRec = record
+    Len,Attr : Sw_word;
+  end;
+  TLineInfoArr = array[0..MaxLines] of TLineInfoRec;
+  PLineInfoArr = ^TLineInfoArr;
+
+  PLineInfo = ^TLineInfo;
+  TLineInfo = object
+    Info : PLineInfoArr;
+    MaxPos : Sw_Word;
+    constructor Init;
+    destructor Done;
+    procedure Grow(pos:Sw_word);
+    procedure SetLen(pos,val:Sw_Word);
+    procedure SetAttr(pos,val:Sw_Word);
+    function  GetLen(pos:Sw_Word):Sw_Word;
+    function  GetAttr(pos:Sw_Word):Sw_Word;
+  end;
+
+
+  PEditBuffer = ^TEditBuffer;
+  TEditBuffer = array[0..MaxBufLength] of AnsiChar;
+
+  PEditor = ^TEditor;
+  TEditor = object (TView)
+    HScrollBar         : PScrollBar;
+    VScrollBar         : PScrollBar;
+    Indicator          : PIndicator;
+    Buffer             : PEditBuffer;
+    BufSize            : Sw_Word;
+    BufLen             : Sw_Word;
+    GapLen             : Sw_Word;
+    SelStart           : Sw_Word;
+    SelEnd             : Sw_Word;
+    CurPtr             : Sw_Word;
+    CurPos             : TPoint;
+    Delta              : TPoint;
+    Limit              : TPoint;
+    DrawLine           : Sw_Integer;
+    DrawPtr            : Sw_Word;
+    DelCount           : Sw_Word;
+    InsCount           : Sw_Word;
+    Flags              : Longint;
+    IsReadOnly         : Boolean;
+    IsValid            : Boolean;
+    CanUndo            : Boolean;
+    Modified           : Boolean;
+    Selecting          : Boolean;
+    Overwrite          : Boolean;
+    AutoIndent         : Boolean;
+    NoSelect           : Boolean;
+    TabSize            : Sw_Word; { tabsize for displaying }
+    BlankLine          : Sw_Word; { First blank line after a paragraph. }
+    Word_Wrap          : Boolean; { Added boolean to toggle wordwrap on/off. }
+    Line_Number        : string[8]; { Holds line number to jump to. }
+    Right_Margin       : Sw_Integer; { Added SmallInt to set right margin. }
+    Tab_Settings       : String[Tab_Stop_Length]; { Added string to hold tab stops. }
+
+    constructor Init (var Bounds : TRect; AHScrollBar, AVScrollBar : PScrollBar;
+                          AIndicator : PIndicator; ABufSize : Sw_Word);
+    constructor Load (var S : TStream);
+    destructor Done; virtual;
+    function   BufChar (P : Sw_Word) : AnsiChar;
+    function   BufPtr (P : Sw_Word) : Sw_Word;
+    procedure  ChangeBounds (var Bounds : TRect); virtual;
+    procedure  ConvertEvent (var Event : TEvent); virtual;
+    function   CursorVisible : Boolean;
+    procedure  DeleteSelect;
+    procedure  DoneBuffer; virtual;
+    procedure  Draw; virtual;
+    procedure  FormatLine (var DrawBuf; LinePtr : Sw_Word; Width : Sw_Integer; Colors : Word);virtual;
+    function   GetPalette : PPalette; virtual;
+    procedure  HandleEvent (var Event : TEvent); virtual;
+    procedure  InitBuffer; virtual;
+    function   InsertBuffer (var P : PEditBuffer; Offset, Length : Sw_Word;AllowUndo, SelectText : Boolean) : Boolean;
+    function   InsertFrom (Editor : PEditor) : Boolean; virtual;
+    function   InsertText (Text : Pointer; Length : Sw_Word; SelectText : Boolean) : Boolean;
+    procedure  ScrollTo (X, Y : Sw_Integer);
+    function   Search (const FindStr : String; Opts : Word) : Boolean;
+    function   SetBufSize (NewSize : Sw_Word) : Boolean; virtual;
+    procedure  SetCmdState (Command : Word; Enable : Boolean);
+    procedure  SetSelect (NewStart, NewEnd : Sw_Word; CurStart : Boolean);
+    procedure  SetCurPtr (P : Sw_Word; SelectMode : Byte);
+    procedure  SetState (AState : Word; Enable : Boolean); virtual;
+    procedure  Store (var S : TStream);
+    procedure  TrackCursor (Center : Boolean);
+    procedure  Undo;
+    procedure  UpdateCommands; virtual;
+    function   Valid (Command : Word) : Boolean; virtual;
+
+  private
+    KeyState       : SmallInt;
+    LockCount      : Byte;
+    UpdateFlags    : Byte;
+    Place_Marker   : Array [1..10] of Sw_Word; { Inserted array to hold place markers. }
+    Search_Replace : Boolean; { Added boolean to test for Search and Replace insertions. }
+
+    procedure  Center_Text (Select_Mode : Byte);
+    function   CharPos (P, Target : Sw_Word) : Sw_Integer;
+    function   CharPtr (P : Sw_Word; Target : Sw_Integer) : Sw_Word;
+    procedure  Check_For_Word_Wrap (Select_Mode : Byte; Center_Cursor : Boolean);
+    function   ClipCopy : Boolean;
+    procedure  ClipCut;
+    procedure  ClipPaste;
+    procedure  DeleteRange (StartPtr, EndPtr : Sw_Word; DelSelect : Boolean);
+    procedure  DoSearchReplace;
+    procedure  DoUpdate;
+    function   Do_Word_Wrap (Select_Mode : Byte; Center_Cursor : Boolean) : Boolean;
+    procedure  DrawLines (Y, Count : Sw_Integer; LinePtr : Sw_Word);
+    procedure  Find;
+    function   GetLineDisplayLen: Sw_word;
+    function   GetMousePtr (Mouse : TPoint) : Sw_Word;
+    function   HasSelection : Boolean;
+    procedure  HideSelect;
+    procedure  Insert_Line (Select_Mode : Byte);
+    function   IsClipboard : Boolean;
+    procedure  Jump_Place_Marker (Element : Byte; Select_Mode : Byte);
+    procedure  Jump_To_Line  (Select_Mode : Byte);
+    function   LineEnd (P : Sw_Word) : Sw_Word;
+    function   LineMove (P : Sw_Word; Count : Sw_Integer) : Sw_Word;
+    function   LineStart (P : Sw_Word) : Sw_Word;
+    function   LineNr (P : Sw_Word) : Sw_Word;
+    procedure  Lock;
+    function   NewLine (Select_Mode : Byte) : Boolean;
+    function   NextChar (P : Sw_Word) : Sw_Word;
+    function   NextLine (P : Sw_Word) : Sw_Word;
+    function   NextWord (P : Sw_Word) : Sw_Word;
+    function   PrevChar (P : Sw_Word) : Sw_Word;
+    function   PrevLine (P : Sw_Word) : Sw_Word;
+    function   PrevWord (P : Sw_Word) : Sw_Word;
+    procedure  Reformat_Document (Select_Mode : Byte; Center_Cursor : Boolean);
+    function   Reformat_Paragraph (Select_Mode : Byte; Center_Cursor : Boolean) : Boolean;
+    procedure  Remove_EOL_Spaces (Select_Mode : Byte);
+    procedure  Replace;
+    procedure  Scroll_Down;
+    procedure  Scroll_Up;
+    procedure  Select_Word;
+    procedure  SetBufLen (Length : Sw_Word);
+    procedure  Set_Place_Marker (Element : Byte);
+    procedure  Set_Right_Margin;
+    procedure  Set_Tabs;
+    procedure  StartSelect;
+    procedure  Tab_Key (Select_Mode : Byte);
+    procedure  ToggleInsMode;
+    procedure  Unlock;
+    procedure  Update (AFlags : Byte);
+    procedure  Update_Place_Markers (AddCount : Word; KillCount : Word; StartPtr,EndPtr : Sw_Word);
+  end;
+
+  TMemoData = record
+    Length : Sw_Word;
+    Buffer : TEditBuffer;
+  end;
+
+  PMemo = ^TMemo;
+  TMemo = object (TEditor)
+    constructor Load (var S : TStream);
+    function    DataSize : Sw_Word; virtual;
+    procedure   GetData (var Rec); virtual;
+    function    GetPalette : PPalette; virtual;
+    procedure   HandleEvent (var Event : TEvent); virtual;
+    procedure   SetData (var Rec); virtual;
+    procedure   Store (var S : TStream);
+  end;
+
+  PFileEditor = ^TFileEditor;
+  TFileEditor = object (TEditor)
+    FileName : FNameStr;
+    constructor Init (var Bounds : TRect; AHScrollBar, AVScrollBar : PScrollBar;
+                          AIndicator : PIndicator; AFileName : FNameStr);
+    constructor Load (var S : TStream);
+    procedure   DoneBuffer; virtual;
+    procedure   HandleEvent (var Event : TEvent); virtual;
+    procedure   InitBuffer; virtual;
+    function    LoadFile : Boolean;
+    function    Save : Boolean;
+    function    SaveAs : Boolean;
+    function    SaveFile : Boolean;
+    function    SetBufSize (NewSize : Sw_Word) : Boolean; virtual;
+    procedure   Store (var S : TStream);
+    procedure   UpdateCommands; virtual;
+    function    Valid (Command : Word) : Boolean; virtual;
+  end;
+
+  PEditWindow = ^TEditWindow;
+  TEditWindow = object (TWindow)
+    Editor : PFileEditor;
+    constructor Init (var Bounds : TRect; FileName : FNameStr; ANumber : SmallInt);
+    constructor Load (var S : TStream);
+    procedure   Close; virtual;
+    function    GetTitle (MaxSize : Sw_Integer) : TTitleStr; virtual;
+    procedure   HandleEvent (var Event : TEvent); virtual;
+    procedure   SizeLimits(var Min, Max: TPoint); virtual;
+    procedure   Store (var S : TStream);
+  end;
+
+
+function DefEditorDialog (Dialog : SmallInt; Info : Pointer) : Word;
+function CreateFindDialog: PDialog;
+function CreateReplaceDialog: PDialog;
+function JumpLineDialog : PDialog;
+function ReformDocDialog : PDialog;
+function RightMarginDialog : PDialog;
+function TabStopDialog : PDialog;
+function StdEditorDialog(Dialog: SmallInt; Info: Pointer): Word;
+
+const
+  WordChars    : set of AnsiChar = ['!'..#255];
+
+  LineBreak    : string[2]=
+{$ifdef UNIXLF}
+    #10;
+{$else}
+    #13#10;
+{$endif}
+
+
+  { The Allow_Reformat boolean is a programmer hook.  }
+  { I've placed this here to allow programmers to     }
+  { determine whether or not paragraph and document   }
+  { reformatting are allowed if Word_Wrap is not      }
+  { active.  Some people say don't allow, and others  }
+  { say allow it.  I've left it up to the programmer. }
+  { Set to FALSE if not allowed, or TRUE if allowed.  }
+  Allow_Reformat : Boolean = True;
+
+  EditorDialog   : TEditorDialog = {$ifdef fpc}@{$endif}DefEditorDialog;
+  EditorFlags    : Word = efBackupFiles + efPromptOnReplace;
+  FindStr        : String[80] = '';
+  ReplaceStr     : String[80] = '';
+  Clipboard      : PEditor = nil;
+
+  ToClipCmds     : TCommandSet = ([cmCut,cmCopy,cmClear]);
+  FromClipCmds   : TCommandSet = ([cmPaste]);
+  UndoCmds       : TCommandSet = ([cmUndo,cmRedo]);
+
+TYPE
+  TFindDialogRec =
+{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
+  packed
+{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
+  record
+    Find    : String[80];
+    Options : Word;
+  end;
+
+  TReplaceDialogRec =
+{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
+  packed
+{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
+  record
+       Find : String[80];
+    Replace : String[80];
+    Options : Word;
+  end;
+
+  TRightMarginRec =
+{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
+  packed
+{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
+  record
+    Margin_Position : String[3];
+  end;
+
+  TTabStopRec =
+{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
+  packed
+{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
+  record
+    Tab_String : String [Tab_Stop_Length];
+  end;
+
+CONST
+  { VMT constants. }
+  REditor   : TStreamRec = (ObjType : idEditor;
+                            VmtLink : Ofs (TypeOf (TEditor)^);
+                               Load : @TEditor.Load;
+                              Store : @TEditor.Store);
+
+  RMemo     : TStreamRec = (ObjType : idMemo;
+                            VmtLink : Ofs (TypeOf (TMemo)^);
+                               Load : @TMemo.Load;
+                              Store : @TMemo.Store);
+
+  RFileEditor : TStreamRec = (ObjType : idFileEditor;
+                              VmtLink : Ofs (TypeOf (TFileEditor)^);
+                                 Load : @TFileEditor.Load;
+                                Store : @TFileEditor.Store);
+
+  RIndicator : TStreamRec = (ObjType : idIndicator;
+                             VmtLink : Ofs (TypeOf (TIndicator)^);
+                                Load : @TIndicator.Load;
+                               Store : @TIndicator.Store);
+
+  REditWindow : TStreamRec = (ObjType : idEditWindow;
+                              VmtLink : Ofs (TypeOf (TEditWindow)^);
+                                 Load : @TEditWindow.Load;
+                                Store : @TEditWindow.Store);
+
+procedure RegisterEditors;
+
+
+{****************************************************************************
+                              Implementation
+****************************************************************************}
+
+implementation
+
+{$IFDEF FPC_DOTTEDUNITS}
+uses
+  TP.DOS, FreeVision.App, FreeVision.Stddlg, FreeVision.Msgbox{, System.Resources.Resource};
+{$ELSE FPC_DOTTEDUNITS}
+uses
+  Dos, App, StdDlg, MsgBox{, Resource};
+{$ENDIF FPC_DOTTEDUNITS}
+
+type
+  pword = ^word;
+
+resourcestring  sClipboard='Clipboard';
+                sFileCreateError='Error creating file %s';
+                sFileReadError='Error reading file %s';
+                sFileUntitled='Save untitled file?';
+                sFileWriteError='Error writing to file %s';
+                sFind='Find';
+                sJumpTo='Jump To';
+                sModified=''#3'%s'#13#10#13#3'has been modified.  Save?';
+                sOutOfMemory='Not enough memory for this operation.';
+                sPasteNotPossible='Wordwrap on:  Paste not possible in current margins when at end of line.';
+                sReformatDocument='Reformat Document';
+                sReformatNotPossible='Paragraph reformat not possible while trying to wrap current line with current margins.';
+                sReformattingTheDocument='Reformatting the document:';
+                sReplaceNotPossible='Wordwrap on:  Replace not possible in current margins when at end of line.';
+                sReplaceThisOccurence='Replace this occurrence?';
+                sRightMargin='Right Margin';
+                sSearchStringNotFound='Search string not found.';
+                sSelectWhereToBegin='Please select where to begin.';
+                sSetting='Setting:';
+                sTabSettings='Tab Settings';
+                sUnknownDialog='Unknown dialog requested!';
+                sUntitled='Untitled';
+                sWordWrapNotPossible='Wordwrap on:  Wordwrap not possible in current margins with continuous line.';
+                sWordWrapOff='You must turn on wordwrap before you can reformat.';
+                sSaveFileAs='Save file as';
+
+                slCaseSensitive='~C~ase sensitive';
+                slCurrentLine='~C~urrent line';
+                slEntireDocument='~E~ntire document';
+                slLineNumber='~L~ine number';
+                slNewText='~N~ew text';
+                slPromptOnReplace='~P~rompt on replace';
+                slReplace='~R~eplace';
+                slReplaceAll='~R~eplace all';
+                slTextToFind='~T~ext to find';
+                slWholeWordsOnly='~W~hole words only';
+
+
+CONST
+  { Update flag constants. }
+  ufUpdate = $01;
+  ufLine   = $02;
+  ufView   = $04;
+  ufStats  = $05;
+
+  { SelectMode constants. }
+  smExtend = $01;
+  smDouble = $02;
+
+  sfSearchFailed = NotFoundValue;
+
+  { Arrays that hold all the command keys and options. }
+  FirstKeys : array[0..46 * 2] of Word = (46, Ord (^A),    cmWordLeft,
+                                              Ord (^B),    cmReformPara,
+                                              Ord (^C),    cmPageDown,
+                                              Ord (^D),    cmCharRight,
+                                              Ord (^E),    cmLineUp,
+                                              Ord (^F),    cmWordRight,
+                                              Ord (^G),    cmDelChar,
+                                              Ord (^H),    cmBackSpace,
+                                              Ord (^I),    cmTabKey,
+                                              Ord (^J),    $FF04,
+                                              Ord (^K),    $FF02,
+                                              Ord (^L),    cmSearchAgain,
+                                              Ord (^M),    cmNewLine,
+                                              Ord (^N),    cmInsertLine,
+                                              Ord (^O),    $FF03,
+                                              Ord (^Q),    $FF01,
+                                              Ord (^R),    cmPageUp,
+                                              Ord (^S),    cmCharLeft,
+                                              Ord (^T),    cmDelWord,
+                                              Ord (^U),    cmUndo,
+                                              Ord (^V),    cmInsMode,
+                                              Ord (^W),    cmScrollUp,
+                                              Ord (^X),    cmLineDown,
+                                              Ord (^Y),    cmDelLine,
+                                              Ord (^Z),    cmScrollDown,
+                                              kbLeft,      cmCharLeft,
+                                              kbRight,     cmCharRight,
+                                              kbCtrlLeft,  cmWordLeft,
+                                              kbCtrlRight, cmWordRight,
+                                              kbHome,      cmLineStart,
+                                              kbEnd,       cmLineEnd,
+                                              kbCtrlHome,  cmHomePage,
+                                              kbCtrlEnd,   cmEndPage,
+                                              kbUp,        cmLineUp,
+                                              kbDown,      cmLineDown,
+                                              kbPgUp,      cmPageUp,
+                                              kbPgDn,      cmPageDown,
+                                              kbCtrlPgUp,  cmTextStart,
+                                              kbCtrlPgDn,  cmTextEnd,
+                                              kbIns,       cmInsMode,
+                                              kbDel,       cmDelChar,
+                                              kbCtrlBack,  cmDelStart,
+                                              kbShiftIns,  cmPaste,
+                                              kbShiftDel,  cmCut,
+                                              kbCtrlIns,   cmCopy,
+                                              kbCtrlDel,   cmClear);
+
+  { SCRLUP - Stop. } { Added ^W to scroll screen up.         }
+  { SCRLDN - Stop. } { Added ^Z to scroll screen down.       }
+  { REFORM - Stop. } { Added ^B for paragraph reformatting.  }
+  { PRETAB - Stop. } { Added ^I for preset tabbing.          }
+  { JLINE  - Stop. } { Added ^J to jump to a line number.    }
+  { INSLIN - Stop. } { Added ^N to insert line at cursor.    }
+  { INDENT - Stop. } { Removed ^O and put it into ^QI.       }
+  { HOMEND - Stop. } { Added kbCtrlHome and kbCtrlEnd pages. }
+  { CTRLBK - Stop. } { Added kbCtrlBack same as ^QH.         }
+
+  QuickKeys : array[0..21 * 2] of Word = (21, Ord ('0'), cmJumpMark0,
+                                              Ord ('1'), cmJumpMark1,
+                                              Ord ('2'), cmJumpMark2,
+                                              Ord ('3'), cmJumpMark3,
+                                              Ord ('4'), cmJumpMark4,
+                                              Ord ('5'), cmJumpMark5,
+                                              Ord ('6'), cmJumpMark6,
+                                              Ord ('7'), cmJumpMark7,
+                                              Ord ('8'), cmJumpMark8,
+                                              Ord ('9'), cmJumpMark9,
+                                              Ord ('A'), cmReplace,
+                                              Ord ('C'), cmTextEnd,
+                                              Ord ('D'), cmLineEnd,
+                                              Ord ('F'), cmFind,
+                                              Ord ('H'), cmDelStart,
+                                              Ord ('I'), cmIndentMode,
+                                              Ord ('L'), cmUndo,
+                                              Ord ('R'), cmTextStart,
+                                              Ord ('S'), cmLineStart,
+                                              Ord ('U'), cmReformDoc,
+                                              Ord ('Y'), cmDelEnd);
+
+  { UNDO   - Stop. } { Added IDE undo feature of ^QL.                  }
+  { REFDOC - Stop. } { Added document reformat feature if ^QU pressed. }
+  { MARK   - Stop. } { Added cmJumpMark# to allow place marking.       }
+  { INDENT - Stop. } { Moved IndentMode here from Firstkeys.           }
+
+  BlockKeys : array[0..20 * 2] of Word = (20, Ord ('0'), cmSetMark0,
+                                              Ord ('1'), cmSetMark1,
+                                              Ord ('2'), cmSetMark2,
+                                              Ord ('3'), cmSetMark3,
+                                              Ord ('4'), cmSetMark4,
+                                              Ord ('5'), cmSetMark5,
+                                              Ord ('6'), cmSetMark6,
+                                              Ord ('7'), cmSetMark7,
+                                              Ord ('8'), cmSetMark8,
+                                              Ord ('9'), cmSetMark9,
+                                              Ord ('B'), cmStartSelect,
+                                              Ord ('C'), cmPaste,
+                                              Ord ('D'), cmSave,
+                                              Ord ('F'), cmSaveAs,
+                                              Ord ('H'), cmHideSelect,
+                                              Ord ('K'), cmCopy,
+                                              Ord ('S'), cmSave,
+                                              Ord ('T'), cmSelectWord,
+                                              Ord ('Y'), cmCut,
+                                              Ord ('X'), cmSaveDone);
+
+  { SELWRD - Stop. } { Added ^KT to select word only. }
+  { SAVE   - Stop. } { Added ^KD, ^KF, ^KS, ^KX key commands.   }
+  { MARK   - Stop. } { Added cmSetMark# to allow place marking. }
+
+  FormatKeys : array[0..5 * 2] of Word = (5,  Ord ('C'), cmCenterText,
+                                              Ord ('T'), cmCenterText,
+                                              Ord ('I'), cmSetTabs,
+                                              Ord ('R'), cmRightMargin,
+                                              Ord ('W'), cmWordWrap);
+
+  { WRAP   - Stop. } { Added Wordwrap feature if ^OW pressed.          }
+  { RMSET  - Stop. } { Added set right margin feature if ^OR pressed.  }
+  { PRETAB - Stop. } { Added preset tab feature if ^OI pressed.        }
+  { CENTER - Stop. } { Added center text option ^OC for a line.        }
+
+  JumpKeys : array[0..1 * 2] of Word = (1, Ord ('L'), cmJumpLine);
+
+  { JLINE - Stop. } { Added jump to line number feature if ^JL pressed. }
+
+  KeyMap : array[0..4] of Pointer = (@FirstKeys,
+                                     @QuickKeys,
+                                     @BlockKeys,
+                                     @FormatKeys,
+                                     @JumpKeys);
+
+  { WRAP   - Stop. } { Added @FormatKeys for new ^O? keys. }
+  { PRETAB - Stop. } { Added @FormatKeys for new ^O? keys. }
+  { JLINE  - Stop. } { Added @JumpKeys for new ^J? keys.   }
+  { CENTER - Stop. } { Added @FormatKeys for new ^O? keys. }
+
+
+{****************************************************************************
+                                 Dialogs
+****************************************************************************}
+
+function DefEditorDialog (Dialog : SmallInt; Info : Pointer) : Word;
+begin
+  DefEditorDialog := cmCancel;
+end; { DefEditorDialog }
+
+
+function CreateFindDialog: PDialog;
+var
+  D: PDialog;
+  Control: PView;
+  R: TRect;
+begin
+  R.Assign(0, 0, 38, 12);
+  D := New(PDialog, Init(R,sFind));
+  with D^ do
+  begin
+    Options := Options or ofCentered;
+
+    R.Assign(3, 3, 32, 4);
+    Control := New(PInputLine, Init(R, 80));
+    Control^.HelpCtx := hcDFindText;
+    Insert(Control);
+    R.Assign(2, 2, 15, 3);
+    Insert(New(PLabel, Init(R, slTextToFind, Control)));
+    R.Assign(32, 3, 35, 4);
+    Insert(New(PHistory, Init(R, PInputLine(Control), 10)));
+
+    R.Assign(3, 5, 35, 7);
+    Control := New(PCheckBoxes, Init(R,
+        NewSItem (slCaseSensitive,
+        NewSItem (slWholeWordsOnly,nil))));
+    Control^.HelpCtx := hcCCaseSensitive;
+    Insert(Control);
+
+    R.Assign(14, 9, 24, 11);
+    Control := New (PButton, Init(R,slOK,cmOk,bfDefault));
+    Control^.HelpCtx := hcDOk;
+    Insert (Control);
+
+    Inc(R.A.X, 12); Inc(R.B.X, 12);
+    Control := New (PButton, Init(R,slCancel,cmCancel, bfNormal));
+    Control^.HelpCtx := hcDCancel;
+    Insert (Control);
+
+    SelectNext(False);
+  end;
+  CreateFindDialog := D;
+end;
+
+
+function CreateReplaceDialog: PDialog;
+var
+  D: PDialog;
+  Control: PView;
+  R: TRect;
+begin
+  R.Assign(0, 0, 40, 16);
+  D := New(PDialog, Init(R,slReplace));
+  with D^ do
+  begin
+    Options := Options or ofCentered;
+
+    R.Assign(3, 3, 34, 4);
+    Control := New(PInputLine, Init(R, 80));
+    Control^.HelpCtx := hcDFindText;
+    Insert(Control);
+    R.Assign(2, 2, 15, 3);
+    Insert(New(PLabel, Init(R,slTextToFind, Control)));
+    R.Assign(34, 3, 37, 4);
+    Insert(New(PHistory, Init(R, PInputLine(Control), 10)));
+
+    R.Assign(3, 6, 34, 7);
+    Control := New(PInputLine, Init(R, 80));
+    Control^.HelpCtx := hcDReplaceText;
+    Insert(Control);
+    R.Assign(2, 5, 12, 6);
+    Insert(New(PLabel, Init(R,slNewText, Control)));
+    R.Assign(34, 6, 37, 7);
+    Insert(New(PHistory, Init(R, PInputLine(Control), 11)));
+
+    R.Assign(3, 8, 37, 12);
+    Control := New (PCheckBoxes, Init (R,
+      NewSItem (slCasesensitive,
+      NewSItem (slWholewordsonly,
+      NewSItem (slPromptonreplace,
+      NewSItem (slReplaceall, nil))))));
+    Control^.HelpCtx := hcCCaseSensitive;
+    Insert (Control);
+
+    R.Assign (8, 13, 18, 15);
+    Control := New (PButton, Init (R,slOK, cmOk, bfDefault));
+    Control^.HelpCtx := hcDOk;
+    Insert (Control);
+
+    R.Assign (22, 13, 32, 15);
+    Control := New (PButton, Init (R,slCancel, cmCancel, bfNormal));
+    Control^.HelpCtx := hcDCancel;
+    Insert (Control);
+
+    SelectNext(False);
+  end;
+  CreateReplaceDialog := D;
+end;
+
+
+function JumpLineDialog : PDialog;
+VAR
+  D      : PDialog;
+  R      : TRect;
+  Control: PView;
+Begin
+  R.Assign (0, 0, 26, 8);
+  D := New(PDialog, Init(R,sJumpTo));
+  with D^ do
+    begin
+      Options := Options or ofCentered;
+
+      R.Assign (3, 2, 15, 3);
+      Control := New (PStaticText, Init (R,slLineNumber));
+      Insert (Control);
+
+      R.Assign (15, 2, 21, 3);
+      Control := New (PInputLine, Init (R, 4));
+      Control^.HelpCtx := hcDLineNumber;
+      Insert (Control);
+
+      R.Assign (21, 2, 24, 3);
+      Insert (New (PHistory, Init (R, PInputLine (Control), 12)));
+
+      R.Assign (2, 5, 12, 7);
+      Control := New (PButton, Init (R, slOK, cmOK, bfDefault));
+      Control^.HelpCtx := hcDOk;
+      Insert (Control);
+
+      R.Assign (14, 5, 24, 7);
+      Control := New (PButton, Init (R, slCancel, cmCancel, bfNormal));
+      Control^.HelpCtx := hcDCancel;
+      Insert (Control);
+
+      SelectNext (False);
+    end;
+  JumpLineDialog := D;
+end; { JumpLineDialog }
+
+
+function ReformDocDialog : PDialog;
+  { This is a local function that brings up a dialog box  }
+  { that asks where to start reformatting the document.   }
+VAR
+  R            : TRect;
+  D            : PDialog;
+  Control      : PView;
+Begin
+  R.Assign (0, 0, 32, 11);
+  D := New (PDialog, Init (R, sReformatDocument));
+  with D^ do
+    begin
+      Options := Options or ofCentered;
+
+      R.Assign (2, 2, 30, 3);
+      Control := New (PStaticText, Init (R, sSelectWhereToBegin));
+      Insert (Control);
+
+      R.Assign (3, 3, 29, 4);
+      Control := New (PStaticText, Init (R, sReformattingTheDocument));
+      Insert (Control);
+
+      R.Assign (50, 5, 68, 6);
+      Control := New (PLabel, Init (R, sReformatDocument, Control));
+      Insert (Control);
+
+      R.Assign (5, 5, 26, 7);
+      Control := New (PRadioButtons, Init (R,
+        NewSItem (slCurrentLine,
+        NewSItem (slEntireDocument, Nil))));
+      Control^.HelpCtx := hcDReformDoc;
+      Insert (Control);
+
+      R.Assign (4, 8, 14, 10);
+      Control := New (PButton, Init (R, slOK, cmOK, bfDefault));
+      Control^.HelpCtx := hcDOk;
+      Insert (Control);
+
+      R.Assign (17, 8, 27, 10);
+      Control := New (PButton, Init (R, slCancel, cmCancel, bfNormal));
+      Control^.HelpCtx := hcDCancel;
+      Insert (Control);
+
+      SelectNext (False);
+    end;
+    ReformDocDialog := D;
+end; { ReformDocDialog }
+
+
+function RightMarginDialog : PDialog;
+  { This is a local function that brings up a dialog box }
+  { that allows the user to change the Right_Margin.     }
+VAR
+  R        : TRect;
+  D        : PDialog;
+  Control  : PView;
+Begin
+  R.Assign (0, 0, 26, 8);
+  D := New (PDialog, Init (R, sRightMargin));
+  with D^ do
+    begin
+      Options := Options or ofCentered;
+
+      R.Assign (5, 2, 13, 3);
+      Control := New (PStaticText, Init (R, sSetting));
+      Insert (Control);
+
+      R.Assign (13, 2, 18, 3);
+      Control := New (PInputLine, Init (R, 3));
+      Control^.HelpCtx := hcDRightMargin;
+      Insert (Control);
+
+      R.Assign (18, 2, 21, 3);
+      Insert (New (PHistory, Init (R, PInputLine (Control), 13)));
+
+      R.Assign (2, 5, 12, 7);
+      Control := New (PButton, Init (R, slOK, cmOK, bfDefault));
+      Control^.HelpCtx := hcDOk;
+      Insert (Control);
+
+      R.Assign (14, 5, 24, 7);
+      Control := New (PButton, Init (R, slCancel, cmCancel, bfNormal));
+      Control^.HelpCtx := hcDCancel;
+      Insert (Control);
+
+      SelectNext (False);
+    end;
+  RightMarginDialog := D;
+end; { RightMarginDialog; }
+
+
+function TabStopDialog : PDialog;
+  { This is a local function that brings up a dialog box }
+  { that allows the user to set their own tab stops.     }
+VAR
+  Index      : Sw_Integer;       { Local Indexing variable.                 }
+  R          : TRect;
+  D          : PDialog;
+  Control    : PView;
+  Tab_Stop   : String[2];        { Local string to print tab column number. }
+Begin
+  R.Assign (0, 0, 80, 8);
+  D := New (PDialog, Init (R, sTabSettings));
+  with D^ do
+    begin
+      Options := Options or ofCentered;
+
+      R.Assign (2, 2, 77, 3);
+      Control := New (PStaticText, Init (R,
+                  ' ....|....|....|....|....|....|....|....|....|....|....|....|....|....|....'));
+      Insert (Control);
+
+      for Index := 1 to 7 do
+        begin
+          R.Assign (Index * 10 + 1, 1, Index * 10 + 3, 2);
+          Str (Index * 10, Tab_Stop);
+          Control := New (PStaticText, Init (R, Tab_Stop));
+          Insert (Control);
+        end;
+
+      R.Assign (2, 3, 78, 4);
+      Control := New (PInputLine, Init (R, 74));
+      Control^.HelpCtx := hcDTabStops;
+      Insert (Control);
+
+      R.Assign (38, 5, 41, 6);
+      Insert (New (PHistory, Init (R, PInputLine (Control), 14)));
+
+      R.Assign (27, 5, 37, 7);
+      Control := New (PButton, Init (R, slOK, cmOK, bfDefault));
+      Control^.HelpCtx := hcDOk;
+      Insert (Control);
+
+      R.Assign (42, 5, 52, 7);
+      Control := New (PButton, Init (R, slCancel, cmCancel, bfNormal));
+      Control^.HelpCtx := hcDCancel;
+      Insert (Control);
+      SelectNext (False);
+    end;
+  TabStopDialog := D;
+end { TabStopDialog };
+
+
+function StdEditorDialog(Dialog: SmallInt; Info: Pointer): Word;
+var
+  R: TRect;
+  T: TPoint;
+begin
+  case Dialog of
+    edOutOfMemory:
+      StdEditorDialog := MessageBox(sOutOfMemory, nil, mfError + mfOkButton);
+    edReadError:
+      StdEditorDialog := MessageBox(sFileReadError, @Info, mfError + mfOkButton);
+    edWriteError:
+      StdEditorDialog := MessageBox(sFileWriteError, @Info, mfError + mfOkButton);
+    edCreateError:
+      StdEditorDialog := MessageBox(sFileCreateError, @Info, mfError + mfOkButton);
+    edSaveModify:
+      StdEditorDialog := MessageBox(sModified, @Info, mfInformation + mfYesNoCancel);
+    edSaveUntitled:
+      StdEditorDialog := MessageBox(sFileUntitled, nil, mfInformation + mfYesNoCancel);
+    edSaveAs:
+      StdEditorDialog := Application^.ExecuteDialog(New(PFileDialog, Init('*.*',
+        sSaveFileAs, slName, fdOkButton, 101)), Info);
+    edFind:
+      StdEditorDialog := Application^.ExecuteDialog(CreateFindDialog, Info);
+    edSearchFailed:
+      StdEditorDialog := MessageBox(sSearchStringNotFound, nil, mfError + mfOkButton);
+    edReplace:
+      StdEditorDialog := Application^.ExecuteDialog(CreateReplaceDialog, Info);
+    edReplacePrompt:
+      begin
+        { Avoid placing the dialog on the same line as the cursor }
+        R.Assign(0, 1, 40, 8);
+        R.Move((Desktop^.Size.X - R.B.X) div 2, 0);
+        Desktop^.MakeGlobal(R.B, T);
+        Inc(T.Y);
+        if PPoint(Info)^.Y <= T.Y then
+          R.Move(0, Desktop^.Size.Y - R.B.Y - 2);
+        StdEditorDialog := MessageBoxRect(R, sReplaceThisOccurence,
+          nil, mfYesNoCancel + mfInformation);
+      end;
+    edJumpToLine:
+      StdEditorDialog := Application^.ExecuteDialog(JumpLineDialog, Info);
+    edSetTabStops:
+      StdEditorDialog := Application^.ExecuteDialog(TabStopDialog, Info);
+    edPasteNotPossible:
+      StdEditorDialog := MessageBox (sPasteNotPossible, nil, mfError + mfOkButton);
+    edReformatDocument:
+      StdEditorDialog := Application^.ExecuteDialog(ReformDocDialog, Info);
+    edReformatNotAllowed:
+      StdEditorDialog := MessageBox (sWordWrapOff, nil, mfError + mfOkButton);
+    edReformNotPossible:
+      StdEditorDialog := MessageBox (sReformatNotPossible, nil, mfError + mfOkButton);
+    edReplaceNotPossible:
+      StdEditorDialog := MessageBox (sReplaceNotPossible, nil, mfError + mfOkButton);
+    edRightMargin:
+      StdEditorDialog := Application^.ExecuteDialog(RightMarginDialog, Info);
+    edWrapNotPossible:
+      StdEditorDialog := MessageBox (sWordWrapNotPossible, nil, mfError + mfOKButton);
+  else
+    StdEditorDialog := MessageBox (sUnknownDialog, nil, mfError + mfOkButton);
+  end;
+end;
+
+
+{****************************************************************************
+                                 Helpers
+****************************************************************************}
+
+function CountLines(var Buf; Count: sw_Word): sw_Integer;
+var
+  p : PAnsiChar;
+  lines : sw_word;
+begin
+  p:=PAnsiChar(@buf);
+  lines:=0;
+  while (count>0) do
+   begin
+     if p^ in [#10,#13] then
+      begin
+        inc(lines);
+        if ord((p+1)^)+ord(p^)=23 then
+         begin
+           inc(p);
+           dec(count);
+           if count=0 then
+            break;
+         end;
+      end;
+     inc(p);
+     dec(count);
+   end;
+  CountLines:=Lines;
+end;
+
+
+procedure GetLimits(var Buf; Count: sw_Word;var lim:TPoint);
+{ Get the limits needed for Buf, its an extended version of countlines (lim.y),
+  which also gets the maximum line length in lim.x }
+var
+  p : PAnsiChar;
+  len : sw_word;
+begin
+  lim.x:=0;
+  lim.y:=0;
+  len:=0;
+  p:=PAnsiChar(@buf);
+  while (count>0) do
+   begin
+     if p^ in [#10,#13] then
+      begin
+        if len>lim.x then
+         lim.x:=len;
+        inc(lim.y);
+        if ord((p+1)^)+ord(p^)=23 then
+         begin
+           inc(p);
+           dec(count);
+         end;
+        len:=0;
+      end
+     else
+      inc(len);
+     inc(p);
+     dec(count);
+   end;
+end;
+
+
+function ScanKeyMap(KeyMap: Pointer; KeyCode: Word): Word;
+var
+  p : pword;
+  count : sw_word;
+begin
+  p:=keymap;
+  count:=p^;
+  inc(p);
+  while (count>0) do
+   begin
+     if (lo(p^)=lo(keycode)) and
+        ((hi(p^)=0) or (hi(p^)=hi(keycode))) then
+      begin
+        inc(p);
+        scankeymap:=p^;
+        exit;
+      end;
+     inc(p,2);
+     dec(count);
+   end;
+  scankeymap:=0;
+end;
+
+
+Type
+  Btable = Array[0..255] of Byte;
+Procedure BMMakeTable(const s:string; Var t : Btable);
+{ Makes a Boyer-Moore search table. s = the search String t = the table }
+Var
+  x : sw_integer;
+begin
+  FillChar(t,sizeof(t),length(s));
+  For x := length(s) downto 1 do
+   if (t[ord(s[x])] = length(s)) then
+    t[ord(s[x])] := length(s) - x;
+end;
+
+
+function Scan(var Block; Size: Sw_Word;const Str: String): Sw_Word;
+Var
+  buffer : Array[0..MaxBufLength-1] of Byte Absolute block;
+  s2     : String;
+  len,
+  numb   : Sw_Word;
+  found  : Boolean;
+  bt     : Btable;
+begin
+  BMMakeTable(str,bt);
+  len:=length(str);
+  SetLength(s2,len);       { sets the length to that of the search String }
+  found:=False;
+  numb:=pred(len);
+  While (not found) and (numb<(size-len)) do
+   begin
+     { partial match }
+     if buffer[numb] = ord(str[len]) then
+      begin
+        { less partial! }
+        if buffer[numb-pred(len)] = ord(str[1]) then
+         begin
+           move(buffer[numb-pred(len)],s2[1],len);
+           if (str=s2) then
+            begin
+              found:=true;
+              break;
+            end;
+         end;
+        inc(numb);
+     end
+    else
+     inc(numb,Bt[buffer[numb]]);
+  end;
+  if not found then
+    Scan := NotFoundValue
+  else
+    Scan := numb - pred(len);
+end;
+
+
+function IScan(var Block; Size: Sw_Word;const Str: String): Sw_Word;
+Var
+  buffer : Array[0..MaxBufLength-1] of AnsiChar Absolute block;
+  s      : String;
+  len,
+  numb,
+  x      : Sw_Word;
+  found  : Boolean;
+  bt     : Btable;
+  p      : PAnsiChar;
+  c      : AnsiChar;
+begin
+  len:=length(str);
+  if (len=0) or (len>size) then
+  begin
+    IScan := NotFoundValue;
+    exit;
+  end;
+  { create uppercased string }
+  SetLength(s,len);
+  for x:=1 to len do
+   begin
+     if str[x] in ['a'..'z'] then
+      s[x]:=chr(ord(str[x])-32)
+     else
+      s[x]:=str[x];
+   end;
+  BMMakeTable(s,bt);
+  found:=False;
+  numb:=pred(len);
+  While (not found) and (numb<(size-len)) do
+   begin
+     { partial match }
+     c:=buffer[numb];
+     if c in ['a'..'z'] then
+      c:=chr(ord(c)-32);
+     if (c=s[len]) then
+      begin
+        { less partial! }
+        p:=@buffer[numb-pred(len)];
+        x:=1;
+        while (x<=len) do
+         begin
+           if not(((p^ in ['a'..'z']) and (chr(ord(p^)-32)=s[x])) or
+                  (p^=s[x])) then
+            break;
+           inc(p);
+           inc(x);
+         end;
+        if (x>len) then
+         begin
+           found:=true;
+           break;
+         end;
+        inc(numb);
+     end
+    else
+     inc(numb,Bt[ord(c)]);
+  end;
+  if not found then
+    IScan := NotFoundValue
+  else
+    IScan := numb - pred(len);
+end;
+
+
+{****************************************************************************
+                                 TIndicator
+****************************************************************************}
+
+constructor TIndicator.Init (var Bounds : TRect);
+begin
+  Inherited Init (Bounds);
+  GrowMode := gfGrowLoY + gfGrowHiY;
+end; { TIndicator.Init }
+
+
+procedure TIndicator.Draw;
+VAR
+  Color : Byte;
+  Frame : AnsiChar;
+  L     : array[0..1] of PtrInt;
+  S     : String[15];
+  B     : TDrawBuffer;
+begin
+  if State and sfDragging = 0 then
+    begin
+      Color := GetColor (1);
+      Frame := #205;
+    end
+  else
+    begin
+      Color := GetColor (2);
+      Frame := #196;
+    end;
+  MoveChar (B, Frame, Color, Size.X);
+  { If the text has been modified, put an 'M' in the TIndicator display. }
+  if Modified then
+    WordRec (B[1]).Lo := 77;
+  { If WordWrap is active put a 'W' in the TIndicator display. }
+  if WordWrap then
+    WordRec (B[2]).Lo := 87
+  else
+    WordRec (B[2]).Lo := Byte (Frame);
+  { If AutoIndent is active put an 'I' in TIndicator display. }
+  if AutoIndent then
+    WordRec (B[0]).Lo := 73
+  else
+    WordRec (B[0]).Lo := Byte (Frame);
+  L[0] := Location.Y + 1;
+  L[1] := Location.X + 1;
+  FormatStr (S, ' %d:%d ', L);
+  MoveStr (B[9 - Pos (':', S)], S, Color);       { Changed original 8 to 9. }
+  WriteBuf (0, 0, Size.X, 1, B);
+end; { TIndicator.Draw }
+
+
+function TIndicator.GetPalette : PPalette;
+const
+  P : string[Length (CIndicator)] = CIndicator;
+begin
+  GetPalette := PPalette(@P);
+end; { TIndicator.GetPalette }
+
+
+procedure TIndicator.SetState (AState : Word; Enable : Boolean);
+begin
+  Inherited SetState (AState, Enable);
+  if AState = sfDragging then
+    DrawView;
+end; { TIndicator.SetState }
+
+
+procedure TIndicator.SetValue (ALocation : TPoint; IsAutoIndent : Boolean;
+                                                           IsModified   : Boolean;
+                                                           IsWordWrap   : Boolean);
+begin
+  if (Location.X<>ALocation.X) or
+     (Location.Y<>ALocation.Y) or
+     (AutoIndent <> IsAutoIndent) or
+     (Modified <> IsModified) or
+     (WordWrap <> IsWordWrap) then
+   begin
+     Location   := ALocation;
+     AutoIndent := IsAutoIndent;    { Added provisions to show AutoIndent. }
+     Modified   := IsModified;
+     WordWrap   := IsWordWrap;      { Added provisions to show WordWrap.   }
+     DrawView;
+   end;
+end; { TIndicator.SetValue }
+
+
+{****************************************************************************
+                                 TLineInfo
+****************************************************************************}
+
+constructor TLineInfo.Init;
+begin
+  MaxPos:=0;
+  Grow(1);
+end;
+
+
+destructor TLineInfo.Done;
+begin
+  FreeMem(Info,MaxPos*sizeof(TLineInfoRec));
+  Info := nil;
+end;
+
+
+procedure TLineInfo.Grow(pos:Sw_word);
+var
+  NewSize : Sw_word;
+  P : pointer;
+begin
+  NewSize:=(Pos+LineInfoGrow-(Pos mod LineInfoGrow));
+  GetMem(P,NewSize*sizeof(TLineInfoRec));
+  FillChar(P^,NewSize*sizeof(TLineInfoRec),0);
+  Move(Info^,P^,MaxPos*sizeof(TLineInfoRec));
+  Freemem(Info,MaxPos*sizeof(TLineInfoRec));
+  Info:=P;
+end;
+
+
+procedure TLineInfo.SetLen(pos,val:Sw_Word);
+begin
+  if pos>=MaxPos then
+   Grow(Pos);
+  Info^[Pos].Len:=val
+end;
+
+
+procedure TLineInfo.SetAttr(pos,val:Sw_Word);
+begin
+  if pos>=MaxPos then
+   Grow(Pos);
+  Info^[Pos].Attr:=val
+end;
+
+
+function TLineInfo.GetLen(pos:Sw_Word):Sw_Word;
+begin
+  GetLen:=Info^[Pos].Len;
+end;
+
+
+function TLineInfo.GetAttr(pos:Sw_Word):Sw_Word;
+begin
+  GetAttr:=Info^[Pos].Attr;
+end;
+
+
+
+{****************************************************************************
+                                 TEditor
+****************************************************************************}
+
+constructor TEditor.Init (var Bounds : TRect;
+                              AHScrollBar, AVScrollBar : PScrollBar;
+                              AIndicator : PIndicator; ABufSize : Sw_Word);
+var
+  Element : Byte;      { Place_Marker array element to initialize array with. }
+begin
+  Inherited Init (Bounds);
+  GrowMode := gfGrowHiX + gfGrowHiY;
+  Options := Options or ofSelectable;
+  Flags := EditorFlags;
+  EventMask := evMouseWheel + evMouseDown + evKeyDown + evCommand + evBroadcast;
+  ShowCursor;
+
+  HScrollBar := AHScrollBar;
+  VScrollBar := AVScrollBar;
+
+  Indicator := AIndicator;
+  BufSize := ABufSize;
+  CanUndo := True;
+  InitBuffer;
+
+  if assigned(Buffer) then
+    IsValid := True
+  else
+    begin
+      EditorDialog (edOutOfMemory, nil);
+      BufSize := 0;
+    end;
+
+  SetBufLen (0);
+
+  for Element := 1 to 10 do
+    Place_Marker[Element] := 0;
+
+  Element := 1;
+  while Element <= 70 do
+    begin
+      if Element mod 5 = 0 then
+        Insert ('x', Tab_Settings, Element)
+      else
+        Insert (#32, Tab_Settings, Element);
+      Inc (Element);
+    end;
+  { Default Right_Margin value.  Change it if you want another. }
+  Right_Margin := 76;
+  TabSize:=8;
+end; { TEditor.Init }
+
+
+constructor TEditor.Load (var S : TStream);
+begin
+  Inherited Load (S);
+  GetPeerViewPtr (S, HScrollBar);
+  GetPeerViewPtr (S, VScrollBar);
+  GetPeerViewPtr (S, Indicator);
+  S.Read (BufSize, SizeOf (BufSize));
+  S.Read (CanUndo, SizeOf (CanUndo));
+  S.Read (AutoIndent,   SizeOf (AutoIndent));
+  S.Read (Line_Number,  SizeOf (Line_Number));
+  S.Read (Place_Marker, SizeOf (Place_Marker));
+  S.Read (Right_Margin, SizeOf (Right_Margin));
+  S.Read (Tab_Settings, SizeOf (Tab_Settings));
+  S.Read (Word_Wrap,    SizeOf (Word_Wrap));
+  InitBuffer;
+  if Assigned(Buffer) then
+    IsValid := True
+  else
+    begin
+      EditorDialog (edOutOfMemory, nil);
+      BufSize := 0;
+    end;
+  Lock;
+  SetBufLen (0);
+end; { TEditor.Load }
+
+
+destructor TEditor.Done;
+begin
+  DoneBuffer;
+  Inherited Done;
+end; { TEditor.Done }
+
+
+function TEditor.BufChar(P: Sw_Word): AnsiChar;
+begin
+  if P>=CurPtr then
+   inc(P,Gaplen);
+  BufChar:=Buffer^[P];
+end;
+
+
+function TEditor.BufPtr(P: Sw_Word): Sw_Word;
+begin
+  if P>=CurPtr then
+   BufPtr:=P+GapLen
+  else
+   BufPtr:=P;
+end;
+
+
+procedure TEditor.Center_Text (Select_Mode : Byte);
+{ This procedure will center the current line of text. }
+{ Centering is based on the current Right_Margin.      }
+{ If the Line_Length exceeds the Right_Margin, or the  }
+{ line is just a blank line, we exit and do nothing.   }
+VAR
+  Spaces      : array [1..80] of AnsiChar;  { Array to hold spaces we'll insert. }
+  Index       : Byte;                   { Index into Spaces array.           }
+  Line_Length : Sw_Integer;             { Holds the length of the line.      }
+  E,S : Sw_Word;                        { End of the current line.           }
+begin
+  E := LineEnd (CurPtr);
+  S := LineStart (CurPtr);
+  { If the line is blank (only a CR/LF on it) then do noting. }
+  if E = S then
+    Exit;
+  { Set CurPtr to start of line.  Check if line begins with a space.  }
+  { We must strip out any spaces from the beginning, or end of lines. }
+  { If line does not start with space, make sure line length does not }
+  { exceed the Right_Margin.  If it does, then do nothing.            }
+  SetCurPtr (S, Select_Mode);
+  Remove_EOL_Spaces (Select_Mode);
+  if Buffer^[CurPtr] = #32 then
+    begin
+      { If the next word is greater than the end of line then do nothing. }
+      { If the line length is greater than Right_Margin then do nothing.  }
+      { Otherwise, delete all spaces at the start of line.                }
+      { Then reset end of line and put CurPtr at start of modified line.  }
+      E := LineEnd (CurPtr);
+      if NextWord (CurPtr) > E then
+        Exit;
+      if E - NextWord (CurPtr) > Right_Margin then
+        Exit;
+      DeleteRange (CurPtr, NextWord (CurPtr), True);
+      E := LineEnd (CurPtr);
+      SetCurPtr (LineStart (CurPtr), Select_Mode);
+    end
+  else
+    if E - CurPtr > Right_Margin then
+      Exit;
+  { Now we determine the real length of the line.       }
+  { Then we subtract the Line_Length from Right_Margin. }
+  { Dividing the result by two tells us how many spaces }
+  { must be inserted at start of line to center it.     }
+  { When we're all done, set the CurPtr to end of line. }
+  Line_Length := E - CurPtr;
+  for Index := 1 to ((Right_Margin - Line_Length) shr 1) do
+    Spaces[Index] := #32;
+  InsertText (@Spaces, Index, False);
+  SetCurPtr (LineEnd (CurPtr), Select_Mode);
+end; { TEditor.Center_Text }
+
+
+procedure TEditor.ChangeBounds (var Bounds : TRect);
+begin
+  SetBounds (Bounds);
+  Delta.X := Max (0, Min (Delta.X, Limit.X - Size.X));
+  Delta.Y := Max (0, Min (Delta.Y, Limit.Y - Size.Y));
+  Update (ufView);
+end; { TEditor.ChangeBounds }
+
+
+function TEditor.CharPos (P, Target : Sw_Word) : Sw_Integer;
+VAR
+  Pos : Sw_Integer;
+begin
+  Pos := 0;
+  while P < Target do
+   begin
+     if BufChar (P) = #9 then
+       Pos := Pos or 7;
+     Inc (Pos);
+     Inc (P);
+   end;
+  CharPos := Pos;
+end; { TEditor.CharPos }
+
+
+function TEditor.CharPtr (P : Sw_Word; Target : Sw_Integer) : Sw_Word;
+VAR
+  Pos : Sw_Integer;
+begin
+  Pos := 0;
+  while (Pos < Target) and (P < BufLen) and  not(BufChar (P) in [#10,#13]) do
+  begin
+    if BufChar (P) = #9 then
+      Pos := Pos or 7;
+    Inc (Pos);
+    Inc (P);
+  end;
+  if Pos > Target then
+    Dec (P);
+  CharPtr := P;
+end; { TEditor.CharPtr }
+
+
+procedure TEditor.Check_For_Word_Wrap (Select_Mode   : Byte;
+                                       Center_Cursor : Boolean);
+{ This procedure checks if CurPos.X > Right_Margin. }
+{ If it is, then we Do_Word_Wrap.  Simple, eh?      }
+begin
+  if CurPos.X > Right_Margin then
+    Do_Word_Wrap (Select_Mode, Center_Cursor);
+end; {Check_For_Word_Wrap}
+
+
+function TEditor.ClipCopy : Boolean;
+begin
+  ClipCopy := False;
+  if Assigned(Clipboard) and (Clipboard <> @Self) then
+   begin
+     ClipCopy := Clipboard^.InsertFrom (@Self);
+     Selecting := False;
+     Update (ufUpdate);
+  end;
+end; { TEditor.ClipCopy }
+
+
+procedure TEditor.ClipCut;
+begin
+  if ClipCopy then
+  begin
+    Update_Place_Markers (0,
+                          Self.SelEnd - Self.SelStart,
+                          Self.SelStart,
+                          Self.SelEnd);
+    DeleteSelect;
+  end;
+end; { TEditor.ClipCut }
+
+
+procedure TEditor.ClipPaste;
+begin
+  if Assigned(Clipboard) and (Clipboard <> @Self) then
+    begin
+      { Do not allow paste operations that will exceed }
+      { the Right_Margin when Word_Wrap is active and  }
+      { cursor is at EOL.                              }
+      if Word_Wrap and (CurPos.X > Right_Margin) then
+        begin
+          EditorDialog (edPasteNotPossible, nil);
+          Exit;
+        end;
+      { The editor will not copy selected text if the CurPtr }
+      { is not the same value as the SelStart.  However, it  }
+      { does return an InsCount.  This may, or may not, be a }
+      { bug.  We don't want to update the Place_Marker if    }
+      { there's no text copied.                              }
+      if CurPtr = SelStart then
+        Update_Place_Markers (Clipboard^.SelEnd - Clipboard^.SelStart,
+                              0,
+                              Clipboard^.SelStart,
+                              Clipboard^.SelEnd);
+      InsertFrom (Clipboard);
+    end;
+end; { TEditor.ClipPaste }
+
+
+procedure TEditor.ConvertEvent (var Event : TEvent);
+VAR
+  ShiftState : Byte;
+  Key        : Word;
+begin
+  ShiftState:=GetShiftState;
+  if Event.What = evKeyDown then
+  begin
+    if (ShiftState and $03 <> 0)
+                   and (Event.ScanCode >= $47)
+                   and (Event.ScanCode <= $51) then
+      Event.CharCode := #0;
+    Key := Event.KeyCode;
+    if KeyState <> 0 then
+    begin
+      if (Lo (Key) >= $01) and (Lo (Key) <= $1A) then
+        Inc (Key, $40);
+      if (Lo (Key) >= $61) and (Lo (Key) <= $7A) then
+        Dec (Key, $20);
+    end;
+    Key := ScanKeyMap (KeyMap[KeyState], Key);
+    KeyState := 0;
+    if Key <> 0 then
+      if Hi (Key) = $FF then
+        begin
+          KeyState := Lo (Key);
+          ClearEvent (Event);
+        end
+      else
+        begin
+          Event.What := evCommand;
+          Event.Command := Key;
+        end;
+  end;
+end; { TEditor.ConvertEvent }
+
+
+function TEditor.CursorVisible : Boolean;
+begin
+  CursorVisible := (CurPos.Y >= Delta.Y) and (CurPos.Y < Delta.Y + Size.Y);
+end; { TEditor.CursorVisible }
+
+
+procedure TEditor.DeleteRange (StartPtr, EndPtr : Sw_Word; DelSelect : Boolean);
+begin
+  { This will update Place_Marker for all deletions. }
+  { EXCEPT the Remove_EOL_Spaces deletion.           }
+  Update_Place_Markers (0, EndPtr - StartPtr, StartPtr, EndPtr);
+  if HasSelection and DelSelect then
+    DeleteSelect
+  else
+    begin
+      SetSelect (CurPtr, EndPtr, True);
+      DeleteSelect;
+      SetSelect (StartPtr, CurPtr, False);
+      DeleteSelect;
+    end;
+end; { TEditor.DeleteRange }
+
+
+procedure TEditor.DeleteSelect;
+begin
+  InsertText (nil, 0, False);
+end; { TEditor.DeleteSelect }
+
+
+procedure TEditor.DoneBuffer;
+begin
+  ReAllocMem(Buffer, 0);
+end; { TEditor.DoneBuffer }
+
+
+procedure TEditor.DoSearchReplace;
+VAR
+  I : Sw_Word;
+  C : TPoint;
+begin
+  repeat
+    I := cmCancel;
+    if not Search (FindStr, Flags) then
+      begin
+        if Flags and (efReplaceAll + efDoReplace) <> (efReplaceAll + efDoReplace) then
+          EditorDialog (edSearchFailed, nil)
+      end
+    else
+      if Flags and efDoReplace <> 0 then
+      begin
+        I := cmYes;
+        if Flags and efPromptOnReplace <> 0 then
+        begin
+          MakeGlobal (Cursor, C);
+          I := EditorDialog (edReplacePrompt, Pointer(@C));
+        end;
+        if I = cmYes then
+          begin
+            { If Word_Wrap is active and we are at EOL }
+            { disallow replace by bringing up a dialog }
+            { stating that replace is not possible.    }
+            if Word_Wrap and
+               ((CurPos.X + (Length (ReplaceStr) - Length (FindStr))) > Right_Margin) then
+              EditorDialog (edReplaceNotPossible, nil)
+            else
+              begin
+                Lock;
+                Search_Replace := True;
+                if length (ReplaceStr) < length (FindStr) then
+                  Update_Place_Markers (0,
+                                        Length (FindStr) - Length (ReplaceStr),
+                                        CurPtr - Length (FindStr) + Length (ReplaceStr),
+                                        CurPtr)
+                else
+                  if length (ReplaceStr) > length (FindStr) then
+                    Update_Place_Markers (Length (ReplaceStr) - Length (FindStr),
+                                          0,
+                                          CurPtr,
+                                          CurPtr + (Length (ReplaceStr) - Length (FindStr)));
+                InsertText (@ReplaceStr[1], Length (ReplaceStr), False);
+                Search_Replace := False;
+                TrackCursor (False);
+                Unlock;
+             end;
+          end;
+      end;
+  until (I = cmCancel) or (Flags and efReplaceAll = 0);
+end; { TEditor.DoSearchReplace }
+
+
+procedure TEditor.DoUpdate;
+begin
+  if UpdateFlags <> 0 then
+  begin
+    SetCursor (CurPos.X - Delta.X, CurPos.Y - Delta.Y);
+    if UpdateFlags and ufView <> 0 then
+      DrawView
+    else
+      if UpdateFlags and ufLine <> 0 then
+        DrawLines (CurPos.Y - Delta.Y, 1, LineStart (CurPtr));
+    if assigned(HScrollBar) then
+      HScrollBar^.SetParams (Delta.X, 0, Limit.X - Size.X, Size.X div 2, 1);
+    if assigned(VScrollBar) then
+      VScrollBar^.SetParams (Delta.Y, 0, Limit.Y - Size.Y, Size.Y - 1, 1);
+    if assigned(Indicator) then
+      Indicator^.SetValue (CurPos, AutoIndent, Modified, Word_Wrap);
+    if State and sfActive <> 0 then
+      UpdateCommands;
+    UpdateFlags := 0;
+  end;
+end; { TEditor.DoUpdate }
+
+
+function TEditor.Do_Word_Wrap (Select_Mode   : Byte;
+                               Center_Cursor : Boolean) : Boolean;
+{ This procedure does the actual wordwrap.  It always assumes the CurPtr }
+{ is at Right_Margin + 1.  It makes several tests for special conditions }
+{ and processes those first.  If they all fail, it does a normal wrap.   }
+VAR
+  A : Sw_Word;          { Distance between line start and first word on line. }
+  C : Sw_Word;          { Current pointer when we come into procedure.        }
+  L : Sw_Word;          { BufLen when we come into procedure.                 }
+  P : Sw_Word;          { Position of pointer at any given moment.            }
+  S : Sw_Word;          { Start of a line.                                    }
+begin
+  Do_Word_Wrap := False;
+  Select_Mode := 0;
+  if BufLen >= (BufSize - 1) then
+    exit;
+  C := CurPtr;
+  L := BufLen;
+  S := LineStart (CurPtr);
+  { If first character in the line is a space and autoindent mode is on  }
+  { then we check to see if NextWord(S) exceeds the CurPtr.  If it does, }
+  { we set CurPtr as the AutoIndent marker.  If it doesn't, we will set  }
+  { NextWord(S) as the AutoIndent marker.  If neither, we set it to S.   }
+  if AutoIndent and (Buffer^[S] = ' ') then
+    begin
+      if NextWord (S) > CurPtr then
+        A := CurPtr
+      else
+        A := NextWord (S);
+    end
+  else
+    A := NextWord (S);
+  { Though NewLine will remove EOL spaces, we do it here too. }
+  { This catches the instance where a user may try to space   }
+  { completely across the line, in which case CurPtr.X = 0.   }
+  Remove_EOL_Spaces (Select_Mode);
+  if CurPos.X = 0 then
+    begin
+      NewLine (Select_Mode);
+      Do_Word_Wrap := True;
+      Exit;
+    end;
+  { At this point we have one of five situations:                               }
+  {                                                                             }
+  { 1)  AutoIndent is on and this line is all spaces before CurPtr.             }
+  { 2)  AutoIndent is off and this line is all spaces before CurPtr.            }
+  { 3)  AutoIndent is on and this line is continuous characters before CurPtr.  }
+  { 4)  AutoIndent is off and this line is continuous characters before CurPtr. }
+  { 5)  This is just a normal line of text.                                     }
+  {                                                                             }
+  { Conditions 1 through 4 have to be taken into account before condition 5.    }
+  { First, we see if there are all spaces and/or all characters. }
+  { Then we determine which one it really is.  Finally, we take  }
+  { a course of action based on the state of AutoIndent.         }
+  if PrevWord (CurPtr) <= S then
+    begin
+      P := CurPtr - 1;
+      while ((Buffer^[P] <> ' ') and (P > S)) do
+        Dec (P);
+      { We found NO SPACES.  Conditions 4 and 5 are treated the same.  }
+      { We can NOT do word wrap and put up a dialog box stating such.  }
+      { Delete character just entered so we don't exceed Right_Margin. }
+      if P = S then
+        begin
+          EditorDialog (edWrapNotPossible, nil);
+          DeleteRange (PrevChar (CurPtr), CurPtr, True);
+          Exit;
+        end
+      else
+        begin
+          { There are spaces.  Now find out if they are all spaces. }
+          { If so, see if AutoIndent is on.  If it is, turn it off, }
+          { do a NewLine, and turn it back on.  Otherwise, just do  }
+          { the NewLine.  We go through all of these gyrations for  }
+          { AutoIndent.  Being way out here with a preceding line   }
+          { of spaces and wrapping with AutoIndent on is real dumb! }
+          { However, the user expects something.  The wrap will NOT }
+          { autoindent, but they had no business being here anyway! }
+          P := CurPtr - 1;
+          while ((Buffer^[P] = ' ') and (P > S)) do
+            Dec (P);
+          if P = S then
+            begin
+              if Autoindent then
+                begin
+                  AutoIndent := False;
+                  NewLine (Select_Mode);
+                  AutoIndent := True;
+                end
+              else
+                NewLine (Select_Mode);
+              end; { AutoIndent }
+            end; { P = S for spaces }
+        end { P = S for no spaces }
+    else { PrevWord (CurPtr) <= S }
+      begin
+        { Hooray!  We actually had a plain old line of text to wrap!       }
+        { Regardless if we are pushing out a line beyond the Right_Margin, }
+        { or at the end of a line itself, the following will determine     }
+        { exactly where to do the wrap and re-set the cursor accordingly.  }
+        { However, if P = A then we can't wrap.  Show dialog and exit.     }
+        P := CurPtr;
+        while P - S > Right_Margin do
+          P := PrevWord (P);
+        if (P = A) then
+          begin
+            EditorDialog (edReformNotPossible, nil);
+            SetCurPtr (P, Select_Mode);
+            Exit;
+          end;
+        SetCurPtr (P, Select_Mode);
+        NewLine (Select_Mode);
+    end; { PrevWord (CurPtr <= S }
+  { Track the cursor here (it is at CurPos.X = 0) so the view  }
+  { will redraw itself at column 0.  This eliminates having it }
+  { redraw starting at the current cursor and not being able   }
+  { to see text before the cursor.  Of course, we also end up  }
+  { redrawing the view twice, here and back in HandleEvent.    }
+  {                                                            }
+  { Reposition cursor so user can pick up where they left off. }
+  TrackCursor (Center_Cursor);
+  SetCurPtr (C - (L - BufLen), Select_Mode);
+  Do_Word_Wrap := True;
+end; { TEditor.Do_Word_Wrap }
+
+
+procedure TEditor.Draw;
+begin
+  if DrawLine <> Delta.Y then
+  begin
+    DrawPtr := LineMove (DrawPtr, Delta.Y - DrawLine);
+    DrawLine := Delta.Y;
+  end;
+  DrawLines (0, Size.Y, DrawPtr);
+end; { TEditor.Draw }
+
+
+procedure TEditor.DrawLines (Y, Count : Sw_Integer; LinePtr : Sw_Word);
+VAR
+  Color : Word;
+  B     : array[0..MaxLineLength - 1] of Word;  { This is array of video buffer cells. Has to be Word}
+begin
+  Color := GetColor ($0201);
+  while Count > 0 do
+  begin
+    FormatLine (B, LinePtr, Delta.X + Size.X, Color);
+    WriteBuf (0, Y, Size.X, 1, B[Delta.X]);
+    LinePtr := NextLine (LinePtr);
+    Inc (Y);
+    Dec (Count);
+  end;
+end; { TEditor.DrawLines }
+
+
+procedure TEditor.Find;
+VAR
+  FindRec : TFindDialogRec;
+begin
+  with FindRec do
+  begin
+    Find := FindStr;
+    Options := Flags;
+    if EditorDialog (edFind, @FindRec) <> cmCancel then
+    begin
+      FindStr := Find;
+      Flags := Options and not efDoReplace;
+      DoSearchReplace;
+    end;
+  end;
+end; { TEditor.Find }
+
+
+procedure TEditor.FormatLine (var DrawBuf; LinePtr : Sw_Word;
+                                  Width  : Sw_Integer;
+                                  Colors : Word);
+var
+  outptr : pword;
+  outcnt,
+  idxpos : Sw_Word;
+  attr   : Word;
+
+  procedure FillSpace(i:Sw_Word);
+  var
+    w : word;
+  begin
+    inc(OutCnt,i);
+    w:=32 or attr;
+    while (i>0) do
+     begin
+       OutPtr^:=w;
+       inc(OutPtr);
+       dec(i);
+     end;
+  end;
+
+  function FormatUntil(endpos:Sw_word):boolean;
+  var
+    p : PAnsiChar;
+  begin
+    FormatUntil:=false;
+    p:=PAnsiChar(Buffer)+idxpos;
+    while endpos>idxpos do
+     begin
+       if OutCnt>=Width then
+        exit;
+       case p^ of
+         #9 :
+           FillSpace(Tabsize-(outcnt mod Tabsize));
+         #10,#13 :
+           begin
+             FillSpace(Width-OutCnt);
+             FormatUntil:=true;
+             exit;
+           end;
+         else
+           begin
+             inc(OutCnt);
+             OutPtr^:=ord(p^) or attr;
+             inc(OutPtr);
+           end;
+       end; { case }
+       inc(p);
+       inc(idxpos);
+     end;
+  end;
+
+begin
+  OutCnt:=0;
+  OutPtr:=@DrawBuf;
+  idxPos:=LinePtr;
+  attr:=lo(Colors) shl 8;
+  if FormatUntil(SelStart) then
+   exit;
+  attr:=hi(Colors) shl 8;
+  if FormatUntil(CurPtr) then
+   exit;
+  inc(idxPos,GapLen);
+  if FormatUntil(SelEnd+GapLen) then
+   exit;
+  attr:=lo(Colors) shl 8;
+  if FormatUntil(BufSize) then
+   exit;
+{ fill up until width }
+  FillSpace(Width-OutCnt);
+end; {TEditor.FormatLine}
+
+
+function TEditor.GetLineDisplayLen: Sw_word;
+var S, E : Sw_word;
+begin
+  S:=LineStart(CurPtr);
+  E:=LineEnd(CurPtr);
+  GetLineDisplayLen:=Min(E-S,MaxLineLength-1);
+end; {TEditor.GetLineDisplayLen}
+
+
+function TEditor.GetMousePtr (Mouse : TPoint) : Sw_Word;
+begin
+  MakeLocal (Mouse, Mouse);
+  Mouse.X := Max (0, Min (Mouse.X, Size.X - 1));
+  Mouse.Y := Max (0, Min (Mouse.Y, Size.Y - 1));
+  GetMousePtr := CharPtr (LineMove (DrawPtr, Mouse.Y + Delta.Y - DrawLine),
+                          Mouse.X + Delta.X);
+end; { TEditor.GetMousePtr }
+
+
+function TEditor.GetPalette : PPalette;
+CONST
+  P : String[Length (CEditor)] = CEditor;
+begin
+  GetPalette := PPalette(@P);
+end; { TEditor.GetPalette }
+
+
+procedure TEditor.HandleEvent (var Event : TEvent);
+VAR
+  ShiftState   : Byte;
+  CenterCursor : Boolean;
+  SelectMode   : Byte;
+  D            : TPoint;
+  Mouse        : TPoint;
+  LinesScroll  : Sw_Integer;
+  E            : TEvent;
+
+  function CheckScrollBar (P : PScrollBar; var D : Sw_Integer) : Boolean;
+  begin
+    CheckScrollBar := FALSE;
+    if (Event.InfoPtr = P) and (P^.Value <> D) then
+    begin
+      D := P^.Value;
+      Update (ufView);
+      CheckScrollBar := TRUE;
+    end;
+  end; {CheckScrollBar}
+
+begin
+  Inherited HandleEvent (Event);
+  ConvertEvent (Event);
+  CenterCursor := not CursorVisible;
+  SelectMode := 0;
+  ShiftState:=GetShiftState;
+  if Selecting or (ShiftState and $03 <> 0) then
+    SelectMode := smExtend;
+  case Event.What of
+    evMouseWheel:
+      begin
+        if (Event.Wheel=mwDown) then { Mouse scroll down}
+          begin
+            Lock;
+            LinesScroll:=1;
+            if Event.Double then LinesScroll:=LinesScroll+4;
+            ScrollTo(Delta.X, Delta.Y + LinesScroll);
+            Unlock;
+          end else
+        if (Event.Wheel=mwUp) then  { Mouse scroll up }
+          begin
+            Lock;
+            LinesScroll:=-1;
+            if Event.Double then LinesScroll:=LinesScroll-4;
+            ScrollTo(Delta.X, Delta.Y + LinesScroll);
+            Unlock;
+          end
+        else exit;
+      end;
+    evMouseDown:
+      begin
+        if Event.Double then
+          SelectMode := SelectMode or smDouble;
+        repeat
+          Lock;
+          if Event.What = evMouseWheel then
+            begin
+              E:=Event;
+              HandleEvent(Event); { Scroll }
+              Event:=E;
+            end;
+          if Event.What = evMouseAuto then
+          begin
+            MakeLocal (Event.Where, Mouse);
+            D := Delta;
+            if Mouse.X < 0 then
+              Dec (D.X);
+            if Mouse.X >= Size.X then
+              Inc (D.X);
+            if Mouse.Y < 0 then
+              Dec (D.Y);
+            if Mouse.Y >= Size.Y then
+              Inc (D.Y);
+            ScrollTo (D.X, D.Y);
+          end;
+          SetCurPtr (GetMousePtr (Event.Where), SelectMode);
+          SelectMode := SelectMode or smExtend;
+          Unlock;
+        until not MouseEvent (Event, evMouseMove + evMouseAuto + evMouseWheel);
+      end; { evMouseDown }
+
+    evKeyDown:
+      case Event.CharCode of
+        #32..#255:
+          begin
+            Lock;
+            if Overwrite and not HasSelection then
+              if CurPtr <> LineEnd (CurPtr) then
+                SelEnd := NextChar (CurPtr);
+            InsertText (@Event.CharCode, 1, False);
+            if Word_Wrap then
+              Check_For_Word_Wrap (SelectMode, CenterCursor);
+            TrackCursor (CenterCursor);
+            Unlock;
+          end;
+
+      else
+        Exit;
+      end; { evKeyDown }
+
+    evCommand:
+      case Event.Command of
+        cmFind        : Find;
+        cmReplace     : Replace;
+        cmSearchAgain : DoSearchReplace;
+      else
+        begin
+          Lock;
+          case Event.Command of
+            cmCut         : ClipCut;
+            cmCopy        : ClipCopy;
+            cmPaste       : ClipPaste;
+            cmPasteText   : InsertText(Event.InfoPtr,Event.Id,false);
+            cmUndo        : Undo;
+            cmClear       : DeleteSelect;
+            cmCharLeft    : SetCurPtr (PrevChar  (CurPtr), SelectMode);
+            cmCharRight   : SetCurPtr (NextChar  (CurPtr), SelectMode);
+            cmWordLeft    : SetCurPtr (PrevWord  (CurPtr), SelectMode);
+            cmWordRight   : SetCurPtr (NextWord  (CurPtr), SelectMode);
+            cmLineStart   : SetCurPtr (LineStart (CurPtr), SelectMode);
+            cmLineEnd     : SetCurPtr (LineEnd   (CurPtr), SelectMode);
+            cmLineUp      : SetCurPtr (LineMove  (CurPtr, -1), SelectMode);
+            cmLineDown    : SetCurPtr (LineMove  (CurPtr, 1),  SelectMode);
+            cmPageUp      : SetCurPtr (LineMove  (CurPtr, - (Size.Y - 1)), SelectMode);
+            cmPageDown    : SetCurPtr (LineMove  (CurPtr, Size.Y - 1), SelectMode);
+            cmTextStart   : SetCurPtr (0, SelectMode);
+            cmTextEnd     : SetCurPtr (BufLen, SelectMode);
+            cmNewLine     : NewLine (SelectMode);
+            cmBackSpace   : DeleteRange (PrevChar (CurPtr), CurPtr, True);
+            cmDelChar     : DeleteRange (CurPtr, NextChar (CurPtr), True);
+            cmDelWord     : DeleteRange (CurPtr, NextWord (CurPtr), False);
+            cmDelStart    : DeleteRange (LineStart (CurPtr), CurPtr, False);
+            cmDelEnd      : DeleteRange (CurPtr, LineEnd (CurPtr), False);
+            cmDelLine     : DeleteRange (LineStart (CurPtr), NextLine (CurPtr), False);
+            cmInsMode     : ToggleInsMode;
+            cmStartSelect : StartSelect;
+            cmHideSelect  : HideSelect;
+            cmIndentMode  : begin
+                              AutoIndent := not AutoIndent;
+                              Update (ufStats);
+                            end; { Added provision to update TIndicator if ^QI pressed. }
+            cmCenterText  : Center_Text (SelectMode);
+            cmEndPage     : SetCurPtr (LineMove  (CurPtr, Delta.Y - CurPos.Y + Size.Y - 1), SelectMode);
+            cmHomePage    : SetCurPtr (LineMove  (CurPtr, -(CurPos.Y - Delta.Y)), SelectMode);
+            cmInsertLine  : Insert_Line (SelectMode);
+            cmJumpLine    : Jump_To_Line (SelectMode);
+            cmReformDoc   : Reformat_Document (SelectMode, CenterCursor);
+            cmReformPara  : Reformat_Paragraph (SelectMode, CenterCursor);
+            cmRightMargin : Set_Right_Margin;
+            cmScrollDown  : Scroll_Down;
+            cmScrollUp    : Scroll_Up;
+            cmSelectWord  : Select_Word;
+            cmSetTabs     : Set_Tabs;
+            cmTabKey      : Tab_Key (SelectMode);
+            cmWordWrap    : begin
+                              Word_Wrap := not Word_Wrap;
+                              Update (ufStats);
+                            end; { Added provision to update TIndicator if ^OW pressed. }
+            cmSetMark0    : Set_Place_Marker (10);
+            cmSetMark1    : Set_Place_Marker  (1);
+            cmSetMark2    : Set_Place_Marker  (2);
+            cmSetMark3    : Set_Place_Marker  (3);
+            cmSetMark4    : Set_Place_Marker  (4);
+            cmSetMark5    : Set_Place_Marker  (5);
+            cmSetMark6    : Set_Place_Marker  (6);
+            cmSetMark7    : Set_Place_Marker  (7);
+            cmSetMark8    : Set_Place_Marker  (8);
+            cmSetMark9    : Set_Place_Marker  (9);
+            cmJumpMark0   : Jump_Place_Marker (10, SelectMode);
+            cmJumpMark1   : Jump_Place_Marker  (1, SelectMode);
+            cmJumpMark2   : Jump_Place_Marker  (2, SelectMode);
+            cmJumpMark3   : Jump_Place_Marker  (3, SelectMode);
+            cmJumpMark4   : Jump_Place_Marker  (4, SelectMode);
+            cmJumpMark5   : Jump_Place_Marker  (5, SelectMode);
+            cmJumpMark6   : Jump_Place_Marker  (6, SelectMode);
+            cmJumpMark7   : Jump_Place_Marker  (7, SelectMode);
+            cmJumpMark8   : Jump_Place_Marker  (8, SelectMode);
+            cmJumpMark9   : Jump_Place_Marker  (9, SelectMode);
+          else
+            Unlock;
+            Exit;
+          end; { Event.Command (Inner) }
+          TrackCursor (CenterCursor);
+          { If the user presses any key except cmNewline or cmBackspace  }
+          { we need to check if the file has been modified yet.  There   }
+          { can be no spaces at the end of a line, or wordwrap doesn't   }
+          { work properly.  We don't want to do this if the file hasn't  }
+          { been modified because the user could be bringing in an ASCII }
+          { file from an editor that allows spaces at the EOL.  If we    }
+          { took them out in that scenario the "M" would appear on the   }
+          { TIndicator line and the user would get upset or confused.    }
+          if (Event.Command <> cmNewLine)   and
+             (Event.Command <> cmBackSpace) and
+             (Event.Command <> cmTabKey)    and
+              Modified then
+            Remove_EOL_Spaces (SelectMode);
+          Unlock;
+        end; { Event.Command (Outer) }
+      end; { evCommand }
+
+    evBroadcast:
+      case Event.Command of
+        cmScrollBarChanged:
+          if (Event.InfoPtr = HScrollBar) or
+            (Event.InfoPtr = VScrollBar) then
+          begin
+            CheckScrollBar (HScrollBar, Delta.X);
+            CheckScrollBar (VScrollBar, Delta.Y);
+          end
+          else
+            exit;
+      else
+        Exit;
+      end; { evBroadcast }
+
+  end;
+  ClearEvent (Event);
+end; { TEditor.HandleEvent }
+
+
+function TEditor.HasSelection : Boolean;
+begin
+  HasSelection := SelStart <> SelEnd;
+end; { TEditor.HasSelection }
+
+
+procedure TEditor.HideSelect;
+begin
+  Selecting := False;
+  SetSelect (CurPtr, CurPtr, False);
+end; { TEditor.HideSelect }
+
+
+procedure TEditor.InitBuffer;
+begin
+  Assert(Buffer = nil, 'TEditor.InitBuffer: Buffer is not nil');
+  ReAllocMem(Buffer, BufSize);
+end; { TEditor.InitBuffer }
+
+
+function TEditor.InsertBuffer (var P : PEditBuffer;
+                               Offset,    Length     : Sw_Word;
+                               AllowUndo, SelectText : Boolean) : Boolean;
+VAR
+  SelLen   : Sw_Word;
+  DelLen   : Sw_Word;
+  SelLines : Sw_Word;
+  Lines    : Sw_Word;
+  NewSize  : Longint;
+begin
+  InsertBuffer := True;
+  Selecting := False;
+  SelLen := SelEnd - SelStart;
+  if (SelLen = 0) and (Length = 0) then
+    Exit;
+  DelLen := 0;
+  if AllowUndo then
+    if CurPtr = SelStart then
+      DelLen := SelLen
+    else
+      if SelLen > InsCount then
+        DelLen := SelLen - InsCount;
+  NewSize := Longint (BufLen + DelCount - SelLen + DelLen) + Length;
+  if NewSize > BufLen + DelCount then
+    if (NewSize > MaxBufLength) or not SetBufSize (NewSize) then
+      begin
+        EditorDialog (edOutOfMemory, nil);
+        InsertBuffer := False;
+        SelEnd := SelStart;
+        Exit;
+      end;
+  SelLines := CountLines (Buffer^[BufPtr (SelStart)], SelLen);
+  if CurPtr = SelEnd then
+  begin
+    if AllowUndo then
+    begin
+      if DelLen > 0 then
+        Move (Buffer^[SelStart], Buffer^[CurPtr + GapLen - DelCount - DelLen], DelLen);
+      Dec (InsCount, SelLen - DelLen);
+    end;
+    CurPtr := SelStart;
+    Dec (CurPos.Y, SelLines);
+  end;
+  if Delta.Y > CurPos.Y then
+    begin
+      Dec (Delta.Y, SelLines);
+      if Delta.Y < CurPos.Y then
+        Delta.Y := CurPos.Y;
+    end;
+  if Length > 0 then
+    Move (P^[Offset], Buffer^[CurPtr], Length);
+  Lines := CountLines (Buffer^[CurPtr], Length);
+  Inc (CurPtr, Length);
+  Inc (CurPos.Y, Lines);
+  DrawLine := CurPos.Y;
+  DrawPtr := LineStart (CurPtr);
+  CurPos.X := CharPos (DrawPtr, CurPtr);
+  if not SelectText then
+    SelStart := CurPtr;
+  SelEnd := CurPtr;
+  if Length>Sellen then
+   begin
+     Inc (BufLen, Length - SelLen);
+     Dec (GapLen, Length - SelLen);
+   end
+  else
+   begin
+     Dec (BufLen, Sellen - Length);
+     Inc (GapLen, Sellen - Length);
+   end;
+  if AllowUndo then
+    begin
+      Inc (DelCount, DelLen);
+      Inc (InsCount, Length);
+    end;
+  Inc (Limit.Y, Lines - SelLines);
+  Delta.Y := Max (0, Min (Delta.Y, Limit.Y - Size.Y));
+  if not IsClipboard then
+    Modified := True;
+  SetBufSize (BufLen + DelCount);
+  if Not Word_Wrap then
+    Limit.X:=Max(Limit.X,GetLineDisplayLen+1);
+  if (SelLines = 0) and (Lines = 0) then
+    Update (ufLine)
+  else
+    Update (ufView);
+end; { TEditor.InsertBuffer }
+
+
+function TEditor.InsertFrom (Editor : PEditor) : Boolean;
+begin
+  InsertFrom := InsertBuffer (Editor^.Buffer,
+    Editor^.BufPtr (Editor^.SelStart),
+    Editor^.SelEnd - Editor^.SelStart, CanUndo, IsClipboard);
+end; { TEditor.InsertFrom }
+
+
+procedure TEditor.Insert_Line (Select_Mode : Byte);
+{ This procedure inserts a newline at the current cursor position }
+{ if a ^N is pressed.  Unlike cmNewLine, the cursor will return   }
+{ to its original position.  If the cursor was at the end of a    }
+{ line, and its spaces were removed, the cursor returns to the    }
+{ end of the line instead.                                        }
+begin
+  NewLine (Select_Mode);
+  SetCurPtr (LineEnd (LineMove (CurPtr, -1)), Select_Mode);
+end; { TEditor.Insert_Line }
+
+
+function TEditor.InsertText (Text       : Pointer;
+                             Length     : Sw_Word;
+                             SelectText : Boolean) : Boolean;
+begin
+  if assigned(Text) and not Search_Replace then
+    Update_Place_Markers (Length, 0, Self.SelStart, Self.SelEnd);
+  InsertText := InsertBuffer (PEditBuffer (Text),
+                0, Length, CanUndo, SelectText);
+end; { TEditor.InsertText }
+
+
+function TEditor.IsClipboard : Boolean;
+begin
+  IsClipboard := Clipboard = @Self;
+end; { TEditor.IsClipboard }
+
+
+procedure TEditor.Jump_Place_Marker (Element : Byte; Select_Mode : Byte);
+{ This procedure jumps to a place marker if ^Q# is pressed.  }
+{ We don't go anywhere if Place_Marker[Element] is not zero. }
+begin
+  if (not IsClipboard) and (Place_Marker[Element] <> 0) then
+    SetCurPtr (Place_Marker[Element], Select_Mode);
+end; { TEditor.Jump_Place_Marker }
+
+
+procedure TEditor.Jump_To_Line (Select_Mode : Byte);
+{ This function brings up a dialog box that allows }
+{ the user to select a line number to jump to.     }
+VAR
+  Code       : SmallInt;         { Used for Val conversion.      }
+  Temp_Value : Longint;         { Holds converted dialog value. }
+begin
+  if EditorDialog (edJumpToLine, @Line_Number) <> cmCancel then
+    begin
+      { Convert the Line_Number string to an interger. }
+      { Put it into Temp_Value.  If the number is not  }
+      { in the range 1..9999 abort.  If the number is  }
+      { our current Y position, abort.  Otherwise,     }
+      { go to top of document, and jump to the line.   }
+      { There are faster methods.  This one's easy.    }
+      { Note that CurPos.Y is always 1 less than what  }
+      { the TIndicator line says.                      }
+      val (Line_Number, Temp_Value, Code);
+      if (Temp_Value < 1) or (Temp_Value > 9999999) then
+        Exit;
+      if Temp_Value = CurPos.Y + 1 then
+        Exit;
+      SetCurPtr (0, Select_Mode);
+      SetCurPtr (LineMove (CurPtr, Temp_Value - 1), Select_Mode);
+    end;
+end; {TEditor.Jump_To_Line}
+
+
+function TEditor.LineEnd (P : Sw_Word) : Sw_Word;
+var
+  start,
+  i  : Sw_word;
+  pc : PAnsiChar;
+begin
+  if P<CurPtr then
+   begin
+     i:=CurPtr-P;
+     pc:=PAnsiChar(Buffer)+P;
+     while (i>0) do
+      begin
+        if pc^ in [#10,#13] then
+         begin
+           LineEnd:=pc-PAnsiChar(Buffer);
+           exit;
+         end;
+        inc(pc);
+        dec(i);
+      end;
+     start:=CurPtr;
+   end
+  else
+   start:=P;
+  i:=BufLen-Start;
+  pc:=PAnsiChar(Buffer)+GapLen+start;
+  while (i>0) do
+   begin
+     if pc^ in [#10,#13] then
+      begin
+        LineEnd:=pc-(PAnsiChar(Buffer)+Gaplen);
+        exit;
+      end;
+     inc(pc);
+     dec(i);
+   end;
+  LineEnd:=pc-(PAnsiChar(Buffer)+Gaplen);
+end; { TEditor.LineEnd }
+
+
+function TEditor.LineMove (P : Sw_Word; Count : Sw_Integer) : Sw_Word;
+VAR
+  Pos : Sw_Integer;
+  I   : Sw_Word;
+begin
+  I := P;
+  P := LineStart (P);
+  Pos := CharPos (P, I);
+  while Count <> 0 do
+   begin
+     I := P;
+     if Count < 0 then
+       begin
+         P := PrevLine (P);
+         Inc (Count);
+       end
+     else
+       begin
+         P := NextLine (P);
+         Dec (Count);
+       end;
+   end;
+  if P <> I then
+    P := CharPtr (P, Pos);
+  LineMove := P;
+end; { TEditor.LineMove }
+
+
+function TEditor.LineStart (P : Sw_Word) : Sw_Word;
+var
+  i  : Sw_word;
+  start,pc : PAnsiChar;
+  oc : AnsiChar;
+begin
+  if P>CurPtr then
+   begin
+     start:=PAnsiChar(Buffer)+GapLen;
+     pc:=start+P;
+     i:=P-CurPtr;
+     dec(pc);
+     while (i>0) do
+      begin
+        if pc^ in [#10,#13] then
+         break;
+        dec(pc);
+        dec(i);
+      end;
+   end
+  else
+   i:=0;
+  if i=0 then
+   begin
+     start:=PAnsiChar(Buffer);
+     i:=P;
+     pc:=start+p;
+     dec(pc);
+     while (i>0) do
+      begin
+        if pc^ in [#10,#13] then
+         break;
+        dec(pc);
+        dec(i);
+      end;
+     if i=0 then
+      begin
+        LineStart:=0;
+        exit;
+      end;
+   end;
+  oc:=pc^;
+  LineStart:=pc-start+1;
+end; { TEditor.LineStart }
+
+
+function TEditor.LineNr (P : Sw_Word) : Sw_Word;
+var
+  pc,endp : PAnsiChar;
+  lines : sw_word;
+begin
+  endp:=PAnsiChar(Buffer)+BufPtr(P);
+  pc:=PAnsiChar(Buffer);
+  lines:=0;
+  while (pc<endp) do
+   begin
+     if pc^ in [#10,#13] then
+      begin
+        inc(lines);
+        if ord((pc+1)^)+ord(pc^)=23 then
+         begin
+           inc(pc);
+           if (pc>=endp) then
+            break;
+         end;
+      end;
+     inc(pc);
+   end;
+  LineNr:=Lines;
+end;
+
+
+procedure TEditor.Lock;
+begin
+  Inc (LockCount);
+end; { TEditor.Lock }
+
+
+function TEditor.NewLine (Select_Mode : Byte) : Boolean;
+VAR
+  I : Sw_Word;          { Used to track spaces for AutoIndent.                 }
+  P : Sw_Word;          { Position of Cursor when we arrive and after Newline. }
+begin
+  P := LineStart (CurPtr);
+  I := P;
+  { The first thing we do is remove any End Of Line spaces.  }
+  { Then we check to see how many spaces are on beginning    }
+  { of a line.   We need this check to add them after CR/LF  }
+  { if AutoIndenting.  Last of all we insert spaces required }
+  { for the AutoIndenting, if it was on.                     }
+  Remove_EOL_Spaces (Select_Mode);
+  while (I < CurPtr) and ((Buffer^[I] in [#9,' '])) do
+    Inc (I);
+  if InsertText (@LineBreak[1], length(LineBreak), False) = FALSE then
+    exit;
+  if AutoIndent then
+    InsertText (@Buffer^[P], I - P, False);
+  { Remember where the CurPtr is at this moment.     }
+  { Remember the length of the buffer at the moment. }
+  { Go to the previous line and remove EOL spaces.   }
+  { Once removed, re-set the cursor to where we were }
+  { minus any spaces that might have been removed.   }
+  I := BufLen;
+  P := CurPtr;
+  SetCurPtr (LineMove (CurPtr, - 1), Select_Mode);
+  Remove_EOL_Spaces (Select_Mode);
+  if I - BufLen <> 0 then
+    SetCurPtr (P - (I - BufLen), Select_Mode)
+  else
+    SetCurPtr (P, Select_Mode);
+  NewLine:=true;
+end; { TEditor.NewLine }
+
+
+function TEditor.NextChar (P : Sw_Word) : Sw_Word;
+var
+  pc : PAnsiChar;
+begin
+  if P<>BufLen then
+   begin
+     inc(P);
+     if P<>BufLen then
+      begin
+        pc:=PAnsiChar(Buffer);
+        if P>=CurPtr then
+         inc(pc,GapLen);
+        inc(pc,P-1);
+        if ord(pc^)+ord((pc+1)^)=23 then
+         inc(p);
+      end;
+   end;
+  NextChar:=P;
+end; { TEditor.NextChar }
+
+
+function TEditor.NextLine (P : Sw_Word) : Sw_Word;
+begin
+  NextLine := NextChar (LineEnd (P));
+end; { TEditor.NextLine }
+
+
+function TEditor.NextWord (P : Sw_Word) : Sw_Word;
+begin
+  { skip word }
+  while (P < BufLen) and (BufChar (P) in WordChars) do
+    P := NextChar (P);
+  { skip spaces }
+  while (P < BufLen) and not (BufChar (P) in WordChars) do
+    P := NextChar (P);
+  NextWord := P;
+end; { TEditor.NextWord }
+
+
+function TEditor.PrevChar (P : Sw_Word) : Sw_Word;
+var
+  pc : PAnsiChar;
+begin
+  if p<>0 then
+   begin
+     dec(p);
+     if p<>0 then
+      begin
+        pc:=PAnsiChar(Buffer);
+        if P>=CurPtr then
+         inc(pc,GapLen);
+        inc(pc,P-1);
+        if ord(pc^)+ord((pc+1)^)=23 then
+         dec(p);
+      end;
+   end;
+  PrevChar:=P;
+end; { TEditor.PrevChar }
+
+
+function TEditor.PrevLine (P : Sw_Word) : Sw_Word;
+begin
+  PrevLine := LineStart (PrevChar (P));
+end; { TEditor.PrevLine }
+
+
+function TEditor.PrevWord (P : Sw_Word) : Sw_Word;
+begin
+  { skip spaces }
+  while (P > 0) and not (BufChar (PrevChar (P)) in WordChars) do
+    P := PrevChar (P);
+  { skip word }
+  while (P > 0) and (BufChar (PrevChar (P)) in WordChars) do
+    P := PrevChar (P);
+  PrevWord := P;
+end; { TEditor.PrevWord }
+
+
+procedure TEditor.Reformat_Document (Select_Mode : Byte; Center_Cursor : Boolean);
+{ This procedure will do a reformat of the entire document, or just    }
+{ from the current line to the end of the document, if ^QU is pressed. }
+{ It simply brings up the correct dialog box, and then calls the       }
+{ TEditor.Reformat_Paragraph procedure to do the actual reformatting.  }
+CONST
+  efCurrentLine   = $0000;  { Radio button #1 selection for dialog box.  }
+  efWholeDocument = $0001;  { Radio button #2 selection for dialog box.  }
+VAR
+  Reformat_Options : Word;  { Holds the dialog options for reformatting. }
+begin
+  { Check if Word_Wrap is toggled on.  If NOT on, check if programmer }
+  { allows reformatting of document and if not show user dialog that  }
+  { says reformatting is not permissable.                             }
+  if not Word_Wrap then
+    begin
+      if not Allow_Reformat then
+        begin
+          EditorDialog (edReformatNotAllowed, nil);
+          Exit;
+        end;
+      Word_Wrap := True;
+      Update (ufStats);
+    end;
+  { Default radio button option to 1st one.  Bring up dialog box. }
+  Reformat_Options := efCurrentLine;
+  if EditorDialog (edReformatDocument, @Reformat_Options) <> cmCancel then
+    begin
+      { If the option to reformat the whole document was selected   }
+      { we need to go back to start of document.  Otherwise we stay }
+      { on the current line.  Call Reformat_Paragraph until we get  }
+      { to the end of the document to do the reformatting.          }
+      if Reformat_Options and efWholeDocument <> 0 then
+        SetCurPtr (0, Select_Mode);
+      Unlock;
+      repeat
+        Lock;
+        if NOT Reformat_Paragraph (Select_Mode, Center_Cursor) then
+          Exit;
+        TrackCursor (False);
+        Unlock;
+      until CurPtr = BufLen;
+    end;
+end; { TEditor.Reformat_Document }
+
+
+function TEditor.Reformat_Paragraph (Select_Mode   : Byte;
+                                     Center_Cursor : Boolean) : Boolean;
+{ This procedure will do a reformat of the current paragraph if ^B pressed. }
+{ The feature works regardless if wordrap is on or off.  It also supports   }
+{ the AutoIndent feature.  Reformat is not possible if the CurPos exceeds   }
+{ the Right_Margin.  Right_Margin is where the EOL is considered to be.     }
+CONST
+  Space : array [1..2] of AnsiChar = #32#32;
+VAR
+  C : Sw_Word;  { Position of CurPtr when we come into procedure. }
+  E : Sw_Word;  { End of a line.                                  }
+  S : Sw_Word;  { Start of a line.                                }
+begin
+  Reformat_Paragraph := False;
+  { Check if Word_Wrap is toggled on.  If NOT on, check if programmer }
+  { allows reformatting of paragraph and if not show user dialog that }
+  { says reformatting is not permissable.                             }
+  if not Word_Wrap then
+    begin
+      if not Allow_Reformat then
+        begin
+          EditorDialog (edReformatNotAllowed, nil);
+          Exit;
+        end;
+      Word_Wrap := True;
+      Update (ufStats);
+    end;
+  C := CurPtr;
+  E := LineEnd (CurPtr);
+  S := LineStart (CurPtr);
+  { Reformat possible only if current line is NOT blank! }
+  if E <> S then
+    begin
+      { Reformat is NOT possible if the first word }
+      { on the line is beyond the Right_Margin.    }
+      S := LineStart (CurPtr);
+      if NextWord (S) - S >= Right_Margin - 1 then
+        begin
+          EditorDialog (edReformNotPossible, nil);
+          Exit;
+        end;
+      { First objective is to find the first blank line }
+      { after this paragraph so we know when to stop.   }
+      { That could be the end of the document.          }
+      Repeat
+        SetCurPtr (LineMove (CurPtr, 1), Select_Mode);
+        E := LineEnd (CurPtr);
+        S := LineStart (CurPtr);
+        BlankLine := E;
+      until ((CurPtr = BufLen) or (E = S));
+      SetCurPtr (C, Select_Mode);
+      repeat
+        { Set CurPtr to LineEnd and remove the EOL spaces. }
+        { Pull up the next line and remove its EOL space.  }
+        { First make sure the next line is not BlankLine!  }
+        { Insert spaces as required between the two lines. }
+        SetCurPtr (LineEnd (CurPtr), Select_Mode);
+        Remove_EOL_Spaces (Select_Mode);
+        if CurPtr <> Blankline - 2 then
+          DeleteRange (CurPtr, Nextword (CurPtr), True);
+        Remove_EOL_Spaces (Select_Mode);
+        case Buffer^[CurPtr-1] of
+          '!' : InsertText (@Space, 2, False);
+          '.' : InsertText (@Space, 2, False);
+          ':' : InsertText (@Space, 2, False);
+          '?' : InsertText (@Space, 2, False);
+        else
+          InsertText (@Space, 1, False);
+        end;
+        { Reset CurPtr to EOL.  While line length is > Right_Margin }
+        { go Do_Word_Wrap.  If wordrap failed, exit routine.        }
+        SetCurPtr (LineEnd (CurPtr), Select_Mode);
+        while LineEnd (CurPtr) - LineStart (CurPtr) > Right_Margin do
+          if not Do_Word_Wrap (Select_Mode, Center_Cursor) then
+              Exit;
+        { If LineEnd - LineStart > Right_Margin then set CurPtr    }
+        { to Right_Margin on current line.  Otherwise we set the   }
+        { CurPtr to LineEnd.  This gyration sets up the conditions }
+        { to test for time of loop exit.                           }
+        if LineEnd (CurPtr) - LineStart (CurPtr) > Right_Margin then
+          SetCurPtr (LineStart (CurPtr) + Right_Margin, Select_Mode)
+        else
+          SetCurPtr (LineEnd (CurPtr), Select_Mode);
+      until ((CurPtr >= BufLen) or (CurPtr >= BlankLine - 2));
+    end;
+  { If not at the end of the document reset CurPtr to start of next line. }
+  { This should be a blank line between paragraphs.                       }
+  if CurPtr < BufLen then
+    SetCurPtr (LineMove (CurPtr, 1), Select_Mode);
+  Reformat_Paragraph := True;
+end; { TEditor.Reformat_Paragraph }
+
+
+procedure TEditor.Remove_EOL_Spaces (Select_Mode : Byte);
+{ This procedure tests to see if there are consecutive spaces }
+{ at the end of a line (EOL).  If so, we delete all spaces    }
+{ after the last non-space character to the end of line.      }
+{ We then reset the CurPtr to where we ended up at.           }
+VAR
+  C : Sw_Word;           { Current pointer when we come into procedure. }
+  E : Sw_Word;           { End of line.                                 }
+  P : Sw_Word;           { Position of pointer at any given moment.     }
+  S : Sw_Word;           { Start of a line.                             }
+begin
+  C := CurPtr;
+  E := LineEnd (CurPtr);
+  P := E;
+  S := LineStart (CurPtr);
+  { Start at the end of a line and move towards the start. }
+  { Find first non-space character in that direction.      }
+  while (P > S) and (BufChar (PrevChar (P)) = #32) do
+    P := PrevChar (P);
+  { If we found any spaces then delete them. }
+  if P < E then
+    begin
+      SetSelect (P, E, True);
+      DeleteSelect;
+      Update_Place_Markers (0, E - P, P, E);
+    end;
+  { If C, our pointer when we came into this procedure, }
+  { is less than the CurPtr then reset CurPtr to C so   }
+  { cursor is where we started.  Otherwise, set it to   }
+  { the new CurPtr, for we have deleted characters.     }
+  if C < CurPtr then
+    SetCurPtr (C, Select_Mode)
+  else
+    SetCurPtr (CurPtr, Select_Mode);
+end; { TEditor.Remove_EOL_Spaces }
+
+
+procedure TEditor.Replace;
+VAR
+  ReplaceRec : TReplaceDialogRec;
+begin
+  with ReplaceRec do
+  begin
+    Find := FindStr;
+    Replace := ReplaceStr;
+    Options := Flags;
+    if EditorDialog (edReplace, @ReplaceRec) <> cmCancel then
+    begin
+      FindStr := Find;
+      ReplaceStr := Replace;
+      Flags := Options or efDoReplace;
+      DoSearchReplace;
+    end;
+  end;
+end; { TEditor.Replace }
+
+
+procedure TEditor.Scroll_Down;
+{ This procedure will scroll the screen up, and always keep      }
+{ the cursor on the CurPos.Y position, but not necessarily on    }
+{ the CurPos.X.  If CurPos.Y scrolls off the screen, the cursor  }
+{ will stay in the upper left corner of the screen.  This will   }
+{ simulate the same process in the IDE.  The CurPos.X coordinate }
+{ only messes up if we are on long lines and we then encounter   }
+{ a shorter or blank line beneath the current one as we scroll.  }
+{ In that case, it goes to the end of the new line.              }
+VAR
+  C : Sw_Word;           { Position of CurPtr when we enter procedure. }
+  P : Sw_Word;           { Position of CurPtr at any given time.       }
+  W : TPoint; { CurPos.Y of CurPtr and P ('.X and '.Y).     }
+begin
+  { Remember current cursor position.  Remember current CurPos.Y position. }
+  { Now issue the equivalent of a [Ctrl]-[End] command so the cursor will  }
+  { go to the bottom of the current screen.  Reset the cursor to this new  }
+  { position and then send FALSE to TrackCursor so we fool it into         }
+  { incrementing Delta.Y by only +1.  If we didn't do this it would try    }
+  { to center the cursor on the screen by fiddling with Delta.Y.           }
+  C := CurPtr;
+  W.X := CurPos.Y;
+  P := LineMove (CurPtr, Delta.Y - CurPos.Y + Size.Y);
+  SetCurPtr (P, 0);
+  TrackCursor (False);
+  { Now remember where the new CurPos.Y is.  See if distance between new }
+  { CurPos.Y and old CurPos.Y are greater than the current screen size.  }
+  { If they are, we need to move cursor position itself down by one.     }
+  { Otherwise, send the cursor back to our original CurPtr.              }
+  W.Y := CurPos.Y;
+  if W.Y - W.X > Size.Y - 1 then
+    SetCurPtr (LineMove (C, 1), 0)
+  else
+    SetCurPtr (C, 0);
+end; { TEditor.Scroll_Down }
+
+
+procedure TEditor.Scroll_Up;
+{ This procedure will scroll the screen down, and always keep    }
+{ the cursor on the CurPos.Y position, but not necessarily on    }
+{ the CurPos.X.  If CurPos.Y scrolls off the screen, the cursor  }
+{ will stay in the bottom left corner of the screen.  This will  }
+{ simulate the same process in the IDE.  The CurPos.X coordinate }
+{ only messes up if we are on long lines and we then encounter   }
+{ a shorter or blank line beneath the current one as we scroll.  }
+{ In that case, it goes to the end of the new line.              }
+VAR
+  C : Sw_Word;           { Position of CurPtr when we enter procedure. }
+  P : Sw_Word;           { Position of CurPtr at any given time.       }
+  W : TPoint; { CurPos.Y of CurPtr and P ('.X and '.Y).     }
+begin
+  { Remember current cursor position.  Remember current CurPos.Y position. }
+  { Now issue the equivalent of a [Ctrl]-[Home] command so the cursor will }
+  { go to the top of the current screen.  Reset the cursor to this new     }
+  { position and then send FALSE to TrackCursor so we fool it into         }
+  { decrementing Delta.Y by only -1.  If we didn't do this it would try    }
+  { to center the cursor on the screen by fiddling with Delta.Y.           }
+  C := CurPtr;
+  W.Y := CurPos.Y;
+  P := LineMove (CurPtr, -(CurPos.Y - Delta.Y + 1));
+  SetCurPtr (P, 0);
+  TrackCursor (False);
+  { Now remember where the new CurPos.Y is.  See if distance between new }
+  { CurPos.Y and old CurPos.Y are greater than the current screen size.  }
+  { If they are, we need to move the cursor position itself up by one.   }
+  { Otherwise, send the cursor back to our original CurPtr.              }
+  W.X := CurPos.Y;
+  if W.Y - W.X > Size.Y - 1 then
+    SetCurPtr (LineMove (C, -1), 0)
+  else
+    SetCurPtr (C, 0);
+end; { TEditor.Scroll_Up }
+
+
+procedure TEditor.ScrollTo (X, Y : Sw_Integer);
+begin
+  X := Max (0, Min (X, Limit.X - Size.X));
+  Y := Max (0, Min (Y, Limit.Y - Size.Y));
+  if (X <> Delta.X) or (Y <> Delta.Y) then
+  begin
+    Delta.X := X;
+    Delta.Y := Y;
+    Update (ufView);
+  end;
+end; { TEditor.ScrollTo }
+
+
+function TEditor.Search (const FindStr : String; Opts : Word) : Boolean;
+VAR
+  I,Pos : Sw_Word;
+begin
+  Search := False;
+  Pos := CurPtr;
+  repeat
+    if Opts and efCaseSensitive <> 0 then
+      I := Scan (Buffer^[BufPtr (Pos)], BufLen - Pos, FindStr)
+    else
+      I := IScan (Buffer^[BufPtr (Pos)], BufLen - Pos, FindStr);
+    if (I <> sfSearchFailed) then
+    begin
+      Inc (I, Pos);
+      if (Opts and efWholeWordsOnly = 0) or
+         not (((I <> 0) and (BufChar (I - 1) in WordChars)) or
+              ((I + Length (FindStr) <> BufLen) and
+               (BufChar (I + Length (FindStr)) in WordChars))) then
+        begin
+          Lock;
+          SetSelect (I, I + Length (FindStr), False);
+          TrackCursor (not CursorVisible);
+          Unlock;
+          Search := True;
+          Exit;
+        end
+      else
+        Pos := I + 1;
+    end;
+  until I = sfSearchFailed;
+end; { TEditor.Search }
+
+
+procedure TEditor.Select_Word;
+{ This procedure will select the a word to put into the clipboard.   }
+{ I've added it just to maintain compatibility with the IDE editor.  }
+{ Note that selection starts at the current cursor position and ends }
+{ when a space or the end of line is encountered.                    }
+VAR
+  E : Sw_Word;         { End of the current line.                           }
+  Select_Mode : Byte;  { Allows us to turn select mode on inside procedure. }
+begin
+  E := LineEnd (CurPtr);
+  { If the cursor is on a space or at the end of a line, abort. }
+  { Stupid action on users part for you can't select blanks!    }
+  if (BufChar (CurPtr) = #32) or (CurPtr = E) then
+    Exit;
+  { Turn on select mode and tell editor to start selecting text. }
+  { As long as we have a character > a space (this is done to    }
+  { exclude CR/LF pairs at end of a line) and we are NOT at the  }
+  { end of a line, set the CurPtr to the next character.         }
+  { Once we find a space or CR/LF, selection is done and we      }
+  { automatically put the selected word into the Clipboard.      }
+  Select_Mode := smExtend;
+  StartSelect;
+  while (BufChar (NextChar (CurPtr)) > #32) and (CurPtr < E) do
+    SetCurPtr (NextChar (CurPtr), Select_Mode);
+  SetCurPtr (NextChar (CurPtr), Select_Mode);
+  ClipCopy;
+end; {TEditor.Select_Word }
+
+
+procedure TEditor.SetBufLen (Length : Sw_Word);
+begin
+  BufLen := Length;
+  GapLen := BufSize - Length;
+  SelStart := 0;
+  SelEnd := 0;
+  CurPtr := 0;
+  CurPos.X:=0;
+  CurPos.Y:=0;
+  Delta.X:=0;
+  Delta.Y:=0;
+  GetLimits(Buffer^[GapLen], BufLen,Limit);
+  inc(Limit.X);
+  inc(Limit.Y);
+  DrawLine := 0;
+  DrawPtr := 0;
+  DelCount := 0;
+  InsCount := 0;
+  Modified := False;
+  Update (ufView);
+end; { TEditor.SetBufLen }
+
+
+function TEditor.SetBufSize (NewSize : Sw_Word) : Boolean;
+begin
+  if BufSize>=NewSize then SetBufSize:=true else SetBufSize:=false;
+end; { TEditor.SetBufSize }
+
+
+procedure TEditor.SetCmdState (Command : Word; Enable : Boolean);
+VAR
+  S : TCommandSet;
+begin
+  S := [Command];
+  if Enable and (State and sfActive <> 0) then
+    EnableCommands (S)
+  else
+    DisableCommands (S);
+end; { TEditor.SetCmdState }
+
+
+procedure TEditor.SetCurPtr (P : Sw_Word; SelectMode : Byte);
+VAR
+  Anchor : Sw_Word;
+begin
+  if SelectMode and smExtend = 0 then
+    Anchor := P
+  else
+    if CurPtr = SelStart then
+      Anchor := SelEnd
+    else
+      Anchor := SelStart;
+  if P < Anchor then
+    begin
+      if SelectMode and smDouble <> 0 then
+      begin
+        P := PrevLine (NextLine (P));
+        Anchor := NextLine (PrevLine (Anchor));
+      end;
+      SetSelect (P, Anchor, True);
+    end
+  else
+    begin
+      if SelectMode and smDouble <> 0 then
+      begin
+        P := NextLine (P);
+        Anchor := PrevLine (NextLine (Anchor));
+      end;
+      SetSelect (Anchor, P, False);
+    end;
+end; { TEditor.SetCurPtr }
+
+
+procedure TEditor.Set_Place_Marker (Element : Byte);
+{ This procedure sets a place marker for the CurPtr if ^K# is pressed. }
+begin
+  if not IsClipboard then
+    Place_Marker[Element] := CurPtr;
+end; { TEditor.Set_Place_Marker }
+
+
+procedure TEditor.Set_Right_Margin;
+{ This procedure will bring up a dialog box }
+{ that allows the user to set Right_Margin. }
+{ Values must be < MaxLineLength and > 9.   }
+VAR
+  Code        : SmallInt;          { Used for Val conversion.      }
+  Margin_Data : TRightMarginRec;  { Holds dialog results.         }
+  Temp_Value  : Sw_Integer;       { Holds converted dialog value. }
+begin
+  with Margin_Data do
+    begin
+      Str (Right_Margin, Margin_Position);
+      if EditorDialog (edRightMargin, @Margin_Position) <> cmCancel then
+        begin
+          val (Margin_Position, Temp_Value, Code);
+          if (Temp_Value <= MaxLineLength) and (Temp_Value > 9) then
+            Right_Margin := Temp_Value;
+        end;
+    end;
+end; { TEditor.Set_Right_Margin }
+
+
+procedure TEditor.SetSelect (NewStart, NewEnd : Sw_Word; CurStart : Boolean);
+VAR
+  UFlags : Byte;
+  P     : Sw_Word;
+  L     : Sw_Word;
+begin
+  if CurStart then
+    P := NewStart
+  else
+    P := NewEnd;
+  UFlags := ufUpdate;
+  if (NewStart <> SelStart) or (NewEnd <> SelEnd) then
+    if (NewStart <> NewEnd) or (SelStart <> SelEnd) then
+      UFlags := ufView;
+  if P <> CurPtr then
+  begin
+    if P > CurPtr then
+      begin
+        L := P - CurPtr;
+        Move (Buffer^[CurPtr + GapLen], Buffer^[CurPtr], L);
+        Inc (CurPos.Y, CountLines (Buffer^[CurPtr], L));
+        CurPtr := P;
+      end
+    else
+      begin
+        L := CurPtr - P;
+        CurPtr := P;
+        Dec (CurPos.Y, CountLines (Buffer^[CurPtr], L));
+        Move (Buffer^[CurPtr], Buffer^[CurPtr + GapLen], L);
+      end;
+    DrawLine := CurPos.Y;
+    DrawPtr := LineStart (P);
+    CurPos.X := CharPos (DrawPtr, P);
+    DelCount := 0;
+    InsCount := 0;
+    SetBufSize (BufLen);
+  end;
+  SelStart := NewStart;
+  SelEnd := NewEnd;
+  Update (UFlags);
+end; { TEditor.Select }
+
+
+procedure TEditor.SetState (AState : Word; Enable : Boolean);
+begin
+  Inherited SetState (AState, Enable);
+  case AState of
+    sfActive: begin
+                      if assigned(HScrollBar) then
+                        HScrollBar^.SetState (sfVisible, Enable);
+                      if assigned(VScrollBar) then
+                        VScrollBar^.SetState (sfVisible, Enable);
+                      if assigned(Indicator) then
+                        Indicator^.SetState (sfVisible, Enable);
+                      UpdateCommands;
+                    end;
+    sfExposed: if Enable then Unlock;
+  end;
+end; { TEditor.SetState }
+
+
+procedure TEditor.Set_Tabs;
+{ This procedure will bring up a dialog box }
+{ that allows the user to set tab stops.    }
+VAR
+  Index    : Sw_Integer;   { Index into string array. }
+  Tab_Data : TTabStopRec;  { Holds dialog results.    }
+begin
+  with Tab_Data do
+    begin
+      { Assign current Tab_Settings to Tab_String.    }
+      { Bring up the tab dialog so user can set tabs. }
+      Tab_String := Copy (Tab_Settings, 1, Tab_Stop_Length);
+      if EditorDialog (edSetTabStops, @Tab_String) <> cmCancel then
+        begin
+          { If Tab_String comes back as empty then set Tab_Settings to nil. }
+          { Otherwise, find the last character in Tab_String that is not    }
+          { a space and copy Tab_String into Tab_Settings up to that spot.  }
+          if Length (Tab_String) = 0 then
+            begin
+              FillChar (Tab_Settings, SizeOf (Tab_Settings), #0);
+              Exit;
+            end
+          else
+            begin
+              Index := Length (Tab_String);
+              while Tab_String[Index] <= #32 do
+                Dec (Index);
+              Tab_Settings := Copy (Tab_String, 1, Index);
+            end;
+        end;
+  end;
+end; { TEditor.Set_Tabs }
+
+
+procedure TEditor.StartSelect;
+begin
+  HideSelect;
+  Selecting := True;
+end; { TEditor.StartSelect }
+
+
+procedure TEditor.Store (var S : TStream);
+begin
+  Inherited Store (S);
+  PutPeerViewPtr (S, HScrollBar);
+  PutPeerViewPtr (S, VScrollBar);
+  PutPeerViewPtr (S, Indicator);
+  S.Write (BufSize, SizeOf (BufSize));
+  S.Write (Canundo, SizeOf (Canundo));
+  S.Write (AutoIndent,   SizeOf (AutoIndent));
+  S.Write (Line_Number,  SizeOf (Line_Number));
+  S.Write (Place_Marker, SizeOf (Place_Marker));
+  S.Write (Right_Margin, SizeOf (Right_Margin));
+  S.Write (Tab_Settings, SizeOf (Tab_Settings));
+  S.Write (Word_Wrap,    SizeOf (Word_Wrap));
+end; { Editor.Store }
+
+
+procedure TEditor.Tab_Key (Select_Mode : Byte);
+{ This function determines if we are in overstrike or insert mode,   }
+{ and then moves the cursor if overstrike, or adds spaces if insert. }
+VAR
+  E        : Sw_Word;                { End of current line.                }
+  Index    : Sw_Integer;             { Loop counter.                       }
+  Position : Sw_Integer;             { CurPos.X position.                  }
+  S        : Sw_Word;                { Start of current line.              }
+  Spaces   : array [1..80] of AnsiChar;  { Array to hold spaces for insertion. }
+begin
+  E := LineEnd (CurPtr);
+  S := LineStart (CurPtr);
+  { Find the current horizontal cursor position. }
+  { Now loop through the Tab_Settings string and }
+  { find the next available tab stop.            }
+  Position := CurPos.X + 1;
+  repeat
+    Inc (Position);
+  until (Tab_Settings[Position] <> #32) or (Position >= Length (Tab_Settings));
+  E := CurPos.X;
+  Index := 1;
+  { Now we enter a loop to go to the next tab position.  }
+  { If we are in overwrite mode, we just move the cursor }
+  { through the text to the next tab stop.  If we are in }
+  { insert mode, we add spaces to the Spaces array for   }
+  { the number of times we loop.                         }
+  while Index < Position - E do
+    begin
+      if Overwrite then
+        begin
+          if (Position > LineEnd (CurPtr) - LineStart (CurPtr))
+              or (Position > Length (Tab_Settings)) then
+            begin
+              SetCurPtr (LineStart (LineMove (CurPtr, 1)), Select_Mode);
+              Exit;
+            end
+          else
+            if CurPtr < BufLen then
+              SetCurPtr (NextChar (CurPtr), Select_Mode);
+        end
+      else
+        begin
+          if (Position > Right_Margin) or (Position > Length (Tab_Settings)) then
+            begin
+              SetCurPtr (LineStart (LineMove (CurPtr, 1)), Select_Mode);
+              Exit;
+            end
+          else
+            Spaces[Index] := #32;
+        end;
+      Inc (Index);
+  end;
+  { If we are insert mode, we insert spaces to the next tab stop.        }
+  { When we're all done, the cursor will be sitting on the new tab stop. }
+  if not OverWrite then
+    InsertText (@Spaces, Index - 1, False);
+end; { TEditor.Tab_Key }
+
+
+procedure TEditor.ToggleInsMode;
+begin
+  Overwrite := not Overwrite;
+  SetState (sfCursorIns, not GetState (sfCursorIns));
+end; { TEditor.ToggleInsMode }
+
+
+procedure TEditor.TrackCursor (Center : Boolean);
+begin
+  if Center then
+    ScrollTo (CurPos.X - Size.X + 1, CurPos.Y - Size.Y div 2)
+  else
+    ScrollTo (Max (CurPos.X - Size.X + 1, Min (Delta.X, CurPos.X)),
+              Max (CurPos.Y - Size.Y + 1, Min (Delta.Y, CurPos.Y)));
+end; { TEditor.TrackCursor }
+
+
+procedure TEditor.Undo;
+VAR
+  Length : Sw_Word;
+begin
+  if (DelCount <> 0) or (InsCount <> 0) then
+  begin
+    Update_Place_Markers (DelCount, 0, CurPtr, CurPtr + DelCount);
+    SelStart := CurPtr - InsCount;
+    SelEnd := CurPtr;
+    Length := DelCount;
+    DelCount := 0;
+    InsCount := 0;
+    InsertBuffer (Buffer, CurPtr + GapLen - Length, Length, False, True);
+  end;
+end; { TEditor.Undo }
+
+
+procedure TEditor.Unlock;
+begin
+  if LockCount > 0 then
+  begin
+    Dec (LockCount);
+    if LockCount = 0 then
+      DoUpdate;
+  end;
+end; { TEditor.Unlock }
+
+
+procedure TEditor.Update (AFlags : Byte);
+begin
+  UpdateFlags := UpdateFlags or AFlags;
+  if LockCount = 0 then
+    DoUpdate;
+end; { TEditor.Update }
+
+
+procedure TEditor.UpdateCommands;
+begin
+  SetCmdState (cmUndo, (DelCount <> 0) or (InsCount <> 0));
+  if not IsClipboard then
+    begin
+      SetCmdState (cmCut, HasSelection);
+      SetCmdState (cmCopy, HasSelection);
+      SetCmdState (cmPaste, assigned(Clipboard) and (Clipboard^.HasSelection));
+    end;
+  SetCmdState (cmClear, HasSelection);
+  SetCmdState (cmFind, True);
+  SetCmdState (cmReplace, True);
+  SetCmdState (cmSearchAgain, True);
+end; { TEditor.UpdateCommands }
+
+
+procedure TEditor.Update_Place_Markers (AddCount : Word; KillCount : Word;
+                                        StartPtr,EndPtr : Sw_Word);
+{ This procedure updates the position of the place markers }
+{ as the user inserts and deletes text in the document.    }
+VAR
+  Element : Byte;     { Place_Marker array element to traverse array with. }
+begin
+  for Element := 1 to 10 do
+    begin
+      if AddCount > 0 then
+        begin
+          if (Place_Marker[Element] >= Curptr)
+              and (Place_Marker[Element] <> 0) then
+            Place_Marker[Element] := Place_Marker[Element] + AddCount;
+        end
+      else
+        begin
+          if Place_Marker[Element] >= StartPtr then
+            begin
+              if (Place_Marker[Element] >= StartPtr) and
+                 (Place_Marker[Element] < EndPtr) then
+                Place_marker[Element] := 0
+              else
+                begin
+                  if SmallInt (Place_Marker[Element]) - SmallInt (KillCount) > 0 then
+                    Place_Marker[Element] := Place_Marker[Element] - KillCount
+                  else
+                    Place_Marker[Element] := 0;
+                end;
+            end;
+        end;
+    end;
+  if AddCount > 0 then
+    BlankLine := BlankLine + AddCount
+  else
+    begin
+      if SmallInt (BlankLine) - SmallInt (KillCount) > 0 then
+        BlankLine := BlankLine - KillCount
+      else
+        BlankLine := 0;
+    end;
+end; { TEditor.Update_Place_Markers }
+
+
+function TEditor.Valid (Command : Word) : Boolean;
+begin
+  Valid := IsValid;
+end; { TEditor.Valid }
+
+
+{****************************************************************************
+                                   TMEMO
+****************************************************************************}
+
+constructor TMemo.Load (var S : TStream);
+VAR
+  Length : Sw_Word;
+begin
+  Inherited Load (S);
+  S.Read (Length, SizeOf (Length));
+  if IsValid then
+    begin
+      S.Read (Buffer^[BufSize - Length], Length);
+      SetBufLen (Length);
+    end
+  else
+    S.Seek (S.GetPos + Length);
+end; { TMemo.Load }
+
+
+function TMemo.DataSize : Sw_Word;
+begin
+  DataSize := BufSize + SizeOf (Sw_Word);
+end; { TMemo.DataSize }
+
+
+procedure TMemo.GetData (var Rec);
+VAR
+  Data : TMemoData absolute Rec;
+begin
+  Data.Length := BufLen;
+  Move (Buffer^, Data.Buffer, CurPtr);
+  Move (Buffer^[CurPtr + GapLen], Data.Buffer[CurPtr], BufLen - CurPtr);
+  FillChar (Data.Buffer[BufLen], BufSize - BufLen, 0);
+end; { TMemo.GetData }
+
+
+function TMemo.GetPalette : PPalette;
+CONST
+  P : String[Length (CMemo)] = CMemo;
+begin
+  GetPalette := PPalette(@P);
+end; { TMemo.GetPalette }
+
+
+procedure TMemo.HandleEvent (var Event : TEvent);
+begin
+  if (Event.What <> evKeyDown) or (Event.KeyCode <> kbTab) then
+    Inherited HandleEvent (Event);
+end; { TMemo.HandleEvent }
+
+
+procedure TMemo.SetData (var Rec);
+VAR
+  Data : TMemoData absolute Rec;
+begin
+  Move (Data.Buffer, Buffer^[BufSize - Data.Length], Data.Length);
+  SetBufLen (Data.Length);
+end; { TMemo.SetData }
+
+
+procedure TMemo.Store (var S : TStream);
+begin
+  Inherited Store (S);
+  S.Write (BufLen, SizeOf (BufLen));
+  S.Write (Buffer^, CurPtr);
+  S.Write (Buffer^[CurPtr + GapLen], BufLen - CurPtr);
+end; { TMemo.Store }
+
+
+{****************************************************************************
+                               TFILEEDITOR
+****************************************************************************}
+
+
+constructor TFileEditor.Init (var Bounds : TRect;
+                              AHScrollBar, AVScrollBar : PScrollBar;
+                              AIndicator : PIndicator;
+                              AFileName  : FNameStr);
+begin
+  Inherited Init (Bounds, AHScrollBar, AVScrollBar, AIndicator, 0);
+  if AFileName <> '' then
+    begin
+      FileName := FExpand (AFileName);
+      if IsValid then
+        IsValid := LoadFile;
+    end;
+end; { TFileEditor.Init }
+
+
+constructor TFileEditor.Load (var S : TStream);
+VAR
+  SStart,SEnd,Curs : Sw_Word;
+begin
+  Inherited Load (S);
+  BufSize := 0;
+  S.Read (FileName[0], SizeOf (Byte));
+  S.Read (Filename[1], Length (FileName));
+  if IsValid then
+    IsValid := LoadFile;
+  S.Read (SStart, SizeOf (SStart));
+  S.Read (SEnd, SizeOf (SEnd));
+  S.Read (Curs, SizeOf (Curs));
+  if IsValid and (SEnd <= BufLen) then
+    begin
+      SetSelect (SStart, SEnd, Curs = SStart);
+      TrackCursor (True);
+    end;
+end; { TFileEditor.Load }
+
+
+procedure TFileEditor.DoneBuffer;
+begin
+  ReAllocMem(Buffer, 0);
+end; { TFileEditor.DoneBuffer }
+
+
+procedure TFileEditor.HandleEvent (var Event : TEvent);
+begin
+  Inherited HandleEvent (Event);
+  case Event.What of
+    evCommand:
+      case Event.Command of
+        cmSave   : Save;
+        cmSaveAs : SaveAs;
+        cmSaveDone : if Save then
+                       Message (Owner, evCommand, cmClose, nil);
+      else
+        Exit;
+      end;
+  else
+    Exit;
+  end;
+  ClearEvent (Event);
+end; { TFileEditor.HandleEvent }
+
+
+procedure TFileEditor.InitBuffer;
+begin
+  Assert(Buffer = nil, 'TFileEditor.InitBuffer: Buffer is not nil');
+  ReAllocMem(Buffer, MinBufLength);
+  BufSize := MinBufLength;
+end; { TFileEditor.InitBuffer }
+
+
+function TFileEditor.LoadFile: Boolean;
+VAR
+  Length : Sw_Word;
+  FSize : Longint;
+  FRead : Sw_Integer;
+  oFileMode : byte;
+  F : File;
+begin
+  LoadFile := False;
+  Length := 0;
+  oFileMode:=FileMode;   {save file open mode}
+  FileMode:=0;           {Reset will open file in read only mode }
+  Assign(F, FileName);
+  {$push}{$i-}Reset(F, 1);{$pop}
+  FileMode:=oFileMode;   {restore file open mode}
+  if IOResult <> 0 then
+    EditorDialog(edReadError, @FileName)
+  else
+    begin
+      FSize := FileSize(F);
+      if (FSize > MaxBufLength) or not SetBufSize(FSize) then
+        EditorDialog(edOutOfMemory, nil)
+      else
+        begin
+          BlockRead(F, Buffer^[BufSize-FSize], FSize, FRead);
+          if (IOResult <> 0) or (FRead<>FSize) then
+            EditorDialog(edReadError, @FileName)
+          else
+            begin
+              LoadFile := True;
+              Length := FRead;
+            end;
+        end;
+      Close(F);
+    end;
+  SetBufLen(Length);
+end; { TFileEditor.LoadFile }
+
+
+function TFileEditor.Save : Boolean;
+begin
+  if FileName = '' then
+    Save := SaveAs
+  else
+    Save := SaveFile;
+end; { TFileEditor.Save }
+
+
+function TFileEditor.SaveAs : Boolean;
+begin
+  SaveAs := False;
+  if EditorDialog (edSaveAs, @FileName) <> cmCancel then
+  begin
+    FileName := FExpand (FileName);
+    Message (Owner, evBroadcast, cmUpdateTitle, nil);
+    SaveAs := SaveFile;
+    if IsClipboard then
+      FileName := '';
+  end;
+end; { TFileEditor.SaveAs }
+
+
+function TFileEditor.SaveFile : Boolean;
+VAR
+  F          : File;
+  BackupName : FNameStr;
+  D          : DirStr;
+  N          : NameStr;
+  E          : ExtStr;
+begin
+  SaveFile := False;
+  if Flags and efBackupFiles <> 0 then
+  begin
+    FSplit (FileName, D, N, E);
+    BackupName := D + N + '.bak';
+    Assign (F, BackupName);
+    Erase (F);
+    Assign (F, FileName);
+    Rename (F, BackupName);
+    InOutRes := 0;
+  end;
+  Assign (F, FileName);
+  {$push}{$i-}Rewrite (F, 1);{$pop}
+  if IOResult <> 0 then
+    EditorDialog (edCreateError, @FileName)
+  else
+    begin
+      BlockWrite (F, Buffer^, CurPtr);
+      BlockWrite (F, Buffer^[CurPtr + GapLen], BufLen - CurPtr);
+      if IOResult <> 0 then
+        EditorDialog (edWriteError, @FileName)
+      else
+        begin
+          Modified := False;
+          Update (ufUpdate);
+          SaveFile := True;
+        end;
+        Close (F);
+   end;
+end; { TFileEditor.SaveFile }
+
+
+function TFileEditor.SetBufSize (NewSize : Sw_Word) : Boolean;
+VAR
+  N : Sw_Word;
+begin
+  SetBufSize := False;
+  if NewSize = 0 then
+    NewSize := MinBufLength
+  else
+    if NewSize > (MaxBufLength-MinBufLength) then
+      NewSize := MaxBufLength
+    else
+      NewSize := (NewSize + (MinBufLength-1)) and (MaxBufLength and (not (MinBufLength-1)));
+  if NewSize <> BufSize then
+   begin
+     if NewSize > BufSize then ReAllocMem(Buffer, NewSize);
+     N := BufLen - CurPtr + DelCount;
+     Move(Buffer^[BufSize - N], Buffer^[NewSize - N], N);
+     if NewSize < BufSize then ReAllocMem(Buffer, NewSize);
+     BufSize := NewSize;
+     GapLen := BufSize - BufLen;
+   end;
+  SetBufSize := True;
+end; { TFileEditor.SetBufSize }
+
+
+procedure TFileEditor.Store (var S : TStream);
+begin
+  Inherited Store (S);
+  S.Write (FileName, Length (FileName) + 1);
+  S.Write (SelStart, SizeOf (SelStart));
+  S.Write (SelEnd, SizeOf (SelEnd));
+  S.Write (CurPtr, SizeOf (CurPtr));
+end; { TFileEditor.Store }
+
+
+procedure TFileEditor.UpdateCommands;
+begin
+  Inherited UpdateCommands;
+  SetCmdState (cmSave, True);
+  SetCmdState (cmSaveAs, True);
+  SetCmdState (cmSaveDone, True);
+end; { TFileEditor.UpdateCommands }
+
+
+function TFileEditor.Valid (Command : Word) : Boolean;
+VAR
+  D : SmallInt;
+begin
+  if Command = cmValid then
+    Valid := IsValid
+  else
+    begin
+      Valid := True;
+      if Modified then
+        begin
+          if FileName = '' then
+            D := edSaveUntitled
+          else
+            D := edSaveModify;
+          case EditorDialog (D, @FileName) of
+            cmYes    : Valid := Save;
+            cmNo     : Modified := False;
+            cmCancel : Valid := False;
+          end;
+        end;
+    end;
+end; { TFileEditor.Valid }
+
+
+{****************************************************************************
+                             TEDITWINDOW
+****************************************************************************}
+
+constructor TEditWindow.Init (var Bounds   : TRect;
+                                  FileName : FNameStr;
+                                  ANumber  : SmallInt);
+var
+  HScrollBar : PScrollBar;
+  VScrollBar : PScrollBar;
+  Indicator  : PIndicator;
+  R          : TRect;
+begin
+  Inherited Init (Bounds, '', ANumber);
+  Options := Options or ofTileable;
+
+  R.Assign (18, Size.Y - 1, Size.X - 2, Size.Y);
+  HScrollBar := New (PScrollBar, Init (R));
+  HScrollBar^.Hide;
+  Insert (HScrollBar);
+
+  R.Assign (Size.X - 1, 1, Size.X, Size.Y - 1);
+  VScrollBar := New (PScrollBar, Init (R));
+  VScrollBar^.Hide;
+  Insert (VScrollBar);
+
+  R.Assign (2, Size.Y - 1, 16, Size.Y);
+  Indicator := New (PIndicator, Init (R));
+  Indicator^.Hide;
+  Insert (Indicator);
+
+  GetExtent (R);
+  R.Grow (-1, -1);
+  Editor := New (PFileEditor, Init (R, HScrollBar, VScrollBar, Indicator, FileName));
+  Insert (Editor);
+end; { TEditWindow.Init }
+
+
+constructor TEditWindow.Load (var S : TStream);
+begin
+  Inherited Load (S);
+  GetSubViewPtr (S, Editor);
+end; { TEditWindow.Load }
+
+
+procedure TEditWindow.Close;
+begin
+  if Editor^.IsClipboard then
+    Hide
+  else
+    Inherited Close;
+end; { TEditWindow.Close }
+
+
+function TEditWindow.GetTitle (MaxSize : Sw_Integer) : TTitleStr;
+begin
+  if Editor^.IsClipboard then
+    GetTitle := sClipboard
+  else
+    if Editor^.FileName = '' then
+      GetTitle := sUntitled
+    else
+      GetTitle := Editor^.FileName;
+end; { TEditWindow.GetTile }
+
+
+procedure TEditWindow.HandleEvent (var Event : TEvent);
+begin
+  Inherited HandleEvent (Event);
+  if (Event.What = evBroadcast) then
+    { and (Event.Command = cmUpdateTitle) then }
+    { Changed if statement above so I could test for cmBlugeonStats.       }
+    { Stats would not show up when loading a file until a key was pressed. }
+    case Event.Command of
+      cmUpdateTitle :
+        begin
+          Frame^.DrawView;
+          ClearEvent (Event);
+        end;
+      cmBludgeonStats :
+        begin
+          Editor^.Update (ufStats);
+          ClearEvent (Event);
+        end;
+    end;
+end; { TEditWindow.HandleEvent }
+
+
+procedure TEditWindow.SizeLimits(var Min, Max: TPoint);
+begin
+  inherited SizeLimits(Min, Max);
+  Min.X := 23;
+end;
+
+
+procedure TEditWindow.Store (var S : TStream);
+begin
+  Inherited Store (S);
+  PutSubViewPtr (S, Editor);
+end; { TEditWindow.Store }
+
+
+procedure RegisterEditors;
+begin
+  RegisterType (REditor);
+  RegisterType (RMemo);
+  RegisterType (RFileEditor);
+  RegisterType (RIndicator);
+  RegisterType (REditWindow);
+end; { RegisterEditors }
+
+
+end. { Unit NewEdit }

+ 1 - 3868
packages/fv/src/editors.pas

@@ -1,3868 +1 @@
-{$IFNDEF FPC_DOTTEDUNITS}
-unit Editors;
-{$ENDIF FPC_DOTTEDUNITS}
-{
-    This file is part of the Free Vision package
-   
-    The main source editor
-
-    Copyright (c) 1999-2022 by Peter Vreman
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
-{$i platform.inc}
-
-{$ifdef PPC_FPC}
-  {$H-}
-{$else}
-  {$F+,O+,E+,N+}
-{$endif}
-{$X+,R-,I-,Q-,V-}
-{$ifndef OS_UNIX}
-  {$S-}
-{$endif}
-
-
-{$define UNIXLF}
-
-{2.0 compatibility}
-{$ifdef VER2_0}
-  {$macro on}
-  {$define resourcestring := const}
-{$endif}
-
-interface
-
-{$IFDEF FPC_DOTTEDUNITS}
-uses
-  System.Objects, FreeVision.Drivers, FreeVision.Views, FreeVision.Dialogs,
-  FreeVision.Fvcommon, FreeVision.Fvconsts;
-{$ELSE FPC_DOTTEDUNITS}
-uses
-  Objects, Drivers,Views,Dialogs,FVCommon,FVConsts;
-{$ENDIF FPC_DOTTEDUNITS}
-
-const
-  { Length constants. }
-  Tab_Stop_Length = 74;
-
-{$ifdef BIT_16}
-  MaxLineLength  = 1024;
-  MinBufLength   = $1000;
-  MaxBufLength   = $ff00;
-  NotFoundValue  = $ffff;
-  LineInfoGrow   = 256;
-  MaxLines       = 16000;
-{$else}
-  MaxLineLength  = 4096;
-  MinBufLength   = $1000;
-  MaxBufLength   = $7fffff00;
-  NotFoundValue  = $ffffffff;
-  LineInfoGrow   = 1024;
-  MaxLines       = $7ffffff;
-{$endif}
-
-
-  { Editor constants for dialog boxes. }
-  edOutOfMemory   = 0;
-  edReadError     = 1;
-  edWriteError    = 2;
-  edCreateError   = 3;
-  edSaveModify    = 4;
-  edSaveUntitled  = 5;
-  edSaveAs        = 6;
-  edFind          = 7;
-  edSearchFailed  = 8;
-  edReplace       = 9;
-  edReplacePrompt = 10;
-
-  edJumpToLine         = 11;
-  edPasteNotPossible   = 12;
-  edReformatDocument   = 13;
-  edReformatNotAllowed = 14;
-  edReformNotPossible  = 15;
-  edReplaceNotPossible = 16;
-  edRightMargin        = 17;
-  edSetTabStops        = 18;
-  edWrapNotPossible    = 19;
-
-  { Editor flag constants for dialog options. }
-  efCaseSensitive   = $0001;
-  efWholeWordsOnly  = $0002;
-  efPromptOnReplace = $0004;
-  efReplaceAll      = $0008;
-  efDoReplace       = $0010;
-  efBackupFiles     = $0100;
-
-  { Constants for object palettes. }
-  CIndicator = #2#3;
-  CEditor    = #6#7;
-  CMemo      = #26#27;
-
-type
-  TEditorDialog = function (Dialog : SmallInt; Info : Pointer) : Word;
-
-  PIndicator = ^TIndicator;
-  TIndicator = object (TView)
-    Location   : TPoint;
-    Modified   : Boolean;
-    AutoIndent : Boolean;          { Added boolean for AutoIndent mode. }
-    WordWrap   : Boolean;          { Added boolean for WordWrap mode.   }
-    constructor Init (var Bounds : TRect);
-    procedure   Draw; virtual;
-    function    GetPalette : PPalette; virtual;
-    procedure   SetState (AState : Word; Enable : Boolean); virtual;
-    procedure   SetValue (ALocation : TPoint; IsAutoIndent : Boolean;
-                                                      IsModified   : Boolean;
-                                                      IsWordWrap   : Boolean);
-  end;
-
-  TLineInfoRec = record
-    Len,Attr : Sw_word;
-  end;
-  TLineInfoArr = array[0..MaxLines] of TLineInfoRec;
-  PLineInfoArr = ^TLineInfoArr;
-
-  PLineInfo = ^TLineInfo;
-  TLineInfo = object
-    Info : PLineInfoArr;
-    MaxPos : Sw_Word;
-    constructor Init;
-    destructor Done;
-    procedure Grow(pos:Sw_word);
-    procedure SetLen(pos,val:Sw_Word);
-    procedure SetAttr(pos,val:Sw_Word);
-    function  GetLen(pos:Sw_Word):Sw_Word;
-    function  GetAttr(pos:Sw_Word):Sw_Word;
-  end;
-
-
-  PEditBuffer = ^TEditBuffer;
-  TEditBuffer = array[0..MaxBufLength] of AnsiChar;
-
-  PEditor = ^TEditor;
-  TEditor = object (TView)
-    HScrollBar         : PScrollBar;
-    VScrollBar         : PScrollBar;
-    Indicator          : PIndicator;
-    Buffer             : PEditBuffer;
-    BufSize            : Sw_Word;
-    BufLen             : Sw_Word;
-    GapLen             : Sw_Word;
-    SelStart           : Sw_Word;
-    SelEnd             : Sw_Word;
-    CurPtr             : Sw_Word;
-    CurPos             : TPoint;
-    Delta              : TPoint;
-    Limit              : TPoint;
-    DrawLine           : Sw_Integer;
-    DrawPtr            : Sw_Word;
-    DelCount           : Sw_Word;
-    InsCount           : Sw_Word;
-    Flags              : Longint;
-    IsReadOnly         : Boolean;
-    IsValid            : Boolean;
-    CanUndo            : Boolean;
-    Modified           : Boolean;
-    Selecting          : Boolean;
-    Overwrite          : Boolean;
-    AutoIndent         : Boolean;
-    NoSelect           : Boolean;
-    TabSize            : Sw_Word; { tabsize for displaying }
-    BlankLine          : Sw_Word; { First blank line after a paragraph. }
-    Word_Wrap          : Boolean; { Added boolean to toggle wordwrap on/off. }
-    Line_Number        : string[8]; { Holds line number to jump to. }
-    Right_Margin       : Sw_Integer; { Added SmallInt to set right margin. }
-    Tab_Settings       : String[Tab_Stop_Length]; { Added string to hold tab stops. }
-
-    constructor Init (var Bounds : TRect; AHScrollBar, AVScrollBar : PScrollBar;
-                          AIndicator : PIndicator; ABufSize : Sw_Word);
-    constructor Load (var S : TStream);
-    destructor Done; virtual;
-    function   BufChar (P : Sw_Word) : AnsiChar;
-    function   BufPtr (P : Sw_Word) : Sw_Word;
-    procedure  ChangeBounds (var Bounds : TRect); virtual;
-    procedure  ConvertEvent (var Event : TEvent); virtual;
-    function   CursorVisible : Boolean;
-    procedure  DeleteSelect;
-    procedure  DoneBuffer; virtual;
-    procedure  Draw; virtual;
-    procedure  FormatLine (var DrawBuf; LinePtr : Sw_Word; Width : Sw_Integer; Colors : Word);virtual;
-    function   GetPalette : PPalette; virtual;
-    procedure  HandleEvent (var Event : TEvent); virtual;
-    procedure  InitBuffer; virtual;
-    function   InsertBuffer (var P : PEditBuffer; Offset, Length : Sw_Word;AllowUndo, SelectText : Boolean) : Boolean;
-    function   InsertFrom (Editor : PEditor) : Boolean; virtual;
-    function   InsertText (Text : Pointer; Length : Sw_Word; SelectText : Boolean) : Boolean;
-    procedure  ScrollTo (X, Y : Sw_Integer);
-    function   Search (const FindStr : String; Opts : Word) : Boolean;
-    function   SetBufSize (NewSize : Sw_Word) : Boolean; virtual;
-    procedure  SetCmdState (Command : Word; Enable : Boolean);
-    procedure  SetSelect (NewStart, NewEnd : Sw_Word; CurStart : Boolean);
-    procedure  SetCurPtr (P : Sw_Word; SelectMode : Byte);
-    procedure  SetState (AState : Word; Enable : Boolean); virtual;
-    procedure  Store (var S : TStream);
-    procedure  TrackCursor (Center : Boolean);
-    procedure  Undo;
-    procedure  UpdateCommands; virtual;
-    function   Valid (Command : Word) : Boolean; virtual;
-
-  private
-    KeyState       : SmallInt;
-    LockCount      : Byte;
-    UpdateFlags    : Byte;
-    Place_Marker   : Array [1..10] of Sw_Word; { Inserted array to hold place markers. }
-    Search_Replace : Boolean; { Added boolean to test for Search and Replace insertions. }
-
-    procedure  Center_Text (Select_Mode : Byte);
-    function   CharPos (P, Target : Sw_Word) : Sw_Integer;
-    function   CharPtr (P : Sw_Word; Target : Sw_Integer) : Sw_Word;
-    procedure  Check_For_Word_Wrap (Select_Mode : Byte; Center_Cursor : Boolean);
-    function   ClipCopy : Boolean;
-    procedure  ClipCut;
-    procedure  ClipPaste;
-    procedure  DeleteRange (StartPtr, EndPtr : Sw_Word; DelSelect : Boolean);
-    procedure  DoSearchReplace;
-    procedure  DoUpdate;
-    function   Do_Word_Wrap (Select_Mode : Byte; Center_Cursor : Boolean) : Boolean;
-    procedure  DrawLines (Y, Count : Sw_Integer; LinePtr : Sw_Word);
-    procedure  Find;
-    function   GetLineDisplayLen: Sw_word;
-    function   GetMousePtr (Mouse : TPoint) : Sw_Word;
-    function   HasSelection : Boolean;
-    procedure  HideSelect;
-    procedure  Insert_Line (Select_Mode : Byte);
-    function   IsClipboard : Boolean;
-    procedure  Jump_Place_Marker (Element : Byte; Select_Mode : Byte);
-    procedure  Jump_To_Line  (Select_Mode : Byte);
-    function   LineEnd (P : Sw_Word) : Sw_Word;
-    function   LineMove (P : Sw_Word; Count : Sw_Integer) : Sw_Word;
-    function   LineStart (P : Sw_Word) : Sw_Word;
-    function   LineNr (P : Sw_Word) : Sw_Word;
-    procedure  Lock;
-    function   NewLine (Select_Mode : Byte) : Boolean;
-    function   NextChar (P : Sw_Word) : Sw_Word;
-    function   NextLine (P : Sw_Word) : Sw_Word;
-    function   NextWord (P : Sw_Word) : Sw_Word;
-    function   PrevChar (P : Sw_Word) : Sw_Word;
-    function   PrevLine (P : Sw_Word) : Sw_Word;
-    function   PrevWord (P : Sw_Word) : Sw_Word;
-    procedure  Reformat_Document (Select_Mode : Byte; Center_Cursor : Boolean);
-    function   Reformat_Paragraph (Select_Mode : Byte; Center_Cursor : Boolean) : Boolean;
-    procedure  Remove_EOL_Spaces (Select_Mode : Byte);
-    procedure  Replace;
-    procedure  Scroll_Down;
-    procedure  Scroll_Up;
-    procedure  Select_Word;
-    procedure  SetBufLen (Length : Sw_Word);
-    procedure  Set_Place_Marker (Element : Byte);
-    procedure  Set_Right_Margin;
-    procedure  Set_Tabs;
-    procedure  StartSelect;
-    procedure  Tab_Key (Select_Mode : Byte);
-    procedure  ToggleInsMode;
-    procedure  Unlock;
-    procedure  Update (AFlags : Byte);
-    procedure  Update_Place_Markers (AddCount : Word; KillCount : Word; StartPtr,EndPtr : Sw_Word);
-  end;
-
-  TMemoData = record
-    Length : Sw_Word;
-    Buffer : TEditBuffer;
-  end;
-
-  PMemo = ^TMemo;
-  TMemo = object (TEditor)
-    constructor Load (var S : TStream);
-    function    DataSize : Sw_Word; virtual;
-    procedure   GetData (var Rec); virtual;
-    function    GetPalette : PPalette; virtual;
-    procedure   HandleEvent (var Event : TEvent); virtual;
-    procedure   SetData (var Rec); virtual;
-    procedure   Store (var S : TStream);
-  end;
-
-  PFileEditor = ^TFileEditor;
-  TFileEditor = object (TEditor)
-    FileName : FNameStr;
-    constructor Init (var Bounds : TRect; AHScrollBar, AVScrollBar : PScrollBar;
-                          AIndicator : PIndicator; AFileName : FNameStr);
-    constructor Load (var S : TStream);
-    procedure   DoneBuffer; virtual;
-    procedure   HandleEvent (var Event : TEvent); virtual;
-    procedure   InitBuffer; virtual;
-    function    LoadFile : Boolean;
-    function    Save : Boolean;
-    function    SaveAs : Boolean;
-    function    SaveFile : Boolean;
-    function    SetBufSize (NewSize : Sw_Word) : Boolean; virtual;
-    procedure   Store (var S : TStream);
-    procedure   UpdateCommands; virtual;
-    function    Valid (Command : Word) : Boolean; virtual;
-  end;
-
-  PEditWindow = ^TEditWindow;
-  TEditWindow = object (TWindow)
-    Editor : PFileEditor;
-    constructor Init (var Bounds : TRect; FileName : FNameStr; ANumber : SmallInt);
-    constructor Load (var S : TStream);
-    procedure   Close; virtual;
-    function    GetTitle (MaxSize : Sw_Integer) : TTitleStr; virtual;
-    procedure   HandleEvent (var Event : TEvent); virtual;
-    procedure   SizeLimits(var Min, Max: TPoint); virtual;
-    procedure   Store (var S : TStream);
-  end;
-
-
-function DefEditorDialog (Dialog : SmallInt; Info : Pointer) : Word;
-function CreateFindDialog: PDialog;
-function CreateReplaceDialog: PDialog;
-function JumpLineDialog : PDialog;
-function ReformDocDialog : PDialog;
-function RightMarginDialog : PDialog;
-function TabStopDialog : PDialog;
-function StdEditorDialog(Dialog: SmallInt; Info: Pointer): Word;
-
-const
-  WordChars    : set of AnsiChar = ['!'..#255];
-
-  LineBreak    : string[2]=
-{$ifdef UNIXLF}
-    #10;
-{$else}
-    #13#10;
-{$endif}
-
-
-  { The Allow_Reformat boolean is a programmer hook.  }
-  { I've placed this here to allow programmers to     }
-  { determine whether or not paragraph and document   }
-  { reformatting are allowed if Word_Wrap is not      }
-  { active.  Some people say don't allow, and others  }
-  { say allow it.  I've left it up to the programmer. }
-  { Set to FALSE if not allowed, or TRUE if allowed.  }
-  Allow_Reformat : Boolean = True;
-
-  EditorDialog   : TEditorDialog = {$ifdef fpc}@{$endif}DefEditorDialog;
-  EditorFlags    : Word = efBackupFiles + efPromptOnReplace;
-  FindStr        : String[80] = '';
-  ReplaceStr     : String[80] = '';
-  Clipboard      : PEditor = nil;
-
-  ToClipCmds     : TCommandSet = ([cmCut,cmCopy,cmClear]);
-  FromClipCmds   : TCommandSet = ([cmPaste]);
-  UndoCmds       : TCommandSet = ([cmUndo,cmRedo]);
-
-TYPE
-  TFindDialogRec =
-{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
-  packed
-{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
-  record
-    Find    : String[80];
-    Options : Word;
-  end;
-
-  TReplaceDialogRec =
-{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
-  packed
-{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
-  record
-       Find : String[80];
-    Replace : String[80];
-    Options : Word;
-  end;
-
-  TRightMarginRec =
-{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
-  packed
-{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
-  record
-    Margin_Position : String[3];
-  end;
-
-  TTabStopRec =
-{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
-  packed
-{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
-  record
-    Tab_String : String [Tab_Stop_Length];
-  end;
-
-CONST
-  { VMT constants. }
-  REditor   : TStreamRec = (ObjType : idEditor;
-                            VmtLink : Ofs (TypeOf (TEditor)^);
-                               Load : @TEditor.Load;
-                              Store : @TEditor.Store);
-
-  RMemo     : TStreamRec = (ObjType : idMemo;
-                            VmtLink : Ofs (TypeOf (TMemo)^);
-                               Load : @TMemo.Load;
-                              Store : @TMemo.Store);
-
-  RFileEditor : TStreamRec = (ObjType : idFileEditor;
-                              VmtLink : Ofs (TypeOf (TFileEditor)^);
-                                 Load : @TFileEditor.Load;
-                                Store : @TFileEditor.Store);
-
-  RIndicator : TStreamRec = (ObjType : idIndicator;
-                             VmtLink : Ofs (TypeOf (TIndicator)^);
-                                Load : @TIndicator.Load;
-                               Store : @TIndicator.Store);
-
-  REditWindow : TStreamRec = (ObjType : idEditWindow;
-                              VmtLink : Ofs (TypeOf (TEditWindow)^);
-                                 Load : @TEditWindow.Load;
-                                Store : @TEditWindow.Store);
-
-procedure RegisterEditors;
-
-
-{****************************************************************************
-                              Implementation
-****************************************************************************}
-
-implementation
-
-{$IFDEF FPC_DOTTEDUNITS}
-uses
-  TP.DOS, FreeVision.App, FreeVision.Stddlg, FreeVision.Msgbox{, System.Resources.Resource};
-{$ELSE FPC_DOTTEDUNITS}
-uses
-  Dos, App, StdDlg, MsgBox{, Resource};
-{$ENDIF FPC_DOTTEDUNITS}
-
-type
-  pword = ^word;
-
-resourcestring  sClipboard='Clipboard';
-                sFileCreateError='Error creating file %s';
-                sFileReadError='Error reading file %s';
-                sFileUntitled='Save untitled file?';
-                sFileWriteError='Error writing to file %s';
-                sFind='Find';
-                sJumpTo='Jump To';
-                sModified=''#3'%s'#13#10#13#3'has been modified.  Save?';
-                sOutOfMemory='Not enough memory for this operation.';
-                sPasteNotPossible='Wordwrap on:  Paste not possible in current margins when at end of line.';
-                sReformatDocument='Reformat Document';
-                sReformatNotPossible='Paragraph reformat not possible while trying to wrap current line with current margins.';
-                sReformattingTheDocument='Reformatting the document:';
-                sReplaceNotPossible='Wordwrap on:  Replace not possible in current margins when at end of line.';
-                sReplaceThisOccurence='Replace this occurrence?';
-                sRightMargin='Right Margin';
-                sSearchStringNotFound='Search string not found.';
-                sSelectWhereToBegin='Please select where to begin.';
-                sSetting='Setting:';
-                sTabSettings='Tab Settings';
-                sUnknownDialog='Unknown dialog requested!';
-                sUntitled='Untitled';
-                sWordWrapNotPossible='Wordwrap on:  Wordwrap not possible in current margins with continuous line.';
-                sWordWrapOff='You must turn on wordwrap before you can reformat.';
-                sSaveFileAs='Save file as';
-
-                slCaseSensitive='~C~ase sensitive';
-                slCurrentLine='~C~urrent line';
-                slEntireDocument='~E~ntire document';
-                slLineNumber='~L~ine number';
-                slNewText='~N~ew text';
-                slPromptOnReplace='~P~rompt on replace';
-                slReplace='~R~eplace';
-                slReplaceAll='~R~eplace all';
-                slTextToFind='~T~ext to find';
-                slWholeWordsOnly='~W~hole words only';
-
-
-CONST
-  { Update flag constants. }
-  ufUpdate = $01;
-  ufLine   = $02;
-  ufView   = $04;
-  ufStats  = $05;
-
-  { SelectMode constants. }
-  smExtend = $01;
-  smDouble = $02;
-
-  sfSearchFailed = NotFoundValue;
-
-  { Arrays that hold all the command keys and options. }
-  FirstKeys : array[0..46 * 2] of Word = (46, Ord (^A),    cmWordLeft,
-                                              Ord (^B),    cmReformPara,
-                                              Ord (^C),    cmPageDown,
-                                              Ord (^D),    cmCharRight,
-                                              Ord (^E),    cmLineUp,
-                                              Ord (^F),    cmWordRight,
-                                              Ord (^G),    cmDelChar,
-                                              Ord (^H),    cmBackSpace,
-                                              Ord (^I),    cmTabKey,
-                                              Ord (^J),    $FF04,
-                                              Ord (^K),    $FF02,
-                                              Ord (^L),    cmSearchAgain,
-                                              Ord (^M),    cmNewLine,
-                                              Ord (^N),    cmInsertLine,
-                                              Ord (^O),    $FF03,
-                                              Ord (^Q),    $FF01,
-                                              Ord (^R),    cmPageUp,
-                                              Ord (^S),    cmCharLeft,
-                                              Ord (^T),    cmDelWord,
-                                              Ord (^U),    cmUndo,
-                                              Ord (^V),    cmInsMode,
-                                              Ord (^W),    cmScrollUp,
-                                              Ord (^X),    cmLineDown,
-                                              Ord (^Y),    cmDelLine,
-                                              Ord (^Z),    cmScrollDown,
-                                              kbLeft,      cmCharLeft,
-                                              kbRight,     cmCharRight,
-                                              kbCtrlLeft,  cmWordLeft,
-                                              kbCtrlRight, cmWordRight,
-                                              kbHome,      cmLineStart,
-                                              kbEnd,       cmLineEnd,
-                                              kbCtrlHome,  cmHomePage,
-                                              kbCtrlEnd,   cmEndPage,
-                                              kbUp,        cmLineUp,
-                                              kbDown,      cmLineDown,
-                                              kbPgUp,      cmPageUp,
-                                              kbPgDn,      cmPageDown,
-                                              kbCtrlPgUp,  cmTextStart,
-                                              kbCtrlPgDn,  cmTextEnd,
-                                              kbIns,       cmInsMode,
-                                              kbDel,       cmDelChar,
-                                              kbCtrlBack,  cmDelStart,
-                                              kbShiftIns,  cmPaste,
-                                              kbShiftDel,  cmCut,
-                                              kbCtrlIns,   cmCopy,
-                                              kbCtrlDel,   cmClear);
-
-  { SCRLUP - Stop. } { Added ^W to scroll screen up.         }
-  { SCRLDN - Stop. } { Added ^Z to scroll screen down.       }
-  { REFORM - Stop. } { Added ^B for paragraph reformatting.  }
-  { PRETAB - Stop. } { Added ^I for preset tabbing.          }
-  { JLINE  - Stop. } { Added ^J to jump to a line number.    }
-  { INSLIN - Stop. } { Added ^N to insert line at cursor.    }
-  { INDENT - Stop. } { Removed ^O and put it into ^QI.       }
-  { HOMEND - Stop. } { Added kbCtrlHome and kbCtrlEnd pages. }
-  { CTRLBK - Stop. } { Added kbCtrlBack same as ^QH.         }
-
-  QuickKeys : array[0..21 * 2] of Word = (21, Ord ('0'), cmJumpMark0,
-                                              Ord ('1'), cmJumpMark1,
-                                              Ord ('2'), cmJumpMark2,
-                                              Ord ('3'), cmJumpMark3,
-                                              Ord ('4'), cmJumpMark4,
-                                              Ord ('5'), cmJumpMark5,
-                                              Ord ('6'), cmJumpMark6,
-                                              Ord ('7'), cmJumpMark7,
-                                              Ord ('8'), cmJumpMark8,
-                                              Ord ('9'), cmJumpMark9,
-                                              Ord ('A'), cmReplace,
-                                              Ord ('C'), cmTextEnd,
-                                              Ord ('D'), cmLineEnd,
-                                              Ord ('F'), cmFind,
-                                              Ord ('H'), cmDelStart,
-                                              Ord ('I'), cmIndentMode,
-                                              Ord ('L'), cmUndo,
-                                              Ord ('R'), cmTextStart,
-                                              Ord ('S'), cmLineStart,
-                                              Ord ('U'), cmReformDoc,
-                                              Ord ('Y'), cmDelEnd);
-
-  { UNDO   - Stop. } { Added IDE undo feature of ^QL.                  }
-  { REFDOC - Stop. } { Added document reformat feature if ^QU pressed. }
-  { MARK   - Stop. } { Added cmJumpMark# to allow place marking.       }
-  { INDENT - Stop. } { Moved IndentMode here from Firstkeys.           }
-
-  BlockKeys : array[0..20 * 2] of Word = (20, Ord ('0'), cmSetMark0,
-                                              Ord ('1'), cmSetMark1,
-                                              Ord ('2'), cmSetMark2,
-                                              Ord ('3'), cmSetMark3,
-                                              Ord ('4'), cmSetMark4,
-                                              Ord ('5'), cmSetMark5,
-                                              Ord ('6'), cmSetMark6,
-                                              Ord ('7'), cmSetMark7,
-                                              Ord ('8'), cmSetMark8,
-                                              Ord ('9'), cmSetMark9,
-                                              Ord ('B'), cmStartSelect,
-                                              Ord ('C'), cmPaste,
-                                              Ord ('D'), cmSave,
-                                              Ord ('F'), cmSaveAs,
-                                              Ord ('H'), cmHideSelect,
-                                              Ord ('K'), cmCopy,
-                                              Ord ('S'), cmSave,
-                                              Ord ('T'), cmSelectWord,
-                                              Ord ('Y'), cmCut,
-                                              Ord ('X'), cmSaveDone);
-
-  { SELWRD - Stop. } { Added ^KT to select word only. }
-  { SAVE   - Stop. } { Added ^KD, ^KF, ^KS, ^KX key commands.   }
-  { MARK   - Stop. } { Added cmSetMark# to allow place marking. }
-
-  FormatKeys : array[0..5 * 2] of Word = (5,  Ord ('C'), cmCenterText,
-                                              Ord ('T'), cmCenterText,
-                                              Ord ('I'), cmSetTabs,
-                                              Ord ('R'), cmRightMargin,
-                                              Ord ('W'), cmWordWrap);
-
-  { WRAP   - Stop. } { Added Wordwrap feature if ^OW pressed.          }
-  { RMSET  - Stop. } { Added set right margin feature if ^OR pressed.  }
-  { PRETAB - Stop. } { Added preset tab feature if ^OI pressed.        }
-  { CENTER - Stop. } { Added center text option ^OC for a line.        }
-
-  JumpKeys : array[0..1 * 2] of Word = (1, Ord ('L'), cmJumpLine);
-
-  { JLINE - Stop. } { Added jump to line number feature if ^JL pressed. }
-
-  KeyMap : array[0..4] of Pointer = (@FirstKeys,
-                                     @QuickKeys,
-                                     @BlockKeys,
-                                     @FormatKeys,
-                                     @JumpKeys);
-
-  { WRAP   - Stop. } { Added @FormatKeys for new ^O? keys. }
-  { PRETAB - Stop. } { Added @FormatKeys for new ^O? keys. }
-  { JLINE  - Stop. } { Added @JumpKeys for new ^J? keys.   }
-  { CENTER - Stop. } { Added @FormatKeys for new ^O? keys. }
-
-
-{****************************************************************************
-                                 Dialogs
-****************************************************************************}
-
-function DefEditorDialog (Dialog : SmallInt; Info : Pointer) : Word;
-begin
-  DefEditorDialog := cmCancel;
-end; { DefEditorDialog }
-
-
-function CreateFindDialog: PDialog;
-var
-  D: PDialog;
-  Control: PView;
-  R: TRect;
-begin
-  R.Assign(0, 0, 38, 12);
-  D := New(PDialog, Init(R,sFind));
-  with D^ do
-  begin
-    Options := Options or ofCentered;
-
-    R.Assign(3, 3, 32, 4);
-    Control := New(PInputLine, Init(R, 80));
-    Control^.HelpCtx := hcDFindText;
-    Insert(Control);
-    R.Assign(2, 2, 15, 3);
-    Insert(New(PLabel, Init(R, slTextToFind, Control)));
-    R.Assign(32, 3, 35, 4);
-    Insert(New(PHistory, Init(R, PInputLine(Control), 10)));
-
-    R.Assign(3, 5, 35, 7);
-    Control := New(PCheckBoxes, Init(R,
-        NewSItem (slCaseSensitive,
-        NewSItem (slWholeWordsOnly,nil))));
-    Control^.HelpCtx := hcCCaseSensitive;
-    Insert(Control);
-
-    R.Assign(14, 9, 24, 11);
-    Control := New (PButton, Init(R,slOK,cmOk,bfDefault));
-    Control^.HelpCtx := hcDOk;
-    Insert (Control);
-
-    Inc(R.A.X, 12); Inc(R.B.X, 12);
-    Control := New (PButton, Init(R,slCancel,cmCancel, bfNormal));
-    Control^.HelpCtx := hcDCancel;
-    Insert (Control);
-
-    SelectNext(False);
-  end;
-  CreateFindDialog := D;
-end;
-
-
-function CreateReplaceDialog: PDialog;
-var
-  D: PDialog;
-  Control: PView;
-  R: TRect;
-begin
-  R.Assign(0, 0, 40, 16);
-  D := New(PDialog, Init(R,slReplace));
-  with D^ do
-  begin
-    Options := Options or ofCentered;
-
-    R.Assign(3, 3, 34, 4);
-    Control := New(PInputLine, Init(R, 80));
-    Control^.HelpCtx := hcDFindText;
-    Insert(Control);
-    R.Assign(2, 2, 15, 3);
-    Insert(New(PLabel, Init(R,slTextToFind, Control)));
-    R.Assign(34, 3, 37, 4);
-    Insert(New(PHistory, Init(R, PInputLine(Control), 10)));
-
-    R.Assign(3, 6, 34, 7);
-    Control := New(PInputLine, Init(R, 80));
-    Control^.HelpCtx := hcDReplaceText;
-    Insert(Control);
-    R.Assign(2, 5, 12, 6);
-    Insert(New(PLabel, Init(R,slNewText, Control)));
-    R.Assign(34, 6, 37, 7);
-    Insert(New(PHistory, Init(R, PInputLine(Control), 11)));
-
-    R.Assign(3, 8, 37, 12);
-    Control := New (PCheckBoxes, Init (R,
-      NewSItem (slCasesensitive,
-      NewSItem (slWholewordsonly,
-      NewSItem (slPromptonreplace,
-      NewSItem (slReplaceall, nil))))));
-    Control^.HelpCtx := hcCCaseSensitive;
-    Insert (Control);
-
-    R.Assign (8, 13, 18, 15);
-    Control := New (PButton, Init (R,slOK, cmOk, bfDefault));
-    Control^.HelpCtx := hcDOk;
-    Insert (Control);
-
-    R.Assign (22, 13, 32, 15);
-    Control := New (PButton, Init (R,slCancel, cmCancel, bfNormal));
-    Control^.HelpCtx := hcDCancel;
-    Insert (Control);
-
-    SelectNext(False);
-  end;
-  CreateReplaceDialog := D;
-end;
-
-
-function JumpLineDialog : PDialog;
-VAR
-  D      : PDialog;
-  R      : TRect;
-  Control: PView;
-Begin
-  R.Assign (0, 0, 26, 8);
-  D := New(PDialog, Init(R,sJumpTo));
-  with D^ do
-    begin
-      Options := Options or ofCentered;
-
-      R.Assign (3, 2, 15, 3);
-      Control := New (PStaticText, Init (R,slLineNumber));
-      Insert (Control);
-
-      R.Assign (15, 2, 21, 3);
-      Control := New (PInputLine, Init (R, 4));
-      Control^.HelpCtx := hcDLineNumber;
-      Insert (Control);
-
-      R.Assign (21, 2, 24, 3);
-      Insert (New (PHistory, Init (R, PInputLine (Control), 12)));
-
-      R.Assign (2, 5, 12, 7);
-      Control := New (PButton, Init (R, slOK, cmOK, bfDefault));
-      Control^.HelpCtx := hcDOk;
-      Insert (Control);
-
-      R.Assign (14, 5, 24, 7);
-      Control := New (PButton, Init (R, slCancel, cmCancel, bfNormal));
-      Control^.HelpCtx := hcDCancel;
-      Insert (Control);
-
-      SelectNext (False);
-    end;
-  JumpLineDialog := D;
-end; { JumpLineDialog }
-
-
-function ReformDocDialog : PDialog;
-  { This is a local function that brings up a dialog box  }
-  { that asks where to start reformatting the document.   }
-VAR
-  R            : TRect;
-  D            : PDialog;
-  Control      : PView;
-Begin
-  R.Assign (0, 0, 32, 11);
-  D := New (PDialog, Init (R, sReformatDocument));
-  with D^ do
-    begin
-      Options := Options or ofCentered;
-
-      R.Assign (2, 2, 30, 3);
-      Control := New (PStaticText, Init (R, sSelectWhereToBegin));
-      Insert (Control);
-
-      R.Assign (3, 3, 29, 4);
-      Control := New (PStaticText, Init (R, sReformattingTheDocument));
-      Insert (Control);
-
-      R.Assign (50, 5, 68, 6);
-      Control := New (PLabel, Init (R, sReformatDocument, Control));
-      Insert (Control);
-
-      R.Assign (5, 5, 26, 7);
-      Control := New (PRadioButtons, Init (R,
-        NewSItem (slCurrentLine,
-        NewSItem (slEntireDocument, Nil))));
-      Control^.HelpCtx := hcDReformDoc;
-      Insert (Control);
-
-      R.Assign (4, 8, 14, 10);
-      Control := New (PButton, Init (R, slOK, cmOK, bfDefault));
-      Control^.HelpCtx := hcDOk;
-      Insert (Control);
-
-      R.Assign (17, 8, 27, 10);
-      Control := New (PButton, Init (R, slCancel, cmCancel, bfNormal));
-      Control^.HelpCtx := hcDCancel;
-      Insert (Control);
-
-      SelectNext (False);
-    end;
-    ReformDocDialog := D;
-end; { ReformDocDialog }
-
-
-function RightMarginDialog : PDialog;
-  { This is a local function that brings up a dialog box }
-  { that allows the user to change the Right_Margin.     }
-VAR
-  R        : TRect;
-  D        : PDialog;
-  Control  : PView;
-Begin
-  R.Assign (0, 0, 26, 8);
-  D := New (PDialog, Init (R, sRightMargin));
-  with D^ do
-    begin
-      Options := Options or ofCentered;
-
-      R.Assign (5, 2, 13, 3);
-      Control := New (PStaticText, Init (R, sSetting));
-      Insert (Control);
-
-      R.Assign (13, 2, 18, 3);
-      Control := New (PInputLine, Init (R, 3));
-      Control^.HelpCtx := hcDRightMargin;
-      Insert (Control);
-
-      R.Assign (18, 2, 21, 3);
-      Insert (New (PHistory, Init (R, PInputLine (Control), 13)));
-
-      R.Assign (2, 5, 12, 7);
-      Control := New (PButton, Init (R, slOK, cmOK, bfDefault));
-      Control^.HelpCtx := hcDOk;
-      Insert (Control);
-
-      R.Assign (14, 5, 24, 7);
-      Control := New (PButton, Init (R, slCancel, cmCancel, bfNormal));
-      Control^.HelpCtx := hcDCancel;
-      Insert (Control);
-
-      SelectNext (False);
-    end;
-  RightMarginDialog := D;
-end; { RightMarginDialog; }
-
-
-function TabStopDialog : PDialog;
-  { This is a local function that brings up a dialog box }
-  { that allows the user to set their own tab stops.     }
-VAR
-  Index      : Sw_Integer;       { Local Indexing variable.                 }
-  R          : TRect;
-  D          : PDialog;
-  Control    : PView;
-  Tab_Stop   : String[2];        { Local string to print tab column number. }
-Begin
-  R.Assign (0, 0, 80, 8);
-  D := New (PDialog, Init (R, sTabSettings));
-  with D^ do
-    begin
-      Options := Options or ofCentered;
-
-      R.Assign (2, 2, 77, 3);
-      Control := New (PStaticText, Init (R,
-                  ' ....|....|....|....|....|....|....|....|....|....|....|....|....|....|....'));
-      Insert (Control);
-
-      for Index := 1 to 7 do
-        begin
-          R.Assign (Index * 10 + 1, 1, Index * 10 + 3, 2);
-          Str (Index * 10, Tab_Stop);
-          Control := New (PStaticText, Init (R, Tab_Stop));
-          Insert (Control);
-        end;
-
-      R.Assign (2, 3, 78, 4);
-      Control := New (PInputLine, Init (R, 74));
-      Control^.HelpCtx := hcDTabStops;
-      Insert (Control);
-
-      R.Assign (38, 5, 41, 6);
-      Insert (New (PHistory, Init (R, PInputLine (Control), 14)));
-
-      R.Assign (27, 5, 37, 7);
-      Control := New (PButton, Init (R, slOK, cmOK, bfDefault));
-      Control^.HelpCtx := hcDOk;
-      Insert (Control);
-
-      R.Assign (42, 5, 52, 7);
-      Control := New (PButton, Init (R, slCancel, cmCancel, bfNormal));
-      Control^.HelpCtx := hcDCancel;
-      Insert (Control);
-      SelectNext (False);
-    end;
-  TabStopDialog := D;
-end { TabStopDialog };
-
-
-function StdEditorDialog(Dialog: SmallInt; Info: Pointer): Word;
-var
-  R: TRect;
-  T: TPoint;
-begin
-  case Dialog of
-    edOutOfMemory:
-      StdEditorDialog := MessageBox(sOutOfMemory, nil, mfError + mfOkButton);
-    edReadError:
-      StdEditorDialog := MessageBox(sFileReadError, @Info, mfError + mfOkButton);
-    edWriteError:
-      StdEditorDialog := MessageBox(sFileWriteError, @Info, mfError + mfOkButton);
-    edCreateError:
-      StdEditorDialog := MessageBox(sFileCreateError, @Info, mfError + mfOkButton);
-    edSaveModify:
-      StdEditorDialog := MessageBox(sModified, @Info, mfInformation + mfYesNoCancel);
-    edSaveUntitled:
-      StdEditorDialog := MessageBox(sFileUntitled, nil, mfInformation + mfYesNoCancel);
-    edSaveAs:
-      StdEditorDialog := Application^.ExecuteDialog(New(PFileDialog, Init('*.*',
-        sSaveFileAs, slName, fdOkButton, 101)), Info);
-    edFind:
-      StdEditorDialog := Application^.ExecuteDialog(CreateFindDialog, Info);
-    edSearchFailed:
-      StdEditorDialog := MessageBox(sSearchStringNotFound, nil, mfError + mfOkButton);
-    edReplace:
-      StdEditorDialog := Application^.ExecuteDialog(CreateReplaceDialog, Info);
-    edReplacePrompt:
-      begin
-        { Avoid placing the dialog on the same line as the cursor }
-        R.Assign(0, 1, 40, 8);
-        R.Move((Desktop^.Size.X - R.B.X) div 2, 0);
-        Desktop^.MakeGlobal(R.B, T);
-        Inc(T.Y);
-        if PPoint(Info)^.Y <= T.Y then
-          R.Move(0, Desktop^.Size.Y - R.B.Y - 2);
-        StdEditorDialog := MessageBoxRect(R, sReplaceThisOccurence,
-          nil, mfYesNoCancel + mfInformation);
-      end;
-    edJumpToLine:
-      StdEditorDialog := Application^.ExecuteDialog(JumpLineDialog, Info);
-    edSetTabStops:
-      StdEditorDialog := Application^.ExecuteDialog(TabStopDialog, Info);
-    edPasteNotPossible:
-      StdEditorDialog := MessageBox (sPasteNotPossible, nil, mfError + mfOkButton);
-    edReformatDocument:
-      StdEditorDialog := Application^.ExecuteDialog(ReformDocDialog, Info);
-    edReformatNotAllowed:
-      StdEditorDialog := MessageBox (sWordWrapOff, nil, mfError + mfOkButton);
-    edReformNotPossible:
-      StdEditorDialog := MessageBox (sReformatNotPossible, nil, mfError + mfOkButton);
-    edReplaceNotPossible:
-      StdEditorDialog := MessageBox (sReplaceNotPossible, nil, mfError + mfOkButton);
-    edRightMargin:
-      StdEditorDialog := Application^.ExecuteDialog(RightMarginDialog, Info);
-    edWrapNotPossible:
-      StdEditorDialog := MessageBox (sWordWrapNotPossible, nil, mfError + mfOKButton);
-  else
-    StdEditorDialog := MessageBox (sUnknownDialog, nil, mfError + mfOkButton);
-  end;
-end;
-
-
-{****************************************************************************
-                                 Helpers
-****************************************************************************}
-
-function CountLines(var Buf; Count: sw_Word): sw_Integer;
-var
-  p : PAnsiChar;
-  lines : sw_word;
-begin
-  p:=PAnsiChar(@buf);
-  lines:=0;
-  while (count>0) do
-   begin
-     if p^ in [#10,#13] then
-      begin
-        inc(lines);
-        if ord((p+1)^)+ord(p^)=23 then
-         begin
-           inc(p);
-           dec(count);
-           if count=0 then
-            break;
-         end;
-      end;
-     inc(p);
-     dec(count);
-   end;
-  CountLines:=Lines;
-end;
-
-
-procedure GetLimits(var Buf; Count: sw_Word;var lim:TPoint);
-{ Get the limits needed for Buf, its an extended version of countlines (lim.y),
-  which also gets the maximum line length in lim.x }
-var
-  p : PAnsiChar;
-  len : sw_word;
-begin
-  lim.x:=0;
-  lim.y:=0;
-  len:=0;
-  p:=PAnsiChar(@buf);
-  while (count>0) do
-   begin
-     if p^ in [#10,#13] then
-      begin
-        if len>lim.x then
-         lim.x:=len;
-        inc(lim.y);
-        if ord((p+1)^)+ord(p^)=23 then
-         begin
-           inc(p);
-           dec(count);
-         end;
-        len:=0;
-      end
-     else
-      inc(len);
-     inc(p);
-     dec(count);
-   end;
-end;
-
-
-function ScanKeyMap(KeyMap: Pointer; KeyCode: Word): Word;
-var
-  p : pword;
-  count : sw_word;
-begin
-  p:=keymap;
-  count:=p^;
-  inc(p);
-  while (count>0) do
-   begin
-     if (lo(p^)=lo(keycode)) and
-        ((hi(p^)=0) or (hi(p^)=hi(keycode))) then
-      begin
-        inc(p);
-        scankeymap:=p^;
-        exit;
-      end;
-     inc(p,2);
-     dec(count);
-   end;
-  scankeymap:=0;
-end;
-
-
-Type
-  Btable = Array[0..255] of Byte;
-Procedure BMMakeTable(const s:string; Var t : Btable);
-{ Makes a Boyer-Moore search table. s = the search String t = the table }
-Var
-  x : sw_integer;
-begin
-  FillChar(t,sizeof(t),length(s));
-  For x := length(s) downto 1 do
-   if (t[ord(s[x])] = length(s)) then
-    t[ord(s[x])] := length(s) - x;
-end;
-
-
-function Scan(var Block; Size: Sw_Word;const Str: String): Sw_Word;
-Var
-  buffer : Array[0..MaxBufLength-1] of Byte Absolute block;
-  s2     : String;
-  len,
-  numb   : Sw_Word;
-  found  : Boolean;
-  bt     : Btable;
-begin
-  BMMakeTable(str,bt);
-  len:=length(str);
-  SetLength(s2,len);       { sets the length to that of the search String }
-  found:=False;
-  numb:=pred(len);
-  While (not found) and (numb<(size-len)) do
-   begin
-     { partial match }
-     if buffer[numb] = ord(str[len]) then
-      begin
-        { less partial! }
-        if buffer[numb-pred(len)] = ord(str[1]) then
-         begin
-           move(buffer[numb-pred(len)],s2[1],len);
-           if (str=s2) then
-            begin
-              found:=true;
-              break;
-            end;
-         end;
-        inc(numb);
-     end
-    else
-     inc(numb,Bt[buffer[numb]]);
-  end;
-  if not found then
-    Scan := NotFoundValue
-  else
-    Scan := numb - pred(len);
-end;
-
-
-function IScan(var Block; Size: Sw_Word;const Str: String): Sw_Word;
-Var
-  buffer : Array[0..MaxBufLength-1] of AnsiChar Absolute block;
-  s      : String;
-  len,
-  numb,
-  x      : Sw_Word;
-  found  : Boolean;
-  bt     : Btable;
-  p      : PAnsiChar;
-  c      : AnsiChar;
-begin
-  len:=length(str);
-  if (len=0) or (len>size) then
-  begin
-    IScan := NotFoundValue;
-    exit;
-  end;
-  { create uppercased string }
-  SetLength(s,len);
-  for x:=1 to len do
-   begin
-     if str[x] in ['a'..'z'] then
-      s[x]:=chr(ord(str[x])-32)
-     else
-      s[x]:=str[x];
-   end;
-  BMMakeTable(s,bt);
-  found:=False;
-  numb:=pred(len);
-  While (not found) and (numb<(size-len)) do
-   begin
-     { partial match }
-     c:=buffer[numb];
-     if c in ['a'..'z'] then
-      c:=chr(ord(c)-32);
-     if (c=s[len]) then
-      begin
-        { less partial! }
-        p:=@buffer[numb-pred(len)];
-        x:=1;
-        while (x<=len) do
-         begin
-           if not(((p^ in ['a'..'z']) and (chr(ord(p^)-32)=s[x])) or
-                  (p^=s[x])) then
-            break;
-           inc(p);
-           inc(x);
-         end;
-        if (x>len) then
-         begin
-           found:=true;
-           break;
-         end;
-        inc(numb);
-     end
-    else
-     inc(numb,Bt[ord(c)]);
-  end;
-  if not found then
-    IScan := NotFoundValue
-  else
-    IScan := numb - pred(len);
-end;
-
-
-{****************************************************************************
-                                 TIndicator
-****************************************************************************}
-
-constructor TIndicator.Init (var Bounds : TRect);
-begin
-  Inherited Init (Bounds);
-  GrowMode := gfGrowLoY + gfGrowHiY;
-end; { TIndicator.Init }
-
-
-procedure TIndicator.Draw;
-VAR
-  Color : Byte;
-  Frame : AnsiChar;
-  L     : array[0..1] of PtrInt;
-  S     : String[15];
-  B     : TDrawBuffer;
-begin
-  if State and sfDragging = 0 then
-    begin
-      Color := GetColor (1);
-      Frame := #205;
-    end
-  else
-    begin
-      Color := GetColor (2);
-      Frame := #196;
-    end;
-  MoveChar (B, Frame, Color, Size.X);
-  { If the text has been modified, put an 'M' in the TIndicator display. }
-  if Modified then
-    WordRec (B[1]).Lo := 77;
-  { If WordWrap is active put a 'W' in the TIndicator display. }
-  if WordWrap then
-    WordRec (B[2]).Lo := 87
-  else
-    WordRec (B[2]).Lo := Byte (Frame);
-  { If AutoIndent is active put an 'I' in TIndicator display. }
-  if AutoIndent then
-    WordRec (B[0]).Lo := 73
-  else
-    WordRec (B[0]).Lo := Byte (Frame);
-  L[0] := Location.Y + 1;
-  L[1] := Location.X + 1;
-  FormatStr (S, ' %d:%d ', L);
-  MoveStr (B[9 - Pos (':', S)], S, Color);       { Changed original 8 to 9. }
-  WriteBuf (0, 0, Size.X, 1, B);
-end; { TIndicator.Draw }
-
-
-function TIndicator.GetPalette : PPalette;
-const
-  P : string[Length (CIndicator)] = CIndicator;
-begin
-  GetPalette := PPalette(@P);
-end; { TIndicator.GetPalette }
-
-
-procedure TIndicator.SetState (AState : Word; Enable : Boolean);
-begin
-  Inherited SetState (AState, Enable);
-  if AState = sfDragging then
-    DrawView;
-end; { TIndicator.SetState }
-
-
-procedure TIndicator.SetValue (ALocation : TPoint; IsAutoIndent : Boolean;
-                                                           IsModified   : Boolean;
-                                                           IsWordWrap   : Boolean);
-begin
-  if (Location.X<>ALocation.X) or
-     (Location.Y<>ALocation.Y) or
-     (AutoIndent <> IsAutoIndent) or
-     (Modified <> IsModified) or
-     (WordWrap <> IsWordWrap) then
-   begin
-     Location   := ALocation;
-     AutoIndent := IsAutoIndent;    { Added provisions to show AutoIndent. }
-     Modified   := IsModified;
-     WordWrap   := IsWordWrap;      { Added provisions to show WordWrap.   }
-     DrawView;
-   end;
-end; { TIndicator.SetValue }
-
-
-{****************************************************************************
-                                 TLineInfo
-****************************************************************************}
-
-constructor TLineInfo.Init;
-begin
-  MaxPos:=0;
-  Grow(1);
-end;
-
-
-destructor TLineInfo.Done;
-begin
-  FreeMem(Info,MaxPos*sizeof(TLineInfoRec));
-  Info := nil;
-end;
-
-
-procedure TLineInfo.Grow(pos:Sw_word);
-var
-  NewSize : Sw_word;
-  P : pointer;
-begin
-  NewSize:=(Pos+LineInfoGrow-(Pos mod LineInfoGrow));
-  GetMem(P,NewSize*sizeof(TLineInfoRec));
-  FillChar(P^,NewSize*sizeof(TLineInfoRec),0);
-  Move(Info^,P^,MaxPos*sizeof(TLineInfoRec));
-  Freemem(Info,MaxPos*sizeof(TLineInfoRec));
-  Info:=P;
-end;
-
-
-procedure TLineInfo.SetLen(pos,val:Sw_Word);
-begin
-  if pos>=MaxPos then
-   Grow(Pos);
-  Info^[Pos].Len:=val
-end;
-
-
-procedure TLineInfo.SetAttr(pos,val:Sw_Word);
-begin
-  if pos>=MaxPos then
-   Grow(Pos);
-  Info^[Pos].Attr:=val
-end;
-
-
-function TLineInfo.GetLen(pos:Sw_Word):Sw_Word;
-begin
-  GetLen:=Info^[Pos].Len;
-end;
-
-
-function TLineInfo.GetAttr(pos:Sw_Word):Sw_Word;
-begin
-  GetAttr:=Info^[Pos].Attr;
-end;
-
-
-
-{****************************************************************************
-                                 TEditor
-****************************************************************************}
-
-constructor TEditor.Init (var Bounds : TRect;
-                              AHScrollBar, AVScrollBar : PScrollBar;
-                              AIndicator : PIndicator; ABufSize : Sw_Word);
-var
-  Element : Byte;      { Place_Marker array element to initialize array with. }
-begin
-  Inherited Init (Bounds);
-  GrowMode := gfGrowHiX + gfGrowHiY;
-  Options := Options or ofSelectable;
-  Flags := EditorFlags;
-  EventMask := evMouseWheel + evMouseDown + evKeyDown + evCommand + evBroadcast;
-  ShowCursor;
-
-  HScrollBar := AHScrollBar;
-  VScrollBar := AVScrollBar;
-
-  Indicator := AIndicator;
-  BufSize := ABufSize;
-  CanUndo := True;
-  InitBuffer;
-
-  if assigned(Buffer) then
-    IsValid := True
-  else
-    begin
-      EditorDialog (edOutOfMemory, nil);
-      BufSize := 0;
-    end;
-
-  SetBufLen (0);
-
-  for Element := 1 to 10 do
-    Place_Marker[Element] := 0;
-
-  Element := 1;
-  while Element <= 70 do
-    begin
-      if Element mod 5 = 0 then
-        Insert ('x', Tab_Settings, Element)
-      else
-        Insert (#32, Tab_Settings, Element);
-      Inc (Element);
-    end;
-  { Default Right_Margin value.  Change it if you want another. }
-  Right_Margin := 76;
-  TabSize:=8;
-end; { TEditor.Init }
-
-
-constructor TEditor.Load (var S : TStream);
-begin
-  Inherited Load (S);
-  GetPeerViewPtr (S, HScrollBar);
-  GetPeerViewPtr (S, VScrollBar);
-  GetPeerViewPtr (S, Indicator);
-  S.Read (BufSize, SizeOf (BufSize));
-  S.Read (CanUndo, SizeOf (CanUndo));
-  S.Read (AutoIndent,   SizeOf (AutoIndent));
-  S.Read (Line_Number,  SizeOf (Line_Number));
-  S.Read (Place_Marker, SizeOf (Place_Marker));
-  S.Read (Right_Margin, SizeOf (Right_Margin));
-  S.Read (Tab_Settings, SizeOf (Tab_Settings));
-  S.Read (Word_Wrap,    SizeOf (Word_Wrap));
-  InitBuffer;
-  if Assigned(Buffer) then
-    IsValid := True
-  else
-    begin
-      EditorDialog (edOutOfMemory, nil);
-      BufSize := 0;
-    end;
-  Lock;
-  SetBufLen (0);
-end; { TEditor.Load }
-
-
-destructor TEditor.Done;
-begin
-  DoneBuffer;
-  Inherited Done;
-end; { TEditor.Done }
-
-
-function TEditor.BufChar(P: Sw_Word): AnsiChar;
-begin
-  if P>=CurPtr then
-   inc(P,Gaplen);
-  BufChar:=Buffer^[P];
-end;
-
-
-function TEditor.BufPtr(P: Sw_Word): Sw_Word;
-begin
-  if P>=CurPtr then
-   BufPtr:=P+GapLen
-  else
-   BufPtr:=P;
-end;
-
-
-procedure TEditor.Center_Text (Select_Mode : Byte);
-{ This procedure will center the current line of text. }
-{ Centering is based on the current Right_Margin.      }
-{ If the Line_Length exceeds the Right_Margin, or the  }
-{ line is just a blank line, we exit and do nothing.   }
-VAR
-  Spaces      : array [1..80] of AnsiChar;  { Array to hold spaces we'll insert. }
-  Index       : Byte;                   { Index into Spaces array.           }
-  Line_Length : Sw_Integer;             { Holds the length of the line.      }
-  E,S : Sw_Word;                        { End of the current line.           }
-begin
-  E := LineEnd (CurPtr);
-  S := LineStart (CurPtr);
-  { If the line is blank (only a CR/LF on it) then do noting. }
-  if E = S then
-    Exit;
-  { Set CurPtr to start of line.  Check if line begins with a space.  }
-  { We must strip out any spaces from the beginning, or end of lines. }
-  { If line does not start with space, make sure line length does not }
-  { exceed the Right_Margin.  If it does, then do nothing.            }
-  SetCurPtr (S, Select_Mode);
-  Remove_EOL_Spaces (Select_Mode);
-  if Buffer^[CurPtr] = #32 then
-    begin
-      { If the next word is greater than the end of line then do nothing. }
-      { If the line length is greater than Right_Margin then do nothing.  }
-      { Otherwise, delete all spaces at the start of line.                }
-      { Then reset end of line and put CurPtr at start of modified line.  }
-      E := LineEnd (CurPtr);
-      if NextWord (CurPtr) > E then
-        Exit;
-      if E - NextWord (CurPtr) > Right_Margin then
-        Exit;
-      DeleteRange (CurPtr, NextWord (CurPtr), True);
-      E := LineEnd (CurPtr);
-      SetCurPtr (LineStart (CurPtr), Select_Mode);
-    end
-  else
-    if E - CurPtr > Right_Margin then
-      Exit;
-  { Now we determine the real length of the line.       }
-  { Then we subtract the Line_Length from Right_Margin. }
-  { Dividing the result by two tells us how many spaces }
-  { must be inserted at start of line to center it.     }
-  { When we're all done, set the CurPtr to end of line. }
-  Line_Length := E - CurPtr;
-  for Index := 1 to ((Right_Margin - Line_Length) shr 1) do
-    Spaces[Index] := #32;
-  InsertText (@Spaces, Index, False);
-  SetCurPtr (LineEnd (CurPtr), Select_Mode);
-end; { TEditor.Center_Text }
-
-
-procedure TEditor.ChangeBounds (var Bounds : TRect);
-begin
-  SetBounds (Bounds);
-  Delta.X := Max (0, Min (Delta.X, Limit.X - Size.X));
-  Delta.Y := Max (0, Min (Delta.Y, Limit.Y - Size.Y));
-  Update (ufView);
-end; { TEditor.ChangeBounds }
-
-
-function TEditor.CharPos (P, Target : Sw_Word) : Sw_Integer;
-VAR
-  Pos : Sw_Integer;
-begin
-  Pos := 0;
-  while P < Target do
-   begin
-     if BufChar (P) = #9 then
-       Pos := Pos or 7;
-     Inc (Pos);
-     Inc (P);
-   end;
-  CharPos := Pos;
-end; { TEditor.CharPos }
-
-
-function TEditor.CharPtr (P : Sw_Word; Target : Sw_Integer) : Sw_Word;
-VAR
-  Pos : Sw_Integer;
-begin
-  Pos := 0;
-  while (Pos < Target) and (P < BufLen) and  not(BufChar (P) in [#10,#13]) do
-  begin
-    if BufChar (P) = #9 then
-      Pos := Pos or 7;
-    Inc (Pos);
-    Inc (P);
-  end;
-  if Pos > Target then
-    Dec (P);
-  CharPtr := P;
-end; { TEditor.CharPtr }
-
-
-procedure TEditor.Check_For_Word_Wrap (Select_Mode   : Byte;
-                                       Center_Cursor : Boolean);
-{ This procedure checks if CurPos.X > Right_Margin. }
-{ If it is, then we Do_Word_Wrap.  Simple, eh?      }
-begin
-  if CurPos.X > Right_Margin then
-    Do_Word_Wrap (Select_Mode, Center_Cursor);
-end; {Check_For_Word_Wrap}
-
-
-function TEditor.ClipCopy : Boolean;
-begin
-  ClipCopy := False;
-  if Assigned(Clipboard) and (Clipboard <> @Self) then
-   begin
-     ClipCopy := Clipboard^.InsertFrom (@Self);
-     Selecting := False;
-     Update (ufUpdate);
-  end;
-end; { TEditor.ClipCopy }
-
-
-procedure TEditor.ClipCut;
-begin
-  if ClipCopy then
-  begin
-    Update_Place_Markers (0,
-                          Self.SelEnd - Self.SelStart,
-                          Self.SelStart,
-                          Self.SelEnd);
-    DeleteSelect;
-  end;
-end; { TEditor.ClipCut }
-
-
-procedure TEditor.ClipPaste;
-begin
-  if Assigned(Clipboard) and (Clipboard <> @Self) then
-    begin
-      { Do not allow paste operations that will exceed }
-      { the Right_Margin when Word_Wrap is active and  }
-      { cursor is at EOL.                              }
-      if Word_Wrap and (CurPos.X > Right_Margin) then
-        begin
-          EditorDialog (edPasteNotPossible, nil);
-          Exit;
-        end;
-      { The editor will not copy selected text if the CurPtr }
-      { is not the same value as the SelStart.  However, it  }
-      { does return an InsCount.  This may, or may not, be a }
-      { bug.  We don't want to update the Place_Marker if    }
-      { there's no text copied.                              }
-      if CurPtr = SelStart then
-        Update_Place_Markers (Clipboard^.SelEnd - Clipboard^.SelStart,
-                              0,
-                              Clipboard^.SelStart,
-                              Clipboard^.SelEnd);
-      InsertFrom (Clipboard);
-    end;
-end; { TEditor.ClipPaste }
-
-
-procedure TEditor.ConvertEvent (var Event : TEvent);
-VAR
-  ShiftState : Byte;
-  Key        : Word;
-begin
-  ShiftState:=GetShiftState;
-  if Event.What = evKeyDown then
-  begin
-    if (ShiftState and $03 <> 0)
-                   and (Event.ScanCode >= $47)
-                   and (Event.ScanCode <= $51) then
-      Event.CharCode := #0;
-    Key := Event.KeyCode;
-    if KeyState <> 0 then
-    begin
-      if (Lo (Key) >= $01) and (Lo (Key) <= $1A) then
-        Inc (Key, $40);
-      if (Lo (Key) >= $61) and (Lo (Key) <= $7A) then
-        Dec (Key, $20);
-    end;
-    Key := ScanKeyMap (KeyMap[KeyState], Key);
-    KeyState := 0;
-    if Key <> 0 then
-      if Hi (Key) = $FF then
-        begin
-          KeyState := Lo (Key);
-          ClearEvent (Event);
-        end
-      else
-        begin
-          Event.What := evCommand;
-          Event.Command := Key;
-        end;
-  end;
-end; { TEditor.ConvertEvent }
-
-
-function TEditor.CursorVisible : Boolean;
-begin
-  CursorVisible := (CurPos.Y >= Delta.Y) and (CurPos.Y < Delta.Y + Size.Y);
-end; { TEditor.CursorVisible }
-
-
-procedure TEditor.DeleteRange (StartPtr, EndPtr : Sw_Word; DelSelect : Boolean);
-begin
-  { This will update Place_Marker for all deletions. }
-  { EXCEPT the Remove_EOL_Spaces deletion.           }
-  Update_Place_Markers (0, EndPtr - StartPtr, StartPtr, EndPtr);
-  if HasSelection and DelSelect then
-    DeleteSelect
-  else
-    begin
-      SetSelect (CurPtr, EndPtr, True);
-      DeleteSelect;
-      SetSelect (StartPtr, CurPtr, False);
-      DeleteSelect;
-    end;
-end; { TEditor.DeleteRange }
-
-
-procedure TEditor.DeleteSelect;
-begin
-  InsertText (nil, 0, False);
-end; { TEditor.DeleteSelect }
-
-
-procedure TEditor.DoneBuffer;
-begin
-  ReAllocMem(Buffer, 0);
-end; { TEditor.DoneBuffer }
-
-
-procedure TEditor.DoSearchReplace;
-VAR
-  I : Sw_Word;
-  C : TPoint;
-begin
-  repeat
-    I := cmCancel;
-    if not Search (FindStr, Flags) then
-      begin
-        if Flags and (efReplaceAll + efDoReplace) <> (efReplaceAll + efDoReplace) then
-          EditorDialog (edSearchFailed, nil)
-      end
-    else
-      if Flags and efDoReplace <> 0 then
-      begin
-        I := cmYes;
-        if Flags and efPromptOnReplace <> 0 then
-        begin
-          MakeGlobal (Cursor, C);
-          I := EditorDialog (edReplacePrompt, Pointer(@C));
-        end;
-        if I = cmYes then
-          begin
-            { If Word_Wrap is active and we are at EOL }
-            { disallow replace by bringing up a dialog }
-            { stating that replace is not possible.    }
-            if Word_Wrap and
-               ((CurPos.X + (Length (ReplaceStr) - Length (FindStr))) > Right_Margin) then
-              EditorDialog (edReplaceNotPossible, nil)
-            else
-              begin
-                Lock;
-                Search_Replace := True;
-                if length (ReplaceStr) < length (FindStr) then
-                  Update_Place_Markers (0,
-                                        Length (FindStr) - Length (ReplaceStr),
-                                        CurPtr - Length (FindStr) + Length (ReplaceStr),
-                                        CurPtr)
-                else
-                  if length (ReplaceStr) > length (FindStr) then
-                    Update_Place_Markers (Length (ReplaceStr) - Length (FindStr),
-                                          0,
-                                          CurPtr,
-                                          CurPtr + (Length (ReplaceStr) - Length (FindStr)));
-                InsertText (@ReplaceStr[1], Length (ReplaceStr), False);
-                Search_Replace := False;
-                TrackCursor (False);
-                Unlock;
-             end;
-          end;
-      end;
-  until (I = cmCancel) or (Flags and efReplaceAll = 0);
-end; { TEditor.DoSearchReplace }
-
-
-procedure TEditor.DoUpdate;
-begin
-  if UpdateFlags <> 0 then
-  begin
-    SetCursor (CurPos.X - Delta.X, CurPos.Y - Delta.Y);
-    if UpdateFlags and ufView <> 0 then
-      DrawView
-    else
-      if UpdateFlags and ufLine <> 0 then
-        DrawLines (CurPos.Y - Delta.Y, 1, LineStart (CurPtr));
-    if assigned(HScrollBar) then
-      HScrollBar^.SetParams (Delta.X, 0, Limit.X - Size.X, Size.X div 2, 1);
-    if assigned(VScrollBar) then
-      VScrollBar^.SetParams (Delta.Y, 0, Limit.Y - Size.Y, Size.Y - 1, 1);
-    if assigned(Indicator) then
-      Indicator^.SetValue (CurPos, AutoIndent, Modified, Word_Wrap);
-    if State and sfActive <> 0 then
-      UpdateCommands;
-    UpdateFlags := 0;
-  end;
-end; { TEditor.DoUpdate }
-
-
-function TEditor.Do_Word_Wrap (Select_Mode   : Byte;
-                               Center_Cursor : Boolean) : Boolean;
-{ This procedure does the actual wordwrap.  It always assumes the CurPtr }
-{ is at Right_Margin + 1.  It makes several tests for special conditions }
-{ and processes those first.  If they all fail, it does a normal wrap.   }
-VAR
-  A : Sw_Word;          { Distance between line start and first word on line. }
-  C : Sw_Word;          { Current pointer when we come into procedure.        }
-  L : Sw_Word;          { BufLen when we come into procedure.                 }
-  P : Sw_Word;          { Position of pointer at any given moment.            }
-  S : Sw_Word;          { Start of a line.                                    }
-begin
-  Do_Word_Wrap := False;
-  Select_Mode := 0;
-  if BufLen >= (BufSize - 1) then
-    exit;
-  C := CurPtr;
-  L := BufLen;
-  S := LineStart (CurPtr);
-  { If first character in the line is a space and autoindent mode is on  }
-  { then we check to see if NextWord(S) exceeds the CurPtr.  If it does, }
-  { we set CurPtr as the AutoIndent marker.  If it doesn't, we will set  }
-  { NextWord(S) as the AutoIndent marker.  If neither, we set it to S.   }
-  if AutoIndent and (Buffer^[S] = ' ') then
-    begin
-      if NextWord (S) > CurPtr then
-        A := CurPtr
-      else
-        A := NextWord (S);
-    end
-  else
-    A := NextWord (S);
-  { Though NewLine will remove EOL spaces, we do it here too. }
-  { This catches the instance where a user may try to space   }
-  { completely across the line, in which case CurPtr.X = 0.   }
-  Remove_EOL_Spaces (Select_Mode);
-  if CurPos.X = 0 then
-    begin
-      NewLine (Select_Mode);
-      Do_Word_Wrap := True;
-      Exit;
-    end;
-  { At this point we have one of five situations:                               }
-  {                                                                             }
-  { 1)  AutoIndent is on and this line is all spaces before CurPtr.             }
-  { 2)  AutoIndent is off and this line is all spaces before CurPtr.            }
-  { 3)  AutoIndent is on and this line is continuous characters before CurPtr.  }
-  { 4)  AutoIndent is off and this line is continuous characters before CurPtr. }
-  { 5)  This is just a normal line of text.                                     }
-  {                                                                             }
-  { Conditions 1 through 4 have to be taken into account before condition 5.    }
-  { First, we see if there are all spaces and/or all characters. }
-  { Then we determine which one it really is.  Finally, we take  }
-  { a course of action based on the state of AutoIndent.         }
-  if PrevWord (CurPtr) <= S then
-    begin
-      P := CurPtr - 1;
-      while ((Buffer^[P] <> ' ') and (P > S)) do
-        Dec (P);
-      { We found NO SPACES.  Conditions 4 and 5 are treated the same.  }
-      { We can NOT do word wrap and put up a dialog box stating such.  }
-      { Delete character just entered so we don't exceed Right_Margin. }
-      if P = S then
-        begin
-          EditorDialog (edWrapNotPossible, nil);
-          DeleteRange (PrevChar (CurPtr), CurPtr, True);
-          Exit;
-        end
-      else
-        begin
-          { There are spaces.  Now find out if they are all spaces. }
-          { If so, see if AutoIndent is on.  If it is, turn it off, }
-          { do a NewLine, and turn it back on.  Otherwise, just do  }
-          { the NewLine.  We go through all of these gyrations for  }
-          { AutoIndent.  Being way out here with a preceding line   }
-          { of spaces and wrapping with AutoIndent on is real dumb! }
-          { However, the user expects something.  The wrap will NOT }
-          { autoindent, but they had no business being here anyway! }
-          P := CurPtr - 1;
-          while ((Buffer^[P] = ' ') and (P > S)) do
-            Dec (P);
-          if P = S then
-            begin
-              if Autoindent then
-                begin
-                  AutoIndent := False;
-                  NewLine (Select_Mode);
-                  AutoIndent := True;
-                end
-              else
-                NewLine (Select_Mode);
-              end; { AutoIndent }
-            end; { P = S for spaces }
-        end { P = S for no spaces }
-    else { PrevWord (CurPtr) <= S }
-      begin
-        { Hooray!  We actually had a plain old line of text to wrap!       }
-        { Regardless if we are pushing out a line beyond the Right_Margin, }
-        { or at the end of a line itself, the following will determine     }
-        { exactly where to do the wrap and re-set the cursor accordingly.  }
-        { However, if P = A then we can't wrap.  Show dialog and exit.     }
-        P := CurPtr;
-        while P - S > Right_Margin do
-          P := PrevWord (P);
-        if (P = A) then
-          begin
-            EditorDialog (edReformNotPossible, nil);
-            SetCurPtr (P, Select_Mode);
-            Exit;
-          end;
-        SetCurPtr (P, Select_Mode);
-        NewLine (Select_Mode);
-    end; { PrevWord (CurPtr <= S }
-  { Track the cursor here (it is at CurPos.X = 0) so the view  }
-  { will redraw itself at column 0.  This eliminates having it }
-  { redraw starting at the current cursor and not being able   }
-  { to see text before the cursor.  Of course, we also end up  }
-  { redrawing the view twice, here and back in HandleEvent.    }
-  {                                                            }
-  { Reposition cursor so user can pick up where they left off. }
-  TrackCursor (Center_Cursor);
-  SetCurPtr (C - (L - BufLen), Select_Mode);
-  Do_Word_Wrap := True;
-end; { TEditor.Do_Word_Wrap }
-
-
-procedure TEditor.Draw;
-begin
-  if DrawLine <> Delta.Y then
-  begin
-    DrawPtr := LineMove (DrawPtr, Delta.Y - DrawLine);
-    DrawLine := Delta.Y;
-  end;
-  DrawLines (0, Size.Y, DrawPtr);
-end; { TEditor.Draw }
-
-
-procedure TEditor.DrawLines (Y, Count : Sw_Integer; LinePtr : Sw_Word);
-VAR
-  Color : Word;
-  B     : array[0..MaxLineLength - 1] of Word;  { This is array of video buffer cells. Has to be Word}
-begin
-  Color := GetColor ($0201);
-  while Count > 0 do
-  begin
-    FormatLine (B, LinePtr, Delta.X + Size.X, Color);
-    WriteBuf (0, Y, Size.X, 1, B[Delta.X]);
-    LinePtr := NextLine (LinePtr);
-    Inc (Y);
-    Dec (Count);
-  end;
-end; { TEditor.DrawLines }
-
-
-procedure TEditor.Find;
-VAR
-  FindRec : TFindDialogRec;
-begin
-  with FindRec do
-  begin
-    Find := FindStr;
-    Options := Flags;
-    if EditorDialog (edFind, @FindRec) <> cmCancel then
-    begin
-      FindStr := Find;
-      Flags := Options and not efDoReplace;
-      DoSearchReplace;
-    end;
-  end;
-end; { TEditor.Find }
-
-
-procedure TEditor.FormatLine (var DrawBuf; LinePtr : Sw_Word;
-                                  Width  : Sw_Integer;
-                                  Colors : Word);
-var
-  outptr : pword;
-  outcnt,
-  idxpos : Sw_Word;
-  attr   : Word;
-
-  procedure FillSpace(i:Sw_Word);
-  var
-    w : word;
-  begin
-    inc(OutCnt,i);
-    w:=32 or attr;
-    while (i>0) do
-     begin
-       OutPtr^:=w;
-       inc(OutPtr);
-       dec(i);
-     end;
-  end;
-
-  function FormatUntil(endpos:Sw_word):boolean;
-  var
-    p : PAnsiChar;
-  begin
-    FormatUntil:=false;
-    p:=PAnsiChar(Buffer)+idxpos;
-    while endpos>idxpos do
-     begin
-       if OutCnt>=Width then
-        exit;
-       case p^ of
-         #9 :
-           FillSpace(Tabsize-(outcnt mod Tabsize));
-         #10,#13 :
-           begin
-             FillSpace(Width-OutCnt);
-             FormatUntil:=true;
-             exit;
-           end;
-         else
-           begin
-             inc(OutCnt);
-             OutPtr^:=ord(p^) or attr;
-             inc(OutPtr);
-           end;
-       end; { case }
-       inc(p);
-       inc(idxpos);
-     end;
-  end;
-
-begin
-  OutCnt:=0;
-  OutPtr:=@DrawBuf;
-  idxPos:=LinePtr;
-  attr:=lo(Colors) shl 8;
-  if FormatUntil(SelStart) then
-   exit;
-  attr:=hi(Colors) shl 8;
-  if FormatUntil(CurPtr) then
-   exit;
-  inc(idxPos,GapLen);
-  if FormatUntil(SelEnd+GapLen) then
-   exit;
-  attr:=lo(Colors) shl 8;
-  if FormatUntil(BufSize) then
-   exit;
-{ fill up until width }
-  FillSpace(Width-OutCnt);
-end; {TEditor.FormatLine}
-
-
-function TEditor.GetLineDisplayLen: Sw_word;
-var S, E : Sw_word;
-begin
-  S:=LineStart(CurPtr);
-  E:=LineEnd(CurPtr);
-  GetLineDisplayLen:=Min(E-S,MaxLineLength-1);
-end; {TEditor.GetLineDisplayLen}
-
-
-function TEditor.GetMousePtr (Mouse : TPoint) : Sw_Word;
-begin
-  MakeLocal (Mouse, Mouse);
-  Mouse.X := Max (0, Min (Mouse.X, Size.X - 1));
-  Mouse.Y := Max (0, Min (Mouse.Y, Size.Y - 1));
-  GetMousePtr := CharPtr (LineMove (DrawPtr, Mouse.Y + Delta.Y - DrawLine),
-                          Mouse.X + Delta.X);
-end; { TEditor.GetMousePtr }
-
-
-function TEditor.GetPalette : PPalette;
-CONST
-  P : String[Length (CEditor)] = CEditor;
-begin
-  GetPalette := PPalette(@P);
-end; { TEditor.GetPalette }
-
-
-procedure TEditor.HandleEvent (var Event : TEvent);
-VAR
-  ShiftState   : Byte;
-  CenterCursor : Boolean;
-  SelectMode   : Byte;
-  D            : TPoint;
-  Mouse        : TPoint;
-  LinesScroll  : Sw_Integer;
-  E            : TEvent;
-
-  function CheckScrollBar (P : PScrollBar; var D : Sw_Integer) : Boolean;
-  begin
-    CheckScrollBar := FALSE;
-    if (Event.InfoPtr = P) and (P^.Value <> D) then
-    begin
-      D := P^.Value;
-      Update (ufView);
-      CheckScrollBar := TRUE;
-    end;
-  end; {CheckScrollBar}
-
-begin
-  Inherited HandleEvent (Event);
-  ConvertEvent (Event);
-  CenterCursor := not CursorVisible;
-  SelectMode := 0;
-  ShiftState:=GetShiftState;
-  if Selecting or (ShiftState and $03 <> 0) then
-    SelectMode := smExtend;
-  case Event.What of
-    evMouseWheel:
-      begin
-        if (Event.Wheel=mwDown) then { Mouse scroll down}
-          begin
-            Lock;
-            LinesScroll:=1;
-            if Event.Double then LinesScroll:=LinesScroll+4;
-            ScrollTo(Delta.X, Delta.Y + LinesScroll);
-            Unlock;
-          end else
-        if (Event.Wheel=mwUp) then  { Mouse scroll up }
-          begin
-            Lock;
-            LinesScroll:=-1;
-            if Event.Double then LinesScroll:=LinesScroll-4;
-            ScrollTo(Delta.X, Delta.Y + LinesScroll);
-            Unlock;
-          end
-        else exit;
-      end;
-    evMouseDown:
-      begin
-        if Event.Double then
-          SelectMode := SelectMode or smDouble;
-        repeat
-          Lock;
-          if Event.What = evMouseWheel then
-            begin
-              E:=Event;
-              HandleEvent(Event); { Scroll }
-              Event:=E;
-            end;
-          if Event.What = evMouseAuto then
-          begin
-            MakeLocal (Event.Where, Mouse);
-            D := Delta;
-            if Mouse.X < 0 then
-              Dec (D.X);
-            if Mouse.X >= Size.X then
-              Inc (D.X);
-            if Mouse.Y < 0 then
-              Dec (D.Y);
-            if Mouse.Y >= Size.Y then
-              Inc (D.Y);
-            ScrollTo (D.X, D.Y);
-          end;
-          SetCurPtr (GetMousePtr (Event.Where), SelectMode);
-          SelectMode := SelectMode or smExtend;
-          Unlock;
-        until not MouseEvent (Event, evMouseMove + evMouseAuto + evMouseWheel);
-      end; { evMouseDown }
-
-    evKeyDown:
-      case Event.CharCode of
-        #32..#255:
-          begin
-            Lock;
-            if Overwrite and not HasSelection then
-              if CurPtr <> LineEnd (CurPtr) then
-                SelEnd := NextChar (CurPtr);
-            InsertText (@Event.CharCode, 1, False);
-            if Word_Wrap then
-              Check_For_Word_Wrap (SelectMode, CenterCursor);
-            TrackCursor (CenterCursor);
-            Unlock;
-          end;
-
-      else
-        Exit;
-      end; { evKeyDown }
-
-    evCommand:
-      case Event.Command of
-        cmFind        : Find;
-        cmReplace     : Replace;
-        cmSearchAgain : DoSearchReplace;
-      else
-        begin
-          Lock;
-          case Event.Command of
-            cmCut         : ClipCut;
-            cmCopy        : ClipCopy;
-            cmPaste       : ClipPaste;
-            cmPasteText   : InsertText(Event.InfoPtr,Event.Id,false);
-            cmUndo        : Undo;
-            cmClear       : DeleteSelect;
-            cmCharLeft    : SetCurPtr (PrevChar  (CurPtr), SelectMode);
-            cmCharRight   : SetCurPtr (NextChar  (CurPtr), SelectMode);
-            cmWordLeft    : SetCurPtr (PrevWord  (CurPtr), SelectMode);
-            cmWordRight   : SetCurPtr (NextWord  (CurPtr), SelectMode);
-            cmLineStart   : SetCurPtr (LineStart (CurPtr), SelectMode);
-            cmLineEnd     : SetCurPtr (LineEnd   (CurPtr), SelectMode);
-            cmLineUp      : SetCurPtr (LineMove  (CurPtr, -1), SelectMode);
-            cmLineDown    : SetCurPtr (LineMove  (CurPtr, 1),  SelectMode);
-            cmPageUp      : SetCurPtr (LineMove  (CurPtr, - (Size.Y - 1)), SelectMode);
-            cmPageDown    : SetCurPtr (LineMove  (CurPtr, Size.Y - 1), SelectMode);
-            cmTextStart   : SetCurPtr (0, SelectMode);
-            cmTextEnd     : SetCurPtr (BufLen, SelectMode);
-            cmNewLine     : NewLine (SelectMode);
-            cmBackSpace   : DeleteRange (PrevChar (CurPtr), CurPtr, True);
-            cmDelChar     : DeleteRange (CurPtr, NextChar (CurPtr), True);
-            cmDelWord     : DeleteRange (CurPtr, NextWord (CurPtr), False);
-            cmDelStart    : DeleteRange (LineStart (CurPtr), CurPtr, False);
-            cmDelEnd      : DeleteRange (CurPtr, LineEnd (CurPtr), False);
-            cmDelLine     : DeleteRange (LineStart (CurPtr), NextLine (CurPtr), False);
-            cmInsMode     : ToggleInsMode;
-            cmStartSelect : StartSelect;
-            cmHideSelect  : HideSelect;
-            cmIndentMode  : begin
-                              AutoIndent := not AutoIndent;
-                              Update (ufStats);
-                            end; { Added provision to update TIndicator if ^QI pressed. }
-            cmCenterText  : Center_Text (SelectMode);
-            cmEndPage     : SetCurPtr (LineMove  (CurPtr, Delta.Y - CurPos.Y + Size.Y - 1), SelectMode);
-            cmHomePage    : SetCurPtr (LineMove  (CurPtr, -(CurPos.Y - Delta.Y)), SelectMode);
-            cmInsertLine  : Insert_Line (SelectMode);
-            cmJumpLine    : Jump_To_Line (SelectMode);
-            cmReformDoc   : Reformat_Document (SelectMode, CenterCursor);
-            cmReformPara  : Reformat_Paragraph (SelectMode, CenterCursor);
-            cmRightMargin : Set_Right_Margin;
-            cmScrollDown  : Scroll_Down;
-            cmScrollUp    : Scroll_Up;
-            cmSelectWord  : Select_Word;
-            cmSetTabs     : Set_Tabs;
-            cmTabKey      : Tab_Key (SelectMode);
-            cmWordWrap    : begin
-                              Word_Wrap := not Word_Wrap;
-                              Update (ufStats);
-                            end; { Added provision to update TIndicator if ^OW pressed. }
-            cmSetMark0    : Set_Place_Marker (10);
-            cmSetMark1    : Set_Place_Marker  (1);
-            cmSetMark2    : Set_Place_Marker  (2);
-            cmSetMark3    : Set_Place_Marker  (3);
-            cmSetMark4    : Set_Place_Marker  (4);
-            cmSetMark5    : Set_Place_Marker  (5);
-            cmSetMark6    : Set_Place_Marker  (6);
-            cmSetMark7    : Set_Place_Marker  (7);
-            cmSetMark8    : Set_Place_Marker  (8);
-            cmSetMark9    : Set_Place_Marker  (9);
-            cmJumpMark0   : Jump_Place_Marker (10, SelectMode);
-            cmJumpMark1   : Jump_Place_Marker  (1, SelectMode);
-            cmJumpMark2   : Jump_Place_Marker  (2, SelectMode);
-            cmJumpMark3   : Jump_Place_Marker  (3, SelectMode);
-            cmJumpMark4   : Jump_Place_Marker  (4, SelectMode);
-            cmJumpMark5   : Jump_Place_Marker  (5, SelectMode);
-            cmJumpMark6   : Jump_Place_Marker  (6, SelectMode);
-            cmJumpMark7   : Jump_Place_Marker  (7, SelectMode);
-            cmJumpMark8   : Jump_Place_Marker  (8, SelectMode);
-            cmJumpMark9   : Jump_Place_Marker  (9, SelectMode);
-          else
-            Unlock;
-            Exit;
-          end; { Event.Command (Inner) }
-          TrackCursor (CenterCursor);
-          { If the user presses any key except cmNewline or cmBackspace  }
-          { we need to check if the file has been modified yet.  There   }
-          { can be no spaces at the end of a line, or wordwrap doesn't   }
-          { work properly.  We don't want to do this if the file hasn't  }
-          { been modified because the user could be bringing in an ASCII }
-          { file from an editor that allows spaces at the EOL.  If we    }
-          { took them out in that scenario the "M" would appear on the   }
-          { TIndicator line and the user would get upset or confused.    }
-          if (Event.Command <> cmNewLine)   and
-             (Event.Command <> cmBackSpace) and
-             (Event.Command <> cmTabKey)    and
-              Modified then
-            Remove_EOL_Spaces (SelectMode);
-          Unlock;
-        end; { Event.Command (Outer) }
-      end; { evCommand }
-
-    evBroadcast:
-      case Event.Command of
-        cmScrollBarChanged:
-          if (Event.InfoPtr = HScrollBar) or
-            (Event.InfoPtr = VScrollBar) then
-          begin
-            CheckScrollBar (HScrollBar, Delta.X);
-            CheckScrollBar (VScrollBar, Delta.Y);
-          end
-          else
-            exit;
-      else
-        Exit;
-      end; { evBroadcast }
-
-  end;
-  ClearEvent (Event);
-end; { TEditor.HandleEvent }
-
-
-function TEditor.HasSelection : Boolean;
-begin
-  HasSelection := SelStart <> SelEnd;
-end; { TEditor.HasSelection }
-
-
-procedure TEditor.HideSelect;
-begin
-  Selecting := False;
-  SetSelect (CurPtr, CurPtr, False);
-end; { TEditor.HideSelect }
-
-
-procedure TEditor.InitBuffer;
-begin
-  Assert(Buffer = nil, 'TEditor.InitBuffer: Buffer is not nil');
-  ReAllocMem(Buffer, BufSize);
-end; { TEditor.InitBuffer }
-
-
-function TEditor.InsertBuffer (var P : PEditBuffer;
-                               Offset,    Length     : Sw_Word;
-                               AllowUndo, SelectText : Boolean) : Boolean;
-VAR
-  SelLen   : Sw_Word;
-  DelLen   : Sw_Word;
-  SelLines : Sw_Word;
-  Lines    : Sw_Word;
-  NewSize  : Longint;
-begin
-  InsertBuffer := True;
-  Selecting := False;
-  SelLen := SelEnd - SelStart;
-  if (SelLen = 0) and (Length = 0) then
-    Exit;
-  DelLen := 0;
-  if AllowUndo then
-    if CurPtr = SelStart then
-      DelLen := SelLen
-    else
-      if SelLen > InsCount then
-        DelLen := SelLen - InsCount;
-  NewSize := Longint (BufLen + DelCount - SelLen + DelLen) + Length;
-  if NewSize > BufLen + DelCount then
-    if (NewSize > MaxBufLength) or not SetBufSize (NewSize) then
-      begin
-        EditorDialog (edOutOfMemory, nil);
-        InsertBuffer := False;
-        SelEnd := SelStart;
-        Exit;
-      end;
-  SelLines := CountLines (Buffer^[BufPtr (SelStart)], SelLen);
-  if CurPtr = SelEnd then
-  begin
-    if AllowUndo then
-    begin
-      if DelLen > 0 then
-        Move (Buffer^[SelStart], Buffer^[CurPtr + GapLen - DelCount - DelLen], DelLen);
-      Dec (InsCount, SelLen - DelLen);
-    end;
-    CurPtr := SelStart;
-    Dec (CurPos.Y, SelLines);
-  end;
-  if Delta.Y > CurPos.Y then
-    begin
-      Dec (Delta.Y, SelLines);
-      if Delta.Y < CurPos.Y then
-        Delta.Y := CurPos.Y;
-    end;
-  if Length > 0 then
-    Move (P^[Offset], Buffer^[CurPtr], Length);
-  Lines := CountLines (Buffer^[CurPtr], Length);
-  Inc (CurPtr, Length);
-  Inc (CurPos.Y, Lines);
-  DrawLine := CurPos.Y;
-  DrawPtr := LineStart (CurPtr);
-  CurPos.X := CharPos (DrawPtr, CurPtr);
-  if not SelectText then
-    SelStart := CurPtr;
-  SelEnd := CurPtr;
-  if Length>Sellen then
-   begin
-     Inc (BufLen, Length - SelLen);
-     Dec (GapLen, Length - SelLen);
-   end
-  else
-   begin
-     Dec (BufLen, Sellen - Length);
-     Inc (GapLen, Sellen - Length);
-   end;
-  if AllowUndo then
-    begin
-      Inc (DelCount, DelLen);
-      Inc (InsCount, Length);
-    end;
-  Inc (Limit.Y, Lines - SelLines);
-  Delta.Y := Max (0, Min (Delta.Y, Limit.Y - Size.Y));
-  if not IsClipboard then
-    Modified := True;
-  SetBufSize (BufLen + DelCount);
-  if Not Word_Wrap then
-    Limit.X:=Max(Limit.X,GetLineDisplayLen+1);
-  if (SelLines = 0) and (Lines = 0) then
-    Update (ufLine)
-  else
-    Update (ufView);
-end; { TEditor.InsertBuffer }
-
-
-function TEditor.InsertFrom (Editor : PEditor) : Boolean;
-begin
-  InsertFrom := InsertBuffer (Editor^.Buffer,
-    Editor^.BufPtr (Editor^.SelStart),
-    Editor^.SelEnd - Editor^.SelStart, CanUndo, IsClipboard);
-end; { TEditor.InsertFrom }
-
-
-procedure TEditor.Insert_Line (Select_Mode : Byte);
-{ This procedure inserts a newline at the current cursor position }
-{ if a ^N is pressed.  Unlike cmNewLine, the cursor will return   }
-{ to its original position.  If the cursor was at the end of a    }
-{ line, and its spaces were removed, the cursor returns to the    }
-{ end of the line instead.                                        }
-begin
-  NewLine (Select_Mode);
-  SetCurPtr (LineEnd (LineMove (CurPtr, -1)), Select_Mode);
-end; { TEditor.Insert_Line }
-
-
-function TEditor.InsertText (Text       : Pointer;
-                             Length     : Sw_Word;
-                             SelectText : Boolean) : Boolean;
-begin
-  if assigned(Text) and not Search_Replace then
-    Update_Place_Markers (Length, 0, Self.SelStart, Self.SelEnd);
-  InsertText := InsertBuffer (PEditBuffer (Text),
-                0, Length, CanUndo, SelectText);
-end; { TEditor.InsertText }
-
-
-function TEditor.IsClipboard : Boolean;
-begin
-  IsClipboard := Clipboard = @Self;
-end; { TEditor.IsClipboard }
-
-
-procedure TEditor.Jump_Place_Marker (Element : Byte; Select_Mode : Byte);
-{ This procedure jumps to a place marker if ^Q# is pressed.  }
-{ We don't go anywhere if Place_Marker[Element] is not zero. }
-begin
-  if (not IsClipboard) and (Place_Marker[Element] <> 0) then
-    SetCurPtr (Place_Marker[Element], Select_Mode);
-end; { TEditor.Jump_Place_Marker }
-
-
-procedure TEditor.Jump_To_Line (Select_Mode : Byte);
-{ This function brings up a dialog box that allows }
-{ the user to select a line number to jump to.     }
-VAR
-  Code       : SmallInt;         { Used for Val conversion.      }
-  Temp_Value : Longint;         { Holds converted dialog value. }
-begin
-  if EditorDialog (edJumpToLine, @Line_Number) <> cmCancel then
-    begin
-      { Convert the Line_Number string to an interger. }
-      { Put it into Temp_Value.  If the number is not  }
-      { in the range 1..9999 abort.  If the number is  }
-      { our current Y position, abort.  Otherwise,     }
-      { go to top of document, and jump to the line.   }
-      { There are faster methods.  This one's easy.    }
-      { Note that CurPos.Y is always 1 less than what  }
-      { the TIndicator line says.                      }
-      val (Line_Number, Temp_Value, Code);
-      if (Temp_Value < 1) or (Temp_Value > 9999999) then
-        Exit;
-      if Temp_Value = CurPos.Y + 1 then
-        Exit;
-      SetCurPtr (0, Select_Mode);
-      SetCurPtr (LineMove (CurPtr, Temp_Value - 1), Select_Mode);
-    end;
-end; {TEditor.Jump_To_Line}
-
-
-function TEditor.LineEnd (P : Sw_Word) : Sw_Word;
-var
-  start,
-  i  : Sw_word;
-  pc : PAnsiChar;
-begin
-  if P<CurPtr then
-   begin
-     i:=CurPtr-P;
-     pc:=PAnsiChar(Buffer)+P;
-     while (i>0) do
-      begin
-        if pc^ in [#10,#13] then
-         begin
-           LineEnd:=pc-PAnsiChar(Buffer);
-           exit;
-         end;
-        inc(pc);
-        dec(i);
-      end;
-     start:=CurPtr;
-   end
-  else
-   start:=P;
-  i:=BufLen-Start;
-  pc:=PAnsiChar(Buffer)+GapLen+start;
-  while (i>0) do
-   begin
-     if pc^ in [#10,#13] then
-      begin
-        LineEnd:=pc-(PAnsiChar(Buffer)+Gaplen);
-        exit;
-      end;
-     inc(pc);
-     dec(i);
-   end;
-  LineEnd:=pc-(PAnsiChar(Buffer)+Gaplen);
-end; { TEditor.LineEnd }
-
-
-function TEditor.LineMove (P : Sw_Word; Count : Sw_Integer) : Sw_Word;
-VAR
-  Pos : Sw_Integer;
-  I   : Sw_Word;
-begin
-  I := P;
-  P := LineStart (P);
-  Pos := CharPos (P, I);
-  while Count <> 0 do
-   begin
-     I := P;
-     if Count < 0 then
-       begin
-         P := PrevLine (P);
-         Inc (Count);
-       end
-     else
-       begin
-         P := NextLine (P);
-         Dec (Count);
-       end;
-   end;
-  if P <> I then
-    P := CharPtr (P, Pos);
-  LineMove := P;
-end; { TEditor.LineMove }
-
-
-function TEditor.LineStart (P : Sw_Word) : Sw_Word;
-var
-  i  : Sw_word;
-  start,pc : PAnsiChar;
-  oc : AnsiChar;
-begin
-  if P>CurPtr then
-   begin
-     start:=PAnsiChar(Buffer)+GapLen;
-     pc:=start+P;
-     i:=P-CurPtr;
-     dec(pc);
-     while (i>0) do
-      begin
-        if pc^ in [#10,#13] then
-         break;
-        dec(pc);
-        dec(i);
-      end;
-   end
-  else
-   i:=0;
-  if i=0 then
-   begin
-     start:=PAnsiChar(Buffer);
-     i:=P;
-     pc:=start+p;
-     dec(pc);
-     while (i>0) do
-      begin
-        if pc^ in [#10,#13] then
-         break;
-        dec(pc);
-        dec(i);
-      end;
-     if i=0 then
-      begin
-        LineStart:=0;
-        exit;
-      end;
-   end;
-  oc:=pc^;
-  LineStart:=pc-start+1;
-end; { TEditor.LineStart }
-
-
-function TEditor.LineNr (P : Sw_Word) : Sw_Word;
-var
-  pc,endp : PAnsiChar;
-  lines : sw_word;
-begin
-  endp:=PAnsiChar(Buffer)+BufPtr(P);
-  pc:=PAnsiChar(Buffer);
-  lines:=0;
-  while (pc<endp) do
-   begin
-     if pc^ in [#10,#13] then
-      begin
-        inc(lines);
-        if ord((pc+1)^)+ord(pc^)=23 then
-         begin
-           inc(pc);
-           if (pc>=endp) then
-            break;
-         end;
-      end;
-     inc(pc);
-   end;
-  LineNr:=Lines;
-end;
-
-
-procedure TEditor.Lock;
-begin
-  Inc (LockCount);
-end; { TEditor.Lock }
-
-
-function TEditor.NewLine (Select_Mode : Byte) : Boolean;
-VAR
-  I : Sw_Word;          { Used to track spaces for AutoIndent.                 }
-  P : Sw_Word;          { Position of Cursor when we arrive and after Newline. }
-begin
-  P := LineStart (CurPtr);
-  I := P;
-  { The first thing we do is remove any End Of Line spaces.  }
-  { Then we check to see how many spaces are on beginning    }
-  { of a line.   We need this check to add them after CR/LF  }
-  { if AutoIndenting.  Last of all we insert spaces required }
-  { for the AutoIndenting, if it was on.                     }
-  Remove_EOL_Spaces (Select_Mode);
-  while (I < CurPtr) and ((Buffer^[I] in [#9,' '])) do
-    Inc (I);
-  if InsertText (@LineBreak[1], length(LineBreak), False) = FALSE then
-    exit;
-  if AutoIndent then
-    InsertText (@Buffer^[P], I - P, False);
-  { Remember where the CurPtr is at this moment.     }
-  { Remember the length of the buffer at the moment. }
-  { Go to the previous line and remove EOL spaces.   }
-  { Once removed, re-set the cursor to where we were }
-  { minus any spaces that might have been removed.   }
-  I := BufLen;
-  P := CurPtr;
-  SetCurPtr (LineMove (CurPtr, - 1), Select_Mode);
-  Remove_EOL_Spaces (Select_Mode);
-  if I - BufLen <> 0 then
-    SetCurPtr (P - (I - BufLen), Select_Mode)
-  else
-    SetCurPtr (P, Select_Mode);
-  NewLine:=true;
-end; { TEditor.NewLine }
-
-
-function TEditor.NextChar (P : Sw_Word) : Sw_Word;
-var
-  pc : PAnsiChar;
-begin
-  if P<>BufLen then
-   begin
-     inc(P);
-     if P<>BufLen then
-      begin
-        pc:=PAnsiChar(Buffer);
-        if P>=CurPtr then
-         inc(pc,GapLen);
-        inc(pc,P-1);
-        if ord(pc^)+ord((pc+1)^)=23 then
-         inc(p);
-      end;
-   end;
-  NextChar:=P;
-end; { TEditor.NextChar }
-
-
-function TEditor.NextLine (P : Sw_Word) : Sw_Word;
-begin
-  NextLine := NextChar (LineEnd (P));
-end; { TEditor.NextLine }
-
-
-function TEditor.NextWord (P : Sw_Word) : Sw_Word;
-begin
-  { skip word }
-  while (P < BufLen) and (BufChar (P) in WordChars) do
-    P := NextChar (P);
-  { skip spaces }
-  while (P < BufLen) and not (BufChar (P) in WordChars) do
-    P := NextChar (P);
-  NextWord := P;
-end; { TEditor.NextWord }
-
-
-function TEditor.PrevChar (P : Sw_Word) : Sw_Word;
-var
-  pc : PAnsiChar;
-begin
-  if p<>0 then
-   begin
-     dec(p);
-     if p<>0 then
-      begin
-        pc:=PAnsiChar(Buffer);
-        if P>=CurPtr then
-         inc(pc,GapLen);
-        inc(pc,P-1);
-        if ord(pc^)+ord((pc+1)^)=23 then
-         dec(p);
-      end;
-   end;
-  PrevChar:=P;
-end; { TEditor.PrevChar }
-
-
-function TEditor.PrevLine (P : Sw_Word) : Sw_Word;
-begin
-  PrevLine := LineStart (PrevChar (P));
-end; { TEditor.PrevLine }
-
-
-function TEditor.PrevWord (P : Sw_Word) : Sw_Word;
-begin
-  { skip spaces }
-  while (P > 0) and not (BufChar (PrevChar (P)) in WordChars) do
-    P := PrevChar (P);
-  { skip word }
-  while (P > 0) and (BufChar (PrevChar (P)) in WordChars) do
-    P := PrevChar (P);
-  PrevWord := P;
-end; { TEditor.PrevWord }
-
-
-procedure TEditor.Reformat_Document (Select_Mode : Byte; Center_Cursor : Boolean);
-{ This procedure will do a reformat of the entire document, or just    }
-{ from the current line to the end of the document, if ^QU is pressed. }
-{ It simply brings up the correct dialog box, and then calls the       }
-{ TEditor.Reformat_Paragraph procedure to do the actual reformatting.  }
-CONST
-  efCurrentLine   = $0000;  { Radio button #1 selection for dialog box.  }
-  efWholeDocument = $0001;  { Radio button #2 selection for dialog box.  }
-VAR
-  Reformat_Options : Word;  { Holds the dialog options for reformatting. }
-begin
-  { Check if Word_Wrap is toggled on.  If NOT on, check if programmer }
-  { allows reformatting of document and if not show user dialog that  }
-  { says reformatting is not permissable.                             }
-  if not Word_Wrap then
-    begin
-      if not Allow_Reformat then
-        begin
-          EditorDialog (edReformatNotAllowed, nil);
-          Exit;
-        end;
-      Word_Wrap := True;
-      Update (ufStats);
-    end;
-  { Default radio button option to 1st one.  Bring up dialog box. }
-  Reformat_Options := efCurrentLine;
-  if EditorDialog (edReformatDocument, @Reformat_Options) <> cmCancel then
-    begin
-      { If the option to reformat the whole document was selected   }
-      { we need to go back to start of document.  Otherwise we stay }
-      { on the current line.  Call Reformat_Paragraph until we get  }
-      { to the end of the document to do the reformatting.          }
-      if Reformat_Options and efWholeDocument <> 0 then
-        SetCurPtr (0, Select_Mode);
-      Unlock;
-      repeat
-        Lock;
-        if NOT Reformat_Paragraph (Select_Mode, Center_Cursor) then
-          Exit;
-        TrackCursor (False);
-        Unlock;
-      until CurPtr = BufLen;
-    end;
-end; { TEditor.Reformat_Document }
-
-
-function TEditor.Reformat_Paragraph (Select_Mode   : Byte;
-                                     Center_Cursor : Boolean) : Boolean;
-{ This procedure will do a reformat of the current paragraph if ^B pressed. }
-{ The feature works regardless if wordrap is on or off.  It also supports   }
-{ the AutoIndent feature.  Reformat is not possible if the CurPos exceeds   }
-{ the Right_Margin.  Right_Margin is where the EOL is considered to be.     }
-CONST
-  Space : array [1..2] of AnsiChar = #32#32;
-VAR
-  C : Sw_Word;  { Position of CurPtr when we come into procedure. }
-  E : Sw_Word;  { End of a line.                                  }
-  S : Sw_Word;  { Start of a line.                                }
-begin
-  Reformat_Paragraph := False;
-  { Check if Word_Wrap is toggled on.  If NOT on, check if programmer }
-  { allows reformatting of paragraph and if not show user dialog that }
-  { says reformatting is not permissable.                             }
-  if not Word_Wrap then
-    begin
-      if not Allow_Reformat then
-        begin
-          EditorDialog (edReformatNotAllowed, nil);
-          Exit;
-        end;
-      Word_Wrap := True;
-      Update (ufStats);
-    end;
-  C := CurPtr;
-  E := LineEnd (CurPtr);
-  S := LineStart (CurPtr);
-  { Reformat possible only if current line is NOT blank! }
-  if E <> S then
-    begin
-      { Reformat is NOT possible if the first word }
-      { on the line is beyond the Right_Margin.    }
-      S := LineStart (CurPtr);
-      if NextWord (S) - S >= Right_Margin - 1 then
-        begin
-          EditorDialog (edReformNotPossible, nil);
-          Exit;
-        end;
-      { First objective is to find the first blank line }
-      { after this paragraph so we know when to stop.   }
-      { That could be the end of the document.          }
-      Repeat
-        SetCurPtr (LineMove (CurPtr, 1), Select_Mode);
-        E := LineEnd (CurPtr);
-        S := LineStart (CurPtr);
-        BlankLine := E;
-      until ((CurPtr = BufLen) or (E = S));
-      SetCurPtr (C, Select_Mode);
-      repeat
-        { Set CurPtr to LineEnd and remove the EOL spaces. }
-        { Pull up the next line and remove its EOL space.  }
-        { First make sure the next line is not BlankLine!  }
-        { Insert spaces as required between the two lines. }
-        SetCurPtr (LineEnd (CurPtr), Select_Mode);
-        Remove_EOL_Spaces (Select_Mode);
-        if CurPtr <> Blankline - 2 then
-          DeleteRange (CurPtr, Nextword (CurPtr), True);
-        Remove_EOL_Spaces (Select_Mode);
-        case Buffer^[CurPtr-1] of
-          '!' : InsertText (@Space, 2, False);
-          '.' : InsertText (@Space, 2, False);
-          ':' : InsertText (@Space, 2, False);
-          '?' : InsertText (@Space, 2, False);
-        else
-          InsertText (@Space, 1, False);
-        end;
-        { Reset CurPtr to EOL.  While line length is > Right_Margin }
-        { go Do_Word_Wrap.  If wordrap failed, exit routine.        }
-        SetCurPtr (LineEnd (CurPtr), Select_Mode);
-        while LineEnd (CurPtr) - LineStart (CurPtr) > Right_Margin do
-          if not Do_Word_Wrap (Select_Mode, Center_Cursor) then
-              Exit;
-        { If LineEnd - LineStart > Right_Margin then set CurPtr    }
-        { to Right_Margin on current line.  Otherwise we set the   }
-        { CurPtr to LineEnd.  This gyration sets up the conditions }
-        { to test for time of loop exit.                           }
-        if LineEnd (CurPtr) - LineStart (CurPtr) > Right_Margin then
-          SetCurPtr (LineStart (CurPtr) + Right_Margin, Select_Mode)
-        else
-          SetCurPtr (LineEnd (CurPtr), Select_Mode);
-      until ((CurPtr >= BufLen) or (CurPtr >= BlankLine - 2));
-    end;
-  { If not at the end of the document reset CurPtr to start of next line. }
-  { This should be a blank line between paragraphs.                       }
-  if CurPtr < BufLen then
-    SetCurPtr (LineMove (CurPtr, 1), Select_Mode);
-  Reformat_Paragraph := True;
-end; { TEditor.Reformat_Paragraph }
-
-
-procedure TEditor.Remove_EOL_Spaces (Select_Mode : Byte);
-{ This procedure tests to see if there are consecutive spaces }
-{ at the end of a line (EOL).  If so, we delete all spaces    }
-{ after the last non-space character to the end of line.      }
-{ We then reset the CurPtr to where we ended up at.           }
-VAR
-  C : Sw_Word;           { Current pointer when we come into procedure. }
-  E : Sw_Word;           { End of line.                                 }
-  P : Sw_Word;           { Position of pointer at any given moment.     }
-  S : Sw_Word;           { Start of a line.                             }
-begin
-  C := CurPtr;
-  E := LineEnd (CurPtr);
-  P := E;
-  S := LineStart (CurPtr);
-  { Start at the end of a line and move towards the start. }
-  { Find first non-space character in that direction.      }
-  while (P > S) and (BufChar (PrevChar (P)) = #32) do
-    P := PrevChar (P);
-  { If we found any spaces then delete them. }
-  if P < E then
-    begin
-      SetSelect (P, E, True);
-      DeleteSelect;
-      Update_Place_Markers (0, E - P, P, E);
-    end;
-  { If C, our pointer when we came into this procedure, }
-  { is less than the CurPtr then reset CurPtr to C so   }
-  { cursor is where we started.  Otherwise, set it to   }
-  { the new CurPtr, for we have deleted characters.     }
-  if C < CurPtr then
-    SetCurPtr (C, Select_Mode)
-  else
-    SetCurPtr (CurPtr, Select_Mode);
-end; { TEditor.Remove_EOL_Spaces }
-
-
-procedure TEditor.Replace;
-VAR
-  ReplaceRec : TReplaceDialogRec;
-begin
-  with ReplaceRec do
-  begin
-    Find := FindStr;
-    Replace := ReplaceStr;
-    Options := Flags;
-    if EditorDialog (edReplace, @ReplaceRec) <> cmCancel then
-    begin
-      FindStr := Find;
-      ReplaceStr := Replace;
-      Flags := Options or efDoReplace;
-      DoSearchReplace;
-    end;
-  end;
-end; { TEditor.Replace }
-
-
-procedure TEditor.Scroll_Down;
-{ This procedure will scroll the screen up, and always keep      }
-{ the cursor on the CurPos.Y position, but not necessarily on    }
-{ the CurPos.X.  If CurPos.Y scrolls off the screen, the cursor  }
-{ will stay in the upper left corner of the screen.  This will   }
-{ simulate the same process in the IDE.  The CurPos.X coordinate }
-{ only messes up if we are on long lines and we then encounter   }
-{ a shorter or blank line beneath the current one as we scroll.  }
-{ In that case, it goes to the end of the new line.              }
-VAR
-  C : Sw_Word;           { Position of CurPtr when we enter procedure. }
-  P : Sw_Word;           { Position of CurPtr at any given time.       }
-  W : TPoint; { CurPos.Y of CurPtr and P ('.X and '.Y).     }
-begin
-  { Remember current cursor position.  Remember current CurPos.Y position. }
-  { Now issue the equivalent of a [Ctrl]-[End] command so the cursor will  }
-  { go to the bottom of the current screen.  Reset the cursor to this new  }
-  { position and then send FALSE to TrackCursor so we fool it into         }
-  { incrementing Delta.Y by only +1.  If we didn't do this it would try    }
-  { to center the cursor on the screen by fiddling with Delta.Y.           }
-  C := CurPtr;
-  W.X := CurPos.Y;
-  P := LineMove (CurPtr, Delta.Y - CurPos.Y + Size.Y);
-  SetCurPtr (P, 0);
-  TrackCursor (False);
-  { Now remember where the new CurPos.Y is.  See if distance between new }
-  { CurPos.Y and old CurPos.Y are greater than the current screen size.  }
-  { If they are, we need to move cursor position itself down by one.     }
-  { Otherwise, send the cursor back to our original CurPtr.              }
-  W.Y := CurPos.Y;
-  if W.Y - W.X > Size.Y - 1 then
-    SetCurPtr (LineMove (C, 1), 0)
-  else
-    SetCurPtr (C, 0);
-end; { TEditor.Scroll_Down }
-
-
-procedure TEditor.Scroll_Up;
-{ This procedure will scroll the screen down, and always keep    }
-{ the cursor on the CurPos.Y position, but not necessarily on    }
-{ the CurPos.X.  If CurPos.Y scrolls off the screen, the cursor  }
-{ will stay in the bottom left corner of the screen.  This will  }
-{ simulate the same process in the IDE.  The CurPos.X coordinate }
-{ only messes up if we are on long lines and we then encounter   }
-{ a shorter or blank line beneath the current one as we scroll.  }
-{ In that case, it goes to the end of the new line.              }
-VAR
-  C : Sw_Word;           { Position of CurPtr when we enter procedure. }
-  P : Sw_Word;           { Position of CurPtr at any given time.       }
-  W : TPoint; { CurPos.Y of CurPtr and P ('.X and '.Y).     }
-begin
-  { Remember current cursor position.  Remember current CurPos.Y position. }
-  { Now issue the equivalent of a [Ctrl]-[Home] command so the cursor will }
-  { go to the top of the current screen.  Reset the cursor to this new     }
-  { position and then send FALSE to TrackCursor so we fool it into         }
-  { decrementing Delta.Y by only -1.  If we didn't do this it would try    }
-  { to center the cursor on the screen by fiddling with Delta.Y.           }
-  C := CurPtr;
-  W.Y := CurPos.Y;
-  P := LineMove (CurPtr, -(CurPos.Y - Delta.Y + 1));
-  SetCurPtr (P, 0);
-  TrackCursor (False);
-  { Now remember where the new CurPos.Y is.  See if distance between new }
-  { CurPos.Y and old CurPos.Y are greater than the current screen size.  }
-  { If they are, we need to move the cursor position itself up by one.   }
-  { Otherwise, send the cursor back to our original CurPtr.              }
-  W.X := CurPos.Y;
-  if W.Y - W.X > Size.Y - 1 then
-    SetCurPtr (LineMove (C, -1), 0)
-  else
-    SetCurPtr (C, 0);
-end; { TEditor.Scroll_Up }
-
-
-procedure TEditor.ScrollTo (X, Y : Sw_Integer);
-begin
-  X := Max (0, Min (X, Limit.X - Size.X));
-  Y := Max (0, Min (Y, Limit.Y - Size.Y));
-  if (X <> Delta.X) or (Y <> Delta.Y) then
-  begin
-    Delta.X := X;
-    Delta.Y := Y;
-    Update (ufView);
-  end;
-end; { TEditor.ScrollTo }
-
-
-function TEditor.Search (const FindStr : String; Opts : Word) : Boolean;
-VAR
-  I,Pos : Sw_Word;
-begin
-  Search := False;
-  Pos := CurPtr;
-  repeat
-    if Opts and efCaseSensitive <> 0 then
-      I := Scan (Buffer^[BufPtr (Pos)], BufLen - Pos, FindStr)
-    else
-      I := IScan (Buffer^[BufPtr (Pos)], BufLen - Pos, FindStr);
-    if (I <> sfSearchFailed) then
-    begin
-      Inc (I, Pos);
-      if (Opts and efWholeWordsOnly = 0) or
-         not (((I <> 0) and (BufChar (I - 1) in WordChars)) or
-              ((I + Length (FindStr) <> BufLen) and
-               (BufChar (I + Length (FindStr)) in WordChars))) then
-        begin
-          Lock;
-          SetSelect (I, I + Length (FindStr), False);
-          TrackCursor (not CursorVisible);
-          Unlock;
-          Search := True;
-          Exit;
-        end
-      else
-        Pos := I + 1;
-    end;
-  until I = sfSearchFailed;
-end; { TEditor.Search }
-
-
-procedure TEditor.Select_Word;
-{ This procedure will select the a word to put into the clipboard.   }
-{ I've added it just to maintain compatibility with the IDE editor.  }
-{ Note that selection starts at the current cursor position and ends }
-{ when a space or the end of line is encountered.                    }
-VAR
-  E : Sw_Word;         { End of the current line.                           }
-  Select_Mode : Byte;  { Allows us to turn select mode on inside procedure. }
-begin
-  E := LineEnd (CurPtr);
-  { If the cursor is on a space or at the end of a line, abort. }
-  { Stupid action on users part for you can't select blanks!    }
-  if (BufChar (CurPtr) = #32) or (CurPtr = E) then
-    Exit;
-  { Turn on select mode and tell editor to start selecting text. }
-  { As long as we have a character > a space (this is done to    }
-  { exclude CR/LF pairs at end of a line) and we are NOT at the  }
-  { end of a line, set the CurPtr to the next character.         }
-  { Once we find a space or CR/LF, selection is done and we      }
-  { automatically put the selected word into the Clipboard.      }
-  Select_Mode := smExtend;
-  StartSelect;
-  while (BufChar (NextChar (CurPtr)) > #32) and (CurPtr < E) do
-    SetCurPtr (NextChar (CurPtr), Select_Mode);
-  SetCurPtr (NextChar (CurPtr), Select_Mode);
-  ClipCopy;
-end; {TEditor.Select_Word }
-
-
-procedure TEditor.SetBufLen (Length : Sw_Word);
-begin
-  BufLen := Length;
-  GapLen := BufSize - Length;
-  SelStart := 0;
-  SelEnd := 0;
-  CurPtr := 0;
-  CurPos.X:=0;
-  CurPos.Y:=0;
-  Delta.X:=0;
-  Delta.Y:=0;
-  GetLimits(Buffer^[GapLen], BufLen,Limit);
-  inc(Limit.X);
-  inc(Limit.Y);
-  DrawLine := 0;
-  DrawPtr := 0;
-  DelCount := 0;
-  InsCount := 0;
-  Modified := False;
-  Update (ufView);
-end; { TEditor.SetBufLen }
-
-
-function TEditor.SetBufSize (NewSize : Sw_Word) : Boolean;
-begin
-  if BufSize>=NewSize then SetBufSize:=true else SetBufSize:=false;
-end; { TEditor.SetBufSize }
-
-
-procedure TEditor.SetCmdState (Command : Word; Enable : Boolean);
-VAR
-  S : TCommandSet;
-begin
-  S := [Command];
-  if Enable and (State and sfActive <> 0) then
-    EnableCommands (S)
-  else
-    DisableCommands (S);
-end; { TEditor.SetCmdState }
-
-
-procedure TEditor.SetCurPtr (P : Sw_Word; SelectMode : Byte);
-VAR
-  Anchor : Sw_Word;
-begin
-  if SelectMode and smExtend = 0 then
-    Anchor := P
-  else
-    if CurPtr = SelStart then
-      Anchor := SelEnd
-    else
-      Anchor := SelStart;
-  if P < Anchor then
-    begin
-      if SelectMode and smDouble <> 0 then
-      begin
-        P := PrevLine (NextLine (P));
-        Anchor := NextLine (PrevLine (Anchor));
-      end;
-      SetSelect (P, Anchor, True);
-    end
-  else
-    begin
-      if SelectMode and smDouble <> 0 then
-      begin
-        P := NextLine (P);
-        Anchor := PrevLine (NextLine (Anchor));
-      end;
-      SetSelect (Anchor, P, False);
-    end;
-end; { TEditor.SetCurPtr }
-
-
-procedure TEditor.Set_Place_Marker (Element : Byte);
-{ This procedure sets a place marker for the CurPtr if ^K# is pressed. }
-begin
-  if not IsClipboard then
-    Place_Marker[Element] := CurPtr;
-end; { TEditor.Set_Place_Marker }
-
-
-procedure TEditor.Set_Right_Margin;
-{ This procedure will bring up a dialog box }
-{ that allows the user to set Right_Margin. }
-{ Values must be < MaxLineLength and > 9.   }
-VAR
-  Code        : SmallInt;          { Used for Val conversion.      }
-  Margin_Data : TRightMarginRec;  { Holds dialog results.         }
-  Temp_Value  : Sw_Integer;       { Holds converted dialog value. }
-begin
-  with Margin_Data do
-    begin
-      Str (Right_Margin, Margin_Position);
-      if EditorDialog (edRightMargin, @Margin_Position) <> cmCancel then
-        begin
-          val (Margin_Position, Temp_Value, Code);
-          if (Temp_Value <= MaxLineLength) and (Temp_Value > 9) then
-            Right_Margin := Temp_Value;
-        end;
-    end;
-end; { TEditor.Set_Right_Margin }
-
-
-procedure TEditor.SetSelect (NewStart, NewEnd : Sw_Word; CurStart : Boolean);
-VAR
-  UFlags : Byte;
-  P     : Sw_Word;
-  L     : Sw_Word;
-begin
-  if CurStart then
-    P := NewStart
-  else
-    P := NewEnd;
-  UFlags := ufUpdate;
-  if (NewStart <> SelStart) or (NewEnd <> SelEnd) then
-    if (NewStart <> NewEnd) or (SelStart <> SelEnd) then
-      UFlags := ufView;
-  if P <> CurPtr then
-  begin
-    if P > CurPtr then
-      begin
-        L := P - CurPtr;
-        Move (Buffer^[CurPtr + GapLen], Buffer^[CurPtr], L);
-        Inc (CurPos.Y, CountLines (Buffer^[CurPtr], L));
-        CurPtr := P;
-      end
-    else
-      begin
-        L := CurPtr - P;
-        CurPtr := P;
-        Dec (CurPos.Y, CountLines (Buffer^[CurPtr], L));
-        Move (Buffer^[CurPtr], Buffer^[CurPtr + GapLen], L);
-      end;
-    DrawLine := CurPos.Y;
-    DrawPtr := LineStart (P);
-    CurPos.X := CharPos (DrawPtr, P);
-    DelCount := 0;
-    InsCount := 0;
-    SetBufSize (BufLen);
-  end;
-  SelStart := NewStart;
-  SelEnd := NewEnd;
-  Update (UFlags);
-end; { TEditor.Select }
-
-
-procedure TEditor.SetState (AState : Word; Enable : Boolean);
-begin
-  Inherited SetState (AState, Enable);
-  case AState of
-    sfActive: begin
-                      if assigned(HScrollBar) then
-                        HScrollBar^.SetState (sfVisible, Enable);
-                      if assigned(VScrollBar) then
-                        VScrollBar^.SetState (sfVisible, Enable);
-                      if assigned(Indicator) then
-                        Indicator^.SetState (sfVisible, Enable);
-                      UpdateCommands;
-                    end;
-    sfExposed: if Enable then Unlock;
-  end;
-end; { TEditor.SetState }
-
-
-procedure TEditor.Set_Tabs;
-{ This procedure will bring up a dialog box }
-{ that allows the user to set tab stops.    }
-VAR
-  Index    : Sw_Integer;   { Index into string array. }
-  Tab_Data : TTabStopRec;  { Holds dialog results.    }
-begin
-  with Tab_Data do
-    begin
-      { Assign current Tab_Settings to Tab_String.    }
-      { Bring up the tab dialog so user can set tabs. }
-      Tab_String := Copy (Tab_Settings, 1, Tab_Stop_Length);
-      if EditorDialog (edSetTabStops, @Tab_String) <> cmCancel then
-        begin
-          { If Tab_String comes back as empty then set Tab_Settings to nil. }
-          { Otherwise, find the last character in Tab_String that is not    }
-          { a space and copy Tab_String into Tab_Settings up to that spot.  }
-          if Length (Tab_String) = 0 then
-            begin
-              FillChar (Tab_Settings, SizeOf (Tab_Settings), #0);
-              Exit;
-            end
-          else
-            begin
-              Index := Length (Tab_String);
-              while Tab_String[Index] <= #32 do
-                Dec (Index);
-              Tab_Settings := Copy (Tab_String, 1, Index);
-            end;
-        end;
-  end;
-end; { TEditor.Set_Tabs }
-
-
-procedure TEditor.StartSelect;
-begin
-  HideSelect;
-  Selecting := True;
-end; { TEditor.StartSelect }
-
-
-procedure TEditor.Store (var S : TStream);
-begin
-  Inherited Store (S);
-  PutPeerViewPtr (S, HScrollBar);
-  PutPeerViewPtr (S, VScrollBar);
-  PutPeerViewPtr (S, Indicator);
-  S.Write (BufSize, SizeOf (BufSize));
-  S.Write (Canundo, SizeOf (Canundo));
-  S.Write (AutoIndent,   SizeOf (AutoIndent));
-  S.Write (Line_Number,  SizeOf (Line_Number));
-  S.Write (Place_Marker, SizeOf (Place_Marker));
-  S.Write (Right_Margin, SizeOf (Right_Margin));
-  S.Write (Tab_Settings, SizeOf (Tab_Settings));
-  S.Write (Word_Wrap,    SizeOf (Word_Wrap));
-end; { Editor.Store }
-
-
-procedure TEditor.Tab_Key (Select_Mode : Byte);
-{ This function determines if we are in overstrike or insert mode,   }
-{ and then moves the cursor if overstrike, or adds spaces if insert. }
-VAR
-  E        : Sw_Word;                { End of current line.                }
-  Index    : Sw_Integer;             { Loop counter.                       }
-  Position : Sw_Integer;             { CurPos.X position.                  }
-  S        : Sw_Word;                { Start of current line.              }
-  Spaces   : array [1..80] of AnsiChar;  { Array to hold spaces for insertion. }
-begin
-  E := LineEnd (CurPtr);
-  S := LineStart (CurPtr);
-  { Find the current horizontal cursor position. }
-  { Now loop through the Tab_Settings string and }
-  { find the next available tab stop.            }
-  Position := CurPos.X + 1;
-  repeat
-    Inc (Position);
-  until (Tab_Settings[Position] <> #32) or (Position >= Length (Tab_Settings));
-  E := CurPos.X;
-  Index := 1;
-  { Now we enter a loop to go to the next tab position.  }
-  { If we are in overwrite mode, we just move the cursor }
-  { through the text to the next tab stop.  If we are in }
-  { insert mode, we add spaces to the Spaces array for   }
-  { the number of times we loop.                         }
-  while Index < Position - E do
-    begin
-      if Overwrite then
-        begin
-          if (Position > LineEnd (CurPtr) - LineStart (CurPtr))
-              or (Position > Length (Tab_Settings)) then
-            begin
-              SetCurPtr (LineStart (LineMove (CurPtr, 1)), Select_Mode);
-              Exit;
-            end
-          else
-            if CurPtr < BufLen then
-              SetCurPtr (NextChar (CurPtr), Select_Mode);
-        end
-      else
-        begin
-          if (Position > Right_Margin) or (Position > Length (Tab_Settings)) then
-            begin
-              SetCurPtr (LineStart (LineMove (CurPtr, 1)), Select_Mode);
-              Exit;
-            end
-          else
-            Spaces[Index] := #32;
-        end;
-      Inc (Index);
-  end;
-  { If we are insert mode, we insert spaces to the next tab stop.        }
-  { When we're all done, the cursor will be sitting on the new tab stop. }
-  if not OverWrite then
-    InsertText (@Spaces, Index - 1, False);
-end; { TEditor.Tab_Key }
-
-
-procedure TEditor.ToggleInsMode;
-begin
-  Overwrite := not Overwrite;
-  SetState (sfCursorIns, not GetState (sfCursorIns));
-end; { TEditor.ToggleInsMode }
-
-
-procedure TEditor.TrackCursor (Center : Boolean);
-begin
-  if Center then
-    ScrollTo (CurPos.X - Size.X + 1, CurPos.Y - Size.Y div 2)
-  else
-    ScrollTo (Max (CurPos.X - Size.X + 1, Min (Delta.X, CurPos.X)),
-              Max (CurPos.Y - Size.Y + 1, Min (Delta.Y, CurPos.Y)));
-end; { TEditor.TrackCursor }
-
-
-procedure TEditor.Undo;
-VAR
-  Length : Sw_Word;
-begin
-  if (DelCount <> 0) or (InsCount <> 0) then
-  begin
-    Update_Place_Markers (DelCount, 0, CurPtr, CurPtr + DelCount);
-    SelStart := CurPtr - InsCount;
-    SelEnd := CurPtr;
-    Length := DelCount;
-    DelCount := 0;
-    InsCount := 0;
-    InsertBuffer (Buffer, CurPtr + GapLen - Length, Length, False, True);
-  end;
-end; { TEditor.Undo }
-
-
-procedure TEditor.Unlock;
-begin
-  if LockCount > 0 then
-  begin
-    Dec (LockCount);
-    if LockCount = 0 then
-      DoUpdate;
-  end;
-end; { TEditor.Unlock }
-
-
-procedure TEditor.Update (AFlags : Byte);
-begin
-  UpdateFlags := UpdateFlags or AFlags;
-  if LockCount = 0 then
-    DoUpdate;
-end; { TEditor.Update }
-
-
-procedure TEditor.UpdateCommands;
-begin
-  SetCmdState (cmUndo, (DelCount <> 0) or (InsCount <> 0));
-  if not IsClipboard then
-    begin
-      SetCmdState (cmCut, HasSelection);
-      SetCmdState (cmCopy, HasSelection);
-      SetCmdState (cmPaste, assigned(Clipboard) and (Clipboard^.HasSelection));
-    end;
-  SetCmdState (cmClear, HasSelection);
-  SetCmdState (cmFind, True);
-  SetCmdState (cmReplace, True);
-  SetCmdState (cmSearchAgain, True);
-end; { TEditor.UpdateCommands }
-
-
-procedure TEditor.Update_Place_Markers (AddCount : Word; KillCount : Word;
-                                        StartPtr,EndPtr : Sw_Word);
-{ This procedure updates the position of the place markers }
-{ as the user inserts and deletes text in the document.    }
-VAR
-  Element : Byte;     { Place_Marker array element to traverse array with. }
-begin
-  for Element := 1 to 10 do
-    begin
-      if AddCount > 0 then
-        begin
-          if (Place_Marker[Element] >= Curptr)
-              and (Place_Marker[Element] <> 0) then
-            Place_Marker[Element] := Place_Marker[Element] + AddCount;
-        end
-      else
-        begin
-          if Place_Marker[Element] >= StartPtr then
-            begin
-              if (Place_Marker[Element] >= StartPtr) and
-                 (Place_Marker[Element] < EndPtr) then
-                Place_marker[Element] := 0
-              else
-                begin
-                  if SmallInt (Place_Marker[Element]) - SmallInt (KillCount) > 0 then
-                    Place_Marker[Element] := Place_Marker[Element] - KillCount
-                  else
-                    Place_Marker[Element] := 0;
-                end;
-            end;
-        end;
-    end;
-  if AddCount > 0 then
-    BlankLine := BlankLine + AddCount
-  else
-    begin
-      if SmallInt (BlankLine) - SmallInt (KillCount) > 0 then
-        BlankLine := BlankLine - KillCount
-      else
-        BlankLine := 0;
-    end;
-end; { TEditor.Update_Place_Markers }
-
-
-function TEditor.Valid (Command : Word) : Boolean;
-begin
-  Valid := IsValid;
-end; { TEditor.Valid }
-
-
-{****************************************************************************
-                                   TMEMO
-****************************************************************************}
-
-constructor TMemo.Load (var S : TStream);
-VAR
-  Length : Sw_Word;
-begin
-  Inherited Load (S);
-  S.Read (Length, SizeOf (Length));
-  if IsValid then
-    begin
-      S.Read (Buffer^[BufSize - Length], Length);
-      SetBufLen (Length);
-    end
-  else
-    S.Seek (S.GetPos + Length);
-end; { TMemo.Load }
-
-
-function TMemo.DataSize : Sw_Word;
-begin
-  DataSize := BufSize + SizeOf (Sw_Word);
-end; { TMemo.DataSize }
-
-
-procedure TMemo.GetData (var Rec);
-VAR
-  Data : TMemoData absolute Rec;
-begin
-  Data.Length := BufLen;
-  Move (Buffer^, Data.Buffer, CurPtr);
-  Move (Buffer^[CurPtr + GapLen], Data.Buffer[CurPtr], BufLen - CurPtr);
-  FillChar (Data.Buffer[BufLen], BufSize - BufLen, 0);
-end; { TMemo.GetData }
-
-
-function TMemo.GetPalette : PPalette;
-CONST
-  P : String[Length (CMemo)] = CMemo;
-begin
-  GetPalette := PPalette(@P);
-end; { TMemo.GetPalette }
-
-
-procedure TMemo.HandleEvent (var Event : TEvent);
-begin
-  if (Event.What <> evKeyDown) or (Event.KeyCode <> kbTab) then
-    Inherited HandleEvent (Event);
-end; { TMemo.HandleEvent }
-
-
-procedure TMemo.SetData (var Rec);
-VAR
-  Data : TMemoData absolute Rec;
-begin
-  Move (Data.Buffer, Buffer^[BufSize - Data.Length], Data.Length);
-  SetBufLen (Data.Length);
-end; { TMemo.SetData }
-
-
-procedure TMemo.Store (var S : TStream);
-begin
-  Inherited Store (S);
-  S.Write (BufLen, SizeOf (BufLen));
-  S.Write (Buffer^, CurPtr);
-  S.Write (Buffer^[CurPtr + GapLen], BufLen - CurPtr);
-end; { TMemo.Store }
-
-
-{****************************************************************************
-                               TFILEEDITOR
-****************************************************************************}
-
-
-constructor TFileEditor.Init (var Bounds : TRect;
-                              AHScrollBar, AVScrollBar : PScrollBar;
-                              AIndicator : PIndicator;
-                              AFileName  : FNameStr);
-begin
-  Inherited Init (Bounds, AHScrollBar, AVScrollBar, AIndicator, 0);
-  if AFileName <> '' then
-    begin
-      FileName := FExpand (AFileName);
-      if IsValid then
-        IsValid := LoadFile;
-    end;
-end; { TFileEditor.Init }
-
-
-constructor TFileEditor.Load (var S : TStream);
-VAR
-  SStart,SEnd,Curs : Sw_Word;
-begin
-  Inherited Load (S);
-  BufSize := 0;
-  S.Read (FileName[0], SizeOf (Byte));
-  S.Read (Filename[1], Length (FileName));
-  if IsValid then
-    IsValid := LoadFile;
-  S.Read (SStart, SizeOf (SStart));
-  S.Read (SEnd, SizeOf (SEnd));
-  S.Read (Curs, SizeOf (Curs));
-  if IsValid and (SEnd <= BufLen) then
-    begin
-      SetSelect (SStart, SEnd, Curs = SStart);
-      TrackCursor (True);
-    end;
-end; { TFileEditor.Load }
-
-
-procedure TFileEditor.DoneBuffer;
-begin
-  ReAllocMem(Buffer, 0);
-end; { TFileEditor.DoneBuffer }
-
-
-procedure TFileEditor.HandleEvent (var Event : TEvent);
-begin
-  Inherited HandleEvent (Event);
-  case Event.What of
-    evCommand:
-      case Event.Command of
-        cmSave   : Save;
-        cmSaveAs : SaveAs;
-        cmSaveDone : if Save then
-                       Message (Owner, evCommand, cmClose, nil);
-      else
-        Exit;
-      end;
-  else
-    Exit;
-  end;
-  ClearEvent (Event);
-end; { TFileEditor.HandleEvent }
-
-
-procedure TFileEditor.InitBuffer;
-begin
-  Assert(Buffer = nil, 'TFileEditor.InitBuffer: Buffer is not nil');
-  ReAllocMem(Buffer, MinBufLength);
-  BufSize := MinBufLength;
-end; { TFileEditor.InitBuffer }
-
-
-function TFileEditor.LoadFile: Boolean;
-VAR
-  Length : Sw_Word;
-  FSize : Longint;
-  FRead : Sw_Integer;
-  oFileMode : byte;
-  F : File;
-begin
-  LoadFile := False;
-  Length := 0;
-  oFileMode:=FileMode;   {save file open mode}
-  FileMode:=0;           {Reset will open file in read only mode }
-  Assign(F, FileName);
-  {$push}{$i-}Reset(F, 1);{$pop}
-  FileMode:=oFileMode;   {restore file open mode}
-  if IOResult <> 0 then
-    EditorDialog(edReadError, @FileName)
-  else
-    begin
-      FSize := FileSize(F);
-      if (FSize > MaxBufLength) or not SetBufSize(FSize) then
-        EditorDialog(edOutOfMemory, nil)
-      else
-        begin
-          BlockRead(F, Buffer^[BufSize-FSize], FSize, FRead);
-          if (IOResult <> 0) or (FRead<>FSize) then
-            EditorDialog(edReadError, @FileName)
-          else
-            begin
-              LoadFile := True;
-              Length := FRead;
-            end;
-        end;
-      Close(F);
-    end;
-  SetBufLen(Length);
-end; { TFileEditor.LoadFile }
-
-
-function TFileEditor.Save : Boolean;
-begin
-  if FileName = '' then
-    Save := SaveAs
-  else
-    Save := SaveFile;
-end; { TFileEditor.Save }
-
-
-function TFileEditor.SaveAs : Boolean;
-begin
-  SaveAs := False;
-  if EditorDialog (edSaveAs, @FileName) <> cmCancel then
-  begin
-    FileName := FExpand (FileName);
-    Message (Owner, evBroadcast, cmUpdateTitle, nil);
-    SaveAs := SaveFile;
-    if IsClipboard then
-      FileName := '';
-  end;
-end; { TFileEditor.SaveAs }
-
-
-function TFileEditor.SaveFile : Boolean;
-VAR
-  F          : File;
-  BackupName : FNameStr;
-  D          : DirStr;
-  N          : NameStr;
-  E          : ExtStr;
-begin
-  SaveFile := False;
-  if Flags and efBackupFiles <> 0 then
-  begin
-    FSplit (FileName, D, N, E);
-    BackupName := D + N + '.bak';
-    Assign (F, BackupName);
-    Erase (F);
-    Assign (F, FileName);
-    Rename (F, BackupName);
-    InOutRes := 0;
-  end;
-  Assign (F, FileName);
-  {$push}{$i-}Rewrite (F, 1);{$pop}
-  if IOResult <> 0 then
-    EditorDialog (edCreateError, @FileName)
-  else
-    begin
-      BlockWrite (F, Buffer^, CurPtr);
-      BlockWrite (F, Buffer^[CurPtr + GapLen], BufLen - CurPtr);
-      if IOResult <> 0 then
-        EditorDialog (edWriteError, @FileName)
-      else
-        begin
-          Modified := False;
-          Update (ufUpdate);
-          SaveFile := True;
-        end;
-        Close (F);
-   end;
-end; { TFileEditor.SaveFile }
-
-
-function TFileEditor.SetBufSize (NewSize : Sw_Word) : Boolean;
-VAR
-  N : Sw_Word;
-begin
-  SetBufSize := False;
-  if NewSize = 0 then
-    NewSize := MinBufLength
-  else
-    if NewSize > (MaxBufLength-MinBufLength) then
-      NewSize := MaxBufLength
-    else
-      NewSize := (NewSize + (MinBufLength-1)) and (MaxBufLength and (not (MinBufLength-1)));
-  if NewSize <> BufSize then
-   begin
-     if NewSize > BufSize then ReAllocMem(Buffer, NewSize);
-     N := BufLen - CurPtr + DelCount;
-     Move(Buffer^[BufSize - N], Buffer^[NewSize - N], N);
-     if NewSize < BufSize then ReAllocMem(Buffer, NewSize);
-     BufSize := NewSize;
-     GapLen := BufSize - BufLen;
-   end;
-  SetBufSize := True;
-end; { TFileEditor.SetBufSize }
-
-
-procedure TFileEditor.Store (var S : TStream);
-begin
-  Inherited Store (S);
-  S.Write (FileName, Length (FileName) + 1);
-  S.Write (SelStart, SizeOf (SelStart));
-  S.Write (SelEnd, SizeOf (SelEnd));
-  S.Write (CurPtr, SizeOf (CurPtr));
-end; { TFileEditor.Store }
-
-
-procedure TFileEditor.UpdateCommands;
-begin
-  Inherited UpdateCommands;
-  SetCmdState (cmSave, True);
-  SetCmdState (cmSaveAs, True);
-  SetCmdState (cmSaveDone, True);
-end; { TFileEditor.UpdateCommands }
-
-
-function TFileEditor.Valid (Command : Word) : Boolean;
-VAR
-  D : SmallInt;
-begin
-  if Command = cmValid then
-    Valid := IsValid
-  else
-    begin
-      Valid := True;
-      if Modified then
-        begin
-          if FileName = '' then
-            D := edSaveUntitled
-          else
-            D := edSaveModify;
-          case EditorDialog (D, @FileName) of
-            cmYes    : Valid := Save;
-            cmNo     : Modified := False;
-            cmCancel : Valid := False;
-          end;
-        end;
-    end;
-end; { TFileEditor.Valid }
-
-
-{****************************************************************************
-                             TEDITWINDOW
-****************************************************************************}
-
-constructor TEditWindow.Init (var Bounds   : TRect;
-                                  FileName : FNameStr;
-                                  ANumber  : SmallInt);
-var
-  HScrollBar : PScrollBar;
-  VScrollBar : PScrollBar;
-  Indicator  : PIndicator;
-  R          : TRect;
-begin
-  Inherited Init (Bounds, '', ANumber);
-  Options := Options or ofTileable;
-
-  R.Assign (18, Size.Y - 1, Size.X - 2, Size.Y);
-  HScrollBar := New (PScrollBar, Init (R));
-  HScrollBar^.Hide;
-  Insert (HScrollBar);
-
-  R.Assign (Size.X - 1, 1, Size.X, Size.Y - 1);
-  VScrollBar := New (PScrollBar, Init (R));
-  VScrollBar^.Hide;
-  Insert (VScrollBar);
-
-  R.Assign (2, Size.Y - 1, 16, Size.Y);
-  Indicator := New (PIndicator, Init (R));
-  Indicator^.Hide;
-  Insert (Indicator);
-
-  GetExtent (R);
-  R.Grow (-1, -1);
-  Editor := New (PFileEditor, Init (R, HScrollBar, VScrollBar, Indicator, FileName));
-  Insert (Editor);
-end; { TEditWindow.Init }
-
-
-constructor TEditWindow.Load (var S : TStream);
-begin
-  Inherited Load (S);
-  GetSubViewPtr (S, Editor);
-end; { TEditWindow.Load }
-
-
-procedure TEditWindow.Close;
-begin
-  if Editor^.IsClipboard then
-    Hide
-  else
-    Inherited Close;
-end; { TEditWindow.Close }
-
-
-function TEditWindow.GetTitle (MaxSize : Sw_Integer) : TTitleStr;
-begin
-  if Editor^.IsClipboard then
-    GetTitle := sClipboard
-  else
-    if Editor^.FileName = '' then
-      GetTitle := sUntitled
-    else
-      GetTitle := Editor^.FileName;
-end; { TEditWindow.GetTile }
-
-
-procedure TEditWindow.HandleEvent (var Event : TEvent);
-begin
-  Inherited HandleEvent (Event);
-  if (Event.What = evBroadcast) then
-    { and (Event.Command = cmUpdateTitle) then }
-    { Changed if statement above so I could test for cmBlugeonStats.       }
-    { Stats would not show up when loading a file until a key was pressed. }
-    case Event.Command of
-      cmUpdateTitle :
-        begin
-          Frame^.DrawView;
-          ClearEvent (Event);
-        end;
-      cmBludgeonStats :
-        begin
-          Editor^.Update (ufStats);
-          ClearEvent (Event);
-        end;
-    end;
-end; { TEditWindow.HandleEvent }
-
-
-procedure TEditWindow.SizeLimits(var Min, Max: TPoint);
-begin
-  inherited SizeLimits(Min, Max);
-  Min.X := 23;
-end;
-
-
-procedure TEditWindow.Store (var S : TStream);
-begin
-  Inherited Store (S);
-  PutSubViewPtr (S, Editor);
-end; { TEditWindow.Store }
-
-
-procedure RegisterEditors;
-begin
-  RegisterType (REditor);
-  RegisterType (RMemo);
-  RegisterType (RFileEditor);
-  RegisterType (RIndicator);
-  RegisterType (REditWindow);
-end; { RegisterEditors }
-
-
-end. { Unit NewEdit }
+{$I editors.inc}

+ 346 - 0
packages/fv/src/gadgets.inc

@@ -0,0 +1,346 @@
+{********[ SOURCE FILE OF GRAPHICAL FREE VISION ]**********}
+{                                                          }
+{   System independent GRAPHICAL clone of GADGETS.PAS      }
+{                                                          }
+{   Interface Copyright (c) 1992 Borland International     }
+{                                                          }
+{   Copyright (c) 1999 by Leon de Boer                     }
+{   [email protected]  - primary e-mail address        }
+{   [email protected] - backup e-mail address         }
+{                                                          }
+{****************[ THIS CODE IS FREEWARE ]*****************}
+{                                                          }
+{     This sourcecode is released for the purpose to       }
+{   promote the pascal language on all platforms. You may  }
+{   redistribute it and/or modify with the following       }
+{   DISCLAIMER.                                            }
+{                                                          }
+{     This SOURCE CODE is distributed "AS IS" WITHOUT      }
+{   WARRANTIES AS TO PERFORMANCE OF MERCHANTABILITY OR     }
+{   ANY OTHER WARRANTIES WHETHER EXPRESSED OR IMPLIED.     }
+{                                                          }
+{*****************[ SUPPORTED PLATFORMS ]******************}
+{     16 and 32 Bit compilers                              }
+{        DOS      - Turbo Pascal 7.0 +      (16 Bit)       }
+{        DPMI     - Turbo Pascal 7.0 +      (16 Bit)       }
+{                 - FPC 0.9912+ (GO32V2)    (32 Bit)       }
+{        WINDOWS  - Turbo Pascal 7.0 +      (16 Bit)       }
+{                 - Delphi 1.0+             (16 Bit)       }
+{        WIN95/NT - Delphi 2.0+             (32 Bit)       }
+{                 - Virtual Pascal 2.0+     (32 Bit)       }
+{                 - Speedsoft Sybil 2.0+    (32 Bit)       }
+{                 - FPC 0.9912+             (32 Bit)       }
+{        OS2      - Virtual Pascal 1.0+     (32 Bit)       }
+{                                                          }
+{*******************[ DOCUMENTATION ]**********************}
+{                                                          }
+{   This unit had to be for GFV due to some problems with  }
+{  the original Borland International implementation.      }
+{                                                          }
+{   First it used the DOS unit for it's time calls in the  }
+{  TClockView object. Since this unit can not be compiled  }
+{  under WIN/NT/OS2 we use a new unit TIME.PAS which was   }
+{  created and works under these O/S.                      }
+{                                                          }
+{   Second the HeapView object accessed MemAvail from in   }
+{  the Draw call. As GFV uses heap memory during the Draw  }
+{  call the OldMem value always met the test condition in  }
+{  the update procedure. The consequence was the view      }
+{  would continually redraw. By moving the memavail call   }
+{  the update procedure this eliminates this problem.      }
+{                                                          }
+{   Finally the original object relied on the font AnsiChar    }
+{  blocks being square to erase it's entire view area as   }
+{  it used a simple writeline call in the Draw method.     }
+{  Under GFV font blocks are not necessarily square and    }
+{  so both objects had their Draw routines rewritten. As   }
+{  the Draw had to be redone it was done in the GFV split  }
+{  drawing method to accelerate the graphical speed.       }
+{                                                          }
+{******************[ REVISION HISTORY ]********************}
+{  Version  Date        Fix                                }
+{  -------  ---------   ---------------------------------  }
+{  1.00     12 Nov 99   First multi platform release       }
+{**********************************************************}
+
+{$IFNDEF FPC_DOTTEDUNITS}
+UNIT Gadgets;
+{$ENDIF FPC_DOTTEDUNITS}
+
+{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
+                                  INTERFACE
+{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
+
+{====Include file to sort compiler platform out =====================}
+{$I platform.inc}
+{====================================================================}
+
+{==== Compiler directives ===========================================}
+
+{$IFNDEF PPC_FPC}{ FPC doesn't support these switches }
+  {$F-} { Near calls are okay }
+  {$A+} { Word Align Data }
+  {$B-} { Allow short circuit boolean evaluations }
+  {$O+} { This unit may be overlaid }
+  {$G+} { 286 Code optimization - if you're on an 8088 get a real computer }
+  {$P-} { Normal string variables }
+  {$N-} { No 80x87 code generation }
+  {$E+} { Emulation is on }
+{$ELSE}
+  {$H-}
+{$ENDIF}
+
+{$X+} { Extended syntax is ok }
+{$R-} { Disable range checking }
+{$S-} { Disable Stack Checking }
+{$I-} { Disable IO Checking }
+{$Q-} { Disable Overflow Checking }
+{$V-} { Turn off strict VAR strings }
+{====================================================================}
+
+{$IFDEF FPC_DOTTEDUNITS}
+USES FreeVision.Fvconsts, FreeVision.Time, System.Objects,FreeVision.Drivers, FreeVision.Views, FreeVision.App;      { Standard GFV units }
+{$ELSE FPC_DOTTEDUNITS}
+USES FVConsts, Time, Objects, Drivers, Views, App;      { Standard GFV units }
+{$ENDIF FPC_DOTTEDUNITS}
+
+{***************************************************************************}
+{                        PUBLIC OBJECT DEFINITIONS                          }
+{***************************************************************************}
+
+{---------------------------------------------------------------------------}
+{                  THeapView OBJECT - ANCESTOR VIEW OBJECT                  }
+{---------------------------------------------------------------------------}
+TYPE
+   THeapViewMode=(HVNormal,HVComma,HVKb,HVMb);
+
+   THeapView = OBJECT (TView)
+         Mode   : THeapViewMode;
+         OldMem: LongInt;                             { Last memory count }
+      constructor Init(var Bounds: TRect);
+      constructor InitComma(var Bounds: TRect);
+      constructor InitKb(var Bounds: TRect);
+      constructor InitMb(var Bounds: TRect);
+      PROCEDURE Update;
+      PROCEDURE Draw; Virtual;
+      Function  Comma ( N : LongInt ) : String;
+   END;
+   PHeapView = ^THeapView;                            { Heapview pointer }
+
+{---------------------------------------------------------------------------}
+{                 TClockView OBJECT - ANCESTOR VIEW OBJECT                  }
+{---------------------------------------------------------------------------}
+TYPE
+   TClockView = OBJECT (TView)
+         am : AnsiChar;
+         Refresh : Byte;                              { Refresh rate }
+         LastTime: Longint;                           { Last time displayed }
+         TimeStr : String[10];                        { Time string }
+      CONSTRUCTOR Init (Var Bounds: TRect);
+      FUNCTION FormatTimeStr (H, M, S: Word): String; Virtual;
+      PROCEDURE Update; Virtual;
+      PROCEDURE Draw; Virtual;
+   END;
+   PClockView = ^TClockView;                          { Clockview ptr }
+
+{---------------------------------------------------------------------------}
+{ Registrations records                                                     }
+{---------------------------------------------------------------------------}
+const
+  RHeapView: TStreamRec = (
+     ObjType: idHeap;
+     VmtLink: Ofs(TypeOf(THeapView)^);
+     Load:    @THeapView.Load;
+     Store:   @THeapView.Store
+  );
+
+  RClockView: TStreamRec = (
+     ObjType: idClock;
+     VmtLink: Ofs(TypeOf(TClockView)^);
+     Load:    @TClockView.Load;
+     Store:   @TClockView.Store
+  );
+
+{---------------------------------------------------------------------------}
+{ Registration procedure                                                    }
+{---------------------------------------------------------------------------}
+procedure RegisterGadgets;
+
+{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
+                             IMPLEMENTATION
+{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
+
+{***************************************************************************}
+{                              OBJECT METHODS                               }
+{***************************************************************************}
+
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+{                          THeapView OBJECT METHODS                         }
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+
+constructor THeapView.Init(var Bounds: TRect);
+begin
+  inherited Init(Bounds);
+  mode:=HVNormal;
+  OldMem := 0;
+end;
+
+constructor THeapView.InitComma(var Bounds: TRect);
+begin
+  inherited Init(Bounds);
+  mode:=HVComma;
+  OldMem := 0;
+end;
+
+constructor THeapView.InitKb(var Bounds: TRect);
+begin
+  inherited Init(Bounds);
+  mode:=HVKb;
+  OldMem := 0;
+end;
+
+constructor THeapView.InitMb(var Bounds: TRect);
+begin
+  inherited Init(Bounds);
+  mode:=HVMb;
+  OldMem := 0;
+end;
+
+{--THeapView----------------------------------------------------------------}
+{  Update -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Nov99 LdB            }
+{---------------------------------------------------------------------------}
+PROCEDURE THeapView.Update;
+var
+  status : TFPCHeapStatus;
+BEGIN
+   status:=GetFPCHeapStatus;
+   If (OldMem <> status.CurrHeapUsed) Then Begin                 { Memory differs }
+     OldMem := status.CurrHeapUsed;                              { Hold memory avail }
+     DrawView;                                        { Now redraw }
+   End;
+END;
+
+{--THeapView----------------------------------------------------------------}
+{  Draw -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Nov99 LdB              }
+{---------------------------------------------------------------------------}
+PROCEDURE THeapView.Draw;
+VAR
+  C : Byte;
+  S : String;
+  B : TDrawBuffer;
+begin
+  case mode of
+    HVNormal :
+      Str(OldMem:Size.X, S);
+    HVComma :
+      S:=Comma(OldMem);
+    HVKb :
+      begin
+        Str(OldMem shr 10:Size.X-1, S);
+        S:=S+'K';
+      end;
+    HVMb :
+      begin
+        Str(OldMem shr 20:Size.X-1, S);
+        S:=S+'M';
+      end;
+  end;
+  C:=GetColor(2);
+  MoveChar(B,' ',C,Size.X);
+  MoveStr(B,S,C);
+  WriteLine(0,0,Size.X,1,B);
+END;
+
+Function THeapView.Comma ( n : LongInt) : String;
+Var
+  num, loc : Byte;
+  s : String;
+  t : String;
+Begin
+  Str (n,s);
+  Str (n:Size.X,t);
+
+  num := length(s) div 3;
+  if (length(s) mod 3) = 0 then dec (num);
+
+  delete (t,1,num);
+  loc := length(t)-2;
+
+  while num > 0 do
+  Begin
+    Insert (',',t,loc);
+    dec (num);
+    dec (loc,3);
+  End;
+
+  Comma := t;
+End;
+
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+{                        TClockView OBJECT METHODS                          }
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+
+{--TClockView---------------------------------------------------------------}
+{  Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Nov99 LdB              }
+{---------------------------------------------------------------------------}
+CONSTRUCTOR TClockView.Init (Var Bounds: TRect);
+BEGIN
+   Inherited Init(Bounds);                            { Call ancestor }
+   FillChar(LastTime, SizeOf(LastTime), #$FF);        { Fill last time }
+   TimeStr := '';                                     { Empty time string }
+   Refresh := 1;                                      { Refresh per second }
+END;
+
+{--TClockView---------------------------------------------------------------}
+{  FormatTimeStr -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Nov99 LdB     }
+{---------------------------------------------------------------------------}
+FUNCTION TClockView.FormatTimeStr (H, M, S: Word): String;
+VAR Hs, Ms, Ss: String;
+BEGIN
+   Str(H, Hs);                                        { Convert hour string }
+   While (Length(Hs) < 2) Do Hs := '0' + Hs;          { Add lead zero's }
+   Str(M, Ms);                                        { Convert min string }
+   While (Length(Ms) < 2) Do Ms := '0' + Ms;          { Add lead zero's }
+   Str(S, Ss);                                        { Convert sec string }
+   While (Length(Ss) < 2) Do Ss := '0' + Ss;          { Add lead zero's }
+   FormatTimeStr := Hs + ':'+ Ms + ':' + Ss;          { Return string }
+END;
+
+{--TClockView---------------------------------------------------------------}
+{  Update -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Nov99 LdB            }
+{---------------------------------------------------------------------------}
+PROCEDURE TClockView.Update;
+VAR Hour, Min, Sec, Sec100: Word;
+BEGIN
+   GetTime(Hour, Min, Sec, Sec100);                   { Get current time }
+   If (Abs(Sec - LastTime) >= Refresh) Then Begin     { Refresh time elapsed }
+     LastTime := Sec;                                 { Hold second }
+     TimeStr := FormatTimeStr(Hour, Min, Sec);        { Create time string }
+     DrawView;                                        { Now redraw }
+   End;
+END;
+
+{--TClockView---------------------------------------------------------------}
+{  DrawBackGround -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Nov99 LdB    }
+{---------------------------------------------------------------------------}
+PROCEDURE TClockView.Draw;
+VAR
+  C : Byte;
+  B : TDrawBuffer;
+BEGIN
+  C:=GetColor(2);
+  MoveChar(B,' ',C,Size.X);
+  MoveStr(B,TimeStr,C);
+  WriteLine(0,0,Size.X,1,B);
+END;
+
+{---------------------------------------------------------------------------}
+{ Registration procedure                                                    }
+{---------------------------------------------------------------------------}
+procedure RegisterGadgets;
+begin
+  RegisterType(RHeapView);
+  RegisterType(RClockView);
+end;
+
+END.

+ 1 - 346
packages/fv/src/gadgets.pas

@@ -1,346 +1 @@
-{********[ SOURCE FILE OF GRAPHICAL FREE VISION ]**********}
-{                                                          }
-{   System independent GRAPHICAL clone of GADGETS.PAS      }
-{                                                          }
-{   Interface Copyright (c) 1992 Borland International     }
-{                                                          }
-{   Copyright (c) 1999 by Leon de Boer                     }
-{   [email protected]  - primary e-mail address        }
-{   [email protected] - backup e-mail address         }
-{                                                          }
-{****************[ THIS CODE IS FREEWARE ]*****************}
-{                                                          }
-{     This sourcecode is released for the purpose to       }
-{   promote the pascal language on all platforms. You may  }
-{   redistribute it and/or modify with the following       }
-{   DISCLAIMER.                                            }
-{                                                          }
-{     This SOURCE CODE is distributed "AS IS" WITHOUT      }
-{   WARRANTIES AS TO PERFORMANCE OF MERCHANTABILITY OR     }
-{   ANY OTHER WARRANTIES WHETHER EXPRESSED OR IMPLIED.     }
-{                                                          }
-{*****************[ SUPPORTED PLATFORMS ]******************}
-{     16 and 32 Bit compilers                              }
-{        DOS      - Turbo Pascal 7.0 +      (16 Bit)       }
-{        DPMI     - Turbo Pascal 7.0 +      (16 Bit)       }
-{                 - FPC 0.9912+ (GO32V2)    (32 Bit)       }
-{        WINDOWS  - Turbo Pascal 7.0 +      (16 Bit)       }
-{                 - Delphi 1.0+             (16 Bit)       }
-{        WIN95/NT - Delphi 2.0+             (32 Bit)       }
-{                 - Virtual Pascal 2.0+     (32 Bit)       }
-{                 - Speedsoft Sybil 2.0+    (32 Bit)       }
-{                 - FPC 0.9912+             (32 Bit)       }
-{        OS2      - Virtual Pascal 1.0+     (32 Bit)       }
-{                                                          }
-{*******************[ DOCUMENTATION ]**********************}
-{                                                          }
-{   This unit had to be for GFV due to some problems with  }
-{  the original Borland International implementation.      }
-{                                                          }
-{   First it used the DOS unit for it's time calls in the  }
-{  TClockView object. Since this unit can not be compiled  }
-{  under WIN/NT/OS2 we use a new unit TIME.PAS which was   }
-{  created and works under these O/S.                      }
-{                                                          }
-{   Second the HeapView object accessed MemAvail from in   }
-{  the Draw call. As GFV uses heap memory during the Draw  }
-{  call the OldMem value always met the test condition in  }
-{  the update procedure. The consequence was the view      }
-{  would continually redraw. By moving the memavail call   }
-{  the update procedure this eliminates this problem.      }
-{                                                          }
-{   Finally the original object relied on the font AnsiChar    }
-{  blocks being square to erase it's entire view area as   }
-{  it used a simple writeline call in the Draw method.     }
-{  Under GFV font blocks are not necessarily square and    }
-{  so both objects had their Draw routines rewritten. As   }
-{  the Draw had to be redone it was done in the GFV split  }
-{  drawing method to accelerate the graphical speed.       }
-{                                                          }
-{******************[ REVISION HISTORY ]********************}
-{  Version  Date        Fix                                }
-{  -------  ---------   ---------------------------------  }
-{  1.00     12 Nov 99   First multi platform release       }
-{**********************************************************}
-
-{$IFNDEF FPC_DOTTEDUNITS}
-UNIT Gadgets;
-{$ENDIF FPC_DOTTEDUNITS}
-
-{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
-                                  INTERFACE
-{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
-
-{====Include file to sort compiler platform out =====================}
-{$I platform.inc}
-{====================================================================}
-
-{==== Compiler directives ===========================================}
-
-{$IFNDEF PPC_FPC}{ FPC doesn't support these switches }
-  {$F-} { Near calls are okay }
-  {$A+} { Word Align Data }
-  {$B-} { Allow short circuit boolean evaluations }
-  {$O+} { This unit may be overlaid }
-  {$G+} { 286 Code optimization - if you're on an 8088 get a real computer }
-  {$P-} { Normal string variables }
-  {$N-} { No 80x87 code generation }
-  {$E+} { Emulation is on }
-{$ELSE}
-  {$H-}
-{$ENDIF}
-
-{$X+} { Extended syntax is ok }
-{$R-} { Disable range checking }
-{$S-} { Disable Stack Checking }
-{$I-} { Disable IO Checking }
-{$Q-} { Disable Overflow Checking }
-{$V-} { Turn off strict VAR strings }
-{====================================================================}
-
-{$IFDEF FPC_DOTTEDUNITS}
-USES FreeVision.Fvconsts, FreeVision.Time, System.Objects,FreeVision.Drivers, FreeVision.Views, FreeVision.App;      { Standard GFV units }
-{$ELSE FPC_DOTTEDUNITS}
-USES FVConsts, Time, Objects, Drivers, Views, App;      { Standard GFV units }
-{$ENDIF FPC_DOTTEDUNITS}
-
-{***************************************************************************}
-{                        PUBLIC OBJECT DEFINITIONS                          }
-{***************************************************************************}
-
-{---------------------------------------------------------------------------}
-{                  THeapView OBJECT - ANCESTOR VIEW OBJECT                  }
-{---------------------------------------------------------------------------}
-TYPE
-   THeapViewMode=(HVNormal,HVComma,HVKb,HVMb);
-
-   THeapView = OBJECT (TView)
-         Mode   : THeapViewMode;
-         OldMem: LongInt;                             { Last memory count }
-      constructor Init(var Bounds: TRect);
-      constructor InitComma(var Bounds: TRect);
-      constructor InitKb(var Bounds: TRect);
-      constructor InitMb(var Bounds: TRect);
-      PROCEDURE Update;
-      PROCEDURE Draw; Virtual;
-      Function  Comma ( N : LongInt ) : String;
-   END;
-   PHeapView = ^THeapView;                            { Heapview pointer }
-
-{---------------------------------------------------------------------------}
-{                 TClockView OBJECT - ANCESTOR VIEW OBJECT                  }
-{---------------------------------------------------------------------------}
-TYPE
-   TClockView = OBJECT (TView)
-         am : AnsiChar;
-         Refresh : Byte;                              { Refresh rate }
-         LastTime: Longint;                           { Last time displayed }
-         TimeStr : String[10];                        { Time string }
-      CONSTRUCTOR Init (Var Bounds: TRect);
-      FUNCTION FormatTimeStr (H, M, S: Word): String; Virtual;
-      PROCEDURE Update; Virtual;
-      PROCEDURE Draw; Virtual;
-   END;
-   PClockView = ^TClockView;                          { Clockview ptr }
-
-{---------------------------------------------------------------------------}
-{ Registrations records                                                     }
-{---------------------------------------------------------------------------}
-const
-  RHeapView: TStreamRec = (
-     ObjType: idHeap;
-     VmtLink: Ofs(TypeOf(THeapView)^);
-     Load:    @THeapView.Load;
-     Store:   @THeapView.Store
-  );
-
-  RClockView: TStreamRec = (
-     ObjType: idClock;
-     VmtLink: Ofs(TypeOf(TClockView)^);
-     Load:    @TClockView.Load;
-     Store:   @TClockView.Store
-  );
-
-{---------------------------------------------------------------------------}
-{ Registration procedure                                                    }
-{---------------------------------------------------------------------------}
-procedure RegisterGadgets;
-
-{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
-                             IMPLEMENTATION
-{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
-
-{***************************************************************************}
-{                              OBJECT METHODS                               }
-{***************************************************************************}
-
-{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
-{                          THeapView OBJECT METHODS                         }
-{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
-
-constructor THeapView.Init(var Bounds: TRect);
-begin
-  inherited Init(Bounds);
-  mode:=HVNormal;
-  OldMem := 0;
-end;
-
-constructor THeapView.InitComma(var Bounds: TRect);
-begin
-  inherited Init(Bounds);
-  mode:=HVComma;
-  OldMem := 0;
-end;
-
-constructor THeapView.InitKb(var Bounds: TRect);
-begin
-  inherited Init(Bounds);
-  mode:=HVKb;
-  OldMem := 0;
-end;
-
-constructor THeapView.InitMb(var Bounds: TRect);
-begin
-  inherited Init(Bounds);
-  mode:=HVMb;
-  OldMem := 0;
-end;
-
-{--THeapView----------------------------------------------------------------}
-{  Update -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Nov99 LdB            }
-{---------------------------------------------------------------------------}
-PROCEDURE THeapView.Update;
-var
-  status : TFPCHeapStatus;
-BEGIN
-   status:=GetFPCHeapStatus;
-   If (OldMem <> status.CurrHeapUsed) Then Begin                 { Memory differs }
-     OldMem := status.CurrHeapUsed;                              { Hold memory avail }
-     DrawView;                                        { Now redraw }
-   End;
-END;
-
-{--THeapView----------------------------------------------------------------}
-{  Draw -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Nov99 LdB              }
-{---------------------------------------------------------------------------}
-PROCEDURE THeapView.Draw;
-VAR
-  C : Byte;
-  S : String;
-  B : TDrawBuffer;
-begin
-  case mode of
-    HVNormal :
-      Str(OldMem:Size.X, S);
-    HVComma :
-      S:=Comma(OldMem);
-    HVKb :
-      begin
-        Str(OldMem shr 10:Size.X-1, S);
-        S:=S+'K';
-      end;
-    HVMb :
-      begin
-        Str(OldMem shr 20:Size.X-1, S);
-        S:=S+'M';
-      end;
-  end;
-  C:=GetColor(2);
-  MoveChar(B,' ',C,Size.X);
-  MoveStr(B,S,C);
-  WriteLine(0,0,Size.X,1,B);
-END;
-
-Function THeapView.Comma ( n : LongInt) : String;
-Var
-  num, loc : Byte;
-  s : String;
-  t : String;
-Begin
-  Str (n,s);
-  Str (n:Size.X,t);
-
-  num := length(s) div 3;
-  if (length(s) mod 3) = 0 then dec (num);
-
-  delete (t,1,num);
-  loc := length(t)-2;
-
-  while num > 0 do
-  Begin
-    Insert (',',t,loc);
-    dec (num);
-    dec (loc,3);
-  End;
-
-  Comma := t;
-End;
-
-{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
-{                        TClockView OBJECT METHODS                          }
-{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
-
-{--TClockView---------------------------------------------------------------}
-{  Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Nov99 LdB              }
-{---------------------------------------------------------------------------}
-CONSTRUCTOR TClockView.Init (Var Bounds: TRect);
-BEGIN
-   Inherited Init(Bounds);                            { Call ancestor }
-   FillChar(LastTime, SizeOf(LastTime), #$FF);        { Fill last time }
-   TimeStr := '';                                     { Empty time string }
-   Refresh := 1;                                      { Refresh per second }
-END;
-
-{--TClockView---------------------------------------------------------------}
-{  FormatTimeStr -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Nov99 LdB     }
-{---------------------------------------------------------------------------}
-FUNCTION TClockView.FormatTimeStr (H, M, S: Word): String;
-VAR Hs, Ms, Ss: String;
-BEGIN
-   Str(H, Hs);                                        { Convert hour string }
-   While (Length(Hs) < 2) Do Hs := '0' + Hs;          { Add lead zero's }
-   Str(M, Ms);                                        { Convert min string }
-   While (Length(Ms) < 2) Do Ms := '0' + Ms;          { Add lead zero's }
-   Str(S, Ss);                                        { Convert sec string }
-   While (Length(Ss) < 2) Do Ss := '0' + Ss;          { Add lead zero's }
-   FormatTimeStr := Hs + ':'+ Ms + ':' + Ss;          { Return string }
-END;
-
-{--TClockView---------------------------------------------------------------}
-{  Update -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Nov99 LdB            }
-{---------------------------------------------------------------------------}
-PROCEDURE TClockView.Update;
-VAR Hour, Min, Sec, Sec100: Word;
-BEGIN
-   GetTime(Hour, Min, Sec, Sec100);                   { Get current time }
-   If (Abs(Sec - LastTime) >= Refresh) Then Begin     { Refresh time elapsed }
-     LastTime := Sec;                                 { Hold second }
-     TimeStr := FormatTimeStr(Hour, Min, Sec);        { Create time string }
-     DrawView;                                        { Now redraw }
-   End;
-END;
-
-{--TClockView---------------------------------------------------------------}
-{  DrawBackGround -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Nov99 LdB    }
-{---------------------------------------------------------------------------}
-PROCEDURE TClockView.Draw;
-VAR
-  C : Byte;
-  B : TDrawBuffer;
-BEGIN
-  C:=GetColor(2);
-  MoveChar(B,' ',C,Size.X);
-  MoveStr(B,TimeStr,C);
-  WriteLine(0,0,Size.X,1,B);
-END;
-
-{---------------------------------------------------------------------------}
-{ Registration procedure                                                    }
-{---------------------------------------------------------------------------}
-procedure RegisterGadgets;
-begin
-  RegisterType(RHeapView);
-  RegisterType(RClockView);
-end;
-
-END.
+{$I gadgets.inc}

+ 1421 - 0
packages/fv/src/statuses.inc

@@ -0,0 +1,1421 @@
+{$V-}
+{$IFNDEF FPC_DOTTEDUNITS}
+unit Statuses;
+{$ENDIF FPC_DOTTEDUNITS}
+
+{$CODEPAGE cp437}
+
+{#Z+}
+{  Free Vision Status Objects Unit
+   Free VIsion
+   Written by : Brad Williams, DVM
+
+Revision History
+
+1.2.3   (96/04/13)
+  - moved Pause and Resume to methods of TStatus leaving TStatus Pause and
+    Resume "aware"
+  - eliminated many bugs
+  - moved Pause, Resume and Cancel from TStatusDlg to TStatus
+
+1.2.1    (95/12/6)
+   - minor typo corrections in opening unit documentation
+   - F+ to Z+ around stream registration records
+   - removed redundant sentence in TAppStatus definition
+   - updated CBarStatus documentation and constant
+   - removed TGauge.Init cross-reference from TSpinner.Init
+   - added THeapMemAvail and RegistertvStatus documentation
+   - numerous other documentation updates
+   - changed all calls to Send to Message
+
+1.2.0    (95/11/24)
+   - conversion to Bsd format
+
+1.1.0    (05/01/94)
+   - initial WVS release
+
+
+Known Bugs
+
+ScanHelp Errors
+   - sdXXXX constants help documentation doesn't show TStatusDlg and
+     TMessageStatusDlg
+   - ScanHelp produces garbage in evStatus help context
+
+tvStatus Bugs
+   - CAppStatus may not be correct }
+{#Z-}
+
+{ The tvStatus unit implements several views for providing information to
+the user which needs to be updated during program execution, such as a
+progress indicator, clock, heap viewer, gauges, etc.  All tvStatus views
+respond to a new message event class, evStatus.  An individual status view
+only processes an event with its associated command. }
+
+interface
+
+{$i platform.inc}
+
+{$ifdef PPC_FPC}
+  {$H-}
+{$else}
+  {$F+,O+,E+,N+}
+{$endif}
+{$X+,R-,I-,Q-,V-}
+{$ifndef OS_UNIX}
+  {$S-}
+{$endif}
+
+{$IFDEF FPC_DOTTEDUNITS}
+uses
+  FreeVision.Fvcommon, FreeVision.Fvconsts, System.Objects, FreeVision.Drivers, 
+  FreeVision.Views, FreeVision.Dialogs;
+{$ELSE FPC_DOTTEDUNITS}
+uses
+  FVCommon, FVConsts, Objects, Drivers, Views, Dialogs;
+{$ENDIF FPC_DOTTEDUNITS}
+{  Resource;}
+
+const
+
+  evStatus = $8000;
+    { evStatus represents the event class all status views know how to
+      respond to. }
+    {#X Statuses }
+
+
+  CStatus    =  #1#2#3;
+{$ifndef cdPrintDoc}
+{#F+}
+{*TStatus.CStatus palette
+*************************}
+{#F-}
+{$endif cdPrintDoc}
+{ Status views use the default palette, CStatus, to map onto the first three
+entries in the standard window palette. }
+{#F+}
+{             1    2    3
+           +====+====+====+
+ CStatus   |  1 |  2 |  3 |
+           +==+=+==+=+==+=+
+Normal Text---+    |    |
+Other--------------+    |
+Highlighted Text--------+ }
+{#F-}
+{#X TStatus }
+
+  CAppStatus =  #2#5#4;
+{$ifndef cdPrintDoc}
+{#F+}
+{*TAppStatus.CAppStatus palette
+*******************************}
+{#F-}
+{$endif cdPrintDoc}
+{ Status views which are inserted into the application rather than a dialog
+or window use the default palette, CAppStatus, to map onto the application
+object's palette. }
+{#F+}
+{                1    2    3
+              +====+====+====+
+ CAppStatus   |  2 |  5 |  4 |
+              +==+=+==+=+==+=+
+Normal Text------+    |    |
+Other-----------------+    |
+Highlighted Text-----------+ }
+{#F-}
+    {#X tvStatus TAppStatus }
+
+
+  CBarGauge = CStatus + #16#19;
+{$ifndef cdPrintDoc}
+{#F+}
+{*TBarGauge.CBarGauge palette
+*****************************}
+{#F-}
+{$endif cdPrintDoc}
+{ TBarGauge's use the default palette, CBarGauge, to map onto the dialog or
+window owner's palette. }
+{#F+}
+{                1    2    3   4    5
+              +====+====+====+====+====+
+ CAppStatus   |  2 |  5 |  4 | 16 | 19 |
+              +==+=+==+=+==+=+==+=+==+=+
+Normal Text------+    |    |    |    +---- filled in bar
+Other-----------------+    |    +--------- empty bar
+Highlighted Text-----------+ }
+{#F-}
+    {#X tvStatus TBarGauge }
+
+
+{#T sdXXXX }
+{$ifndef cdPrintDoc}
+{#F+}
+{***********************************
+* sdXXXX constants   (STDDLG unit) *
+************************************}
+{#F-}
+{$endif cdNoPrintDoc}
+{ sdXXXX constants are used to determine the types of buttons displayed in a
+#TStatusDlg# or #TStatusMessageDlg#. }
+{#F+}
+{   Constant      | Value | Meaning
+==================+=======+=================================
+  sdNone          | $0000 | no buttons
+  sdCancelButton  | $0001 | show Cancel button
+  sdPauseButton   | $0002 | show Pause button
+  sdResumeButton  | $0004 | show Resume button
+  sdAllButtons    | $0008 | show Cancel, Pause and Resume
+                  |       |   buttons }
+{#Z+}
+  sdNone                 = $0000;
+  sdCancelButton         = $0001;
+  sdPauseButton          = $0002;
+  sdResumeButton         = $0004;
+  sdAllButtons           = sdCancelButton or sdPauseButton or sdResumeButton;
+{#Z-}
+  {#X tvStatus TStatusDlg TStatusMessageDlg }
+
+{$ifdef FV_UNICODE}
+  SpinChars : UnicodeString = #$2502'/'#$2500'\';
+{$else FV_UNICODE}
+  SpinChars : String[4] = #179'/'#196'\';
+{$endif FV_UNICODE}
+    { SpinChars are the characters used by a #TSpinnerGauge# when it is drawn.
+      Only one character is displayed at a time.  The string is cycled
+      through then started over again until the view is disposed. }
+    {#X tvStatus }
+
+  sfPause = $F000;
+    { sfPause is an additional state flag used internally by status views to
+      indicate they are in a paused state and should not respond to their
+      command. }
+
+type
+  {#Z+}
+  PStatus = ^TStatus;
+  {#Z-}
+  TStatus = Object(TParamText)
+    { TStatus is the base object type from which all status views descend.
+      Status views are used to display information that will change at
+      run-time based upon some state or process in the application, such as
+      printing.
+
+      All status views that are to be inserted into the application should
+      descend from #TAppStatus# for proper color mapping. }
+    Command : Word;
+      { Command is the only command the status view will respond to.  When
+        the status view receives an evStatus event it checks the value of the
+        Event.Command field against Command before handling the event. }
+      {#X HandleEvent }
+    constructor Init (R : TRect; ACommand : Word; AText : String;
+                      AParamCount : SmallInt);
+      { Init calls the inherited constructor then sets #Command# to ACommand.
+
+        If an error occurs Init fails. }
+      {#X Load }
+    constructor Load (var S : TStream);
+      { Load calls the inherited constructor then reads #Command# from the
+        stream.
+
+        If an error occurs Load fails. }
+      {#X Store Init }
+    function Cancel : Boolean; virtual;
+      { Cancel should prompt the user when necessary for validation of
+        canceling the process which the status view is displaying.  If the
+        user elects to continue the process Cancel must return False,
+        otherwise Cancel must return True. }
+      {#X Pause Resume }
+    function GetPalette : PPalette; virtual;
+      { GetPalette returns a pointer to the default status view palette,
+        #CStatus#. }
+      {#X TAppStatus CAppStatus }
+    procedure HandleEvent (var Event : TEvent); virtual;
+      { HandleEvent captures any #evStatus# messages with its command value
+        equal to #Command#, then calls #Update# with Data set to
+        Event.InfoPtr.  If the State field has its #sfPause# bit set, the
+        view ignores the event. }
+    procedure Pause; virtual;
+      { Pause sends an evStatus message to the application with Event.Command
+        set to cmStatusPause and Event.InfoPtr set to #Status#^.Command.  The
+        #Status# view's sfPause bit of the State flag is set by calling
+        SetState.  In the paused state, the status view does not respond to
+        its associated command. }
+      {#X Resume sdXXXX Cancel }
+    procedure Reset; virtual;
+      { Reset causes the status view to be reset to its beginning or default
+        value, then be redrawn.  Reset is used after an event is aborted
+        which can only be performed in its entirety. }
+    procedure Resume; virtual;
+      { Resume is called in response to pressing the Resume button.  Resume
+        sends an evStatus message to the application with Event.Command set
+        to cmStatusPause and Event.InfoPtr set to #Status#^.Command.  The
+        Status view's sfPause bit is turned off by calling SetState. }
+      {#X Pause sdXXXX Cancel }
+    procedure Store (var S : TStream); { store should never be virtual;}
+      { Store calls the inherited Store method then writes #Command# to the
+        stream. }
+      {#X Load }
+    procedure Update (Data : Pointer); virtual;
+      { Update changes the status' displayed text as necessary based on
+        Data. }
+      {#X Command HandleEvent }
+  end;  { of TStatus }
+
+
+  {#Z+}
+  PStatusDlg = ^TStatusDlg;
+  {#Z-}
+  TStatusDlg = Object(TDialog)
+    { A TStatusDlg displays a status view and optional buttons.  It may be
+      used to display any status message and optionally provide end user
+      cancelation or pausing of an ongoing operation, such as printing.
+
+      All status views that are to be inserted into a window or dialog should
+      descend from #TStatus# for proper color mapping. }
+    Status : PStatus;
+      { Status is the key status view for the dialog.  When a cmStatusPause
+        command is broadcast in response to pressing the pause button,
+        Event.InfoPtr is set to point to the command associated with Status. }
+      {#X TStatus cmXXXX }
+    constructor Init (ATitle : TTitleStr; AStatus : PStatus; AFlags : Word);
+      { Init calls the inherited constructor to create the dialog and sets
+        the EventMask to handle #evStatus# events.  AStatus is assigned to
+        #Status# and inserted into the dialog at position 2,2.
+
+        The dialog is anchored at AStatus^.Origin and its size is at least
+        AStatus^.Size + 2 in both dimensions.  The actual size is determined
+        by the AFlags byte.  The #sdXXXX# constants should be used to signify
+        which buttons to display.
+
+        If an error occurs Init fails. }
+      {#X TStatus.Pause TStatus.Resume }
+    constructor Load (var S : TStream);
+      { Load calls the inherited constructor then loads #Status#.
+
+        If an error occurs Load fails. }
+      {#X Store }
+    procedure Cancel (ACommand : Word); virtual;
+      { Cancel sends an evStatus message to the Application object with
+        command set to cmCancel and InfoPtr set to the calling status view's
+        command, then calls the inherited Cancel method. }
+      {#X TBSDDialog.Cancel }
+    procedure HandleEvent (var Event : TEvent); virtual;
+      { All evStatus events are accepted by the dialog and sent to each
+        subview in Z-order until cleared.
+
+        If the dialog recieves an evCommand or evBroadcast event with the
+        Command parameter set to cmCancel, HandleEvent sends an #evStatus#
+        message to the Application variable with Event.Command set to the
+        cmStatusCancel and Event.InfoPtr set to the #Status#.Command and
+        disposes of itself.
+
+        When a pause button is included, a cmStatusPause broadcast event is
+        associated with the button.  When the button is pressed a call to
+        #TStatus.Pause# results.  The status view is inactivated until it
+        receives an evStatus event with a commond of cmStatusResume and
+        Event.InfoPtr set to the status view's Command value.  When a pause
+        button is used, the application should respond to the evStatus event
+        (with Event.Command of cmStatusPause) appropriately, then dispatch a
+        cmStatusResume evStatus event when ready to resume activity. }
+      {#X TStatus.Command }
+    procedure InsertButtons (AFlags : Word); virtual;
+      { InsertButtons enlarges the dialog to the necessary size and inserts
+        the buttons specified in AFlags into the last row of the dialog. }
+    procedure Store (var S : TStream); { store should never be virtual;}
+      { Store calls the inherited Store method then writes #Status# to the
+        stream. }
+      {#X Load }
+  end;  { of TStatusDlg }
+
+
+  {#Z+}
+  PStatusMessageDlg = ^TStatusMessageDlg;
+  {#Z-}
+  TStatusMessageDlg = Object(TStatusDlg)
+    { A TStatusMessageDlg displays a message as static text with a status
+      view on the line below it.
+
+      All status views that are to be inserted into a window or dialog should
+      descend from #TStatus# for proper color mapping. }
+    constructor Init (ATitle : TTitleStr; AStatus : PStatus; AFlags : Word;
+                      AMessage : String);
+      { Init calls the inherited constructor then inserts a TStaticText view
+        containing AMessage at the top line of the dialog.
+
+        The size of the dialog is determined by the size of the AStatus.  The
+        dialog is anchored at AStatus^.Origin and is of at least
+        AStatus^.Size + 2 in heighth and width.  The exact width and heighth
+        are determined by AOptions.
+
+        AFlags contains flags which determine the buttons to be displayed
+        in the dialog.
+
+        If an error occurs Init fails. }
+  end;  { of TStatusMessageDlg }
+
+
+  {#Z+}
+  PGauge = ^TGauge;
+  {#Z-}
+  TGauge = Object(TStatus)
+    { A gauge is used to represent the current numerical position within a
+      range of values.  When Current equals Max a gauge dispatches an
+      #evStatus# event with the command set to cmStatusDone to the
+      Application object. }
+    Min : LongInt;
+      { Min is the minimum value which #Current# may be set to. }
+      {#X Max }
+    Max : LongInt;
+      { Max is the maximum value which #Current# may be set to. }
+      {#X Min }
+    Current : LongInt;
+      { Current is the current value represented in the gauge. }
+      {#X Max Min }
+    constructor Init (R : TRect; ACommand : Word; AMin, AMax : LongInt);
+      { Init calls the inherited constructor then sets #Min# and #Max# to
+        AMin and AMax, respectively.  #Current# is set to AMin.
+
+        If an error occurs Init fails. }
+      {#X Load }
+    constructor Load (var S : TStream);
+      { Load calls the inherited constructor then reads #Min#, #Max# and
+        #Current# from the stream.
+
+        If an error occurs Load fails. }
+      {#X Init Store }
+    procedure Draw; virtual;
+      { Draw writes the following to the screen: }
+{#F+}
+{
+Min = XXX  Max = XXX  Current = XXX }
+{#F-}
+      { where XXX are the current values of the corresponding variables. }
+    procedure GetData (var Rec); virtual;
+      { GetData assumes Rec is a #TGaugeRec# and returns the current settings
+        of the gauge. }
+      {#X SetData }
+    procedure Reset; virtual;
+      { Reset sets #Current# to #Min# then redraws the status view. }
+      {#X TStatus.Reset }
+    procedure SetData (var Rec); virtual;
+      { SetData assumes Rec is a #TGaugeRec# and sets the gauge's variables
+        accordingly. }
+      {#X GetData }
+    procedure Store (var S : TStream); { store should never be virtual;}
+      { Store calls the inherited Store method then writes #Min#, #Max# and
+        #Current# to the stream. }
+      {#X Load }
+    procedure Update (Data : Pointer); virtual;
+      { Update increments #Current#. }
+  end;  { of TGauge }
+
+
+  {#Z+}
+  PGaugeRec = ^TGaugeRec;
+  {#Z-}
+  TGaugeRec = record
+    { A TGaugeRec is used to set and get a #TGauge#'s variables. }
+    {#X TGauge.GetData TGauge.SetData }
+    Min, Max, Current : LongInt;
+  end;  { of TGaugeRec }
+
+
+  {#Z+}
+  PArrowGauge = ^TArrowGauge;
+  {#Z-}
+  TArrowGauge = Object(TGauge)
+    { An arrow gauge draws a progressively larger series of arrows across the
+      view.  If Right is True, the arrows are right facing, '>', and are
+      drawn from left to right.  If Right is False, the arrows are left
+      facing, '<', and are drawn from right to left. }
+    Right : Boolean;
+      { Right determines the direction of arrow used and the direction which
+        the status view is filled.  If Right is True, the arrows are right
+        facing, '>', and are drawn from left to right.  If Right is False,
+        the arrows are left facing, '<', and are drawn from right to left. }
+      {#X Draw }
+    constructor Init (R : TRect; ACommand : Word; AMin, AMax : Word;
+                      RightArrow : Boolean);
+      { Init calls the inherited constructor then sets #Right# to RightArrow.
+
+        If an error occurs Init fails. }
+      {#X Load }
+    constructor Load (var S : TStream);
+      { Load calls the inherited constructor then reads #Right# from the
+        stream.
+
+        If an error occurs Load fails. }
+      {#X Init Store }
+    procedure Draw; virtual;
+      { Draw fills the Current / Max percent of the view with arrows. }
+      {#X Right }
+    procedure GetData (var Rec); virtual;
+      { GetData assumes Rec is a #TArrowGaugeRec# and returns the current
+        settings of the views variables. }
+      {#X SetData }
+    procedure SetData (var Rec); virtual;
+      { SetData assumes Rec is a #TArrowGaugeRec# and sets the view's
+        variables accordingly. }
+      {#X GetData }
+    procedure Store (var S : TStream); { store should never be virtual;}
+      { Store calls the inherited Store method then writes #Right# to the
+        stream. }
+      {#X Load }
+  end;  { of TArrowGauge }
+
+
+  {#Z+}
+  PArrowGaugeRec = ^TArrowGaugeRec;
+  {#Z-}
+  TArrowGaugeRec = record
+    { A TArrowGaugeRec is used to set and get the variables of a
+      #TArrowGauge#. }
+    {#X TArrowGauge.GetData TArrowGauge.SetData }
+    Min, Max, Count : LongInt;
+    Right : Boolean;
+  end;  { of TGaugeRec }
+
+
+  {#Z+}
+  PPercentGauge = ^TPercentGauge;
+  {#Z-}
+  TPercentGauge = Object(TGauge)
+    { A TPercentGauge displays a numerical percentage as returned by
+      #Percent# followed by a '%' sign. }
+    function Percent : SmallInt; virtual;
+      { Percent returns the whole number value of (Current / Max) * 100. }
+      {#X TGauge.Current TGauge.Max }
+    procedure Draw; virtual;
+      { Draw writes the current percentage to the screen. }
+      {#X Percent }
+  end;  { of TPercentGauge }
+
+
+  {#Z+}
+  PBarGauge = ^TBarGauge;
+  {#Z-}
+  TBarGauge = Object(TPercentGauge)
+    { A TBarGauge displays a bar which increases in size from the left to
+      the right of the view as Current increases.  A numeric percentage
+      representing the value of (Current / Max) * 100 is displayed in the
+      center of the bar. }
+    {#x TPercentGauge.Percent }
+    procedure Draw; virtual;
+      { Draw draws the bar and percentage to the screen representing the
+        current status of the view's variables. }
+      {#X TGauge.Update }
+    function GetPalette : PPalette; virtual;
+      { GetPalette returns a pointer to the default status view palette,
+        #CBarStatus#. }
+  end;  { of TBarGauge }
+
+
+  {#Z+}
+  PSpinnerGauge = ^TSpinnerGauge;
+  {#Z-}
+  TSpinnerGauge = Object(TGauge)
+    { A TSpinnerGauge displays a series of characters in one spot on the
+      screen giving the illusion of a spinning line. }
+    constructor Init (X, Y : SmallInt; ACommand : Word);
+      { Init calls the inherited constructor with AMin set to 0 and AMax set
+        to 4. }
+    procedure Draw; virtual;
+      { Draw uses the #SpinChars# variable to draw the view's Current
+        character. }
+      {#X Update }
+    procedure HandleEvent (var Event : TEvent); virtual;
+      { HandleEvent calls TStatus.HandleEvent so that a cmStatusDone event
+        is not generated when Current equals Max. }
+      {#X TGauge.Current TGauge.Max }
+    procedure Update (Data : Pointer); virtual;
+      { Update increments Current until Current equals Max, when it resets
+        Current to Min. }
+      {#X Draw HandleEvent }
+  end;  { of TSpinnerGauge }
+
+
+  {#Z+}
+  PAppStatus = ^TAppStatus;
+  {#Z-}
+  TAppStatus = Object(TStatus)
+    { TAppStatus is a base object which implements color control for status
+      views that are normally inserted in the Application object. }
+    {#X TStatus }
+    function GetPalette : PPalette; virtual;
+      { GetPalette returns a pointer to the default application status view
+        palette, #CAppStatus#. }
+      {#X TStatus CStatus }
+  end;  { of TAppStatus }
+
+
+  {#Z+}
+  PHeapMaxAvail = ^THeapMaxAvail;
+  {#Z-}
+  THeapMaxAvail = Object(TAppStatus)
+    { A THeapMaxAvail displays the largest available contiguous area of heap
+      memory.  It responds to a cmStatusUpdate event by calling MaxAvail and
+      comparing the result to #Max#, then updating the view if necessary. }
+    {#X THeapMemAvail }
+    constructor Init (X, Y : SmallInt);
+      { Init creates the view with the following text:
+
+        MaxAvail = xxxx
+
+        where xxxx is the result returned by MaxAvail. }
+    procedure Update (Data : Pointer); virtual;
+      { Update changes #Mem# to the current MemAvail and redraws the status
+        if necessary. }
+      private
+    Max : LongInt;
+      { Max is the last reported value from MaxAvail. }
+      {#X Update }
+  end;  { of THeapMaxAvail }
+
+
+  {#Z+}
+  PHeapMemAvail = ^THeapMemAvail;
+  {#Z-}
+  THeapMemAvail = Object(TAppStatus)
+    { A THeapMemAvail displays the total amount of heap memory available to
+      the application.  It responds to a cmStatusUpdate event by calling
+      MemAvail and comparing the result to #Max#, then updating the view if
+      necessary. }
+    {#X THeapMaxAvail }
+    constructor Init (X, Y : SmallInt);
+      { Init creates the view with the following text:
+
+        MemAvail = xxxx
+
+        where xxxx is the result returned by MemAvail. }
+      {#X Load }
+    procedure Update (Data : Pointer); virtual;
+      { Update changes #Mem# to the current MemAvail and redraws the status
+        if necessary. }
+      private
+    Mem : LongInt;
+      { Mem is the last available value reported by MemAvail. }
+      {#X Update }
+  end;  { of THeapMemAvail }
+
+
+{$ifndef cdPrintDoc}
+{#Z+}
+{$endif cdPrintDoc}
+const
+  RStatus    : TStreamRec = (
+     ObjType : idStatus;
+     VmtLink : Ofs(TypeOf(TStatus)^);
+     Load    : @TStatus.Load;
+     Store   : @TStatus.Store);
+
+  RStatusDlg : TStreamRec = (
+     ObjType : idStatusDlg;
+     VmtLink : Ofs(TypeOf(TStatusDlg)^);
+     Load    : @TStatusDlg.Load;
+     Store   : @TStatusDlg.Store);
+
+  RStatusMessageDlg : TStreamRec = (
+     ObjType : idStatusMessageDlg;
+     VmtLink : Ofs(TypeOf(TStatusMessageDlg)^);
+     Load    : @TStatusMessageDlg.Load;
+     Store   : @TStatusMessageDlg.Store);
+
+  RGauge  : TStreamRec = (
+     ObjType : idGauge;
+     VmtLink : Ofs(TypeOf(TGauge)^);
+     Load    : @TGauge.Load;
+     Store   : @TGauge.Store);
+
+  RArrowGauge  : TStreamRec = (
+     ObjType : idArrowGauge;
+     VmtLink : Ofs(TypeOf(TArrowGauge)^);
+     Load    : @TArrowGauge.Load;
+     Store   : @TArrowGauge.Store);
+
+  RBarGauge  : TStreamRec = (
+     ObjType : idBarGauge;
+     VmtLink : Ofs(TypeOf(TBarGauge)^);
+     Load    : @TBarGauge.Load;
+     Store   : @TBarGauge.Store);
+
+  RPercentGauge  : TStreamRec = (
+     ObjType : idPercentGauge;
+     VmtLink : Ofs(TypeOf(TPercentGauge)^);
+     Load    : @TPercentGauge.Load;
+     Store   : @TPercentGauge.Store);
+
+  RSpinnerGauge  : TStreamRec = (
+     ObjType : idSpinnerGauge;
+     VmtLink : Ofs(TypeOf(TSpinnerGauge)^);
+     Load    : @TSpinnerGauge.Load;
+     Store   : @TSpinnerGauge.Store);
+
+  RAppStatus  : TStreamRec = (
+     ObjType : idAppStatus;
+     VmtLink : Ofs(TypeOf(TAppStatus)^);
+     Load    : @TAppStatus.Load;
+     Store   : @TAppStatus.Store);
+
+  RHeapMinAvail  : TStreamRec = (
+     ObjType : idHeapMinAvail;
+     VmtLink : Ofs(TypeOf(THeapMaxAvail)^);
+     Load    : @THeapMaxAvail.Load;
+     Store   : @THeapMaxAvail.Store);
+
+  RHeapMemAvail  : TStreamRec = (
+     ObjType : idHeapMemAvail;
+     VmtLink : Ofs(TypeOf(THeapMemAvail)^);
+     Load    : @THeapMemAvail.Load;
+     Store   : @THeapMemAvail.Store);
+{$ifndef cdPrintDoc}
+{#Z-}
+{$endif cdPrintDoc}
+
+procedure RegisterStatuses;
+{$ifndef cdPrintDoc}
+{#F+}
+{*********************************************
+*RegisterStatuses procedure   (Statuses unit)*
+**********************************************}
+{#F-}
+{$endif cdPrintDoc}
+  { RegisterStatuses calls RegisterType for each of the status view and
+    status dialog object types defined in the tvStatus unit.  After calling
+    RegisterStatuses, your application can read or write any of those types
+    with streams. }
+
+
+implementation
+
+{$IFDEF FPC_DOTTEDUNITS}
+uses
+  FreeVision.Msgbox, FreeVision.App;
+{$ELSE FPC_DOTTEDUNITS}
+uses
+  MsgBox, App;
+{$ENDIF FPC_DOTTEDUNITS}
+
+{****************************************************************************}
+{                    Local procedures and functions                          }
+{****************************************************************************}
+
+{****************************************************************************}
+{ TAppStatus Object                                                          }
+{****************************************************************************}
+{****************************************************************************}
+{ TAppStatus.GetPalette                                                      }
+{****************************************************************************}
+function TAppStatus.GetPalette : PPalette;
+const P : String[Length(CAppStatus)] = CAppStatus;
+begin
+  GetPalette := PPalette(@P);
+end;
+
+{****************************************************************************}
+{ TArrowGauge Object                                                         }
+{****************************************************************************}
+{****************************************************************************}
+{ TArrowGauge.Init                                                           }
+{****************************************************************************}
+constructor TArrowGauge.Init (R : TRect; ACommand : Word; AMin, AMax : Word;
+                              RightArrow : Boolean);
+begin
+  if not TGauge.Init(R,ACommand,AMin,AMax) then
+    Fail;
+  Right := RightArrow;
+end;
+
+{****************************************************************************}
+{ TArrowGauge.Load                                                           }
+{****************************************************************************}
+constructor TArrowGauge.Load (var S : TStream);
+begin
+  if not TGauge.Load(S) then
+    Fail;
+  S.Read(Right,SizeOf(Right));
+  if (S.Status <> stOk) then
+  begin
+    TGauge.Done;
+    Fail;
+  end;
+end;
+
+{****************************************************************************}
+{ TArrowGauge.Draw                                                           }
+{****************************************************************************}
+procedure TArrowGauge.Draw;
+const Arrows : array[0..1] of AnsiChar = '<>';
+var
+  B : TDrawBuffer;
+  C : Word;
+  Len : Sw_Integer;
+begin
+  C := GetColor(1);
+  Len := Round(Size.X * Current/(Max - Min));
+  if Len>Size.X then Len:=Size.X;
+  MoveChar(B,' ',C,Size.X);
+  if Right then
+    MoveChar(B,Arrows[Byte(Right)],C,Len)
+  else MoveChar(B[Size.X - Len],Arrows[Byte(Right)],C,Len);
+  WriteLine(0,0,Size.X,1,B);
+end;
+
+{****************************************************************************}
+{ TArrowGauge.GetData                                                        }
+{****************************************************************************}
+procedure TArrowGauge.GetData (var Rec);
+begin
+  PArrowGaugeRec(Rec)^.Min := Min;
+  PArrowGaugeRec(Rec)^.Max := Max;
+  PArrowGaugeRec(Rec)^.Count := Current;
+  PArrowGaugeRec(Rec)^.Right := Right;
+end;
+
+{****************************************************************************}
+{ TArrowGauge.SetData                                                        }
+{****************************************************************************}
+procedure TArrowGauge.SetData (var Rec);
+begin
+  Min := PArrowGaugeRec(Rec)^.Min;
+  Max := PArrowGaugeRec(Rec)^.Max;
+  Current := PArrowGaugeRec(Rec)^.Count;
+  Right := PArrowGaugeRec(Rec)^.Right;
+end;
+
+{****************************************************************************}
+{ TArrowGauge.Store                                                          }
+{****************************************************************************}
+procedure TArrowGauge.Store (var S : TStream);
+begin
+  TGauge.Store(S);
+  S.Write(Right,SizeOf(Right));
+end;
+
+{****************************************************************************}
+{ TBarGauge Object                                                           }
+{****************************************************************************}
+{****************************************************************************}
+{ TBarGauge.Draw                                                             }
+{****************************************************************************}
+procedure TBarGauge.Draw;
+var
+  B : TDrawBuffer;
+  C : Word;
+  FillSize : Word;
+  PercentDone : PtrInt;
+  S : String[4];
+begin
+  { fill entire view }
+  MoveChar(B,' ',GetColor(4),Size.X);
+  { make progress bar }
+  C := GetColor(5);
+  FillSize := Round(Size.X * (Current / Max));
+  MoveChar(B,' ',C,FillSize);
+  { display percent done }
+  PercentDone := Percent;
+  FormatStr(S,'%d%%',PercentDone);
+  if PercentDone < 50 then
+    C := GetColor(4);
+  FillSize := (Size.X - Length(S)) div 2;
+  MoveStr(B[FillSize],S,C);
+  WriteLine(0,0,Size.X,Size.Y,B);
+end;
+
+{****************************************************************************}
+{ TBarGauge.GetPalette                                                       }
+{****************************************************************************}
+function TBarGauge.GetPalette : PPalette;
+const
+  S : String[Length(CBarGauge)] = CBarGauge;
+begin
+  GetPalette := PPalette(@S);
+end;
+
+{****************************************************************************}
+{ TGauge Object                                                              }
+{****************************************************************************}
+{****************************************************************************}
+{ TGauge.Init                                                                }
+{****************************************************************************}
+constructor TGauge.Init (R : TRect; ACommand : Word; AMin, AMax : LongInt);
+begin
+  if not TStatus.Init(R,ACommand,'',1) then
+    Fail;
+  Min := AMin;
+  Max := AMax;
+  Current := Min;
+end;
+
+{****************************************************************************}
+{ TGauge.Load                                                                }
+{****************************************************************************}
+constructor TGauge.Load (var S : TStream);
+begin
+  if not TStatus.Load(S) then
+    Fail;
+  S.Read(Min,SizeOf(Min));
+  S.Read(Max,SizeOf(Max));
+  S.Read(Current,SizeOf(Current));
+  if S.Status <> stOk then
+  begin
+    TStatus.Done;
+    Fail;
+  end;
+end;
+
+{****************************************************************************}
+{ TGauge.Draw                                                                }
+{****************************************************************************}
+procedure TGauge.Draw;
+var
+  S : String;
+  B : TDrawBuffer;
+begin
+  { Blank the gauge }
+  MoveChar(B,' ',GetColor(1),Size.X);
+  WriteBuf(0,0,Size.X,Size.Y,B);
+  { write current status }
+  FormatStr(S,'%d',Current);
+  MoveStr(B,S,GetColor(1));
+  WriteBuf(0,0,Size.X,Size.Y,B);
+end;
+
+{****************************************************************************}
+{ TGauge.GetData                                                             }
+{****************************************************************************}
+procedure TGauge.GetData (var Rec);
+begin
+  TGaugeRec(Rec).Min := Min;
+  TGaugeRec(Rec).Max := Max;
+  TGaugeRec(Rec).Current := Current;
+end;
+
+{****************************************************************************}
+{ TGauge.Reset                                                               }
+{****************************************************************************}
+procedure TGauge.Reset;
+begin
+  Current := Min;
+  DrawView;
+end;
+
+{****************************************************************************}
+{ TGauge.SetData                                                             }
+{****************************************************************************}
+procedure TGauge.SetData (var Rec);
+begin
+  Min := TGaugeRec(Rec).Min;
+  Max := TGaugeRec(Rec).Max;
+  Current := TGaugeRec(Rec).Current;
+end;
+
+{****************************************************************************}
+{ TGauge.Store                                                               }
+{****************************************************************************}
+procedure TGauge.Store (var S : TStream);
+begin
+  TStatus.Store(S);
+  S.Write(Min,SizeOf(Min));
+  S.Write(Max,SizeOf(Max));
+  S.Write(Current,SizeOf(Current));
+end;
+
+{****************************************************************************}
+{ TGauge.Update                                                              }
+{****************************************************************************}
+procedure TGauge.Update (Data : Pointer);
+begin
+  if Current < Max then
+  begin
+    Inc(Current);
+    DrawView;
+  end
+  else Message(@Self,evStatus,cmStatusDone,@Self);
+end;
+
+{****************************************************************************}
+{ THeapMaxAvail Object                                                       }
+{****************************************************************************}
+{****************************************************************************}
+{ THeapMaxAvail.Init                                                         }
+{****************************************************************************}
+constructor THeapMaxAvail.Init (X, Y : SmallInt);
+var
+  R : TRect;
+begin
+  R.Assign(X,Y,X+20,Y+1);
+  if not TAppStatus.Init(R,cmStatusUpdate,' MaxAvail = %d',1) then
+    Fail;
+  Max := -1;
+end;
+
+{****************************************************************************}
+{ THeapMaxAvail.Update                                                       }
+{****************************************************************************}
+procedure THeapMaxAvail.Update (Data : Pointer);
+var
+  M : LongInt;
+begin
+  M := MaxAvail;
+  if (Max <> M) then
+  begin
+    Max := MaxAvail;
+    SetData(Max);
+  end;
+end;
+
+{****************************************************************************}
+{ THeapMemAvail Object                                                       }
+{****************************************************************************}
+{****************************************************************************}
+{ THeapMemAvail.Init                                                         }
+{****************************************************************************}
+constructor THeapMemAvail.Init (X, Y : SmallInt);
+var
+  R : TRect;
+begin
+  R.Assign(X,Y,X+20,Y+1);
+  if not TAppStatus.Init(R,cmStatusUpdate,' MemAvail = %d',1) then
+    Fail;
+  Mem := -1;
+end;
+
+{****************************************************************************}
+{ THeapMemAvail.Update                                                       }
+{****************************************************************************}
+procedure THeapMemAvail.Update (Data : Pointer);
+  { Total bytes available on the heap.  May not be contiguous. }
+var
+  M : LongInt;
+begin
+  M := MemAvail;
+  if (Mem <> M) then
+  begin
+    Mem := M;
+    SetData(Mem);
+  end;
+end;
+
+{****************************************************************************}
+{ TPercentGauge Object                                                       }
+{****************************************************************************}
+{****************************************************************************}
+{ TPercentGauge.Draw                                                         }
+{****************************************************************************}
+procedure TPercentGauge.Draw;
+var
+  B : TDrawBuffer;
+  C : Word;
+  S : String;
+  PercentDone : LongInt;
+  FillSize : SmallInt;
+begin
+  C := GetColor(1);
+  MoveChar(B,' ',C,Size.X);
+  WriteLine(0,0,Size.X,Size.Y,B);
+  PercentDone := Percent;
+  FormatStr(S,'%d%%',PercentDone);
+  MoveStr(B[(Size.X - Length(S)) div 2],S,C);
+  WriteLine(0,0,Size.X,Size.Y,B);
+end;
+
+{****************************************************************************}
+{ TPercentGauge.Percent                                                      }
+{****************************************************************************}
+function TPercentGauge.Percent : SmallInt;
+  { Returns percent as a whole SmallInt Current of Max }
+begin
+  Percent := Round((Current/Max) * 100);
+end;
+
+{****************************************************************************}
+{ TSpinnerGauge Object                                                       }
+{****************************************************************************}
+
+{****************************************************************************}
+{ TSpinnerGauge.Init                                                         }
+{****************************************************************************}
+constructor TSpinnerGauge.Init (X, Y : SmallInt; ACommand : Word);
+var R : TRect;
+begin
+  R.Assign(X,Y,X+1,Y+1);
+  if not TGauge.Init(R,ACommand,1,4) then
+    Fail;
+end;
+
+{****************************************************************************}
+{ TSpinnerGauge.Draw                                                         }
+{****************************************************************************}
+procedure TSpinnerGauge.Draw;
+var
+  B : TDrawBuffer;
+  C : Word;
+begin
+  C := GetColor(1);
+  MoveChar(B,' ',C,Size.X);
+  WriteLine(0,0,Size.X,Size.Y,B);
+  MoveChar(B[Size.X div 2],SpinChars[Current],C,1);
+  WriteLine(0,0,Size.X,Size.Y,B);
+end;
+
+{****************************************************************************}
+{ TSpinnerGauge.HandleEvent                                                  }
+{****************************************************************************}
+procedure TSpinnerGauge.HandleEvent (var Event : TEvent);
+begin
+  TStatus.HandleEvent(Event);
+end;
+
+{****************************************************************************}
+{ TSpinnerGauge.Update                                                       }
+{****************************************************************************}
+procedure TSpinnerGauge.Update (Data : Pointer);
+begin
+  if Current = Max then
+    Current := Min
+  else Inc(Current);
+  DrawView;
+end;
+
+{****************************************************************************}
+{ TStatus Object                                                             }
+{****************************************************************************}
+{****************************************************************************}
+{ TStatus.Init                                                               }
+{****************************************************************************}
+constructor TStatus.Init (R : TRect; ACommand : Word; AText : String;
+                          AParamCount : SmallInt);
+begin
+  if (not TParamText.Init(R,AText,AParamCount)) then
+    Fail;
+  EventMask := EventMask or evStatus;
+  Command := ACommand;
+end;
+
+{****************************************************************************}
+{ TStatus.Load                                                               }
+{****************************************************************************}
+constructor TStatus.Load (var S : TStream);
+begin
+  if not TParamText.Load(S) then
+    Fail;
+  S.Read(Command,SizeOf(Command));
+  if (S.Status <> stOk) then
+  begin
+    TParamText.Done;
+    Fail;
+  end;
+end;
+
+{****************************************************************************}
+{ TStatus.Cancel                                                             }
+{****************************************************************************}
+function TStatus.Cancel : Boolean;
+begin
+  Cancel := True;
+end;
+
+{****************************************************************************}
+{ TStatus.GetPalette                                                         }
+{****************************************************************************}
+function TStatus.GetPalette : PPalette;
+const
+  P : String[Length(CStatus)] = CStatus;
+begin
+  GetPalette := PPalette(@P);
+end;
+
+{****************************************************************************}
+{ TStatus.HandleEvent                                                        }
+{****************************************************************************}
+procedure TStatus.HandleEvent (var Event : TEvent);
+begin
+  if (Event.What = evCommand) and (Event.Command = cmStatusPause) then
+  begin
+    Pause;
+    ClearEvent(Event);
+  end;
+  case Event.What of
+    evStatus :
+      case Event.Command of
+        cmStatusDone :
+          if (Event.InfoPtr = @Self) then
+          begin
+            Message(Owner,evStatus,cmStatusDone,@Self);
+            ClearEvent(Event);
+          end;
+        cmStatusUpdate :
+          if (Event.InfoWord = Command) and ((State and sfPause) = 0) then
+          begin
+            Update(Event.InfoPtr);
+            { ClearEvent(Event); } { don't clear the event so multiple }
+                            { status views can respond to the same event }
+          end;
+        cmStatusResume :
+          if (Event.InfoWord = Command) and
+             ((State and sfPause) = sfPause) then
+          begin
+            Resume;
+            ClearEvent(Event);
+          end;
+        cmStatusPause :
+          if (Event.InfoWord = Command) and ((State and sfPause) = 0) then
+          begin
+            Pause;
+            ClearEvent(Event);
+          end;
+      end;
+  end;
+  TParamText.HandleEvent(Event);
+end;
+
+{****************************************************************************}
+{ TStatus.Pause                                                              }
+{****************************************************************************}
+procedure TStatus.Pause;
+begin
+  SetState(sfPause,True);
+end;
+
+{****************************************************************************}
+{ TStatus.Reset                                                              }
+{****************************************************************************}
+procedure TStatus.Reset;
+begin
+  DrawView;
+end;
+
+{****************************************************************************}
+{ TStatus.Resume                                                             }
+{****************************************************************************}
+procedure TStatus.Resume;
+begin
+  SetState(sfPause,False);
+end;
+
+{****************************************************************************}
+{ TStatus.Store                                                              }
+{****************************************************************************}
+procedure TStatus.Store (var S : TStream);
+begin
+  TParamText.Store(S);
+  S.Write(Command,SizeOf(Command));
+end;
+
+{****************************************************************************}
+{ TStatus.Update                                                             }
+{****************************************************************************}
+procedure TStatus.Update (Data : Pointer);
+begin
+  DisposeStr(Text);
+  Text := NewStr(String(Data^));
+  DrawView;
+end;
+
+{****************************************************************************}
+{ TStatusDlg Object                                                          }
+{****************************************************************************}
+{****************************************************************************}
+{ TStatusDlg.Init                                                            }
+{****************************************************************************}
+constructor TStatusDlg.Init (ATitle : TTitleStr; AStatus : PStatus;
+                             AFlags : Word);
+var
+  R : TRect;
+  i : LongInt;
+  Buttons : Byte;
+begin
+  if (AStatus = nil) then
+    Fail;
+  R.A := AStatus^.Origin;
+  R.B := AStatus^.Size;
+  Inc(R.B.Y,R.A.Y+4);
+  Inc(R.B.X,R.A.X+5);
+  if not TDialog.Init(R,ATitle) then
+    Fail;
+  EventMask := EventMask or evStatus;
+  Status := AStatus;
+  Status^.MoveTo(2,2);
+  Insert(Status);
+  InsertButtons(AFlags);
+end;
+
+{****************************************************************************}
+{ TStatusDlg.Load                                                            }
+{****************************************************************************}
+constructor TStatusDlg.Load (var S : TStream);
+begin
+  if not TDialog.Load(S) then
+    Fail;
+  GetSubViewPtr(S,Status);
+  if (S.Status <> stOk) then
+  begin
+    if (Status <> nil) then
+      Dispose(Status,Done);
+    TDialog.Done;
+    Fail;
+  end;
+end;
+
+{****************************************************************************}
+{ TStatusDlg.Cancel                                                          }
+{****************************************************************************}
+procedure TStatusDlg.Cancel (ACommand : Word);
+begin
+  if Status^.Cancel then
+    TDialog.Cancel(ACommand);
+end;
+
+{****************************************************************************}
+{ TStatusDlg.HandleEvent                                                     }
+{****************************************************************************}
+procedure TStatusDlg.HandleEvent (var Event : TEvent);
+begin
+  case Event.What of
+    evStatus :
+      case Event.Command of
+        cmStatusDone :
+          if Event.InfoPtr = Status then
+          begin
+            TDialog.Cancel(cmOk);
+            ClearEvent(Event);
+          end;
+      end;
+      { else let TDialog.HandleEvent send to all subviews for handling }
+    evBroadcast, evCommand :
+      case Event.Command of
+        cmCancel, cmClose :
+          begin
+            Cancel(cmCancel);
+            ClearEvent(Event);
+          end;
+        cmStatusPause :
+          begin
+            Status^.Pause;
+            ClearEvent(Event);
+          end;
+        cmStatusResume :
+          begin
+            Status^.Resume;
+            ClearEvent(Event);
+          end;
+      end;
+  end;
+  TDialog.HandleEvent(Event);
+end;
+
+{****************************************************************************}
+{ TStatusDlg.InsertButtons                                                   }
+{****************************************************************************}
+procedure TStatusDlg.InsertButtons (AFlags : Word);
+var
+  R : TRect;
+  P : PButton;
+  Buttons : Byte;
+  X, Y, Gap : SmallInt;
+  i : Word;
+begin
+  Buttons := Byte(((AFlags and sdCancelButton) = sdCancelButton));
+  { do this Inc twice, once for Pause and once for Resume buttons }
+  Inc(Buttons,2 * Byte(((AFlags and sdPauseButton) = sdPauseButton)));
+  if Buttons > 0 then
+  begin
+    Status^.GrowMode := gfGrowHiX;
+    { resize dialog to hold all requested buttons }
+    if Size.X < ((Buttons * 13) + 3+1) then
+      GrowTo((Buttons * 13) + 2+1,Size.Y + 2)
+    else GrowTo(Size.X,Size.Y + 2);
+    { find correct starting position for first button }
+    Gap := Size.X - (Buttons * 10) - 2;
+    Gap := Gap div Succ(Buttons);
+    X := Gap;
+    if X < 2 then
+      X := 2;
+    Y := Size.Y - 3;
+    { insert buttons }
+    if ((AFlags and sdCancelButton) = sdCancelButton) then
+    begin
+      P := NewButton(X,Y,10,2,'Cancel',cmCancel,hcCancel,bfDefault);
+      P^.GrowMode := gfGrowHiY or gfGrowLoY;
+      Inc(X,12 + Gap);
+    end;
+    if ((AFlags and sdPauseButton) = sdPauseButton) then
+    begin
+      P := NewButton(X,Y,10,2,'~P~ause',cmStatusPause,hcStatusPause,bfNormal);
+      P^.GrowMode := gfGrowHiY or gfGrowLoY;
+      Inc(X,12 + Gap);
+      P := NewButton(X,Y,10,2,'~R~esume',cmStatusResume,hcStatusResume,
+                     bfBroadcast);
+      P^.GrowMode := gfGrowHiY or gfGrowLoY;
+    end;
+  end;  { of if }
+  SelectNext(False);
+end;
+
+{****************************************************************************}
+{ TStatusDlg.Store                                                           }
+{****************************************************************************}
+procedure TStatusDlg.Store (var S : TStream);
+begin
+  TDialog.Store(S);
+  PutSubViewPtr(S,Status);
+end;
+
+{****************************************************************************}
+{ TStatusMessageDlg Object                                                   }
+{****************************************************************************}
+{****************************************************************************}
+{ TStatusMessageDlg.Init                                                     }
+{****************************************************************************}
+constructor TStatusMessageDlg.Init (ATitle : TTitleStr; AStatus : PStatus;
+                                    AFlags : Word; AMessage : String);
+var
+  P : PStaticText;
+  X, Y : SmallInt;
+  R : TRect;
+begin
+  if not TStatusDlg.Init(ATitle,AStatus,AFlags) then
+    Fail;
+  Status^.GrowMode := gfGrowLoY or gfGrowHiY;
+  GetExtent(R);
+  X := R.B.X - R.A.X;
+  if X < Size.X then
+    X := Size.X;
+  Y := R.B.Y - R.A.Y;
+  if Y < Size.Y then
+    Y := Size.Y;
+  GrowTo(X,Y);
+  R.Assign(2,2,Size.X-2,Size.Y-3);
+  P := New(PStaticText,Init(R,AMessage));
+  if (P = nil) then
+  begin
+    TStatusDlg.Done;
+    Fail;
+  end;
+  GrowTo(Size.X,Size.Y + P^.Size.Y + 1);
+  Insert(P);
+end;
+
+{****************************************************************************}
+{                    Global procedures and functions                         }
+{****************************************************************************}
+
+{****************************************************************************}
+{ RegisterStatuses                                                           }
+{****************************************************************************}
+procedure RegisterStatuses;
+begin
+{  RegisterType(RStatus);
+  RegisterType(RStatusDlg);
+  RegisterType(RGauge);
+  RegisterType(RArrowGauge);
+  RegisterType(RPercentGauge);
+  RegisterType(RBarGauge);
+  RegisterType(RSpinnerGauge); }
+end;
+
+{****************************************************************************}
+{                            Unit Initialization                             }
+{****************************************************************************}
+begin
+end.

+ 1 - 1421
packages/fv/src/statuses.pas

@@ -1,1421 +1 @@
-{$V-}
-{$IFNDEF FPC_DOTTEDUNITS}
-unit Statuses;
-{$ENDIF FPC_DOTTEDUNITS}
-
-{$CODEPAGE cp437}
-
-{#Z+}
-{  Free Vision Status Objects Unit
-   Free VIsion
-   Written by : Brad Williams, DVM
-
-Revision History
-
-1.2.3   (96/04/13)
-  - moved Pause and Resume to methods of TStatus leaving TStatus Pause and
-    Resume "aware"
-  - eliminated many bugs
-  - moved Pause, Resume and Cancel from TStatusDlg to TStatus
-
-1.2.1    (95/12/6)
-   - minor typo corrections in opening unit documentation
-   - F+ to Z+ around stream registration records
-   - removed redundant sentence in TAppStatus definition
-   - updated CBarStatus documentation and constant
-   - removed TGauge.Init cross-reference from TSpinner.Init
-   - added THeapMemAvail and RegistertvStatus documentation
-   - numerous other documentation updates
-   - changed all calls to Send to Message
-
-1.2.0    (95/11/24)
-   - conversion to Bsd format
-
-1.1.0    (05/01/94)
-   - initial WVS release
-
-
-Known Bugs
-
-ScanHelp Errors
-   - sdXXXX constants help documentation doesn't show TStatusDlg and
-     TMessageStatusDlg
-   - ScanHelp produces garbage in evStatus help context
-
-tvStatus Bugs
-   - CAppStatus may not be correct }
-{#Z-}
-
-{ The tvStatus unit implements several views for providing information to
-the user which needs to be updated during program execution, such as a
-progress indicator, clock, heap viewer, gauges, etc.  All tvStatus views
-respond to a new message event class, evStatus.  An individual status view
-only processes an event with its associated command. }
-
-interface
-
-{$i platform.inc}
-
-{$ifdef PPC_FPC}
-  {$H-}
-{$else}
-  {$F+,O+,E+,N+}
-{$endif}
-{$X+,R-,I-,Q-,V-}
-{$ifndef OS_UNIX}
-  {$S-}
-{$endif}
-
-{$IFDEF FPC_DOTTEDUNITS}
-uses
-  FreeVision.Fvcommon, FreeVision.Fvconsts, System.Objects, FreeVision.Drivers, 
-  FreeVision.Views, FreeVision.Dialogs;
-{$ELSE FPC_DOTTEDUNITS}
-uses
-  FVCommon, FVConsts, Objects, Drivers, Views, Dialogs;
-{$ENDIF FPC_DOTTEDUNITS}
-{  Resource;}
-
-const
-
-  evStatus = $8000;
-    { evStatus represents the event class all status views know how to
-      respond to. }
-    {#X Statuses }
-
-
-  CStatus    =  #1#2#3;
-{$ifndef cdPrintDoc}
-{#F+}
-{*TStatus.CStatus palette
-*************************}
-{#F-}
-{$endif cdPrintDoc}
-{ Status views use the default palette, CStatus, to map onto the first three
-entries in the standard window palette. }
-{#F+}
-{             1    2    3
-           +====+====+====+
- CStatus   |  1 |  2 |  3 |
-           +==+=+==+=+==+=+
-Normal Text---+    |    |
-Other--------------+    |
-Highlighted Text--------+ }
-{#F-}
-{#X TStatus }
-
-  CAppStatus =  #2#5#4;
-{$ifndef cdPrintDoc}
-{#F+}
-{*TAppStatus.CAppStatus palette
-*******************************}
-{#F-}
-{$endif cdPrintDoc}
-{ Status views which are inserted into the application rather than a dialog
-or window use the default palette, CAppStatus, to map onto the application
-object's palette. }
-{#F+}
-{                1    2    3
-              +====+====+====+
- CAppStatus   |  2 |  5 |  4 |
-              +==+=+==+=+==+=+
-Normal Text------+    |    |
-Other-----------------+    |
-Highlighted Text-----------+ }
-{#F-}
-    {#X tvStatus TAppStatus }
-
-
-  CBarGauge = CStatus + #16#19;
-{$ifndef cdPrintDoc}
-{#F+}
-{*TBarGauge.CBarGauge palette
-*****************************}
-{#F-}
-{$endif cdPrintDoc}
-{ TBarGauge's use the default palette, CBarGauge, to map onto the dialog or
-window owner's palette. }
-{#F+}
-{                1    2    3   4    5
-              +====+====+====+====+====+
- CAppStatus   |  2 |  5 |  4 | 16 | 19 |
-              +==+=+==+=+==+=+==+=+==+=+
-Normal Text------+    |    |    |    +---- filled in bar
-Other-----------------+    |    +--------- empty bar
-Highlighted Text-----------+ }
-{#F-}
-    {#X tvStatus TBarGauge }
-
-
-{#T sdXXXX }
-{$ifndef cdPrintDoc}
-{#F+}
-{***********************************
-* sdXXXX constants   (STDDLG unit) *
-************************************}
-{#F-}
-{$endif cdNoPrintDoc}
-{ sdXXXX constants are used to determine the types of buttons displayed in a
-#TStatusDlg# or #TStatusMessageDlg#. }
-{#F+}
-{   Constant      | Value | Meaning
-==================+=======+=================================
-  sdNone          | $0000 | no buttons
-  sdCancelButton  | $0001 | show Cancel button
-  sdPauseButton   | $0002 | show Pause button
-  sdResumeButton  | $0004 | show Resume button
-  sdAllButtons    | $0008 | show Cancel, Pause and Resume
-                  |       |   buttons }
-{#Z+}
-  sdNone                 = $0000;
-  sdCancelButton         = $0001;
-  sdPauseButton          = $0002;
-  sdResumeButton         = $0004;
-  sdAllButtons           = sdCancelButton or sdPauseButton or sdResumeButton;
-{#Z-}
-  {#X tvStatus TStatusDlg TStatusMessageDlg }
-
-{$ifdef FV_UNICODE}
-  SpinChars : UnicodeString = #$2502'/'#$2500'\';
-{$else FV_UNICODE}
-  SpinChars : String[4] = #179'/'#196'\';
-{$endif FV_UNICODE}
-    { SpinChars are the characters used by a #TSpinnerGauge# when it is drawn.
-      Only one character is displayed at a time.  The string is cycled
-      through then started over again until the view is disposed. }
-    {#X tvStatus }
-
-  sfPause = $F000;
-    { sfPause is an additional state flag used internally by status views to
-      indicate they are in a paused state and should not respond to their
-      command. }
-
-type
-  {#Z+}
-  PStatus = ^TStatus;
-  {#Z-}
-  TStatus = Object(TParamText)
-    { TStatus is the base object type from which all status views descend.
-      Status views are used to display information that will change at
-      run-time based upon some state or process in the application, such as
-      printing.
-
-      All status views that are to be inserted into the application should
-      descend from #TAppStatus# for proper color mapping. }
-    Command : Word;
-      { Command is the only command the status view will respond to.  When
-        the status view receives an evStatus event it checks the value of the
-        Event.Command field against Command before handling the event. }
-      {#X HandleEvent }
-    constructor Init (R : TRect; ACommand : Word; AText : String;
-                      AParamCount : SmallInt);
-      { Init calls the inherited constructor then sets #Command# to ACommand.
-
-        If an error occurs Init fails. }
-      {#X Load }
-    constructor Load (var S : TStream);
-      { Load calls the inherited constructor then reads #Command# from the
-        stream.
-
-        If an error occurs Load fails. }
-      {#X Store Init }
-    function Cancel : Boolean; virtual;
-      { Cancel should prompt the user when necessary for validation of
-        canceling the process which the status view is displaying.  If the
-        user elects to continue the process Cancel must return False,
-        otherwise Cancel must return True. }
-      {#X Pause Resume }
-    function GetPalette : PPalette; virtual;
-      { GetPalette returns a pointer to the default status view palette,
-        #CStatus#. }
-      {#X TAppStatus CAppStatus }
-    procedure HandleEvent (var Event : TEvent); virtual;
-      { HandleEvent captures any #evStatus# messages with its command value
-        equal to #Command#, then calls #Update# with Data set to
-        Event.InfoPtr.  If the State field has its #sfPause# bit set, the
-        view ignores the event. }
-    procedure Pause; virtual;
-      { Pause sends an evStatus message to the application with Event.Command
-        set to cmStatusPause and Event.InfoPtr set to #Status#^.Command.  The
-        #Status# view's sfPause bit of the State flag is set by calling
-        SetState.  In the paused state, the status view does not respond to
-        its associated command. }
-      {#X Resume sdXXXX Cancel }
-    procedure Reset; virtual;
-      { Reset causes the status view to be reset to its beginning or default
-        value, then be redrawn.  Reset is used after an event is aborted
-        which can only be performed in its entirety. }
-    procedure Resume; virtual;
-      { Resume is called in response to pressing the Resume button.  Resume
-        sends an evStatus message to the application with Event.Command set
-        to cmStatusPause and Event.InfoPtr set to #Status#^.Command.  The
-        Status view's sfPause bit is turned off by calling SetState. }
-      {#X Pause sdXXXX Cancel }
-    procedure Store (var S : TStream); { store should never be virtual;}
-      { Store calls the inherited Store method then writes #Command# to the
-        stream. }
-      {#X Load }
-    procedure Update (Data : Pointer); virtual;
-      { Update changes the status' displayed text as necessary based on
-        Data. }
-      {#X Command HandleEvent }
-  end;  { of TStatus }
-
-
-  {#Z+}
-  PStatusDlg = ^TStatusDlg;
-  {#Z-}
-  TStatusDlg = Object(TDialog)
-    { A TStatusDlg displays a status view and optional buttons.  It may be
-      used to display any status message and optionally provide end user
-      cancelation or pausing of an ongoing operation, such as printing.
-
-      All status views that are to be inserted into a window or dialog should
-      descend from #TStatus# for proper color mapping. }
-    Status : PStatus;
-      { Status is the key status view for the dialog.  When a cmStatusPause
-        command is broadcast in response to pressing the pause button,
-        Event.InfoPtr is set to point to the command associated with Status. }
-      {#X TStatus cmXXXX }
-    constructor Init (ATitle : TTitleStr; AStatus : PStatus; AFlags : Word);
-      { Init calls the inherited constructor to create the dialog and sets
-        the EventMask to handle #evStatus# events.  AStatus is assigned to
-        #Status# and inserted into the dialog at position 2,2.
-
-        The dialog is anchored at AStatus^.Origin and its size is at least
-        AStatus^.Size + 2 in both dimensions.  The actual size is determined
-        by the AFlags byte.  The #sdXXXX# constants should be used to signify
-        which buttons to display.
-
-        If an error occurs Init fails. }
-      {#X TStatus.Pause TStatus.Resume }
-    constructor Load (var S : TStream);
-      { Load calls the inherited constructor then loads #Status#.
-
-        If an error occurs Load fails. }
-      {#X Store }
-    procedure Cancel (ACommand : Word); virtual;
-      { Cancel sends an evStatus message to the Application object with
-        command set to cmCancel and InfoPtr set to the calling status view's
-        command, then calls the inherited Cancel method. }
-      {#X TBSDDialog.Cancel }
-    procedure HandleEvent (var Event : TEvent); virtual;
-      { All evStatus events are accepted by the dialog and sent to each
-        subview in Z-order until cleared.
-
-        If the dialog recieves an evCommand or evBroadcast event with the
-        Command parameter set to cmCancel, HandleEvent sends an #evStatus#
-        message to the Application variable with Event.Command set to the
-        cmStatusCancel and Event.InfoPtr set to the #Status#.Command and
-        disposes of itself.
-
-        When a pause button is included, a cmStatusPause broadcast event is
-        associated with the button.  When the button is pressed a call to
-        #TStatus.Pause# results.  The status view is inactivated until it
-        receives an evStatus event with a commond of cmStatusResume and
-        Event.InfoPtr set to the status view's Command value.  When a pause
-        button is used, the application should respond to the evStatus event
-        (with Event.Command of cmStatusPause) appropriately, then dispatch a
-        cmStatusResume evStatus event when ready to resume activity. }
-      {#X TStatus.Command }
-    procedure InsertButtons (AFlags : Word); virtual;
-      { InsertButtons enlarges the dialog to the necessary size and inserts
-        the buttons specified in AFlags into the last row of the dialog. }
-    procedure Store (var S : TStream); { store should never be virtual;}
-      { Store calls the inherited Store method then writes #Status# to the
-        stream. }
-      {#X Load }
-  end;  { of TStatusDlg }
-
-
-  {#Z+}
-  PStatusMessageDlg = ^TStatusMessageDlg;
-  {#Z-}
-  TStatusMessageDlg = Object(TStatusDlg)
-    { A TStatusMessageDlg displays a message as static text with a status
-      view on the line below it.
-
-      All status views that are to be inserted into a window or dialog should
-      descend from #TStatus# for proper color mapping. }
-    constructor Init (ATitle : TTitleStr; AStatus : PStatus; AFlags : Word;
-                      AMessage : String);
-      { Init calls the inherited constructor then inserts a TStaticText view
-        containing AMessage at the top line of the dialog.
-
-        The size of the dialog is determined by the size of the AStatus.  The
-        dialog is anchored at AStatus^.Origin and is of at least
-        AStatus^.Size + 2 in heighth and width.  The exact width and heighth
-        are determined by AOptions.
-
-        AFlags contains flags which determine the buttons to be displayed
-        in the dialog.
-
-        If an error occurs Init fails. }
-  end;  { of TStatusMessageDlg }
-
-
-  {#Z+}
-  PGauge = ^TGauge;
-  {#Z-}
-  TGauge = Object(TStatus)
-    { A gauge is used to represent the current numerical position within a
-      range of values.  When Current equals Max a gauge dispatches an
-      #evStatus# event with the command set to cmStatusDone to the
-      Application object. }
-    Min : LongInt;
-      { Min is the minimum value which #Current# may be set to. }
-      {#X Max }
-    Max : LongInt;
-      { Max is the maximum value which #Current# may be set to. }
-      {#X Min }
-    Current : LongInt;
-      { Current is the current value represented in the gauge. }
-      {#X Max Min }
-    constructor Init (R : TRect; ACommand : Word; AMin, AMax : LongInt);
-      { Init calls the inherited constructor then sets #Min# and #Max# to
-        AMin and AMax, respectively.  #Current# is set to AMin.
-
-        If an error occurs Init fails. }
-      {#X Load }
-    constructor Load (var S : TStream);
-      { Load calls the inherited constructor then reads #Min#, #Max# and
-        #Current# from the stream.
-
-        If an error occurs Load fails. }
-      {#X Init Store }
-    procedure Draw; virtual;
-      { Draw writes the following to the screen: }
-{#F+}
-{
-Min = XXX  Max = XXX  Current = XXX }
-{#F-}
-      { where XXX are the current values of the corresponding variables. }
-    procedure GetData (var Rec); virtual;
-      { GetData assumes Rec is a #TGaugeRec# and returns the current settings
-        of the gauge. }
-      {#X SetData }
-    procedure Reset; virtual;
-      { Reset sets #Current# to #Min# then redraws the status view. }
-      {#X TStatus.Reset }
-    procedure SetData (var Rec); virtual;
-      { SetData assumes Rec is a #TGaugeRec# and sets the gauge's variables
-        accordingly. }
-      {#X GetData }
-    procedure Store (var S : TStream); { store should never be virtual;}
-      { Store calls the inherited Store method then writes #Min#, #Max# and
-        #Current# to the stream. }
-      {#X Load }
-    procedure Update (Data : Pointer); virtual;
-      { Update increments #Current#. }
-  end;  { of TGauge }
-
-
-  {#Z+}
-  PGaugeRec = ^TGaugeRec;
-  {#Z-}
-  TGaugeRec = record
-    { A TGaugeRec is used to set and get a #TGauge#'s variables. }
-    {#X TGauge.GetData TGauge.SetData }
-    Min, Max, Current : LongInt;
-  end;  { of TGaugeRec }
-
-
-  {#Z+}
-  PArrowGauge = ^TArrowGauge;
-  {#Z-}
-  TArrowGauge = Object(TGauge)
-    { An arrow gauge draws a progressively larger series of arrows across the
-      view.  If Right is True, the arrows are right facing, '>', and are
-      drawn from left to right.  If Right is False, the arrows are left
-      facing, '<', and are drawn from right to left. }
-    Right : Boolean;
-      { Right determines the direction of arrow used and the direction which
-        the status view is filled.  If Right is True, the arrows are right
-        facing, '>', and are drawn from left to right.  If Right is False,
-        the arrows are left facing, '<', and are drawn from right to left. }
-      {#X Draw }
-    constructor Init (R : TRect; ACommand : Word; AMin, AMax : Word;
-                      RightArrow : Boolean);
-      { Init calls the inherited constructor then sets #Right# to RightArrow.
-
-        If an error occurs Init fails. }
-      {#X Load }
-    constructor Load (var S : TStream);
-      { Load calls the inherited constructor then reads #Right# from the
-        stream.
-
-        If an error occurs Load fails. }
-      {#X Init Store }
-    procedure Draw; virtual;
-      { Draw fills the Current / Max percent of the view with arrows. }
-      {#X Right }
-    procedure GetData (var Rec); virtual;
-      { GetData assumes Rec is a #TArrowGaugeRec# and returns the current
-        settings of the views variables. }
-      {#X SetData }
-    procedure SetData (var Rec); virtual;
-      { SetData assumes Rec is a #TArrowGaugeRec# and sets the view's
-        variables accordingly. }
-      {#X GetData }
-    procedure Store (var S : TStream); { store should never be virtual;}
-      { Store calls the inherited Store method then writes #Right# to the
-        stream. }
-      {#X Load }
-  end;  { of TArrowGauge }
-
-
-  {#Z+}
-  PArrowGaugeRec = ^TArrowGaugeRec;
-  {#Z-}
-  TArrowGaugeRec = record
-    { A TArrowGaugeRec is used to set and get the variables of a
-      #TArrowGauge#. }
-    {#X TArrowGauge.GetData TArrowGauge.SetData }
-    Min, Max, Count : LongInt;
-    Right : Boolean;
-  end;  { of TGaugeRec }
-
-
-  {#Z+}
-  PPercentGauge = ^TPercentGauge;
-  {#Z-}
-  TPercentGauge = Object(TGauge)
-    { A TPercentGauge displays a numerical percentage as returned by
-      #Percent# followed by a '%' sign. }
-    function Percent : SmallInt; virtual;
-      { Percent returns the whole number value of (Current / Max) * 100. }
-      {#X TGauge.Current TGauge.Max }
-    procedure Draw; virtual;
-      { Draw writes the current percentage to the screen. }
-      {#X Percent }
-  end;  { of TPercentGauge }
-
-
-  {#Z+}
-  PBarGauge = ^TBarGauge;
-  {#Z-}
-  TBarGauge = Object(TPercentGauge)
-    { A TBarGauge displays a bar which increases in size from the left to
-      the right of the view as Current increases.  A numeric percentage
-      representing the value of (Current / Max) * 100 is displayed in the
-      center of the bar. }
-    {#x TPercentGauge.Percent }
-    procedure Draw; virtual;
-      { Draw draws the bar and percentage to the screen representing the
-        current status of the view's variables. }
-      {#X TGauge.Update }
-    function GetPalette : PPalette; virtual;
-      { GetPalette returns a pointer to the default status view palette,
-        #CBarStatus#. }
-  end;  { of TBarGauge }
-
-
-  {#Z+}
-  PSpinnerGauge = ^TSpinnerGauge;
-  {#Z-}
-  TSpinnerGauge = Object(TGauge)
-    { A TSpinnerGauge displays a series of characters in one spot on the
-      screen giving the illusion of a spinning line. }
-    constructor Init (X, Y : SmallInt; ACommand : Word);
-      { Init calls the inherited constructor with AMin set to 0 and AMax set
-        to 4. }
-    procedure Draw; virtual;
-      { Draw uses the #SpinChars# variable to draw the view's Current
-        character. }
-      {#X Update }
-    procedure HandleEvent (var Event : TEvent); virtual;
-      { HandleEvent calls TStatus.HandleEvent so that a cmStatusDone event
-        is not generated when Current equals Max. }
-      {#X TGauge.Current TGauge.Max }
-    procedure Update (Data : Pointer); virtual;
-      { Update increments Current until Current equals Max, when it resets
-        Current to Min. }
-      {#X Draw HandleEvent }
-  end;  { of TSpinnerGauge }
-
-
-  {#Z+}
-  PAppStatus = ^TAppStatus;
-  {#Z-}
-  TAppStatus = Object(TStatus)
-    { TAppStatus is a base object which implements color control for status
-      views that are normally inserted in the Application object. }
-    {#X TStatus }
-    function GetPalette : PPalette; virtual;
-      { GetPalette returns a pointer to the default application status view
-        palette, #CAppStatus#. }
-      {#X TStatus CStatus }
-  end;  { of TAppStatus }
-
-
-  {#Z+}
-  PHeapMaxAvail = ^THeapMaxAvail;
-  {#Z-}
-  THeapMaxAvail = Object(TAppStatus)
-    { A THeapMaxAvail displays the largest available contiguous area of heap
-      memory.  It responds to a cmStatusUpdate event by calling MaxAvail and
-      comparing the result to #Max#, then updating the view if necessary. }
-    {#X THeapMemAvail }
-    constructor Init (X, Y : SmallInt);
-      { Init creates the view with the following text:
-
-        MaxAvail = xxxx
-
-        where xxxx is the result returned by MaxAvail. }
-    procedure Update (Data : Pointer); virtual;
-      { Update changes #Mem# to the current MemAvail and redraws the status
-        if necessary. }
-      private
-    Max : LongInt;
-      { Max is the last reported value from MaxAvail. }
-      {#X Update }
-  end;  { of THeapMaxAvail }
-
-
-  {#Z+}
-  PHeapMemAvail = ^THeapMemAvail;
-  {#Z-}
-  THeapMemAvail = Object(TAppStatus)
-    { A THeapMemAvail displays the total amount of heap memory available to
-      the application.  It responds to a cmStatusUpdate event by calling
-      MemAvail and comparing the result to #Max#, then updating the view if
-      necessary. }
-    {#X THeapMaxAvail }
-    constructor Init (X, Y : SmallInt);
-      { Init creates the view with the following text:
-
-        MemAvail = xxxx
-
-        where xxxx is the result returned by MemAvail. }
-      {#X Load }
-    procedure Update (Data : Pointer); virtual;
-      { Update changes #Mem# to the current MemAvail and redraws the status
-        if necessary. }
-      private
-    Mem : LongInt;
-      { Mem is the last available value reported by MemAvail. }
-      {#X Update }
-  end;  { of THeapMemAvail }
-
-
-{$ifndef cdPrintDoc}
-{#Z+}
-{$endif cdPrintDoc}
-const
-  RStatus    : TStreamRec = (
-     ObjType : idStatus;
-     VmtLink : Ofs(TypeOf(TStatus)^);
-     Load    : @TStatus.Load;
-     Store   : @TStatus.Store);
-
-  RStatusDlg : TStreamRec = (
-     ObjType : idStatusDlg;
-     VmtLink : Ofs(TypeOf(TStatusDlg)^);
-     Load    : @TStatusDlg.Load;
-     Store   : @TStatusDlg.Store);
-
-  RStatusMessageDlg : TStreamRec = (
-     ObjType : idStatusMessageDlg;
-     VmtLink : Ofs(TypeOf(TStatusMessageDlg)^);
-     Load    : @TStatusMessageDlg.Load;
-     Store   : @TStatusMessageDlg.Store);
-
-  RGauge  : TStreamRec = (
-     ObjType : idGauge;
-     VmtLink : Ofs(TypeOf(TGauge)^);
-     Load    : @TGauge.Load;
-     Store   : @TGauge.Store);
-
-  RArrowGauge  : TStreamRec = (
-     ObjType : idArrowGauge;
-     VmtLink : Ofs(TypeOf(TArrowGauge)^);
-     Load    : @TArrowGauge.Load;
-     Store   : @TArrowGauge.Store);
-
-  RBarGauge  : TStreamRec = (
-     ObjType : idBarGauge;
-     VmtLink : Ofs(TypeOf(TBarGauge)^);
-     Load    : @TBarGauge.Load;
-     Store   : @TBarGauge.Store);
-
-  RPercentGauge  : TStreamRec = (
-     ObjType : idPercentGauge;
-     VmtLink : Ofs(TypeOf(TPercentGauge)^);
-     Load    : @TPercentGauge.Load;
-     Store   : @TPercentGauge.Store);
-
-  RSpinnerGauge  : TStreamRec = (
-     ObjType : idSpinnerGauge;
-     VmtLink : Ofs(TypeOf(TSpinnerGauge)^);
-     Load    : @TSpinnerGauge.Load;
-     Store   : @TSpinnerGauge.Store);
-
-  RAppStatus  : TStreamRec = (
-     ObjType : idAppStatus;
-     VmtLink : Ofs(TypeOf(TAppStatus)^);
-     Load    : @TAppStatus.Load;
-     Store   : @TAppStatus.Store);
-
-  RHeapMinAvail  : TStreamRec = (
-     ObjType : idHeapMinAvail;
-     VmtLink : Ofs(TypeOf(THeapMaxAvail)^);
-     Load    : @THeapMaxAvail.Load;
-     Store   : @THeapMaxAvail.Store);
-
-  RHeapMemAvail  : TStreamRec = (
-     ObjType : idHeapMemAvail;
-     VmtLink : Ofs(TypeOf(THeapMemAvail)^);
-     Load    : @THeapMemAvail.Load;
-     Store   : @THeapMemAvail.Store);
-{$ifndef cdPrintDoc}
-{#Z-}
-{$endif cdPrintDoc}
-
-procedure RegisterStatuses;
-{$ifndef cdPrintDoc}
-{#F+}
-{*********************************************
-*RegisterStatuses procedure   (Statuses unit)*
-**********************************************}
-{#F-}
-{$endif cdPrintDoc}
-  { RegisterStatuses calls RegisterType for each of the status view and
-    status dialog object types defined in the tvStatus unit.  After calling
-    RegisterStatuses, your application can read or write any of those types
-    with streams. }
-
-
-implementation
-
-{$IFDEF FPC_DOTTEDUNITS}
-uses
-  FreeVision.Msgbox, FreeVision.App;
-{$ELSE FPC_DOTTEDUNITS}
-uses
-  MsgBox, App;
-{$ENDIF FPC_DOTTEDUNITS}
-
-{****************************************************************************}
-{                    Local procedures and functions                          }
-{****************************************************************************}
-
-{****************************************************************************}
-{ TAppStatus Object                                                          }
-{****************************************************************************}
-{****************************************************************************}
-{ TAppStatus.GetPalette                                                      }
-{****************************************************************************}
-function TAppStatus.GetPalette : PPalette;
-const P : String[Length(CAppStatus)] = CAppStatus;
-begin
-  GetPalette := PPalette(@P);
-end;
-
-{****************************************************************************}
-{ TArrowGauge Object                                                         }
-{****************************************************************************}
-{****************************************************************************}
-{ TArrowGauge.Init                                                           }
-{****************************************************************************}
-constructor TArrowGauge.Init (R : TRect; ACommand : Word; AMin, AMax : Word;
-                              RightArrow : Boolean);
-begin
-  if not TGauge.Init(R,ACommand,AMin,AMax) then
-    Fail;
-  Right := RightArrow;
-end;
-
-{****************************************************************************}
-{ TArrowGauge.Load                                                           }
-{****************************************************************************}
-constructor TArrowGauge.Load (var S : TStream);
-begin
-  if not TGauge.Load(S) then
-    Fail;
-  S.Read(Right,SizeOf(Right));
-  if (S.Status <> stOk) then
-  begin
-    TGauge.Done;
-    Fail;
-  end;
-end;
-
-{****************************************************************************}
-{ TArrowGauge.Draw                                                           }
-{****************************************************************************}
-procedure TArrowGauge.Draw;
-const Arrows : array[0..1] of AnsiChar = '<>';
-var
-  B : TDrawBuffer;
-  C : Word;
-  Len : Sw_Integer;
-begin
-  C := GetColor(1);
-  Len := Round(Size.X * Current/(Max - Min));
-  if Len>Size.X then Len:=Size.X;
-  MoveChar(B,' ',C,Size.X);
-  if Right then
-    MoveChar(B,Arrows[Byte(Right)],C,Len)
-  else MoveChar(B[Size.X - Len],Arrows[Byte(Right)],C,Len);
-  WriteLine(0,0,Size.X,1,B);
-end;
-
-{****************************************************************************}
-{ TArrowGauge.GetData                                                        }
-{****************************************************************************}
-procedure TArrowGauge.GetData (var Rec);
-begin
-  PArrowGaugeRec(Rec)^.Min := Min;
-  PArrowGaugeRec(Rec)^.Max := Max;
-  PArrowGaugeRec(Rec)^.Count := Current;
-  PArrowGaugeRec(Rec)^.Right := Right;
-end;
-
-{****************************************************************************}
-{ TArrowGauge.SetData                                                        }
-{****************************************************************************}
-procedure TArrowGauge.SetData (var Rec);
-begin
-  Min := PArrowGaugeRec(Rec)^.Min;
-  Max := PArrowGaugeRec(Rec)^.Max;
-  Current := PArrowGaugeRec(Rec)^.Count;
-  Right := PArrowGaugeRec(Rec)^.Right;
-end;
-
-{****************************************************************************}
-{ TArrowGauge.Store                                                          }
-{****************************************************************************}
-procedure TArrowGauge.Store (var S : TStream);
-begin
-  TGauge.Store(S);
-  S.Write(Right,SizeOf(Right));
-end;
-
-{****************************************************************************}
-{ TBarGauge Object                                                           }
-{****************************************************************************}
-{****************************************************************************}
-{ TBarGauge.Draw                                                             }
-{****************************************************************************}
-procedure TBarGauge.Draw;
-var
-  B : TDrawBuffer;
-  C : Word;
-  FillSize : Word;
-  PercentDone : PtrInt;
-  S : String[4];
-begin
-  { fill entire view }
-  MoveChar(B,' ',GetColor(4),Size.X);
-  { make progress bar }
-  C := GetColor(5);
-  FillSize := Round(Size.X * (Current / Max));
-  MoveChar(B,' ',C,FillSize);
-  { display percent done }
-  PercentDone := Percent;
-  FormatStr(S,'%d%%',PercentDone);
-  if PercentDone < 50 then
-    C := GetColor(4);
-  FillSize := (Size.X - Length(S)) div 2;
-  MoveStr(B[FillSize],S,C);
-  WriteLine(0,0,Size.X,Size.Y,B);
-end;
-
-{****************************************************************************}
-{ TBarGauge.GetPalette                                                       }
-{****************************************************************************}
-function TBarGauge.GetPalette : PPalette;
-const
-  S : String[Length(CBarGauge)] = CBarGauge;
-begin
-  GetPalette := PPalette(@S);
-end;
-
-{****************************************************************************}
-{ TGauge Object                                                              }
-{****************************************************************************}
-{****************************************************************************}
-{ TGauge.Init                                                                }
-{****************************************************************************}
-constructor TGauge.Init (R : TRect; ACommand : Word; AMin, AMax : LongInt);
-begin
-  if not TStatus.Init(R,ACommand,'',1) then
-    Fail;
-  Min := AMin;
-  Max := AMax;
-  Current := Min;
-end;
-
-{****************************************************************************}
-{ TGauge.Load                                                                }
-{****************************************************************************}
-constructor TGauge.Load (var S : TStream);
-begin
-  if not TStatus.Load(S) then
-    Fail;
-  S.Read(Min,SizeOf(Min));
-  S.Read(Max,SizeOf(Max));
-  S.Read(Current,SizeOf(Current));
-  if S.Status <> stOk then
-  begin
-    TStatus.Done;
-    Fail;
-  end;
-end;
-
-{****************************************************************************}
-{ TGauge.Draw                                                                }
-{****************************************************************************}
-procedure TGauge.Draw;
-var
-  S : String;
-  B : TDrawBuffer;
-begin
-  { Blank the gauge }
-  MoveChar(B,' ',GetColor(1),Size.X);
-  WriteBuf(0,0,Size.X,Size.Y,B);
-  { write current status }
-  FormatStr(S,'%d',Current);
-  MoveStr(B,S,GetColor(1));
-  WriteBuf(0,0,Size.X,Size.Y,B);
-end;
-
-{****************************************************************************}
-{ TGauge.GetData                                                             }
-{****************************************************************************}
-procedure TGauge.GetData (var Rec);
-begin
-  TGaugeRec(Rec).Min := Min;
-  TGaugeRec(Rec).Max := Max;
-  TGaugeRec(Rec).Current := Current;
-end;
-
-{****************************************************************************}
-{ TGauge.Reset                                                               }
-{****************************************************************************}
-procedure TGauge.Reset;
-begin
-  Current := Min;
-  DrawView;
-end;
-
-{****************************************************************************}
-{ TGauge.SetData                                                             }
-{****************************************************************************}
-procedure TGauge.SetData (var Rec);
-begin
-  Min := TGaugeRec(Rec).Min;
-  Max := TGaugeRec(Rec).Max;
-  Current := TGaugeRec(Rec).Current;
-end;
-
-{****************************************************************************}
-{ TGauge.Store                                                               }
-{****************************************************************************}
-procedure TGauge.Store (var S : TStream);
-begin
-  TStatus.Store(S);
-  S.Write(Min,SizeOf(Min));
-  S.Write(Max,SizeOf(Max));
-  S.Write(Current,SizeOf(Current));
-end;
-
-{****************************************************************************}
-{ TGauge.Update                                                              }
-{****************************************************************************}
-procedure TGauge.Update (Data : Pointer);
-begin
-  if Current < Max then
-  begin
-    Inc(Current);
-    DrawView;
-  end
-  else Message(@Self,evStatus,cmStatusDone,@Self);
-end;
-
-{****************************************************************************}
-{ THeapMaxAvail Object                                                       }
-{****************************************************************************}
-{****************************************************************************}
-{ THeapMaxAvail.Init                                                         }
-{****************************************************************************}
-constructor THeapMaxAvail.Init (X, Y : SmallInt);
-var
-  R : TRect;
-begin
-  R.Assign(X,Y,X+20,Y+1);
-  if not TAppStatus.Init(R,cmStatusUpdate,' MaxAvail = %d',1) then
-    Fail;
-  Max := -1;
-end;
-
-{****************************************************************************}
-{ THeapMaxAvail.Update                                                       }
-{****************************************************************************}
-procedure THeapMaxAvail.Update (Data : Pointer);
-var
-  M : LongInt;
-begin
-  M := MaxAvail;
-  if (Max <> M) then
-  begin
-    Max := MaxAvail;
-    SetData(Max);
-  end;
-end;
-
-{****************************************************************************}
-{ THeapMemAvail Object                                                       }
-{****************************************************************************}
-{****************************************************************************}
-{ THeapMemAvail.Init                                                         }
-{****************************************************************************}
-constructor THeapMemAvail.Init (X, Y : SmallInt);
-var
-  R : TRect;
-begin
-  R.Assign(X,Y,X+20,Y+1);
-  if not TAppStatus.Init(R,cmStatusUpdate,' MemAvail = %d',1) then
-    Fail;
-  Mem := -1;
-end;
-
-{****************************************************************************}
-{ THeapMemAvail.Update                                                       }
-{****************************************************************************}
-procedure THeapMemAvail.Update (Data : Pointer);
-  { Total bytes available on the heap.  May not be contiguous. }
-var
-  M : LongInt;
-begin
-  M := MemAvail;
-  if (Mem <> M) then
-  begin
-    Mem := M;
-    SetData(Mem);
-  end;
-end;
-
-{****************************************************************************}
-{ TPercentGauge Object                                                       }
-{****************************************************************************}
-{****************************************************************************}
-{ TPercentGauge.Draw                                                         }
-{****************************************************************************}
-procedure TPercentGauge.Draw;
-var
-  B : TDrawBuffer;
-  C : Word;
-  S : String;
-  PercentDone : LongInt;
-  FillSize : SmallInt;
-begin
-  C := GetColor(1);
-  MoveChar(B,' ',C,Size.X);
-  WriteLine(0,0,Size.X,Size.Y,B);
-  PercentDone := Percent;
-  FormatStr(S,'%d%%',PercentDone);
-  MoveStr(B[(Size.X - Length(S)) div 2],S,C);
-  WriteLine(0,0,Size.X,Size.Y,B);
-end;
-
-{****************************************************************************}
-{ TPercentGauge.Percent                                                      }
-{****************************************************************************}
-function TPercentGauge.Percent : SmallInt;
-  { Returns percent as a whole SmallInt Current of Max }
-begin
-  Percent := Round((Current/Max) * 100);
-end;
-
-{****************************************************************************}
-{ TSpinnerGauge Object                                                       }
-{****************************************************************************}
-
-{****************************************************************************}
-{ TSpinnerGauge.Init                                                         }
-{****************************************************************************}
-constructor TSpinnerGauge.Init (X, Y : SmallInt; ACommand : Word);
-var R : TRect;
-begin
-  R.Assign(X,Y,X+1,Y+1);
-  if not TGauge.Init(R,ACommand,1,4) then
-    Fail;
-end;
-
-{****************************************************************************}
-{ TSpinnerGauge.Draw                                                         }
-{****************************************************************************}
-procedure TSpinnerGauge.Draw;
-var
-  B : TDrawBuffer;
-  C : Word;
-begin
-  C := GetColor(1);
-  MoveChar(B,' ',C,Size.X);
-  WriteLine(0,0,Size.X,Size.Y,B);
-  MoveChar(B[Size.X div 2],SpinChars[Current],C,1);
-  WriteLine(0,0,Size.X,Size.Y,B);
-end;
-
-{****************************************************************************}
-{ TSpinnerGauge.HandleEvent                                                  }
-{****************************************************************************}
-procedure TSpinnerGauge.HandleEvent (var Event : TEvent);
-begin
-  TStatus.HandleEvent(Event);
-end;
-
-{****************************************************************************}
-{ TSpinnerGauge.Update                                                       }
-{****************************************************************************}
-procedure TSpinnerGauge.Update (Data : Pointer);
-begin
-  if Current = Max then
-    Current := Min
-  else Inc(Current);
-  DrawView;
-end;
-
-{****************************************************************************}
-{ TStatus Object                                                             }
-{****************************************************************************}
-{****************************************************************************}
-{ TStatus.Init                                                               }
-{****************************************************************************}
-constructor TStatus.Init (R : TRect; ACommand : Word; AText : String;
-                          AParamCount : SmallInt);
-begin
-  if (not TParamText.Init(R,AText,AParamCount)) then
-    Fail;
-  EventMask := EventMask or evStatus;
-  Command := ACommand;
-end;
-
-{****************************************************************************}
-{ TStatus.Load                                                               }
-{****************************************************************************}
-constructor TStatus.Load (var S : TStream);
-begin
-  if not TParamText.Load(S) then
-    Fail;
-  S.Read(Command,SizeOf(Command));
-  if (S.Status <> stOk) then
-  begin
-    TParamText.Done;
-    Fail;
-  end;
-end;
-
-{****************************************************************************}
-{ TStatus.Cancel                                                             }
-{****************************************************************************}
-function TStatus.Cancel : Boolean;
-begin
-  Cancel := True;
-end;
-
-{****************************************************************************}
-{ TStatus.GetPalette                                                         }
-{****************************************************************************}
-function TStatus.GetPalette : PPalette;
-const
-  P : String[Length(CStatus)] = CStatus;
-begin
-  GetPalette := PPalette(@P);
-end;
-
-{****************************************************************************}
-{ TStatus.HandleEvent                                                        }
-{****************************************************************************}
-procedure TStatus.HandleEvent (var Event : TEvent);
-begin
-  if (Event.What = evCommand) and (Event.Command = cmStatusPause) then
-  begin
-    Pause;
-    ClearEvent(Event);
-  end;
-  case Event.What of
-    evStatus :
-      case Event.Command of
-        cmStatusDone :
-          if (Event.InfoPtr = @Self) then
-          begin
-            Message(Owner,evStatus,cmStatusDone,@Self);
-            ClearEvent(Event);
-          end;
-        cmStatusUpdate :
-          if (Event.InfoWord = Command) and ((State and sfPause) = 0) then
-          begin
-            Update(Event.InfoPtr);
-            { ClearEvent(Event); } { don't clear the event so multiple }
-                            { status views can respond to the same event }
-          end;
-        cmStatusResume :
-          if (Event.InfoWord = Command) and
-             ((State and sfPause) = sfPause) then
-          begin
-            Resume;
-            ClearEvent(Event);
-          end;
-        cmStatusPause :
-          if (Event.InfoWord = Command) and ((State and sfPause) = 0) then
-          begin
-            Pause;
-            ClearEvent(Event);
-          end;
-      end;
-  end;
-  TParamText.HandleEvent(Event);
-end;
-
-{****************************************************************************}
-{ TStatus.Pause                                                              }
-{****************************************************************************}
-procedure TStatus.Pause;
-begin
-  SetState(sfPause,True);
-end;
-
-{****************************************************************************}
-{ TStatus.Reset                                                              }
-{****************************************************************************}
-procedure TStatus.Reset;
-begin
-  DrawView;
-end;
-
-{****************************************************************************}
-{ TStatus.Resume                                                             }
-{****************************************************************************}
-procedure TStatus.Resume;
-begin
-  SetState(sfPause,False);
-end;
-
-{****************************************************************************}
-{ TStatus.Store                                                              }
-{****************************************************************************}
-procedure TStatus.Store (var S : TStream);
-begin
-  TParamText.Store(S);
-  S.Write(Command,SizeOf(Command));
-end;
-
-{****************************************************************************}
-{ TStatus.Update                                                             }
-{****************************************************************************}
-procedure TStatus.Update (Data : Pointer);
-begin
-  DisposeStr(Text);
-  Text := NewStr(String(Data^));
-  DrawView;
-end;
-
-{****************************************************************************}
-{ TStatusDlg Object                                                          }
-{****************************************************************************}
-{****************************************************************************}
-{ TStatusDlg.Init                                                            }
-{****************************************************************************}
-constructor TStatusDlg.Init (ATitle : TTitleStr; AStatus : PStatus;
-                             AFlags : Word);
-var
-  R : TRect;
-  i : LongInt;
-  Buttons : Byte;
-begin
-  if (AStatus = nil) then
-    Fail;
-  R.A := AStatus^.Origin;
-  R.B := AStatus^.Size;
-  Inc(R.B.Y,R.A.Y+4);
-  Inc(R.B.X,R.A.X+5);
-  if not TDialog.Init(R,ATitle) then
-    Fail;
-  EventMask := EventMask or evStatus;
-  Status := AStatus;
-  Status^.MoveTo(2,2);
-  Insert(Status);
-  InsertButtons(AFlags);
-end;
-
-{****************************************************************************}
-{ TStatusDlg.Load                                                            }
-{****************************************************************************}
-constructor TStatusDlg.Load (var S : TStream);
-begin
-  if not TDialog.Load(S) then
-    Fail;
-  GetSubViewPtr(S,Status);
-  if (S.Status <> stOk) then
-  begin
-    if (Status <> nil) then
-      Dispose(Status,Done);
-    TDialog.Done;
-    Fail;
-  end;
-end;
-
-{****************************************************************************}
-{ TStatusDlg.Cancel                                                          }
-{****************************************************************************}
-procedure TStatusDlg.Cancel (ACommand : Word);
-begin
-  if Status^.Cancel then
-    TDialog.Cancel(ACommand);
-end;
-
-{****************************************************************************}
-{ TStatusDlg.HandleEvent                                                     }
-{****************************************************************************}
-procedure TStatusDlg.HandleEvent (var Event : TEvent);
-begin
-  case Event.What of
-    evStatus :
-      case Event.Command of
-        cmStatusDone :
-          if Event.InfoPtr = Status then
-          begin
-            TDialog.Cancel(cmOk);
-            ClearEvent(Event);
-          end;
-      end;
-      { else let TDialog.HandleEvent send to all subviews for handling }
-    evBroadcast, evCommand :
-      case Event.Command of
-        cmCancel, cmClose :
-          begin
-            Cancel(cmCancel);
-            ClearEvent(Event);
-          end;
-        cmStatusPause :
-          begin
-            Status^.Pause;
-            ClearEvent(Event);
-          end;
-        cmStatusResume :
-          begin
-            Status^.Resume;
-            ClearEvent(Event);
-          end;
-      end;
-  end;
-  TDialog.HandleEvent(Event);
-end;
-
-{****************************************************************************}
-{ TStatusDlg.InsertButtons                                                   }
-{****************************************************************************}
-procedure TStatusDlg.InsertButtons (AFlags : Word);
-var
-  R : TRect;
-  P : PButton;
-  Buttons : Byte;
-  X, Y, Gap : SmallInt;
-  i : Word;
-begin
-  Buttons := Byte(((AFlags and sdCancelButton) = sdCancelButton));
-  { do this Inc twice, once for Pause and once for Resume buttons }
-  Inc(Buttons,2 * Byte(((AFlags and sdPauseButton) = sdPauseButton)));
-  if Buttons > 0 then
-  begin
-    Status^.GrowMode := gfGrowHiX;
-    { resize dialog to hold all requested buttons }
-    if Size.X < ((Buttons * 13) + 3+1) then
-      GrowTo((Buttons * 13) + 2+1,Size.Y + 2)
-    else GrowTo(Size.X,Size.Y + 2);
-    { find correct starting position for first button }
-    Gap := Size.X - (Buttons * 10) - 2;
-    Gap := Gap div Succ(Buttons);
-    X := Gap;
-    if X < 2 then
-      X := 2;
-    Y := Size.Y - 3;
-    { insert buttons }
-    if ((AFlags and sdCancelButton) = sdCancelButton) then
-    begin
-      P := NewButton(X,Y,10,2,'Cancel',cmCancel,hcCancel,bfDefault);
-      P^.GrowMode := gfGrowHiY or gfGrowLoY;
-      Inc(X,12 + Gap);
-    end;
-    if ((AFlags and sdPauseButton) = sdPauseButton) then
-    begin
-      P := NewButton(X,Y,10,2,'~P~ause',cmStatusPause,hcStatusPause,bfNormal);
-      P^.GrowMode := gfGrowHiY or gfGrowLoY;
-      Inc(X,12 + Gap);
-      P := NewButton(X,Y,10,2,'~R~esume',cmStatusResume,hcStatusResume,
-                     bfBroadcast);
-      P^.GrowMode := gfGrowHiY or gfGrowLoY;
-    end;
-  end;  { of if }
-  SelectNext(False);
-end;
-
-{****************************************************************************}
-{ TStatusDlg.Store                                                           }
-{****************************************************************************}
-procedure TStatusDlg.Store (var S : TStream);
-begin
-  TDialog.Store(S);
-  PutSubViewPtr(S,Status);
-end;
-
-{****************************************************************************}
-{ TStatusMessageDlg Object                                                   }
-{****************************************************************************}
-{****************************************************************************}
-{ TStatusMessageDlg.Init                                                     }
-{****************************************************************************}
-constructor TStatusMessageDlg.Init (ATitle : TTitleStr; AStatus : PStatus;
-                                    AFlags : Word; AMessage : String);
-var
-  P : PStaticText;
-  X, Y : SmallInt;
-  R : TRect;
-begin
-  if not TStatusDlg.Init(ATitle,AStatus,AFlags) then
-    Fail;
-  Status^.GrowMode := gfGrowLoY or gfGrowHiY;
-  GetExtent(R);
-  X := R.B.X - R.A.X;
-  if X < Size.X then
-    X := Size.X;
-  Y := R.B.Y - R.A.Y;
-  if Y < Size.Y then
-    Y := Size.Y;
-  GrowTo(X,Y);
-  R.Assign(2,2,Size.X-2,Size.Y-3);
-  P := New(PStaticText,Init(R,AMessage));
-  if (P = nil) then
-  begin
-    TStatusDlg.Done;
-    Fail;
-  end;
-  GrowTo(Size.X,Size.Y + P^.Size.Y + 1);
-  Insert(P);
-end;
-
-{****************************************************************************}
-{                    Global procedures and functions                         }
-{****************************************************************************}
-
-{****************************************************************************}
-{ RegisterStatuses                                                           }
-{****************************************************************************}
-procedure RegisterStatuses;
-begin
-{  RegisterType(RStatus);
-  RegisterType(RStatusDlg);
-  RegisterType(RGauge);
-  RegisterType(RArrowGauge);
-  RegisterType(RPercentGauge);
-  RegisterType(RBarGauge);
-  RegisterType(RSpinnerGauge); }
-end;
-
-{****************************************************************************}
-{                            Unit Initialization                             }
-{****************************************************************************}
-begin
-end.
+{$I statuses.inc}

+ 2887 - 0
packages/fv/src/stddlg.inc

@@ -0,0 +1,2887 @@
+{*******************************************************}
+{ Free Vision Runtime Library                           }
+{ StdDlg Unit                                           }
+{ Version: 0.1.0                                        }
+{ Release Date: July 23, 1998                           }
+{                                                       }
+{*******************************************************}
+{                                                       }
+{ This unit is a port of Borland International's        }
+{ StdDlg.pas unit.  It is for distribution with the     }
+{ Free Pascal (FPK) Compiler as part of the 32-bit      }
+{ Free Vision library.  The unit is still fully         }
+{ functional under BP7 by using the tp compiler         }
+{ directive when rebuilding the library.                }
+{                                                       }
+{*******************************************************}
+
+{ Revision History
+
+1.1a   (97/12/29)
+  - fixed bug in TFileDialog.HandleEvent that prevented the user from being
+    able to have an action taken automatically when the FileList was
+    selected and kbEnter pressed
+
+1.1
+  - modified OpenNewFile to take a history list ID
+  - implemented OpenNewFile
+
+1.0   (1992)
+  - original implementation }
+
+{$IFNDEF FPC_DOTTEDUNITS}
+unit StdDlg;
+{$ENDIF FPC_DOTTEDUNITS}
+
+{
+  This unit has been modified to make some functions global, apply patches
+  from version 3.1 of the TVBUGS list, added TEditChDirDialog, and added
+  several new global functions and procedures.
+}
+
+{$i platform.inc}
+
+{$ifdef PPC_FPC}
+  {$H-}
+{$else}
+  {$F+,O+,E+,N+}
+{$endif}
+{$X+,R-,I-,Q-,V-}
+{$ifndef OS_UNIX}
+  {$S-}
+{$endif}
+{$ifdef OS_DOS}
+  {$define HAS_DOS_DRIVES}
+{$endif}
+{$ifdef OS_WINDOWS}
+  {$define HAS_DOS_DRIVES}
+{$endif}
+{$ifdef OS_OS2}
+  {$define HAS_DOS_DRIVES}
+{$endif}
+
+{2.0 compatibility}
+{$ifdef VER2_0}
+  {$macro on}
+  {$define resourcestring := const}
+{$endif}
+
+interface
+
+{$IFDEF FPC_DOTTEDUNITS}
+uses
+  FreeVision.Fvconsts, System.Objects, FreeVision.Drivers, FreeVision.Views, 
+  FreeVision.Dialogs, FreeVision.Validate, TP.DOS;
+{$ELSE FPC_DOTTEDUNITS}
+uses
+  FVConsts, Objects, Drivers, Views, Dialogs, Validate, Dos;
+{$ENDIF FPC_DOTTEDUNITS}
+
+const
+  MaxDir   = 255;   { Maximum length of a DirStr. }
+  MaxFName = 255; { Maximum length of a FNameStr. }
+
+  DirSeparator : AnsiChar = system.DirectorySeparator;
+
+{$ifdef Unix}
+  AllFiles = '*';
+{$else}
+  {$ifdef OS_AMIGA}
+    AllFiles = '*';
+  {$else}
+    AllFiles = '*.*';
+  {$endif}
+{$endif}
+
+type
+  { TSearchRec }
+
+  {  Record used to store directory information by TFileDialog
+     This is a part of Dos.Searchrec for Bp !! }
+
+  TSearchRec =
+{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
+  packed
+{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
+  record
+    Attr: Longint;
+    Time: Longint;
+    Size: Longint;
+    Name: string[MaxFName];
+  end;
+  PSearchRec = ^TSearchRec;
+
+type
+
+  { TFileInputLine is a special input line that is used by      }
+  { TFileDialog that will update its contents in response to a  }
+  { cmFileFocused command from a TFileList.          }
+
+  PFileInputLine = ^TFileInputLine;
+  TFileInputLine = object(TInputLine)
+    constructor Init(var Bounds: TRect; AMaxLen: Sw_Integer);
+    procedure HandleEvent(var Event: TEvent); virtual;
+  end;
+
+  { TFileCollection is a collection of TSearchRec's. }
+
+  PFileCollection = ^TFileCollection;
+  TFileCollection = object(TSortedCollection)
+    function Compare(Key1, Key2: Pointer): Sw_Integer; virtual;
+    procedure FreeItem(Item: Pointer); virtual;
+    function GetItem(var S: TStream): Pointer; virtual;
+    procedure PutItem(var S: TStream; Item: Pointer); virtual;
+  end;
+
+  {#Z+}
+  PFileValidator = ^TFileValidator;
+  {#Z-}
+  TFileValidator = Object(TValidator)
+  end;  { of TFileValidator }
+
+  { TSortedListBox is a TListBox that assumes it has a     }
+  { TStoredCollection instead of just a TCollection.  It will   }
+  { perform an incremental search on the contents.       }
+
+  PSortedListBox = ^TSortedListBox;
+  TSortedListBox = object(TListBox)
+    SearchPos: Byte;
+    {ShiftState: Byte;}
+    HandleDir : boolean;
+    constructor Init(var Bounds: TRect; ANumCols: Sw_Word;
+      AScrollBar: PScrollBar);
+    procedure HandleEvent(var Event: TEvent); virtual;
+    function GetKey(var S: String): Pointer; virtual;
+    procedure NewList(AList: PCollection); virtual;
+  end;
+
+  { TFileList is a TSortedList box that assumes it contains     }
+  { a TFileCollection as its collection.  It also communicates  }
+  { through broadcast messages to TFileInput and TInfoPane      }
+  { what file is currently selected.             }
+
+  PFileList = ^TFileList;
+  TFileList = object(TSortedListBox)
+    constructor Init(var Bounds: TRect; AScrollBar: PScrollBar);
+    destructor Done; virtual;
+    function DataSize: Sw_Word; virtual;
+    procedure FocusItem(Item: Sw_Integer); virtual;
+    procedure GetData(var Rec); virtual;
+    function GetText(Item,MaxLen: Sw_Integer): String; virtual;
+    function GetKey(var S: String): Pointer; virtual;
+    procedure HandleEvent(var Event: TEvent); virtual;
+    procedure ReadDirectory(AWildCard: PathStr);
+    procedure SetData(var Rec); virtual;
+  end;
+
+  { TFileInfoPane is a TView that displays the information      }
+  { about the currently selected file in the TFileList     }
+  { of a TFileDialog.                  }
+
+  PFileInfoPane = ^TFileInfoPane;
+  TFileInfoPane = object(TView)
+    S: TSearchRec;
+    constructor Init(var Bounds: TRect);
+    procedure Draw; virtual;
+    function GetPalette: PPalette; virtual;
+    procedure HandleEvent(var Event: TEvent); virtual;
+  end;
+
+  { TFileDialog is a standard file name input dialog      }
+
+  TWildStr = PathStr;
+
+const
+  fdOkButton      = $0001;      { Put an OK button in the dialog }
+  fdOpenButton    = $0002;      { Put an Open button in the dialog }
+  fdReplaceButton = $0004;      { Put a Replace button in the dialog }
+  fdClearButton   = $0008;      { Put a Clear button in the dialog }
+  fdHelpButton    = $0010;      { Put a Help button in the dialog }
+  fdNoLoadDir     = $0100;      { Do not load the current directory }
+            { contents into the dialog at Init. }
+            { This means you intend to change the }
+            { WildCard by using SetData or store }
+            { the dialog on a stream. }
+
+type
+
+  PFileHistory = ^TFileHistory;
+  TFileHistory = object(THistory)
+    CurDir : PString;
+    procedure HandleEvent(var Event: TEvent);virtual;
+    destructor Done; virtual;
+    procedure AdaptHistoryToDir(Dir : string);
+  end;
+
+  PFileDialog = ^TFileDialog;
+  TFileDialog = object(TDialog)
+    FileName: PFileInputLine;
+    FileList: PFileList;
+    FileHistory: PFileHistory;
+    WildCard: TWildStr;
+    Directory: PString;
+    constructor Init(AWildCard: TWildStr; const ATitle,
+      InputName: String; AOptions: Word; HistoryId: Byte);
+    constructor Load(var S: TStream);
+    destructor Done; virtual;
+    procedure GetData(var Rec); virtual;
+    procedure GetFileName(var S: PathStr);
+    procedure HandleEvent(var Event: TEvent); virtual;
+    procedure SetData(var Rec); virtual;
+    procedure Store(var S: TStream);
+    function Valid(Command: Word): Boolean; virtual;
+  private
+    procedure ReadDirectory;
+  end;
+
+  { TDirEntry }
+
+  PDirEntry = ^TDirEntry;
+  TDirEntry = record
+    DisplayText: PString;
+    Directory: PString;
+  end;  { of TDirEntry }
+
+  { TDirCollection is a collection of TDirEntry's used by       }
+  { TDirListBox.                 }
+
+  PDirCollection = ^TDirCollection;
+  TDirCollection = object(TCollection)
+    function GetItem(var S: TStream): Pointer; virtual;
+    procedure FreeItem(Item: Pointer); virtual;
+    procedure PutItem(var S: TStream; Item: Pointer); virtual;
+  end;
+
+  { TDirListBox displays a tree of directories for use in the }
+  { TChDirDialog.                    }
+
+  PDirListBox = ^TDirListBox;
+  TDirListBox = object(TListBox)
+    Dir: DirStr;
+    Cur: Word;
+    constructor Init(var Bounds: TRect; AScrollBar: PScrollBar);
+    destructor Done; virtual;
+    function GetText(Item,MaxLen: Sw_Integer): String; virtual;
+    procedure HandleEvent(var Event: TEvent); virtual;
+    function IsSelected(Item: Sw_Integer): Boolean; virtual;
+    procedure NewDirectory(var ADir: DirStr);
+    procedure SetState(AState: Word; Enable: Boolean); virtual;
+  end;
+
+  { TChDirDialog is a standard change directory dialog. }
+
+const
+  cdNormal     = $0000; { Option to use dialog immediately }
+  cdNoLoadDir  = $0001; { Option to init the dialog to store on a stream }
+  cdHelpButton = $0002; { Put a help button in the dialog }
+
+type
+
+  PChDirDialog = ^TChDirDialog;
+  TChDirDialog = object(TDialog)
+    DirInput: PInputLine;
+    DirList: PDirListBox;
+    OkButton: PButton;
+    ChDirButton: PButton;
+    constructor Init(AOptions: Word; HistoryId: Sw_Word);
+    constructor Load(var S: TStream);
+    function DataSize: Sw_Word; virtual;
+    procedure GetData(var Rec); virtual;
+    procedure HandleEvent(var Event: TEvent); virtual;
+    procedure SetData(var Rec); virtual;
+    procedure Store(var S: TStream);
+    function Valid(Command: Word): Boolean; virtual;
+  private
+    procedure SetUpDialog;
+  end;
+
+  PEditChDirDialog = ^TEditChDirDialog;
+  TEditChDirDialog = Object(TChDirDialog)
+    { TEditChDirDialog allows setting/getting the starting directory.  The
+      transfer record is a DirStr. }
+    function DataSize : Sw_Word; virtual;
+    procedure GetData (var Rec); virtual;
+    procedure SetData (var Rec); virtual;
+  end;  { of TEditChDirDialog }
+
+
+  {#Z+}
+  PDirValidator = ^TDirValidator;
+  {#Z-}
+  TDirValidator = Object(TFilterValidator)
+    constructor Init;
+    function IsValid(const S: string): Boolean; virtual;
+    function IsValidInput(var S: string; SuppressFill: Boolean): Boolean;
+      virtual;
+  end;  { of TDirValidator }
+
+
+  FileConfirmFunc = function (AFile : FNameStr) : Boolean;
+    { Functions of type FileConfirmFunc's are used to prompt the end user for
+      confirmation of an operation.
+
+      FileConfirmFunc's should ask the user whether to perform the desired
+      action on the file named AFile.  If the user elects to perform the
+      function FileConfirmFunc's return True, otherwise they return False.
+
+      Using FileConfirmFunc's allows routines to be coded independant of the
+      user interface implemented.  OWL and TurboVision are supported through
+      conditional defines.  If you do not use either user interface you must
+      compile this unit with the conditional define cdNoMessages and set all
+      FileConfirmFunc variables to a valid function prior to calling any
+      routines in this unit. }
+    {#X ReplaceFile DeleteFile }
+
+
+var
+
+  ReplaceFile : FileConfirmFunc;
+    { ReplaceFile returns True if the end user elects to replace the existing
+      file with the new file, otherwise it returns False.
+
+      ReplaceFile is only called when #CheckOnReplace# is True. }
+    {#X DeleteFile }
+
+  DeleteFile : FileConfirmFunc;
+    { DeleteFile returns True if the end user elects to delete the file,
+      otherwise it returns False.
+
+       DeleteFile is only called when #CheckOnDelete# is True. }
+    {#X ReplaceFile }
+
+
+const
+
+  CInfoPane = #30;
+
+  { TStream registration records }
+
+function Contains(S1, S2: String): Boolean;
+  { Contains returns true if S1 contains any characters in S2. }
+
+function DriveValid(Drive: AnsiChar): Boolean;
+  { DriveValid returns True if Drive is a valid DOS drive.  Drive valid works
+    by attempting to change the current directory to Drive, then restoring
+    the original directory. }
+
+function ExtractDir(AFile: FNameStr): DirStr;
+  { ExtractDir returns the path of AFile terminated with a trailing '\'.  If
+    AFile contains no directory information, an empty string is returned. }
+
+function ExtractFileName(AFile: FNameStr): NameStr;
+  { ExtractFileName returns the file name without any directory or file
+    extension information. }
+
+function Equal(const S1, S2: String; Count: Sw_word): Boolean;
+  { Equal returns True if S1 equals S2 for up to Count characters.  Equal is
+    case-insensitive. }
+
+function FileExists (AFile : FNameStr) : Boolean;
+  { FileExists looks for the file specified in AFile.  If AFile is present
+    FileExists returns true, otherwise FileExists returns False.
+
+    The search is performed relative to the current system directory, but
+    other directories may be searched by prefacing a file name with a valid
+    directory path.
+
+    There is no check for a vaild file name or drive.  Errrors are handled
+    internally and not reported in DosError.  Critical errors are left to
+    the system's critical error handler. }
+  {#X OpenFile }
+
+function GetCurDir: DirStr;
+  { GetCurDir returns the current directory.  The directory returned always
+    ends with a trailing backslash '\'. }
+
+function GetCurDrive: AnsiChar;
+  { GetCurDrive returns the letter of the current drive as reported by the
+    operating system. }
+
+function IsWild(const S: String): Boolean;
+  { IsWild returns True if S contains a question mark (?) or asterix (*). }
+
+function IsList(const S: String): Boolean;
+  { IsList returns True if S contains list separator (;) AnsiChar }
+
+function IsDir(const S: String): Boolean;
+  { IsDir returns True if S is a valid DOS directory. }
+
+{procedure MakeResources;}
+  { MakeResources places a language specific version of all resources
+    needed for the StdDlg unit to function on the RezFile using the string
+    constants and variables in the Resource unit.  The Resource unit and the
+    appropriate string lists must be initialized prior to calling this
+    procedure. }
+
+function NoWildChars(S: String): String;
+  { NoWildChars deletes the wild card characters ? and * from the string S
+    and returns the result. }
+
+function OpenFile (var AFile : FNameStr; HistoryID : Byte) : Boolean;
+  { OpenFile prompts the user to select a file using the file specifications
+    in AFile as the starting file and path.  Wildcards are accepted.  If the
+    user accepts a file OpenFile returns True, otherwise OpenFile returns
+    False.
+
+    Note: The file returned may or may not exist. }
+
+function OpenNewFile (var AFile: FNameStr; HistoryID: Byte): Boolean;
+  { OpenNewFile allows the user to select a directory from disk and enter a
+    new file name.  If the file name entered is an existing file the user is
+    optionally prompted for confirmation of replacing the file based on the
+    value in #CheckOnReplace#.  If a file name is successfully entered,
+    OpenNewFile returns True. }
+  {#X OpenFile }
+
+function PathValid(var Path: PathStr): Boolean;
+  { PathValid returns True if Path is a valid DOS path name.  Path may be a
+    file or directory name.  Trailing '\'s are removed. }
+
+procedure RegisterStdDlg;
+  { RegisterStdDlg registers all objects in the StdDlg unit for stream
+    usage. }
+
+function SaveAs (var AFile : FNameStr; HistoryID : Word) : Boolean;
+  { SaveAs prompts the user for a file name using AFile as a template.  If
+    AFile already exists and CheckOnReplace is True, the user is prompted
+    to replace the file.
+
+    If a valid file name is entered SaveAs returns True, other SaveAs returns
+    False. }
+
+function SelectDir (var ADir : DirStr; HistoryID : Byte) : Boolean;
+  { SelectDir prompts the user to select a directory using ADir as the
+    starting directory.  If a directory is selected, SelectDir returns True.
+    The directory returned is gauranteed to exist. }
+
+function ShrinkPath (AFile : FNameStr; MaxLen : Byte) : FNameStr;
+  { ShrinkPath returns a file name with a maximu length of MaxLen.
+    Internal directories are removed and replaced with elipses as needed to
+    make the file name fit in MaxLen.
+
+    AFile must be a valid path name. }
+
+function StdDeleteFile (AFile : FNameStr) : Boolean;
+  { StdDeleteFile returns True if the end user elects to delete the file,
+    otherwise it returns False.
+
+    DeleteFile is only called when CheckOnDelete is True. }
+
+function StdReplaceFile (AFile : FNameStr) : Boolean;
+  { StdReplaceFile returns True if the end user elects to replace the existing
+    AFile with the new AFile, otherwise it returns False.
+
+    ReplaceFile is only called when CheckOnReplace is True. }
+
+function ValidFileName(var FileName: PathStr): Boolean;
+  { ValidFileName returns True if FileName is a valid DOS file name. }
+
+
+const
+  CheckOnReplace : Boolean = True;
+    { CheckOnReplace is used by file functions.  If a file exists, it is
+      optionally replaced based on the value of CheckOnReplace.
+
+      If CheckOnReplace is False the file is replaced without asking the
+      user.  If CheckOnReplace is True, the end user is asked to replace the
+      file using a call to ReplaceFile.
+
+      CheckOnReplace is set to True by default. }
+
+  CheckOnDelete : Boolean = True;
+    { CheckOnDelete is used by file and directory functions.  If a file
+      exists, it is optionally deleted based on the value of CheckOnDelete.
+
+      If CheckOnDelete is False the file or directory is deleted without
+      asking the user.  If CheckOnDelete is True, the end user is asked to
+      delete the file/directory using a call to DeleteFile.
+
+      CheckOnDelete is set to True by default. }
+
+
+
+const
+  RFileInputLine: TStreamRec = (
+     ObjType: idFileInputLine;
+     VmtLink: Ofs(TypeOf(TFileInputLine)^);
+     Load:    @TFileInputLine.Load;
+     Store:   @TFileInputLine.Store
+  );
+
+  RFileCollection: TStreamRec = (
+     ObjType: idFileCollection;
+     VmtLink: Ofs(TypeOf(TFileCollection)^);
+     Load:    @TFileCollection.Load;
+     Store:   @TFileCollection.Store
+  );
+
+  RFileList: TStreamRec = (
+     ObjType: idFileList;
+     VmtLink: Ofs(TypeOf(TFileList)^);
+     Load:    @TFileList.Load;
+     Store:   @TFileList.Store
+  );
+
+  RFileInfoPane: TStreamRec = (
+     ObjType: idFileInfoPane;
+     VmtLink: Ofs(TypeOf(TFileInfoPane)^);
+     Load:    @TFileInfoPane.Load;
+     Store:   @TFileInfoPane.Store
+  );
+
+  RFileDialog: TStreamRec = (
+     ObjType: idFileDialog;
+     VmtLink: Ofs(TypeOf(TFileDialog)^);
+     Load:    @TFileDialog.Load;
+     Store:   @TFileDialog.Store
+  );
+
+  RDirCollection: TStreamRec = (
+     ObjType: idDirCollection;
+     VmtLink: Ofs(TypeOf(TDirCollection)^);
+     Load:    @TDirCollection.Load;
+     Store:   @TDirCollection.Store
+  );
+
+  RDirListBox: TStreamRec = (
+     ObjType: idDirListBox;
+     VmtLink: Ofs(TypeOf(TDirListBox)^);
+     Load:    @TDirListBox.Load;
+     Store:   @TDirListBox.Store
+  );
+
+  RChDirDialog: TStreamRec = (
+     ObjType: idChDirDialog;
+     VmtLink: Ofs(TypeOf(TChDirDialog)^);
+     Load:    @TChDirDialog.Load;
+     Store:   @TChDirDialog.Store
+  );
+
+  RSortedListBox: TStreamRec = (
+     ObjType: idSortedListBox;
+     VmtLink: Ofs(TypeOf(TSortedListBox)^);
+     Load:    @TSortedListBox.Load;
+     Store:   @TSortedListBox.Store
+  );
+
+  REditChDirDialog : TStreamRec = (
+    ObjType : idEditChDirDialog;
+    VmtLink : Ofs(TypeOf(TEditChDirDialog)^);
+    Load    : @TEditChDirDialog.Load;
+    Store   : @TEditChDirDialog.Store);
+
+
+implementation
+
+{****************************************************************************}
+{            Local Declarations              }
+{****************************************************************************}
+
+{$IFDEF FPC_DOTTEDUNITS}
+uses
+  FreeVision.App, {FreeVision.Memory,} FreeVision.HistList, FreeVision.MsgBox{, System.Resources.Resource};
+{$ELSE FPC_DOTTEDUNITS}
+uses
+  App, {Memory,} HistList, MsgBox{, Resource};
+{$ENDIF FPC_DOTTEDUNITS}
+
+type
+
+  PStringRec = record
+    { PStringRec is needed for properly displaying PStrings using
+      MessageBox. }
+    AString : PString;
+  end;
+
+resourcestring  sChangeDirectory='Change Directory';
+                sDeleteFile='Delete file?'#13#10#13#3'%s';
+                sDirectory='Directory';
+                sDrives='Drives';
+                sInvalidDirectory='Invalid directory.';
+                sInvalidDriveOrDir='Invalid drive or directory.';
+                sInvalidFileName='Invalid file name.';
+                sOpen='Open';
+                sReplaceFile='Replace file?'#13#10#13#3'%s';
+                sSaveAs='Save As';
+                sTooManyFiles='Too many files.';
+
+                smApr='Apr';
+                smAug='Aug';
+                smDec='Dec';
+                smFeb='Feb';
+                smJan='Jan';
+                smJul='Jul';
+                smJun='Jun';
+                smMar='Mar';
+                smMay='May';
+                smNov='Nov';
+                smOct='Oct';
+                smSep='Sep';
+
+                slChDir='~C~hdir';
+                slClear='C~l~ear';
+                slDirectoryName='Directory ~n~ame';
+                slDirectoryTree='Directory ~t~ree';
+                slFiles='~F~iles';
+                slReplace='~R~eplace';
+                slRevert='~R~evert';
+
+{****************************************************************************}
+{ PathValid                        }
+{****************************************************************************}
+{$ifdef go32v2}
+{$define NetDrive}
+{$endif go32v2}
+{$ifdef OS_WINDOWS}
+{$define NetDrive}
+{$endif OS_WINDOWS}
+
+procedure RemoveDoubleDirSep(var ExpPath : PathStr);
+var
+  p: longint;
+{$ifdef NetDrive}
+  OneDirSepRemoved: boolean;
+{$endif NetDrive}
+begin
+  p:=pos(DirSeparator+DirSeparator,ExpPath);
+{$ifdef NetDrive}
+  if p=1 then
+    begin
+      ExpPath:=Copy(ExpPath,1,high(ExpPath));
+      OneDirSepRemoved:=true;
+      p:=pos(DirSeparator+DirSeparator,ExpPath);
+    end
+  else
+    OneDirSepRemoved:=false;
+{$endif NetDrive}
+  while p>0 do
+    begin
+      ExpPath:=Copy(ExpPath,1,p)+Copy(ExpPath,p+2,high(ExpPath));
+      p:=pos(DirSeparator+DirSeparator,ExpPath);
+    end;
+{$ifdef NetDrive}
+  if OneDirSepRemoved then
+    ExpPath:=DirSeparator+ExpPath;
+{$endif NetDrive}
+end;
+
+function PathValid (var Path: PathStr): Boolean;
+var
+  ExpPath: PathStr;
+  SR: SearchRec;
+begin
+  RemoveDoubleDirSep(Path);
+  ExpPath := FExpand(Path);
+{$ifdef HAS_DOS_DRIVES}
+  if (Length(ExpPath) <= 3) then
+    PathValid := DriveValid(ExpPath[1])
+  else
+{$endif}
+  begin
+    { do not change '/' into '' }
+    if (Length(ExpPath)>1) and (ExpPath[Length(ExpPath)] = DirSeparator) then
+      SetLength(ExpPath,Length(ExpPath)-1);
+    // This function is called on current directories.
+    // If the current dir starts with a . on Linux it is is hidden.
+    // That's why we allow hidden dirs below (bug 6173)
+    FindFirst(ExpPath, Directory+hidden, SR);
+    PathValid := (DosError = 0) and (SR.Attr and Directory <> 0);
+{$ifdef NetDrive}
+    if (DosError<>0) and (length(ExpPath)>2) and
+       (ExpPath[1]='\') and (ExpPath[2]='\')then
+      begin
+        { Checking '\\machine\sharedfolder' directly always fails..
+          rather try '\\machine\sharedfolder\*' PM }
+      {$ifdef fpc}
+        FindClose(SR);
+      {$endif}
+        FindFirst(ExpPath+'\*',AnyFile,SR);
+        PathValid:=(DosError = 0);
+      end;
+{$endif NetDrive}
+    {$ifdef fpc}
+    FindClose(SR);
+   {$endif}
+  end;
+end;
+
+{****************************************************************************}
+{ TDirValidator Object                        }
+{****************************************************************************}
+{****************************************************************************}
+{ TDirValidator.Init                    }
+{****************************************************************************}
+constructor TDirValidator.Init;
+const   { What should this list be?  The commented one doesn't allow home,
+  end, right arrow, left arrow, Ctrl+XXXX, etc. }
+  Chars: TCharSet = ['A'..'Z','a'..'z','.','~',':','_','-'];
+{  Chars: TCharSet = [#0..#255]; }
+begin
+  Chars := Chars + [DirSeparator];
+  if not inherited Init(Chars) then
+    Fail;
+end;
+
+{****************************************************************************}
+{ TDirValidator.IsValid                      }
+{****************************************************************************}
+function TDirValidator.IsValid(const S: string): Boolean;
+begin
+{  IsValid := False; }
+  IsValid := True;
+end;
+
+{****************************************************************************}
+{ TDirValidator.IsValidInput                  }
+{****************************************************************************}
+function TDirValidator.IsValidInput(var S: string; SuppressFill: Boolean): Boolean;
+begin
+{  IsValid := False; }
+  IsValidInput := True;
+end;
+
+{****************************************************************************}
+{ TFileInputLine Object                      }
+{****************************************************************************}
+{****************************************************************************}
+{ TFileInputLine.Init                     }
+{****************************************************************************}
+constructor TFileInputLine.Init(var Bounds: TRect; AMaxLen: Sw_Integer);
+begin
+  TInputLine.Init(Bounds, AMaxLen);
+  EventMask := EventMask or evBroadcast;
+end;
+
+{****************************************************************************}
+{ TFileInputLine.HandleEvent                  }
+{****************************************************************************}
+procedure TFileInputLine.HandleEvent(var Event: TEvent);
+begin
+  TInputLine.HandleEvent(Event);
+  if (Event.What = evBroadcast) and (Event.Command = cmFileFocused) and
+    (State and sfSelected = 0) then
+  begin
+     if PSearchRec(Event.InfoPtr)^.Attr and Directory <> 0 then
+       begin
+          Data^ := PSearchRec(Event.InfoPtr)^.Name + DirSeparator +
+            PFileDialog(Owner)^.WildCard;
+          { PFileDialog(Owner)^.FileHistory^.AdaptHistoryToDir(
+              PSearchRec(Event.InfoPtr)^.Name+DirSeparator);}
+       end
+     else Data^ := PSearchRec(Event.InfoPtr)^.Name;
+     DrawView;
+  end;
+end;
+
+{****************************************************************************}
+{ TFileCollection Object                       }
+{****************************************************************************}
+{****************************************************************************}
+{ TFileCollection.Compare                     }
+{****************************************************************************}
+  function uppername(const s : string) : string;
+  var
+    i  : Sw_integer;
+    in_name : boolean;
+  begin
+     in_name:=true;
+     for i:=length(s) downto 1 do
+      if in_name and (s[i] in ['a'..'z']) then
+        uppername[i]:=AnsiChar(byte(s[i])-32)
+      else
+       begin
+          uppername[i]:=s[i];
+          if s[i] = DirSeparator then
+            in_name:=false;
+       end;
+     uppername[0]:=s[0];
+  end;
+
+function TFileCollection.Compare(Key1, Key2: Pointer): Sw_Integer;
+begin
+  if PSearchRec(Key1)^.Name = PSearchRec(Key2)^.Name then Compare := 0
+  else if PSearchRec(Key1)^.Name = '..' then Compare := 1
+  else if PSearchRec(Key2)^.Name = '..' then Compare := -1
+  else if (PSearchRec(Key1)^.Attr and Directory <> 0) and
+     (PSearchRec(Key2)^.Attr and Directory = 0) then Compare := 1
+  else if (PSearchRec(Key2)^.Attr and Directory <> 0) and
+     (PSearchRec(Key1)^.Attr and Directory = 0) then Compare := -1
+  else if UpperName(PSearchRec(Key1)^.Name) > UpperName(PSearchRec(Key2)^.Name) then
+    Compare := 1
+{$ifdef unix}
+  else if UpperName(PSearchRec(Key1)^.Name) < UpperName(PSearchRec(Key2)^.Name) then
+    Compare := -1
+  else if PSearchRec(Key1)^.Name > PSearchRec(Key2)^.Name then
+    Compare := 1
+{$endif def unix}
+  else
+    Compare := -1;
+end;
+
+{****************************************************************************}
+{ TFileCollection.FreeItem                   }
+{****************************************************************************}
+procedure TFileCollection.FreeItem(Item: Pointer);
+begin
+  Dispose(PSearchRec(Item));
+end;
+
+{****************************************************************************}
+{ TFileCollection.GetItem                     }
+{****************************************************************************}
+function TFileCollection.GetItem(var S: TStream): Pointer;
+var
+  Item: PSearchRec;
+begin
+  New(Item);
+  S.Read(Item^, SizeOf(TSearchRec));
+  GetItem := Item;
+end;
+
+{****************************************************************************}
+{ TFileCollection.PutItem                     }
+{****************************************************************************}
+procedure TFileCollection.PutItem(var S: TStream; Item: Pointer);
+begin
+  S.Write(Item^, SizeOf(TSearchRec));
+end;
+
+
+{*****************************************************************************
+               TFileList
+*****************************************************************************}
+
+const
+  ListSeparator=';';
+
+function MatchesMask(What, Mask: string): boolean;
+
+  function upper(const s : string) : string;
+  var
+    i  : Sw_integer;
+  begin
+     for i:=1 to length(s) do
+      if s[i] in ['a'..'z'] then
+       upper[i]:=AnsiChar(byte(s[i])-32)
+      else
+       upper[i]:=s[i];
+     upper[0]:=s[0];
+  end;
+
+  Function CmpStr(const hstr1,hstr2:string):boolean;
+  var
+    found : boolean;
+    i1,i2 : Sw_integer;
+  begin
+    i1:=0;
+    i2:=0;
+    if hstr1='' then
+      begin
+        CmpStr:=(hstr2='');
+        exit;
+      end;
+    found:=true;
+    repeat
+      inc(i1);
+      if (i1>length(hstr1)) then
+        break;
+      inc(i2);
+      if (i2>length(hstr2)) then
+        break;
+      case hstr1[i1] of
+        '?' :
+          found:=true;
+        '*' :
+          begin
+            found:=true;
+            if (i1=length(hstr1)) then
+             i2:=length(hstr2)
+            else
+             if (i1<length(hstr1)) and (hstr1[i1+1]<>hstr2[i2]) then
+              begin
+                if i2<length(hstr2) then
+                 dec(i1)
+              end
+            else
+             if i2>1 then
+              dec(i2);
+          end;
+        else
+          found:=(hstr1[i1]=hstr2[i2]) or (hstr2[i2]='?');
+      end;
+    until not found;
+    if found then
+      begin
+        found:=(i2>=length(hstr2)) and
+               (
+                (i1>length(hstr1)) or
+                ((i1=length(hstr1)) and
+                 (hstr1[i1]='*'))
+               );
+      end;
+    CmpStr:=found;
+  end;
+
+var
+  D1,D2 : DirStr;
+  N1,N2 : NameStr;
+  E1,E2 : Extstr;
+begin
+{$ifdef Unix}
+  FSplit(What,D1,N1,E1);
+  FSplit(Mask,D2,N2,E2);
+{$else}
+  FSplit(Upper(What),D1,N1,E1);
+  FSplit(Upper(Mask),D2,N2,E2);
+{$endif}
+  MatchesMask:=CmpStr(N2,N1) and CmpStr(E2,E1);
+end;
+
+function MatchesMaskList(What, MaskList: string): boolean;
+var P: SmallInt;
+    Match: boolean;
+begin
+  Match:=false;
+  if What<>'' then
+  repeat
+    P:=Pos(ListSeparator, MaskList);
+    if P=0 then P:=length(MaskList)+1;
+    Match:=MatchesMask(What,copy(MaskList,1,P-1));
+    Delete(MaskList,1,P);
+  until Match or (MaskList='');
+  MatchesMaskList:=Match;
+end;
+
+constructor TFileList.Init(var Bounds: TRect; AScrollBar: PScrollBar);
+begin
+  TSortedListBox.Init(Bounds, 2, AScrollBar);
+end;
+
+destructor TFileList.Done;
+begin
+  if List <> nil then Dispose(List, Done);
+  TListBox.Done;
+end;
+
+function TFileList.DataSize: Sw_Word;
+begin
+  DataSize := 0;
+end;
+
+procedure TFileList.FocusItem(Item: Sw_Integer);
+begin
+  TSortedListBox.FocusItem(Item);
+  if (List^.Count > 0) then
+    Message(Owner, evBroadcast, cmFileFocused, List^.At(Item));
+end;
+
+procedure TFileList.GetData(var Rec);
+begin
+end;
+
+function TFileList.GetKey(var S: String): Pointer;
+const
+  SR: TSearchRec = ();
+
+procedure UpStr(var S: String);
+var
+  I: Sw_Integer;
+begin
+  for I := 1 to Length(S) do S[I] := UpCase(S[I]);
+end;
+
+begin
+  if (HandleDir{ShiftState and $03 <> 0}) or ((S <> '') and (S[1]='.')) then
+    SR.Attr := Directory
+  else SR.Attr := 0;
+  SR.Name := S;
+{$ifndef Unix}
+  UpStr(SR.Name);
+{$endif Unix}
+  GetKey := @SR;
+end;
+
+function TFileList.GetText(Item,MaxLen: Sw_Integer): String;
+var
+  S: String;
+  SR: PSearchRec;
+begin
+  SR := PSearchRec(List^.At(Item));
+  S := SR^.Name;
+  if SR^.Attr and Directory <> 0 then
+  begin
+    S[Length(S)+1] := DirSeparator;
+    Inc(S[0]);
+  end;
+  GetText := S;
+end;
+
+procedure TFileList.HandleEvent(var Event: TEvent);
+var
+  S : String;
+  K : pointer;
+  Value : Sw_integer;
+begin
+  if (Event.What = evMouseDown) and (Event.Double) then
+  begin
+    Event.What := evCommand;
+    Event.Command := cmOK;
+    PutEvent(Event);
+    ClearEvent(Event);
+  end
+  else if (Event.What = evKeyDown) and (Event.CharCode='<') then
+  begin
+    { select '..' }
+      S := '..';
+      K := GetKey(S);
+      If PSortedCollection(List)^.Search(K, Value) then
+        FocusItem(Value);
+  end
+  else TSortedListBox.HandleEvent(Event);
+end;
+
+procedure TFileList.ReadDirectory(AWildCard: PathStr);
+const
+  FindAttr = ReadOnly + Archive;
+  PrevDir  = '..';
+var
+  S: SearchRec;
+  P: PSearchRec;
+  FileList: PFileCollection;
+  NumFiles: Word;
+  FindStr,
+  WildName : string;
+  Dir: DirStr;
+  Ext: ExtStr;
+  Name: NameStr;
+  Event : TEvent;
+  Tmp: PathStr;
+begin
+  NumFiles := 0;
+  FileList := New(PFileCollection, Init(5, 5));
+  AWildCard := FExpand(AWildCard);
+  FSplit(AWildCard, Dir, Name, Ext);
+  if pos(ListSeparator,AWildCard)>0 then
+   begin
+     WildName:=Copy(AWildCard,length(Dir)+1,255);
+     FindStr:=Dir+AllFiles;
+   end
+  else
+   begin
+     WildName:=Name+Ext;
+     FindStr:=AWildCard;
+   end;
+  FindFirst(FindStr, FindAttr, S);
+  P := PSearchRec(@P);
+  while assigned(P) and (DosError = 0) do
+   begin
+     if (S.Attr and Directory = 0) and
+        MatchesMaskList(S.Name,WildName) then
+     begin
+{       P := MemAlloc(SizeOf(P^));
+       if assigned(P) then
+       begin}
+         new(P);
+         P^.Attr:=S.Attr;
+         P^.Time:=S.Time;
+         P^.Size:=S.Size;
+         P^.Name:=S.Name;
+         FileList^.Insert(P);
+{       end;}
+     end;
+     FindNext(S);
+   end;
+ {$ifdef fpc}
+  FindClose(S);
+ {$endif}
+
+  Tmp := Dir + AllFiles;
+  FindFirst(Tmp, Directory, S);
+  while (P <> nil) and (DosError = 0) do
+  begin
+    if (S.Attr and Directory <> 0) and (S.Name <> '.') and (S.Name <> '..') then
+    begin
+{      P := MemAlloc(SizeOf(P^));
+      if P <> nil then
+      begin}
+        new(p);
+        P^.Attr:=S.Attr;
+        P^.Time:=S.Time;
+        P^.Size:=S.Size;
+        P^.Name:=S.Name;
+        FileList^.Insert(P);
+{      end;}
+    end;
+    FindNext(S);
+  end;
+ {$ifdef fpc}
+  FindClose(S);
+ {$endif}
+ {$ifndef Unix}
+  if Length(Dir) > 4 then
+ {$endif not Unix}
+  begin
+{
+    P := MemAlloc(SizeOf(P^));
+    if P <> nil then
+    begin}
+      new(p);
+      FindFirst(Tmp, Directory, S);
+      FindNext(S);
+      if (DosError = 0) and (S.Name = PrevDir) then
+       begin
+         P^.Attr:=S.Attr;
+         P^.Time:=S.Time;
+         P^.Size:=S.Size;
+         P^.Name:=S.Name;
+       end
+      else
+       begin
+         P^.Name := PrevDir;
+         P^.Size := 0;
+         P^.Time := $210000;
+         P^.Attr := Directory;
+       end;
+      FileList^.Insert(PSearchRec(P));
+     {$ifdef fpc}
+      FindClose(S);
+     {$endif}
+{    end;}
+  end;
+  if P = nil then
+    MessageBox(sTooManyFiles, nil, mfOkButton + mfWarning);
+  NewList(FileList);
+  if List^.Count > 0 then
+  begin
+    Event.What := evBroadcast;
+    Event.Command := cmFileFocused;
+    Event.InfoPtr := List^.At(0);
+    Owner^.HandleEvent(Event);
+  end;
+end;
+
+procedure TFileList.SetData(var Rec);
+begin
+  with PFileDialog(Owner)^ do
+    Self.ReadDirectory(Directory^ + WildCard);
+end;
+
+{****************************************************************************}
+{ TFileInfoPane Object                        }
+{****************************************************************************}
+{****************************************************************************}
+{ TFileInfoPane.Init                    }
+{****************************************************************************}
+constructor TFileInfoPane.Init(var Bounds: TRect);
+begin
+  TView.Init(Bounds);
+  FillChar(S,SizeOf(S),#0);
+  EventMask := EventMask or evBroadcast;
+end;
+
+{****************************************************************************}
+{ AdjustNameSize for TFileInfoPane                                           }
+{****************************************************************************}
+function AdjustNameSize(S:String;ASize:sw_integer):String;
+var St: String;
+    NameLen:sw_integer;
+    K,N : sw_integer;
+begin
+  NameLen:=12;
+  Str(NameLen,St);
+  NameLen:=ASize-10-9-3-2-4-2-2-1-2;
+  if NameLen>12 then
+    Str(NameLen,St);
+  k:=1;
+  while k<=length(S) do
+  begin
+    if (S[k] in ['0'..'9']) then break;
+    inc(k);
+  end;
+  N:=K;
+  while N<=length(S) do
+  begin
+    if not (S[N] in ['0'..'9']) then break;
+    inc(N);
+  end;
+  S:=Copy(S,1,K-1)+St+Copy(S,N,length(S));
+  AdjustNameSize:=S;
+end;
+
+{****************************************************************************}
+{ TFileInfoPane.Draw                    }
+{****************************************************************************}
+procedure TFileInfoPane.Draw;
+var
+  B: TDrawBuffer;
+  D: String[9];
+  M: String[3];
+  PM: Boolean;
+  Color: Word;
+  Time: DateTime;
+  Path: PathStr;
+  FmtId: String;
+  Params: array[0..7] of PtruInt;
+  Str: String[80];
+const
+  sDirectoryLine = ' %-12s %-9s %3s %2d, %4d  %2d:%02d%cm';
+  sFileLine      = ' %-12s %-9d %3s %2d, %4d  %2d:%02d%cm';
+  InValidFiles : array[0..2] of string[12] = ('','.','..');
+var
+  Month: array[1..12] of String[3];
+begin
+  Month[1] := smJan;
+  Month[2] := smFeb;
+  Month[3] := smMar;
+  Month[4] := smApr;
+  Month[5] := smMay;
+  Month[6] := smJun;
+  Month[7] := smJul;
+  Month[8] := smAug;
+  Month[9] := smSep;
+  Month[10] := smOct;
+  Month[11] := smNov;
+  Month[12] := smDec;
+  { Display path }
+  if (PFileDialog(Owner)^.Directory <> nil) then
+    Path := PFileDialog(Owner)^.Directory^
+  else Path := '';
+  Path := FExpand(Path+PFileDialog(Owner)^.WildCard);
+  { avoid B Buffer overflow PM }
+  Path := ShrinkPath(Path, Size.X - 1);
+  Color := GetColor($01);
+  MoveChar(B, ' ', Color, Size.X); { fill with empty spaces }
+  WriteLine(0, 0, Size.X, Size.Y, B);
+  MoveStr(B[1], Path, Color);
+  WriteLine(0, 0, Size.X, 1, B);
+  if (S.Name = InValidFiles[0]) or (S.Name = InValidFiles[1]) or
+     (S.Name = InValidFiles[2]) then
+    Exit;
+
+  { Display file }
+  Params[0] := ptruint(@S.Name);
+  if S.Attr and Directory <> 0 then
+  begin
+    FmtId := sDirectoryLine;
+    D := sDirectory;
+    Params[1] := ptruint(@D);
+  end else
+  begin
+    FmtId := sFileLine;
+    Params[1] := S.Size;
+  end;
+  FmtId:=AdjustNameSize(FmtId,Size.X);
+  UnpackTime(S.Time, Time);
+  M := Month[Time.Month];
+  Params[2] := ptruint(@M);
+  Params[3] := Time.Day;
+  Params[4] := Time.Year;
+  PM := Time.Hour >= 12;
+  Time.Hour := Time.Hour mod 12;
+  if Time.Hour = 0 then Time.Hour := 12;
+  Params[5] := Time.Hour;
+  Params[6] := Time.Min;
+  if PM then
+    Params[7] := Byte('p')
+  else Params[7] := Byte('a');
+  FormatStr(Str, FmtId, Params);
+  MoveStr(B, Str, Color);
+  WriteLine(0, 1, Size.X, 1, B);
+
+  { Fill in rest of rectangle }
+  MoveChar(B, ' ', Color, Size.X);
+  WriteLine(0, 2, Size.X, Size.Y-2, B);
+end;
+
+function TFileInfoPane.GetPalette: PPalette;
+const
+  P: String[Length(CInfoPane)] = CInfoPane;
+begin
+  GetPalette := PPalette(@P);
+end;
+
+procedure TFileInfoPane.HandleEvent(var Event: TEvent);
+begin
+  TView.HandleEvent(Event);
+  if (Event.What = evBroadcast) and (Event.Command = cmFileFocused) then
+  begin
+    S := PSearchRec(Event.InfoPtr)^;
+    DrawView;
+  end;
+end;
+
+{****************************************************************************
+              TFileHistory
+****************************************************************************}
+
+  function LTrim(const S: String): String;
+  var
+    I: Sw_Integer;
+  begin
+    I := 1;
+    while (I < Length(S)) and (S[I] = ' ') do Inc(I);
+    LTrim := Copy(S, I, length(S));
+  end;
+
+  function RTrim(const S: String): String;
+  var
+    I: Sw_Integer;
+  begin
+    I := Length(S);
+    if I = 0 then begin RTrim:=''; exit; end;
+    while S[I] = ' ' do Dec(I);
+    RTrim := Copy(S, 1, I);
+  end;
+
+  function RelativePath(var S: PathStr): Boolean;
+  begin
+    S := LTrim(RTrim(S));
+    {$ifdef HASAMIGA}
+    RelativePath := Pos(DriveSeparator, S) = 0;
+    {$ELSE}
+    RelativePath := not ((S <> '') and ((S[1] = DirSeparator) or (S[2] = ':')));
+    {$ENDIF}
+  end;
+
+{ try to reduce the length of S+dir as a file path+pattern }
+
+  function Simplify (var S,Dir : string) : string;
+    var i : sw_integer;
+  begin
+   if RelativePath(Dir) then
+     begin
+        if (S<>'') and (Copy(Dir,1,3)='..'+DirSeparator) then
+          begin
+             i:=Length(S);
+             for i:=Length(S)-1 downto 1 do
+               if S[i]=DirSeparator then
+                 break;
+             if S[i]=DirSeparator then
+               Simplify:=Copy(S,1,i)+Copy(Dir,4,255)
+             else
+               Simplify:=S+Dir;
+          end
+        else
+          Simplify:=S+Dir;
+     end
+   else
+      Simplify:=Dir;
+  end;
+
+{****************************************************************************}
+{ TFileHistory.HandleEvent                                                       }
+{****************************************************************************}
+
+procedure TFileHistory.HandleEvent(var Event: TEvent);
+var
+  HistoryWindow: PHistoryWindow;
+  R,P: TRect;
+  C: Word;
+  Rslt: String;
+begin
+  TView.HandleEvent(Event);
+  if (Event.What = evMouseDown) or
+     ((Event.What = evKeyDown) and (CtrlToArrow(Event.KeyCode) = kbDown) and
+      (Link^.State and sfFocused <> 0)) then
+  begin
+    if not Link^.Focus then
+    begin
+      ClearEvent(Event);
+      Exit;
+    end;
+    if assigned(CurDir) then
+     Rslt:=CurDir^
+    else
+     Rslt:='';
+    Rslt:=Simplify(Rslt,Link^.Data^);
+    RemoveDoubleDirSep(Rslt);
+    If IsWild(Rslt) then
+      RecordHistory(Rslt);
+    Link^.GetBounds(R);
+    Dec(R.A.X); Inc(R.B.X); Inc(R.B.Y,7); Dec(R.A.Y,1);
+    Owner^.GetExtent(P);
+    R.Intersect(P);
+    Dec(R.B.Y,1);
+    HistoryWindow := InitHistoryWindow(R);
+    if HistoryWindow <> nil then
+    begin
+      C := Owner^.ExecView(HistoryWindow);
+      if C = cmOk then
+      begin
+        Rslt := HistoryWindow^.GetSelection;
+        if Length(Rslt) > Link^.MaxLen then Rslt[0] := AnsiChar(Link^.MaxLen);
+        Link^.Data^ := Rslt;
+        Link^.SelectAll(True);
+        Link^.DrawView;
+      end;
+      Dispose(HistoryWindow, Done);
+    end;
+    ClearEvent(Event);
+  end
+  else if (Event.What = evBroadcast) then
+    if ((Event.Command = cmReleasedFocus) and (Event.InfoPtr = Link))
+      or (Event.Command = cmRecordHistory) then
+    begin
+      if assigned(CurDir) then
+       Rslt:=CurDir^
+      else
+       Rslt:='';
+      Rslt:=Simplify(Rslt,Link^.Data^);
+      RemoveDoubleDirSep(Rslt);
+      If IsWild(Rslt) then
+        RecordHistory(Rslt);
+    end;
+end;
+
+procedure TFileHistory.AdaptHistoryToDir(Dir : string);
+  var S,S2 : String;
+      i,Count : Sw_word;
+begin
+   if assigned(CurDir) then
+     begin
+        S:=CurDir^;
+        if S=Dir then
+          exit;
+        DisposeStr(CurDir);
+     end
+   else
+     S:='';
+   CurDir:=NewStr(Simplify(S,Dir));
+
+   Count:=HistoryCount(HistoryId);
+   for i:=1 to count do
+     begin
+        S2:=HistoryStr(HistoryId,1);
+        HistoryRemove(HistoryId,1);
+        if RelativePath(S2) then
+          if S<>'' then
+            S2:=S+S2
+          else
+            S2:=FExpand(S2);
+        { simply full path
+          we should simplify relative to Dir ! }
+        HistoryAdd(HistoryId,S2);
+     end;
+
+end;
+
+destructor TFileHistory.Done;
+begin
+  If assigned(CurDir) then
+    DisposeStr(CurDir);
+  Inherited Done;
+end;
+
+{****************************************************************************
+              TFileDialog
+****************************************************************************}
+
+constructor TFileDialog.Init(AWildCard: TWildStr; const ATitle,
+  InputName: String; AOptions: Word; HistoryId: Byte);
+var
+  Control: PView;
+  R: TRect;
+  Opt: Word;
+begin
+  R.Assign(15,1,64,20);
+  TDialog.Init(R, ATitle);
+  Options := Options or ofCentered;
+  WildCard := AWildCard;
+
+  R.Assign(3,3,31,4);
+  FileName := New(PFileInputLine, Init(R, 79));
+  FileName^.GrowMode:=gfGrowHiX;
+  FileName^.Data^ := WildCard;
+  Insert(FileName);
+  R.Assign(2,2,3+CStrLen(InputName),3);
+  Control := New(PLabel, Init(R, InputName, FileName));
+  Insert(Control);
+  R.Assign(31,3,34,4);
+  FileHistory := New(PFileHistory, Init(R, FileName, HistoryId));
+  FileHistory^.GrowMode:=gfGrowHiX or gfGrowLoX;
+  Insert(FileHistory);
+
+  R.Assign(3,14,34,15);
+  Control := New(PScrollBar, Init(R));
+  Insert(Control);
+  R.Assign(3,6,34,14);
+  FileList := New(PFileList, Init(R, PScrollBar(Control)));
+  FileList^.GrowMode:=gfGrowHiX or gfGrowHiY;
+  Insert(FileList);
+  R.Assign(2,5,8,6);
+  Control := New(PLabel, Init(R, slFiles, FileList));
+  Insert(Control);
+
+  R.Assign(35,3,46,5);
+  Opt := bfDefault;
+  if AOptions and fdOpenButton <> 0 then
+  begin
+    Control:=New(PButton, Init(R,slOpen, cmFileOpen, Opt));
+    Control^.GrowMode:=gfGrowHiX or gfGrowLoX;
+    Insert(Control);
+    Opt := bfNormal;
+    Inc(R.A.Y,3); Inc(R.B.Y,3);
+  end;
+  if AOptions and fdOkButton <> 0 then
+  begin
+    Control:=New(PButton, Init(R,slOk, cmFileOpen, Opt));
+    Control^.GrowMode:=gfGrowHiX or gfGrowLoX;
+    Insert(Control);
+    Opt := bfNormal;
+    Inc(R.A.Y,3); Inc(R.B.Y,3);
+  end;
+  if AOptions and fdReplaceButton <> 0 then
+  begin
+    Control:=New(PButton, Init(R, slReplace,cmFileReplace, Opt));
+    Control^.GrowMode:=gfGrowHiX or gfGrowLoX;
+    Insert(Control);
+    Opt := bfNormal;
+    Inc(R.A.Y,3); Inc(R.B.Y,3);
+  end;
+  if AOptions and fdClearButton <> 0 then
+  begin
+    Control:=New(PButton, Init(R, slClear,cmFileClear, Opt));
+    Control^.GrowMode:=gfGrowHiX or gfGrowLoX;
+    Insert(Control);
+    Opt := bfNormal;
+    Inc(R.A.Y,3); Inc(R.B.Y,3);
+  end;
+  Control:=New(PButton, Init(R, slCancel, cmCancel, bfNormal));
+  Control^.GrowMode:=gfGrowHiX or gfGrowLoX;
+  Insert(Control);
+  Inc(R.A.Y,3); Inc(R.B.Y,3);
+  if AOptions and fdHelpButton <> 0 then
+  begin
+    //Insert(New(PButton, Init(R,slHelp,cmHelp, bfNormal)));
+    //Inc(R.A.Y,3); Inc(R.B.Y,3);
+  end;
+
+  R.Assign(1,16,48,18);
+  Control := New(PFileInfoPane, Init(R));
+  Control^.GrowMode:=gfGrowHiX or gfGrowHiY or gfGrowLoY;
+  Insert(Control);
+
+  SelectNext(False);
+
+  if AOptions and fdNoLoadDir = 0 then ReadDirectory;
+end;
+
+constructor TFileDialog.Load(var S: TStream);
+begin
+  if not TDialog.Load(S) then
+    Fail;
+  S.Read(WildCard, SizeOf(WildCard));
+  if (S.Status <> stOk) then
+  begin
+    TDialog.Done;
+    Fail;
+  end;
+  GetSubViewPtr(S, FileName);
+  GetSubViewPtr(S, FileList);
+  GetSubViewPtr(S, FileHistory);
+  ReadDirectory;
+  if (DosError <> 0) then
+  begin
+    TDialog.Done;
+    Fail;
+  end;
+end;
+
+destructor TFileDialog.Done;
+begin
+  DisposeStr(Directory);
+  TDialog.Done;
+end;
+
+procedure TFileDialog.GetData(var Rec);
+begin
+  GetFilename(PathStr(Rec));
+end;
+
+procedure TFileDialog.GetFileName(var S: PathStr);
+
+var
+  Path: PathStr;
+  Name: NameStr;
+  Ext: ExtStr;
+  TWild : string;
+  TPath: PathStr;
+  TName: NameStr;
+  TExt: NameStr;
+  i : Sw_integer;
+begin
+  S := FileName^.Data^;
+  if RelativePath(S) then
+    begin
+      if (Directory <> nil) then
+   S := FExpand(Directory^ + S);
+    end
+  else
+    S := FExpand(S);
+  if Pos(ListSeparator,S)=0 then
+   begin
+     If FileExists(S) then
+       exit;
+     FSplit(S, Path, Name, Ext);
+     if ((Name = '') or (Ext = '')) and not IsDir(S) then
+     begin
+       TWild:=WildCard;
+       repeat
+    i:=Pos(ListSeparator,TWild);
+    if i=0 then
+     i:=length(TWild)+1;
+    FSplit(Copy(TWild,1,i-1), TPath, TName, TExt);
+    if ((Name = '') and (Ext = '')) then
+      S := Path + TName + TExt
+    else
+      if Name = '' then
+        S := Path + TName + Ext
+      else
+        if Ext = '' then
+          begin
+       if IsWild(Name) then
+         S := Path + Name + TExt
+       else
+         S := Path + Name + NoWildChars(TExt);
+          end;
+    if FileExists(S) then
+     break;
+    System.Delete(TWild,1,i);
+       until TWild='';
+       if TWild='' then
+         S := Path + Name + Ext;
+     end;
+   end;
+end;
+
+procedure TFileDialog.HandleEvent(var Event: TEvent);
+begin
+  if (Event.What and evBroadcast <> 0) and
+     (Event.Command = cmListItemSelected) then
+  begin
+    EndModal(cmFileOpen);
+    ClearEvent(Event);
+  end;
+  TDialog.HandleEvent(Event);
+  if Event.What = evCommand then
+    case Event.Command of
+      cmFileOpen, cmFileReplace, cmFileClear:
+   begin
+     EndModal(Event.Command);
+     ClearEvent(Event);
+   end;
+    end;
+end;
+
+procedure TFileDialog.SetData(var Rec);
+begin
+  TDialog.SetData(Rec);
+  if (PathStr(Rec) <> '') and (IsWild(TWildStr(Rec))) then
+  begin
+    Valid(cmFileInit);
+    FileName^.Select;
+  end;
+end;
+
+procedure TFileDialog.ReadDirectory;
+begin
+  FileList^.ReadDirectory(WildCard);
+  FileHistory^.AdaptHistoryToDir(GetCurDir);
+  Directory := NewStr(GetCurDir);
+end;
+
+procedure TFileDialog.Store(var S: TStream);
+begin
+  TDialog.Store(S);
+  S.Write(WildCard, SizeOf(WildCard));
+  PutSubViewPtr(S, FileName);
+  PutSubViewPtr(S, FileList);
+  PutSubViewPtr(S, FileHistory);
+end;
+
+function TFileDialog.Valid(Command: Word): Boolean;
+var
+  FName: PathStr;
+  Dir: DirStr;
+  Name: NameStr;
+  Ext: ExtStr;
+
+  function CheckDirectory(var S: PathStr): Boolean;
+  begin
+    if not PathValid(S) then
+    begin
+      MessageBox(sInvalidDriveOrDir, nil, mfError + mfOkButton);
+      FileName^.Select;
+      CheckDirectory := False;
+    end else CheckDirectory := True;
+  end;
+
+  function CompleteDir(const Path: string): string;
+  begin
+    { keep c: untouched PM }
+    if (Path<>'') and (Path[Length(Path)]<>DirSeparator) and
+       (Path[Length(Path)]<>':') then
+     CompleteDir:=Path+DirSeparator
+    else
+     CompleteDir:=Path;
+  end;
+
+  function NormalizeDir(const Path: string): string;
+  var Root: boolean;
+  begin
+    Root:=false;
+    {$ifdef Unix}
+    if Path=DirSeparator then Root:=true;
+    {$else}
+    {$ifdef HASAMIGA}
+    if Length(Path) > 0 then Root := Path[Length(Path)] = DriveSeparator;
+    {$else}
+    if (length(Path)=3) and (Upcase(Path[1]) in['A'..'Z']) and
+       (Path[2]=':') and (Path[3]=DirSeparator) then
+         Root:=true;
+    {$endif}
+    {$endif}
+    if (Root=false) and (copy(Path,length(Path),1)=DirSeparator) then
+      NormalizeDir:=copy(Path,1,length(Path)-1)
+    else
+      NormalizeDir:=Path;
+  end;
+function NormalizeDirF(var S: openstring): boolean;
+begin
+  S:=NormalizeDir(S);
+  NormalizeDirF:=true;
+end;
+
+begin
+  if Command = 0 then
+  begin
+    Valid := True;
+    Exit;
+  end
+  else Valid := False;
+  if TDialog.Valid(Command) then
+  begin
+    GetFileName(FName);
+    if (Command <> cmCancel) and (Command <> cmFileClear) then
+    begin
+      if IsWild(FName) or IsList(FName) then
+      begin
+        FSplit(FName, Dir, Name, Ext);
+        if CheckDirectory(Dir) then
+        begin
+          FileHistory^.AdaptHistoryToDir(Dir);
+          DisposeStr(Directory);
+          Directory := NewStr(Dir);
+          if Pos(ListSeparator,FName)>0 then
+           WildCard:=Copy(FName,length(Dir)+1,255)
+          else
+           WildCard := Name+Ext;
+          if Command <> cmFileInit then
+            FileList^.Select;
+          FileList^.ReadDirectory(Directory^+WildCard);
+        end;
+      end
+    else
+      if NormalizeDirF(FName) then
+      { ^^ this is just a dummy if construct (the func always returns true,
+        it's just there, 'coz I don't want to rearrange the following "if"s... }
+      if IsDir(FName) then
+        begin
+          if CheckDirectory(FName) then
+          begin
+            FileHistory^.AdaptHistoryToDir(CompleteDir(FName));
+            DisposeStr(Directory);
+            Directory := NewSTr(CompleteDir(FName));
+            if Command <> cmFileInit then FileList^.Select;
+            FileList^.ReadDirectory(Directory^+WildCard);
+          end
+        end
+      else
+        if ValidFileName(FName) then
+          Valid := True
+        else
+          begin
+            MessageBox(^C + sInvalidFileName, nil, mfError + mfOkButton);
+            Valid := False;
+          end;
+    end
+    else Valid := True;
+  end;
+end;
+
+{ TDirCollection }
+
+function TDirCollection.GetItem(var S: TStream): Pointer;
+var
+  DirItem: PDirEntry;
+begin
+  New(DirItem);
+  DirItem^.DisplayText := S.ReadStr;
+  DirItem^.Directory := S.ReadStr;
+  GetItem := DirItem;
+end;
+
+procedure TDirCollection.FreeItem(Item: Pointer);
+var
+  DirItem: PDirEntry absolute Item;
+begin
+  DisposeStr(DirItem^.DisplayText);
+  DisposeStr(DirItem^.Directory);
+  Dispose(DirItem);
+end;
+
+procedure TDirCollection.PutItem(var S: TStream; Item: Pointer);
+var
+  DirItem: PDirEntry absolute Item;
+begin
+  S.WriteStr(DirItem^.DisplayText);
+  S.WriteStr(DirItem^.Directory);
+end;
+
+{ TDirListBox }
+
+const
+  DrivesS: String = '';
+  Drives: PString = @DrivesS;
+
+constructor TDirListBox.Init(var Bounds: TRect; AScrollBar:
+  PScrollBar);
+begin
+  DrivesS := sDrives;
+  TListBox.Init(Bounds, 1, AScrollBar);
+  Dir := '';
+end;
+
+destructor TDirListBox.Done;
+begin
+  if (List <> nil) then
+    Dispose(List,Done);
+  TListBox.Done;
+end;
+
+function TDirListBox.GetText(Item,MaxLen: Sw_Integer): String;
+begin
+  GetText := PDirEntry(List^.At(Item))^.DisplayText^;
+end;
+
+procedure TDirListBox.HandleEvent(var Event: TEvent);
+begin
+  case Event.What of
+    evMouseDown:
+      if Event.Double then
+      begin
+   Event.What := evCommand;
+   Event.Command := cmChangeDir;
+   PutEvent(Event);
+   ClearEvent(Event);
+      end;
+    evKeyboard:
+      if (Event.CharCode = ' ') and
+    (PSearchRec(List^.At(Focused))^.Name = '..') then
+   NewDirectory(PSearchRec(List^.At(Focused))^.Name);
+  end;
+  TListBox.HandleEvent(Event);
+end;
+
+function TDirListBox.IsSelected(Item: Sw_Integer): Boolean;
+begin
+{  IsSelected := Item = Cur; }
+  IsSelected := Inherited IsSelected(Item);
+end;
+
+procedure TDirListBox.NewDirectory(var ADir: DirStr);
+{$ifdef FV_UNICODE}
+const
+  PathDir       = #$2514#$2500#$252C;
+  FirstDir     =   #$2514#$252C#$2500;
+  MiddleDir   =   ' '#$251C#$2500;
+  LastDir       =   ' '#$2514#$2500;
+  IndentSize    = '  ';
+{$else FV_UNICODE}
+const
+  PathDir       = #192#196#194;
+  FirstDir     =   #192#194#196;
+  MiddleDir   =   ' '#195#196;
+  LastDir       =   ' '#192#196;
+  IndentSize    = '  ';
+{$endif FV_UNICODE}
+var
+  AList: PCollection;
+  NewDir, Dirct: DirStr;
+  C, OldC: AnsiChar;
+  S, Indent: String[80];
+  P: PString;
+  NewCur: Word;
+  isFirst: Boolean;
+  SR: SearchRec;
+  I: Sw_Integer;
+
+  function NewDirEntry(const DisplayText, Directory: String): PDirEntry;{$ifdef PPC_BP}near;{$endif}
+  var
+    DirEntry: PDirEntry;
+  begin
+    New(DirEntry);
+    DirEntry^.DisplayText := NewStr(DisplayText);
+    If Directory='' then
+      DirEntry^.Directory := NewStr(DirSeparator)
+    else
+      DirEntry^.Directory := NewStr(Directory);
+    NewDirEntry := DirEntry;
+  end;
+
+begin
+  Dir := ADir;
+  AList := New(PDirCollection, Init(5,5));
+{$ifdef HAS_DOS_DRIVES}
+  AList^.Insert(NewDirEntry(Drives^,Drives^));
+  if Dir = Drives^ then
+  begin
+    isFirst := True;
+    OldC := ' ';
+    for C := 'A' to 'Z' do
+    begin
+      if (C < 'C') or DriveValid(C) then
+      begin
+   if OldC <> ' ' then
+   begin
+     if isFirst then
+     begin
+       S := FirstDir + OldC;
+       isFirst := False;
+     end
+     else S := MiddleDir + OldC;
+     AList^.Insert(NewDirEntry(S, OldC + ':' + DirSeparator));
+   end;
+   if C = GetCurDrive then NewCur := AList^.Count;
+   OldC := C;
+      end;
+    end;
+    if OldC <> ' ' then
+      AList^.Insert(NewDirEntry(LastDir + OldC, OldC + ':' + DirSeparator));
+  end
+  else
+{$endif HAS_DOS_DRIVES}
+  begin
+    Indent := IndentSize;
+    NewDir := Dir;
+{$ifdef HAS_DOS_DRIVES}
+    Dirct := Copy(NewDir,1,3);
+    AList^.Insert(NewDirEntry(PathDir + Dirct, Dirct));
+    NewDir := Copy(NewDir,4,255);
+{$else HAS_DOS_DRIVES}
+    Dirct := '';
+{$endif HAS_DOS_DRIVES}
+    while NewDir <> '' do
+    begin
+      I := Pos(DirSeparator,NewDir);
+      if I <> 0 then
+      begin
+   S := Copy(NewDir,1,I-1);
+   Dirct := Dirct + S;
+   AList^.Insert(NewDirEntry(Indent + PathDir + S, Dirct));
+   NewDir := Copy(NewDir,I+1,255);
+      end
+      else
+      begin
+   Dirct := Dirct + NewDir;
+   AList^.Insert(NewDirEntry(Indent + PathDir + NewDir, Dirct));
+   NewDir := '';
+      end;
+      Indent := Indent + IndentSize;
+      Dirct := Dirct + DirSeparator;
+    end;
+    NewCur := AList^.Count-1;
+    isFirst := True;
+    NewDir := Dirct + AllFiles;
+    FindFirst(NewDir, Directory, SR);
+    while DosError = 0 do
+    begin
+      if (SR.Attr and Directory <> 0) and
+         (SR.Name <> '.') and (SR.Name <> '..') then
+      begin
+   if isFirst then
+   begin
+     S := FirstDir;
+     isFirst := False;
+   end else S := MiddleDir;
+   AList^.Insert(NewDirEntry(Indent + S + SR.Name, Dirct + SR.Name));
+      end;
+      FindNext(SR);
+    end;
+  FindClose(SR);
+    P := PDirEntry(AList^.At(AList^.Count-1))^.DisplayText;
+{$ifdef FV_UNICODE}
+    I := Pos(#$2514,P^);
+    if I = 0 then
+    begin
+      I := Pos(#$251C,P^);
+      if I <> 0 then P^[I] := #$2514;
+    end else
+    begin
+      P^[I+1] := #$2500;
+      P^[I+2] := #$2500;
+    end;
+{$else FV_UNICODE}
+    I := Pos(#192,P^);
+    if I = 0 then
+    begin
+      I := Pos(#195,P^);
+      if I <> 0 then P^[I] := #192;
+    end else
+    begin
+      P^[I+1] := #196;
+      P^[I+2] := #196;
+    end;
+{$endif FV_UNICODE}
+  end;
+  NewList(AList);
+  FocusItem(NewCur);
+  Cur:=NewCur;
+end;
+
+procedure TDirListBox.SetState(AState: Word; Enable: Boolean);
+begin
+  TListBox.SetState(AState, Enable);
+  if AState and sfFocused <> 0 then
+    PChDirDialog(Owner)^.ChDirButton^.MakeDefault(Enable);
+end;
+
+{****************************************************************************}
+{ TChDirDialog Object                     }
+{****************************************************************************}
+{****************************************************************************}
+{ TChDirDialog.Init                      }
+{****************************************************************************}
+constructor TChDirDialog.Init(AOptions: Word; HistoryId: Sw_Word);
+var
+  R: TRect;
+  Control: PView;
+begin
+  R.Assign(16, 2, 64, 20);
+  TDialog.Init(R,sChangeDirectory);
+
+  Options := Options or ofCentered;
+
+  R.Assign(3, 3, 30, 4);
+  DirInput := New(PInputLine, Init(R, FileNameLen+4));
+  DirInput^.GrowMode:=gfGrowHiX;
+  Insert(DirInput);
+  R.Assign(2, 2, 17, 3);
+  Control := New(PLabel, Init(R,slDirectoryName, DirInput));
+  Insert(Control);
+  R.Assign(30, 3, 33, 4);
+  Control := New(PHistory, Init(R, DirInput, HistoryId));
+  Control^.GrowMode:=gfGrowHiX or gfGrowLoX;
+  Insert(Control);
+
+  R.Assign(32, 6, 33, 16);
+  Control := New(PScrollBar, Init(R));
+  Insert(Control);
+  R.Assign(3, 6, 32, 16);
+  DirList := New(PDirListBox, Init(R, PScrollBar(Control)));
+  DirList^.GrowMode:=gfGrowHiX or gfGrowHiY;
+  Insert(DirList);
+  R.Assign(2, 5, 17, 6);
+  Control := New(PLabel, Init(R, slDirectoryTree, DirList));
+  Insert(Control);
+
+  R.Assign(35, 6, 45, 8);
+  OkButton := New(PButton, Init(R, slOk, cmOK, bfDefault));
+  OkButton^.GrowMode:=gfGrowHiX or gfGrowLoX;
+  Insert(OkButton);
+  Inc(R.A.Y,3); Inc(R.B.Y,3);
+  ChDirButton := New(PButton,Init(R,slChDir,cmChangeDir,
+           bfNormal));
+  ChDirButton^.GrowMode:=gfGrowHiX or gfGrowLoX;
+  Insert(ChDirButton);
+  Inc(R.A.Y,3); Inc(R.B.Y,3);
+  Control := New(PButton, Init(R,slRevert, cmRevert, bfNormal));
+  Control^.GrowMode:=gfGrowHiX or gfGrowLoX;
+  Insert(Control);
+  if AOptions and cdHelpButton <> 0 then
+  begin
+    //Inc(R.A.Y,3); Inc(R.B.Y,3);
+    //Insert(New(PButton, Init(R,slHelp, cmHelp, bfNormal)));
+  end;
+
+  if AOptions and cdNoLoadDir = 0 then SetUpDialog;
+
+  SelectNext(False);
+end;
+
+{****************************************************************************}
+{ TChDirDialog.Load                      }
+{****************************************************************************}
+constructor TChDirDialog.Load(var S: TStream);
+begin
+  TDialog.Load(S);
+  GetSubViewPtr(S, DirList);
+  GetSubViewPtr(S, DirInput);
+  GetSubViewPtr(S, OkButton);
+  GetSubViewPtr(S, ChDirbutton);
+  SetUpDialog;
+end;
+
+{****************************************************************************}
+{ TChDirDialog.DataSize                      }
+{****************************************************************************}
+function TChDirDialog.DataSize: Sw_Word;
+begin
+  DataSize := 0;
+end;
+
+{****************************************************************************}
+{ TChDirDialog.GetData                        }
+{****************************************************************************}
+procedure TChDirDialog.GetData(var Rec);
+begin
+end;
+
+{****************************************************************************}
+{ TChDirDialog.HandleEvent                   }
+{****************************************************************************}
+procedure TChDirDialog.HandleEvent(var Event: TEvent);
+var
+  CurDir: DirStr;
+  P: PDirEntry;
+begin
+  TDialog.HandleEvent(Event);
+  case Event.What of
+    evCommand:
+      begin
+   case Event.Command of
+     cmRevert: GetDir(0,CurDir);
+     cmChangeDir:
+       begin
+         P := DirList^.List^.At(DirList^.Focused);
+         if (P^.Directory^ = Drives^)
+            or DriveValid(P^.Directory^[1]) then
+           CurDir := P^.Directory^
+         else Exit;
+       end;
+   else
+     Exit;
+   end;
+   if (Length(CurDir) > 3) and
+      (CurDir[Length(CurDir)] = DirSeparator) then
+     CurDir := Copy(CurDir,1,Length(CurDir)-1);
+   DirList^.NewDirectory(CurDir);
+   DirInput^.Data^ := CurDir;
+   DirInput^.DrawView;
+   DirList^.Select;
+   ClearEvent(Event);
+      end;
+  end;
+end;
+
+{****************************************************************************}
+{ TChDirDialog.SetData                        }
+{****************************************************************************}
+procedure TChDirDialog.SetData(var Rec);
+begin
+end;
+
+{****************************************************************************}
+{ TChDirDialog.SetUpDialog                   }
+{****************************************************************************}
+procedure TChDirDialog.SetUpDialog;
+var
+  CurDir: DirStr;
+begin
+  if DirList <> nil then
+  begin
+    CurDir := GetCurDir;
+    DirList^.NewDirectory(CurDir);
+    if (Length(CurDir) > 3) and (CurDir[Length(CurDir)] = DirSeparator) then
+      CurDir := Copy(CurDir,1,Length(CurDir)-1);
+    if DirInput <> nil then
+    begin
+      DirInput^.Data^ := CurDir;
+      DirInput^.DrawView;
+    end;
+  end;
+end;
+
+{****************************************************************************}
+{ TChDirDialog.Store                    }
+{****************************************************************************}
+procedure TChDirDialog.Store(var S: TStream);
+begin
+  TDialog.Store(S);
+  PutSubViewPtr(S, DirList);
+  PutSubViewPtr(S, DirInput);
+  PutSubViewPtr(S, OkButton);
+  PutSubViewPtr(S, ChDirButton);
+end;
+
+{****************************************************************************}
+{ TChDirDialog.Valid                    }
+{****************************************************************************}
+function TChDirDialog.Valid(Command: Word): Boolean;
+var
+  P: PathStr;
+begin
+  Valid := True;
+  if Command = cmOk then
+  begin
+    P := FExpand(DirInput^.Data^);
+    if (Length(P) > 3) and (P[Length(P)] = DirSeparator) then
+      Dec(P[0]);
+    {$push}{$I-}
+    ChDir(P);
+    if (IOResult <> 0) then
+    begin
+      MessageBox(sInvalidDirectory, nil, mfError + mfOkButton);
+      Valid := False;
+    end;
+    {$pop}
+  end;
+end;
+
+{****************************************************************************}
+{ TEditChDirDialog Object                     }
+{****************************************************************************}
+{****************************************************************************}
+{ TEditChDirDialog.DataSize                    }
+{****************************************************************************}
+function TEditChDirDialog.DataSize : Sw_Word;
+begin
+  DataSize := SizeOf(DirStr);
+end;
+
+{****************************************************************************}
+{ TEditChDirDialog.GetData                   }
+{****************************************************************************}
+procedure TEditChDirDialog.GetData (var Rec);
+var
+  CurDir : DirStr absolute Rec;
+begin
+  if (DirInput = nil) then
+    CurDir := ''
+  else begin
+    CurDir := DirInput^.Data^;
+    
+    if (CurDir[Length(CurDir)] <> DirSeparator) 
+    {$IFDEF HASAMIGA}
+      and (CurDir[Length(CurDir)] <> DriveSeparator) 
+    {$endif}
+    then
+      CurDir := CurDir + DirSeparator;
+  end;
+end;
+
+{****************************************************************************}
+{ TEditChDirDialog.SetData                   }
+{****************************************************************************}
+procedure TEditChDirDialog.SetData (var Rec);
+var
+  CurDir : DirStr absolute Rec;
+begin
+  if DirList <> nil then
+  begin
+    DirList^.NewDirectory(CurDir);
+    if DirInput <> nil then
+    begin
+      if (Length(CurDir) > 3) and (CurDir[Length(CurDir)] = DirSeparator) then
+   DirInput^.Data^ := Copy(CurDir,1,Length(CurDir)-1)
+      else DirInput^.Data^ := CurDir;
+      DirInput^.DrawView;
+    end;
+  end;
+end;
+
+{****************************************************************************}
+{ TSortedListBox Object                      }
+{****************************************************************************}
+{****************************************************************************}
+{ TSortedListBox.Init                     }
+{****************************************************************************}
+constructor TSortedListBox.Init(var Bounds: TRect; ANumCols: Sw_Word;
+  AScrollBar: PScrollBar);
+begin
+  TListBox.Init(Bounds, ANumCols, AScrollBar);
+  SearchPos := 0;
+  ShowCursor;
+  SetCursor(1,0);
+end;
+
+{****************************************************************************}
+{ TSortedListBox.HandleEvent                  }
+{****************************************************************************}
+procedure TSortedListBox.HandleEvent(var Event: TEvent);
+const
+  SpecialChars: set of AnsiChar = [#0,#9,#27];
+var
+  CurString, NewString: String;
+  K: Pointer;
+  Value : Sw_integer;
+  OldPos, OldValue: Sw_Integer;
+  T: Boolean;
+begin
+  OldValue := Focused;
+  TListBox.HandleEvent(Event);
+  if (OldValue <> Focused) or
+     ((Event.What = evBroadcast) and (Event.InfoPtr = @Self) and
+      (Event.Command = cmReleasedFocus)) then
+    SearchPos := 0;
+  if Event.What = evKeyDown then
+  begin
+    { patched to prevent error when no or empty list or Escape pressed }
+    if (not (Event.CharCode in SpecialChars)) and
+       (List <> nil) and (List^.Count > 0) then
+    begin
+      Value := Focused;
+      if Value < Range then
+        CurString := GetText(Value, 255)
+      else
+        CurString := '';
+      OldPos := SearchPos;
+      if Event.KeyCode = kbBack then
+      begin
+   if SearchPos = 0 then Exit;
+   Dec(SearchPos);
+          if SearchPos = 0 then
+            HandleDir:= ((GetShiftState and $3) <> 0) or (Event.CharCode in ['A'..'Z']);
+          SetLength(CurString,SearchPos);
+      end
+      else if (Event.CharCode = '.') then
+        SearchPos := Pos('.',CurString)
+      else
+      begin
+   Inc(SearchPos);
+          if SearchPos = 1 then
+            HandleDir := ((GetShiftState and 3) <> 0) or (Event.CharCode in ['A'..'Z']);
+          SetLength(CurString,SearchPos);
+   CurString[SearchPos] := Event.CharCode;
+      end;
+      K := GetKey(CurString);
+      T := PSortedCollection(List)^.Search(K, Value);
+      if Value < Range then
+      begin
+          if Value < Range then
+            NewString := GetText(Value, 255)
+          else
+            NewString := '';
+   if Equal(NewString, CurString, SearchPos) then
+   begin
+     if Value <> OldValue then
+     begin
+       FocusItem(Value);
+       { Assumes ListControl will set the cursor to the first character }
+       { of the sfFocused item }
+       SetCursor(Cursor.X+SearchPos, Cursor.Y);
+     end
+              else
+                SetCursor(Cursor.X+(SearchPos-OldPos), Cursor.Y);
+   end
+          else
+            SearchPos := OldPos;
+      end
+      else SearchPos := OldPos;
+      if (SearchPos <> OldPos) or (Event.CharCode in ['A'..'Z','a'..'z']) then
+   ClearEvent(Event);
+    end;
+  end;
+end;
+
+function TSortedListBox.GetKey(var S: String): Pointer;
+begin
+  GetKey := @S;
+end;
+
+procedure TSortedListBox.NewList(AList: PCollection);
+begin
+  TListBox.NewList(AList);
+  SearchPos := 0;
+end;
+
+{****************************************************************************}
+{            Global Procedures and Functions          }
+{****************************************************************************}
+
+{****************************************************************************}
+{ Contains                          }
+{****************************************************************************}
+function Contains(S1, S2: String): Boolean;
+  { Contains returns true if S1 contains any characters in S2. }
+var
+  i : Byte;
+begin
+  Contains := True;
+  i := 1;
+  while ((i < Length(S2)) and (i < Length(S1))) do
+    if (Upcase(S1[i]) = Upcase(S2[i])) then
+      Exit
+    else Inc(i);
+  Contains := False;
+end;
+
+{****************************************************************************}
+{ StdDeleteFile                           }
+{****************************************************************************}
+function StdDeleteFile (AFile : FNameStr) : Boolean;
+var
+  Rec : PStringRec;
+begin
+  if CheckOnDelete then
+  begin
+    AFile := ShrinkPath(AFile,33);
+    Rec.AString := PString(@AFile);
+    StdDeleteFile := (MessageBox(^C + sDeleteFile,
+               @Rec,mfConfirmation or mfOkCancel) = cmOk);
+  end
+  else StdDeleteFile := False;
+end;
+
+{****************************************************************************}
+{ DriveValid                         }
+{****************************************************************************}
+function DriveValid(Drive: AnsiChar): Boolean;
+{$ifdef HAS_DOS_DRIVES}
+var
+  D: AnsiChar;
+begin
+  D := GetCurDrive;
+  {$push}{$I-}
+  ChDir(Drive+':');
+  if (IOResult = 0) then
+  begin
+    DriveValid := True;
+    ChDir(D+':')
+  end
+  else DriveValid := False;
+  {$pop}
+end;
+{$else HAS_DOS_DRIVES}
+begin
+  DriveValid:=true;
+end;
+{$endif HAS_DOS_DRIVES}
+
+{****************************************************************************}
+{ Equal                             }
+{****************************************************************************}
+function Equal(const S1, S2: String; Count: Sw_word): Boolean;
+var
+  i: Sw_Word;
+begin
+  Equal := False;
+  if (Length(S1) < Count) or (Length(S2) < Count) then
+    Exit;
+  for i := 1 to Count do
+    if UpCase(S1[I]) <> UpCase(S2[I]) then
+      Exit;
+  Equal := True;
+end;
+
+{****************************************************************************}
+{ ExtractDir                         }
+{****************************************************************************}
+function ExtractDir(AFile: FNameStr): DirStr;
+  { ExtractDir returns the path of AFile terminated with a trailing '\'.  If
+    AFile contains no directory information, an empty string is returned. }
+var
+  D: DirStr;
+  N: NameStr;
+  E: ExtStr;
+begin
+  FSplit(AFile,D,N,E);
+  if D = '' then
+  begin
+    ExtractDir := '';
+    Exit;
+  end;
+  if (D[Length(D)] <> DirSeparator)
+  {$ifdef HASAMIGA}
+    and (D[Length(D)] <> DriveSeparator)
+  {$endif}
+  then
+    D := D + DirSeparator;
+  ExtractDir := D;
+end;
+
+{****************************************************************************}
+{ ExtractFileName                       }
+{****************************************************************************}
+function ExtractFileName(AFile: FNameStr): NameStr;
+var
+  D: DirStr;
+  N: NameStr;
+  E: ExtStr;
+begin
+  FSplit(AFile,D,N,E);
+  ExtractFileName := N;
+end;
+
+{****************************************************************************}
+{ FileExists                         }
+{****************************************************************************}
+function FileExists (AFile : FNameStr) : Boolean;
+begin
+  FileExists := (FSearch(AFile,'') <> '');
+end;
+
+{****************************************************************************}
+{ GetCurDir                        }
+{****************************************************************************}
+function GetCurDir: DirStr;
+var
+  CurDir: DirStr;
+begin
+  GetDir(0, CurDir);
+  if (Length(CurDir) > 3) then
+  begin
+    SetLength(CurDir,Length(CurDir)+1);
+    CurDir[Length(CurDir)] := DirSeparator;
+  end;
+  GetCurDir := CurDir;
+end;
+
+{****************************************************************************}
+{ GetCurDrive                       }
+{****************************************************************************}
+function GetCurDrive: AnsiChar;
+{$ifdef go32v2}
+var
+  Regs : Registers;
+begin
+  Regs.AH := $19;
+  Intr($21,Regs);
+  GetCurDrive := AnsiChar(Regs.AL + Byte('A'));
+end;
+{$else not go32v2}
+var
+  D : DirStr;
+begin
+  D:=GetCurDir;
+  if (Length(D)>1) and (D[2]=':') then
+    begin
+      if (D[1]>='a') and (D[1]<='z') then
+        GetCurDrive:=AnsiChar(Byte(D[1])+Byte('A')-Byte('a'))
+      else
+        GetCurDrive:=D[1];
+    end
+  else
+    GetCurDrive:='C';
+end;
+{$endif not go32v2}
+
+{****************************************************************************}
+{ IsDir                             }
+{****************************************************************************}
+function IsDir(const S: String): Boolean;
+var
+  SR: SearchRec;
+begin
+  Result:=false;
+{$ifdef Unix}
+  Result:=(S=DirSeparator); { handle root }
+{$else}
+  {$ifdef HASAMIGA}
+  Result := (Length(S) > 0) and (S[Length(S)] = DriveSeparator);
+  {$else}
+  Result:=(length(S)=3) and (Upcase(S[1]) in['A'..'Z']) and (S[2]=':') and (S[3]=DirSeparator);
+  {$endif}
+  { handle root dirs }
+{$endif}
+  if Result=false then
+  begin
+    FindFirst(S, Directory, SR);
+    if DosError = 0 then
+      Result := (SR.Attr and Directory) <> 0
+    else
+      Result := False;
+   {$ifdef fpc}
+    FindClose(SR);
+   {$endif}
+  end;
+end;
+
+{****************************************************************************}
+{ IsWild                           }
+{****************************************************************************}
+function IsWild(const S: String): Boolean;
+begin
+  IsWild := (Pos('?',S) > 0) or (Pos('*',S) > 0);
+end;
+
+{****************************************************************************}
+{ IsList                           }
+{****************************************************************************}
+function IsList(const S: String): Boolean;
+begin
+  IsList := (Pos(ListSeparator,S) > 0);
+end;
+
+{****************************************************************************}
+{ MakeResources                           }
+{****************************************************************************}
+(*
+procedure MakeResources;
+var
+  Dlg : PDialog;
+  Key : String;
+  i : Word;
+begin
+  for i := 0 to 1 do
+  begin
+    case i of
+      0 : begin
+       Key := reOpenDlg;
+       Dlg := New(PFileDialog,Init('*.*',sOpen,slName,
+             fdOkButton or fdHelpButton or fdNoLoadDir,0));
+     end;
+      1 : begin
+       Key := reSaveAsDlg;
+       Dlg := New(PFileDialog,Init('*.*',sSaveAs,slName,
+             fdOkButton or fdHelpButton or fdNoLoadDir,0));
+     end;
+      2 : begin
+       Key := reEditChDirDialog;
+       Dlg := New(PEditChDirDialog,Init(cdHelpButton,
+             hiCurrentDirectories));
+     end;
+    end;
+    if Dlg = nil then
+    begin
+       PrintStr('Error initializing dialog ' + Key);
+       Halt;
+    end
+    else begin
+      RezFile^.Put(Dlg,Key);
+      if (RezFile^.Stream^.Status <> stOk) then
+      begin
+   PrintStr('Error writing dialog ' + Key + ' to the resource file.');
+   Halt;
+      end;
+    end;
+  end;
+end;
+*)
+{****************************************************************************}
+{ NoWildChars                       }
+{****************************************************************************}
+function NoWildChars(S: String): String;
+const
+  WildChars : array[0..1] of AnsiChar = ('?','*');
+var
+  i : Sw_Word;
+begin
+  repeat
+    i := Pos('?',S);
+    if (i > 0) then
+      System.Delete(S,i,1);
+  until (i = 0);
+  repeat
+    i := Pos('*',S);
+    if (i > 0) then
+      System.Delete(S,i,1);
+  until (i = 0);
+  NoWildChars:=S;
+end;
+
+{****************************************************************************}
+{ OpenFile                          }
+{****************************************************************************}
+function OpenFile (var AFile : FNameStr; HistoryID : Byte) : Boolean;
+var
+  Dlg : PFileDialog;
+begin
+  {$ifdef cdResource}
+  Dlg := PFileDialog(RezFile^.Get(reOpenDlg));
+  {$else}
+  Dlg := New(PFileDialog,Init('*.*',sOpen,slName,
+        fdOkButton or fdHelpButton,0));
+  {$endif cdResource}
+    { this might not work }
+  PHistory(Dlg^.FileName^.Next^.Next)^.HistoryID := HistoryID;
+  OpenFile := (Application^.ExecuteDialog(Dlg,@AFile) = cmFileOpen);
+end;
+
+{****************************************************************************}
+{ OpenNewFile                       }
+{****************************************************************************}
+function OpenNewFile (var AFile: FNameStr; HistoryID: Byte): Boolean;
+  { OpenNewFile allows the user to select a directory from disk and enter a
+    new file name.  If the file name entered is an existing file the user is
+    optionally prompted for confirmation of replacing the file based on the
+    value in #CheckOnReplace#.  If a file name is successfully entered,
+    OpenNewFile returns True. }
+  {#X OpenFile }
+begin
+  OpenNewFile := False;
+  if OpenFile(AFile,HistoryID) then
+  begin
+    if not ValidFileName(AFile) then
+      Exit;
+    if FileExists(AFile) then
+      if (not CheckOnReplace) or (not ReplaceFile(AFile)) then
+   Exit;
+    OpenNewFile := True;
+  end;
+end;
+
+{****************************************************************************}
+{ RegisterStdDlg                         }
+{****************************************************************************}
+procedure RegisterStdDlg;
+begin
+  RegisterType(RFileInputLine);
+  RegisterType(RFileCollection);
+  RegisterType(RFileList);
+  RegisterType(RFileInfoPane);
+  RegisterType(RFileDialog);
+  RegisterType(RDirCollection);
+  RegisterType(RDirListBox);
+  RegisterType(RSortedListBox);
+  RegisterType(RChDirDialog);
+end;
+
+{****************************************************************************}
+{ StdReplaceFile                         }
+{****************************************************************************}
+function StdReplaceFile (AFile : FNameStr) : Boolean;
+var
+  Rec : PStringRec;
+begin
+  if CheckOnReplace then
+  begin
+    AFile := ShrinkPath(AFile,33);
+    Rec.AString := PString(@AFile);
+    StdReplaceFile :=
+       (MessageBox(^C + sReplaceFile,
+         @Rec,mfConfirmation or mfOkCancel) = cmOk);
+  end
+  else StdReplaceFile := True;
+end;
+
+{****************************************************************************}
+{ SaveAs                           }
+{****************************************************************************}
+function SaveAs (var AFile : FNameStr; HistoryID : Word) : Boolean;
+var
+  Dlg : PFileDialog;
+begin
+  SaveAs := False;
+  Dlg := New(PFileDialog,Init('*.*',sSaveAs,slSaveAs,
+        fdOkButton or fdHelpButton,0));
+    { this might not work }
+  PHistory(Dlg^.FileName^.Next^.Next)^.HistoryID := HistoryID;
+  Dlg^.HelpCtx := hcSaveAs;
+  if (Application^.ExecuteDialog(Dlg,@AFile) = cmFileOpen) and
+     ((not FileExists(AFile)) or ReplaceFile(AFile)) then
+    SaveAs := True;
+end;
+
+{****************************************************************************}
+{ SelectDir                        }
+{****************************************************************************}
+function SelectDir (var ADir : DirStr; HistoryID : Byte) : Boolean;
+var
+  Dir: DirStr;
+  Dlg : PEditChDirDialog;
+  Rec : DirStr;
+begin
+  {$push}{$I-}
+  GetDir(0,Dir);
+  {$pop}
+  Rec := FExpand(ADir);
+  Dlg := New(PEditChDirDialog,Init(cdHelpButton,HistoryID));
+  if (Application^.ExecuteDialog(Dlg,@Rec) = cmOk) then
+  begin
+    SelectDir := True;
+    ADir := Rec;
+  end
+  else SelectDir := False;
+  {$push}{$I-}
+  ChDir(Dir);
+  {$pop}
+end;
+
+{****************************************************************************}
+{ ShrinkPath                         }
+{****************************************************************************}
+function ShrinkPath (AFile : FNameStr; MaxLen : Byte) : FNameStr;
+var
+  Filler: string;
+  D1 : DirStr;
+  N1 : NameStr;
+  E1 : ExtStr;
+  i  : Sw_Word;
+
+begin
+  if Length(AFile) > MaxLen then
+  begin
+    FSplit(FExpand(AFile),D1,N1,E1);
+    AFile := Copy(D1,1,3) + '..' + DirSeparator;
+    i := Pred(Length(D1));
+    while (i > 0) and (D1[i] <> DirSeparator) do
+      Dec(i);
+    if (i = 0) then
+      AFile := AFile + D1
+    else AFile := AFile + Copy(D1,Succ(i),Length(D1)-i);
+    if (AFile[Length(AFile)] <> DirSeparator)
+    {$ifdef HASAMIGA}
+      and (AFile[Length(AFile)] <> DriveSeparator)
+    {$endif}
+    then
+      AFile := AFile + DirSeparator;
+    if Length(AFile)+Length(N1)+Length(E1) <= MaxLen then
+      AFile := AFile + N1 + E1
+    else
+      begin
+        Filler := '...' + DirSeparator;
+        AFile:=Copy(Afile,1,MaxLen-Length(Filler)-Length(N1)-Length(E1))
+                +Filler+N1+E1;
+      end;
+  end;
+  ShrinkPath := AFile;
+end;
+
+{****************************************************************************}
+{ ValidFileName                           }
+{****************************************************************************}
+function ValidFileName(var FileName: PathStr): Boolean;
+var
+  IllegalChars: string[12];
+  Dir: DirStr;
+  Name: NameStr;
+  Ext: ExtStr;
+begin
+{$ifdef PPC_FPC}
+{$ifdef go32v2}
+  { spaces are allowed if LFN is supported }
+  if LFNSupport then
+    IllegalChars := ';,=+<>|"[]'+DirSeparator
+  else
+    IllegalChars := ';,=+<>|"[] '+DirSeparator;
+{$else not go32v2}
+{$ifdef OS_WINDOWS}
+    IllegalChars := ';,=+<>|"[]'+DirSeparator;
+{$else not go32v2 and not OS_WINDOWS }
+    IllegalChars := ';,=+<>|"[] '+DirSeparator;
+{$endif not OS_WINDOWS}
+{$endif not go32v2}
+{$else not PPC_FPC}
+  IllegalChars := ';,=+<>|"[] '+DirSeparator;
+{$endif PPC_FPC}
+  ValidFileName := True;
+  FSplit(FileName, Dir, Name, Ext);
+  if not ((Dir = '') or PathValid(Dir)) or
+     Contains(Name, IllegalChars) or
+     Contains(Dir, IllegalChars) then
+    ValidFileName := False;
+end;
+
+{****************************************************************************}
+{        Unit Initialization Section                                         }
+{****************************************************************************}
+begin
+{$ifdef PPC_BP}
+  ReplaceFile := StdReplaceFile;
+  DeleteFile := StdDeleteFile;
+{$else}
+  ReplaceFile := @StdReplaceFile;
+  DeleteFile := @StdDeleteFile;
+{$endif PPC_BP}
+end.

+ 1 - 2887
packages/fv/src/stddlg.pas

@@ -1,2887 +1 @@
-{*******************************************************}
-{ Free Vision Runtime Library                           }
-{ StdDlg Unit                                           }
-{ Version: 0.1.0                                        }
-{ Release Date: July 23, 1998                           }
-{                                                       }
-{*******************************************************}
-{                                                       }
-{ This unit is a port of Borland International's        }
-{ StdDlg.pas unit.  It is for distribution with the     }
-{ Free Pascal (FPK) Compiler as part of the 32-bit      }
-{ Free Vision library.  The unit is still fully         }
-{ functional under BP7 by using the tp compiler         }
-{ directive when rebuilding the library.                }
-{                                                       }
-{*******************************************************}
-
-{ Revision History
-
-1.1a   (97/12/29)
-  - fixed bug in TFileDialog.HandleEvent that prevented the user from being
-    able to have an action taken automatically when the FileList was
-    selected and kbEnter pressed
-
-1.1
-  - modified OpenNewFile to take a history list ID
-  - implemented OpenNewFile
-
-1.0   (1992)
-  - original implementation }
-
-{$IFNDEF FPC_DOTTEDUNITS}
-unit StdDlg;
-{$ENDIF FPC_DOTTEDUNITS}
-
-{
-  This unit has been modified to make some functions global, apply patches
-  from version 3.1 of the TVBUGS list, added TEditChDirDialog, and added
-  several new global functions and procedures.
-}
-
-{$i platform.inc}
-
-{$ifdef PPC_FPC}
-  {$H-}
-{$else}
-  {$F+,O+,E+,N+}
-{$endif}
-{$X+,R-,I-,Q-,V-}
-{$ifndef OS_UNIX}
-  {$S-}
-{$endif}
-{$ifdef OS_DOS}
-  {$define HAS_DOS_DRIVES}
-{$endif}
-{$ifdef OS_WINDOWS}
-  {$define HAS_DOS_DRIVES}
-{$endif}
-{$ifdef OS_OS2}
-  {$define HAS_DOS_DRIVES}
-{$endif}
-
-{2.0 compatibility}
-{$ifdef VER2_0}
-  {$macro on}
-  {$define resourcestring := const}
-{$endif}
-
-interface
-
-{$IFDEF FPC_DOTTEDUNITS}
-uses
-  FreeVision.Fvconsts, System.Objects, FreeVision.Drivers, FreeVision.Views, 
-  FreeVision.Dialogs, FreeVision.Validate, TP.DOS;
-{$ELSE FPC_DOTTEDUNITS}
-uses
-  FVConsts, Objects, Drivers, Views, Dialogs, Validate, Dos;
-{$ENDIF FPC_DOTTEDUNITS}
-
-const
-  MaxDir   = 255;   { Maximum length of a DirStr. }
-  MaxFName = 255; { Maximum length of a FNameStr. }
-
-  DirSeparator : AnsiChar = system.DirectorySeparator;
-
-{$ifdef Unix}
-  AllFiles = '*';
-{$else}
-  {$ifdef OS_AMIGA}
-    AllFiles = '*';
-  {$else}
-    AllFiles = '*.*';
-  {$endif}
-{$endif}
-
-type
-  { TSearchRec }
-
-  {  Record used to store directory information by TFileDialog
-     This is a part of Dos.Searchrec for Bp !! }
-
-  TSearchRec =
-{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
-  packed
-{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
-  record
-    Attr: Longint;
-    Time: Longint;
-    Size: Longint;
-    Name: string[MaxFName];
-  end;
-  PSearchRec = ^TSearchRec;
-
-type
-
-  { TFileInputLine is a special input line that is used by      }
-  { TFileDialog that will update its contents in response to a  }
-  { cmFileFocused command from a TFileList.          }
-
-  PFileInputLine = ^TFileInputLine;
-  TFileInputLine = object(TInputLine)
-    constructor Init(var Bounds: TRect; AMaxLen: Sw_Integer);
-    procedure HandleEvent(var Event: TEvent); virtual;
-  end;
-
-  { TFileCollection is a collection of TSearchRec's. }
-
-  PFileCollection = ^TFileCollection;
-  TFileCollection = object(TSortedCollection)
-    function Compare(Key1, Key2: Pointer): Sw_Integer; virtual;
-    procedure FreeItem(Item: Pointer); virtual;
-    function GetItem(var S: TStream): Pointer; virtual;
-    procedure PutItem(var S: TStream; Item: Pointer); virtual;
-  end;
-
-  {#Z+}
-  PFileValidator = ^TFileValidator;
-  {#Z-}
-  TFileValidator = Object(TValidator)
-  end;  { of TFileValidator }
-
-  { TSortedListBox is a TListBox that assumes it has a     }
-  { TStoredCollection instead of just a TCollection.  It will   }
-  { perform an incremental search on the contents.       }
-
-  PSortedListBox = ^TSortedListBox;
-  TSortedListBox = object(TListBox)
-    SearchPos: Byte;
-    {ShiftState: Byte;}
-    HandleDir : boolean;
-    constructor Init(var Bounds: TRect; ANumCols: Sw_Word;
-      AScrollBar: PScrollBar);
-    procedure HandleEvent(var Event: TEvent); virtual;
-    function GetKey(var S: String): Pointer; virtual;
-    procedure NewList(AList: PCollection); virtual;
-  end;
-
-  { TFileList is a TSortedList box that assumes it contains     }
-  { a TFileCollection as its collection.  It also communicates  }
-  { through broadcast messages to TFileInput and TInfoPane      }
-  { what file is currently selected.             }
-
-  PFileList = ^TFileList;
-  TFileList = object(TSortedListBox)
-    constructor Init(var Bounds: TRect; AScrollBar: PScrollBar);
-    destructor Done; virtual;
-    function DataSize: Sw_Word; virtual;
-    procedure FocusItem(Item: Sw_Integer); virtual;
-    procedure GetData(var Rec); virtual;
-    function GetText(Item,MaxLen: Sw_Integer): String; virtual;
-    function GetKey(var S: String): Pointer; virtual;
-    procedure HandleEvent(var Event: TEvent); virtual;
-    procedure ReadDirectory(AWildCard: PathStr);
-    procedure SetData(var Rec); virtual;
-  end;
-
-  { TFileInfoPane is a TView that displays the information      }
-  { about the currently selected file in the TFileList     }
-  { of a TFileDialog.                  }
-
-  PFileInfoPane = ^TFileInfoPane;
-  TFileInfoPane = object(TView)
-    S: TSearchRec;
-    constructor Init(var Bounds: TRect);
-    procedure Draw; virtual;
-    function GetPalette: PPalette; virtual;
-    procedure HandleEvent(var Event: TEvent); virtual;
-  end;
-
-  { TFileDialog is a standard file name input dialog      }
-
-  TWildStr = PathStr;
-
-const
-  fdOkButton      = $0001;      { Put an OK button in the dialog }
-  fdOpenButton    = $0002;      { Put an Open button in the dialog }
-  fdReplaceButton = $0004;      { Put a Replace button in the dialog }
-  fdClearButton   = $0008;      { Put a Clear button in the dialog }
-  fdHelpButton    = $0010;      { Put a Help button in the dialog }
-  fdNoLoadDir     = $0100;      { Do not load the current directory }
-            { contents into the dialog at Init. }
-            { This means you intend to change the }
-            { WildCard by using SetData or store }
-            { the dialog on a stream. }
-
-type
-
-  PFileHistory = ^TFileHistory;
-  TFileHistory = object(THistory)
-    CurDir : PString;
-    procedure HandleEvent(var Event: TEvent);virtual;
-    destructor Done; virtual;
-    procedure AdaptHistoryToDir(Dir : string);
-  end;
-
-  PFileDialog = ^TFileDialog;
-  TFileDialog = object(TDialog)
-    FileName: PFileInputLine;
-    FileList: PFileList;
-    FileHistory: PFileHistory;
-    WildCard: TWildStr;
-    Directory: PString;
-    constructor Init(AWildCard: TWildStr; const ATitle,
-      InputName: String; AOptions: Word; HistoryId: Byte);
-    constructor Load(var S: TStream);
-    destructor Done; virtual;
-    procedure GetData(var Rec); virtual;
-    procedure GetFileName(var S: PathStr);
-    procedure HandleEvent(var Event: TEvent); virtual;
-    procedure SetData(var Rec); virtual;
-    procedure Store(var S: TStream);
-    function Valid(Command: Word): Boolean; virtual;
-  private
-    procedure ReadDirectory;
-  end;
-
-  { TDirEntry }
-
-  PDirEntry = ^TDirEntry;
-  TDirEntry = record
-    DisplayText: PString;
-    Directory: PString;
-  end;  { of TDirEntry }
-
-  { TDirCollection is a collection of TDirEntry's used by       }
-  { TDirListBox.                 }
-
-  PDirCollection = ^TDirCollection;
-  TDirCollection = object(TCollection)
-    function GetItem(var S: TStream): Pointer; virtual;
-    procedure FreeItem(Item: Pointer); virtual;
-    procedure PutItem(var S: TStream; Item: Pointer); virtual;
-  end;
-
-  { TDirListBox displays a tree of directories for use in the }
-  { TChDirDialog.                    }
-
-  PDirListBox = ^TDirListBox;
-  TDirListBox = object(TListBox)
-    Dir: DirStr;
-    Cur: Word;
-    constructor Init(var Bounds: TRect; AScrollBar: PScrollBar);
-    destructor Done; virtual;
-    function GetText(Item,MaxLen: Sw_Integer): String; virtual;
-    procedure HandleEvent(var Event: TEvent); virtual;
-    function IsSelected(Item: Sw_Integer): Boolean; virtual;
-    procedure NewDirectory(var ADir: DirStr);
-    procedure SetState(AState: Word; Enable: Boolean); virtual;
-  end;
-
-  { TChDirDialog is a standard change directory dialog. }
-
-const
-  cdNormal     = $0000; { Option to use dialog immediately }
-  cdNoLoadDir  = $0001; { Option to init the dialog to store on a stream }
-  cdHelpButton = $0002; { Put a help button in the dialog }
-
-type
-
-  PChDirDialog = ^TChDirDialog;
-  TChDirDialog = object(TDialog)
-    DirInput: PInputLine;
-    DirList: PDirListBox;
-    OkButton: PButton;
-    ChDirButton: PButton;
-    constructor Init(AOptions: Word; HistoryId: Sw_Word);
-    constructor Load(var S: TStream);
-    function DataSize: Sw_Word; virtual;
-    procedure GetData(var Rec); virtual;
-    procedure HandleEvent(var Event: TEvent); virtual;
-    procedure SetData(var Rec); virtual;
-    procedure Store(var S: TStream);
-    function Valid(Command: Word): Boolean; virtual;
-  private
-    procedure SetUpDialog;
-  end;
-
-  PEditChDirDialog = ^TEditChDirDialog;
-  TEditChDirDialog = Object(TChDirDialog)
-    { TEditChDirDialog allows setting/getting the starting directory.  The
-      transfer record is a DirStr. }
-    function DataSize : Sw_Word; virtual;
-    procedure GetData (var Rec); virtual;
-    procedure SetData (var Rec); virtual;
-  end;  { of TEditChDirDialog }
-
-
-  {#Z+}
-  PDirValidator = ^TDirValidator;
-  {#Z-}
-  TDirValidator = Object(TFilterValidator)
-    constructor Init;
-    function IsValid(const S: string): Boolean; virtual;
-    function IsValidInput(var S: string; SuppressFill: Boolean): Boolean;
-      virtual;
-  end;  { of TDirValidator }
-
-
-  FileConfirmFunc = function (AFile : FNameStr) : Boolean;
-    { Functions of type FileConfirmFunc's are used to prompt the end user for
-      confirmation of an operation.
-
-      FileConfirmFunc's should ask the user whether to perform the desired
-      action on the file named AFile.  If the user elects to perform the
-      function FileConfirmFunc's return True, otherwise they return False.
-
-      Using FileConfirmFunc's allows routines to be coded independant of the
-      user interface implemented.  OWL and TurboVision are supported through
-      conditional defines.  If you do not use either user interface you must
-      compile this unit with the conditional define cdNoMessages and set all
-      FileConfirmFunc variables to a valid function prior to calling any
-      routines in this unit. }
-    {#X ReplaceFile DeleteFile }
-
-
-var
-
-  ReplaceFile : FileConfirmFunc;
-    { ReplaceFile returns True if the end user elects to replace the existing
-      file with the new file, otherwise it returns False.
-
-      ReplaceFile is only called when #CheckOnReplace# is True. }
-    {#X DeleteFile }
-
-  DeleteFile : FileConfirmFunc;
-    { DeleteFile returns True if the end user elects to delete the file,
-      otherwise it returns False.
-
-       DeleteFile is only called when #CheckOnDelete# is True. }
-    {#X ReplaceFile }
-
-
-const
-
-  CInfoPane = #30;
-
-  { TStream registration records }
-
-function Contains(S1, S2: String): Boolean;
-  { Contains returns true if S1 contains any characters in S2. }
-
-function DriveValid(Drive: AnsiChar): Boolean;
-  { DriveValid returns True if Drive is a valid DOS drive.  Drive valid works
-    by attempting to change the current directory to Drive, then restoring
-    the original directory. }
-
-function ExtractDir(AFile: FNameStr): DirStr;
-  { ExtractDir returns the path of AFile terminated with a trailing '\'.  If
-    AFile contains no directory information, an empty string is returned. }
-
-function ExtractFileName(AFile: FNameStr): NameStr;
-  { ExtractFileName returns the file name without any directory or file
-    extension information. }
-
-function Equal(const S1, S2: String; Count: Sw_word): Boolean;
-  { Equal returns True if S1 equals S2 for up to Count characters.  Equal is
-    case-insensitive. }
-
-function FileExists (AFile : FNameStr) : Boolean;
-  { FileExists looks for the file specified in AFile.  If AFile is present
-    FileExists returns true, otherwise FileExists returns False.
-
-    The search is performed relative to the current system directory, but
-    other directories may be searched by prefacing a file name with a valid
-    directory path.
-
-    There is no check for a vaild file name or drive.  Errrors are handled
-    internally and not reported in DosError.  Critical errors are left to
-    the system's critical error handler. }
-  {#X OpenFile }
-
-function GetCurDir: DirStr;
-  { GetCurDir returns the current directory.  The directory returned always
-    ends with a trailing backslash '\'. }
-
-function GetCurDrive: AnsiChar;
-  { GetCurDrive returns the letter of the current drive as reported by the
-    operating system. }
-
-function IsWild(const S: String): Boolean;
-  { IsWild returns True if S contains a question mark (?) or asterix (*). }
-
-function IsList(const S: String): Boolean;
-  { IsList returns True if S contains list separator (;) AnsiChar }
-
-function IsDir(const S: String): Boolean;
-  { IsDir returns True if S is a valid DOS directory. }
-
-{procedure MakeResources;}
-  { MakeResources places a language specific version of all resources
-    needed for the StdDlg unit to function on the RezFile using the string
-    constants and variables in the Resource unit.  The Resource unit and the
-    appropriate string lists must be initialized prior to calling this
-    procedure. }
-
-function NoWildChars(S: String): String;
-  { NoWildChars deletes the wild card characters ? and * from the string S
-    and returns the result. }
-
-function OpenFile (var AFile : FNameStr; HistoryID : Byte) : Boolean;
-  { OpenFile prompts the user to select a file using the file specifications
-    in AFile as the starting file and path.  Wildcards are accepted.  If the
-    user accepts a file OpenFile returns True, otherwise OpenFile returns
-    False.
-
-    Note: The file returned may or may not exist. }
-
-function OpenNewFile (var AFile: FNameStr; HistoryID: Byte): Boolean;
-  { OpenNewFile allows the user to select a directory from disk and enter a
-    new file name.  If the file name entered is an existing file the user is
-    optionally prompted for confirmation of replacing the file based on the
-    value in #CheckOnReplace#.  If a file name is successfully entered,
-    OpenNewFile returns True. }
-  {#X OpenFile }
-
-function PathValid(var Path: PathStr): Boolean;
-  { PathValid returns True if Path is a valid DOS path name.  Path may be a
-    file or directory name.  Trailing '\'s are removed. }
-
-procedure RegisterStdDlg;
-  { RegisterStdDlg registers all objects in the StdDlg unit for stream
-    usage. }
-
-function SaveAs (var AFile : FNameStr; HistoryID : Word) : Boolean;
-  { SaveAs prompts the user for a file name using AFile as a template.  If
-    AFile already exists and CheckOnReplace is True, the user is prompted
-    to replace the file.
-
-    If a valid file name is entered SaveAs returns True, other SaveAs returns
-    False. }
-
-function SelectDir (var ADir : DirStr; HistoryID : Byte) : Boolean;
-  { SelectDir prompts the user to select a directory using ADir as the
-    starting directory.  If a directory is selected, SelectDir returns True.
-    The directory returned is gauranteed to exist. }
-
-function ShrinkPath (AFile : FNameStr; MaxLen : Byte) : FNameStr;
-  { ShrinkPath returns a file name with a maximu length of MaxLen.
-    Internal directories are removed and replaced with elipses as needed to
-    make the file name fit in MaxLen.
-
-    AFile must be a valid path name. }
-
-function StdDeleteFile (AFile : FNameStr) : Boolean;
-  { StdDeleteFile returns True if the end user elects to delete the file,
-    otherwise it returns False.
-
-    DeleteFile is only called when CheckOnDelete is True. }
-
-function StdReplaceFile (AFile : FNameStr) : Boolean;
-  { StdReplaceFile returns True if the end user elects to replace the existing
-    AFile with the new AFile, otherwise it returns False.
-
-    ReplaceFile is only called when CheckOnReplace is True. }
-
-function ValidFileName(var FileName: PathStr): Boolean;
-  { ValidFileName returns True if FileName is a valid DOS file name. }
-
-
-const
-  CheckOnReplace : Boolean = True;
-    { CheckOnReplace is used by file functions.  If a file exists, it is
-      optionally replaced based on the value of CheckOnReplace.
-
-      If CheckOnReplace is False the file is replaced without asking the
-      user.  If CheckOnReplace is True, the end user is asked to replace the
-      file using a call to ReplaceFile.
-
-      CheckOnReplace is set to True by default. }
-
-  CheckOnDelete : Boolean = True;
-    { CheckOnDelete is used by file and directory functions.  If a file
-      exists, it is optionally deleted based on the value of CheckOnDelete.
-
-      If CheckOnDelete is False the file or directory is deleted without
-      asking the user.  If CheckOnDelete is True, the end user is asked to
-      delete the file/directory using a call to DeleteFile.
-
-      CheckOnDelete is set to True by default. }
-
-
-
-const
-  RFileInputLine: TStreamRec = (
-     ObjType: idFileInputLine;
-     VmtLink: Ofs(TypeOf(TFileInputLine)^);
-     Load:    @TFileInputLine.Load;
-     Store:   @TFileInputLine.Store
-  );
-
-  RFileCollection: TStreamRec = (
-     ObjType: idFileCollection;
-     VmtLink: Ofs(TypeOf(TFileCollection)^);
-     Load:    @TFileCollection.Load;
-     Store:   @TFileCollection.Store
-  );
-
-  RFileList: TStreamRec = (
-     ObjType: idFileList;
-     VmtLink: Ofs(TypeOf(TFileList)^);
-     Load:    @TFileList.Load;
-     Store:   @TFileList.Store
-  );
-
-  RFileInfoPane: TStreamRec = (
-     ObjType: idFileInfoPane;
-     VmtLink: Ofs(TypeOf(TFileInfoPane)^);
-     Load:    @TFileInfoPane.Load;
-     Store:   @TFileInfoPane.Store
-  );
-
-  RFileDialog: TStreamRec = (
-     ObjType: idFileDialog;
-     VmtLink: Ofs(TypeOf(TFileDialog)^);
-     Load:    @TFileDialog.Load;
-     Store:   @TFileDialog.Store
-  );
-
-  RDirCollection: TStreamRec = (
-     ObjType: idDirCollection;
-     VmtLink: Ofs(TypeOf(TDirCollection)^);
-     Load:    @TDirCollection.Load;
-     Store:   @TDirCollection.Store
-  );
-
-  RDirListBox: TStreamRec = (
-     ObjType: idDirListBox;
-     VmtLink: Ofs(TypeOf(TDirListBox)^);
-     Load:    @TDirListBox.Load;
-     Store:   @TDirListBox.Store
-  );
-
-  RChDirDialog: TStreamRec = (
-     ObjType: idChDirDialog;
-     VmtLink: Ofs(TypeOf(TChDirDialog)^);
-     Load:    @TChDirDialog.Load;
-     Store:   @TChDirDialog.Store
-  );
-
-  RSortedListBox: TStreamRec = (
-     ObjType: idSortedListBox;
-     VmtLink: Ofs(TypeOf(TSortedListBox)^);
-     Load:    @TSortedListBox.Load;
-     Store:   @TSortedListBox.Store
-  );
-
-  REditChDirDialog : TStreamRec = (
-    ObjType : idEditChDirDialog;
-    VmtLink : Ofs(TypeOf(TEditChDirDialog)^);
-    Load    : @TEditChDirDialog.Load;
-    Store   : @TEditChDirDialog.Store);
-
-
-implementation
-
-{****************************************************************************}
-{            Local Declarations              }
-{****************************************************************************}
-
-{$IFDEF FPC_DOTTEDUNITS}
-uses
-  FreeVision.App, {FreeVision.Memory,} FreeVision.HistList, FreeVision.MsgBox{, System.Resources.Resource};
-{$ELSE FPC_DOTTEDUNITS}
-uses
-  App, {Memory,} HistList, MsgBox{, Resource};
-{$ENDIF FPC_DOTTEDUNITS}
-
-type
-
-  PStringRec = record
-    { PStringRec is needed for properly displaying PStrings using
-      MessageBox. }
-    AString : PString;
-  end;
-
-resourcestring  sChangeDirectory='Change Directory';
-                sDeleteFile='Delete file?'#13#10#13#3'%s';
-                sDirectory='Directory';
-                sDrives='Drives';
-                sInvalidDirectory='Invalid directory.';
-                sInvalidDriveOrDir='Invalid drive or directory.';
-                sInvalidFileName='Invalid file name.';
-                sOpen='Open';
-                sReplaceFile='Replace file?'#13#10#13#3'%s';
-                sSaveAs='Save As';
-                sTooManyFiles='Too many files.';
-
-                smApr='Apr';
-                smAug='Aug';
-                smDec='Dec';
-                smFeb='Feb';
-                smJan='Jan';
-                smJul='Jul';
-                smJun='Jun';
-                smMar='Mar';
-                smMay='May';
-                smNov='Nov';
-                smOct='Oct';
-                smSep='Sep';
-
-                slChDir='~C~hdir';
-                slClear='C~l~ear';
-                slDirectoryName='Directory ~n~ame';
-                slDirectoryTree='Directory ~t~ree';
-                slFiles='~F~iles';
-                slReplace='~R~eplace';
-                slRevert='~R~evert';
-
-{****************************************************************************}
-{ PathValid                        }
-{****************************************************************************}
-{$ifdef go32v2}
-{$define NetDrive}
-{$endif go32v2}
-{$ifdef OS_WINDOWS}
-{$define NetDrive}
-{$endif OS_WINDOWS}
-
-procedure RemoveDoubleDirSep(var ExpPath : PathStr);
-var
-  p: longint;
-{$ifdef NetDrive}
-  OneDirSepRemoved: boolean;
-{$endif NetDrive}
-begin
-  p:=pos(DirSeparator+DirSeparator,ExpPath);
-{$ifdef NetDrive}
-  if p=1 then
-    begin
-      ExpPath:=Copy(ExpPath,1,high(ExpPath));
-      OneDirSepRemoved:=true;
-      p:=pos(DirSeparator+DirSeparator,ExpPath);
-    end
-  else
-    OneDirSepRemoved:=false;
-{$endif NetDrive}
-  while p>0 do
-    begin
-      ExpPath:=Copy(ExpPath,1,p)+Copy(ExpPath,p+2,high(ExpPath));
-      p:=pos(DirSeparator+DirSeparator,ExpPath);
-    end;
-{$ifdef NetDrive}
-  if OneDirSepRemoved then
-    ExpPath:=DirSeparator+ExpPath;
-{$endif NetDrive}
-end;
-
-function PathValid (var Path: PathStr): Boolean;
-var
-  ExpPath: PathStr;
-  SR: SearchRec;
-begin
-  RemoveDoubleDirSep(Path);
-  ExpPath := FExpand(Path);
-{$ifdef HAS_DOS_DRIVES}
-  if (Length(ExpPath) <= 3) then
-    PathValid := DriveValid(ExpPath[1])
-  else
-{$endif}
-  begin
-    { do not change '/' into '' }
-    if (Length(ExpPath)>1) and (ExpPath[Length(ExpPath)] = DirSeparator) then
-      SetLength(ExpPath,Length(ExpPath)-1);
-    // This function is called on current directories.
-    // If the current dir starts with a . on Linux it is is hidden.
-    // That's why we allow hidden dirs below (bug 6173)
-    FindFirst(ExpPath, Directory+hidden, SR);
-    PathValid := (DosError = 0) and (SR.Attr and Directory <> 0);
-{$ifdef NetDrive}
-    if (DosError<>0) and (length(ExpPath)>2) and
-       (ExpPath[1]='\') and (ExpPath[2]='\')then
-      begin
-        { Checking '\\machine\sharedfolder' directly always fails..
-          rather try '\\machine\sharedfolder\*' PM }
-      {$ifdef fpc}
-        FindClose(SR);
-      {$endif}
-        FindFirst(ExpPath+'\*',AnyFile,SR);
-        PathValid:=(DosError = 0);
-      end;
-{$endif NetDrive}
-    {$ifdef fpc}
-    FindClose(SR);
-   {$endif}
-  end;
-end;
-
-{****************************************************************************}
-{ TDirValidator Object                        }
-{****************************************************************************}
-{****************************************************************************}
-{ TDirValidator.Init                    }
-{****************************************************************************}
-constructor TDirValidator.Init;
-const   { What should this list be?  The commented one doesn't allow home,
-  end, right arrow, left arrow, Ctrl+XXXX, etc. }
-  Chars: TCharSet = ['A'..'Z','a'..'z','.','~',':','_','-'];
-{  Chars: TCharSet = [#0..#255]; }
-begin
-  Chars := Chars + [DirSeparator];
-  if not inherited Init(Chars) then
-    Fail;
-end;
-
-{****************************************************************************}
-{ TDirValidator.IsValid                      }
-{****************************************************************************}
-function TDirValidator.IsValid(const S: string): Boolean;
-begin
-{  IsValid := False; }
-  IsValid := True;
-end;
-
-{****************************************************************************}
-{ TDirValidator.IsValidInput                  }
-{****************************************************************************}
-function TDirValidator.IsValidInput(var S: string; SuppressFill: Boolean): Boolean;
-begin
-{  IsValid := False; }
-  IsValidInput := True;
-end;
-
-{****************************************************************************}
-{ TFileInputLine Object                      }
-{****************************************************************************}
-{****************************************************************************}
-{ TFileInputLine.Init                     }
-{****************************************************************************}
-constructor TFileInputLine.Init(var Bounds: TRect; AMaxLen: Sw_Integer);
-begin
-  TInputLine.Init(Bounds, AMaxLen);
-  EventMask := EventMask or evBroadcast;
-end;
-
-{****************************************************************************}
-{ TFileInputLine.HandleEvent                  }
-{****************************************************************************}
-procedure TFileInputLine.HandleEvent(var Event: TEvent);
-begin
-  TInputLine.HandleEvent(Event);
-  if (Event.What = evBroadcast) and (Event.Command = cmFileFocused) and
-    (State and sfSelected = 0) then
-  begin
-     if PSearchRec(Event.InfoPtr)^.Attr and Directory <> 0 then
-       begin
-          Data^ := PSearchRec(Event.InfoPtr)^.Name + DirSeparator +
-            PFileDialog(Owner)^.WildCard;
-          { PFileDialog(Owner)^.FileHistory^.AdaptHistoryToDir(
-              PSearchRec(Event.InfoPtr)^.Name+DirSeparator);}
-       end
-     else Data^ := PSearchRec(Event.InfoPtr)^.Name;
-     DrawView;
-  end;
-end;
-
-{****************************************************************************}
-{ TFileCollection Object                       }
-{****************************************************************************}
-{****************************************************************************}
-{ TFileCollection.Compare                     }
-{****************************************************************************}
-  function uppername(const s : string) : string;
-  var
-    i  : Sw_integer;
-    in_name : boolean;
-  begin
-     in_name:=true;
-     for i:=length(s) downto 1 do
-      if in_name and (s[i] in ['a'..'z']) then
-        uppername[i]:=AnsiChar(byte(s[i])-32)
-      else
-       begin
-          uppername[i]:=s[i];
-          if s[i] = DirSeparator then
-            in_name:=false;
-       end;
-     uppername[0]:=s[0];
-  end;
-
-function TFileCollection.Compare(Key1, Key2: Pointer): Sw_Integer;
-begin
-  if PSearchRec(Key1)^.Name = PSearchRec(Key2)^.Name then Compare := 0
-  else if PSearchRec(Key1)^.Name = '..' then Compare := 1
-  else if PSearchRec(Key2)^.Name = '..' then Compare := -1
-  else if (PSearchRec(Key1)^.Attr and Directory <> 0) and
-     (PSearchRec(Key2)^.Attr and Directory = 0) then Compare := 1
-  else if (PSearchRec(Key2)^.Attr and Directory <> 0) and
-     (PSearchRec(Key1)^.Attr and Directory = 0) then Compare := -1
-  else if UpperName(PSearchRec(Key1)^.Name) > UpperName(PSearchRec(Key2)^.Name) then
-    Compare := 1
-{$ifdef unix}
-  else if UpperName(PSearchRec(Key1)^.Name) < UpperName(PSearchRec(Key2)^.Name) then
-    Compare := -1
-  else if PSearchRec(Key1)^.Name > PSearchRec(Key2)^.Name then
-    Compare := 1
-{$endif def unix}
-  else
-    Compare := -1;
-end;
-
-{****************************************************************************}
-{ TFileCollection.FreeItem                   }
-{****************************************************************************}
-procedure TFileCollection.FreeItem(Item: Pointer);
-begin
-  Dispose(PSearchRec(Item));
-end;
-
-{****************************************************************************}
-{ TFileCollection.GetItem                     }
-{****************************************************************************}
-function TFileCollection.GetItem(var S: TStream): Pointer;
-var
-  Item: PSearchRec;
-begin
-  New(Item);
-  S.Read(Item^, SizeOf(TSearchRec));
-  GetItem := Item;
-end;
-
-{****************************************************************************}
-{ TFileCollection.PutItem                     }
-{****************************************************************************}
-procedure TFileCollection.PutItem(var S: TStream; Item: Pointer);
-begin
-  S.Write(Item^, SizeOf(TSearchRec));
-end;
-
-
-{*****************************************************************************
-               TFileList
-*****************************************************************************}
-
-const
-  ListSeparator=';';
-
-function MatchesMask(What, Mask: string): boolean;
-
-  function upper(const s : string) : string;
-  var
-    i  : Sw_integer;
-  begin
-     for i:=1 to length(s) do
-      if s[i] in ['a'..'z'] then
-       upper[i]:=AnsiChar(byte(s[i])-32)
-      else
-       upper[i]:=s[i];
-     upper[0]:=s[0];
-  end;
-
-  Function CmpStr(const hstr1,hstr2:string):boolean;
-  var
-    found : boolean;
-    i1,i2 : Sw_integer;
-  begin
-    i1:=0;
-    i2:=0;
-    if hstr1='' then
-      begin
-        CmpStr:=(hstr2='');
-        exit;
-      end;
-    found:=true;
-    repeat
-      inc(i1);
-      if (i1>length(hstr1)) then
-        break;
-      inc(i2);
-      if (i2>length(hstr2)) then
-        break;
-      case hstr1[i1] of
-        '?' :
-          found:=true;
-        '*' :
-          begin
-            found:=true;
-            if (i1=length(hstr1)) then
-             i2:=length(hstr2)
-            else
-             if (i1<length(hstr1)) and (hstr1[i1+1]<>hstr2[i2]) then
-              begin
-                if i2<length(hstr2) then
-                 dec(i1)
-              end
-            else
-             if i2>1 then
-              dec(i2);
-          end;
-        else
-          found:=(hstr1[i1]=hstr2[i2]) or (hstr2[i2]='?');
-      end;
-    until not found;
-    if found then
-      begin
-        found:=(i2>=length(hstr2)) and
-               (
-                (i1>length(hstr1)) or
-                ((i1=length(hstr1)) and
-                 (hstr1[i1]='*'))
-               );
-      end;
-    CmpStr:=found;
-  end;
-
-var
-  D1,D2 : DirStr;
-  N1,N2 : NameStr;
-  E1,E2 : Extstr;
-begin
-{$ifdef Unix}
-  FSplit(What,D1,N1,E1);
-  FSplit(Mask,D2,N2,E2);
-{$else}
-  FSplit(Upper(What),D1,N1,E1);
-  FSplit(Upper(Mask),D2,N2,E2);
-{$endif}
-  MatchesMask:=CmpStr(N2,N1) and CmpStr(E2,E1);
-end;
-
-function MatchesMaskList(What, MaskList: string): boolean;
-var P: SmallInt;
-    Match: boolean;
-begin
-  Match:=false;
-  if What<>'' then
-  repeat
-    P:=Pos(ListSeparator, MaskList);
-    if P=0 then P:=length(MaskList)+1;
-    Match:=MatchesMask(What,copy(MaskList,1,P-1));
-    Delete(MaskList,1,P);
-  until Match or (MaskList='');
-  MatchesMaskList:=Match;
-end;
-
-constructor TFileList.Init(var Bounds: TRect; AScrollBar: PScrollBar);
-begin
-  TSortedListBox.Init(Bounds, 2, AScrollBar);
-end;
-
-destructor TFileList.Done;
-begin
-  if List <> nil then Dispose(List, Done);
-  TListBox.Done;
-end;
-
-function TFileList.DataSize: Sw_Word;
-begin
-  DataSize := 0;
-end;
-
-procedure TFileList.FocusItem(Item: Sw_Integer);
-begin
-  TSortedListBox.FocusItem(Item);
-  if (List^.Count > 0) then
-    Message(Owner, evBroadcast, cmFileFocused, List^.At(Item));
-end;
-
-procedure TFileList.GetData(var Rec);
-begin
-end;
-
-function TFileList.GetKey(var S: String): Pointer;
-const
-  SR: TSearchRec = ();
-
-procedure UpStr(var S: String);
-var
-  I: Sw_Integer;
-begin
-  for I := 1 to Length(S) do S[I] := UpCase(S[I]);
-end;
-
-begin
-  if (HandleDir{ShiftState and $03 <> 0}) or ((S <> '') and (S[1]='.')) then
-    SR.Attr := Directory
-  else SR.Attr := 0;
-  SR.Name := S;
-{$ifndef Unix}
-  UpStr(SR.Name);
-{$endif Unix}
-  GetKey := @SR;
-end;
-
-function TFileList.GetText(Item,MaxLen: Sw_Integer): String;
-var
-  S: String;
-  SR: PSearchRec;
-begin
-  SR := PSearchRec(List^.At(Item));
-  S := SR^.Name;
-  if SR^.Attr and Directory <> 0 then
-  begin
-    S[Length(S)+1] := DirSeparator;
-    Inc(S[0]);
-  end;
-  GetText := S;
-end;
-
-procedure TFileList.HandleEvent(var Event: TEvent);
-var
-  S : String;
-  K : pointer;
-  Value : Sw_integer;
-begin
-  if (Event.What = evMouseDown) and (Event.Double) then
-  begin
-    Event.What := evCommand;
-    Event.Command := cmOK;
-    PutEvent(Event);
-    ClearEvent(Event);
-  end
-  else if (Event.What = evKeyDown) and (Event.CharCode='<') then
-  begin
-    { select '..' }
-      S := '..';
-      K := GetKey(S);
-      If PSortedCollection(List)^.Search(K, Value) then
-        FocusItem(Value);
-  end
-  else TSortedListBox.HandleEvent(Event);
-end;
-
-procedure TFileList.ReadDirectory(AWildCard: PathStr);
-const
-  FindAttr = ReadOnly + Archive;
-  PrevDir  = '..';
-var
-  S: SearchRec;
-  P: PSearchRec;
-  FileList: PFileCollection;
-  NumFiles: Word;
-  FindStr,
-  WildName : string;
-  Dir: DirStr;
-  Ext: ExtStr;
-  Name: NameStr;
-  Event : TEvent;
-  Tmp: PathStr;
-begin
-  NumFiles := 0;
-  FileList := New(PFileCollection, Init(5, 5));
-  AWildCard := FExpand(AWildCard);
-  FSplit(AWildCard, Dir, Name, Ext);
-  if pos(ListSeparator,AWildCard)>0 then
-   begin
-     WildName:=Copy(AWildCard,length(Dir)+1,255);
-     FindStr:=Dir+AllFiles;
-   end
-  else
-   begin
-     WildName:=Name+Ext;
-     FindStr:=AWildCard;
-   end;
-  FindFirst(FindStr, FindAttr, S);
-  P := PSearchRec(@P);
-  while assigned(P) and (DosError = 0) do
-   begin
-     if (S.Attr and Directory = 0) and
-        MatchesMaskList(S.Name,WildName) then
-     begin
-{       P := MemAlloc(SizeOf(P^));
-       if assigned(P) then
-       begin}
-         new(P);
-         P^.Attr:=S.Attr;
-         P^.Time:=S.Time;
-         P^.Size:=S.Size;
-         P^.Name:=S.Name;
-         FileList^.Insert(P);
-{       end;}
-     end;
-     FindNext(S);
-   end;
- {$ifdef fpc}
-  FindClose(S);
- {$endif}
-
-  Tmp := Dir + AllFiles;
-  FindFirst(Tmp, Directory, S);
-  while (P <> nil) and (DosError = 0) do
-  begin
-    if (S.Attr and Directory <> 0) and (S.Name <> '.') and (S.Name <> '..') then
-    begin
-{      P := MemAlloc(SizeOf(P^));
-      if P <> nil then
-      begin}
-        new(p);
-        P^.Attr:=S.Attr;
-        P^.Time:=S.Time;
-        P^.Size:=S.Size;
-        P^.Name:=S.Name;
-        FileList^.Insert(P);
-{      end;}
-    end;
-    FindNext(S);
-  end;
- {$ifdef fpc}
-  FindClose(S);
- {$endif}
- {$ifndef Unix}
-  if Length(Dir) > 4 then
- {$endif not Unix}
-  begin
-{
-    P := MemAlloc(SizeOf(P^));
-    if P <> nil then
-    begin}
-      new(p);
-      FindFirst(Tmp, Directory, S);
-      FindNext(S);
-      if (DosError = 0) and (S.Name = PrevDir) then
-       begin
-         P^.Attr:=S.Attr;
-         P^.Time:=S.Time;
-         P^.Size:=S.Size;
-         P^.Name:=S.Name;
-       end
-      else
-       begin
-         P^.Name := PrevDir;
-         P^.Size := 0;
-         P^.Time := $210000;
-         P^.Attr := Directory;
-       end;
-      FileList^.Insert(PSearchRec(P));
-     {$ifdef fpc}
-      FindClose(S);
-     {$endif}
-{    end;}
-  end;
-  if P = nil then
-    MessageBox(sTooManyFiles, nil, mfOkButton + mfWarning);
-  NewList(FileList);
-  if List^.Count > 0 then
-  begin
-    Event.What := evBroadcast;
-    Event.Command := cmFileFocused;
-    Event.InfoPtr := List^.At(0);
-    Owner^.HandleEvent(Event);
-  end;
-end;
-
-procedure TFileList.SetData(var Rec);
-begin
-  with PFileDialog(Owner)^ do
-    Self.ReadDirectory(Directory^ + WildCard);
-end;
-
-{****************************************************************************}
-{ TFileInfoPane Object                        }
-{****************************************************************************}
-{****************************************************************************}
-{ TFileInfoPane.Init                    }
-{****************************************************************************}
-constructor TFileInfoPane.Init(var Bounds: TRect);
-begin
-  TView.Init(Bounds);
-  FillChar(S,SizeOf(S),#0);
-  EventMask := EventMask or evBroadcast;
-end;
-
-{****************************************************************************}
-{ AdjustNameSize for TFileInfoPane                                           }
-{****************************************************************************}
-function AdjustNameSize(S:String;ASize:sw_integer):String;
-var St: String;
-    NameLen:sw_integer;
-    K,N : sw_integer;
-begin
-  NameLen:=12;
-  Str(NameLen,St);
-  NameLen:=ASize-10-9-3-2-4-2-2-1-2;
-  if NameLen>12 then
-    Str(NameLen,St);
-  k:=1;
-  while k<=length(S) do
-  begin
-    if (S[k] in ['0'..'9']) then break;
-    inc(k);
-  end;
-  N:=K;
-  while N<=length(S) do
-  begin
-    if not (S[N] in ['0'..'9']) then break;
-    inc(N);
-  end;
-  S:=Copy(S,1,K-1)+St+Copy(S,N,length(S));
-  AdjustNameSize:=S;
-end;
-
-{****************************************************************************}
-{ TFileInfoPane.Draw                    }
-{****************************************************************************}
-procedure TFileInfoPane.Draw;
-var
-  B: TDrawBuffer;
-  D: String[9];
-  M: String[3];
-  PM: Boolean;
-  Color: Word;
-  Time: DateTime;
-  Path: PathStr;
-  FmtId: String;
-  Params: array[0..7] of PtruInt;
-  Str: String[80];
-const
-  sDirectoryLine = ' %-12s %-9s %3s %2d, %4d  %2d:%02d%cm';
-  sFileLine      = ' %-12s %-9d %3s %2d, %4d  %2d:%02d%cm';
-  InValidFiles : array[0..2] of string[12] = ('','.','..');
-var
-  Month: array[1..12] of String[3];
-begin
-  Month[1] := smJan;
-  Month[2] := smFeb;
-  Month[3] := smMar;
-  Month[4] := smApr;
-  Month[5] := smMay;
-  Month[6] := smJun;
-  Month[7] := smJul;
-  Month[8] := smAug;
-  Month[9] := smSep;
-  Month[10] := smOct;
-  Month[11] := smNov;
-  Month[12] := smDec;
-  { Display path }
-  if (PFileDialog(Owner)^.Directory <> nil) then
-    Path := PFileDialog(Owner)^.Directory^
-  else Path := '';
-  Path := FExpand(Path+PFileDialog(Owner)^.WildCard);
-  { avoid B Buffer overflow PM }
-  Path := ShrinkPath(Path, Size.X - 1);
-  Color := GetColor($01);
-  MoveChar(B, ' ', Color, Size.X); { fill with empty spaces }
-  WriteLine(0, 0, Size.X, Size.Y, B);
-  MoveStr(B[1], Path, Color);
-  WriteLine(0, 0, Size.X, 1, B);
-  if (S.Name = InValidFiles[0]) or (S.Name = InValidFiles[1]) or
-     (S.Name = InValidFiles[2]) then
-    Exit;
-
-  { Display file }
-  Params[0] := ptruint(@S.Name);
-  if S.Attr and Directory <> 0 then
-  begin
-    FmtId := sDirectoryLine;
-    D := sDirectory;
-    Params[1] := ptruint(@D);
-  end else
-  begin
-    FmtId := sFileLine;
-    Params[1] := S.Size;
-  end;
-  FmtId:=AdjustNameSize(FmtId,Size.X);
-  UnpackTime(S.Time, Time);
-  M := Month[Time.Month];
-  Params[2] := ptruint(@M);
-  Params[3] := Time.Day;
-  Params[4] := Time.Year;
-  PM := Time.Hour >= 12;
-  Time.Hour := Time.Hour mod 12;
-  if Time.Hour = 0 then Time.Hour := 12;
-  Params[5] := Time.Hour;
-  Params[6] := Time.Min;
-  if PM then
-    Params[7] := Byte('p')
-  else Params[7] := Byte('a');
-  FormatStr(Str, FmtId, Params);
-  MoveStr(B, Str, Color);
-  WriteLine(0, 1, Size.X, 1, B);
-
-  { Fill in rest of rectangle }
-  MoveChar(B, ' ', Color, Size.X);
-  WriteLine(0, 2, Size.X, Size.Y-2, B);
-end;
-
-function TFileInfoPane.GetPalette: PPalette;
-const
-  P: String[Length(CInfoPane)] = CInfoPane;
-begin
-  GetPalette := PPalette(@P);
-end;
-
-procedure TFileInfoPane.HandleEvent(var Event: TEvent);
-begin
-  TView.HandleEvent(Event);
-  if (Event.What = evBroadcast) and (Event.Command = cmFileFocused) then
-  begin
-    S := PSearchRec(Event.InfoPtr)^;
-    DrawView;
-  end;
-end;
-
-{****************************************************************************
-              TFileHistory
-****************************************************************************}
-
-  function LTrim(const S: String): String;
-  var
-    I: Sw_Integer;
-  begin
-    I := 1;
-    while (I < Length(S)) and (S[I] = ' ') do Inc(I);
-    LTrim := Copy(S, I, length(S));
-  end;
-
-  function RTrim(const S: String): String;
-  var
-    I: Sw_Integer;
-  begin
-    I := Length(S);
-    if I = 0 then begin RTrim:=''; exit; end;
-    while S[I] = ' ' do Dec(I);
-    RTrim := Copy(S, 1, I);
-  end;
-
-  function RelativePath(var S: PathStr): Boolean;
-  begin
-    S := LTrim(RTrim(S));
-    {$ifdef HASAMIGA}
-    RelativePath := Pos(DriveSeparator, S) = 0;
-    {$ELSE}
-    RelativePath := not ((S <> '') and ((S[1] = DirSeparator) or (S[2] = ':')));
-    {$ENDIF}
-  end;
-
-{ try to reduce the length of S+dir as a file path+pattern }
-
-  function Simplify (var S,Dir : string) : string;
-    var i : sw_integer;
-  begin
-   if RelativePath(Dir) then
-     begin
-        if (S<>'') and (Copy(Dir,1,3)='..'+DirSeparator) then
-          begin
-             i:=Length(S);
-             for i:=Length(S)-1 downto 1 do
-               if S[i]=DirSeparator then
-                 break;
-             if S[i]=DirSeparator then
-               Simplify:=Copy(S,1,i)+Copy(Dir,4,255)
-             else
-               Simplify:=S+Dir;
-          end
-        else
-          Simplify:=S+Dir;
-     end
-   else
-      Simplify:=Dir;
-  end;
-
-{****************************************************************************}
-{ TFileHistory.HandleEvent                                                       }
-{****************************************************************************}
-
-procedure TFileHistory.HandleEvent(var Event: TEvent);
-var
-  HistoryWindow: PHistoryWindow;
-  R,P: TRect;
-  C: Word;
-  Rslt: String;
-begin
-  TView.HandleEvent(Event);
-  if (Event.What = evMouseDown) or
-     ((Event.What = evKeyDown) and (CtrlToArrow(Event.KeyCode) = kbDown) and
-      (Link^.State and sfFocused <> 0)) then
-  begin
-    if not Link^.Focus then
-    begin
-      ClearEvent(Event);
-      Exit;
-    end;
-    if assigned(CurDir) then
-     Rslt:=CurDir^
-    else
-     Rslt:='';
-    Rslt:=Simplify(Rslt,Link^.Data^);
-    RemoveDoubleDirSep(Rslt);
-    If IsWild(Rslt) then
-      RecordHistory(Rslt);
-    Link^.GetBounds(R);
-    Dec(R.A.X); Inc(R.B.X); Inc(R.B.Y,7); Dec(R.A.Y,1);
-    Owner^.GetExtent(P);
-    R.Intersect(P);
-    Dec(R.B.Y,1);
-    HistoryWindow := InitHistoryWindow(R);
-    if HistoryWindow <> nil then
-    begin
-      C := Owner^.ExecView(HistoryWindow);
-      if C = cmOk then
-      begin
-        Rslt := HistoryWindow^.GetSelection;
-        if Length(Rslt) > Link^.MaxLen then Rslt[0] := AnsiChar(Link^.MaxLen);
-        Link^.Data^ := Rslt;
-        Link^.SelectAll(True);
-        Link^.DrawView;
-      end;
-      Dispose(HistoryWindow, Done);
-    end;
-    ClearEvent(Event);
-  end
-  else if (Event.What = evBroadcast) then
-    if ((Event.Command = cmReleasedFocus) and (Event.InfoPtr = Link))
-      or (Event.Command = cmRecordHistory) then
-    begin
-      if assigned(CurDir) then
-       Rslt:=CurDir^
-      else
-       Rslt:='';
-      Rslt:=Simplify(Rslt,Link^.Data^);
-      RemoveDoubleDirSep(Rslt);
-      If IsWild(Rslt) then
-        RecordHistory(Rslt);
-    end;
-end;
-
-procedure TFileHistory.AdaptHistoryToDir(Dir : string);
-  var S,S2 : String;
-      i,Count : Sw_word;
-begin
-   if assigned(CurDir) then
-     begin
-        S:=CurDir^;
-        if S=Dir then
-          exit;
-        DisposeStr(CurDir);
-     end
-   else
-     S:='';
-   CurDir:=NewStr(Simplify(S,Dir));
-
-   Count:=HistoryCount(HistoryId);
-   for i:=1 to count do
-     begin
-        S2:=HistoryStr(HistoryId,1);
-        HistoryRemove(HistoryId,1);
-        if RelativePath(S2) then
-          if S<>'' then
-            S2:=S+S2
-          else
-            S2:=FExpand(S2);
-        { simply full path
-          we should simplify relative to Dir ! }
-        HistoryAdd(HistoryId,S2);
-     end;
-
-end;
-
-destructor TFileHistory.Done;
-begin
-  If assigned(CurDir) then
-    DisposeStr(CurDir);
-  Inherited Done;
-end;
-
-{****************************************************************************
-              TFileDialog
-****************************************************************************}
-
-constructor TFileDialog.Init(AWildCard: TWildStr; const ATitle,
-  InputName: String; AOptions: Word; HistoryId: Byte);
-var
-  Control: PView;
-  R: TRect;
-  Opt: Word;
-begin
-  R.Assign(15,1,64,20);
-  TDialog.Init(R, ATitle);
-  Options := Options or ofCentered;
-  WildCard := AWildCard;
-
-  R.Assign(3,3,31,4);
-  FileName := New(PFileInputLine, Init(R, 79));
-  FileName^.GrowMode:=gfGrowHiX;
-  FileName^.Data^ := WildCard;
-  Insert(FileName);
-  R.Assign(2,2,3+CStrLen(InputName),3);
-  Control := New(PLabel, Init(R, InputName, FileName));
-  Insert(Control);
-  R.Assign(31,3,34,4);
-  FileHistory := New(PFileHistory, Init(R, FileName, HistoryId));
-  FileHistory^.GrowMode:=gfGrowHiX or gfGrowLoX;
-  Insert(FileHistory);
-
-  R.Assign(3,14,34,15);
-  Control := New(PScrollBar, Init(R));
-  Insert(Control);
-  R.Assign(3,6,34,14);
-  FileList := New(PFileList, Init(R, PScrollBar(Control)));
-  FileList^.GrowMode:=gfGrowHiX or gfGrowHiY;
-  Insert(FileList);
-  R.Assign(2,5,8,6);
-  Control := New(PLabel, Init(R, slFiles, FileList));
-  Insert(Control);
-
-  R.Assign(35,3,46,5);
-  Opt := bfDefault;
-  if AOptions and fdOpenButton <> 0 then
-  begin
-    Control:=New(PButton, Init(R,slOpen, cmFileOpen, Opt));
-    Control^.GrowMode:=gfGrowHiX or gfGrowLoX;
-    Insert(Control);
-    Opt := bfNormal;
-    Inc(R.A.Y,3); Inc(R.B.Y,3);
-  end;
-  if AOptions and fdOkButton <> 0 then
-  begin
-    Control:=New(PButton, Init(R,slOk, cmFileOpen, Opt));
-    Control^.GrowMode:=gfGrowHiX or gfGrowLoX;
-    Insert(Control);
-    Opt := bfNormal;
-    Inc(R.A.Y,3); Inc(R.B.Y,3);
-  end;
-  if AOptions and fdReplaceButton <> 0 then
-  begin
-    Control:=New(PButton, Init(R, slReplace,cmFileReplace, Opt));
-    Control^.GrowMode:=gfGrowHiX or gfGrowLoX;
-    Insert(Control);
-    Opt := bfNormal;
-    Inc(R.A.Y,3); Inc(R.B.Y,3);
-  end;
-  if AOptions and fdClearButton <> 0 then
-  begin
-    Control:=New(PButton, Init(R, slClear,cmFileClear, Opt));
-    Control^.GrowMode:=gfGrowHiX or gfGrowLoX;
-    Insert(Control);
-    Opt := bfNormal;
-    Inc(R.A.Y,3); Inc(R.B.Y,3);
-  end;
-  Control:=New(PButton, Init(R, slCancel, cmCancel, bfNormal));
-  Control^.GrowMode:=gfGrowHiX or gfGrowLoX;
-  Insert(Control);
-  Inc(R.A.Y,3); Inc(R.B.Y,3);
-  if AOptions and fdHelpButton <> 0 then
-  begin
-    //Insert(New(PButton, Init(R,slHelp,cmHelp, bfNormal)));
-    //Inc(R.A.Y,3); Inc(R.B.Y,3);
-  end;
-
-  R.Assign(1,16,48,18);
-  Control := New(PFileInfoPane, Init(R));
-  Control^.GrowMode:=gfGrowHiX or gfGrowHiY or gfGrowLoY;
-  Insert(Control);
-
-  SelectNext(False);
-
-  if AOptions and fdNoLoadDir = 0 then ReadDirectory;
-end;
-
-constructor TFileDialog.Load(var S: TStream);
-begin
-  if not TDialog.Load(S) then
-    Fail;
-  S.Read(WildCard, SizeOf(WildCard));
-  if (S.Status <> stOk) then
-  begin
-    TDialog.Done;
-    Fail;
-  end;
-  GetSubViewPtr(S, FileName);
-  GetSubViewPtr(S, FileList);
-  GetSubViewPtr(S, FileHistory);
-  ReadDirectory;
-  if (DosError <> 0) then
-  begin
-    TDialog.Done;
-    Fail;
-  end;
-end;
-
-destructor TFileDialog.Done;
-begin
-  DisposeStr(Directory);
-  TDialog.Done;
-end;
-
-procedure TFileDialog.GetData(var Rec);
-begin
-  GetFilename(PathStr(Rec));
-end;
-
-procedure TFileDialog.GetFileName(var S: PathStr);
-
-var
-  Path: PathStr;
-  Name: NameStr;
-  Ext: ExtStr;
-  TWild : string;
-  TPath: PathStr;
-  TName: NameStr;
-  TExt: NameStr;
-  i : Sw_integer;
-begin
-  S := FileName^.Data^;
-  if RelativePath(S) then
-    begin
-      if (Directory <> nil) then
-   S := FExpand(Directory^ + S);
-    end
-  else
-    S := FExpand(S);
-  if Pos(ListSeparator,S)=0 then
-   begin
-     If FileExists(S) then
-       exit;
-     FSplit(S, Path, Name, Ext);
-     if ((Name = '') or (Ext = '')) and not IsDir(S) then
-     begin
-       TWild:=WildCard;
-       repeat
-    i:=Pos(ListSeparator,TWild);
-    if i=0 then
-     i:=length(TWild)+1;
-    FSplit(Copy(TWild,1,i-1), TPath, TName, TExt);
-    if ((Name = '') and (Ext = '')) then
-      S := Path + TName + TExt
-    else
-      if Name = '' then
-        S := Path + TName + Ext
-      else
-        if Ext = '' then
-          begin
-       if IsWild(Name) then
-         S := Path + Name + TExt
-       else
-         S := Path + Name + NoWildChars(TExt);
-          end;
-    if FileExists(S) then
-     break;
-    System.Delete(TWild,1,i);
-       until TWild='';
-       if TWild='' then
-         S := Path + Name + Ext;
-     end;
-   end;
-end;
-
-procedure TFileDialog.HandleEvent(var Event: TEvent);
-begin
-  if (Event.What and evBroadcast <> 0) and
-     (Event.Command = cmListItemSelected) then
-  begin
-    EndModal(cmFileOpen);
-    ClearEvent(Event);
-  end;
-  TDialog.HandleEvent(Event);
-  if Event.What = evCommand then
-    case Event.Command of
-      cmFileOpen, cmFileReplace, cmFileClear:
-   begin
-     EndModal(Event.Command);
-     ClearEvent(Event);
-   end;
-    end;
-end;
-
-procedure TFileDialog.SetData(var Rec);
-begin
-  TDialog.SetData(Rec);
-  if (PathStr(Rec) <> '') and (IsWild(TWildStr(Rec))) then
-  begin
-    Valid(cmFileInit);
-    FileName^.Select;
-  end;
-end;
-
-procedure TFileDialog.ReadDirectory;
-begin
-  FileList^.ReadDirectory(WildCard);
-  FileHistory^.AdaptHistoryToDir(GetCurDir);
-  Directory := NewStr(GetCurDir);
-end;
-
-procedure TFileDialog.Store(var S: TStream);
-begin
-  TDialog.Store(S);
-  S.Write(WildCard, SizeOf(WildCard));
-  PutSubViewPtr(S, FileName);
-  PutSubViewPtr(S, FileList);
-  PutSubViewPtr(S, FileHistory);
-end;
-
-function TFileDialog.Valid(Command: Word): Boolean;
-var
-  FName: PathStr;
-  Dir: DirStr;
-  Name: NameStr;
-  Ext: ExtStr;
-
-  function CheckDirectory(var S: PathStr): Boolean;
-  begin
-    if not PathValid(S) then
-    begin
-      MessageBox(sInvalidDriveOrDir, nil, mfError + mfOkButton);
-      FileName^.Select;
-      CheckDirectory := False;
-    end else CheckDirectory := True;
-  end;
-
-  function CompleteDir(const Path: string): string;
-  begin
-    { keep c: untouched PM }
-    if (Path<>'') and (Path[Length(Path)]<>DirSeparator) and
-       (Path[Length(Path)]<>':') then
-     CompleteDir:=Path+DirSeparator
-    else
-     CompleteDir:=Path;
-  end;
-
-  function NormalizeDir(const Path: string): string;
-  var Root: boolean;
-  begin
-    Root:=false;
-    {$ifdef Unix}
-    if Path=DirSeparator then Root:=true;
-    {$else}
-    {$ifdef HASAMIGA}
-    if Length(Path) > 0 then Root := Path[Length(Path)] = DriveSeparator;
-    {$else}
-    if (length(Path)=3) and (Upcase(Path[1]) in['A'..'Z']) and
-       (Path[2]=':') and (Path[3]=DirSeparator) then
-         Root:=true;
-    {$endif}
-    {$endif}
-    if (Root=false) and (copy(Path,length(Path),1)=DirSeparator) then
-      NormalizeDir:=copy(Path,1,length(Path)-1)
-    else
-      NormalizeDir:=Path;
-  end;
-function NormalizeDirF(var S: openstring): boolean;
-begin
-  S:=NormalizeDir(S);
-  NormalizeDirF:=true;
-end;
-
-begin
-  if Command = 0 then
-  begin
-    Valid := True;
-    Exit;
-  end
-  else Valid := False;
-  if TDialog.Valid(Command) then
-  begin
-    GetFileName(FName);
-    if (Command <> cmCancel) and (Command <> cmFileClear) then
-    begin
-      if IsWild(FName) or IsList(FName) then
-      begin
-        FSplit(FName, Dir, Name, Ext);
-        if CheckDirectory(Dir) then
-        begin
-          FileHistory^.AdaptHistoryToDir(Dir);
-          DisposeStr(Directory);
-          Directory := NewStr(Dir);
-          if Pos(ListSeparator,FName)>0 then
-           WildCard:=Copy(FName,length(Dir)+1,255)
-          else
-           WildCard := Name+Ext;
-          if Command <> cmFileInit then
-            FileList^.Select;
-          FileList^.ReadDirectory(Directory^+WildCard);
-        end;
-      end
-    else
-      if NormalizeDirF(FName) then
-      { ^^ this is just a dummy if construct (the func always returns true,
-        it's just there, 'coz I don't want to rearrange the following "if"s... }
-      if IsDir(FName) then
-        begin
-          if CheckDirectory(FName) then
-          begin
-            FileHistory^.AdaptHistoryToDir(CompleteDir(FName));
-            DisposeStr(Directory);
-            Directory := NewSTr(CompleteDir(FName));
-            if Command <> cmFileInit then FileList^.Select;
-            FileList^.ReadDirectory(Directory^+WildCard);
-          end
-        end
-      else
-        if ValidFileName(FName) then
-          Valid := True
-        else
-          begin
-            MessageBox(^C + sInvalidFileName, nil, mfError + mfOkButton);
-            Valid := False;
-          end;
-    end
-    else Valid := True;
-  end;
-end;
-
-{ TDirCollection }
-
-function TDirCollection.GetItem(var S: TStream): Pointer;
-var
-  DirItem: PDirEntry;
-begin
-  New(DirItem);
-  DirItem^.DisplayText := S.ReadStr;
-  DirItem^.Directory := S.ReadStr;
-  GetItem := DirItem;
-end;
-
-procedure TDirCollection.FreeItem(Item: Pointer);
-var
-  DirItem: PDirEntry absolute Item;
-begin
-  DisposeStr(DirItem^.DisplayText);
-  DisposeStr(DirItem^.Directory);
-  Dispose(DirItem);
-end;
-
-procedure TDirCollection.PutItem(var S: TStream; Item: Pointer);
-var
-  DirItem: PDirEntry absolute Item;
-begin
-  S.WriteStr(DirItem^.DisplayText);
-  S.WriteStr(DirItem^.Directory);
-end;
-
-{ TDirListBox }
-
-const
-  DrivesS: String = '';
-  Drives: PString = @DrivesS;
-
-constructor TDirListBox.Init(var Bounds: TRect; AScrollBar:
-  PScrollBar);
-begin
-  DrivesS := sDrives;
-  TListBox.Init(Bounds, 1, AScrollBar);
-  Dir := '';
-end;
-
-destructor TDirListBox.Done;
-begin
-  if (List <> nil) then
-    Dispose(List,Done);
-  TListBox.Done;
-end;
-
-function TDirListBox.GetText(Item,MaxLen: Sw_Integer): String;
-begin
-  GetText := PDirEntry(List^.At(Item))^.DisplayText^;
-end;
-
-procedure TDirListBox.HandleEvent(var Event: TEvent);
-begin
-  case Event.What of
-    evMouseDown:
-      if Event.Double then
-      begin
-   Event.What := evCommand;
-   Event.Command := cmChangeDir;
-   PutEvent(Event);
-   ClearEvent(Event);
-      end;
-    evKeyboard:
-      if (Event.CharCode = ' ') and
-    (PSearchRec(List^.At(Focused))^.Name = '..') then
-   NewDirectory(PSearchRec(List^.At(Focused))^.Name);
-  end;
-  TListBox.HandleEvent(Event);
-end;
-
-function TDirListBox.IsSelected(Item: Sw_Integer): Boolean;
-begin
-{  IsSelected := Item = Cur; }
-  IsSelected := Inherited IsSelected(Item);
-end;
-
-procedure TDirListBox.NewDirectory(var ADir: DirStr);
-{$ifdef FV_UNICODE}
-const
-  PathDir       = #$2514#$2500#$252C;
-  FirstDir     =   #$2514#$252C#$2500;
-  MiddleDir   =   ' '#$251C#$2500;
-  LastDir       =   ' '#$2514#$2500;
-  IndentSize    = '  ';
-{$else FV_UNICODE}
-const
-  PathDir       = #192#196#194;
-  FirstDir     =   #192#194#196;
-  MiddleDir   =   ' '#195#196;
-  LastDir       =   ' '#192#196;
-  IndentSize    = '  ';
-{$endif FV_UNICODE}
-var
-  AList: PCollection;
-  NewDir, Dirct: DirStr;
-  C, OldC: AnsiChar;
-  S, Indent: String[80];
-  P: PString;
-  NewCur: Word;
-  isFirst: Boolean;
-  SR: SearchRec;
-  I: Sw_Integer;
-
-  function NewDirEntry(const DisplayText, Directory: String): PDirEntry;{$ifdef PPC_BP}near;{$endif}
-  var
-    DirEntry: PDirEntry;
-  begin
-    New(DirEntry);
-    DirEntry^.DisplayText := NewStr(DisplayText);
-    If Directory='' then
-      DirEntry^.Directory := NewStr(DirSeparator)
-    else
-      DirEntry^.Directory := NewStr(Directory);
-    NewDirEntry := DirEntry;
-  end;
-
-begin
-  Dir := ADir;
-  AList := New(PDirCollection, Init(5,5));
-{$ifdef HAS_DOS_DRIVES}
-  AList^.Insert(NewDirEntry(Drives^,Drives^));
-  if Dir = Drives^ then
-  begin
-    isFirst := True;
-    OldC := ' ';
-    for C := 'A' to 'Z' do
-    begin
-      if (C < 'C') or DriveValid(C) then
-      begin
-   if OldC <> ' ' then
-   begin
-     if isFirst then
-     begin
-       S := FirstDir + OldC;
-       isFirst := False;
-     end
-     else S := MiddleDir + OldC;
-     AList^.Insert(NewDirEntry(S, OldC + ':' + DirSeparator));
-   end;
-   if C = GetCurDrive then NewCur := AList^.Count;
-   OldC := C;
-      end;
-    end;
-    if OldC <> ' ' then
-      AList^.Insert(NewDirEntry(LastDir + OldC, OldC + ':' + DirSeparator));
-  end
-  else
-{$endif HAS_DOS_DRIVES}
-  begin
-    Indent := IndentSize;
-    NewDir := Dir;
-{$ifdef HAS_DOS_DRIVES}
-    Dirct := Copy(NewDir,1,3);
-    AList^.Insert(NewDirEntry(PathDir + Dirct, Dirct));
-    NewDir := Copy(NewDir,4,255);
-{$else HAS_DOS_DRIVES}
-    Dirct := '';
-{$endif HAS_DOS_DRIVES}
-    while NewDir <> '' do
-    begin
-      I := Pos(DirSeparator,NewDir);
-      if I <> 0 then
-      begin
-   S := Copy(NewDir,1,I-1);
-   Dirct := Dirct + S;
-   AList^.Insert(NewDirEntry(Indent + PathDir + S, Dirct));
-   NewDir := Copy(NewDir,I+1,255);
-      end
-      else
-      begin
-   Dirct := Dirct + NewDir;
-   AList^.Insert(NewDirEntry(Indent + PathDir + NewDir, Dirct));
-   NewDir := '';
-      end;
-      Indent := Indent + IndentSize;
-      Dirct := Dirct + DirSeparator;
-    end;
-    NewCur := AList^.Count-1;
-    isFirst := True;
-    NewDir := Dirct + AllFiles;
-    FindFirst(NewDir, Directory, SR);
-    while DosError = 0 do
-    begin
-      if (SR.Attr and Directory <> 0) and
-         (SR.Name <> '.') and (SR.Name <> '..') then
-      begin
-   if isFirst then
-   begin
-     S := FirstDir;
-     isFirst := False;
-   end else S := MiddleDir;
-   AList^.Insert(NewDirEntry(Indent + S + SR.Name, Dirct + SR.Name));
-      end;
-      FindNext(SR);
-    end;
-  FindClose(SR);
-    P := PDirEntry(AList^.At(AList^.Count-1))^.DisplayText;
-{$ifdef FV_UNICODE}
-    I := Pos(#$2514,P^);
-    if I = 0 then
-    begin
-      I := Pos(#$251C,P^);
-      if I <> 0 then P^[I] := #$2514;
-    end else
-    begin
-      P^[I+1] := #$2500;
-      P^[I+2] := #$2500;
-    end;
-{$else FV_UNICODE}
-    I := Pos(#192,P^);
-    if I = 0 then
-    begin
-      I := Pos(#195,P^);
-      if I <> 0 then P^[I] := #192;
-    end else
-    begin
-      P^[I+1] := #196;
-      P^[I+2] := #196;
-    end;
-{$endif FV_UNICODE}
-  end;
-  NewList(AList);
-  FocusItem(NewCur);
-  Cur:=NewCur;
-end;
-
-procedure TDirListBox.SetState(AState: Word; Enable: Boolean);
-begin
-  TListBox.SetState(AState, Enable);
-  if AState and sfFocused <> 0 then
-    PChDirDialog(Owner)^.ChDirButton^.MakeDefault(Enable);
-end;
-
-{****************************************************************************}
-{ TChDirDialog Object                     }
-{****************************************************************************}
-{****************************************************************************}
-{ TChDirDialog.Init                      }
-{****************************************************************************}
-constructor TChDirDialog.Init(AOptions: Word; HistoryId: Sw_Word);
-var
-  R: TRect;
-  Control: PView;
-begin
-  R.Assign(16, 2, 64, 20);
-  TDialog.Init(R,sChangeDirectory);
-
-  Options := Options or ofCentered;
-
-  R.Assign(3, 3, 30, 4);
-  DirInput := New(PInputLine, Init(R, FileNameLen+4));
-  DirInput^.GrowMode:=gfGrowHiX;
-  Insert(DirInput);
-  R.Assign(2, 2, 17, 3);
-  Control := New(PLabel, Init(R,slDirectoryName, DirInput));
-  Insert(Control);
-  R.Assign(30, 3, 33, 4);
-  Control := New(PHistory, Init(R, DirInput, HistoryId));
-  Control^.GrowMode:=gfGrowHiX or gfGrowLoX;
-  Insert(Control);
-
-  R.Assign(32, 6, 33, 16);
-  Control := New(PScrollBar, Init(R));
-  Insert(Control);
-  R.Assign(3, 6, 32, 16);
-  DirList := New(PDirListBox, Init(R, PScrollBar(Control)));
-  DirList^.GrowMode:=gfGrowHiX or gfGrowHiY;
-  Insert(DirList);
-  R.Assign(2, 5, 17, 6);
-  Control := New(PLabel, Init(R, slDirectoryTree, DirList));
-  Insert(Control);
-
-  R.Assign(35, 6, 45, 8);
-  OkButton := New(PButton, Init(R, slOk, cmOK, bfDefault));
-  OkButton^.GrowMode:=gfGrowHiX or gfGrowLoX;
-  Insert(OkButton);
-  Inc(R.A.Y,3); Inc(R.B.Y,3);
-  ChDirButton := New(PButton,Init(R,slChDir,cmChangeDir,
-           bfNormal));
-  ChDirButton^.GrowMode:=gfGrowHiX or gfGrowLoX;
-  Insert(ChDirButton);
-  Inc(R.A.Y,3); Inc(R.B.Y,3);
-  Control := New(PButton, Init(R,slRevert, cmRevert, bfNormal));
-  Control^.GrowMode:=gfGrowHiX or gfGrowLoX;
-  Insert(Control);
-  if AOptions and cdHelpButton <> 0 then
-  begin
-    //Inc(R.A.Y,3); Inc(R.B.Y,3);
-    //Insert(New(PButton, Init(R,slHelp, cmHelp, bfNormal)));
-  end;
-
-  if AOptions and cdNoLoadDir = 0 then SetUpDialog;
-
-  SelectNext(False);
-end;
-
-{****************************************************************************}
-{ TChDirDialog.Load                      }
-{****************************************************************************}
-constructor TChDirDialog.Load(var S: TStream);
-begin
-  TDialog.Load(S);
-  GetSubViewPtr(S, DirList);
-  GetSubViewPtr(S, DirInput);
-  GetSubViewPtr(S, OkButton);
-  GetSubViewPtr(S, ChDirbutton);
-  SetUpDialog;
-end;
-
-{****************************************************************************}
-{ TChDirDialog.DataSize                      }
-{****************************************************************************}
-function TChDirDialog.DataSize: Sw_Word;
-begin
-  DataSize := 0;
-end;
-
-{****************************************************************************}
-{ TChDirDialog.GetData                        }
-{****************************************************************************}
-procedure TChDirDialog.GetData(var Rec);
-begin
-end;
-
-{****************************************************************************}
-{ TChDirDialog.HandleEvent                   }
-{****************************************************************************}
-procedure TChDirDialog.HandleEvent(var Event: TEvent);
-var
-  CurDir: DirStr;
-  P: PDirEntry;
-begin
-  TDialog.HandleEvent(Event);
-  case Event.What of
-    evCommand:
-      begin
-   case Event.Command of
-     cmRevert: GetDir(0,CurDir);
-     cmChangeDir:
-       begin
-         P := DirList^.List^.At(DirList^.Focused);
-         if (P^.Directory^ = Drives^)
-            or DriveValid(P^.Directory^[1]) then
-           CurDir := P^.Directory^
-         else Exit;
-       end;
-   else
-     Exit;
-   end;
-   if (Length(CurDir) > 3) and
-      (CurDir[Length(CurDir)] = DirSeparator) then
-     CurDir := Copy(CurDir,1,Length(CurDir)-1);
-   DirList^.NewDirectory(CurDir);
-   DirInput^.Data^ := CurDir;
-   DirInput^.DrawView;
-   DirList^.Select;
-   ClearEvent(Event);
-      end;
-  end;
-end;
-
-{****************************************************************************}
-{ TChDirDialog.SetData                        }
-{****************************************************************************}
-procedure TChDirDialog.SetData(var Rec);
-begin
-end;
-
-{****************************************************************************}
-{ TChDirDialog.SetUpDialog                   }
-{****************************************************************************}
-procedure TChDirDialog.SetUpDialog;
-var
-  CurDir: DirStr;
-begin
-  if DirList <> nil then
-  begin
-    CurDir := GetCurDir;
-    DirList^.NewDirectory(CurDir);
-    if (Length(CurDir) > 3) and (CurDir[Length(CurDir)] = DirSeparator) then
-      CurDir := Copy(CurDir,1,Length(CurDir)-1);
-    if DirInput <> nil then
-    begin
-      DirInput^.Data^ := CurDir;
-      DirInput^.DrawView;
-    end;
-  end;
-end;
-
-{****************************************************************************}
-{ TChDirDialog.Store                    }
-{****************************************************************************}
-procedure TChDirDialog.Store(var S: TStream);
-begin
-  TDialog.Store(S);
-  PutSubViewPtr(S, DirList);
-  PutSubViewPtr(S, DirInput);
-  PutSubViewPtr(S, OkButton);
-  PutSubViewPtr(S, ChDirButton);
-end;
-
-{****************************************************************************}
-{ TChDirDialog.Valid                    }
-{****************************************************************************}
-function TChDirDialog.Valid(Command: Word): Boolean;
-var
-  P: PathStr;
-begin
-  Valid := True;
-  if Command = cmOk then
-  begin
-    P := FExpand(DirInput^.Data^);
-    if (Length(P) > 3) and (P[Length(P)] = DirSeparator) then
-      Dec(P[0]);
-    {$push}{$I-}
-    ChDir(P);
-    if (IOResult <> 0) then
-    begin
-      MessageBox(sInvalidDirectory, nil, mfError + mfOkButton);
-      Valid := False;
-    end;
-    {$pop}
-  end;
-end;
-
-{****************************************************************************}
-{ TEditChDirDialog Object                     }
-{****************************************************************************}
-{****************************************************************************}
-{ TEditChDirDialog.DataSize                    }
-{****************************************************************************}
-function TEditChDirDialog.DataSize : Sw_Word;
-begin
-  DataSize := SizeOf(DirStr);
-end;
-
-{****************************************************************************}
-{ TEditChDirDialog.GetData                   }
-{****************************************************************************}
-procedure TEditChDirDialog.GetData (var Rec);
-var
-  CurDir : DirStr absolute Rec;
-begin
-  if (DirInput = nil) then
-    CurDir := ''
-  else begin
-    CurDir := DirInput^.Data^;
-    
-    if (CurDir[Length(CurDir)] <> DirSeparator) 
-    {$IFDEF HASAMIGA}
-      and (CurDir[Length(CurDir)] <> DriveSeparator) 
-    {$endif}
-    then
-      CurDir := CurDir + DirSeparator;
-  end;
-end;
-
-{****************************************************************************}
-{ TEditChDirDialog.SetData                   }
-{****************************************************************************}
-procedure TEditChDirDialog.SetData (var Rec);
-var
-  CurDir : DirStr absolute Rec;
-begin
-  if DirList <> nil then
-  begin
-    DirList^.NewDirectory(CurDir);
-    if DirInput <> nil then
-    begin
-      if (Length(CurDir) > 3) and (CurDir[Length(CurDir)] = DirSeparator) then
-   DirInput^.Data^ := Copy(CurDir,1,Length(CurDir)-1)
-      else DirInput^.Data^ := CurDir;
-      DirInput^.DrawView;
-    end;
-  end;
-end;
-
-{****************************************************************************}
-{ TSortedListBox Object                      }
-{****************************************************************************}
-{****************************************************************************}
-{ TSortedListBox.Init                     }
-{****************************************************************************}
-constructor TSortedListBox.Init(var Bounds: TRect; ANumCols: Sw_Word;
-  AScrollBar: PScrollBar);
-begin
-  TListBox.Init(Bounds, ANumCols, AScrollBar);
-  SearchPos := 0;
-  ShowCursor;
-  SetCursor(1,0);
-end;
-
-{****************************************************************************}
-{ TSortedListBox.HandleEvent                  }
-{****************************************************************************}
-procedure TSortedListBox.HandleEvent(var Event: TEvent);
-const
-  SpecialChars: set of AnsiChar = [#0,#9,#27];
-var
-  CurString, NewString: String;
-  K: Pointer;
-  Value : Sw_integer;
-  OldPos, OldValue: Sw_Integer;
-  T: Boolean;
-begin
-  OldValue := Focused;
-  TListBox.HandleEvent(Event);
-  if (OldValue <> Focused) or
-     ((Event.What = evBroadcast) and (Event.InfoPtr = @Self) and
-      (Event.Command = cmReleasedFocus)) then
-    SearchPos := 0;
-  if Event.What = evKeyDown then
-  begin
-    { patched to prevent error when no or empty list or Escape pressed }
-    if (not (Event.CharCode in SpecialChars)) and
-       (List <> nil) and (List^.Count > 0) then
-    begin
-      Value := Focused;
-      if Value < Range then
-        CurString := GetText(Value, 255)
-      else
-        CurString := '';
-      OldPos := SearchPos;
-      if Event.KeyCode = kbBack then
-      begin
-   if SearchPos = 0 then Exit;
-   Dec(SearchPos);
-          if SearchPos = 0 then
-            HandleDir:= ((GetShiftState and $3) <> 0) or (Event.CharCode in ['A'..'Z']);
-          SetLength(CurString,SearchPos);
-      end
-      else if (Event.CharCode = '.') then
-        SearchPos := Pos('.',CurString)
-      else
-      begin
-   Inc(SearchPos);
-          if SearchPos = 1 then
-            HandleDir := ((GetShiftState and 3) <> 0) or (Event.CharCode in ['A'..'Z']);
-          SetLength(CurString,SearchPos);
-   CurString[SearchPos] := Event.CharCode;
-      end;
-      K := GetKey(CurString);
-      T := PSortedCollection(List)^.Search(K, Value);
-      if Value < Range then
-      begin
-          if Value < Range then
-            NewString := GetText(Value, 255)
-          else
-            NewString := '';
-   if Equal(NewString, CurString, SearchPos) then
-   begin
-     if Value <> OldValue then
-     begin
-       FocusItem(Value);
-       { Assumes ListControl will set the cursor to the first character }
-       { of the sfFocused item }
-       SetCursor(Cursor.X+SearchPos, Cursor.Y);
-     end
-              else
-                SetCursor(Cursor.X+(SearchPos-OldPos), Cursor.Y);
-   end
-          else
-            SearchPos := OldPos;
-      end
-      else SearchPos := OldPos;
-      if (SearchPos <> OldPos) or (Event.CharCode in ['A'..'Z','a'..'z']) then
-   ClearEvent(Event);
-    end;
-  end;
-end;
-
-function TSortedListBox.GetKey(var S: String): Pointer;
-begin
-  GetKey := @S;
-end;
-
-procedure TSortedListBox.NewList(AList: PCollection);
-begin
-  TListBox.NewList(AList);
-  SearchPos := 0;
-end;
-
-{****************************************************************************}
-{            Global Procedures and Functions          }
-{****************************************************************************}
-
-{****************************************************************************}
-{ Contains                          }
-{****************************************************************************}
-function Contains(S1, S2: String): Boolean;
-  { Contains returns true if S1 contains any characters in S2. }
-var
-  i : Byte;
-begin
-  Contains := True;
-  i := 1;
-  while ((i < Length(S2)) and (i < Length(S1))) do
-    if (Upcase(S1[i]) = Upcase(S2[i])) then
-      Exit
-    else Inc(i);
-  Contains := False;
-end;
-
-{****************************************************************************}
-{ StdDeleteFile                           }
-{****************************************************************************}
-function StdDeleteFile (AFile : FNameStr) : Boolean;
-var
-  Rec : PStringRec;
-begin
-  if CheckOnDelete then
-  begin
-    AFile := ShrinkPath(AFile,33);
-    Rec.AString := PString(@AFile);
-    StdDeleteFile := (MessageBox(^C + sDeleteFile,
-               @Rec,mfConfirmation or mfOkCancel) = cmOk);
-  end
-  else StdDeleteFile := False;
-end;
-
-{****************************************************************************}
-{ DriveValid                         }
-{****************************************************************************}
-function DriveValid(Drive: AnsiChar): Boolean;
-{$ifdef HAS_DOS_DRIVES}
-var
-  D: AnsiChar;
-begin
-  D := GetCurDrive;
-  {$push}{$I-}
-  ChDir(Drive+':');
-  if (IOResult = 0) then
-  begin
-    DriveValid := True;
-    ChDir(D+':')
-  end
-  else DriveValid := False;
-  {$pop}
-end;
-{$else HAS_DOS_DRIVES}
-begin
-  DriveValid:=true;
-end;
-{$endif HAS_DOS_DRIVES}
-
-{****************************************************************************}
-{ Equal                             }
-{****************************************************************************}
-function Equal(const S1, S2: String; Count: Sw_word): Boolean;
-var
-  i: Sw_Word;
-begin
-  Equal := False;
-  if (Length(S1) < Count) or (Length(S2) < Count) then
-    Exit;
-  for i := 1 to Count do
-    if UpCase(S1[I]) <> UpCase(S2[I]) then
-      Exit;
-  Equal := True;
-end;
-
-{****************************************************************************}
-{ ExtractDir                         }
-{****************************************************************************}
-function ExtractDir(AFile: FNameStr): DirStr;
-  { ExtractDir returns the path of AFile terminated with a trailing '\'.  If
-    AFile contains no directory information, an empty string is returned. }
-var
-  D: DirStr;
-  N: NameStr;
-  E: ExtStr;
-begin
-  FSplit(AFile,D,N,E);
-  if D = '' then
-  begin
-    ExtractDir := '';
-    Exit;
-  end;
-  if (D[Length(D)] <> DirSeparator)
-  {$ifdef HASAMIGA}
-    and (D[Length(D)] <> DriveSeparator)
-  {$endif}
-  then
-    D := D + DirSeparator;
-  ExtractDir := D;
-end;
-
-{****************************************************************************}
-{ ExtractFileName                       }
-{****************************************************************************}
-function ExtractFileName(AFile: FNameStr): NameStr;
-var
-  D: DirStr;
-  N: NameStr;
-  E: ExtStr;
-begin
-  FSplit(AFile,D,N,E);
-  ExtractFileName := N;
-end;
-
-{****************************************************************************}
-{ FileExists                         }
-{****************************************************************************}
-function FileExists (AFile : FNameStr) : Boolean;
-begin
-  FileExists := (FSearch(AFile,'') <> '');
-end;
-
-{****************************************************************************}
-{ GetCurDir                        }
-{****************************************************************************}
-function GetCurDir: DirStr;
-var
-  CurDir: DirStr;
-begin
-  GetDir(0, CurDir);
-  if (Length(CurDir) > 3) then
-  begin
-    SetLength(CurDir,Length(CurDir)+1);
-    CurDir[Length(CurDir)] := DirSeparator;
-  end;
-  GetCurDir := CurDir;
-end;
-
-{****************************************************************************}
-{ GetCurDrive                       }
-{****************************************************************************}
-function GetCurDrive: AnsiChar;
-{$ifdef go32v2}
-var
-  Regs : Registers;
-begin
-  Regs.AH := $19;
-  Intr($21,Regs);
-  GetCurDrive := AnsiChar(Regs.AL + Byte('A'));
-end;
-{$else not go32v2}
-var
-  D : DirStr;
-begin
-  D:=GetCurDir;
-  if (Length(D)>1) and (D[2]=':') then
-    begin
-      if (D[1]>='a') and (D[1]<='z') then
-        GetCurDrive:=AnsiChar(Byte(D[1])+Byte('A')-Byte('a'))
-      else
-        GetCurDrive:=D[1];
-    end
-  else
-    GetCurDrive:='C';
-end;
-{$endif not go32v2}
-
-{****************************************************************************}
-{ IsDir                             }
-{****************************************************************************}
-function IsDir(const S: String): Boolean;
-var
-  SR: SearchRec;
-begin
-  Result:=false;
-{$ifdef Unix}
-  Result:=(S=DirSeparator); { handle root }
-{$else}
-  {$ifdef HASAMIGA}
-  Result := (Length(S) > 0) and (S[Length(S)] = DriveSeparator);
-  {$else}
-  Result:=(length(S)=3) and (Upcase(S[1]) in['A'..'Z']) and (S[2]=':') and (S[3]=DirSeparator);
-  {$endif}
-  { handle root dirs }
-{$endif}
-  if Result=false then
-  begin
-    FindFirst(S, Directory, SR);
-    if DosError = 0 then
-      Result := (SR.Attr and Directory) <> 0
-    else
-      Result := False;
-   {$ifdef fpc}
-    FindClose(SR);
-   {$endif}
-  end;
-end;
-
-{****************************************************************************}
-{ IsWild                           }
-{****************************************************************************}
-function IsWild(const S: String): Boolean;
-begin
-  IsWild := (Pos('?',S) > 0) or (Pos('*',S) > 0);
-end;
-
-{****************************************************************************}
-{ IsList                           }
-{****************************************************************************}
-function IsList(const S: String): Boolean;
-begin
-  IsList := (Pos(ListSeparator,S) > 0);
-end;
-
-{****************************************************************************}
-{ MakeResources                           }
-{****************************************************************************}
-(*
-procedure MakeResources;
-var
-  Dlg : PDialog;
-  Key : String;
-  i : Word;
-begin
-  for i := 0 to 1 do
-  begin
-    case i of
-      0 : begin
-       Key := reOpenDlg;
-       Dlg := New(PFileDialog,Init('*.*',sOpen,slName,
-             fdOkButton or fdHelpButton or fdNoLoadDir,0));
-     end;
-      1 : begin
-       Key := reSaveAsDlg;
-       Dlg := New(PFileDialog,Init('*.*',sSaveAs,slName,
-             fdOkButton or fdHelpButton or fdNoLoadDir,0));
-     end;
-      2 : begin
-       Key := reEditChDirDialog;
-       Dlg := New(PEditChDirDialog,Init(cdHelpButton,
-             hiCurrentDirectories));
-     end;
-    end;
-    if Dlg = nil then
-    begin
-       PrintStr('Error initializing dialog ' + Key);
-       Halt;
-    end
-    else begin
-      RezFile^.Put(Dlg,Key);
-      if (RezFile^.Stream^.Status <> stOk) then
-      begin
-   PrintStr('Error writing dialog ' + Key + ' to the resource file.');
-   Halt;
-      end;
-    end;
-  end;
-end;
-*)
-{****************************************************************************}
-{ NoWildChars                       }
-{****************************************************************************}
-function NoWildChars(S: String): String;
-const
-  WildChars : array[0..1] of AnsiChar = ('?','*');
-var
-  i : Sw_Word;
-begin
-  repeat
-    i := Pos('?',S);
-    if (i > 0) then
-      System.Delete(S,i,1);
-  until (i = 0);
-  repeat
-    i := Pos('*',S);
-    if (i > 0) then
-      System.Delete(S,i,1);
-  until (i = 0);
-  NoWildChars:=S;
-end;
-
-{****************************************************************************}
-{ OpenFile                          }
-{****************************************************************************}
-function OpenFile (var AFile : FNameStr; HistoryID : Byte) : Boolean;
-var
-  Dlg : PFileDialog;
-begin
-  {$ifdef cdResource}
-  Dlg := PFileDialog(RezFile^.Get(reOpenDlg));
-  {$else}
-  Dlg := New(PFileDialog,Init('*.*',sOpen,slName,
-        fdOkButton or fdHelpButton,0));
-  {$endif cdResource}
-    { this might not work }
-  PHistory(Dlg^.FileName^.Next^.Next)^.HistoryID := HistoryID;
-  OpenFile := (Application^.ExecuteDialog(Dlg,@AFile) = cmFileOpen);
-end;
-
-{****************************************************************************}
-{ OpenNewFile                       }
-{****************************************************************************}
-function OpenNewFile (var AFile: FNameStr; HistoryID: Byte): Boolean;
-  { OpenNewFile allows the user to select a directory from disk and enter a
-    new file name.  If the file name entered is an existing file the user is
-    optionally prompted for confirmation of replacing the file based on the
-    value in #CheckOnReplace#.  If a file name is successfully entered,
-    OpenNewFile returns True. }
-  {#X OpenFile }
-begin
-  OpenNewFile := False;
-  if OpenFile(AFile,HistoryID) then
-  begin
-    if not ValidFileName(AFile) then
-      Exit;
-    if FileExists(AFile) then
-      if (not CheckOnReplace) or (not ReplaceFile(AFile)) then
-   Exit;
-    OpenNewFile := True;
-  end;
-end;
-
-{****************************************************************************}
-{ RegisterStdDlg                         }
-{****************************************************************************}
-procedure RegisterStdDlg;
-begin
-  RegisterType(RFileInputLine);
-  RegisterType(RFileCollection);
-  RegisterType(RFileList);
-  RegisterType(RFileInfoPane);
-  RegisterType(RFileDialog);
-  RegisterType(RDirCollection);
-  RegisterType(RDirListBox);
-  RegisterType(RSortedListBox);
-  RegisterType(RChDirDialog);
-end;
-
-{****************************************************************************}
-{ StdReplaceFile                         }
-{****************************************************************************}
-function StdReplaceFile (AFile : FNameStr) : Boolean;
-var
-  Rec : PStringRec;
-begin
-  if CheckOnReplace then
-  begin
-    AFile := ShrinkPath(AFile,33);
-    Rec.AString := PString(@AFile);
-    StdReplaceFile :=
-       (MessageBox(^C + sReplaceFile,
-         @Rec,mfConfirmation or mfOkCancel) = cmOk);
-  end
-  else StdReplaceFile := True;
-end;
-
-{****************************************************************************}
-{ SaveAs                           }
-{****************************************************************************}
-function SaveAs (var AFile : FNameStr; HistoryID : Word) : Boolean;
-var
-  Dlg : PFileDialog;
-begin
-  SaveAs := False;
-  Dlg := New(PFileDialog,Init('*.*',sSaveAs,slSaveAs,
-        fdOkButton or fdHelpButton,0));
-    { this might not work }
-  PHistory(Dlg^.FileName^.Next^.Next)^.HistoryID := HistoryID;
-  Dlg^.HelpCtx := hcSaveAs;
-  if (Application^.ExecuteDialog(Dlg,@AFile) = cmFileOpen) and
-     ((not FileExists(AFile)) or ReplaceFile(AFile)) then
-    SaveAs := True;
-end;
-
-{****************************************************************************}
-{ SelectDir                        }
-{****************************************************************************}
-function SelectDir (var ADir : DirStr; HistoryID : Byte) : Boolean;
-var
-  Dir: DirStr;
-  Dlg : PEditChDirDialog;
-  Rec : DirStr;
-begin
-  {$push}{$I-}
-  GetDir(0,Dir);
-  {$pop}
-  Rec := FExpand(ADir);
-  Dlg := New(PEditChDirDialog,Init(cdHelpButton,HistoryID));
-  if (Application^.ExecuteDialog(Dlg,@Rec) = cmOk) then
-  begin
-    SelectDir := True;
-    ADir := Rec;
-  end
-  else SelectDir := False;
-  {$push}{$I-}
-  ChDir(Dir);
-  {$pop}
-end;
-
-{****************************************************************************}
-{ ShrinkPath                         }
-{****************************************************************************}
-function ShrinkPath (AFile : FNameStr; MaxLen : Byte) : FNameStr;
-var
-  Filler: string;
-  D1 : DirStr;
-  N1 : NameStr;
-  E1 : ExtStr;
-  i  : Sw_Word;
-
-begin
-  if Length(AFile) > MaxLen then
-  begin
-    FSplit(FExpand(AFile),D1,N1,E1);
-    AFile := Copy(D1,1,3) + '..' + DirSeparator;
-    i := Pred(Length(D1));
-    while (i > 0) and (D1[i] <> DirSeparator) do
-      Dec(i);
-    if (i = 0) then
-      AFile := AFile + D1
-    else AFile := AFile + Copy(D1,Succ(i),Length(D1)-i);
-    if (AFile[Length(AFile)] <> DirSeparator)
-    {$ifdef HASAMIGA}
-      and (AFile[Length(AFile)] <> DriveSeparator)
-    {$endif}
-    then
-      AFile := AFile + DirSeparator;
-    if Length(AFile)+Length(N1)+Length(E1) <= MaxLen then
-      AFile := AFile + N1 + E1
-    else
-      begin
-        Filler := '...' + DirSeparator;
-        AFile:=Copy(Afile,1,MaxLen-Length(Filler)-Length(N1)-Length(E1))
-                +Filler+N1+E1;
-      end;
-  end;
-  ShrinkPath := AFile;
-end;
-
-{****************************************************************************}
-{ ValidFileName                           }
-{****************************************************************************}
-function ValidFileName(var FileName: PathStr): Boolean;
-var
-  IllegalChars: string[12];
-  Dir: DirStr;
-  Name: NameStr;
-  Ext: ExtStr;
-begin
-{$ifdef PPC_FPC}
-{$ifdef go32v2}
-  { spaces are allowed if LFN is supported }
-  if LFNSupport then
-    IllegalChars := ';,=+<>|"[]'+DirSeparator
-  else
-    IllegalChars := ';,=+<>|"[] '+DirSeparator;
-{$else not go32v2}
-{$ifdef OS_WINDOWS}
-    IllegalChars := ';,=+<>|"[]'+DirSeparator;
-{$else not go32v2 and not OS_WINDOWS }
-    IllegalChars := ';,=+<>|"[] '+DirSeparator;
-{$endif not OS_WINDOWS}
-{$endif not go32v2}
-{$else not PPC_FPC}
-  IllegalChars := ';,=+<>|"[] '+DirSeparator;
-{$endif PPC_FPC}
-  ValidFileName := True;
-  FSplit(FileName, Dir, Name, Ext);
-  if not ((Dir = '') or PathValid(Dir)) or
-     Contains(Name, IllegalChars) or
-     Contains(Dir, IllegalChars) then
-    ValidFileName := False;
-end;
-
-{****************************************************************************}
-{        Unit Initialization Section                                         }
-{****************************************************************************}
-begin
-{$ifdef PPC_BP}
-  ReplaceFile := StdReplaceFile;
-  DeleteFile := StdDeleteFile;
-{$else}
-  ReplaceFile := @StdReplaceFile;
-  DeleteFile := @StdDeleteFile;
-{$endif PPC_BP}
-end.
+{$I stddlg.inc}