* moved

ide/fake/README

@@ -0,0 +1,8 @@
+
+This is a fake compiler which can be used instead of the full compiler source.
+The only thing it does is when you compile it writes some info lines to the
+do_comment() function, which is normally called by the compiler.
+
+Currently it gives an info line that it is a fake compiler and on the second
+line the specified commandline
+

ide/fake/comphook.pas

@@ -0,0 +1,253 @@
+{
+    $Id$
+
+    Fake comphook unit
+}
+unit comphook;
+interface
+
+Const
+{ <$10000 will show file and line }
+  V_Fatal       = $0;
+  V_Error       = $1;
+  V_Normal      = $2; { doesn't show a text like Error: }
+  V_Warning     = $4;
+  V_Note        = $8;
+  V_Hint        = $10;
+  V_Macro       = $100;
+  V_Procedure   = $200;
+  V_Conditional = $400;
+  V_Info        = $10000;
+  V_Status      = $20000;
+  V_Used        = $40000;
+  V_Tried       = $80000;
+  V_Debug       = $100000;
+
+  V_ShowFile    = $ffff;
+  V_All         = $ffffffff;
+  V_Default     = V_Fatal + V_Error + V_Normal;
+
+type
+  PCompilerStatus = ^TCompilerStatus;
+  TCompilerStatus = record
+  { Current status }
+    currentmodule,
+    currentsource : string;   { filename }
+    currentline,
+    currentcolumn : longint;  { current line and column }
+  { Total Status }
+    compiledlines : longint;  { the number of lines which are compiled }
+    errorcount    : longint;  { number of generated errors }
+  { Settings for the output }
+    verbosity     : longint;
+    maxerrorcount : longint;
+    skip_error,
+    use_stderr,
+    use_redir,
+    use_gccoutput : boolean;
+  { Redirection support }
+    redirfile : text;
+  end;
+var
+  status : tcompilerstatus;
+
+{ Default Functions }
+procedure def_stop;
+Function  def_status:boolean;
+Function  def_comment(Level:Longint;const s:string):boolean;
+function  def_internalerror(i:longint):boolean;
+
+{ Function redirecting for IDE support }
+type
+  tstopprocedure         = procedure;
+  tstatusfunction        = function:boolean;
+  tcommentfunction       = function(Level:Longint;const s:string):boolean;
+  tinternalerrorfunction = function(i:longint):boolean;
+const
+  do_stop          : tstopprocedure   = def_stop;
+  do_status        : tstatusfunction  = def_status;
+  do_comment       : tcommentfunction = def_comment;
+  do_internalerror : tinternalerrorfunction = def_internalerror;
+
+
+
+implementation
+
+{$ifdef USEEXCEPT}
+  uses tpexcept;
+{$endif USEEXCEPT}
+
+{****************************************************************************
+                          Helper Routines
+****************************************************************************}
+
+function gccfilename(const s : string) : string;
+var
+  i : longint;
+begin
+  for i:=1to length(s) do
+   begin
+     case s[i] of
+      '\' : gccfilename[i]:='/';
+ 'A'..'Z' : gccfilename[i]:=chr(ord(s[i])+32);
+     else
+      gccfilename[i]:=s[i];
+     end;
+   end;
+  {$ifndef TP}
+    {$ifopt H+}
+      setlength(gccfilename,length(s));
+    {$else}
+      gccfilename[0]:=s[0];
+    {$endif}
+  {$else}
+    gccfilename[0]:=s[0];
+  {$endif}
+end;
+
+
+function tostr(i : longint) : string;
+var
+  hs : string;
+begin
+  str(i,hs);
+  tostr:=hs;
+end;
+
+
+{****************************************************************************
+                         Predefined default Handlers
+****************************************************************************}
+
+{ predefined handler when then compiler stops }
+procedure def_stop;
+begin
+{$ifndef USEEXCEPT}
+  Halt(1);
+{$else USEEXCEPT}
+  Halt(1);
+{$endif USEEXCEPT}
+end;
+
+
+function def_status:boolean;
+begin
+  def_status:=false; { never stop }
+{ Status info?, Called every line }
+  if ((status.verbosity and V_Status)<>0) then
+   begin
+     if (status.compiledlines=1) then
+       WriteLn(memavail shr 10,' Kb Free');
+     if (status.currentline>0) and (status.currentline mod 100=0) then
+{$ifdef FPC}
+       WriteLn(status.currentline,' ',memavail shr 10,'/',system.heapsize shr 10,' Kb Free');
+{$else}
+       WriteLn(status.currentline,' ',memavail shr 10,' Kb Free');
+{$endif}
+   end
+end;
+
+
+Function def_comment(Level:Longint;const s:string):boolean;
+const
+  { RHIDE expect gcc like error output }
+  rh_errorstr='error: ';
+  rh_warningstr='warning: ';
+  fatalstr='Fatal: ';
+  errorstr='Error: ';
+  warningstr='Warning: ';
+  notestr='Note: ';
+  hintstr='Hint: ';
+var
+  hs : string;
+begin
+  def_comment:=false; { never stop }
+  if (status.verbosity and Level)=Level then
+   begin
+     hs:='';
+     if not(status.use_gccoutput) then
+       begin
+         if (status.verbosity and Level)=V_Hint then
+           hs:=hintstr;
+         if (status.verbosity and Level)=V_Note then
+           hs:=notestr;
+         if (status.verbosity and Level)=V_Warning then
+           hs:=warningstr;
+         if (status.verbosity and Level)=V_Error then
+           hs:=errorstr;
+         if (status.verbosity and Level)=V_Fatal then
+           hs:=fatalstr;
+       end
+     else
+       begin
+         if (status.verbosity and Level)=V_Hint then
+           hs:=rh_warningstr;
+         if (status.verbosity and Level)=V_Note then
+           hs:=rh_warningstr;
+         if (status.verbosity and Level)=V_Warning then
+           hs:=rh_warningstr;
+         if (status.verbosity and Level)=V_Error then
+           hs:=rh_errorstr;
+         if (status.verbosity and Level)=V_Fatal then
+           hs:=rh_errorstr;
+       end;
+     if (Level<=V_ShowFile) and (status.currentsource<>'') and (status.currentline>0) then
+      begin
+        { Adding the column should not confuse RHIDE,
+        even if it does not yet use it PM
+        but only if it is after error or warning !! PM }
+        if status.currentcolumn>0 then
+         begin
+           if status.use_gccoutput then
+             hs:=gccfilename(status.currentsource)+':'+tostr(status.currentline)+': '+hs
+                 +tostr(status.currentcolumn)+': '
+           else
+             hs:=status.currentsource+'('+tostr(status.currentline)
+                 +','+tostr(status.currentcolumn)+') '+hs;
+         end
+        else
+         begin
+           if status.use_gccoutput then
+             hs:=gccfilename(status.currentsource)+': '+hs+tostr(status.currentline)+': '
+           else
+             hs:=status.currentsource+'('+tostr(status.currentline)+') '+hs;
+         end;
+      end;
+   { add the message to the text }
+     hs:=hs+s;
+{$ifdef FPC}
+     if status.use_stderr then
+      begin
+        writeln(stderr,hs);
+        flush(stderr);
+      end
+     else
+{$endif}
+      begin
+        if status.use_redir then
+         writeln(status.redirfile,hs)
+        else
+         writeln(hs);
+      end;
+   end;
+end;
+
+
+function def_internalerror(i : longint) : boolean;
+begin
+  do_comment(V_Fatal,'Internal error '+tostr(i));
+  def_internalerror:=true;
+end;
+
+
+end.
+{
+  $Log$
+  Revision 1.1  1998-12-22 14:27:54  peter
+    * moved
+
+  Revision 1.1  1998/12/10 23:54:28  peter
+    * initial version of the FV IDE
+    * initial version of a fake compiler
+
+}

ide/fake/compiler.pas

@@ -0,0 +1,31 @@
+{
+    $Id$
+
+    Fake compiler unit
+}
+unit compiler;
+interface
+
+function Compile(const cmd:string):longint;
+
+implementation
+uses
+  comphook;
+
+function Compile(const cmd:string):longint;
+begin
+  do_comment(V_Info,'Fake Compiler');
+  do_comment(V_Info,'Cmd = "'+cmd+'"');
+end;
+
+end.
+{
+  $Log$
+  Revision 1.1  1998-12-22 14:27:54  peter
+    * moved
+
+  Revision 1.1  1998/12/10 23:54:28  peter
+    * initial version of the FV IDE
+    * initial version of a fake compiler
+
+}

ide/fake/globtype.pas

@@ -0,0 +1,117 @@
+{
+    $Id$
+    Copyright (c) 1993-98 by Florian Klaempfl, Pierre Muller
+
+    Global types
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    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.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ ****************************************************************************
+}
+unit globtype;
+interface
+
+    const
+       maxidlen = 64;
+
+    type
+       { Switches which can be changed locally }
+       tlocalswitch = (cs_localnone,
+         { codegen }
+         cs_check_overflow,cs_check_range,cs_check_io,cs_check_stack,
+         cs_omitstackframe,cs_do_assertion,cs_generate_rtti,
+         { mmx }
+         cs_mmx,cs_mmx_saturation,
+         { parser }
+         cs_typed_addresses,cs_strict_var_strings,cs_ansistrings
+       );
+       tlocalswitches=set of tlocalswitch;
+
+       { Switches which can be changed only at the beginning of a new module }
+       tmoduleswitch = (cs_modulenone,
+         { parser }
+         cs_fp_emulation,cs_extsyntax,cs_openstring,
+         { support }
+         cs_support_inline,cs_support_goto,cs_support_macro,
+         cs_support_c_operators,
+         { generation }
+         cs_profile,cs_debuginfo,cs_browser,cs_local_browser,cs_compilesystem,
+         { linking }
+         cs_smartlink,cs_create_sharedlib,cs_create_staticlib
+       );
+       tmoduleswitches=set of tmoduleswitch;
+
+       { Switches which can be changed only for a whole program/compilation,
+         mostly set with commandline }
+       tglobalswitch = (cs_globalnone,
+         { parameter switches }
+         cs_check_unit_name,cs_constructor_name,cs_static_keyword,
+         { units }
+         cs_load_objpas_unit,
+         cs_load_gpc_unit,
+         { optimizer }
+         cs_regalloc,cs_uncertainopts,cs_littlesize,cs_optimize,
+         cs_fastoptimize, cs_slowoptimize,
+         { debugger }
+         cs_gdb_dbx,cs_gdb_gsym,cs_gdb_heaptrc,
+         { assembling }
+         cs_asm_leave,cs_asm_extern,cs_asm_pipe,cs_asm_source,
+         { linking }
+         cs_link_extern,cs_link_shared,cs_link_static,cs_link_deffile
+       );
+       tglobalswitches=set of tglobalswitch;
+
+       { Switches which can be changed by a mode (fpc,tp7,delphi) }
+       tmodeswitch = (m_none,m_all, { needed for keyword }
+         { generic }
+         m_fpc,m_delphi,m_tp,m_gpc,
+         { more specific }
+         m_class,m_objpas,m_result,m_string_pchar,m_cvar_support,
+         m_nested_comment,m_tp_procvar,m_repeat_forward,
+         m_pointer_2_procedure, { allows the assignement of pointers to
+                                  procedure variables                     }
+         m_autoderef            { does auto dereferencing of struct. vars }
+       );
+       tmodeswitches=set of tmodeswitch;
+
+       { win32 sub system }
+       tapptype = (at_gui,at_cui);
+
+       { currently parsed block type }
+       tblock_type = (bt_general,bt_type,bt_const);
+
+       stringid = string[maxidlen];
+
+       tnormalset = set of byte; { 256 elements set }
+       pnormalset = ^tnormalset;
+
+       pdouble    = ^double;
+       pbyte      = ^byte;
+       pword      = ^word;
+       plongint   = ^longint;
+
+implementation
+
+end.
+{
+  $Log$
+  Revision 1.1  1998-12-22 14:27:54  peter
+    * moved
+
+  Revision 1.1  1998/12/10 23:54:28  peter
+    * initial version of the FV IDE
+    * initial version of a fake compiler
+
+}
+

ide/fake/systems.pas

@@ -0,0 +1,1238 @@
+{
+    $Id$
+    Copyright (C) 1995,97 by Florian Klaempfl
+
+    This unit contains information about the target systems supported
+    (these are not processor specific)
+
+    This progsam is free software; you can redistribute it and/or modify
+    iu under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 3 of the License, or
+    (at your option) any later version.
+
+    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.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge- MA 02139, USA.
+
+ ****************************************************************************
+}
+unit systems;
+
+  interface
+
+   type
+       tendian = (endian_little,endian_big);
+
+       ttargetcpu=(no_cpu
+            ,i386,m68k,alpha
+       );
+
+       tprocessors = (no_processor
+            ,Class386,ClassP5,ClassP6
+            ,MC68000,MC68100,MC68020
+       );
+
+
+     type
+       tasmmode= (asmmode_none
+            ,asmmode_i386_direct,asmmode_i386_att,asmmode_i386_intel
+            ,asmmode_m68k_mot
+       );
+     const
+       {$ifdef i386} i386asmmodecnt=3; {$else} i386asmmodecnt=0; {$endif}
+       {$ifdef m68k} m68kasmmodecnt=1; {$else} m68kasmmodecnt=0; {$endif}
+       asmmodecnt=i386asmmodecnt+m68kasmmodecnt+1;
+
+     type
+       ttarget = (target_none
+            ,target_i386_GO32V1,target_i386_GO32V2,target_i386_linux,
+            target_i386_OS2,target_i386_Win32
+            ,target_m68k_Amiga,target_m68k_Atari,target_m68k_Mac,
+            target_m68k_linux,target_m68k_PalmOS
+       );
+     const
+       {$ifdef i386} i386targetcnt=5; {$else} i386targetcnt=0; {$endif}
+       {$ifdef m68k} m68ktargetcnt=5; {$else} m68ktargetcnt=0; {$endif}
+       targetcnt=i386targetcnt+m68ktargetcnt+1;
+
+     type
+       tasm = (as_none
+            ,as_i386_o,as_i386_o_aout,as_i386_asw,
+            as_i386_nasmcoff,as_i386_nasmelf,as_i386_nasmobj,
+            as_i386_tasm,as_i386_masm
+            ,as_m68k_o,as_m68k_gas,as_m68k_mit,as_m68k_mot,as_m68k_mpw
+       );
+     const
+       {$ifdef i386} i386asmcnt=8; {$else} i386asmcnt=0; {$endif}
+       {$ifdef m68k} m68kasmcnt=5; {$else} m68kasmcnt=0; {$endif}
+       asmcnt=i386asmcnt+m68kasmcnt+1;
+
+     type
+       tlink = (link_none
+            ,link_i386_ld,link_i386_ldgo32v1,
+            link_i386_ldgo32v2,link_i386_ldw,
+            link_i386_ldos2
+            ,link_m68k_ld
+       );
+     const
+       {$ifdef i386} i386linkcnt=5; {$else} i386linkcnt=0; {$endif}
+       {$ifdef m68k} m68klinkcnt=1; {$else} m68klinkcnt=0; {$endif}
+       linkcnt=i386linkcnt+m68klinkcnt+1;
+
+     type
+       tar = (ar_none
+            ,ar_i386_ar,ar_i386_arw
+            ,ar_m68k_ar
+       );
+     const
+       {$ifdef i386} i386arcnt=2; {$else} i386arcnt=0; {$endif}
+       {$ifdef m68k} m68karcnt=1; {$else} m68karcnt=0; {$endif}
+       arcnt=i386arcnt+m68karcnt+1;
+
+     type
+       tos = ( os_none,
+            os_i386_GO32V1,os_i386_GO32V2,os_i386_Linux,os_i386_OS2,
+            os_i386_Win32,
+            os_m68k_Amiga,os_m68k_Atari,os_m68k_Mac,os_m68k_Linux,
+            os_m68k_PalmOS
+       );
+     const
+       i386oscnt=5;
+       m68koscnt=5;
+       oscnt=i386oscnt+m68koscnt+1;
+
+   type
+       tosinfo = packed record
+          id        : tos;
+          name      : string[30];
+          shortname : string[8];
+          sharedlibext,
+          staticlibext,
+          sourceext,
+          pasext,
+          exeext,
+          scriptext : string[4];
+          libprefix : string[3];
+          Cprefix   : string[2];
+          newline   : string[2];
+          endian    : tendian;
+          stackalignment : {longint this is a little overkill no ?? }byte;
+          size_of_pointer : byte;
+          size_of_longint : byte;
+          use_bound_instruction : boolean;
+          use_function_relative_addresses : boolean;
+       end;
+
+       tasminfo = packed record
+          id          : tasm;
+          idtxt       : string[8];
+          asmbin      : string[8];
+          asmcmd      : string[50];
+          externals   : boolean;
+          labelprefix : string[2];
+          comment     : string[2];
+       end;
+
+       tlinkinfo = packed record
+          id            : tlink;
+          linkbin       : string[8];
+          linkcmd       : string[127];
+          binders       : word;
+          bindbin       : array[1..2]of string[8];
+          bindcmd       : array[1..2]of string[127];
+          stripopt      : string[2];
+          libpathprefix : string[13];
+          libpathsuffix : string[2];
+          groupstart    : string[8];
+          groupend      : string[2];
+          inputstart    : string[8];
+          inputend      : string[2];
+          libprefix     : string[2];
+       end;
+
+       tarinfo = packed record
+          id      : tar;
+          arbin   : string[8];
+          arcmd   : string[50];
+       end;
+
+       ttargetinfo = packed record
+          target      : ttarget;
+          cpu         : ttargetcpu;
+          short_name  : string[8];
+          unit_env    : string[12];
+          system_unit : string[8];
+          smartext,
+          unitext,
+          unitlibext,
+          asmext,
+          objext,
+          exeext      : string[4];
+          os          : tos;
+          link        : tlink;
+          assem       : tasm;
+          ar          : tar;
+          heapsize,
+          maxheapsize,
+          stacksize   : longint;
+       end;
+
+       tasmmodeinfo=packed record
+          id    : tasmmode;
+          idtxt : string[8];
+       end;
+
+    var
+       target_cpu  : ttargetcpu;
+       target_info : ttargetinfo;
+       target_os   : tosinfo;
+       target_asm  : tasminfo;
+       target_link : tlinkinfo;
+       target_ar   : tarinfo;
+       source_os   : tosinfo;
+
+    function set_string_target(s : string) : boolean;
+    function set_string_asm(s : string) : boolean;
+    function set_string_asmmode(s:string;var t:tasmmode):boolean;
+
+
+implementation
+
+    const
+
+{****************************************************************************
+                                 OS Info
+****************************************************************************}
+       os_infos : array[1..oscnt] of tosinfo = (
+          (
+            id           : os_none;
+            name         : 'No operating system';
+            shortname    : 'none'
+          ),
+          (
+            id           : os_i386_go32v1;
+            name         : 'GO32 V1 DOS extender';
+            shortname    : 'go32v1';
+            sharedlibext : '.dll';
+            staticlibext : '.a';
+            sourceext    : '.pp';
+            pasext       : '.pas';
+            exeext       : '';      { No .exe, the linker only output a.out ! }
+            scriptext    : '.bat';
+            libprefix    : '';
+            Cprefix      : '_';
+            newline      : #13#10;
+            endian       : endian_little;
+            stackalignment : 2;
+            size_of_pointer : 4;
+            size_of_longint : 4;
+            use_bound_instruction : false;
+            use_function_relative_addresses : true
+          ),
+          (
+            id           : os_i386_go32v2;
+            name         : 'GO32 V2 DOS extender';
+            shortname    : 'go32v2';
+            sharedlibext : '.dll';
+            staticlibext : '.a';
+            sourceext    : '.pp';
+            pasext       : '.pas';
+            exeext       : '.exe';
+            scriptext    : '.bat';
+            libprefix    : '';
+            Cprefix      : '_';
+            newline      : #13#10;
+            endian       : endian_little;
+            stackalignment : 2;
+            size_of_pointer : 4;
+            size_of_longint : 4;
+            use_bound_instruction : true;
+            use_function_relative_addresses : true
+          ),
+          (
+            id           : os_i386_linux;
+            name         : 'Linux for i386';
+            shortname    : 'linux';
+            sharedlibext : '.so';
+            staticlibext : '.a';
+            sourceext    : '.pp';
+            pasext       : '.pas';
+            exeext       : '';
+            scriptext    : '.sh';
+            libprefix    : 'lib';
+            Cprefix      : '';
+            newline      : #10;
+            endian       : endian_little;
+            stackalignment : 4;
+            size_of_pointer : 4;
+            size_of_longint : 4;
+            use_bound_instruction : false;
+            use_function_relative_addresses : true
+          ),
+          (
+            id           : os_i386_os2;
+            name         : 'OS/2 via EMX';
+            shortname    : 'os2';
+            sharedlibext : '.ao2';
+            staticlibext : '.ao2';
+            sourceext    : '.pas';
+            pasext       : '.pp';
+            exeext       : '.exe';
+            scriptext    : '.cmd';
+            libprefix    : '';
+            Cprefix      : '_';
+            newline      : #13#10;
+            endian       : endian_little;
+            stackalignment : 2;
+            size_of_pointer : 4;
+            size_of_longint : 4;
+            use_bound_instruction : false;
+            use_function_relative_addresses : false
+          ),
+          (
+            id           : os_i386_win32;
+            name         : 'Win32 for i386';
+            shortname    : 'win32';
+            sharedlibext : '.dll';
+            staticlibext : '.aw';
+            sourceext    : '.pp';
+            pasext       : '.pas';
+            exeext       : '.exe';
+            scriptext    : '.bat';
+            libprefix    : 'lib';
+            Cprefix      : '_';
+            newline      : #13#10;
+            endian       : endian_little;
+            stackalignment : 4;
+            size_of_pointer : 4;
+            size_of_longint : 4;
+            use_bound_instruction : true;
+            use_function_relative_addresses : true
+          ),
+          (
+            id           : os_m68k_amiga;
+            name         : 'Commodore Amiga';
+            shortname    : 'amiga';
+            sharedlibext : '.library';
+            staticlibext : '.a';
+            sourceext    : '.pp';
+            pasext       : '.pas';
+            exeext       : '';
+            scriptext    : '';
+            libprefix    : '';
+            Cprefix      : '_';
+            newline      : #10;
+            endian       : endian_big;
+            stackalignment : 2;
+            size_of_pointer : 4;
+            size_of_longint : 4;
+            use_bound_instruction : false;
+            use_function_relative_addresses : false
+          ),
+          (
+            id           : os_m68k_atari;
+            name         : 'Atari ST/STE';
+            shortname    : 'atari';
+            sharedlibext : '.dll';
+            staticlibext : '.a';
+            sourceext    : '.pp';
+            pasext       : '.pas';
+            exeext       : '.tpp';
+            scriptext    : '';
+            libprefix    : '';
+            Cprefix      : '_';
+            newline      : #10;
+            endian       : endian_big;
+            stackalignment : 2;
+            size_of_pointer : 4;
+            size_of_longint : 4;
+            use_bound_instruction : false;
+            use_function_relative_addresses : false
+          ),
+          (
+            id           : os_m68k_mac;
+            name         : 'Macintosh m68k';
+            shortname    : 'mac';
+            sharedlibext : '.dll';
+            staticlibext : '.a';
+            sourceext    : '.pp';
+            pasext       : '.pas';
+            exeext       : '.tpp';
+            scriptext    : '';
+            libprefix    : '';
+            Cprefix      : '_';
+            newline      : #13;
+            endian       : endian_big;
+            stackalignment : 2;
+            size_of_pointer : 4;
+            size_of_longint : 4;
+            use_bound_instruction : false;
+            use_function_relative_addresses : false
+          ),
+          (
+            id           : os_m68k_linux;
+            name         : 'Linux for m68k';
+            shortname    : 'linux';
+            sharedlibext : '.so';
+            staticlibext : '.a';
+            sourceext    : '.pp';
+            pasext       : '.pas';
+            exeext       : '';
+            scriptext    : '.sh';
+            libprefix    : 'lib';
+            Cprefix      : '';
+            newline      : #10;
+            endian       : endian_big;
+            stackalignment : 2;
+            size_of_pointer : 4;
+            size_of_longint : 4;
+            use_bound_instruction : false;
+            use_function_relative_addresses : true
+          ),
+          (
+            id           : os_m68k_palmos;
+            name         : 'PalmOS';
+            shortname    : 'palmos';
+            sharedlibext : '.so';
+            staticlibext : '.a';
+            sourceext    : '.pp';
+            pasext       : '.pas';
+            exeext       : '';
+            scriptext    : '.sh';
+            libprefix    : 'lib';
+            Cprefix      : '_';
+            newline      : #10;
+            endian       : endian_big;
+            stackalignment : 2;
+            size_of_pointer : 4;
+            size_of_longint : 4;
+            use_bound_instruction : false;
+            use_function_relative_addresses : false
+          )
+          );
+
+
+{****************************************************************************
+                             Assembler Info
+****************************************************************************}
+
+       as_infos : array[1..asmcnt] of tasminfo = (
+          (
+            id     : as_none;
+            idtxt  : 'no'
+          )
+{$ifdef i386}
+          ,(
+            id     : as_i386_o;
+            idtxt  : 'O';
+            asmbin : 'as';
+            asmcmd : '-o $OBJ $ASM';
+            externals : false;
+            labelprefix : '.L';
+            comment : '# '
+          )
+          ,(
+            id     : as_i386_o_aout;
+            idtxt  : 'O_AOUT';
+            asmbin : 'as';
+            asmcmd : '-o $OBJ $ASM';
+            externals : false;
+            labelprefix : 'L';
+            comment : '# '
+          )
+          ,(
+            id     : as_i386_asw;
+            idtxt  : 'ASW';
+            asmbin : 'asw';
+            asmcmd : '-o $OBJ $ASM';
+            externals : false;
+            labelprefix : '.L';
+            comment : '# '
+          )
+          ,(
+            id     : as_i386_nasmcoff;
+            idtxt  : 'NASMCOFF';
+            asmbin : 'nasm';
+            asmcmd : '-f coff -o $OBJ $ASM';
+            externals : true;
+            labelprefix : 'L';
+            comment : '; '
+          )
+          ,(
+            id     : as_i386_nasmelf;
+            idtxt  : 'NASMELF';
+            asmbin : 'nasm';
+            asmcmd : '-f elf -o $OBJ $ASM';
+            externals : true;
+            labelprefix : 'L';
+            comment : '; '
+          )
+          ,(
+            id     : as_i386_nasmobj;
+            idtxt  : 'NASMOBJ';
+            asmbin : 'nasm';
+            asmcmd : '-f obj -o $OBJ $ASM';
+            externals : true;
+            labelprefix : 'L';
+            comment : '; '
+          )
+          ,(
+            id     : as_i386_tasm;
+            idtxt  : 'TASM';
+            asmbin : 'tasm';
+            asmcmd : '/m2 $ASM $OBJ';
+            externals : true;
+            labelprefix : '.L';
+            comment : '; '
+          )
+          ,(
+            id     : as_i386_masm;
+            idtxt  : 'MASM';
+            asmbin : 'masm';
+            asmcmd : '$ASM $OBJ';
+            externals : true;
+            labelprefix : '.L';
+            comment : '; '
+          )
+{$endif i386}
+{$ifdef m68k}
+          ,(
+            id     : as_m68k_o;
+            idtxt  : 'O';
+            asmbin : 'as';
+            asmcmd : '-o $OBJ $ASM';
+            externals : false;
+            labelprefix : '.L';
+            comment : '# '
+          )
+          ,(
+            id     : as_m68k_gas;
+            idtxt  : 'GAS';
+            asmbin : 'as68k'; { Gas for the Amiga}
+            asmcmd : '--register-prefix-optional -o $OBJ $ASM';
+            externals : false;
+            labelprefix : '.L';
+            comment : '| '
+          )
+          ,(
+            id     : as_m68k_mit;
+            idtxt  : 'MIT';
+            asmbin : '';
+            asmcmd : '-o $OBJ $ASM';
+            externals : false;
+            labelprefix : '.L';
+            comment : '| '
+          )
+          ,(
+            id     : as_m68k_mot;
+            idtxt  : 'MOT';
+            asmbin : '';
+            asmcmd : '-o $OBJ $ASM';
+            externals : false;
+            labelprefix : '__L';
+            comment : '| '
+          )
+          ,(
+            id     : as_m68k_mpw;
+            idtxt  : 'MPW';
+            asmbin : '';
+            asmcmd : '-model far -o $OBJ $ASM';
+            externals : false;
+            labelprefix : '__L';
+            comment : '| '
+          )
+{$endif m68k}
+          );
+
+{****************************************************************************
+                            Linker Info
+****************************************************************************}
+       link_infos : array[1..linkcnt] of tlinkinfo = (
+          (
+            id      : link_none
+          )
+{$ifdef i386}
+          ,(
+            id      : link_i386_ld;
+            linkbin : 'ld';
+            linkcmd : '$OPT -o $EXE $RES';
+{* Changes made by Ozerski 23.10.1998}
+            binders:0;
+            bindbin : ('','');
+            bindcmd : ('','');
+{* End changes}
+            stripopt   : '-s';
+            libpathprefix : 'SEARCH_DIR(';
+            libpathsuffix : ')';
+            groupstart : 'GROUP(';
+            groupend   : ')';
+            inputstart : 'INPUT(';
+            inputend   : ')';
+            libprefix  : '-l'
+          )
+          ,(
+            id      : link_i386_ldgo32v1;
+            linkbin : 'ld';
+            linkcmd : '-oformat coff-go32 $OPT -o $EXE @$RES';
+{* Changes made by Ozerski 23.10.1998}
+            binders:1;
+            bindbin : ('aout2exe','');
+            bindcmd : ('$EXE','');
+{* End changes}
+            stripopt   : '-s';
+            libpathprefix : '-L';
+            libpathsuffix : '';
+            groupstart : '-(';
+            groupend   : '-)';
+            inputstart : '';
+            inputend   : '';
+            libprefix  : '-l'
+          )
+          ,(
+            id      : link_i386_ldgo32v2;
+            linkbin : 'ld';
+            linkcmd : '-oformat coff-go32-exe $OPT -o $EXE @$RES';
+{* Changes made by Ozerski 23.10.1998}
+            binders:0;
+            bindbin : ('','');
+            bindcmd : ('','');
+{* End changes}
+            stripopt   : '-s';
+            libpathprefix : '-L';
+            libpathsuffix : '';
+            groupstart : '-(';
+            groupend   : '-)';
+            inputstart : '';
+            inputend   : '';
+            libprefix  : '-l'
+          )
+          ,(
+            id      : link_i386_ldw;
+            linkbin : 'ldw';
+            linkcmd : '$OPT -o $EXE $RES';
+{* Changes made by Ozerski 23.10.1998}
+            binders:0;
+            bindbin : ('dlltool','ldw');
+            bindcmd : ('--as asw.exe --dllname $EXE --output-exp exp.$$$',
+                       '-s $OPT -o $EXE $RES exp.$$$');
+{* End changes}
+            stripopt   : '-s';
+            libpathprefix : 'SEARCH_DIR(';
+            libpathsuffix : ')';
+            groupstart : 'GROUP(';
+            groupend   : ')';
+            inputstart : 'INPUT(';
+            inputend   : ')';
+            libprefix  : '-l'
+          )
+          ,(
+            id      : link_i386_ldos2;
+            linkbin : 'ld';  { Os/2 }
+            linkcmd : '-o $EXE @$RES';
+{* Changes made by Ozerski 23.10.1998}
+            binders:1;
+            bindbin : ('emxbind','');
+            bindcmd : ('-b -k$STACKKB -h$HEAPMB -o $EXE.exe $EXE -aim -s$DOSHEAPKB','');
+{* End changes}
+            stripopt   : '-s';
+            libpathprefix : '-L';
+            libpathsuffix : '';
+            groupstart : ''; {Linker is too primitive...}
+            groupend   : '';
+            inputstart : '';
+            inputend   : '';
+            libprefix  : '-l'
+          )
+{$endif i386}
+{$ifdef m68k}
+          ,(
+            id      : link_m68k_ld;
+            linkbin : 'ld';
+            linkcmd : '$OPT -o $EXE $RES';
+{* Changes made by Ozerski 23.10.1998}
+            binders:0;
+            bindbin : ('','');
+            bindcmd : ('','');
+{* End changes}
+            stripopt   : '-s';
+            libpathprefix : 'SEARCH_DIR(';
+            libpathsuffix : ')';
+            groupstart : 'GROUP(';
+            groupend   : ')';
+            inputstart : 'INPUT(';
+            inputend   : ')';
+            libprefix  : '-l'
+          )
+{$endif m68k}
+          );
+
+{****************************************************************************
+                                 Ar Info
+****************************************************************************}
+           ar_infos : array[1..arcnt] of tarinfo = (
+          (
+            id    : ar_none
+          )
+{$ifdef i386}
+          ,(
+            id    : ar_i386_ar;
+            arbin : 'ar';
+            arcmd : 'rs $LIB $FILES'
+          ),
+          (
+            id    : ar_i386_arw;
+            arbin : 'arw';
+            arcmd : 'rs $LIB $FILES'
+          )
+{$endif i386}
+{$ifdef m68k}
+          ,(
+            id    : ar_m68k_ar;
+            arbin : 'ar';
+            arcmd : 'rs $LIB $FILES'
+          )
+{$endif m68k}
+          );
+
+{****************************************************************************
+                            Targets Info
+****************************************************************************}
+       target_infos : array[1..targetcnt] of ttargetinfo = (
+          (
+            target      : target_none;
+            cpu         : no_cpu;
+            short_name  : 'notarget'
+          )
+{$ifdef i386}
+          ,(
+            target      : target_i386_GO32V1;
+            cpu         : i386;
+            short_name  : 'GO32V1';
+            unit_env    : 'GO32V1UNITS';
+            system_unit : 'SYSTEM';
+            smartext    : '.sl';
+            unitext     : '.pp1';
+            unitlibext  : '.ppl';
+            asmext      : '.s1';
+            objext      : '.o1';
+            exeext      : ''; { The linker produces a.out }
+            os          : os_i386_GO32V1;
+            link        : link_i386_ldgo32v1;
+            assem       : as_i386_o;
+            ar          : ar_i386_ar;
+            heapsize    : 2048*1024;
+            maxheapsize : 32768*1024;
+            stacksize   : 16384
+          ),
+          (
+            target      : target_i386_GO32V2;
+            cpu         : i386;
+            short_name  : 'GO32V2';
+            unit_env    : 'GO32V2UNITS';
+            system_unit : 'SYSTEM';
+            smartext    : '.sl';
+            unitext     : '.ppu';
+            unitlibext  : '.ppl';
+            asmext      : '.s';
+            objext      : '.o';
+            exeext      : '.exe';
+            os          : os_i386_GO32V2;
+            link        : link_i386_ldgo32v2;
+            assem       : as_i386_o;
+            ar          : ar_i386_ar;
+            heapsize    : 2048*1024;
+            maxheapsize : 32768*1024;
+            stacksize   : 16384
+          ),
+          (
+            target      : target_i386_LINUX;
+            cpu         : i386;
+            short_name  : 'LINUX';
+            unit_env    : 'LINUXUNITS';
+            system_unit : 'syslinux';
+            smartext    : '.sl';
+            unitext     : '.ppu';
+            unitlibext  : '.ppl';
+            asmext      : '.s';
+            objext      : '.o';
+            exeext      : '';
+            os          : os_i386_Linux;
+            link        : link_i386_ld;
+            assem       : as_i386_o;
+            ar          : ar_i386_ar;
+            heapsize    : 2048*1024;
+            maxheapsize : 32768*1024;
+            stacksize   : 8192
+          ),
+          (
+            target      : target_i386_OS2;
+            cpu         : i386;
+            short_name  : 'OS2';
+            unit_env    : 'OS2UNITS';
+            system_unit : 'SYSOS2';
+            smartext    : '.sl';
+            unitext     : '.ppo';
+            unitlibext  : '.ppl';
+            asmext      : '.so2';
+            objext      : '.oo2';
+            exeext      : ''; { The linker produces a.out }
+            os          : os_i386_OS2;
+            link        : link_i386_ldos2;
+            assem       : as_i386_o_aout;
+            ar          : ar_i386_ar;
+            heapsize    : 256*1024;
+            maxheapsize : 32768*1024;
+            stacksize   : 32768
+          ),
+          (
+            target      : target_i386_WIN32;
+            cpu         : i386;
+            short_name  : 'WIN32';
+            unit_env    : 'WIN32UNITS';
+            system_unit : 'SYSWIN32';
+            smartext    : '.slw';
+            unitext     : '.ppw';
+            unitlibext  : '.ppl';
+            asmext      : '.sw';
+            objext      : '.ow';
+            exeext      : '.exe';
+            os          : os_i386_Win32;
+            link        : link_i386_ldw;
+            assem       : as_i386_asw;
+            ar          : ar_i386_arw;
+            heapsize    : 2048*1024;
+            maxheapsize : 32768*1024;
+            stacksize   : 32768
+          )
+{$endif i386}
+{$ifdef m68k}
+          ,(
+            target      : target_m68k_Amiga;
+            cpu         : m68k;
+            short_name  : 'AMIGA';
+            unit_env    : '';
+            system_unit : 'sysamiga';
+            smartext    : '.sl';
+            unitext     : '.ppa';
+            unitlibext  : '.ppl';
+            asmext      : '.asm';
+            objext      : '.o';
+            exeext      : '';
+            os          : os_m68k_Amiga;
+            link        : link_m68k_ld;
+            assem       : as_m68k_o;
+            ar          : ar_m68k_ar;
+            heapsize    : 128*1024;
+            maxheapsize : 32768*1024;
+            stacksize   : 8192
+          ),
+          (
+            target      : target_m68k_Atari;
+            cpu         : m68k;
+            short_name  : 'ATARI';
+            unit_env    : '';
+            system_unit : 'SYSATARI';
+            smartext    : '.sl';
+            unitext     : '.ppt';
+            unitlibext  : '.ppl';
+            asmext      : '.s';
+            objext      : '.o';
+            exeext      : '.ttp';
+            os          : os_m68k_Atari;
+            link        : link_m68k_ld;
+            assem       : as_m68k_o;
+            ar          : ar_m68k_ar;
+            heapsize    : 16*1024;
+            maxheapsize : 32768*1024;
+            stacksize   : 8192
+          ),
+          (
+            target      : target_m68k_Mac;
+            cpu         : m68k;
+            short_name  : 'MACOS';
+            unit_env    : '';
+            system_unit : 'sysmac';
+            smartext    : '.sl';
+            unitext     : '.ppt';
+            unitlibext  : '.ppl';
+            asmext      : '.a';
+            objext      : '.o';
+            exeext      : '';
+            os          : os_m68k_Mac;
+            link        : link_m68k_ld;
+            assem       : as_m68k_mpw;
+            ar          : ar_m68k_ar;
+            heapsize    : 128*1024;
+            maxheapsize : 32768*1024;
+            stacksize   : 8192
+          ),
+          (
+            target      : target_m68k_linux;
+            cpu         : m68k;
+            short_name  : 'LINUX';
+            unit_env    : 'LINUXUNITS';
+            system_unit : 'syslinux';
+            smartext    : '.sl';
+            unitext     : '.ppu';
+            unitlibext  : '.ppl';
+            asmext      : '.s';
+            objext      : '.o';
+            exeext      : '';
+            os          : os_m68k_Linux;
+            link        : link_m68k_ld;
+            assem       : as_m68k_o;
+            ar          : ar_m68k_ar;
+            heapsize    : 128*1024;
+            maxheapsize : 32768*1024;
+            stacksize   : 8192
+          ),
+          (
+            target      : target_m68k_PalmOS;
+            cpu         : m68k;
+            short_name  : 'PALMOS';
+            unit_env    : 'PALMUNITS';
+            system_unit : 'syspalm';
+            smartext    : '.sl';
+            unitext     : '.ppu';
+            unitlibext  : '.ppl';
+            asmext      : '.s';
+            objext      : '.o';
+            exeext      : '';
+            os          : os_m68k_PalmOS;
+            link        : link_m68k_ld;
+            assem       : as_m68k_o;
+            ar          : ar_m68k_ar;
+            heapsize    : 128*1024;
+            maxheapsize : 32768*1024;
+            stacksize   : 8192
+          )
+{$endif m68k}
+          );
+
+{****************************************************************************
+                             AsmModeInfo
+****************************************************************************}
+       asmmodeinfos : array[1..asmmodecnt] of tasmmodeinfo = (
+          (
+            id    : asmmode_none;
+            idtxt : 'none'
+          )
+{$ifdef i386}
+          ,(
+            id    : asmmode_i386_direct;
+            idtxt : 'DIRECT'
+          ),
+          (
+            id    : asmmode_i386_att;
+            idtxt : 'ATT'
+          ),
+          (
+            id    : asmmode_i386_intel;
+            idtxt : 'INTEL'
+          )
+{$endif i386}
+{$ifdef m68k}
+          ,(
+            id    : asmmode_m68k_mot;
+            idtxt : 'MOT'
+          )
+{$endif m68k}
+          );
+
+{****************************************************************************
+                                Helpers
+****************************************************************************}
+
+function upper(const s : string) : string;
+var
+  i  : longint;
+begin
+  for i:=1 to length(s) do
+   if s[i] in ['a'..'z'] then
+    upper[i]:=char(byte(s[i])-32)
+   else
+    upper[i]:=s[i];
+{$ifndef TP}
+  {$ifopt H+}
+    SetLength(upper,length(s));
+  {$else}
+    upper[0]:=s[0];
+  {$endif}
+{$else}
+  upper[0]:=s[0];
+{$endif}
+end;
+
+
+function set_target_os(t:tos):boolean;
+var
+  i : longint;
+begin
+  set_target_os:=false;
+  { target 1 is none }
+  for i:=2 to oscnt do
+   if os_infos[i].id=t then
+    begin
+      target_os:=os_infos[i];
+      set_target_os:=true;
+      exit;
+    end;
+end;
+
+
+function set_target_asm(t:tasm):boolean;
+var
+  i : longint;
+begin
+  set_target_asm:=false;
+  for i:=1 to asmcnt do
+   if as_infos[i].id=t then
+    begin
+      target_asm:=as_infos[i];
+      set_target_asm:=true;
+      exit;
+    end;
+end;
+
+
+function set_target_link(t:tlink):boolean;
+var
+  i : longint;
+begin
+  set_target_link:=false;
+  for i:=1 to linkcnt do
+   if link_infos[i].id=t then
+    begin
+      target_link:=link_infos[i];
+      set_target_link:=true;
+      exit;
+    end;
+end;
+
+
+function set_target_ar(t:tar):boolean;
+var
+  i : longint;
+begin
+  set_target_ar:=false;
+  for i:=1 to arcnt do
+   if ar_infos[i].id=t then
+    begin
+      target_ar:=ar_infos[i];
+      set_target_ar:=true;
+      exit;
+    end;
+end;
+
+
+function set_target_info(t:ttarget):boolean;
+var
+  i : longint;
+begin
+  set_target_info:=false;
+  for i:=1 to targetcnt do
+   if target_infos[i].target=t then
+    begin
+      target_info:=target_infos[i];
+      set_target_os(target_info.os);
+      set_target_asm(target_info.assem);
+      set_target_link(target_info.link);
+      set_target_ar(target_info.ar);
+      target_cpu:=target_info.cpu;
+      set_target_info:=true;
+      exit;
+    end;
+end;
+
+
+{****************************************************************************
+                             Load from string
+****************************************************************************}
+
+function set_string_target(s : string) : boolean;
+var
+  i : longint;
+begin
+  set_string_target:=false;
+  { this should be case insensitive !! PM }
+  s:=upper(s);
+  for i:=1 to targetcnt do
+   if target_infos[i].short_name=s then
+    begin
+      target_info:=target_infos[i];
+      set_target_os(target_info.os);
+      set_target_asm(target_info.assem);
+      set_target_link(target_info.link);
+      set_target_ar(target_info.ar);
+      target_cpu:=target_info.cpu;
+      set_string_target:=true;
+      exit;
+    end;
+end;
+
+
+function set_string_asm(s : string) : boolean;
+var
+  i : longint;
+begin
+  set_string_asm:=false;
+  { this should be case insensitive !! PM }
+  s:=upper(s);
+  for i:=1 to asmcnt do
+   if as_infos[i].idtxt=s then
+    begin
+      target_asm:=as_infos[i];
+      set_string_asm:=true;
+    end;
+end;
+
+
+function set_string_asmmode(s:string;var t:tasmmode):boolean;
+var
+  i : longint;
+begin
+  set_string_asmmode:=false;
+  { this should be case insensitive !! PM }
+  s:=upper(s);
+  for i:=1 to asmmodecnt do
+   if asmmodeinfos[i].idtxt=s then
+    begin
+      t:=asmmodeinfos[i].id;
+      set_string_asmmode:=true;
+    end;
+end;
+
+
+{****************************************************************************
+                      Initialization of default target
+****************************************************************************}
+
+procedure default_os(t:ttarget);
+begin
+  set_target_info(t);
+  if source_os.name='' then
+    source_os:=target_os;
+end;
+
+
+procedure set_source_os(t:tos);
+var
+  i : longint;
+begin
+{ can't use message() here (PFV) }
+  if source_os.name<>'' then
+    Writeln('Warning: Source OS Redefined!');
+  for i:=1 to oscnt do
+   if os_infos[i].id=t then
+    begin
+      source_os:=os_infos[i];
+      exit;
+    end;
+end;
+
+
+begin
+{ first get source OS }
+  source_os.name:='';
+{ please note then we use cpu86 and cpu68 here on purpose !! }
+{$ifdef cpu86}
+  {$ifdef GO32V1}
+    set_source_os(os_i386_GO32V1);
+  {$else}
+    {$ifdef GO32V2}
+      set_source_os(os_i386_GO32V2);
+    {$else}
+      {$ifdef OS2}
+        set_source_os(os_i386_OS2);
+      {$else}
+        {$ifdef LINUX}
+          set_source_os(os_i386_LINUX);
+        {$else}
+          {$ifdef WIN32}
+            set_source_os(os_i386_WIN32);
+          {$endif win32}
+        {$endif linux}
+      {$endif os2}
+    {$endif go32v2}
+  {$endif go32v1}
+{$endif cpu86}
+{$ifdef cpu68}
+  {$ifdef AMIGA}
+    set_source_os(os_m68k_Amiga);
+  {$else}
+    {$ifdef ATARI}
+      set_source_os(os_m68k_Atari);
+    {$else}
+      {$ifdef MACOS}
+        set_source_os(os_m68k_MAC);
+      {$else}
+        {$ifdef LINUX}
+          set_source_os(os_m68k_linux);
+        {$endif linux}
+      {$endif macos}
+    {$endif atari}
+  {$endif amiga}
+{$endif cpu68}
+
+{ Now default target !! }
+{$ifdef i386}
+  {$ifdef GO32V1}
+     default_os(target_i386_GO32V1);
+  {$else}
+    {$ifdef GO32V2}
+      default_os(target_i386_GO32V2);
+    {$else}
+      {$ifdef OS2}
+        default_os(target_i386_OS2);
+      {$else}
+        {$ifdef LINUX}
+          default_os(target_i386_LINUX);
+        {$else}
+           {$ifdef WIN32}
+             default_os(target_i386_WIN32);
+           {$else}
+             default_os(target_i386_GO32V2);
+           {$endif win32}
+        {$endif linux}
+      {$endif os2}
+    {$endif go32v2}
+  {$endif go32v1}
+{$endif i386}
+{$ifdef m68k}
+  {$ifdef AMIGA}
+    default_os(target_m68k_Amiga);
+  {$else}
+    {$ifdef ATARI}
+      default_os(target_m68k_Atari);
+    {$else}
+      {$ifdef MACOS}
+        default_os(target_m68k_Mac);
+      {$else}
+        {$ifdef LINUX}
+          default_os(target_m68k_linux);
+        {$else}
+          default_os(target_m68k_Amiga);
+        {$endif linux}
+      {$endif macos}
+    {$endif atari}
+  {$endif amiga}
+{$endif m68k}
+end.
+{
+  $Log$
+  Revision 1.1  1998-12-22 14:27:54  peter
+    * moved
+
+  Revision 1.2  1998/12/18 17:17:05  peter
+    * updated with new versions from compiler
+
+  Revision 1.1  1998/12/10 23:54:28  peter
+    * initial version of the FV IDE
+    * initial version of a fake compiler
+
+}

ide/fake/tokens.pas

@@ -0,0 +1,354 @@
+{
+    $Id$
+    Copyright (c) 1993-98 by Florian Klaempfl, Pierre Muller
+
+    Tokens used by the compiler
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    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.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ ****************************************************************************
+}
+unit tokens;
+interface
+
+uses
+  globtype;
+
+const
+  tokenidlen=14;
+
+type
+  ttoken=(
+    { operators, which can also be overloaded }
+    PLUS,
+    MINUS,
+    STAR,
+    SLASH,
+    EQUAL,
+    GT,
+    LT,
+    GTE,
+    LTE,
+    SYMDIF,
+    STARSTAR,
+    OP_IS,
+    OP_AS,
+    OP_IN,
+    ASSIGNMENT,
+    { special chars }
+    CARET,
+    UNEQUAL,
+    LECKKLAMMER,
+    RECKKLAMMER,
+    POINT,
+    COMMA,
+    LKLAMMER,
+    RKLAMMER,
+    COLON,
+    SEMICOLON,
+    KLAMMERAFFE,
+    POINTPOINT,
+    DOUBLEADDR,
+    _EOF,
+    ID,
+    NOID,
+    REALNUMBER,
+    INTCONST,
+    CSTRING,
+    CCHAR,
+    { C like operators }
+    _PLUSASN,
+    _MINUSASN,
+    _ANDASN,
+    _ORASN,
+    _STARASN,
+    _SLASHASN,
+    _MODASN,
+    _DIVASN,
+    _NOTASN,
+    _XORASN,
+    { Normal words }
+    _AS,
+    _DO,
+    _IF,
+    _IN,
+    _IS,
+    _OF,
+    _ON,
+    _OR,
+    _TO,
+    _AND,
+    _ASM,
+    _DIV,
+    _END,
+    _FAR,
+    _FOR,
+    _MOD,
+    _NEW,
+    _NIL,
+    _NOT,
+    _SET,
+    _SHL,
+    _SHR,
+    _TRY,
+    _VAR,
+    _XOR,
+    _CASE,
+    _CVAR,
+    _ELSE,
+    _EXIT,
+    _FAIL,
+    _FILE,
+    _GOTO,
+    _NAME,
+    _NEAR,
+    _READ,
+    _SELF,
+    _THEN,
+    _TRUE,
+    _TYPE,
+    _UNIT,
+    _USES,
+    _WITH,
+    _ARRAY,
+    _BEGIN,
+    _BREAK,
+    _CLASS,
+    _CONST,
+    _FALSE,
+    _INDEX,
+    _LABEL,
+    _RAISE,
+    _UNTIL,
+    _WHILE,
+    _WRITE,
+    _DOWNTO,
+    _EXCEPT,
+    _EXPORT,
+    _INLINE,
+    _OBJECT,
+    _PACKED,
+    _PUBLIC,
+    _RECORD,
+    _REPEAT,
+    _STATIC,
+    _STORED,
+    _STRING,
+    _DEFAULT,
+    _DISPOSE,
+    _DYNAMIC,
+    _EXPORTS,
+    _FINALLY,
+    _FORWARD,
+    _LIBRARY,
+    _PRIVATE,
+    _PROGRAM,
+    _VIRTUAL,
+    _ABSOLUTE,
+    _ABSTRACT,
+    _CONTINUE,
+    _EXTERNAL,
+    _FUNCTION,
+    _OPERATOR,
+    _OVERRIDE,
+    _PROPERTY,
+    _RESIDENT,
+    _INHERITED,
+    _INTERFACE,
+    _INTERRUPT,
+    _NODEFAULT,
+    _OTHERWISE,
+    _PROCEDURE,
+    _PROTECTED,
+    _PUBLISHED,
+    _DESTRUCTOR,
+    _CONSTRUCTOR,
+    _SHORTSTRING,
+    _FINALIZATION,
+    _IMPLEMENTATION,
+    _INITIALIZATION
+  );
+
+  tokenrec=record
+    str     : string[tokenidlen];
+    special : boolean;
+    keyword : tmodeswitch;
+    encoded : longint;
+  end;
+
+const
+  tokeninfo:array[ttoken] of tokenrec=(
+    { Operators which can be overloaded }
+      (str:'+'             ;special:true ;keyword:m_none),
+      (str:'-'             ;special:true ;keyword:m_none),
+      (str:'*'             ;special:true ;keyword:m_none),
+      (str:'/'             ;special:true ;keyword:m_none),
+      (str:'='             ;special:true ;keyword:m_none),
+      (str:'>'             ;special:true ;keyword:m_none),
+      (str:'<'             ;special:true ;keyword:m_none),
+      (str:'>='            ;special:true ;keyword:m_none),
+      (str:'<='            ;special:true ;keyword:m_none),
+      (str:'><'            ;special:true ;keyword:m_none),
+      (str:'**'            ;special:true ;keyword:m_none),
+      (str:'is'            ;special:true ;keyword:m_none),
+      (str:'as'            ;special:true ;keyword:m_none),
+      (str:'in'            ;special:true ;keyword:m_none),
+      (str:':='            ;special:true ;keyword:m_none),
+    { Special chars }
+      (str:'^'             ;special:true ;keyword:m_none),
+      (str:'<>'            ;special:true ;keyword:m_none),
+      (str:'['             ;special:true ;keyword:m_none),
+      (str:']'             ;special:true ;keyword:m_none),
+      (str:'.'             ;special:true ;keyword:m_none),
+      (str:','             ;special:true ;keyword:m_none),
+      (str:'('             ;special:true ;keyword:m_none),
+      (str:')'             ;special:true ;keyword:m_none),
+      (str:':'             ;special:true ;keyword:m_none),
+      (str:';'             ;special:true ;keyword:m_none),
+      (str:'@'             ;special:true ;keyword:m_none),
+      (str:'..'            ;special:true ;keyword:m_none),
+      (str:'@@'            ;special:true ;keyword:m_none),
+      (str:'end of file'   ;special:true ;keyword:m_none),
+      (str:'identifier'    ;special:true ;keyword:m_none),
+      (str:'non identifier';special:true ;keyword:m_none),
+      (str:'const real'    ;special:true ;keyword:m_none),
+      (str:'ordinal const' ;special:true ;keyword:m_none),
+      (str:'const string'  ;special:true ;keyword:m_none),
+      (str:'const char'    ;special:true ;keyword:m_none),
+    { C like operators }
+      (str:'+='            ;special:true ;keyword:m_none),
+      (str:'-='            ;special:true ;keyword:m_none),
+      (str:'&='            ;special:true ;keyword:m_none),
+      (str:'|='            ;special:true ;keyword:m_none),
+      (str:'*='            ;special:true ;keyword:m_none),
+      (str:'/='            ;special:true ;keyword:m_none),
+      (str:''              ;special:true ;keyword:m_none),
+      (str:''              ;special:true ;keyword:m_none),
+      (str:''              ;special:true ;keyword:m_none),
+      (str:''              ;special:true ;keyword:m_none),
+    { Normal words }
+      (str:'AS'            ;special:false;keyword:m_class),
+      (str:'DO'            ;special:false;keyword:m_all),
+      (str:'IF'            ;special:false;keyword:m_all),
+      (str:'IN'            ;special:false;keyword:m_all),
+      (str:'IS'            ;special:false;keyword:m_class),
+      (str:'OF'            ;special:false;keyword:m_all),
+      (str:'ON'            ;special:false;keyword:m_objpas),
+      (str:'OR'            ;special:false;keyword:m_all),
+      (str:'TO'            ;special:false;keyword:m_all),
+      (str:'AND'           ;special:false;keyword:m_all),
+      (str:'ASM'           ;special:false;keyword:m_all),
+      (str:'DIV'           ;special:false;keyword:m_all),
+      (str:'END'           ;special:false;keyword:m_all),
+      (str:'FAR'           ;special:false;keyword:m_none),
+      (str:'FOR'           ;special:false;keyword:m_all),
+      (str:'MOD'           ;special:false;keyword:m_all),
+      (str:'NEW'           ;special:false;keyword:m_all),
+      (str:'NIL'           ;special:false;keyword:m_all),
+      (str:'NOT'           ;special:false;keyword:m_all),
+      (str:'SET'           ;special:false;keyword:m_all),
+      (str:'SHL'           ;special:false;keyword:m_all),
+      (str:'SHR'           ;special:false;keyword:m_all),
+      (str:'TRY'           ;special:false;keyword:m_objpas),
+      (str:'VAR'           ;special:false;keyword:m_all),
+      (str:'XOR'           ;special:false;keyword:m_all),
+      (str:'CASE'          ;special:false;keyword:m_all),
+      (str:'CVAR'          ;special:false;keyword:m_none),
+      (str:'ELSE'          ;special:false;keyword:m_all),
+      (str:'EXIT'          ;special:false;keyword:m_all),
+      (str:'FAIL'          ;special:false;keyword:m_none), { only set within constructors PM }
+      (str:'FILE'          ;special:false;keyword:m_all),
+      (str:'GOTO'          ;special:false;keyword:m_all),
+      (str:'NAME'          ;special:false;keyword:m_none),
+      (str:'NEAR'          ;special:false;keyword:m_none),
+      (str:'READ'          ;special:false;keyword:m_none),
+      (str:'SELF'          ;special:false;keyword:m_none), {set inside methods only PM }
+      (str:'THEN'          ;special:false;keyword:m_all),
+      (str:'TRUE'          ;special:false;keyword:m_all),
+      (str:'TYPE'          ;special:false;keyword:m_all),
+      (str:'UNIT'          ;special:false;keyword:m_all),
+      (str:'USES'          ;special:false;keyword:m_all),
+      (str:'WITH'          ;special:false;keyword:m_all),
+      (str:'ARRAY'         ;special:false;keyword:m_all),
+      (str:'BEGIN'         ;special:false;keyword:m_all),
+      (str:'BREAK'         ;special:false;keyword:m_none),
+      (str:'CLASS'         ;special:false;keyword:m_class),
+      (str:'CONST'         ;special:false;keyword:m_all),
+      (str:'FALSE'         ;special:false;keyword:m_all),
+      (str:'INDEX'         ;special:false;keyword:m_none),
+      (str:'LABEL'         ;special:false;keyword:m_all),
+      (str:'RAISE'         ;special:false;keyword:m_objpas),
+      (str:'UNTIL'         ;special:false;keyword:m_all),
+      (str:'WHILE'         ;special:false;keyword:m_all),
+      (str:'WRITE'         ;special:false;keyword:m_none),
+      (str:'DOWNTO'        ;special:false;keyword:m_all),
+      (str:'EXCEPT'        ;special:false;keyword:m_objpas),
+      (str:'EXPORT'        ;special:false;keyword:m_none),
+      (str:'INLINE'        ;special:false;keyword:m_none),
+      (str:'OBJECT'        ;special:false;keyword:m_all),
+      (str:'PACKED'        ;special:false;keyword:m_all),
+      (str:'PUBLIC'        ;special:false;keyword:m_none),
+      (str:'RECORD'        ;special:false;keyword:m_all),
+      (str:'REPEAT'        ;special:false;keyword:m_all),
+      (str:'STATIC'        ;special:false;keyword:m_none),
+      (str:'STORED'        ;special:false;keyword:m_none),
+      (str:'STRING'        ;special:false;keyword:m_all),
+      (str:'DEFAULT'       ;special:false;keyword:m_none),
+      (str:'DISPOSE'       ;special:false;keyword:m_all),
+      (str:'DYNAMIC'       ;special:false;keyword:m_none),
+      (str:'EXPORTS'       ;special:false;keyword:m_all),
+      (str:'FINALLY'       ;special:false;keyword:m_objpas),
+      (str:'FORWARD'       ;special:false;keyword:m_none),
+      (str:'LIBRARY'       ;special:false;keyword:m_all),
+      (str:'PRIVATE'       ;special:false;keyword:m_none),
+      (str:'PROGRAM'       ;special:false;keyword:m_all),
+      (str:'VIRTUAL'       ;special:false;keyword:m_none),
+      (str:'ABSOLUTE'      ;special:false;keyword:m_none),
+      (str:'ABSTRACT'      ;special:false;keyword:m_none),
+      (str:'CONTINUE'      ;special:false;keyword:m_none),
+      (str:'EXTERNAL'      ;special:false;keyword:m_none),
+      (str:'FUNCTION'      ;special:false;keyword:m_all),
+      (str:'OPERATOR'      ;special:false;keyword:m_fpc),
+      (str:'OVERRIDE'      ;special:false;keyword:m_none),
+      (str:'PROPERTY'      ;special:false;keyword:m_class),
+      (str:'RESIDENT'      ;special:false;keyword:m_none),
+      (str:'INHERITED'     ;special:false;keyword:m_all),
+      (str:'INTERFACE'     ;special:false;keyword:m_all),
+      (str:'INTERRUPT'     ;special:false;keyword:m_none),
+      (str:'NODEFAULT'     ;special:false;keyword:m_none),
+      (str:'OTHERWISE'     ;special:false;keyword:m_all),
+      (str:'PROCEDURE'     ;special:false;keyword:m_all),
+      (str:'PROTECTED'     ;special:false;keyword:m_none),
+      (str:'PUBLISHED'     ;special:false;keyword:m_none),
+      (str:'DESTRUCTOR'    ;special:false;keyword:m_all),
+      (str:'CONSTRUCTOR'   ;special:false;keyword:m_all),
+      (str:'SHORTSTRING'   ;special:false;keyword:m_none),
+      (str:'FINALIZATION'  ;special:false;keyword:m_class),
+      (str:'IMPLEMENTATION';special:false;keyword:m_all),
+      (str:'INITIALIZATION';special:false;keyword:m_class)
+  );
+
+implementation
+
+end.
+{
+  $Log$
+  Revision 1.1  1998-12-22 14:27:54  peter
+    * moved
+
+  Revision 1.1  1998/12/10 23:54:28  peter
+    * initial version of the FV IDE
+    * initial version of a fake compiler
+
+}

ide/fake/version.pas

@@ -0,0 +1,75 @@
+{
+    $Id$
+    Copyright (C) 1993-98 by Florian Klaempfl
+
+    Version/target constants
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    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.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit version;
+interface
+
+    const
+       { word version for ppu file }
+       wordversion = (0 shl 11)+99;
+
+       { version string }
+       version_nr = '0';
+       release_nr = '99';
+       patch_nr   = '11';
+       version_string = version_nr+'.'+release_nr+'.'+patch_nr;
+
+       { date string }
+{$ifdef FPC}
+       date_string = {$I %DATE%};
+{$else}
+       date_string = 'N/A';
+{$endif}
+
+       { target cpu string }
+{$ifdef i386}
+       target_cpu_string = 'i386';
+{$endif}
+{$ifdef m68k}
+       target_cpu_string = 'm68k';
+{$endif}
+{$ifdef alpha}
+       target_cpu_string = 'alpha';
+{$endif}
+
+       { source cpu string }
+{$ifdef cpu86}
+        source_cpu_string = 'i386';
+{$endif}
+{$ifdef cpu68}
+        source_cpu_string = 'm68k';
+{$endif}
+
+
+implementation
+
+end.
+{
+  $Log$
+  Revision 1.1  1998-12-22 14:27:54  peter
+    * moved
+
+  Revision 1.2  1998/12/18 17:17:06  peter
+    * updated with new versions from compiler
+
+}
+

ide/text/Makefile

@@ -0,0 +1,61 @@
+#
+#   $Id$
+#   Copyright (c) 1998 by the Free Pascal Development Team
+#
+#   Makefile for Free Pascal Environment
+#
+#   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.
+#
+
+#####################################################################
+# Defaults
+#####################################################################
+
+# Where are the files located
+MAKEFILEFPC=makefile.fpc
+#RTL=
+#INC=
+#PROCINC=
+#OSINC=
+
+# Needed options, without it won't compile
+#NEEDOPT=
+
+# Add this dir also to the path as first
+UNITDIR=../fake
+
+# Where need we to place the executables/ppu/objects
+#TARGETDIR=
+#UNITTARGETDIR=
+
+#####################################################################
+# Real targets
+#####################################################################
+
+UNITOBJECTS=
+EXEOBJECTS=fp
+
+#####################################################################
+# Include default makefile
+#####################################################################
+
+include $(MAKEFILEFPC)
+
+#####################################################################
+# Dependencies
+#####################################################################
+
+#
+# $Log$
+# Revision 1.1  1998-12-22 14:27:54  peter
+#   * moved
+#
+# Revision 1.1  1998/12/12 19:21:14  peter
+#   + Makefile
+#
+#

ide/text/README

@@ -0,0 +1,14 @@
+
+You can have a fp.cfg file in the same directory as fp.exe. It works the
+same as ppc386.cfg
+
+If you want to create a fully working IDE you need to compile with a
+unit path to ../.. and for an IDE without compiler compile with ../fake
+
+# IDE with full compiler compile with:
+ppc386 fp -Fu../..
+
+# IDE with fake compiler compile with:
+ppc386 fp -Fu../fake
+
+

ide/text/TODO

@@ -0,0 +1,16 @@
+--- To do ---
+
+* Most editor-actions are not aware if current selection, eg.
+  a line insertion does not shift the start and/or the end of the selection.
+* Implement Help|Files...
+* Implement missing option dialogs in Options menu, and
+* store settings & options
+* User screen
+
+--- Ideas ---
+
+* Integrated source beautifier (fully configurable)
+* Add some other classes to syntax highlight
+  (eg. highlight standard Pascal types, etc.)
+ 
+ 

ide/text/fp.pas

@@ -0,0 +1,468 @@
+{
+    $Id$
+    This file is part of the Free Pascal Integrated Development Environment
+    Copyright (c) 1998 by Berczi Gabor
+
+    Main program of the IDE
+
+    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.
+
+ **********************************************************************}
+program FreePascal;
+
+uses
+  Dos,Objects,Memory,Drivers,Views,Menus,Dialogs,App,StdDlg,ColorSel,
+  Systems,Commands,HelpCtx,
+  WHelp,WHlpView,WINI,
+  FPConst,FPUtils,FPCfgs,FPIntf,FPCompile,FPHelp,FPViews,FPTemplt,FPCalc;
+
+type
+    TIDEApp = object(TApplication)
+      constructor Init;
+      procedure   InitMenuBar; virtual;
+      procedure   InitStatusLine; virtual;
+      procedure   HandleEvent(var Event: TEvent); virtual;
+      function    GetPalette: PPalette; virtual;
+      destructor  Done; virtual;
+    private
+      function  OpenEditorWindow(FileName: string; CurX,CurY: integer): PSourceWindow;
+      procedure NewEditor;
+      procedure NewFromTemplate;
+      procedure Open(FileName: string);
+      procedure OpenRecentFile(RecentIndex: integer);
+      procedure SaveAll;
+      procedure ChangeDir;
+      procedure ShowClipboard;
+      procedure Parameters;
+      procedure Target;
+      procedure PrimaryFile_;
+      procedure ClearPrimary;
+      procedure Information;
+      procedure Calculator;
+      procedure Compiler;
+      procedure MemorySizes;
+      procedure Linker;
+      procedure Debugger;
+      procedure Directories;
+      procedure Colors;
+      procedure CloseAll;
+      procedure WindowList;
+      procedure HelpContents;
+      procedure HelpHelpIndex;
+      procedure HelpTopicSearch;
+      procedure HelpPrevTopic;
+      procedure HelpUsingHelp;
+      procedure HelpFiles;
+      procedure About;
+    private
+      procedure AddRecentFile(AFileName: string; CurX, CurY: integer);
+      function  SearchRecentFile(AFileName: string): integer;
+      procedure RemoveRecentFile(Index: integer);
+    private
+      procedure Update;
+      procedure CurDirChanged;
+      procedure UpdatePrimaryFile;
+      procedure UpdateRecentFileList;
+    end;
+
+    TRecentFileEntry = record
+      FileName  : PathStr;
+      LastPos   : TPoint;
+    end;
+
+const ClipboardWindow  : PClipboardWindow = nil;
+      CalcWindow       : PCalculator = nil;
+      RecentFileCount  : integer = 0;
+
+var   RecentFiles      : array[1..5] of TRecentFileEntry;
+
+constructor TIDEApp.Init;
+begin
+  inherited Init;
+  New(ClipboardWindow, Init);
+  Desktop^.Insert(ClipboardWindow);
+  New(CalcWindow, Init); CalcWindow^.Hide;
+  Desktop^.Insert(CalcWindow);
+  New(ProgramInfoWindow, Init); ProgramInfoWindow^.Hide; Desktop^.Insert(ProgramInfoWindow);
+  Message(@Self,evBroadcast,cmUpdate,nil);
+  InitTemplates;
+  CurDirChanged;
+end;
+
+procedure TIDEApp.InitMenuBar;
+var R: TRect;
+begin
+  GetExtent(R); R.B.Y:=R.A.Y+1;
+  MenuBar:=New(PAdvancedMenuBar, Init(R, NewMenu(
+    NewSubMenu('~F~ile',hcFileMenu, NewMenu(
+      NewItem('~N~ew','',kbNoKey,cmNew,hcNew,
+      NewItem('New from ~t~emplate...','',kbNoKey,cmNewFromTemplate,hcNewFromTemplate,
+      NewItem('~O~pen...','F3',kbF3,cmOpen,hcOpen,
+      NewItem('~S~ave','F2',kbF2,cmSave,hcSave,
+      NewItem('Save ~a~s...','',kbNoKey,cmSaveAs,hcSaveAs,
+      NewItem('Save a~l~l','',kbNoKey,cmSaveAll,hcSaveAll,
+      NewLine(
+      NewItem('~C~hange dir...','',kbNoKey,cmChangeDir,hcChangeDir,
+      NewItem('~D~OS shell','',kbNoKey,cmDOSShell,hcDOSShell,
+      NewItem('E~x~it','Alt+X',kbNoKey,cmQuit,hcQuit,
+      nil))))))))))),
+    NewSubMenu('~E~dit',hcEditMenu, NewMenu(
+      NewItem('~U~ndo','Alt+BkSp', kbAltBack, cmUndo, hcUndo,
+      NewItem('~R~edo','', kbNoKey, cmRedo, hcRedo,
+      NewLine(
+      NewItem('Cu~t~','Shift+Del', kbShiftDel, cmCut, hcCut,
+      NewItem('~C~opy','Ctrl+Ins', kbCtrlIns, cmCopy, hcCut,
+      NewItem('~P~aste','Shift+Ins', kbShiftIns, cmPaste, hcPaste,
+      NewItem('C~l~ear','Ctrl+Del', kbCtrlDel, cmClear, hcClear,
+      NewLine(
+      NewItem('~S~how clipboard','', kbNoKey, cmShowClipboard, hcShowClipboard,
+      nil)))))))))),
+    NewSubMenu('~S~earch',hcSearchMenu, NewMenu(
+      NewItem('~F~ind...','', kbNoKey, cmFind, hcFind,
+      NewItem('~R~eplace...','', kbNoKey, cmReplace, hcReplace,
+      NewItem('~S~earch again','', kbNoKey, cmSearchAgain, hcSearchAgain,
+      NewLine(
+      NewItem('~G~o to line number...','', kbNoKey, cmJumpLine, hcGotoLine,
+      NewItem('Find ~p~rocedure...','', kbNoKey, cmFindProcedure, hcFindProcedure,
+      NewLine(
+      NewItem('~O~bjects','', kbNoKey, cmObjects, hcObjects,
+      NewItem('Mod~u~les','', kbNoKey, cmModules, hcModules,
+      NewItem('~G~lobals','', kbNoKey, cmGlobals, hcGlobals,
+      nil))))))))))),
+    NewSubMenu('~R~un',hcRunMenu, NewMenu(
+      NewItem('~R~un','Ctrl+F9', kbCtrlF9, cmRun, hcRun,
+      NewItem('P~a~rameters...','', kbNoKey, cmParameters, hcParameters,
+      NewLine(
+      NewItem('~U~ser screen','Alt+F5', kbAltF5, cmUserScreen, hcUserScreen,
+      nil))))),
+    NewSubMenu('~C~ompile',hcCompileMenu, NewMenu(
+      NewItem('~C~ompile','Alt+F9', kbAltF9, cmCompile, hcCompile,
+      NewItem('~M~ake','F9', kbF9, cmMake, hcMake,
+      NewItem('~B~uild','', kbNoKey, cmBuild, hcBuild,
+      NewLine(
+      NewItem('~T~arget...','', kbNoKey, cmTarget, hcTarget,
+      NewItem('~P~rimary file...','', kbNoKey, cmPrimaryFile, hcPrimaryFile,
+      NewItem('C~l~ear primary file','', kbNoKey, cmClearPrimary, hcClearPrimary,
+      NewLine(
+      NewItem('~I~nformation...','', kbNoKey, cmInformation, hcInformation,
+      nil)))))))))),
+    NewSubMenu('~D~ebug', hcDebugMenu, NewMenu(
+      nil),
+    NewSubMenu('~T~ools', hcToolsMenu, NewMenu(
+      NewItem('~M~essages', '', kbNoKey, cmToolsMessages, hcToolsMessages,
+      NewLine(
+      NewItem('~C~alculator', '', kbNoKey, cmCalculator, hcCalculator,
+      nil)))),
+    NewSubMenu('~O~ptions', hcOptionsMenu, NewMenu(
+      NewItem('~C~ompiler...','', kbNoKey, cmCompiler, hcCompiler,
+      NewItem('~M~emory sizes...','', kbNoKey, cmMemorySizes, hcMemorySizes,
+      NewItem('~L~inker...','', kbNoKey, cmLinker, hcLinker,
+      NewItem('De~b~ugger...','', kbNoKey, cmDebugger, hcDebugger,
+      NewItem('~D~irectories...','', kbNoKey, cmDirectories, hcDirectories,
+      NewItem('~T~ools...','', kbNoKey, cmTools, hcTools,
+      NewLine(
+      NewSubMenu('~E~nvironment', hcEnvironmentMenu, NewMenu(
+        NewItem('~P~references...','', kbNoKey, cmPreferences, hcPreferences,
+        NewItem('~E~ditor...','', kbNoKey, cmEditor, hcEditor,
+        NewItem('~M~ouse...','', kbNoKey, cmMouse, hcMouse,
+        NewItem('~S~tartup...','', kbNoKey, cmStartup, hcStartup,
+        NewItem('~C~olors...','', kbNoKey, cmColors, hcColors,
+        nil)))))),
+      nil))))))))),
+    NewSubMenu('~W~indow', hcWindowMenu, NewMenu(
+      NewItem('~T~ile','', kbNoKey, cmTile, hcTile,
+      NewItem('C~a~scade','', kbNoKey, cmCascade, hcCascade,
+      NewItem('Cl~o~se all','', kbNoKey, cmCloseAll, hcCloseAll,
+      NewLine(
+      NewItem('~S~ize/Move','Ctrl+F5', kbCtrlF5, cmResize, hcResize,
+      NewItem('~Z~oom','F5', kbF5, cmZoom, hcZoom,
+      NewItem('~N~ext','F6', kbF6, cmNext, hcNext,
+      NewItem('~P~revious','Shift+F6', kbShiftF6, cmPrev, hcPrev,
+      NewItem('~C~lose','Alt+F3', kbAltF3, cmClose, hcClose,
+      NewLine(
+      NewItem('~L~ist...','Alt+0', kbAlt0, cmWindowList, hcWindowList,
+      NewItem('~R~efresh display','', kbNoKey, cmUpdate, hcUpdate,
+      nil))))))))))))),
+    NewSubMenu('~H~elp', hcHelpMenu, NewMenu(
+      NewItem('~C~ontents','', kbNoKey, cmHelpContents, hcHelpContents,
+      NewItem('~I~ndex','Shift+F1', kbShiftF1, cmHelpIndex, hcHelpIndex,
+      NewItem('~T~opic search','Ctrl+F1', kbCtrlF1, cmHelpTopicSearch, hcHelpTopicSearch,
+      NewItem('~P~revious topic','Alt+F1', kbAltF1, cmHelpPrevTopic, hcHelpPrevTopic,
+      NewItem('~U~sing help','',kbNoKey, cmHelpUsingHelp, hcHelpUsingHelp,
+      NewItem('~F~iles...','',kbNoKey, cmHelpFiles, hcHelpFiles,
+      NewLine(
+      NewItem('~A~bout...','',kbNoKey, cmAbout, hcAbout,
+      nil))))))))),
+    nil)))))))))))));
+  DisableCommands(EditorCmds+SourceCmds+CompileCmds);
+  Update;
+end;
+
+procedure TIDEApp.InitStatusLine;
+var
+  R: TRect;
+begin
+  GetExtent(R);
+  R.A.Y := R.B.Y - 1;
+  StatusLine:=New(PIDEStatusLine, Init(R,
+    NewStatusDef(hcFirstCommand, hcLastCommand,
+      NewStatusKey('~F1~ Help', kbF1, cmHelp,
+      StdStatusKeys(
+      nil)),
+    NewStatusDef(hcHelpWindow, hcHelpWindow,
+      NewStatusKey('~F1~ Help on help', kbF1, cmHelpUsingHelp,
+      NewStatusKey('~Alt+F1~ Previous topic', kbAltF1, cmHelpPrevTopic,
+      NewStatusKey('~Shift+F1~ Help index', kbShiftF1, cmHelpIndex,
+      NewStatusKey('~Esc~ Close help', kbEsc, cmClose,
+      nil)))),
+    NewStatusDef(hcSourceWindow, hcSourceWindow,
+      NewStatusKey('~F1~ Help', kbF1, cmHelp,
+      NewStatusKey('~F2~ Save', kbF2, cmSave,
+      NewStatusKey('~F3~ Open', kbF3, cmOpen,
+      NewStatusKey('~Alt+F9~ Compile', kbAltF9, cmCompile,
+      NewStatusKey('~F9~ Make', kbF9, cmMake,
+      NewStatusKey('~Alt+F10~ Local menu', kbAltF10, cmLocalMenu,
+      StdStatusKeys(
+      nil))))))),
+    NewStatusDef(hcCalcWindow, hcCalcWindow,
+      NewStatusKey('~F1~ Help', kbF1, cmHelp,
+      NewStatusKey('~Esc~ Close', kbEsc, cmClose,
+      NewStatusKey('~Ctrl+Enter~ Transfer result', kbCtrlEnter, cmCalculatorPaste,
+      StdStatusKeys(
+      nil)))),
+    NewStatusDef(0, $FFFF,
+      NewStatusKey('~F1~ Help', kbF1, cmHelp,
+      NewStatusKey('~F3~ Open', kbF3, cmOpen,
+      NewStatusKey('~Alt+F9~ Compile', kbAltF9, cmCompile,
+      NewStatusKey('~F9~ Make', kbF9, cmMake,
+      NewStatusKey('~Alt+F10~ Local menu', kbAltF10, cmLocalMenu,
+      StdStatusKeys(
+      nil)))))),
+    nil)))))));
+end;
+
+procedure TIDEApp.HandleEvent(var Event: TEvent);
+var DontClear: boolean;
+begin
+  case Event.What of
+       evCommand :
+         begin
+           DontClear:=false;
+           case Event.Command of
+             cmUpdate        : Message(Application,evBroadcast,cmUpdate,nil);
+           { -- File menu -- }
+             cmNew           : NewEditor;
+             cmNewFromTemplate: NewFromTemplate;
+             cmOpen          : begin
+                                 Open(OpenFileName);
+                                 OpenFileName:='';
+                               end;
+             cmSaveAll       : SaveAll;
+             cmChangeDir     : ChangeDir;
+             cmRecentFileBase..
+             cmRecentFileBase+10
+                             : OpenRecentFile(Event.Command-cmRecentFileBase);
+           { -- Edit menu -- }
+             cmShowClipboard : ShowClipboard;
+           { -- Run menu -- }
+             cmParameters    : Parameters;
+           { -- Compile menu -- }
+             cmCompile       : DoCompile(cCompile);
+             cmBuild         : DoCompile(cBuild);
+             cmMake          : DoCompile(cMake);
+             cmTarget        : Target;
+             cmPrimaryFile   : PrimaryFile_;
+             cmClearPrimary  : ClearPrimary;
+             cmInformation   : Information;
+           { -- Options menu -- }
+             cmCompiler      : Compiler;
+             cmMemorySizes   : MemorySizes;
+             cmLinker        : Linker;
+             cmDebugger      : Debugger;
+             cmDirectories   : Directories;
+             cmColors        : Colors;
+           { -- Tools menu -- }
+             cmCalculator    : Calculator;
+           { -- Window menu -- }
+             cmCloseAll      : CloseAll;
+             cmWindowList    : WindowList;
+           { -- Help menu -- }
+             cmHelpContents  : HelpContents;
+             cmHelpIndex     : HelpHelpIndex;
+{             cmHelpTopicSearch: HelpTopicSearch;}
+             cmHelpPrevTopic : HelpPrevTopic;
+             cmHelpUsingHelp : HelpUsingHelp;
+             cmHelpFiles     : HelpFiles;
+             cmAbout         : About;
+           else DontClear:=true;
+           end;
+           if DontClear=false then ClearEvent(Event);
+         end;
+       evBroadcast :
+         case Event.Command of
+           cmUpdate              :
+             Update;
+           cmSourceWindowClosing :
+             with PSourceWindow(Event.InfoPtr)^ do
+               if Editor^.FileName<>'' then
+                  AddRecentFile(Editor^.FileName,Editor^.CurPos.X,Editor^.CurPos.Y);
+         end;
+  end;
+  inherited HandleEvent(Event);
+end;
+
+procedure TIDEApp.Update;
+begin
+  SetCmdState([cmSaveAll],IsThereAnyEditor);
+  SetCmdState([cmCloseAll,cmTile,cmCascade,cmWindowList],IsThereAnyWindow);
+  SetCmdState([cmFindProcedure,cmObjects,cmModules,cmGlobals{,cmInformation}],IsEXECompiled);
+  UpdatePrimaryFile;
+  Message(MenuBar,evBroadcast,cmUpdate,nil);
+  UpdateRecentFileList;
+  Message(Application,evBroadcast,cmCommandSetChanged,nil);
+end;
+
+procedure TIDEApp.CurDirChanged;
+begin
+  Message(Application,evBroadcast,cmUpdateTitle,nil);
+  UpdatePrimaryFile;
+  UpdateMenu(MenuBar^.Menu);
+end;
+
+procedure TIDEApp.UpdatePrimaryFile;
+begin
+  SetMenuItemParam(SearchMenuItem(MenuBar^.Menu,cmPrimaryFile),SmartPath(PrimaryFile));
+  SetCmdState([cmClearPrimary],PrimaryFile<>'');
+  if PrimaryFile<>'' then
+     SetCmdState(CompileCmds,true);
+  UpdateMenu(MenuBar^.Menu);
+end;
+
+procedure TIDEApp.UpdateRecentFileList;
+var P: PMenuItem;
+    ID,I: word;
+    FileMenu: PMenuItem;
+begin
+  ID:=cmRecentFileBase;
+  FileMenu:=SearchSubMenu(MenuBar^.Menu,menuFile);
+  repeat
+    Inc(ID);
+    P:=SearchMenuItem(FileMenu^.SubMenu,ID);
+    if P<>nil then RemoveMenuItem(FileMenu^.SubMenu,P);
+  until P=nil;
+  P:=GetMenuItemBefore(FileMenu^.SubMenu,nil);
+  if (P<>nil) and IsSeparator(P) then
+     RemoveMenuItem(FileMenu^.SubMenu,P);
+
+  if RecentFileCount>0 then
+     AppendMenuItem(FileMenu^.SubMenu,NewLine(nil));
+  for I:=1 to RecentFileCount do
+  begin
+    P:=NewItem('~'+IntToStr(I)+'~. '+SmartPath(RecentFiles[I].FileName),' ',
+        kbNoKey,cmRecentFileBase+I,hcRecentFileBase+I,nil);
+    AppendMenuItem(FileMenu^.SubMenu,P);
+  end;
+end;
+
+{$I FPMFILE.INC}
+
+{$I FPMEDIT.INC}
+
+{$I FPMCOMP.INC}
+
+{$I FPMTOOLS.INC}
+
+{$I FPMOPTS.INC}
+
+{$I FPMWND.INC}
+
+{$I FPMHELP.INC}
+
+procedure TIDEApp.AddRecentFile(AFileName: string; CurX, CurY: integer);
+begin
+  if SearchRecentFile(AFileName)<>-1 then Exit;
+  if RecentFileCount>0 then
+   Move(RecentFiles[1],RecentFiles[2],SizeOf(RecentFiles[1])*Min(RecentFileCount,High(RecentFiles)-1));
+  if RecentFileCount<High(RecentFiles) then Inc(RecentFileCount);
+  with RecentFiles[1] do
+  begin
+    FileName:=AFileName;
+    LastPos.X:=CurX; LastPos.Y:=CurY;
+  end;
+  UpdateRecentFileList;
+end;
+
+function TIDEApp.SearchRecentFile(AFileName: string): integer;
+var Idx,I: integer;
+begin
+  Idx:=-1;
+  for I:=1 to RecentFileCount do
+    if UpcaseStr(AFileName)=UpcaseStr(RecentFiles[I].FileName) then
+      begin Idx:=I; Break; end;
+  SearchRecentFile:=Idx;
+end;
+
+procedure TIDEApp.RemoveRecentFile(Index: integer);
+begin
+  if Index<RecentFileCount then
+     Move(RecentFiles[Index+1],RecentFiles[Index],SizeOf(RecentFiles[1])*(RecentFileCount-Index));
+  Dec(RecentFileCount);
+end;
+
+function TIDEApp.GetPalette: PPalette;
+const P: string[length(CIDEAppColor)] = CIDEAppColor;
+begin
+  GetPalette:=@P;
+end;
+
+destructor TIDEApp.Done;
+begin
+  inherited Done;
+  DoneHelpSystem;
+  DoneTemplates;
+end;
+
+var MyApp: TIDEApp;
+
+procedure InitApp;
+var S: string;
+    I: integer;
+begin
+  for I:=1 to ParamCount do
+  begin
+    S:=ParamStr(I);
+    if not(S[1] in['-','/']) then
+      MyApp.Open(S);
+  end;
+end;
+
+BEGIN
+  InitReservedWords;
+
+{ load old options }
+  InitOptions;
+  ReadOptions('fp.cfg');
+
+  MyApp.Init;
+  InitApp;
+  MyApp.Run;
+  MyApp.Done;
+
+  WriteOptions('fp.cfg');
+  DoneOptions;
+END.
+{
+  $Log$
+  Revision 1.1  1998-12-22 14:27:54  peter
+    * moved
+
+  Revision 1.3  1998/12/22 10:39:38  peter
+    + options are now written/read
+    + find and replace routines
+
+}

ide/text/fpcalc.pas

@@ -0,0 +1,433 @@
+{
+    $Id$
+    This file is part of the Free Pascal Integrated Development Environment
+    Copyright (c) 1998 by Berczi Gabor
+
+    Calculator object for the IDE
+
+    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.
+
+ **********************************************************************}
+unit FPCalc;
+
+interface
+
+uses
+  Drivers,Objects,Commands,Views,Dialogs,App,
+  FPViews;
+
+const
+      MaxDecimals = 10;
+      MaxDigits   = 30;
+
+type
+
+  TCalcState = (csFirst, csValid, csError);
+
+  PCalcButton = ^TCalcButton;
+  TCalcButton = object(TButton)
+    procedure HandleEvent(var Event: TEvent); virtual;
+  end;
+
+  PCalcDisplay = ^TCalcDisplay;
+  TCalcDisplay = object(TView)
+    Status: TCalcState;
+    Number: string[MaxDigits];
+    Sign: Char;
+    _Operator: Char;
+    Operand: extended;
+    Memory: extended;
+    DispNumber: extended;
+    constructor Init(var Bounds: TRect);
+    constructor Load(var S: TStream);
+    function  CalcKey(Key: string): boolean;
+    procedure Clear;
+    procedure Draw; virtual;
+    function GetPalette: PPalette; virtual;
+    procedure HandleEvent(var Event: TEvent); virtual;
+    procedure Store(var S: TStream);
+  private
+    procedure GetDisplay(var R: extended);
+    procedure SetDisplay(R: extended);
+    procedure Error;
+  end;
+
+  PCalculator = ^TCalculator;
+  TCalculator = object(TCenterDialog)
+    CD : PCalcDisplay;
+    constructor Init;
+    procedure   HandleEvent(var Event: TEvent); virtual;
+    procedure   Show; virtual;
+    procedure   Close; virtual;
+  end;
+
+const
+  RCalcDisplay: TStreamRec = (
+     ObjType: 10040;
+     VmtLink: Ofs(TypeOf(TCalcDisplay)^);
+     Load:    @TCalcDisplay.Load;
+     Store:   @TCalcDisplay.Store
+  );
+  RCalculator: TStreamRec = (
+     ObjType: 10041;
+     VmtLink: Ofs(TypeOf(TCalculator)^);
+     Load:    @TCalculator.Load;
+     Store:   @TCalculator.Store
+  );
+
+procedure RegisterCalc;
+
+implementation
+
+uses FPUtils,FPConst;
+
+const
+  cmCalcButton  = 100;
+  cmPressButton = 101;
+
+procedure TCalcButton.HandleEvent(var Event: TEvent);
+var
+  Call : boolean;
+  i : Sw_Word;
+begin
+  Call:=true;
+  case Event.What of
+    evKeyDown :
+     case Event.KeyCode of
+       kbEnter   : Call:=false;
+     end;
+    evBroadcast :
+     case Event.Command of
+       cmDefault     : Call:=false;
+       cmPressButton :
+         begin
+           if (PString(Event.InfoPtr)^=Title^) or
+              ((PString(Event.InfoPtr)^='^') and (Title^='x^y')) then
+              begin
+                Select;
+                DrawState(true);
+                i:=GetDosTicks+2;
+                repeat
+                until GetDosTicks>i;
+                DrawState(false);
+                ClearEvent(Event);
+              end;
+         end;
+     end;
+  end;
+  if Call then
+  inherited HandleEvent(Event);
+end;
+
+constructor TCalcDisplay.Init(var Bounds: TRect);
+begin
+  inherited Init(Bounds);
+  Options := Options or ofSelectable;
+  EventMask := evKeyDown + evBroadcast;
+  Clear;
+  HelpCtx:={hcCalculatorLine}0;
+end;
+
+constructor TCalcDisplay.Load(var S: TStream);
+begin
+  inherited Load(S);
+  S.Read(Status, SizeOf(Status) + SizeOf(Number) + SizeOf(Sign) +
+    SizeOf(_Operator) + SizeOf(Operand));
+end;
+
+procedure TCalcDisplay.GetDisplay(var R: extended);
+begin
+{  Val(Sign + Number, R, E);}
+  R:=DispNumber;
+end;
+
+procedure TCalcDisplay.SetDisplay(R: extended);
+var
+  S: string[MaxDigits];
+begin
+  DispNumber:=R;
+  Str(R: 0: MaxDecimals, S);
+  if Pos('.',S)<>0 then
+     while (length(S)>1) and (S[length(S)]='0') do Dec(S[0]);
+  if S[1] <> '-' then Sign := ' ' else
+  begin
+    Delete(S, 1, 1);
+    Sign := '-';
+  end;
+  if Length(S) > MaxDigits + 1 + MaxDecimals then Error
+  else
+  begin
+    if S[Length(S)] = '.' then Dec(S[0]);
+    Number := S;
+  end;
+end;
+
+procedure TCalcDisplay.Error;
+begin
+  Status := csError;
+  Number := 'Error';
+  Sign := ' ';
+  DrawView;
+end;
+
+function TCalcDisplay.CalcKey(Key: string): boolean;
+var
+  R,D: extended;
+procedure CheckFirst;
+begin
+  if Status = csFirst then
+  begin
+    Status := csValid;
+{    Number := '0';
+    Sign := ' ';}
+    SetDisplay(0);
+  end;
+end;
+begin
+  CalcKey:=true;
+  Key := UpCaseStr(Key);
+  if (Status = csError) and (Key <> 'C') then Key := ' ';
+  if Key='X^Y' then Key:='^';
+  if length(Key)>1 then
+     begin
+{        if Status = csFirst then}
+        begin
+{          Status := csValid;}
+          GetDisplay(R);
+          if Key='1/X' then begin if R=0 then Error else SetDisplay(1/R) end else
+          if Key='SQR' then begin if R<0 then Error else SetDisplay(sqrt(R)) end else
+          if Key='X^2' then SetDisplay(R*R) else
+          if Key='M+' then Memory:=Memory+R else
+          if Key='M-' then Memory:=Memory-R else
+          if Key='M'#26 then SetDisplay(Memory) else
+          if Key='M'#27 then Memory:=R else
+          if Key='M'#29 then begin D:=Memory; Memory:=R; SetDisplay(D); end;
+        end;
+     end
+  else
+  case Key[1] of
+    '0'..'9':
+    if Length(Number)<MaxDigits then
+      begin
+        CheckFirst;
+        if Number = '0' then Number := '';
+        Number := Number + Key;
+        SetDisplay(StrToExtended(Number)); { !!! }
+      end;
+    '.':
+      begin
+        CheckFirst;
+        if Pos('.', Number) = 0 then Number := Number + '.';
+      end;
+    #8, #27:
+      begin
+        CheckFirst;
+        if Length(Number) = 1 then Number := '0' else Dec(Number[0]);
+        SetDisplay(StrToExtended(Number)); { !!! }
+      end;
+    '_', #241:
+      if Sign = ' ' then Sign := '-' else Sign := ' ';
+    '+', '-', '*', '/', '=', '%', #13, '^':
+      begin
+        if Status = csValid then
+        begin
+          Status := csFirst;
+          GetDisplay(R);
+          if Key = '%' then
+            case _Operator of
+              '+', '-': R := Operand * R / 100;
+              '*', '/': R := R / 100;
+            end;
+          case _Operator of
+            '^': SetDisplay(Power(Operand,R));
+            '+': SetDisplay(Operand + R);
+            '-': SetDisplay(Operand - R);
+            '*': SetDisplay(Operand * R);
+            '/': if R = 0 then Error else SetDisplay(Operand / R);
+          end;
+        end;
+        _Operator := Key[1];
+        GetDisplay(Operand);
+      end;
+    'C':
+      Clear;
+    else CalcKey:=false;
+  end;
+  DrawView;
+end;
+
+procedure TCalcDisplay.Clear;
+begin
+  Status := csFirst;
+  Number := '0';
+  Sign := ' ';
+  _Operator := '=';
+end;
+
+procedure TCalcDisplay.Draw;
+var
+  Color: Byte;
+  I: Integer;
+  B: TDrawBuffer;
+begin
+  Color := GetColor(1);
+  I := Size.X - Length(Number) - 2;
+  MoveChar(B, ' ', Color, Size.X);
+  MoveChar(B[I], Sign, Color, 1);
+  MoveStr(B[I + 1], Number, Color);
+  WriteBuf(0, 0, Size.X, 1, B);
+end;
+
+function TCalcDisplay.GetPalette: PPalette;
+const
+  P: string[1] = #19;
+begin
+  GetPalette := @P;
+end;
+
+procedure TCalcDisplay.HandleEvent(var Event: TEvent);
+var S: string[3];
+begin
+  inherited HandleEvent(Event);
+  case Event.What of
+    evKeyDown:
+      if Owner<>nil then
+      if (Owner^.State and sfSelected)<>0 then
+      begin
+        S:=Event.CharCode;
+        Message(Owner,evBroadcast,cmPressButton,@S);
+        if CalcKey(Event.CharCode) then
+        ClearEvent(Event);
+      end;
+    evBroadcast:
+      if Event.Command = cmCalcButton then
+      begin
+        CalcKey(PButton(Event.InfoPtr)^.Title^);
+        ClearEvent(Event);
+      end;
+  end;
+end;
+
+procedure TCalcDisplay.Store(var S: TStream);
+begin
+  TView.Store(S);
+  S.Write(Status, SizeOf(Status) + SizeOf(Number) + SizeOf(Sign) +
+    SizeOf(_Operator) + SizeOf(Operand));
+end;
+
+{ TCalculator }
+
+constructor TCalculator.Init;
+const
+  Keys: array[0..29] of string[3] =
+   ('M+',  'x^y','C'  ,#27  ,'%'  ,#241 ,
+    'M-',  'x^2','7'  ,'8'  ,'9'  ,'/'  ,
+    'M'#26,'1/x','4'  ,'5'  ,'6'  ,'*'  ,
+    'M'#27,'sqr','1'  ,'2'  ,'3'  ,'-'  ,
+    'M'#29,'log','0'  ,'.'  ,'='  ,'+'  );
+var
+  I: Integer;
+  P: PView;
+  R: TRect;
+begin
+  R.Assign(5, 3, 43, 18);
+  inherited Init(R, 'Calculator');
+  Options := Options or ofFirstClick or ofTopSelect;
+  HelpCtx:=hcCalcWindow;
+
+  for I := 0 to 29 do
+  begin
+    R.A.X := (I mod 6) * 5 + 2;
+    R.A.Y := (I div 6) * 2 + 4;
+    R.B.X := R.A.X + 5;
+    R.B.Y := R.A.Y + 2;
+    if (I mod 6)=0 then Inc(R.B.X,1) else
+    if (I mod 6)=1 then begin R.Move(1,0); Inc(R.B.X,2) end else
+    R.Move(3,0);
+    P := New(PCalcButton, Init(R, Keys[I], cmCalcButton,
+      bfNormal + bfBroadcast+bfGrabFocus));
+    P^.Options := P^.Options {and not ofSelectable};
+    Insert(P);
+  end;
+  R.Assign(3, 2, 35, 3);
+  New(CD, Init(R));
+  CD^.Options:=CD^.Options or ofSelectable;
+  Insert(CD);
+end;
+
+procedure TCalculator.HandleEvent(var Event: TEvent);
+var R: extended;
+    Re: real;
+begin
+  if (State and sfSelected)<>0 then
+  case Event.What of
+    evCommand :
+     case Event.Command of
+       cmCalculatorPaste :
+         Message(@Self,evKeyDown,kbCtrlEnter,nil);
+     end;
+    evKeyDown :
+     case Event.KeyCode of
+       kbEnter :
+         begin
+           Event.KeyCode:=0;
+           Event.CharCode:='=';
+         end;
+       kbCtrlEnter :
+         begin
+           ClearEvent(Event);
+           CD^.GetDisplay(R); Re:=R;
+           Close;
+           CalcClipboard:=R;
+           Message(Application,evBroadcast,cmCalculatorPaste,nil);
+         end;
+       kbEsc :
+         begin
+           CD^.GetDisplay(R);
+           if R<>0 then begin
+                          CD^.SetDisplay(0);
+                          CD^.DrawView;
+                        end
+                   else Close;
+           ClearEvent(Event);
+         end;
+     end;
+  end;
+  inherited HandleEvent(Event);
+  if Event.What=evKeyDown then
+     Message(CD,Event.What,Event.KeyCode,Event.InfoPtr);
+end;
+
+procedure TCalculator.Show;
+begin
+{  if GetState(sfVisible)=false then CD^.Clear;}
+  inherited Show;
+end;
+
+procedure TCalculator.Close;
+begin
+  Hide;
+end;
+
+procedure RegisterCalc;
+begin
+  RegisterType(RCalcDisplay);
+  RegisterType(RCalculator);
+end;
+
+end.
+{
+  $Log$
+  Revision 1.1  1998-12-22 14:27:54  peter
+    * moved
+
+  Revision 1.2  1998/12/22 10:39:39  peter
+    + options are now written/read
+    + find and replace routines
+
+}

ide/text/fpcfgs.pas

@@ -0,0 +1,502 @@
+{
+    $Id$
+    This file is part of the Free Pascal Integrated Development Environment
+    Copyright (c) 1998 by Berczi Gabor
+
+    Options/config routines for the IDE
+
+    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.
+
+ **********************************************************************}
+unit FPCfgs;
+
+interface
+
+uses
+  Objects,
+  Systems;
+
+const
+     MinStackSize    = 1024;
+     MaxStackSize    = 67107840;
+     MinHeapSize     = 1024;
+     MaxHeapSize     = 67107840;
+
+type
+    TOptionMode = (om_Normal,om_Debug,om_Release);
+
+    TOptionToggle = array[TOptionMode] of boolean;
+    TOptionString = array[TOptionMode] of string;
+    TOptionValue  = array[TOptionMode] of longint;
+
+    POptionItem = ^TOptionItem;
+    TOptionItem = record
+      Name      : string[30];
+      Param     : string[10];
+      IsSet     : TOptionToggle;
+    end;
+
+    POptionItemCollection = ^TOptionItemCollection;
+    TOptionItemCollection = object(TCollection)
+      function  At(Index: Integer): POptionItem;
+      procedure FreeItem(Item: Pointer); virtual;
+    end;
+
+    POptions = ^TOptions;
+    TOptions = object
+      constructor InitToggle(ch:char);
+      constructor InitSel(ch:char);
+      destructor  Done;
+      { items }
+      procedure AddItem(const name,param:string);
+      function  ItemCount:integer;
+      function  ItemName(index:integer):string;
+      function  ItemParam(index:integer):string;
+      function  ItemIsSet(index:integer):boolean;
+      procedure ItemSet(index:integer;b:boolean);
+      function  GetCurrSel:integer;
+      procedure SetCurrSel(index:integer);
+      { read / write to cfgfile which must be open }
+      procedure WriteItemsCfg;
+      function  ReadItemsCfg(const s:string):boolean;
+    private
+      IsSel  : boolean;
+      Prefix : char;
+      SelNr  : integer;
+      Items  : POptionItemCollection;
+    end;
+
+    PDirectories = ^TDirectories;
+    TDirectories = record
+      LibraryDirs,
+      IncludeDirs,
+      UnitDirs,
+      ObjectDirs  : TOptionString;
+    end;
+
+const
+    OptionMode : TOptionMode = om_Normal;
+
+var
+    SyntaxOptions,
+    VerboseOptions,
+    CodegenOptions,
+    OptimizationOptions,
+    ProcessorOptions,
+    AsmReaderOptions,
+    TargetOptions : POptions;
+    Dirs          : PDirectories;
+    CondDefs      : TOptionString;
+
+{ other settings }
+function GetConditionalDefines: string;
+procedure SetConditionalDefines(const Defs: string);
+
+{ write/read the options to ppc.cfg file }
+procedure WriteOptions(const fn:string);
+procedure ReadOptions(const fn:string);
+
+{ initialize }
+procedure InitOptions;
+procedure DoneOptions;
+
+
+implementation
+
+uses
+  GlobType,Tokens,Compiler;
+
+var
+  CfgFile : text;
+
+
+{*****************************************************************************
+                             TOptionItemCollection
+*****************************************************************************}
+
+function  TOptionItemCollection.At(Index: Integer): POptionItem;
+begin
+  At:=inherited At(Index);
+end;
+
+procedure TOptionItemCollection.FreeItem(Item: Pointer);
+begin
+  if assigned(Item) then
+   Dispose(POptionItem(Item));
+end;
+
+
+{*****************************************************************************
+                                   TOption
+*****************************************************************************}
+
+function NewOptionItem(const Name,Param:string):POptionItem;
+var
+  P : POptionItem;
+begin
+  New(P);
+  P^.Name:=Name;
+  P^.Param:=Param;
+  FillChar(P^.IsSet,sizeof(P^.IsSet),0);
+  NewOptionItem:=P;
+end;
+
+
+constructor TOptions.InitToggle(ch:char);
+begin
+  new(Items,Init(10,5));
+  Prefix:=ch;
+  SelNr:=0;
+  IsSel:=false;
+end;
+
+
+constructor TOptions.InitSel(ch:char);
+begin
+  new(Items,Init(10,5));
+  Prefix:=ch;
+  SelNr:=0;
+  IsSel:=true;
+end;
+
+
+destructor  TOptions.Done;
+begin
+  dispose(Items,Done);
+end;
+
+
+procedure TOptions.AddItem(const name,param:string);
+begin
+  Items^.Insert(NewOptionItem(name,Param));
+end;
+
+
+function TOptions.ItemCount:integer;
+begin
+  ItemCount:=Items^.Count;
+end;
+
+
+function TOptions.ItemName(index:integer):string;
+var
+  P : POptionItem;
+begin
+  P:=Items^.At(Index);
+  if assigned(P) then
+   ItemName:=P^.Name
+  else
+   ItemName:='';
+end;
+
+
+function TOptions.ItemParam(index:integer):string;
+var
+  P : POptionItem;
+begin
+  P:=Items^.At(Index);
+  if assigned(P) then
+   ItemParam:='-'+Prefix+P^.Param
+  else
+   ItemParam:='';
+end;
+
+
+function TOptions.ItemIsSet(index:integer):boolean;
+var
+  P : POptionItem;
+begin
+  if not IsSel then
+   begin
+     P:=Items^.At(Index);
+     if assigned(P) then
+      ItemIsSet:=P^.IsSet[OptionMode]
+     else
+      ItemIsSet:=false;
+   end
+  else
+   ItemIsSet:=false;
+end;
+
+
+procedure TOptions.ItemSet(index:integer;b:boolean);
+var
+  P : POptionItem;
+begin
+  if not IsSel then
+   begin
+     P:=Items^.At(Index);
+     if assigned(P) then
+      P^.IsSet[OptionMode]:=b;
+   end;
+end;
+
+
+function TOptions.GetCurrSel:integer;
+begin
+  if IsSel then
+   GetCurrSel:=SelNr
+  else
+   GetCurrSel:=-1;
+end;
+
+
+procedure TOptions.SetCurrSel(index:integer);
+begin
+  if IsSel then
+   SelNr:=index;
+end;
+
+
+procedure TOptions.WriteItemsCfg;
+var
+  Pref : char;
+
+  procedure writeitem(P:POptionItem);{$ifndef FPC}far;{$endif}
+  begin
+    if (P^.Param<>'') and (P^.IsSet[OptionMode]) then
+      Writeln(CfgFile,'-'+Pref+P^.Param)
+  end;
+
+begin
+  Pref:=Prefix;
+  if IsSel then
+   begin
+     writeln(CfgFile,ItemParam(SelNr));
+   end
+  else
+   begin
+     Items^.ForEach(@writeitem);
+   end;
+end;
+
+
+function TOptions.ReadItemsCfg(const s:string):boolean;
+var
+  FoundP : POptionItem;
+
+  function checkitem(P:POptionItem):boolean;{$ifndef FPC}far;{$endif}
+  begin
+    CheckItem:=(P^.Param=s);
+  end;
+
+begin
+  FoundP:=Items^.FirstThat(@checkitem);
+  if assigned(FoundP) then
+   begin
+     if IsSel then
+      SelNr:=Items^.IndexOf(FoundP)
+     else
+      FoundP^.IsSet[OptionMode]:=true;
+     ReadItemsCfg:=true;
+   end
+  else
+   ReadItemsCfg:=false;
+end;
+
+
+{*****************************************************************************
+                                    Others
+*****************************************************************************}
+
+function GetConditionalDefines: string;
+begin
+  GetConditionalDefines:=CondDefs[OptionMode];
+end;
+
+
+procedure SetConditionalDefines(const Defs: string);
+begin
+  CondDefs[OptionMode]:=Defs;
+end;
+
+
+procedure WriteConditionalDefines;
+var
+  s,s1 : string;
+  i : integer;
+begin
+  s:=CondDefs[OptionMode];
+  repeat
+    i:=pos(' ',s);
+    if i=0 then
+     i:=255;
+    s1:=Copy(s,1,i-1);
+    if s1<>'' then
+     writeln(CfgFile,'-d'+s1);
+    Delete(s,1,i);
+  until s='';
+end;
+
+
+procedure ReadConditionalDefines(const s:string);
+begin
+  CondDefs[OptionMode]:=CondDefs[OptionMode]+s;
+end;
+
+
+{*****************************************************************************
+                                 Read / Write
+*****************************************************************************}
+
+procedure WriteOptions(const fn:string);
+begin
+{ create the switches }
+  assign(CfgFile,fn);
+  {$I-}
+   rewrite(CfgFile);
+  {$I+}
+  if ioresult<>0 then
+   exit;
+  writeln(CfgFile,'# Automaticly created file, don''t edit.');
+  TargetOptions^.WriteItemsCfg;
+  VerboseOptions^.WriteItemsCfg;
+  SyntaxOptions^.WriteItemsCfg;
+  CodegenOptions^.WriteItemsCfg;
+  OptimizationOptions^.WriteItemsCfg;
+  ProcessorOptions^.WriteItemsCfg;
+  AsmReaderOptions^.WriteItemsCfg;
+  WriteConditionalDefines;
+  close(CfgFile);
+end;
+
+
+procedure ReadOptions(const fn:string);
+var
+  c : char;
+  s : string;
+begin
+  assign(CfgFile,fn);
+  {$I-}
+   reset(CfgFile);
+  {$I+}
+  if ioresult<>0 then
+   exit;
+  while not eof(CfgFile) do
+   begin
+     readln(CfgFile,s);
+     if (length(s)>2) and (s[1]='-') then
+      begin
+        c:=s[2];
+        Delete(s,1,2);
+        case c of
+         'd' : ReadConditionalDefines(s);
+         'S' : SyntaxOptions^.ReadItemsCfg(s);
+         'T' : TargetOptions^.ReadItemsCfg(s);
+         'R' : AsmReaderOptions^.ReadItemsCfg(s);
+         'C' : CodegenOptions^.ReadItemsCfg(s);
+         'v' : VerboseOptions^.ReadItemsCfg(s);
+         'O' : begin
+                 if not OptimizationOptions^.ReadItemsCfg(s) then
+                  ProcessorOptions^.ReadItemsCfg(s);
+               end;
+        end;
+      end;
+   end;
+  close(CfgFile);
+end;
+
+
+
+{*****************************************************************************
+                                 Initialize
+*****************************************************************************}
+
+procedure InitOptions;
+begin
+  New(SyntaxOptions,InitToggle('S'));
+  with SyntaxOptions^ do
+   begin
+     AddItem('~D~elphi 2 extensions on','2');
+     AddItem('~C~-like operators','c');
+     AddItem('S~t~op after first error','e');
+     AddItem('Allo~w~ LABEL and GOTO','g');
+     AddItem('C++ styled ~i~nline','i');
+     AddItem('Global C ~m~acros','m');
+     AddItem('TP/BP ~7~.0 compatibility','o');
+     AddItem('Del~p~hi compatibility','d');
+     AddItem('A~l~low STATIC in objects','s');
+   end;
+  New(VerboseOptions,InitToggle('v'));
+  with VerboseOptions^ do
+   begin
+     AddItem('~W~arnings','w');
+     AddItem('~N~otes','n');
+     AddItem('~H~ints','h');
+     AddItem('General ~I~nfo','i');
+     AddItem('~U~sed,tried info','ut');
+     AddItem('~A~ll','a');
+     AddItem('Show all ~P~rocedures if error','b');
+   end;
+  New(CodegenOptions,InitToggle('C'));
+  with CodegenOptions^ do
+   begin
+     AddItem('~R~ange checking','r');
+     AddItem('~S~tack checking','t');
+     AddItem('~I~/O checking','i');
+     AddItem('Integer ~o~verflow checking','o');
+   end;
+  New(OptimizationOptions,InitToggle('O'));
+  with OptimizationOptions^ do
+   begin
+     AddItem('Generate ~s~maller code','g');
+     AddItem('Generate ~f~aster code','G');
+     AddItem('Use register-~v~ariables','r');
+     AddItem('~U~ncertain optimizations','u');
+     AddItem('Level ~1~ optimizations','1');
+     AddItem('Level ~2~ optimizations','2');
+   end;
+  New(ProcessorOptions,InitSel('O'));
+  with ProcessorOptions^ do
+   begin
+     AddItem('i~3~86/i486','p1');
+     AddItem('Pentium/PentiumMM~X~ (tm)','p2');
+     AddItem('P~P~ro/PII/c6x86/K6 (tm)','p3');
+   end;
+  New(TargetOptions,InitSel('T'));
+  with TargetOptions^ do
+   begin
+     AddItem('DOS (GO32V~1~)','go32v1');
+     AddItem('~D~OS (GO32V2)','go32v2');
+     AddItem('~L~inux','linux');
+     AddItem('~O~S/2','os2');
+     AddItem('~W~IN32','win32');
+   end;
+  New(AsmReaderOptions,InitSel('R'));
+  with AsmReaderOptions^ do
+   begin
+     AddItem('No preprocessin~g~','direct');
+     AddItem('~A~T&T style assembler','att');
+     AddItem('Int~e~l style assembler','intel');
+   end;
+end;
+
+
+procedure DoneOptions;
+begin
+  dispose(SyntaxOptions,Done);
+  dispose(VerboseOptions,Done);
+  dispose(CodegenOptions,Done);
+  dispose(OptimizationOptions,Done);
+  dispose(ProcessorOptions,Done);
+  dispose(TargetOptions,Done);
+  dispose(AsmReaderOptions,Done);
+end;
+
+
+end.
+{
+  $Log$
+  Revision 1.1  1998-12-22 14:27:54  peter
+    * moved
+
+  Revision 1.1  1998/12/22 10:39:40  peter
+    + options are now written/read
+    + find and replace routines
+
+}

ide/text/fpcompil.pas

@@ -0,0 +1,237 @@
+{
+    $Id$
+    This file is part of the Free Pascal Integrated Development Environment
+    Copyright (c) 1998 by Berczi Gabor
+
+    Compiler call routines for the IDE
+
+    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.
+
+ **********************************************************************}
+unit FPCompile;
+
+interface
+
+uses FPViews;
+
+type
+    TCompileMode = (cBuild,cMake,cCompile);
+
+{$ifdef OLDCOMPSTAT}
+    TCompPhase = (cpCompiling,cpLinking,cpDone);
+
+    PCompileStatusDialog = ^TCompileStatusDialog;
+    TCompileStatusDialog = object(TCenterDialog)
+      ST    : PAdvancedStaticText;
+      KeyST : PColorStaticText;
+      constructor Init;
+      procedure   Update;
+    end;
+{$endif}
+
+const
+      PrimaryFile    : string = '';
+      IsEXECompiled  : boolean = false;
+      MainFile         : string = '';
+
+{$ifdef OLDCOMPSTAT}
+      CompilationPhase : TCompPhase = cpDone;
+{$endif}
+      ProgramInfoWindow : PProgramInfoWindow = nil;
+
+
+procedure DoCompile(Mode: TCompileMode);
+
+
+implementation
+
+uses
+  Video,
+  Objects,Drivers,Views,App,
+  CompHook,
+  FPConst,FPUtils,FPIntf;
+
+{$ifdef OLDCOMPSTAT}
+
+const SD: PCompileStatusDialog = nil;
+
+constructor TCompileStatusDialog.Init;
+var R: TRect;
+begin
+  R.Assign(0,0,50,11{+7});
+  inherited Init(R, 'Compiling');
+  GetExtent(R); R.B.Y:=11;
+  R.Grow(-3,-2);
+  New(ST, Init(R, ''));
+  Insert(ST);
+  GetExtent(R); R.B.Y:=11;
+  R.Grow(-1,-1); R.A.Y:=R.B.Y-1;
+  New(KeyST, Init(R, '', Blue*16+White+longint($80+Blue*16+White)*256));
+  Insert(KeyST);
+{  GetExtent(R); R.Grow(-1,-1); R.A.Y:=10;
+  New(MsgLB, Init(R, 1, nil));
+  MsgLB^.NewList(New(PUnsortedStringCollection, Init(100,100)));
+  Insert(MsgLB);}
+end;
+
+
+procedure TCompileStatusDialog.Update;
+var StatusS,KeyS: string;
+const CtrlBS = 'Press Ctrl+Break to cancel';
+      SuccessS = 'Compile successful: ~Press Enter~';
+      FailS = 'Compile failed';
+begin
+  case CompilationPhase of
+    cpCompiling :
+      begin
+        StatusS:='Compiling '+Status.CurrentSource;
+        KeyS:=CtrlBS;
+      end;
+    cpLinking   :
+      begin
+        StatusS:='Linking...';
+        KeyS:=CtrlBS;
+      end;
+    cpDone      :
+      begin
+        StatusS:='Done.';
+        if Status.ErrorCount=0 then KeyS:=SuccessS else KeyS:=FailS;
+      end;
+  end;
+  ST^.SetText(
+    'Main file: '+MainFile+#13+
+    StatusS+#13#13+
+    'Target: '+LExpand(KillTilde(GetTargetOSName(GetTargetOS)),12)+'    '+
+    'Line number: '+IntToStrL(Status.CurrentLine,7)+#13+
+    'Free memory: '+IntToStrL(MemAvail div 1024,6)+'K'+ '    '+
+    'Total lines: '+IntToStrL(Status.CompiledLines,7)+#13+
+    'Total errors: '+IntToStrL(Status.ErrorCount,5)
+  );
+  KeyST^.SetText(^C+KeyS);
+end;
+
+{$endif}
+
+
+{****************************************************************************
+                               Compiler Hooks
+****************************************************************************}
+
+function CompilerStatus: boolean; {$ifndef FPC}far;{$endif}
+begin
+{$ifdef OLDCOMPSTAT}
+  SD^.Update;
+{$endif}
+  CompilerStatus:=false;
+end;
+
+
+procedure CompilerStop; {$ifndef FPC}far;{$endif}
+begin
+end;
+
+
+function CompilerComment(Level:Longint; const s:string):boolean; {$ifndef FPC}far;{$endif}
+begin
+  ProgramInfoWindow^.AddMessage(Level,S,SmartPath(status.currentmodule),status.currentline);
+  CompilerComment:=false;
+end;
+
+
+{****************************************************************************
+                                 DoCompile
+****************************************************************************}
+
+procedure DoCompile(Mode: TCompileMode);
+
+  function IsExitEvent(E: TEvent): boolean;
+  begin
+    IsExitEvent:=(E.What=evKeyDown) and
+                 ((E.KeyCode=kbEnter) or (E.KeyCode=kbEsc));
+  end;
+
+
+var
+  P: PSourceWindow;
+  FileName: string;
+  E: TEvent;
+  WasVisible: boolean;
+begin
+{ Get FileName }
+  P:=Message(Desktop,evBroadcast,cmSearchWindow,nil);
+  if (PrimaryFile='') and (P=nil) then
+    begin
+      ErrorBox('Oooops, nothing to compile.',nil);
+      Exit;
+    end;
+  if PrimaryFile<>'' then
+    FileName:=PrimaryFile
+  else
+    begin
+      if P^.Editor^.Modified and (not P^.Editor^.Save) then
+       begin
+         ErrorBox('Can''t compile unsaved file.',nil);
+         Exit;
+       end;
+      FileName:=P^.Editor^.FileName;
+    end;
+  MainFile:=SmartPath(FileName);
+{ Reset }
+  CtrlBreakHit:=false;
+{ Show Program Info }
+  WasVisible:=ProgramInfoWindow^.GetState(sfVisible);
+  ProgramInfoWindow^.LogLB^.Clear;
+  if WasVisible=false then
+    ProgramInfoWindow^.Show;
+  ProgramInfoWindow^.MakeFirst;
+
+{$ifdef OLDCOMPSTAT}
+  CompilationPhase:=cpCompiling;
+  New(SD, Init);
+  Application^.Insert(SD);
+  SD^.Update;
+{$endif}
+
+  do_status:=CompilerStatus;
+  do_stop:=CompilerStop;
+  do_comment:=CompilerComment;
+
+  Compile(FileName);
+
+{$ifdef OLDCOMPSTAT}
+  CompilationPhase:=cpDone;
+  SD^.Update;
+{$endif}
+
+  if status.errorcount=0 then
+   repeat
+     Application^.GetEvent(E);
+     if IsExitEvent(E)=false then
+      Application^.HandleEvent(E);
+   until IsExitEvent(E);
+
+{$ifdef OLDCOMPSTAT}
+  Application^.Delete(SD);
+  Dispose(SD, Done);
+{$endif}
+
+  if (WasVisible=false) and (status.errorcount=0) then
+   ProgramInfoWindow^.Hide;
+end;
+
+end.
+{
+  $Log$
+  Revision 1.1  1998-12-22 14:27:54  peter
+    * moved
+
+  Revision 1.3  1998/12/22 10:39:40  peter
+    + options are now written/read
+    + find and replace routines
+
+}

ide/text/fpconst.pas

@@ -0,0 +1,207 @@
+{
+    $Id$
+    This file is part of the Free Pascal Integrated Development Environment
+    Copyright (c) 1998 by Berczi Gabor
+
+    Constants used by the IDE
+
+    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.
+
+ **********************************************************************}
+unit FPConst;
+
+interface
+
+uses Views,App,Commands;
+
+const
+     VersionStr      = '0.9';
+
+     { Strings/Messages }
+     strLoadingHelp       = 'Loading help files...';
+     strBuildingHelpIndex = 'Building Help Index...';
+     strLocatingTopic     = 'Locating topic...';
+
+     { Main menu submenu indexes }
+     menuFile             = 0;
+
+     { Command constants }
+     cmShowClipboard     = 201;
+     cmFindProcedure     = 206;
+     cmObjects           = 207;
+     cmModules           = 208;
+     cmGlobals           = 209;
+     cmRun               = 210;
+     cmParameters        = 211;
+     cmUserScreen        = 212;
+     cmCompile           = 213;
+     cmMake              = 214;
+     cmBuild             = 215;
+     cmTarget            = 216;
+     cmPrimaryFile       = 217;
+     cmClearPrimary      = 218;
+     cmInformation       = 219;
+     cmWindowList        = 220;
+     cmHelpTopicSearch   = 221;
+
+     cmNotImplemented    = 1000;
+     cmNewFromTemplate   = 1001;
+
+     cmSearchWindow      = 1500;
+     cmUpdate            = 1600;
+     cmSourceWindowClosing = 1601;
+     cmDeleteWnd         = 1602;
+     cmLocalMenu         = 1603;
+     cmCalculatorPaste   = 1604;
+
+     cmToolsMessages     = 1700;
+     cmToolsBase         = 1800;
+     cmRecentFileBase    = 1850;
+
+     cmCompiler          = 2000;
+     cmMemorySizes       = 2001;
+     cmLinker            = 2002;
+     cmDebugger          = 2003;
+     cmDirectories       = 2004;
+     cmTools             = 2005;
+     cmPreferences       = 2006;
+     cmEditor            = 2007;
+     cmMouse             = 2008;
+     cmStartup           = 2009;
+     cmColors            = 2010;
+     cmCalculator        = 2011;
+     cmAbout             = 2050;
+
+     cmHelpContents      = 2100;
+     cmHelpIndex         = 2101;
+     cmHelpPrevTopic     = 2103;
+     cmHelpUsingHelp     = 2104;
+     cmHelpFiles         = 2105;
+
+     cmOpenAtCursor      = 2200;
+     cmBrowseAtCursor    = 2201;
+     cmEditorOptions     = 2202;
+
+     { Help constants }
+     hcSourceWindow      = 8000;
+     hcHelpWindow        = 8001;
+     hcClipboardWindow   = 8002;
+     hcCalcWindow        = 8003;
+
+     hcShift             = 10000;
+
+     hcUsingHelp         = 2;
+     hcContents          = 3;
+     hcQuit              = hcShift+cmQuit;
+     hcRedo              = hcShift+cmRedo;
+     hcFind              = hcShift+cmFind;
+     hcReplace           = hcShift+cmReplace;
+     hcSearchAgain       = hcShift+cmSearchAgain;
+     hcGotoLine          = hcShift+cmJumpLine;
+
+     hcToolsMessages     = hcShift+cmToolsMessages;
+     hcToolsBase         = hcShift+cmToolsBase;
+     hcRecentFileBase    = hcShift+cmRecentFileBase;
+
+     hcCompiler          = hcShift+cmCompiler;
+     hcMemorySizes       = hcShift+cmMemorySizes;
+     hcLinker            = hcShift+cmLinker;
+     hcDebugger          = hcShift+cmDebugger;
+     hcDirectories       = hcShift+cmDirectories;
+     hcTools             = hcShift+cmTools;
+     hcPreferences       = hcShift+cmPreferences;
+     hcEditor            = hcShift+cmEditor;
+     hcMouse             = hcShift+cmMouse;
+     hcStartup           = hcShift+cmStartup;
+     hcColors            = hcShift+cmColors;
+     hcCalculator        = hcShift+cmCalculator;
+     hcAbout             = hcShift+cmAbout;
+
+     hcSystemMenu        = 9000;
+     hcFileMenu          = 9001;
+     hcEditMenu          = 9002;
+     hcSearchMenu        = 9003;
+     hcRunMenu           = 9004;
+     hcCompileMenu       = 9005;
+     hcDebugMenu         = 9006;
+     hcToolsMenu         = 9007;
+     hcOptionsMenu       = 9008;
+     hcEnvironmentMenu   = 9009;
+     hcWindowMenu        = 9010;
+     hcHelpMenu          = 9011;
+
+     hcFirstCommand      = hcSystemMenu;
+     hcLastCommand       = 65535;
+
+     hcShowClipboard     = hcShift+cmShowClipboard;
+     hcFindProcedure     = hcShift+cmFindProcedure;
+     hcObjects           = hcShift+cmObjects;
+     hcModules           = hcShift+cmModules;
+     hcGlobals           = hcShift+cmGlobals;
+     hcRun               = hcShift+cmRun;
+     hcParameters        = hcShift+cmParameters;
+     hcUserScreen        = hcShift+cmUserScreen;
+     hcCompile           = hcShift+cmCompile;
+     hcMake              = hcShift+cmMake;
+     hcBuild             = hcShift+cmBuild;
+     hcTarget            = hcShift+cmTarget;
+     hcPrimaryFile       = hcShift+cmPrimaryFile;
+     hcClearPrimary      = hcShift+cmClearPrimary;
+     hcInformation       = hcShift+cmInformation;
+     hcWindowList        = hcShift+cmWindowList;
+     hcNewFromTemplate   = hcShift+cmNewFromTemplate;
+     hcHelpTopicSearch   = hcShift+cmHelpTopicSearch;
+     hcHelpContents      = hcShift+cmHelpContents;
+     hcHelpIndex         = hcShift+cmHelpIndex;
+     hcHelpPrevTopic     = hcShift+cmHelpPrevTopic;
+     hcHelpUsingHelp     = hcShift+cmHelpUsingHelp;
+     hcHelpFiles         = hcShift+cmHelpFiles;
+     hcUpdate            = hcShift+cmUpdate;
+
+     hcOpenAtCursor      = hcShift+cmOpenAtCursor;
+     hcBrowseAtCursor    = hcShift+cmBrowseAtCursor;
+     hcEditorOptions     = hcShift+cmEditorOptions;
+
+     { History constants }
+     hisChDirDialog      = 2000;
+
+     CIDEHelpDialog      =
+        #128#129#130#131#132#133#134#135#136#137#138#139#140#141#142#143 +
+        #144#145#146#147#148#149#150#151#152#153#154#155#156#157#158#159 +
+        #160#161#162#163 +
+        #164#165#166;
+
+     CSourceWindow =
+        #167#168#169#170#171#172#173#174#175#176#177#178#179#180#181#182 +
+        #183#184#185#186#187#188#189#190#191#192#193#194#195#196#197#198 +
+        #199#200#201#202#203#204#205#206#207#208#209#210#211#212#213#214 ;
+
+     CIDEAppColor        = CAppColor +
+         { CIDEHelpDialog }
+{128-143}#$70#$7F#$7A#$13#$13#$70#$70#$7F#$7E#$20#$2B#$2F#$78#$2E#$70#$30 + { 1-16}
+{144-159}#$3F#$3E#$1F#$2F#$1A#$20#$72#$31#$31#$30#$2F#$3E#$31#$13#$38#$00 + {17-32}
+{160-163}#$30#$3E#$1E#$70 + { CHelpViewer }                                 {33-36}
+{164-166}#$30#$3F#$3A +     { CHelpFrame }                                  {37-39}
+         { CSourceWindow }
+{167-182}#$17#$1F#$1A#$31#$31#$1E#$71#$1F#$00#$00#$00#$00#$00#$00#$00#$00 + { 1-16}
+{183-198}#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00 + {17-32}
+{199-214}#$1E#$1F#$17#$1F#$1E#$1B#$13#$1A#$1E#$71#$3F#$1F#$1C#$00#$00#$4E ; {33-48}
+
+implementation
+
+END.
+{
+  $Log$
+  Revision 1.1  1998-12-22 14:27:54  peter
+    * moved
+
+  Revision 1.3  1998/12/22 10:39:41  peter
+    + options are now written/read
+    + find and replace routines
+
+}

ide/text/fphelp.pas

@@ -0,0 +1,307 @@
+{
+    $Id$
+    This file is part of the Free Pascal Integrated Development Environment
+    Copyright (c) 1998 by Berczi Gabor
+
+    Help routines for the IDE
+
+    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.
+
+ **********************************************************************}
+unit FPHelp;
+
+interface
+
+uses
+  Drivers,HelpCtx,WHlpView,
+{$ifdef EDITORS}
+  Editors,
+{$else}
+  WEditor,
+{$endif}
+  FPViews;
+
+type
+    PIDEStatusLine = ^TIDEStatusLine;
+    TIDEStatusLine = object(TAdvancedStatusLine)
+      function  Hint(AHelpCtx: Word): String; virtual;
+      procedure HandleEvent(var Event: TEvent); virtual;
+    end;
+
+procedure Help(FileID, Context: word; Modal: boolean);
+procedure HelpIndex(Keyword: string);
+procedure HelpTopicSearch(Editor: PEditor);
+procedure InitHelpSystem;
+procedure DoneHelpSystem;
+
+procedure PushStatus(S: string);
+procedure SetStatus(S: string);
+procedure ClearStatus;
+procedure PopStatus;
+
+const
+      HelpWindow     : PIDEHelpWindow = nil;
+      HelpInited     : boolean = false;
+
+implementation
+
+uses Objects,Views,App,MsgBox,
+     WHelp,
+     FPConst,FPUtils;
+
+var StatusStack : array[0..10] of string[MaxViewWidth];
+
+const
+      StatusStackPtr  : integer = 0;
+
+procedure TIDEStatusLine.HandleEvent(var Event: TEvent);
+begin
+  case Event.What of
+    evBroadcast :
+      case Event.Command of
+        cmUpdate : Update;
+      end;
+  end;
+  inherited HandleEvent(Event);
+end;
+
+function TIDEStatusLine.Hint(AHelpCtx: Word): String;
+var S: string;
+begin
+  case AHelpCtx of
+    hcNoContext     : S:='';
+
+    hcSourceWindow  : S:='';
+    hcHelpWindow    : S:='';
+    hcCalcWindow    : S:='';
+
+    hcSystemMenu    : S:='System menu';
+    hcUpdate        : S:='Refresh and redraw display';
+    hcAbout         : S:='Show version and copyright information';
+
+    hcFileMenu      : S:='File managment commands (Open, New, Save, etc.)';
+    hcNew           : S:='Create a new file in a new edit window';
+    hcOpen          : S:='Locate and open a file in an edit window';
+    hcSave          : S:='Save the file in the active edit window';
+    hcSaveAs        : S:='Save the current file under a different name, directory or drive';
+    hcSaveAll       : S:='Save all modified files';
+    hcChangeDir     : S:='Choose a new default directory';
+    hcDOSShell      : S:='Temporarily exit to DOS';
+    hcQuit          : S:='Exit the IDE';
+    hcRecentFileBase..hcRecentFileBase+10
+                    : S:='Open indicated file in a new editor window';
+
+    hcEditMenu      : S:='Clipboard editing commands';
+    hcUndo          : S:='Undo the previous editor operation';
+    hcRedo          : S:='Redo the previously undone editor operation';
+    hcCut           : S:='Remove the selected text and put it in the clipboard';
+    hcCopy          : S:='Copy the selected text in the clipboard';
+    hcPaste         : S:='Insert selected text from the clipboard at the cursor position';
+    hcClear         : S:='Delete the selected text';
+    hcShowClipboard : S:='Open then clipboard window';
+
+    hcSearchMenu    : S:='Text and symbols search commands';
+    hcFind          : S:='Search for text';
+    hcReplace       : S:='Search for text and replace it with new text';
+    hcSearchAgain   : S:='Repeat the last Search or Replace command';
+    hcGotoLine      : S:='Move the cursor to a specified line number';
+    hcObjects       : S:='Open a browser displaying all objects in the program';
+    hcModules       : S:='Open a browser displaying all modules of the program';
+    hcGlobals       : S:='Open a browser displaying all global symbols in the program';
+
+    hcRunMenu       : S:='Execution and parameters';
+    hcRun           : S:='Run the current program';
+    hcParameters    : S:='Set command-line parameters passed to program at execution';
+    hcUserScreen    : S:='Switch to the full-screen user output';
+
+    hcCompileMenu   : S:='Compile, build & make';
+    hcCompile       : S:='Compile the current source file';
+    hcMake          : S:='Rebuild soruce file and all other files that have been modified';
+    hcBuild         : S:='Rebuild program and all available source files';
+    hcTarget        : S:='Select target platform to compile for';
+    hcPrimaryFile   : S:='Define then file that is the focus of Make and Build';
+    hcClearPrimary  : S:='Clear the file previously set to Primary';
+    hcInformation   : S:='Show compiler messages and program information';
+
+    hcDebugMenu     : S:='';
+
+    hcToolsMenu     : S:='User installed tools';
+    hcCalculator    : S:='Show calculator';
+
+    hcOptionsMenu   : S:='Setting for compiler, editor, mouse, etc.';
+    hcCompiler      : S:='Set default compiler directives and conditional defines';
+    hcMemorySizes   : S:='Set default stack and heap sizes for generated programs';
+    hcLinker        : S:='Set linker options';
+    hcDebugger      : S:='Set debug information options';
+    hcDirectories   : S:='Set paths for units, include, object and generated files';
+    hcTools         : S:='Create or change tools';
+
+    hcEnvironmentMenu:S:='Specify environment settins';
+    hcPreferences   : S:='Specify desktop settings';
+    hcEditor        : S:='Specify default editor settings';
+    hcMouse         : S:='Specify mouse settings';
+    hcStartup       : S:='Permanently change default startup options';
+
+    hcWindowMenu    : S:='Windows managment commands';
+    hcTile          : S:='Arrange windows on desktop by tiling';
+    hcCascade       : S:='Arrange windows on desktop by cascading';
+    hcCloseAll      : S:='Close all windows on the desktop';
+    hcResize        : S:='Change the size/postion of the active window';
+    hcZoom          : S:='Enlarge or restore the size of the active window';
+    hcNext          : S:='Make the next window active';
+    hcPrev          : S:='Make the previous window active';
+    hcClose         : S:='Close the active window';
+    hcWindowList    : S:='Show a list of all open windows';
+
+    hcHelpMenu      : S:='Get online help';
+    hcHelpContents  : S:='Show table of contents for Online Help';
+    hcHelpIndex     : S:='Show index for Online Help';
+    hcHelpTopicSearch:S:='Display help on the word at cursor';
+    hcHelpPrevTopic : S:='Redisplay the last-viewed Online Help screen';
+    hcHelpUsingHelp : S:='How to use Online Help';
+    hcHelpFiles     : S:='Install or remove installed help files';
+
+    hcOpenAtCursor  : S:='Attempt to open the file indicated by the word at cursor';
+    hcBrowseAtCursor: S:='Attempt to browse the symbol at cursor';
+    hcEditorOptions : S:='Specify editor settings';
+  else S:='???';
+  end;
+  Hint:=S;
+end;
+
+procedure InitHelpSystem;
+procedure AddFile(HelpFile: string);
+begin
+  {$IFDEF DEBUG}SetStatus(strLoadingHelp+' ('+SmartPath(HelpFile)+')');{$ENDIF}
+  HelpFacility^.AddHelpFile(HelpFile);
+  {$IFDEF DEBUG}SetStatus(strLoadingHelp);{$ENDIF}
+end;
+begin
+  New(HelpFacility, Init);
+  PushStatus(strLoadingHelp);
+  AddFile('C:\BP\BIN\TURBO.TPH');
+{  AddFile('C:\BP\BIN\TVISION.TPH');
+  AddFile('C:\BP\BIN\OWL.TPH');
+  AddFile('C:\BP\BIN\WINDOWS.TPH');}
+  PopStatus;
+end;
+
+procedure CheckHelpSystem;
+begin
+  if HelpInited then Exit;
+  InitHelpSystem;
+  HelpInited:=true;
+end;
+
+procedure DoneHelpSystem;
+begin
+  if HelpFacility<>nil then Dispose(HelpFacility, Done); HelpFacility:=nil;
+  HelpInited:=false;
+end;
+
+procedure HelpCreateWindow;
+var R: TRect;
+begin
+  CheckHelpSystem;
+  if HelpWindow=nil then
+  begin
+     Desktop^.GetExtent(R); R.Grow(-15,-3); Dec(R.A.Y);
+     New(HelpWindow, Init(R, 'Help', 0, 0, wnNoNumber));
+     if HelpWindow<>nil then
+     begin
+       HelpWindow^.HelpCtx:=hcHelpWindow;
+       HelpWindow^.HideOnClose:=true;
+       HelpWindow^.Hide;
+       Desktop^.Insert(HelpWindow);
+     end;
+  end;
+end;
+
+procedure Help(FileID, Context: word; Modal: boolean);
+begin
+  if Modal then
+     begin MessageBox('Sorry, modal help not yet implemented.',nil,mfInformation+mfInsertInApp+mfOKButton); Exit; end;
+  HelpCreateWindow;
+  with HelpWindow^ do
+  begin
+    HelpWindow^.ShowTopic(0,Context);
+    if GetState(sfVisible)=false then Show;
+    MakeFirst;
+  end;
+  Message(Application,evCommand,cmUpdate,nil);
+end;
+
+procedure HelpTopicSearch(Editor: PEditor);
+var FileID, Ctx: word;
+    S: string;
+var Found: boolean;
+begin
+  CheckHelpSystem;
+  S:=GetEditorCurWord(Editor);
+  PushStatus(strLocatingTopic);
+  Found:=HelpFacility^.TopicSearch(S,FileID,Ctx);
+  PopStatus;
+  if Found then
+     Help(FileID,Ctx,false) else
+     HelpIndex(S);
+end;
+
+procedure HelpIndex(Keyword: string);
+begin
+  HelpCreateWindow;
+  with HelpWindow^ do
+  begin
+    PushStatus(strBuildingHelpIndex);
+    HelpWindow^.ShowIndex;
+    if Keyword<>'' then
+       HelpWindow^.HelpView^.Lookup(Keyword);
+    PopStatus;
+    if GetState(sfVisible)=false then Show;
+    MakeFirst;
+  end;
+  Message(Application,evCommand,cmUpdate,nil);
+end;
+
+procedure PushStatus(S: string);
+begin
+  if StatusLine=nil then Exit;
+  StatusStack[StatusStackPtr]:=PAdvancedStatusLine(StatusLine)^.GetStatusText;
+  SetStatus(S);
+  Inc(StatusStackPtr);
+end;
+
+procedure PopStatus;
+begin
+  if StatusLine=nil then Exit;
+  Dec(StatusStackPtr);
+  SetStatus(StatusStack[StatusStackPtr]);
+end;
+
+procedure SetStatus(S: string);
+begin
+  if StatusLine=nil then Exit;
+  PAdvancedStatusLine(StatusLine)^.SetStatusText(S);
+end;
+
+procedure ClearStatus;
+begin
+  PAdvancedStatusLine(StatusLine)^.ClearStatusText;
+end;
+
+
+END.
+{
+  $Log$
+  Revision 1.1  1998-12-22 14:27:54  peter
+    * moved
+
+  Revision 1.3  1998/12/22 10:39:42  peter
+    + options are now written/read
+    + find and replace routines
+
+}

ide/text/fpintf.pas

@@ -0,0 +1,71 @@
+{
+    $Id$
+    This file is part of the Free Pascal Integrated Development Environment
+    Copyright (c) 1998 by Berczi Gabor
+
+    Misc routines for the IDE
+
+    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.
+
+ **********************************************************************}
+unit FPIntf;
+interface
+
+{ Run }
+function  GetRunParameters: string;
+procedure SetRunParameters(const Params: string);
+
+{ Compile }
+procedure Compile(const FileName: string);
+
+implementation
+
+uses
+  Compiler,
+  FPCfgs;
+
+{****************************************************************************
+                                   Run
+****************************************************************************}
+
+var
+  RunParameters : string;
+
+function GetRunParameters: string;
+begin
+  GetRunParameters:=RunParameters;
+end;
+
+procedure SetRunParameters(const Params: string);
+begin
+  RunParameters:=Params;
+end;
+
+
+{****************************************************************************
+                                   Compile
+****************************************************************************}
+
+procedure Compile(const FileName: string);
+begin
+  WriteOptions('fp.cfg');
+{ call the compiler }
+  Compiler.Compile('[fp.cfg] '+FileName);
+end;
+
+end.
+{
+  $Log$
+  Revision 1.1  1998-12-22 14:27:54  peter
+    * moved
+
+  Revision 1.4  1998/12/22 10:39:43  peter
+    + options are now written/read
+    + find and replace routines
+
+}

ide/text/fpmcomp.inc

@@ -0,0 +1,117 @@
+{
+    $Id$
+    This file is part of the Free Pascal Integrated Development Environment
+    Copyright (c) 1998 by Berczi Gabor
+
+    Compiler menu entries
+
+    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.
+
+ **********************************************************************}
+
+procedure TIDEApp.Parameters;
+var R,R2: TRect;
+    D: PCenterDialog;
+    IL: PInputLine;
+begin
+  R.Assign(0,0,54,4);
+  New(D, Init(R, 'Program parameters'));
+  with D^ do
+  begin
+    GetExtent(R); R.Grow(-2,-1); Inc(R.A.Y); R.B.Y:=R.A.Y+1;
+    R2.Copy(R); R2.A.X:=14;
+    New(IL, Init(R2, 255));
+    IL^.Data^:=GetRunParameters;
+    Insert(IL);
+    R2.Copy(R); R2.B.X:=14;
+    Insert(New(PLabel, Init(R2, '~P~arameter', IL)));
+  end;
+  InsertButtons(D);
+  IL^.Select;
+  if Desktop^.ExecView(D)=cmOK then
+  begin
+    SetRunParameters(IL^.Data^);
+  end;
+  Dispose(D, Done);
+end;
+
+procedure TIDEApp.Target;
+var R,R2: TRect;
+    D: PCenterDialog;
+    RB: PRadioButtons;
+    TargetCount,I: integer;
+    LastItem: PSItem;
+    L: longint;
+begin
+  TargetCount:=TargetOptions^.ItemCount;
+  R.Assign(0,0,36,4+TargetCount);
+  New(D, Init(R, 'Target'));
+  with D^ do
+  begin
+    GetExtent(R); R.Grow(-3,-1); Inc(R.A.Y);
+    R2.Copy(R); Inc(R2.A.Y); R2.B.Y:=R2.A.Y+TargetCount;
+    LastItem:=nil;
+    for I:=TargetCount-1 downto 0 do
+      LastItem:=NewSItem(TargetOptions^.ItemName(I), LastItem);
+    New(RB, Init(R2, LastItem));
+    L:=ord(TargetOptions^.GetCurrSel);
+    RB^.SetData(L);
+    Insert(RB);
+    R2.Copy(R);
+    R2.B.Y:=R2.A.Y+1;
+    Insert(New(PLabel, Init(R2, 'Target platform', RB)));
+  end;
+  InsertButtons(D);
+  RB^.Select;
+  if Desktop^.ExecView(D)=cmOK then
+    TargetOptions^.SetCurrSel(RB^.Value);
+  Dispose(D, Done);
+end;
+
+procedure TIDEApp.PrimaryFile_;
+var
+  D : PFileDialog;
+  FileName : string;
+begin
+  New(D, Init('*.pas','Primary file','*.pas',fdOpenButton,0));
+  if Desktop^.ExecView(D)<>cmCancel then
+  begin
+    D^.GetFileName(FileName);
+    PrimaryFile:=FileName;
+    UpdatePrimaryFile;
+  end;
+end;
+
+
+procedure TIDEApp.ClearPrimary;
+begin
+  PrimaryFile:='';
+  UpdatePrimaryFile;
+end;
+
+
+procedure TIDEApp.Information;
+begin
+  with ProgramInfoWindow^ do
+   begin
+     if not GetState(sfVisible) then
+       Show;
+     MakeFirst;
+   end;
+end;
+
+{
+  $Log$
+  Revision 1.1  1998-12-22 14:27:54  peter
+    * moved
+
+  Revision 1.3  1998/12/22 10:39:44  peter
+    + options are now written/read
+    + find and replace routines
+
+}

ide/text/fpmedit.inc

@@ -0,0 +1,32 @@
+{
+    $Id$
+    This file is part of the Free Pascal Integrated Development Environment
+    Copyright (c) 1998 by Berczi Gabor
+
+    Edit menu entries
+
+    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.
+
+ **********************************************************************}
+
+procedure TIDEApp.ShowClipboard;
+begin
+  ClipboardWindow^.Show;
+  ClipboardWindow^.Focus;
+end;
+
+{
+  $Log$
+  Revision 1.1  1998-12-22 14:27:54  peter
+    * moved
+
+  Revision 1.2  1998/12/22 10:39:45  peter
+    + options are now written/read
+    + find and replace routines
+
+}

ide/text/fpmfile.inc

@@ -0,0 +1,151 @@
+{
+    $Id$
+    This file is part of the Free Pascal Integrated Development Environment
+    Copyright (c) 1998 by Berczi Gabor
+
+    File menu entries
+
+    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.
+
+ **********************************************************************}
+
+function TIDEApp.OpenEditorWindow(FileName: string; CurX,CurY: integer): PSourceWindow;
+var P: PView;
+    R: TRect;
+    W: PSourceWindow;
+begin
+  P:=Message(Desktop,evBroadcast,cmSearchWindow,nil);
+  if P=nil then Desktop^.GetExtent(R) else
+     begin
+       P^.GetBounds(R);
+       Inc(R.A.X); Inc(R.A.Y);
+     end;
+  New(W, Init(R, FileName));
+  if W<>nil then
+  begin
+    if (CurX<>0) or (CurY<>0) then
+       with W^.Editor^ do
+       begin
+         SetCurPtr(CurX,CurY);
+         TrackCursor(true);
+       end;
+    W^.HelpCtx:=hcSourceWindow;
+    Desktop^.Insert(W);
+    Message(Application,evBroadcast,cmUpdate,nil);
+  end;
+  OpenEditorWindow:=W;
+end;
+
+procedure TIDEApp.NewEditor;
+begin
+  OpenEditorWindow('',0,0);
+end;
+
+procedure TIDEApp.NewFromTemplate;
+var D: PCenterDialog;
+    R,R2: TRect;
+    SB: PScrollBar;
+    LB: PAdvancedListBox;
+    I: integer;
+    C: PUnsortedStringCollection;
+    TE: PSourceWindow;
+begin
+  if GetTemplateCount=0 then
+     begin InformationBox('No templates available.',nil); Exit; end;
+  New(C, Init(10,10));
+  R.Assign(0,0,40,14);
+  New(D, Init(R, 'New from template'));
+  with D^ do
+  begin
+    GetExtent(R); R.Grow(-2,-2); Inc(R.A.Y); Dec(R.B.X,12);
+    R2.Copy(R); R2.Move(1,0); R2.A.X:=R2.B.X-1;
+    New(SB, Init(R2)); Insert(SB);
+
+    New(LB, Init(R,1,SB));
+    LB^.Default:=true;
+    for I:=0 to GetTemplateCount-1 do
+      C^.Insert(NewStr(GetTemplateName(I)));
+    LB^.NewList(C);
+    Insert(LB);
+    Dec(R.A.Y); R.B.Y:=R.A.Y+1;
+    Insert(New(PLabel, Init(R, 'Available ~t~emplates', LB)));
+
+    GetExtent(R2); R2.Grow(-2,-3); R2.A.X:=R.B.X+2; R2.B.Y:=R2.A.Y+2;
+    Insert(New(PButton, Init(R2, 'O~K~', cmOK, bfDefault)));
+    R2.Move(0,2);
+    Insert(New(PButton, Init(R2, 'Cancel', cmCancel, bfNormal)));
+  end;
+  LB^.Select;
+  if Desktop^.ExecView(D)=cmOK then
+  begin
+    Desktop^.Lock;
+    TE:=OpenEditorWindow('',0,0);
+    if TE<>nil then
+    begin
+      StartTemplate(LB^.Focused,TE^.Editor);
+      TE^.Editor^.Modified:=false; { if nothing changes, we don't need to save it }
+      TE^.Hide; { we need this trick to get the editor updated }
+      TE^.Show;
+    end;
+    Desktop^.UnLock;
+  end;
+  Dispose(D, Done);
+  Dispose(C, Done);
+end;
+
+procedure TIDEApp.Open(FileName: string);
+var D: PFileDialog;
+    OpenIt: boolean;
+begin
+  New(D, Init('*.pas','Open a file','*.pas',fdOpenButton,0));
+  OpenIt:=FileName<>'';
+  if not OpenIt then
+  begin
+     OpenIt:=Desktop^.ExecView(D)<>cmCancel;
+     if OpenIt then D^.GetFileName(FileName);
+  end;
+  if OpenIt then
+  begin
+    FileName := FExpand(FileName);
+    OpenEditorWindow(FileName,0,0);
+  end;
+  Dispose(D, Done);
+end;
+
+procedure TIDEApp.OpenRecentFile(RecentIndex: integer);
+begin
+  with RecentFiles[RecentIndex] do
+  if OpenEditorWindow(FileName,LastPos.X,LastPos.Y)<>nil then
+     RemoveRecentFile(RecentIndex);
+end;
+
+procedure TIDEApp.SaveAll;
+procedure SendSave(P: PView); {$ifndef FPC}far;{$endif}
+begin
+  Message(P,evCommand,cmSave,nil);
+end;
+begin
+  Desktop^.ForEach(@SendSave);
+end;
+
+procedure TIDEApp.ChangeDir;
+begin
+  ExecuteDialog(New(PChDirDialog, Init(cdNormal, hisChDirDialog)),nil);
+  CurDirChanged;
+end;
+
+{
+  $Log$
+  Revision 1.1  1998-12-22 14:27:54  peter
+    * moved
+
+  Revision 1.3  1998/12/22 10:39:46  peter
+    + options are now written/read
+    + find and replace routines
+
+}

ide/text/fpmhelp.inc

@@ -0,0 +1,80 @@
+{
+    $Id$
+    This file is part of the Free Pascal Integrated Development Environment
+    Copyright (c) 1998 by Berczi Gabor
+
+    Help menu entries
+
+    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.
+
+ **********************************************************************}
+
+procedure TIDEApp.HelpContents;
+begin
+  Help(0,hcContents,false);
+end;
+
+procedure TIDEApp.HelpHelpIndex;
+begin
+  HelpIndex('');
+end;
+
+procedure TIDEApp.HelpTopicSearch;
+begin
+end;
+
+procedure TIDEApp.HelpPrevTopic;
+begin
+  if HelpWindow=nil then HelpContents else
+  with HelpWindow^ do
+  if GetState(sfVisible) then Message(HelpWindow^.HelpView,evCommand,cmPrevTopic,nil)
+     else begin HelpWindow^.Show; HelpWindow^.MakeFirst; end;
+end;
+
+procedure TIDEApp.HelpUsingHelp;
+begin
+  Help(0,hcUsingHelp,false);
+end;
+
+procedure TIDEApp.HelpFiles;
+begin
+end;
+
+procedure TIDEApp.About;
+var R,R2: TRect;
+    D: PCenterDialog;
+begin
+  R.Assign(0,0,38,10);
+  New(D, Init(R, 'About'));
+  with D^ do
+  begin
+    GetExtent(R); R.Grow(-3,-2);
+    R2.Copy(R); R2.B.Y:=R2.A.Y+1;
+    Insert(New(PStaticText, Init(R2, ^C'FreePascal IDE / DOS')));
+    R2.Move(0,2);
+    Insert(New(PStaticText, Init(R2, ^C'Version '+VersionStr)));
+    R2.Move(0,2);
+    Insert(New(PStaticText, Init(R2, ^C'Copyright (C) 1998 by')));
+    R2.Move(0,2);
+    Insert(New(PStaticText, Init(R2, ^C'B‚rczi G bor')));
+  end;
+  InsertOK(D);
+  Desktop^.ExecView(D);
+  Dispose(D, Done);
+end;
+
+{
+  $Log$
+  Revision 1.1  1998-12-22 14:27:54  peter
+    * moved
+
+  Revision 1.2  1998/12/22 10:39:47  peter
+    + options are now written/read
+    + find and replace routines
+
+}

ide/text/fpmopts.inc

@@ -0,0 +1,444 @@
+{
+    $Id$
+    This file is part of the Free Pascal Integrated Development Environment
+    Copyright (c) 1998 by Berczi Gabor
+
+    Options menu entries
+
+    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.
+
+ **********************************************************************}
+
+procedure TIDEApp.Compiler;
+var R,R2,TabR,TabIR: TRect;
+    D: PCenterDialog;
+    CB1,CB2,CB3,CB4: PCheckBoxes;
+    RB1,RB2: PRadioButtons;
+    Items: PSItem;
+    IL: PInputLine;
+    Count : integer;
+    I,L: longint;
+    Tab: PTab;
+    Label11,Label21,Label22,Label23,Label24,Label31: PLabel;
+begin
+  R.Assign(0,0,72,18);
+  New(D, Init(R, 'Compiler Options'));
+  with D^ do
+  begin
+    GetExtent(R);
+    R.Grow(-2,-1);
+    Dec(R.B.Y,2);
+    TabR.Copy(R);
+    TabIR.Copy(R);
+    Inc(TabIR.A.Y,2);
+    TabIR.Grow(0,-1);
+
+    { --- Sheet 1 --- }
+    Count:=SyntaxOptions^.ItemCount;
+    R.Copy(TabIR);
+    R2.Copy(R);
+    R2.B.X:=R2.A.X+(R2.B.X-R2.A.X) div 2;
+    R2.B.Y:=R2.A.Y+Count;
+    Items:=nil;
+    for I:=Count-1 downto 0 do
+      Items:=NewSItem(SyntaxOptions^.ItemName(I), Items);
+    New(CB1, Init(R2, Items));
+    for I:=0 to Count-1 do
+      if SyntaxOptions^.ItemIsSet(I) then
+        CB1^.Press(I);
+    Dec(R2.A.Y);
+    R2.B.Y:=R2.A.Y+1;
+    New(Label11, Init(R2, 'Syntax options', CB1));
+
+    { --- Sheet 2 --- }
+    Count:=CodegenOptions^.ItemCount;
+    R2.Copy(TabIR);
+    R2.B.X:=R2.A.X+(R2.B.X-R2.A.X) div 2-2;
+    R2.B.Y:=R2.A.Y+Count;
+    Items:=nil;
+    for I:=Count-1 downto 0 do
+      Items:=NewSItem(CodegenOptions^.ItemName(I), Items);
+    New(CB3, Init(R2, Items));
+    for I:=0 to Count-1 do
+      if CodegenOptions^.ItemIsSet(I) then
+        CB3^.Press(I);
+    Dec(R2.A.Y);
+    R2.B.Y:=R2.A.Y+1;
+    New(Label21, Init(R2, 'Run-time checks', CB3));
+
+    Count:=OptimizationOptions^.ItemCount;
+    R2.Copy(TabIR);
+    R2.A.X:=R2.B.X-(R2.B.X-R2.A.X) div 2;
+    Dec(R2.B.X,4);
+    R2.B.Y:=R2.A.Y+Count;
+    Items:=nil;
+    for I:=Count-1 downto 0 do
+      Items:=NewSItem(OptimizationOptions^.ItemName(I), Items);
+    New(CB2, Init(R2, Items));
+    for I:=0 to Count-1 do
+      if OptimizationOptions^.ItemIsSet(I) then
+        CB2^.Press(I);
+    Dec(R2.A.Y);
+    R2.B.Y:=R2.A.Y+1;
+    New(Label22, Init(R2, 'Optimizations', CB2));
+
+    Count:=ProcessorOptions^.ItemCount;
+    R2.Copy(TabIR);
+    R2.B.X:=R2.A.X+(R2.B.X-R2.A.X) div 2-2;
+    Inc(R2.A.Y,1+CodegenOptions^.ItemCount);
+    R2.B.Y:=R2.A.Y+Count;
+    Items:=nil;
+    for I:=Count-1 downto 0 do
+      Items:=NewSItem(ProcessorOptions^.ItemName(I), Items);
+    New(RB1, Init(R2, Items));
+    L:=ProcessorOptions^.GetCurrSel;
+    RB1^.SetData(L);
+    Dec(R2.A.Y);
+    R2.B.Y:=R2.A.Y+1;
+    New(Label23, Init(R2, 'Target processor', RB1));
+
+    Count:=AsmReaderOptions^.ItemCount;
+    R2.Copy(TabIR);
+    R2.A.X:=R2.B.X-(R2.B.X-R2.A.X) div 2;
+    Dec(R2.B.X,4);
+    Inc(R2.A.Y, 1+OptimizationOptions^.ItemCount+1+ProcessorOptions^.ItemCount);
+    R2.B.Y:=R2.A.Y+Count;
+    Items:=nil;
+    for I:=Count-1 downto 0 do
+      Items:=NewSItem(AsmReaderOptions^.ItemName(I), Items);
+    New(RB2, Init(R2, Items));
+    L:=AsmReaderOptions^.GetCurrSel;
+    RB2^.SetData(L);
+    Dec(R2.A.Y);
+    R2.B.Y:=R2.A.Y+1;
+    New(Label24, Init(R2, 'Assembler format', RB2));
+
+    { --- Sheet 3 --- }
+    Count:=VerboseOptions^.ItemCount;
+    R.Copy(TabIR);
+    R2.Copy(R);
+    R2.B.X:=R2.A.X+(R2.B.X-R2.A.X) div 2;
+    R2.B.Y:=R2.A.Y+Count;
+    Items:=nil;
+    for I:=Count-1 downto 0 do
+      Items:=NewSItem(VerboseOptions^.ItemName(I), Items);
+    New(CB4, Init(R2, Items));
+    for I:=0 to Count-1 do
+      if VerboseOptions^.ItemIsSet(I) then
+        CB4^.Press(I);
+    Dec(R2.A.Y);
+    R2.B.Y:=R2.A.Y+1;
+    New(Label31, Init(R2, 'Verbose options', CB4));
+
+    { create tabs }
+    New(Tab, Init(TabR,
+      NewTabDef('S~y~ntax',CB1,
+        NewTabItem(Label11,
+        NewTabItem(CB1,
+        nil)),
+      NewTabDef('Code ~g~eneration',CB3,
+        NewTabItem(Label21,
+        NewTabItem(CB3,
+        NewTabItem(Label22,
+        NewTabItem(CB2,
+        NewTabItem(Label23,
+        NewTabItem(RB1,
+        NewTabItem(Label24,
+        NewTabItem(RB2,
+        nil)))))))),
+      NewTabDef('~V~erbose',CB4,
+        NewTabItem(Label31,
+        NewTabItem(CB4,
+        nil)),
+      nil)))));
+    Tab^.GrowMode:=0;
+    Insert(Tab);
+
+    R2.Copy(TabR); R2.A.Y:=R2.B.Y+1; R2.B.Y:=R2.A.Y+1;
+    New(IL, Init(R2, 128));
+    IL^.Data^:=GetConditionalDefines;
+    Insert(IL);
+    R2.Move(0,-1);
+    Insert(New(PLabel, Init(R2, 'Conditio~n~al defines', IL)));
+  end;
+  InsertButtons(D);
+  if Desktop^.ExecView(D)=cmOK then
+  begin
+    for I:=0 to SyntaxOptions^.ItemCount-1 do
+      SyntaxOptions^.ItemSet(I,CB1^.Mark(I));
+    for I:=0 to CodeGenOptions^.ItemCount-1 do
+      CodegenOptions^.ItemSet(I,CB3^.Mark(I));
+    for I:=0 to OptimizationOptions^.ItemCount-1 do
+      OptimizationOptions^.ItemSet(I,CB2^.Mark(I));
+    for I:=0 to VerboseOptions^.ItemCount-1 do
+      VerboseOptions^.ItemSet(I,CB4^.Mark(I));
+    ProcessorOptions^.SetCurrSel(RB1^.Value);
+    AsmReaderOptions^.SetCurrSel(RB2^.Value);
+    SetConditionalDefines(IL^.Data^);
+  end;
+  Dispose(D, Done);
+end;
+
+procedure TIDEApp.MemorySizes;
+var R,R2,R3: TRect;
+    D: PCenterDialog;
+    IL1,IL2: PIntegerLine;
+begin
+{$ifdef NOTYET}
+  R.Assign(0,0,40,7);
+  New(D, Init(R, 'Memory sizes'));
+  with D^ do
+  begin
+    GetExtent(R); R.Grow(-3,-1);
+    R2.Copy(R); Inc(R2.A.Y); R2.B.Y:=R2.A.Y+1;
+    R3.Copy(R2); R3.A.X:=21; R3.B.X:=R3.A.X+10;
+    New(IL1, Init(R3, MinStackSize, MaxStackSize));
+    IL1^.Data^:=IntToStr(GetStackSize);
+    Insert(IL1);
+    R3.Copy(R2); R3.B.X:=21;
+    Insert(New(PLabel, Init(R3, '~S~tack size', IL1)));
+
+    R2.Move(0,2);
+    R3.Copy(R2); R3.A.X:=21; R3.B.X:=R3.A.X+10;
+    New(IL2, Init(R3, MinHeapSize, MaxHeapSize));
+    IL2^.Data^:=IntToStr(GetHeapSize);
+    Insert(IL2);
+    R3.Copy(R2); R3.B.X:=21;
+    Insert(New(PLabel, Init(R3, 'Local ~h~eap size', IL2)));
+  end;
+  InsertButtons(D);
+  IL1^.Select;
+  if Desktop^.ExecView(D)=cmOK then
+  begin
+    SetStackSize(StrToInt(IL1^.Data^));
+    SetHeapSize(StrToInt(IL2^.Data^));
+  end;
+  Dispose(D, Done);
+{$endif}
+end;
+
+procedure TIDEApp.Linker;
+var R,R2: TRect;
+    D: PCenterDialog;
+    RB1,RB2: PRadioButtons;
+    Mask,V,I: longint;
+    Items: PSItem;
+    L: longint;
+begin
+{$ifdef NOTYET}
+  R.Assign(0,0,56,8);
+  New(D, Init(R, 'Linker'));
+  with D^ do
+  begin
+    GetExtent(R); R.Grow(-3,-1);
+    R2.Copy(R); Inc(R2.A.Y); R2.B.Y:=R2.A.Y+GetEXEFormatCount; R2.B.X:=R2.A.X+(R2.B.X-R2.A.X) div 2;
+    Items:=nil;
+    for I:=GetEXEFormatCount downto 1 do
+      Items:=NewSItem(GetEXEFormatName(TEXEFormat(I)),Items);
+    New(RB1, Init(R2, Items));
+    Mask:=0; V:=1;
+    for I:=1 to GetEXEFormatCount do
+     begin
+       if IsEXEFormatAvailable(TEXEFormat(I)) then
+          Mask:=Mask or V;
+       V:=V shl 1;
+     end;
+    RB1^.SetButtonState($ffff,false);
+    RB1^.SetButtonState(Mask,true);
+    L:=ord(GetEXEFormat)-1;
+    RB1^.SetData(L);
+    Insert(RB1);
+    R2.Copy(R); R2.B.Y:=R2.A.Y+1;
+    Insert(New(PLabel, Init(R2, 'Output format', RB1)));
+
+    R2.Copy(R); Inc(R2.A.Y); R2.B.Y:=R2.A.Y+2; R2.A.X:=R2.B.X-(R2.B.X-R2.A.X) div 2+1;
+    New(RB2, Init(R2,
+      NewSItem('D~y~namic libraries',
+      NewSItem('S~t~atic libraries',
+      nil))));
+    L:=ord(GetLinkLibraryType)-1;
+    RB2^.SetData(L);
+    Insert(RB2);
+    R2.Copy(R); R2.B.Y:=R2.A.Y+1; R2.A.X:=R2.B.X-(R2.B.X-R2.A.X) div 2+1;
+    Insert(New(PLabel, Init(R2, 'Preferred library type', RB2)));
+  end;
+  InsertButtons(D);
+  if Desktop^.ExecView(D)=cmOK then
+  begin
+    SetEXEFormat(TEXEFormat(RB1^.Value+1));
+    SetLinkLibraryType(TLibraryType(RB2^.Value+1));
+  end;
+  Dispose(D, Done);
+{$endif}
+end;
+
+procedure TIDEApp.Debugger;
+var R,R2: TRect;
+    D: PCenterDialog;
+    RB1,RB2: PRadioButtons;
+    L: longint;
+begin
+{$ifdef NOTYET}
+  R.Assign(0,0,46,11);
+  New(D, Init(R, 'Debugging/Profiling'));
+  with D^ do
+  begin
+    GetExtent(R); R.Grow(-3,-1);
+    R2.Copy(R); Inc(R2.A.Y,2); R2.B.Y:=R2.A.Y+3;
+    New(RB1, Init(R2,
+      NewSItem('~S~trip all symbols from executable',
+      NewSItem('Generate g~s~ym symbol information',
+      NewSItem('Generate ~d~bx symbol information',
+      nil)))));
+    L:=ord(GetSymbolFormat);
+    RB1^.SetData(L);
+    Insert(RB1);
+    R2.Copy(R); Inc(R2.A.Y); R2.B.Y:=R2.A.Y+1;
+    Insert(New(PLabel, Init(R2, 'Symbol information', RB1)));
+
+    R2.Copy(R); Inc(R2.A.Y,7); R2.B.Y:=R2.A.Y+2;
+    New(RB2, Init(R2,
+      NewSItem('N~o~ profile information',
+      NewSItem('Generate ~p~rofile code for gprof',
+      nil))));
+    L:=ord(GetProfileFormat);
+    RB2^.SetData(L);
+    Insert(RB2);
+    R2.Copy(R); Inc(R2.A.Y,6); R2.B.Y:=R2.A.Y+1;
+    Insert(New(PLabel, Init(R2, 'Profiling options', RB2)));
+  end;
+  InsertButtons(D);
+  RB1^.Select;
+  if Desktop^.ExecView(D)=cmOK then
+  begin
+    SetSymbolFormat(TSymbolFormat(RB1^.Value));
+    SetProfileFormat(TProfileFormat(RB2^.Value));
+  end;
+  Dispose(D, Done);
+{$endif}
+end;
+
+procedure TIDEApp.Directories;
+var R,R2: TRect;
+    D: PCenterDialog;
+    IL1,IL2,IL3,IL4: PInputLine;
+{    Dirs: TDirectoryCfg; }
+const LW = 25;
+begin
+{$ifdef NOTYET}
+  GetDirectoryCfg(Dirs);
+  R.Assign(0,0,64,10);
+  New(D, Init(R, 'Directories'));
+  with D^ do
+  begin
+    GetExtent(R); R.Grow(-2,-2); Dec(R.B.X); R.B.Y:=R.A.Y+1;
+    R2.Copy(R); R2.A.X:=LW;
+    New(IL1, Init(R2, 128));
+    IL1^.Data^:=Dirs.EXETPUDir;
+    Insert(IL1);
+    R2.Copy(R); R2.B.X:=LW;
+    Insert(New(PLabel, Init(R2, '~E~XE & unit directory', IL1)));
+
+    R.Move(0,2);
+    R2.Copy(R); R2.A.X:=LW;
+    New(IL2, Init(R2, 128));
+    IL2^.Data^:=Dirs.IncludeDirs;
+    Insert(IL2);
+    R2.Copy(R); R2.B.X:=LW;
+    Insert(New(PLabel, Init(R2, '~I~nclude directories', IL2)));
+
+    R.Move(0,2);
+    R2.Copy(R); R2.A.X:=LW;
+    New(IL3, Init(R2, 128));
+    IL3^.Data^:=Dirs.UnitDirs;
+    Insert(IL3);
+    R2.Copy(R); R2.B.X:=LW;
+    Insert(New(PLabel, Init(R2, '~U~nit directories', IL3)));
+
+    R.Move(0,2);
+    R2.Copy(R); R2.A.X:=LW;
+    New(IL4, Init(R2, 128));
+    IL4^.Data^:=Dirs.ObjectDirs;
+    Insert(IL4);
+    R2.Copy(R); R2.B.X:=LW;
+    Insert(New(PLabel, Init(R2, '~O~bject directories', IL4)));
+  end;
+  InsertButtons(D);
+  IL1^.Select;
+  if Desktop^.ExecView(D)=cmOK then
+  begin
+    Dirs.EXETPUDir:=IL1^.Data^;
+    Dirs.IncludeDirs:=IL2^.Data^;
+    Dirs.UnitDirs:=IL3^.Data^;
+    Dirs.ObjectDirs:=IL4^.Data^;
+    SetDirectoryCfg(Dirs);
+  end;
+  Dispose(D, Done);
+{$endif NOTYET}
+end;
+
+procedure TIDEApp.Colors;
+var D: PColorDialog;
+begin
+  New(D, Init(GetPalette^,
+    ColorGroup('Desktop', DesktopColorItems(nil),
+    ColorGroup('Dialogs', DialogColorItems(dpGrayDialog,nil),
+    ColorGroup('Editor',
+      ColorItem('Frame passive'   , 167,
+      ColorItem('Frame active'    , 168,
+      ColorItem('Frame icon'      , 169,
+      ColorItem('Scroll bar page' , 170,
+      ColorItem('Scroll bar icons', 171,
+      ColorItem('Normal text'     , 199,
+      ColorItem('Selected text'   , 208,
+      ColorItem('Highlight column', 209,
+      ColorItem('Highlight row'   , 210,
+      ColorItem('Error messages'  , 214,
+      nil)))))))))),
+    ColorGroup('Help',
+      ColorItem('Frame passive'   , 128,
+      ColorItem('Frame active'    , 129,
+      ColorItem('Frame icon'      , 130,
+      ColorItem('Scroll bar page' , 131,
+      ColorItem('Scroll bar icons', 132,
+      ColorItem('Help text'       , 160,
+      ColorItem('Help links'      , 161,
+      ColorItem('Selected link'   , 162,
+      ColorItem('Selected text'   , 163,
+      nil))))))))),
+    ColorGroup('Menus',   MenuColorItems(nil),
+    ColorGroup('Syntax',
+      ColorItem('Whitespace'      , 200,
+      ColorItem('Comments'        , 201,
+      ColorItem('Reserved words'  , 202,
+      ColorItem('Identifiers'     , 203,
+      ColorItem('Strings'         , 204,
+      ColorItem('Numbers'         , 205,
+      ColorItem('Assembler'       , 206,
+      ColorItem('Symbols'         , 207,
+      ColorItem('Directives'      , 211,
+      nil))))))))),
+    nil))))))));
+  if ExecuteDialog(D, GetPalette)=cmOK then
+    begin
+      DoneMemory;
+      Message(Application,evBroadcast,cmUpdate,nil);
+      ReDraw;
+    end;
+end;
+
+{
+  $Log$
+  Revision 1.1  1998-12-22 14:27:54  peter
+    * moved
+
+  Revision 1.3  1998/12/22 10:39:48  peter
+    + options are now written/read
+    + find and replace routines
+
+}

ide/text/fpmtools.inc

@@ -0,0 +1,35 @@
+{
+    $Id$
+    This file is part of the Free Pascal Integrated Development Environment
+    Copyright (c) 1998 by Berczi Gabor
+
+    Tools menu entries
+
+    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.
+
+ **********************************************************************}
+
+procedure TIDEApp.Calculator;
+begin
+  with CalcWindow^ do
+  begin
+    if GetState(sfVisible)=false then Show;
+    MakeFirst;
+  end;
+end;
+
+{
+  $Log$
+  Revision 1.1  1998-12-22 14:27:54  peter
+    * moved
+
+  Revision 1.2  1998/12/22 10:39:49  peter
+    + options are now written/read
+    + find and replace routines
+
+}

ide/text/fpmwnd.inc

@@ -0,0 +1,160 @@
+{
+    $Id$
+    This file is part of the Free Pascal Integrated Development Environment
+    Copyright (c) 1998 by Berczi Gabor
+
+    Window menu entries
+
+    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.
+
+ **********************************************************************}
+
+procedure TIDEApp.CloseAll;
+
+  procedure SendClose(P: PView); {$ifndef FPC}far;{$endif}
+  begin
+    Message(P,evCommand,cmClose,nil);
+  end;
+
+begin
+  Desktop^.ForEach(@SendClose);
+end;
+
+
+type
+    PWindowListBox = ^TWindowListBox;
+    TWindowListBox = object(TAdvancedListBox)
+      constructor Init(var Bounds: TRect; AScrollBar: PScrollBar);
+      function    GetText(Item: Integer; MaxLen: Integer): String; virtual;
+    end;
+
+    PWindowListDialog = ^TWindowListDialog;
+    TWindowListDialog = object(TCenterDialog)
+      constructor Init;
+      procedure   HandleEvent(var Event: TEvent); virtual;
+      destructor  Done; virtual;
+    private
+      LB: PWindowListBox;
+      C : PCollection;
+      procedure  UpdateList;
+    end;
+
+constructor TWindowListBox.Init(var Bounds: TRect; AScrollBar: PScrollBar);
+begin
+  inherited Init(Bounds,1,AScrollBar);
+end;
+
+function TWindowListBox.GetText(Item: Integer; MaxLen: Integer): String;
+var P: PView;
+    S: string;
+begin
+  P:=List^.At(Item);
+  case P^.HelpCtx of
+    hcSourceWindow : S:=PSourceWindow(P)^.GetTitle(MaxLen);
+    hcHelpWindow   : S:=PHelpWindow(P)^.GetTitle(MaxLen);
+    hcCalcWindow   : S:=PCalculator(P)^.GetTitle(MaxLen);
+  else S:='???? - '+PWindow(P)^.GetTitle(MaxLen);
+  end;
+  GetText:=copy(S,1,MaxLen);
+end;
+
+constructor TWindowListDialog.Init;
+var R,R2: TRect;
+    SB: PScrollBar;
+begin
+  R.Assign(0,0,50,15);
+  inherited Init(R, 'Window List');
+
+  New(C, Init(20,10));
+
+  GetExtent(R); R.Grow(-2,-2); Inc(R.A.Y); R.B.X:=37;
+  R2.Copy(R); R2.Move(1,0); R2.A.X:=R2.B.X-1;
+  New(SB, Init(R2)); Insert(SB);
+  New(LB, Init(R, SB));
+  LB^.Default:=true;
+  LB^.NewList(C);
+  UpdateList;
+  if C^.Count>=2 then LB^.FocusItem(1); { focus the 2nd one }
+  Insert(LB);
+  R2.Copy(R); Dec(R2.A.Y); R2.B.Y:=R2.A.Y+1;
+  Insert(New(PLabel, Init(R2, '~W~indows', LB)));
+
+  GetExtent(R); R.Grow(-2,-2); Inc(R.A.Y); R.A.X:=38; R.B.Y:=R.A.Y+2;
+  Insert(New(PButton, Init(R, 'O~K~', cmOK, bfDefault)));
+  R.Move(0,3);
+  Insert(New(PButton, Init(R, '~D~elete', cmDeleteWnd, bfNormal)));
+  R.Move(0,3);
+  Insert(New(PButton, Init(R, 'Cancel', cmCancel, bfNormal)));
+
+  LB^.Select;
+end;
+
+procedure TWindowListDialog.UpdateList;
+procedure AddIt(P: PView); {$ifndef FPC}far;{$endif}
+begin
+  if (P<>pointer(Desktop^.Background)) and (P^.GetState(sfVisible)) then
+     C^.Insert(P);
+end;
+begin
+  C^.DeleteAll;
+  Desktop^.ForEach(@AddIt);
+  LB^.SetRange(C^.Count);
+  ReDraw;
+end;
+
+procedure TWindowListDialog.HandleEvent(var Event: TEvent);
+begin
+  case Event.What of
+    evKeyDown :
+      case Event.KeyCode of
+        kbDel :
+          begin
+            Message(@Self,evCommand,cmDeleteWnd,nil);
+            ClearEvent(Event);
+          end;
+      end;
+    evCommand :
+      case Event.Command of
+        cmDeleteWnd :
+          if C^.Count>0 then
+          begin
+            Message(C^.At(LB^.Focused),evCommand,cmClose,nil);
+            UpdateList;
+            ClearEvent(Event);
+          end;
+        cmOK :
+          PView(C^.At(LB^.Focused))^.MakeFirst;
+      end;
+  end;
+  inherited HandleEvent(Event);
+end;
+
+destructor TWindowListDialog.Done;
+begin
+  if C<>nil then begin C^.DeleteAll; Dispose(C, Done); end;
+  inherited Done;
+end;
+
+procedure TIDEApp.WindowList;
+var W: PWindowListDialog;
+begin
+  New(W,Init);
+  ExecView(W);
+  Dispose(W,Done);
+end;
+
+{
+  $Log$
+  Revision 1.1  1998-12-22 14:27:54  peter
+    * moved
+
+  Revision 1.3  1998/12/22 10:39:50  peter
+    + options are now written/read
+    + find and replace routines
+
+}

ide/text/fptemplt.pas

@@ -0,0 +1,167 @@
+{
+    $Id$
+    This file is part of the Free Pascal Integrated Development Environment
+    Copyright (c) 1998 by Berczi Gabor
+
+    Template support routines for the IDE
+
+    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.
+
+ **********************************************************************}
+unit FPTemplt;
+
+interface
+
+uses FPViews;
+
+procedure InitTemplates;
+function  GetTemplateCount: integer;
+function  GetTemplateName(Index: integer): string;
+function  StartTemplate(Index: integer; Editor: PSourceEditor): boolean;
+procedure DoneTemplates;
+
+implementation
+
+uses
+  Dos,Objects,
+{$ifdef EDITORS}
+  Editors,
+{$else}
+  WEditor,
+{$endif}
+  FPUtils;
+
+type
+    PTemplate = ^TTemplate;
+    TTemplate = record
+      Name : PString;
+      Path : PString;
+    end;
+
+    PTemplateCollection = ^TTemplateCollection;
+    TTemplateCollection = object(TSortedCollection)
+      function  At(Index: Integer): PTemplate;
+      procedure FreeItem(Item: Pointer); virtual;
+      function  Compare(Key1, Key2: Pointer): Sw_Integer; virtual;
+    end;
+
+const Templates : PTemplateCollection = nil;
+
+function NewTemplate(Name, Path: string): PTemplate;
+var P: PTemplate;
+begin
+  New(P); FillChar(P^,SizeOf(P^),0);
+  P^.Name:=NewStr(Name); P^.Path:=NewStr(Path);
+  NewTemplate:=P;
+end;
+
+procedure DisposeTemplate(P: PTemplate);
+begin
+  if P<>nil then
+  begin
+    if P^.Name<>nil then DisposeStr(P^.Name);
+    if P^.Path<>nil then DisposeStr(P^.Path);
+    Dispose(P);
+  end;
+end;
+
+function TTemplateCollection.At(Index: Integer): PTemplate;
+begin
+  At:=inherited At(Index);
+end;
+
+procedure TTemplateCollection.FreeItem(Item: Pointer);
+begin
+  if Item<>nil then DisposeTemplate(Item);
+end;
+
+function TTemplateCollection.Compare(Key1, Key2: Pointer): Sw_Integer;
+var R: Sw_integer;
+    K1: PTemplate absolute Key1;
+    K2: PTemplate absolute Key2;
+begin
+  if K1^.Name^<K2^.Name^ then R:=-1 else
+  if K1^.Name^>K2^.Name^ then R:= 1 else
+  R:=0;
+  Compare:=R;
+end;
+
+procedure InitTemplates;
+procedure ScanDir(Dir: PathStr);
+var SR: SearchRec;
+    S: string;
+begin
+  if copy(Dir,length(Dir),1)<>'\' then Dir:=Dir+'\';
+  FindFirst(Dir+'*.pt',AnyFile,SR);
+  while (DosError=0) do
+  begin
+    S:=NameOf(SR.Name);
+    S:=LowerCaseStr(S);
+    S[1]:=Upcase(S[1]);
+    Templates^.Insert(NewTemplate(S,FExpand(Dir+SR.Name)));
+    FindNext(SR);
+  end;
+end;
+begin
+  New(Templates, Init(10,10));
+  ScanDir('.');
+  ScanDir(DirOf(ParamStr(0)));
+end;
+
+function GetTemplateCount: integer;
+var Count: integer;
+begin
+  if Templates=nil then Count:=0 else Count:=Templates^.Count;
+  GetTemplateCount:=Count;
+end;
+
+function GetTemplateName(Index: integer): string;
+begin
+  GetTemplateName:=Templates^.At(Index)^.Name^;
+end;
+
+function StartTemplate(Index: integer; Editor: PSourceEditor): boolean;
+var
+    T: PTemplate;
+    OK: boolean;
+    E: PFileEditor;
+    R: TRect;
+begin
+  T:=Templates^.At(Index);
+  R.Assign(0,0,0,0);
+  New(E, Init(R,nil,nil,nil,T^.Path^));
+  OK:=E<>nil;
+  if OK then OK:=E^.LoadFile;
+  if OK then
+    begin
+      E^.SelectAll(true);
+      Editor^.InsertFrom(E);
+      Editor^.SetCurPtr(0,0);
+      Editor^.SelectAll(false);
+      Dispose(E, Done);
+    end;
+  StartTemplate:=OK;
+end;
+
+procedure DoneTemplates;
+begin
+  if Templates<>nil then
+    Dispose(Templates, Done);
+end;
+
+END.
+{
+  $Log$
+  Revision 1.1  1998-12-22 14:27:54  peter
+    * moved
+
+  Revision 1.2  1998/12/22 10:39:51  peter
+    + options are now written/read
+    + find and replace routines
+
+}

ide/text/fputils.pas

@@ -0,0 +1,186 @@
+{
+    $Id$
+    This file is part of the Free Pascal Integrated Development Environment
+    Copyright (c) 1998 by Berczi Gabor
+
+    Utilility routines used by the IDE
+
+    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.
+
+ **********************************************************************}
+unit FPUtils;
+
+interface
+
+const
+{$ifdef linux}
+  dirsep = '/';
+{$else}
+  dirsep = '\';
+{$endif}
+
+function IntToStr(L: longint): string;
+function IntToStrZ(L: longint; MinLen: byte): string;
+function IntToStrL(L: longint; MinLen: byte): string;
+function StrToInt(S: string): longint;
+function CharStr(C: char; Count: byte): string;
+function SmartPath(Path: string): string;
+function LExpand(S: string; MinLen: byte): string;
+function RExpand(S: string; MinLen: byte): string;
+function KillTilde(S: string): string;
+function UpcaseStr(S: string): string;
+function LowerCaseStr(S: string): string;
+function Max(A,B: longint): longint;
+function Min(A,B: longint): longint;
+function DirOf(S: string): string;
+function NameOf(S: string): string;
+function StrToExtended(S: string): Extended;
+function Power(const A,B: double): double;
+
+implementation
+
+uses Dos;
+
+function IntToStr(L: longint): string;
+var S: string;
+begin
+  Str(L,S);
+  IntToStr:=S;
+end;
+
+function StrToInt(S: string): longint;
+var L: longint;
+    C: integer;
+begin
+  Val(S,L,C);
+  if C<>0 then L:=-1;
+  StrToInt:=L;
+end;
+
+function CharStr(C: char; Count: byte): string;
+var S: string;
+begin
+  S[0]:=chr(Count);
+  FillChar(S[1],Count,C);
+  CharStr:=S;
+end;
+
+function IntToStrZ(L: longint; MinLen: byte): string;
+var S: string;
+begin
+  S:=IntToStr(L);
+  if length(S)<MinLen then S:=CharStr('0',MinLen-length(S))+S;
+  IntToStrZ:=S;
+end;
+
+function IntToStrL(L: longint; MinLen: byte): string;
+var S: string;
+begin
+  S:=IntToStr(L);
+  if length(S)<MinLen then S:=CharStr(' ',MinLen-length(S))+S;
+  IntToStrL:=S;
+end;
+
+function SmartPath(Path: string): string;
+var S: string;
+begin
+  GetDir(0,S); if copy(S,length(S),1)<>DirSep then S:=S+DirSep;
+  if (copy(Path,1,length(S))=S) {and (Pos('\',copy(Path,length(S)+1,255))=0)} then
+     system.Delete(Path,1,length(S));
+  SmartPath:=Path;
+end;
+
+function LExpand(S: string; MinLen: byte): string;
+begin
+  if length(S)<MinLen then S:=CharStr(' ',MinLen-length(S))+S;
+  LExpand:=S;
+end;
+
+function RExpand(S: string; MinLen: byte): string;
+begin
+  if length(S)<MinLen then S:=S+CharStr(' ',MinLen-length(S));
+  RExpand:=S;
+end;
+
+function KillTilde(S: string): string;
+var P: byte;
+begin
+  repeat
+    P:=Pos('~',S);
+    if P>0 then Delete(S,P,1);
+  until P=0;
+  KillTilde:=S;
+end;
+
+function UpcaseStr(S: string): string;
+var I: integer;
+begin
+  for I:=1 to length(S) do
+      S[I]:=Upcase(S[I]);
+  UpcaseStr:=S;
+end;
+
+function LowerCaseStr(S: string): string;
+var I: byte;
+begin
+  for I:=1 to length(S) do
+    if S[I] in ['A'..'Z'] then S[I]:=chr(ord(S[I])+32);
+  LowerCaseStr:=S;
+end;
+
+function Max(A,B: longint): longint;
+begin
+  if A>B then Max:=A else Max:=B;
+end;
+
+function Min(A,B: longint): longint;
+begin
+  if A<B then Min:=A else Min:=B;
+end;
+
+function DirOf(S: string): string;
+var D: DirStr; E: ExtStr; N: NameStr;
+begin
+  FSplit(S,D,N,E);
+  if copy(D,1,length(D))<>DirSep then D:=D+DirSep;
+  DirOf:=D;
+end;
+
+function NameOf(S: string): string;
+var D: DirStr; E: ExtStr; N: NameStr;
+begin
+  FSplit(S,D,N,E);
+  NameOf:=N;
+end;
+
+function StrToExtended(S: string): Extended;
+var R : Extended;
+    C : integer;
+begin
+  Val(S,R,C);
+  StrToExtended:=R;
+end;
+
+function Power(const A,B: double): double;
+begin
+  if A=0 then Power:=0
+         else Power:=exp(B*ln(A));
+end;
+
+
+END.
+{
+  $Log$
+  Revision 1.1  1998-12-22 14:27:54  peter
+    * moved
+
+  Revision 1.3  1998/12/22 10:39:52  peter
+    + options are now written/read
+    + find and replace routines
+
+}

ide/text/fpviews.pas

@@ -0,0 +1,2499 @@
+{
+    $Id$
+    This file is part of the Free Pascal Integrated Development Environment
+    Copyright (c) 1998 by Berczi Gabor
+
+    Views and view-related functions for the IDE
+
+    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.
+
+ **********************************************************************}
+unit FPViews;
+
+interface
+
+uses
+  Dos,Objects,Drivers,Commands,HelpCtx,Views,Menus,Dialogs,App,
+{$ifdef EDITORS}
+  Editors,
+{$else}
+  WEditor,
+{$endif}
+  WHlpView,
+  Comphook,
+  FPConst;
+
+type
+{$IFNDEF EDITORS}
+    TEditor = TCodeEditor; PEditor = PCodeEditor;
+{$ENDIF}
+
+    PCenterDialog = ^TCenterDialog;
+    TCenterDialog = object(TDialog)
+      constructor Init(var Bounds: TRect; ATitle: TTitleStr);
+    end;
+
+    PIntegerLine = ^TIntegerLine;
+    TIntegerLine = object(TInputLine)
+      constructor Init(var Bounds: TRect; AMin, AMax: longint);
+    end;
+
+    PIDEHelpWindow = ^TIDEHelpWindow;
+    TIDEHelpWindow = object(THelpWindow)
+      procedure HandleEvent(var Event: TEvent); virtual;
+      function  GetPalette: PPalette; virtual;
+    end;
+
+    PSourceEditor = ^TSourceEditor;
+    TSourceEditor = object(TFileEditor)
+{$ifndef EDITORS}
+      function  IsReservedWord(S: string): boolean; virtual;
+      function  GetSpecSymbolCount(SpecClass: TSpecSymbolClass): integer; virtual;
+      function  GetSpecSymbol(SpecClass: TSpecSymbolClass; Index: integer): string; virtual;
+{$endif}
+      procedure   HandleEvent(var Event: TEvent); virtual;
+      procedure   LocalMenu(P: TPoint); virtual;
+      function    GetLocalMenu: PMenu; virtual;
+      function    GetCommandTarget: PView; virtual;
+    private
+      LastLocalCmd : word;
+    end;
+
+    PSourceWindow = ^TSourceWindow;
+    TSourceWindow = object(TWindow)
+      Editor    : PSourceEditor;
+      Indicator : PIndicator;
+      constructor Init(var Bounds: TRect; AFileName: PathStr);
+      procedure   SetTitle(ATitle: string); virtual;
+      procedure   UpdateTitle; virtual;
+      procedure   HandleEvent(var Event: TEvent); virtual;
+      procedure   SetState(AState: Word; Enable: Boolean); virtual;
+      procedure   Update; virtual;
+      procedure   UpdateCommands; virtual;
+      function    GetPalette: PPalette; virtual;
+      destructor  Done; virtual;
+    end;
+
+    PClipboardWindow = ^TClipboardWindow;
+    TClipboardWindow = object(TSourceWindow)
+      constructor Init;
+      procedure   Close; virtual;
+      destructor  Done; virtual;
+    end;
+
+    PAdvancedMenuBox = ^TAdvancedMenuBox;
+    TAdvancedMenuBox = object(TMenuBox)
+      function NewSubView(var Bounds: TRect; AMenu: PMenu;
+                 AParentMenu: PMenuView): PMenuView; virtual;
+      function Execute: Word; virtual;
+    end;
+
+    PAdvancedMenuPopUp = ^TAdvancedMenuPopup;
+    TAdvancedMenuPopUp = object(TMenuPopup)
+      function NewSubView(var Bounds: TRect; AMenu: PMenu;
+                 AParentMenu: PMenuView): PMenuView; virtual;
+      function Execute: Word; virtual;
+    end;
+
+    PAdvancedMenuBar = ^TAdvancedMenuBar;
+    TAdvancedMenuBar = object(TMenuBar)
+      constructor Init(var Bounds: TRect; AMenu: PMenu);
+      function  NewSubView(var Bounds: TRect; AMenu: PMenu;
+                  AParentMenu: PMenuView): PMenuView; virtual;
+      procedure Update; virtual;
+      procedure HandleEvent(var Event: TEvent); virtual;
+      function  Execute: Word; virtual;
+    end;
+
+    PAdvancedStaticText = ^TAdvancedStaticText;
+    TAdvancedStaticText = object(TStaticText)
+      procedure SetText(S: string); virtual;
+    end;
+
+    PAdvancedListBox = ^TAdvancedListBox;
+    TAdvancedListBox = object(TListBox)
+      Default: boolean;
+      procedure HandleEvent(var Event: TEvent); virtual;
+    end;
+
+    PColorStaticText = ^TColorStaticText;
+    TColorStaticText = object(TAdvancedStaticText)
+      Color: word;
+      DontWrap: boolean;
+      Delta: TPoint;
+      constructor Init(var Bounds: TRect; AText: String; AColor: word);
+      procedure   Draw; virtual;
+    end;
+
+    PUnsortedStringCollection = ^TUnsortedStringCollection;
+    TUnsortedStringCollection = object(TCollection)
+      procedure FreeItem(Item: Pointer); virtual;
+    end;
+
+    PHSListBox = ^THSListBox;
+    THSListBox = object(TListBox)
+      constructor Init(var Bounds: TRect; ANumCols: Word; AHScrollBar, AVScrollBar: PScrollBar);
+    end;
+
+    PDlgWindow = ^TDlgWindow;
+    TDlgWindow = object(TDialog)
+      constructor Init(var Bounds: TRect; ATitle: TTitleStr; ANumber: Integer);
+    end;
+
+    PAdvancedStatusLine = ^TAdvancedStatusLine;
+    TAdvancedStatusLine = object(TStatusLine)
+      StatusText: PString;
+      function  GetStatusText: string; virtual;
+      procedure SetStatusText(S: string); virtual;
+      procedure ClearStatusText; virtual;
+      procedure Draw; virtual;
+    end;
+
+    PMessageItem = ^TMessageItem;
+    TMessageItem = object(TObject)
+      TClass    : longint;
+      Text      : PString;
+      Module    : PString;
+      ID        : longint;
+      constructor Init(AClass: longint; AText, AModule: string; AID: longint);
+      function    GetText(MaxLen: integer): string; virtual;
+      procedure   Selected; virtual;
+      destructor  Done; virtual;
+    end;
+
+    PMessageListBox = ^TMessageListBox;
+    TMessageListBox = object(THSListBox)
+      Transparent: boolean;
+      NoSelection: boolean;
+      MaxWidth: integer;
+      constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
+      procedure   AddItem(P: PMessageItem); virtual;
+      procedure   Clear; virtual;
+      function    GetText(Item: Integer; MaxLen: Integer): String; virtual;
+      procedure   Draw; virtual;
+      destructor  Done; virtual;
+    end;
+
+    PCompilerMessage = ^TCompilerMessage;
+    TCompilerMessage = object(TMessageItem)
+      function    GetText(MaxLen: Integer): String; virtual;
+    end;
+
+    PProgramInfoWindow = ^TProgramInfoWindow;
+    TProgramInfoWindow = object(TDlgWindow)
+      InfoST: PStaticText;
+      LogLB : PMessageListBox;
+      constructor Init;
+      procedure   AddMessage(AClass: longint; Msg, Module: string; Line: longint);
+      procedure   SizeLimits(var Min, Max: TPoint); virtual;
+      procedure   Close; virtual;
+    end;
+
+    PTabItem = ^TTabItem;
+    TTabItem = record
+      Next : PTabItem;
+      View : PView;
+      Dis  : boolean;
+    end;
+
+    PTabDef = ^TTabDef;
+    TTabDef = record
+      Next     : PTabDef;
+      Name     : PString;
+      Items    : PTabItem;
+      DefItem  : PView;
+      ShortCut : char;
+    end;
+
+    PTab = ^TTab;
+    TTab = object(TGroup)
+      TabDefs   : PTabDef;
+      ActiveDef : integer;
+      DefCount  : word;
+      constructor Init(var Bounds: TRect; ATabDef: PTabDef);
+      function    AtTab(Index: integer): PTabDef; virtual;
+      procedure   SelectTab(Index: integer); virtual;
+      function    TabCount: integer;
+      function    Valid(Command: Word): Boolean; virtual;
+      procedure   ChangeBounds(var Bounds: TRect); virtual;
+      procedure   HandleEvent(var Event: TEvent); virtual;
+      function    GetPalette: PPalette; virtual;
+      procedure   Draw; virtual;
+      procedure   SetState(AState: Word; Enable: Boolean); virtual;
+      destructor  Done; virtual;
+    private
+      InDraw: boolean;
+    end;
+
+function  SearchFreeWindowNo: integer;
+
+procedure InsertOK(ADialog: PDialog);
+procedure InsertButtons(ADialog: PDialog);
+
+procedure ErrorBox(S: string; Params: pointer);
+procedure InformationBox(S: string; Params: pointer);
+
+function IsThereAnyEditor: boolean;
+function IsThereAnyWindow: boolean;
+
+function  SearchMenuItem(Menu: PMenu; Cmd: word): PMenuItem;
+procedure SetMenuItemParam(Menu: PMenuItem; Param: string);
+function  IsSubMenu(P: PMenuItem): boolean;
+function  IsSeparator(P: PMenuItem): boolean;
+function  UpdateMenu(M: PMenu): boolean;
+function  SearchSubMenu(M: PMenu; Index: integer): PMenuItem;
+procedure AppendMenuItem(M: PMenu; I: PMenuItem);
+procedure RemoveMenuItem(Menu: PMenu; I: PMenuItem);
+function  GetMenuItemBefore(Menu:PMenu; BeforeOf: PMenuItem): PMenuItem;
+
+function  NewTabItem(AView: PView; ANext: PTabItem): PTabItem;
+procedure DisposeTabItem(P: PTabItem);
+function  NewTabDef(AName: string; ADefItem: PView; AItems: PTabItem; ANext: PTabDef): PTabDef;
+procedure DisposeTabDef(P: PTabDef);
+
+function  GetEditorCurWord(Editor: PEditor): string;
+procedure InitReservedWords;
+
+const
+      SourceCmds  : TCommandSet =
+        ([cmSave,cmSaveAs,cmCompile]);
+      EditorCmds  : TCommandSet =
+        ([cmFind,cmReplace,cmSearchAgain,cmJumpLine,cmHelpTopicSearch]);
+      CompileCmds : TCommandSet =
+        ([cmMake,cmBuild,cmRun]);
+
+      CalcClipboard  : extended = 0;
+
+      OpenFileName   : string = '';
+
+
+implementation
+
+uses
+  Memory,MsgBox,Validate,
+  Tokens,
+  FPUtils,FPHelp;
+
+const
+  NoNameCount    : integer = 0;
+  ReservedWords  : PStringCollection = nil;
+
+function IsThereAnyEditor: boolean;
+begin
+  IsThereAnyEditor:=Message(Desktop,evBroadcast,cmSearchWindow,nil)<>nil;
+end;
+
+function IsThereAnyHelpWindow: boolean;
+begin
+  IsThereAnyHelpWindow:=(HelpWindow<>nil) and (HelpWindow^.GetState(sfVisible));
+end;
+
+function IsThereAnyWindow: boolean;
+begin
+  IsThereAnyWindow:=IsThereAnyEditor or IsThereAnyHelpWindow;
+end;
+
+procedure InsertButtons(ADialog: PDialog);
+var R   : TRect;
+    W,H : integer;
+    X   : integer;
+    X1,X2: Sw_integer;
+begin
+  with ADialog^ do
+  begin
+    GetExtent(R);
+    W:=R.B.X-R.A.X; H:=(R.B.Y-R.A.Y);
+    R.Assign(0,0,W,H+3); ChangeBounds(R);
+    X:=W div 2; X1:=X div 2+1; X2:=X+X1-1;
+    R.Assign(X1-3,H,X1+7,H+2);
+    Insert(New(PButton, Init(R, 'O~K~', cmOK, bfDefault)));
+    R.Assign(X2-7,H,X2+3,H+2);
+    Insert(New(PButton, Init(R, 'Cancel', cmCancel, bfNormal)));
+    SelectNext(true);
+  end;
+end;
+
+procedure InsertOK(ADialog: PDialog);
+var BW: Sw_integer;
+    R: TRect;
+begin
+  with ADialog^ do
+  begin
+    GetBounds(R); R.Grow(0,1); Inc(R.B.Y);
+    ChangeBounds(R);
+    BW:=10;
+    R.A.Y:=R.B.Y-2; R.B.Y:=R.A.Y+2;
+    R.A.X:=R.A.X+(R.B.X-R.A.X-BW) div 2; R.B.X:=R.A.X+BW;
+    Insert(New(PButton, Init(R, 'O~K~', cmOK, bfDefault)));
+    SelectNext(true);
+  end;
+end;
+
+
+function GetEditorCurWord(Editor: PEditor): string;
+var S: string;
+    PS,PE: byte;
+function Trim(S: string): string;
+const TrimChars : set of char = [#0,#9,' ',#255];
+begin
+  while (length(S)>0) and (S[1] in TrimChars) do Delete(S,1,1);
+  while (length(S)>0) and (S[length(S)] in TrimChars) do Delete(S,length(S),1);
+  Trim:=S;
+end;
+const AlphaNum : set of char = ['A'..'Z','0'..'9','_'];
+begin
+  with Editor^ do
+  begin
+{$ifdef EDITORS}
+    S:='';
+{$else}
+    S:=GetLineText(CurPos.Y);
+    PS:=CurPos.X; while (PS>0) and (Upcase(S[PS]) in AlphaNum) do Dec(PS);
+    PE:=CurPos.X; while (PE<length(S)) and (Upcase(S[PE+1]) in AlphaNum) do Inc(PE);
+    S:=Trim(copy(S,PS+1,PE-PS));
+{$endif}
+  end;
+  GetEditorCurWord:=S;
+end;
+
+
+{*****************************************************************************
+                                   Tab
+*****************************************************************************}
+
+function NewTabItem(AView: PView; ANext: PTabItem): PTabItem;
+var P: PTabItem;
+begin
+  New(P); FillChar(P^,SizeOf(P^),0);
+  P^.Next:=ANext; P^.View:=AView;
+  NewTabItem:=P;
+end;
+
+procedure DisposeTabItem(P: PTabItem);
+begin
+  if P<>nil then
+  begin
+    if P^.View<>nil then Dispose(P^.View, Done);
+    Dispose(P);
+  end;
+end;
+
+function NewTabDef(AName: string; ADefItem: PView; AItems: PTabItem; ANext: PTabDef): PTabDef;
+var P: PTabDef;
+    x: byte;
+begin
+  New(P);
+  P^.Next:=ANext; P^.Name:=NewStr(AName); P^.Items:=AItems;
+  x:=pos('~',AName);
+  if (x<>0) and (x<length(AName)) then P^.ShortCut:=Upcase(AName[x+1])
+                                  else P^.ShortCut:=#0;
+  P^.DefItem:=ADefItem;
+  NewTabDef:=P;
+end;
+
+procedure DisposeTabDef(P: PTabDef);
+var PI,X: PTabItem;
+begin
+  DisposeStr(P^.Name);
+  PI:=P^.Items;
+  while PI<>nil do
+    begin
+      X:=PI^.Next;
+      DisposeTabItem(PI);
+      PI:=X;
+    end;
+  Dispose(P);
+end;
+
+
+{*****************************************************************************
+                               Reserved Words
+*****************************************************************************}
+
+function GetReservedWordCount: integer;
+var
+  Count,I: integer;
+begin
+  Count:=0;
+  for I:=ord(Low(TokenInfo)) to ord(High(TokenInfo)) do
+   with TokenInfo[TToken(I)] do
+     if (str<>'') and (str[1] in['A'..'Z']) then
+       Inc(Count);
+  GetReservedWordCount:=Count;
+end;
+
+function GetReservedWord(Index: integer): string;
+var
+  Count,Idx,I: integer;
+  S: string;
+begin
+  Idx:=-1;
+  Count:=-1;
+  I:=ord(Low(TokenInfo));
+  while (I<=ord(High(TokenInfo))) and (Idx=-1) do
+   with TokenInfo[TToken(I)] do
+    begin
+      if (str<>'') and (str[1] in['A'..'Z']) then
+        begin
+          Inc(Count);
+          if Count=Index then
+           Idx:=I;
+        end;
+      Inc(I);
+    end;
+  if Idx=-1 then
+    S:=''
+  else
+    S:=TokenInfo[TToken(Idx)].str;
+  GetReservedWord:=S;
+end;
+
+procedure InitReservedWords;
+var
+  I,Count: integer;
+begin
+  Count:=GetReservedWordCount;
+  New(ReservedWords, Init(Count,100));
+  for I:=1 to Count do
+    ReservedWords^.Insert(NewStr(UpcaseStr(GetReservedWord(I-1))));
+end;
+
+
+{*****************************************************************************
+                               SearchWindow
+*****************************************************************************}
+
+function SearchWindowWithNo(No: integer): PSourceWindow;
+var P: PSourceWindow;
+begin
+  P:=Message(Desktop,evBroadcast,cmSearchWindow+No,nil);
+  if pointer(P)=pointer(Desktop) then P:=nil;
+  SearchWindowWithNo:=P;
+end;
+
+function SearchFreeWindowNo: integer;
+var No: integer;
+begin
+  No:=1;
+  while (No<10) and (SearchWindowWithNo(No)<>nil) do
+    Inc(No);
+  if No=10 then No:=0;
+  SearchFreeWindowNo:=No;
+end;
+
+
+{*****************************************************************************
+                              TCenterDialog
+*****************************************************************************}
+
+constructor TCenterDialog.Init(var Bounds: TRect; ATitle: TTitleStr);
+begin
+  inherited Init(Bounds,ATitle);
+  Options:=Options or ofCentered;
+end;
+
+
+{*****************************************************************************
+                              TIntegerLine
+*****************************************************************************}
+
+constructor TIntegerLine.Init(var Bounds: TRect; AMin, AMax: longint);
+begin
+  inherited Init(Bounds, Bounds.B.X-Bounds.A.X-1);
+  Validator:=New(PRangeValidator, Init(AMin, AMax));
+end;
+
+
+{*****************************************************************************
+                               SourceEditor
+*****************************************************************************}
+
+{$ifndef EDITORS}
+function TSourceEditor.GetSpecSymbolCount(SpecClass: TSpecSymbolClass): integer;
+var Count: integer;
+begin
+  case SpecClass of
+    ssCommentPrefix   : Count:=3;
+    ssCommentSuffix   : Count:=2;
+    ssStringPrefix    : Count:=1;
+    ssStringSuffix    : Count:=1;
+    ssAsmPrefix       : Count:=1;
+    ssAsmSuffix       : Count:=1;
+    ssDirectivePrefix : Count:=1;
+    ssDirectiveSuffix : Count:=1;
+  end;
+  GetSpecSymbolCount:=Count;
+end;
+
+function TSourceEditor.GetSpecSymbol(SpecClass: TSpecSymbolClass; Index: integer): string;
+var S: string[20];
+begin
+  case SpecClass of
+    ssCommentPrefix :
+      case Index of
+        0 : S:='{';
+        1 : S:='(*';
+        2 : S:='//';
+      end;
+    ssCommentSuffix :
+      case Index of
+        0 : S:='}';
+        1 : S:='*)';
+      end;
+    ssStringPrefix :
+      S:='''';
+    ssStringSuffix :
+      S:='''';
+    ssAsmPrefix :
+      S:='asm';
+    ssAsmSuffix :
+      S:='end';
+    ssDirectivePrefix :
+      S:='{$';
+    ssDirectiveSuffix :
+      S:='}';
+  end;
+  GetSpecSymbol:=S;
+end;
+
+function TSourceEditor.IsReservedWord(S: string): boolean;
+var I: Sw_integer;
+begin
+  S:=UpcaseStr(S);
+  IsReservedWord:=ReservedWords^.Search(@S,I);
+end;
+{$endif EDITORS}
+
+procedure TSourceEditor.LocalMenu(P: TPoint);
+var M: PMenu;
+    MV: PAdvancedMenuPopUp;
+    R: TRect;
+    Re: word;
+begin
+  M:=GetLocalMenu;
+  if M=nil then Exit;
+  if LastLocalCmd<>0 then
+     M^.Default:=SearchMenuItem(M,LastLocalCmd);
+  Desktop^.GetExtent(R);
+  MakeGlobal(P,R.A); {Desktop^.MakeLocal(R.A,R.A);}
+  New(MV, Init(R, M));
+  Re:=Application^.ExecView(MV);
+  if M^.Default=nil then LastLocalCmd:=0
+     else LastLocalCmd:=M^.Default^.Command;
+  Dispose(MV, Done);
+  if Re<>0 then
+    Message(GetCommandTarget,evCommand,Re,@Self);
+end;
+
+function TSourceEditor.GetLocalMenu: PMenu;
+var M: PMenu;
+begin
+  M:=NewMenu(
+    NewItem('Cu~t~','Shift+Del',kbShiftDel,cmCut,hcCut,
+    NewItem('~C~opy','Ctrl+Ins',kbCtrlIns,cmCopy,hcCopy,
+    NewItem('~P~aste','Shift+Ins',kbShiftIns,cmPaste,hcPaste,
+    NewItem('C~l~ear','Ctrl+Del',kbCtrlDel,cmClear,hcClear,
+    NewLine(
+    NewItem('Open ~f~ile at cursor','',kbNoKey,cmOpenAtCursor,hcOpenAtCursor,
+    NewItem('~B~rowse symbol at cursor','',kbNoKey,cmBrowseAtCursor,hcBrowseAtCursor,
+    NewItem('Topic ~s~earch','Ctrl+F1',kbCtrlF1,cmHelpTopicSearch,hcHelpTopicSearch,
+    NewLine(
+    NewItem('~O~ptions...','',kbNoKey,cmEditorOptions,hcEditorOptions,
+    nil)))))))))));
+  GetLocalMenu:=M;
+end;
+
+function TSourceEditor.GetCommandTarget: PView;
+begin
+  GetCommandTarget:=@Self;
+end;
+
+procedure TSourceEditor.HandleEvent(var Event: TEvent);
+var DontClear: boolean;
+    P: TPoint;
+begin
+  case Event.What of
+    evMouseDown :
+      if MouseInView(Event.Where) and (Event.Buttons=mbRightButton) then
+        begin
+          MakeLocal(Event.Where,P); Inc(P.X); Inc(P.Y);
+          LocalMenu(P);
+          ClearEvent(Event);
+        end;
+    evKeyDown :
+      begin
+        DontClear:=false;
+        case Event.KeyCode of
+          kbAltF10 : Message(@Self,evCommand,cmLocalMenu,@Self);
+        else DontClear:=true;
+        end;
+        if DontClear=false then ClearEvent(Event);
+      end;
+    evCommand :
+      begin
+        DontClear:=false;
+        case Event.Command of
+          cmLocalMenu :
+            begin
+              P:=CurPos; Inc(P.X); Inc(P.Y);
+              LocalMenu(P);
+            end;
+          cmOpenAtCursor :
+            begin
+              OpenFileName:=LowerCaseStr(GetEditorCurWord(@Self))+'.pas';
+              Message(Application,evCommand,cmOpen,nil);
+            end;
+          cmHelp :
+            Message(@Self,evCommand,cmHelpTopicSearch,@Self);
+          cmHelpTopicSearch :
+            HelpTopicSearch(@Self);
+        else DontClear:=true;
+        end;
+        if not DontClear then ClearEvent(Event);
+      end;
+  end;
+  inherited HandleEvent(Event);
+end;
+
+procedure TIDEHelpWindow.HandleEvent(var Event: TEvent);
+begin
+  case Event.What of
+    evBroadcast :
+      case Event.Command of
+        cmUpdate : ReDraw;
+      end;
+  end;
+  inherited HandleEvent(Event);
+end;
+
+function TIDEHelpWindow.GetPalette: PPalette;
+const P: string[length(CIDEHelpDialog)] = CIDEHelpDialog;
+begin
+  GetPalette:=@P;
+end;
+
+constructor TSourceWindow.Init(var Bounds: TRect; AFileName: PathStr);
+var HSB,VSB: PScrollBar;
+    R: TRect;
+    LoadFile: boolean;
+begin
+  inherited Init(Bounds,AFileName,SearchFreeWindowNo);
+  GetExtent(R); R.A.Y:=R.B.Y-1; R.Grow(-1,0); R.A.X:=14;
+  New(HSB, Init(R)); HSB^.GrowMode:=gfGrowLoY+gfGrowHiX+gfGrowHiY; Insert(HSB);
+  GetExtent(R); R.A.X:=R.B.X-1; R.Grow(0,-1);
+  New(VSB, Init(R)); VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY; Insert(VSB);
+  GetExtent(R); R.A.X:=3; R.B.X:=14; R.A.Y:=R.B.Y-1;
+  New(Indicator, Init(R));
+  Indicator^.GrowMode:=gfGrowLoY+gfGrowHiY;
+  Insert(Indicator);
+  GetExtent(R); R.Grow(-1,-1);
+  LoadFile:=AFileName<>'';
+  if not LoadFile then
+     begin SetTitle('noname'+IntToStrZ(NonameCount,2)+'.pas'); Inc(NonameCount); end;
+  New(Editor, Init(R, HSB, VSB, Indicator,AFileName));
+  Editor^.GrowMode:=gfGrowHiX+gfGrowHiY;
+  if LoadFile then
+    if Editor^.LoadFile=false then
+       ErrorBox('Error reading file.',nil);
+  Insert(Editor);
+  UpdateTitle;
+end;
+
+procedure TSourceWindow.UpdateTitle;
+var Name: string;
+begin
+  if Editor^.FileName<>'' then
+  begin Name:=SmartPath(Editor^.FileName); SetTitle(Name); end;
+end;
+
+procedure TSourceWindow.SetTitle(ATitle: string);
+begin
+  if Title<>nil then DisposeStr(Title);
+  Title:=NewStr(ATitle);
+  Frame^.DrawView;
+end;
+
+procedure TSourceWindow.HandleEvent(var Event: TEvent);
+var DontClear: boolean;
+begin
+  case Event.What of
+    evBroadcast :
+      case Event.Command of
+        cmUpdate :
+          Update;
+        cmUpdateTitle :
+          UpdateTitle;
+        cmSearchWindow :
+          if Editor^.IsClipboard=false then
+          ClearEvent(Event);
+        else
+          begin
+            if (Event.Command>cmSearchWindow) and (Event.Command<=cmSearchWindow+100) and
+               (Event.Command-cmSearchWindow=Number) then
+            if Editor^.IsClipboard=false then
+              ClearEvent(Event);
+          end;
+      end;
+    evCommand :
+      begin
+        DontClear:=false;
+        case Event.Command of
+          cmSave :
+            if Editor^.IsClipboard=false then
+            Editor^.Save;
+          cmSaveAs :
+            if Editor^.IsClipboard=false then
+            Editor^.SaveAs;
+        else DontClear:=true;
+        end;
+        if DontClear=false then ClearEvent(Event);
+      end;
+  end;
+  inherited HandleEvent(Event);
+end;
+
+procedure TSourceWindow.SetState(AState: Word; Enable: Boolean);
+var OldState: word;
+begin
+  OldState:=State;
+  inherited SetState(AState,Enable);
+  if ((AState xor State) and sfActive)<>0 then
+  UpdateCommands;
+end;
+
+procedure TSourceWindow.UpdateCommands;
+var Active: boolean;
+begin
+  Active:=GetState(sfActive);
+  if Editor^.IsClipboard=false then
+  begin
+    SetCmdState(SourceCmds+CompileCmds,Active);
+    SetCmdState(EditorCmds,Active);
+  end;
+  if Active=false then
+     SetCmdState(ToClipCmds+FromClipCmds+UndoCmds,false);
+end;
+
+procedure TSourceWindow.Update;
+begin
+  ReDraw;
+end;
+
+function TSourceWindow.GetPalette: PPalette;
+const P: string[length(CSourceWindow)] = CSourceWindow;
+begin
+  GetPalette:=@P;
+end;
+
+destructor TSourceWindow.Done;
+begin
+  Message(Application,evBroadcast,cmSourceWindowClosing,@Self);
+  inherited Done;
+  Message(Application,evBroadcast,cmUpdate,@Self);
+end;
+
+constructor TClipboardWindow.Init;
+var R: TRect;
+    HSB,VSB: PScrollBar;
+begin
+  Desktop^.GetExtent(R);
+  inherited Init(R, '');
+  SetTitle('Clipboard');
+  HelpCtx:=hcClipboardWindow;
+  Number:=wnNoNumber;
+
+  GetExtent(R); R.A.Y:=R.B.Y-1; R.Grow(-1,0); R.A.X:=14;
+  New(HSB, Init(R)); HSB^.GrowMode:=gfGrowLoY+gfGrowHiX+gfGrowHiY; Insert(HSB);
+  GetExtent(R); R.A.X:=R.B.X-1; R.Grow(0,-1);
+  New(VSB, Init(R)); VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY; Insert(VSB);
+  GetExtent(R); R.A.X:=3; R.B.X:=14; R.A.Y:=R.B.Y-1;
+  New(Indicator, Init(R));
+  Indicator^.GrowMode:=gfGrowLoY+gfGrowHiY;
+  Insert(Indicator);
+  GetExtent(R); R.Grow(-1,-1);
+  New(Editor, Init(R, HSB, VSB, Indicator, ''));
+  Editor^.GrowMode:=gfGrowHiX+gfGrowHiY;
+  Insert(Editor);
+
+  Hide;
+
+  Clipboard:=Editor;
+end;
+
+procedure TClipboardWindow.Close;
+begin
+  Hide;
+end;
+
+destructor TClipboardWindow.Done;
+begin
+  inherited Done;
+  Clipboard:=nil;
+end;
+
+function TAdvancedMenuBox.NewSubView(var Bounds: TRect; AMenu: PMenu;
+  AParentMenu: PMenuView): PMenuView;
+begin
+  NewSubView := New(PAdvancedMenuBox, Init(Bounds, AMenu, AParentMenu));
+end;
+
+function TAdvancedMenuBox.Execute: word;
+type
+  MenuAction = (DoNothing, DoSelect, DoReturn);
+var
+  AutoSelect: Boolean;
+  Action: MenuAction;
+  Ch: Char;
+  Result: Word;
+  ItemShown, P: PMenuItem;
+  Target: PMenuView;
+  R: TRect;
+  E: TEvent;
+  MouseActive: Boolean;
+function IsDisabled(Item: PMenuItem): boolean;
+var Found: boolean;
+begin
+  Found:=Item^.Disabled or IsSeparator(Item);
+  if (Found=false) and (IsSubMenu(Item)=false) then
+     Found:=CommandEnabled(Item^.Command)=false;
+  IsDisabled:=Found;
+end;
+
+procedure TrackMouse;
+var
+  Mouse: TPoint;
+  R: TRect;
+  OldC: PMenuItem;
+begin
+  MakeLocal(E.Where, Mouse);
+  OldC:=Current;
+  Current := Menu^.Items;
+  while Current <> nil do
+  begin
+    GetItemRect(Current, R);
+    if R.Contains(Mouse) then
+    begin
+      MouseActive := True;
+      Break;
+    end;
+    Current := Current^.Next;
+  end;
+  if (Current<>nil) and IsDisabled(Current) then
+  begin
+     Current:={OldC}nil;
+     MouseActive:=false;
+  end;
+end;
+
+procedure TrackKey(FindNext: Boolean);
+
+procedure NextItem;
+begin
+  Current := Current^.Next;
+  if Current = nil then Current := Menu^.Items;
+end;
+
+procedure PrevItem;
+var
+  P: PMenuItem;
+begin
+  P := Current;
+  if P = Menu^.Items then P := nil;
+  repeat NextItem until Current^.Next = P;
+end;
+
+begin
+  if Current <> nil then
+    repeat
+      if FindNext then NextItem else PrevItem;
+    until (Current^.Name <> nil) and (IsDisabled(Current)=false);
+end;
+
+function MouseInOwner: Boolean;
+var
+  Mouse: TPoint;
+  R: TRect;
+begin
+  MouseInOwner := False;
+  if (ParentMenu <> nil) and (ParentMenu^.Size.Y = 1) then
+  begin
+    ParentMenu^.MakeLocal(E.Where, Mouse);
+    ParentMenu^.GetItemRect(ParentMenu^.Current, R);
+    MouseInOwner := R.Contains(Mouse);
+  end;
+end;
+
+function MouseInMenus: Boolean;
+var
+  P: PMenuView;
+begin
+  P := ParentMenu;
+  while (P <> nil) and (P^.MouseInView(E.Where)=false) do
+        P := P^.ParentMenu;
+  MouseInMenus := P <> nil;
+end;
+
+function TopMenu: PMenuView;
+var
+  P: PMenuView;
+begin
+  P := @Self;
+  while P^.ParentMenu <> nil do P := P^.ParentMenu;
+  TopMenu := P;
+end;
+
+begin
+  AutoSelect := False; E.What:=evNothing;
+  Result := 0;
+  ItemShown := nil;
+  Current := Menu^.Default;
+  MouseActive := False;
+  if UpdateMenu(Menu) then
+ begin
+  if Current<>nil then
+    if Current^.Disabled then
+       TrackKey(true);
+  repeat
+    Action := DoNothing;
+    GetEvent(E);
+    case E.What of
+      evMouseDown:
+        if MouseInView(E.Where) or MouseInOwner then
+        begin
+          TrackMouse;
+          if Size.Y = 1 then AutoSelect := True;
+        end else Action := DoReturn;
+      evMouseUp:
+        begin
+          TrackMouse;
+          if MouseInOwner then
+            Current := Menu^.Default
+          else
+            if (Current <> nil) and (Current^.Name <> nil) then
+              Action := DoSelect
+            else
+              if MouseActive or MouseInView(E.Where) then Action := DoReturn
+              else
+              begin
+                Current := Menu^.Default;
+                if Current = nil then Current := Menu^.Items;
+                Action := DoNothing;
+              end;
+        end;
+      evMouseMove:
+        if E.Buttons <> 0 then
+        begin
+          TrackMouse;
+          if not (MouseInView(E.Where) or MouseInOwner) and
+            MouseInMenus then Action := DoReturn;
+        end;
+      evKeyDown:
+        case CtrlToArrow(E.KeyCode) of
+          kbUp, kbDown:
+            if Size.Y <> 1 then
+              TrackKey(CtrlToArrow(E.KeyCode) = kbDown) else
+              if E.KeyCode = kbDown then AutoSelect := True;
+          kbLeft, kbRight:
+            if ParentMenu = nil then
+              TrackKey(CtrlToArrow(E.KeyCode) = kbRight) else
+              Action := DoReturn;
+          kbHome, kbEnd:
+            if Size.Y <> 1 then
+            begin
+              Current := Menu^.Items;
+              if E.KeyCode = kbEnd then TrackKey(False);
+            end;
+          kbEnter:
+            begin
+              if Size.Y = 1 then AutoSelect := True;
+              Action := DoSelect;
+            end;
+          kbEsc:
+            begin
+              Action := DoReturn;
+              if (ParentMenu = nil) or (ParentMenu^.Size.Y <> 1) then
+                ClearEvent(E);
+            end;
+        else
+          Target := @Self;
+          Ch := GetAltChar(E.KeyCode);
+          if Ch = #0 then Ch := E.CharCode else Target := TopMenu;
+          P := Target^.FindItem(Ch);
+          if P = nil then
+          begin
+            P := TopMenu^.HotKey(E.KeyCode);
+            if (P <> nil) and CommandEnabled(P^.Command) then
+            begin
+              Result := P^.Command;
+              Action := DoReturn;
+            end
+          end else
+            if Target = @Self then
+            begin
+              if Size.Y = 1 then AutoSelect := True;
+              Action := DoSelect;
+              Current := P;
+            end else
+              if (ParentMenu <> Target) or (ParentMenu^.Current <> P) then
+                Action := DoReturn;
+        end;
+      evCommand:
+        if E.Command = cmMenu then
+        begin
+          AutoSelect := False;
+          if ParentMenu <> nil then Action := DoReturn;
+        end else Action := DoReturn;
+    end;
+    if ItemShown <> Current then
+    begin
+      ItemShown := Current;
+      DrawView;
+    end;
+    if (Action = DoSelect) or ((Action = DoNothing) and AutoSelect) then
+      if Current <> nil then with Current^ do if Name <> nil then
+        if Command = 0 then
+        begin
+          if E.What and (evMouseDown + evMouseMove) <> 0 then PutEvent(E);
+          GetItemRect(Current, R);
+          R.A.X := R.A.X + Origin.X;
+          R.A.Y := R.B.Y + Origin.Y;
+          R.B := Owner^.Size;
+          if Size.Y = 1 then Dec(R.A.X);
+          Target := TopMenu^.NewSubView(R, SubMenu, @Self);
+          Result := Owner^.ExecView(Target);
+          Dispose(Target, Done);
+        end else if Action = DoSelect then Result := Command;
+    if (Result <> 0) and CommandEnabled(Result) then
+    begin
+      Action := DoReturn;
+      ClearEvent(E);
+    end
+    else
+      Result := 0;
+  until Action = DoReturn;
+ end;
+  if E.What <> evNothing then
+    if (ParentMenu <> nil) or (E.What = evCommand) then PutEvent(E);
+  if Current <> nil then
+  begin
+    Menu^.Default := Current;
+    Current := nil;
+    DrawView;
+  end;
+  Execute := Result;
+end;
+
+function TAdvancedMenuPopup.NewSubView(var Bounds: TRect; AMenu: PMenu;
+  AParentMenu: PMenuView): PMenuView;
+begin
+  NewSubView := New(PAdvancedMenuBox, Init(Bounds, AMenu, AParentMenu));
+end;
+
+function TAdvancedMenuPopup.Execute: word;
+type
+  MenuAction = (DoNothing, DoSelect, DoReturn);
+var
+  AutoSelect: Boolean;
+  Action: MenuAction;
+  Ch: Char;
+  Result: Word;
+  ItemShown, P: PMenuItem;
+  Target: PMenuView;
+  R: TRect;
+  E: TEvent;
+  MouseActive: Boolean;
+function IsDisabled(Item: PMenuItem): boolean;
+var Found: boolean;
+begin
+  Found:=Item^.Disabled or IsSeparator(Item);
+  if (Found=false) and (IsSubMenu(Item)=false) then
+     Found:=CommandEnabled(Item^.Command)=false;
+  IsDisabled:=Found;
+end;
+
+procedure TrackMouse;
+var
+  Mouse: TPoint;
+  R: TRect;
+  OldC: PMenuItem;
+begin
+  MakeLocal(E.Where, Mouse);
+  OldC:=Current;
+  Current := Menu^.Items;
+  while Current <> nil do
+  begin
+    GetItemRect(Current, R);
+    if R.Contains(Mouse) then
+    begin
+      MouseActive := True;
+      Break;
+    end;
+    Current := Current^.Next;
+  end;
+  if (Current<>nil) and IsDisabled(Current) then
+  begin
+     Current:={OldC}nil;
+     MouseActive:=false;
+  end;
+end;
+
+procedure TrackKey(FindNext: Boolean);
+
+procedure NextItem;
+begin
+  Current := Current^.Next;
+  if Current = nil then Current := Menu^.Items;
+end;
+
+procedure PrevItem;
+var
+  P: PMenuItem;
+begin
+  P := Current;
+  if P = Menu^.Items then P := nil;
+  repeat NextItem until Current^.Next = P;
+end;
+
+begin
+  if Current <> nil then
+    repeat
+      if FindNext then NextItem else PrevItem;
+    until (Current^.Name <> nil) and (IsDisabled(Current)=false);
+end;
+
+function MouseInOwner: Boolean;
+var
+  Mouse: TPoint;
+  R: TRect;
+begin
+  MouseInOwner := False;
+  if (ParentMenu <> nil) and (ParentMenu^.Size.Y = 1) then
+  begin
+    ParentMenu^.MakeLocal(E.Where, Mouse);
+    ParentMenu^.GetItemRect(ParentMenu^.Current, R);
+    MouseInOwner := R.Contains(Mouse);
+  end;
+end;
+
+function MouseInMenus: Boolean;
+var
+  P: PMenuView;
+begin
+  P := ParentMenu;
+  while (P <> nil) and (P^.MouseInView(E.Where)=false) do
+        P := P^.ParentMenu;
+  MouseInMenus := P <> nil;
+end;
+
+function TopMenu: PMenuView;
+var
+  P: PMenuView;
+begin
+  P := @Self;
+  while P^.ParentMenu <> nil do P := P^.ParentMenu;
+  TopMenu := P;
+end;
+
+begin
+  AutoSelect := False; E.What:=evNothing;
+  Result := 0;
+  ItemShown := nil;
+  Current := Menu^.Default;
+  MouseActive := False;
+  if UpdateMenu(Menu) then
+ begin
+  if Current<>nil then
+    if Current^.Disabled then
+       TrackKey(true);
+  repeat
+    Action := DoNothing;
+    GetEvent(E);
+    case E.What of
+      evMouseDown:
+        if MouseInView(E.Where) or MouseInOwner then
+        begin
+          TrackMouse;
+          if Size.Y = 1 then AutoSelect := True;
+        end else Action := DoReturn;
+      evMouseUp:
+        begin
+          TrackMouse;
+          if MouseInOwner then
+            Current := Menu^.Default
+          else
+            if (Current <> nil) and (Current^.Name <> nil) then
+              Action := DoSelect
+            else
+              if MouseActive or MouseInView(E.Where) then Action := DoReturn
+              else
+              begin
+                Current := Menu^.Default;
+                if Current = nil then Current := Menu^.Items;
+                Action := DoNothing;
+              end;
+        end;
+      evMouseMove:
+        if E.Buttons <> 0 then
+        begin
+          TrackMouse;
+          if not (MouseInView(E.Where) or MouseInOwner) and
+            MouseInMenus then Action := DoReturn;
+        end;
+      evKeyDown:
+        case CtrlToArrow(E.KeyCode) of
+          kbUp, kbDown:
+            if Size.Y <> 1 then
+              TrackKey(CtrlToArrow(E.KeyCode) = kbDown) else
+              if E.KeyCode = kbDown then AutoSelect := True;
+          kbLeft, kbRight:
+            if ParentMenu = nil then
+              TrackKey(CtrlToArrow(E.KeyCode) = kbRight) else
+              Action := DoReturn;
+          kbHome, kbEnd:
+            if Size.Y <> 1 then
+            begin
+              Current := Menu^.Items;
+              if E.KeyCode = kbEnd then TrackKey(False);
+            end;
+          kbEnter:
+            begin
+              if Size.Y = 1 then AutoSelect := True;
+              Action := DoSelect;
+            end;
+          kbEsc:
+            begin
+              Action := DoReturn;
+              if (ParentMenu = nil) or (ParentMenu^.Size.Y <> 1) then
+                ClearEvent(E);
+            end;
+        else
+          Target := @Self;
+          Ch := GetAltChar(E.KeyCode);
+          if Ch = #0 then Ch := E.CharCode else Target := TopMenu;
+          P := Target^.FindItem(Ch);
+          if P = nil then
+          begin
+            P := TopMenu^.HotKey(E.KeyCode);
+            if (P <> nil) and CommandEnabled(P^.Command) then
+            begin
+              Result := P^.Command;
+              Action := DoReturn;
+            end
+          end else
+            if Target = @Self then
+            begin
+              if Size.Y = 1 then AutoSelect := True;
+              Action := DoSelect;
+              Current := P;
+            end else
+              if (ParentMenu <> Target) or (ParentMenu^.Current <> P) then
+                Action := DoReturn;
+        end;
+      evCommand:
+        if E.Command = cmMenu then
+        begin
+          AutoSelect := False;
+          if ParentMenu <> nil then Action := DoReturn;
+        end else Action := DoReturn;
+    end;
+    if ItemShown <> Current then
+    begin
+      ItemShown := Current;
+      DrawView;
+    end;
+    if (Action = DoSelect) or ((Action = DoNothing) and AutoSelect) then
+      if Current <> nil then with Current^ do if Name <> nil then
+        if Command = 0 then
+        begin
+          if E.What and (evMouseDown + evMouseMove) <> 0 then PutEvent(E);
+          GetItemRect(Current, R);
+          R.A.X := R.A.X + Origin.X;
+          R.A.Y := R.B.Y + Origin.Y;
+          R.B := Owner^.Size;
+          if Size.Y = 1 then Dec(R.A.X);
+          Target := TopMenu^.NewSubView(R, SubMenu, @Self);
+          Result := Owner^.ExecView(Target);
+          Dispose(Target, Done);
+        end else if Action = DoSelect then Result := Command;
+    if (Result <> 0) and CommandEnabled(Result) then
+    begin
+      Action := DoReturn;
+      ClearEvent(E);
+    end
+    else
+      Result := 0;
+  until Action = DoReturn;
+ end;
+  if E.What <> evNothing then
+    if (ParentMenu <> nil) or (E.What = evCommand) then PutEvent(E);
+  if Current <> nil then
+  begin
+    Menu^.Default := Current;
+    Current := nil;
+    DrawView;
+  end;
+  Execute := Result;
+end;
+
+constructor TAdvancedMenuBar.Init(var Bounds: TRect; AMenu: PMenu);
+begin
+  inherited Init(Bounds, AMenu);
+  EventMask:=EventMask or evBroadcast;
+end;
+
+function TAdvancedMenuBar.NewSubView(var Bounds: TRect; AMenu: PMenu;
+  AParentMenu: PMenuView): PMenuView;
+begin
+  NewSubView := New(PAdvancedMenuBox, Init(Bounds, AMenu, AParentMenu));
+end;
+
+procedure TAdvancedMenuBar.Update;
+begin
+  UpdateMenu(Menu);
+  DrawView;
+end;
+
+procedure TAdvancedMenuBar.HandleEvent(var Event: TEvent);
+begin
+  case Event.What of
+    evBroadcast :
+      case Event.Command of
+        cmUpdate   : Update;
+      end;
+  end;
+  inherited HandleEvent(Event);
+end;
+
+function TAdvancedMenuBar.Execute: word;
+type
+  MenuAction = (DoNothing, DoSelect, DoReturn);
+var
+  AutoSelect: Boolean;
+  Action: MenuAction;
+  Ch: Char;
+  Result: Word;
+  ItemShown, P: PMenuItem;
+  Target: PMenuView;
+  R: TRect;
+  E: TEvent;
+  MouseActive: Boolean;
+function IsDisabled(Item: PMenuItem): boolean;
+var Dis : boolean;
+begin
+  Dis:=Item^.Disabled or IsSeparator(Item);
+  if (Dis=false) and (IsSubMenu(Item)=false) then
+     Dis:=CommandEnabled(Item^.Command)=false;
+  IsDisabled:=Dis;
+end;
+
+procedure TrackMouse;
+var
+  Mouse: TPoint;
+  R: TRect;
+  OldC: PMenuItem;
+begin
+  MakeLocal(E.Where, Mouse);
+  OldC:=Current;
+  Current := Menu^.Items;
+  while Current <> nil do
+  begin
+    GetItemRect(Current, R);
+    if R.Contains(Mouse) then
+    begin
+      MouseActive := True;
+      Break;
+    end;
+    Current := Current^.Next;
+  end;
+  if (Current<>nil) and IsDisabled(Current) then
+    Current:=nil;
+end;
+
+procedure TrackKey(FindNext: Boolean);
+
+procedure NextItem;
+begin
+  Current := Current^.Next;
+  if Current = nil then Current := Menu^.Items;
+end;
+
+procedure PrevItem;
+var
+  P: PMenuItem;
+begin
+  P := Current;
+  if P = Menu^.Items then P := nil;
+  repeat NextItem until Current^.Next = P;
+end;
+
+begin
+  if Current <> nil then
+    repeat
+      if FindNext then NextItem else PrevItem;
+    until (Current^.Name <> nil) and (IsDisabled(Current)=false);
+end;
+
+function MouseInOwner: Boolean;
+var
+  Mouse: TPoint;
+  R: TRect;
+begin
+  MouseInOwner := False;
+  if (ParentMenu <> nil) and (ParentMenu^.Size.Y = 1) then
+  begin
+    ParentMenu^.MakeLocal(E.Where, Mouse);
+    ParentMenu^.GetItemRect(ParentMenu^.Current, R);
+    MouseInOwner := R.Contains(Mouse);
+  end;
+end;
+
+function MouseInMenus: Boolean;
+var
+  P: PMenuView;
+begin
+  P := ParentMenu;
+  while (P <> nil) and not P^.MouseInView(E.Where) do P := P^.ParentMenu;
+  MouseInMenus := P <> nil;
+end;
+
+function TopMenu: PMenuView;
+var
+  P: PMenuView;
+begin
+  P := @Self;
+  while P^.ParentMenu <> nil do P := P^.ParentMenu;
+  TopMenu := P;
+end;
+
+begin
+  AutoSelect := False; E.What:=evNothing;
+  Result := 0;
+  ItemShown := nil;
+  Current := Menu^.Default;
+  MouseActive := False;
+  if UpdateMenu(Menu) then
+ begin
+  if Current<>nil then
+    if Current^.Disabled then
+       TrackKey(true);
+  repeat
+    Action := DoNothing;
+    GetEvent(E);
+    case E.What of
+      evMouseDown:
+        if MouseInView(E.Where) or MouseInOwner then
+        begin
+          TrackMouse;
+          if Size.Y = 1 then AutoSelect := True;
+        end else Action := DoReturn;
+      evMouseUp:
+        begin
+          TrackMouse;
+          if MouseInOwner then
+            Current := Menu^.Default
+          else
+            if (Current <> nil) and (Current^.Name <> nil) then
+              Action := DoSelect
+            else
+              if MouseActive or MouseInView(E.Where) then Action := DoReturn
+              else
+              begin
+                Current := Menu^.Default;
+                if Current = nil then Current := Menu^.Items;
+                Action := DoNothing;
+              end;
+        end;
+      evMouseMove:
+        if E.Buttons <> 0 then
+        begin
+          TrackMouse;
+          if not (MouseInView(E.Where) or MouseInOwner) and
+            MouseInMenus then Action := DoReturn;
+        end;
+      evKeyDown:
+        case CtrlToArrow(E.KeyCode) of
+          kbUp, kbDown:
+            if Size.Y <> 1 then
+              TrackKey(CtrlToArrow(E.KeyCode) = kbDown) else
+              if E.KeyCode = kbDown then AutoSelect := True;
+          kbLeft, kbRight:
+            if ParentMenu = nil then
+              TrackKey(CtrlToArrow(E.KeyCode) = kbRight) else
+              Action := DoReturn;
+          kbHome, kbEnd:
+            if Size.Y <> 1 then
+            begin
+              Current := Menu^.Items;
+              if E.KeyCode = kbEnd then TrackKey(False);
+            end;
+          kbEnter:
+            begin
+              if Size.Y = 1 then AutoSelect := True;
+              Action := DoSelect;
+            end;
+          kbEsc:
+            begin
+              Action := DoReturn;
+              if (ParentMenu = nil) or (ParentMenu^.Size.Y <> 1) then
+                ClearEvent(E);
+            end;
+        else
+          Target := @Self;
+          Ch := GetAltChar(E.KeyCode);
+          if Ch = #0 then Ch := E.CharCode else Target := TopMenu;
+          P := Target^.FindItem(Ch);
+          if P = nil then
+          begin
+            P := TopMenu^.HotKey(E.KeyCode);
+            if (P <> nil) and CommandEnabled(P^.Command) then
+            begin
+              Result := P^.Command;
+              Action := DoReturn;
+            end
+          end else
+            if Target = @Self then
+            begin
+              if Size.Y = 1 then AutoSelect := True;
+              Action := DoSelect;
+              Current := P;
+            end else
+              if (ParentMenu <> Target) or (ParentMenu^.Current <> P) then
+                Action := DoReturn;
+        end;
+      evCommand:
+        if E.Command = cmMenu then
+        begin
+          AutoSelect := False;
+          if ParentMenu <> nil then Action := DoReturn;
+        end else Action := DoReturn;
+    end;
+    if ItemShown <> Current then
+    begin
+      ItemShown := Current;
+      DrawView;
+    end;
+    if (Action = DoSelect) or ((Action = DoNothing) and AutoSelect) then
+      if Current <> nil then with Current^ do if Name <> nil then
+        if Command = 0 then
+        begin
+          if E.What and (evMouseDown + evMouseMove) <> 0 then PutEvent(E);
+          GetItemRect(Current, R);
+          R.A.X := R.A.X + Origin.X;
+          R.A.Y := R.B.Y + Origin.Y;
+          R.B := Owner^.Size;
+          if Size.Y = 1 then Dec(R.A.X);
+          Target := TopMenu^.NewSubView(R, SubMenu, @Self);
+          Result := Owner^.ExecView(Target);
+          Dispose(Target, Done);
+        end else if Action = DoSelect then Result := Command;
+    if (Result <> 0) and CommandEnabled(Result) then
+    begin
+      Action := DoReturn;
+      ClearEvent(E);
+    end
+    else
+      Result := 0;
+  until Action = DoReturn;
+ end;
+  if E.What <> evNothing then
+    if (ParentMenu <> nil) or (E.What = evCommand) then PutEvent(E);
+  if Current <> nil then
+  begin
+    Menu^.Default := Current;
+    Current := nil;
+    DrawView;
+  end;
+  Execute := Result;
+end;
+
+procedure ErrorBox(S: string; Params: pointer);
+begin
+  MessageBox(S,Params,mfError+mfInsertInApp+mfOKButton);
+end;
+
+procedure InformationBox(S: string; Params: pointer);
+begin
+  MessageBox(S,Params,mfInformation+mfInsertInApp+mfOKButton);
+end;
+
+function IsSeparator(P: PMenuItem): boolean;
+begin
+  IsSeparator:=(P<>nil) and (P^.Name=nil) and (P^.HelpCtx=hcNoContext);
+end;
+
+function IsSubMenu(P: PMenuItem): boolean;
+begin
+  IsSubMenu:=(P<>nil) and (P^.Name<>nil) and (P^.Command=0) and (P^.SubMenu<>nil);
+end;
+
+function SearchMenuItem(Menu: PMenu; Cmd: word): PMenuItem;
+var P,I: PMenuItem;
+begin
+  I:=nil;
+  if Menu=nil then P:=nil else P:=Menu^.Items;
+  while (P<>nil) and (I=nil) do
+  begin
+    if IsSubMenu(P) then
+       I:=SearchMenuItem(P^.SubMenu,Cmd);
+    if I=nil then
+    if P^.Command=Cmd then I:=P else
+    P:=P^.Next;
+  end;
+  SearchMenuItem:=I;
+end;
+
+procedure SetMenuItemParam(Menu: PMenuItem; Param: string);
+begin
+  if Menu=nil then Exit;
+  if Menu^.Param<>nil then DisposeStr(Menu^.Param);
+  Menu^.Param:=NewStr(Param);
+end;
+
+function UpdateMenu(M: PMenu): boolean;
+var P: PMenuItem;
+    IsEnabled: boolean;
+begin
+  if M=nil then begin UpdateMenu:=false; Exit; end;
+  P:=M^.Items; IsEnabled:=false;
+  while (P<>nil) do
+  begin
+    if IsSubMenu(P) then
+       P^.Disabled:=not UpdateMenu(P^.SubMenu);
+    if (IsSeparator(P)=false) and (P^.Disabled=false) and (Application^.CommandEnabled(P^.Command)=true) then
+       IsEnabled:=true;
+    P:=P^.Next;
+  end;
+  UpdateMenu:=IsEnabled;
+end;
+
+function SearchSubMenu(M: PMenu; Index: integer): PMenuItem;
+var P,C: PMenuItem;
+    Count: integer;
+begin
+  P:=nil; Count:=-1;
+  if M<>nil then C:=M^.Items else C:=nil;
+  while (C<>nil) and (P=nil) do
+  begin
+    if IsSubMenu(C) then
+     begin
+       Inc(Count);
+       if Count=Index then P:=C;
+     end;
+    C:=C^.Next;
+  end;
+  SearchSubMenu:=P;
+end;
+
+procedure AppendMenuItem(M: PMenu; I: PMenuItem);
+var P: PMenuItem;
+begin
+  if (M=nil) or (I=nil) then Exit;
+  I^.Next:=nil;
+  if M^.Items=nil then M^.Items:=I else
+  begin
+    P:=M^.Items;
+    while (P^.Next<>nil) do P:=P^.Next;
+    P^.Next:=I;
+  end;
+end;
+
+procedure DisposeMenuItem(P: PMenuItem);
+begin
+  if P<>nil then
+  begin
+    if IsSubMenu(P) then DisposeMenu(P^.SubMenu) else
+      if IsSeparator(P)=false then
+       if P^.Param<>nil then DisposeStr(P^.Param);
+    if P^.Name<>nil then DisposeStr(P^.Name);
+    Dispose(P);
+  end;
+end;
+
+procedure RemoveMenuItem(Menu: PMenu; I: PMenuItem);
+var P,PrevP: PMenuItem;
+begin
+  if (Menu=nil) or (I=nil) then Exit;
+  P:=Menu^.Items; PrevP:=nil;
+  while (P<>nil) do
+  begin
+    if P=I then
+      begin
+        if Menu^.Items<>I then PrevP^.Next:=P^.Next
+                          else Menu^.Items:=P^.Next;
+        DisposeMenuItem(P);
+        Break;
+      end;
+    PrevP:=P; P:=P^.Next;
+  end;
+end;
+
+function GetMenuItemBefore(Menu: PMenu; BeforeOf: PMenuItem): PMenuItem;
+var P,C: PMenuItem;
+begin
+  P:=nil;
+  if Menu<>nil then C:=Menu^.Items else C:=nil;
+  while (C<>nil) do
+    begin
+      if C^.Next=BeforeOf then begin P:=C; Break; end;
+      C:=C^.Next;
+    end;
+  GetMenuItemBefore:=P;
+end;
+
+procedure TAdvancedStaticText.SetText(S: string);
+begin
+  if Text<>nil then DisposeStr(Text);
+  Text:=NewStr(S);
+  DrawView;
+end;
+
+procedure TAdvancedListBox.HandleEvent(var Event: TEvent);
+begin
+  case Event.What of
+    evMouseDown :
+      if MouseInView(Event.Where) and (Event.Double) then
+      begin
+        inherited HandleEvent(Event);
+        if Range>Focused then SelectItem(Focused);
+      end;
+    evBroadcast :
+      case Event.Command of
+        cmListItemSelected :
+          Message(Owner,evBroadcast,cmDefault,nil);
+      end;
+  end;
+  inherited HandleEvent(Event);
+end;
+
+constructor TColorStaticText.Init(var Bounds: TRect; AText: String; AColor: word);
+begin
+  inherited Init(Bounds,AText);
+  Color:=AColor;
+end;
+
+procedure TColorStaticText.Draw;
+var
+  C: word;
+  Center: Boolean;
+  I, J, L, P, Y: Integer;
+  B: TDrawBuffer;
+  S: String;
+  T: string;
+  CurS: string;
+  TildeCount,Po: integer;
+  TempS: string;
+begin
+  if Size.X=0 then Exit;
+  if DontWrap=false then
+ begin
+  C:=Color;
+  GetText(S);
+  L := Length(S);
+  P := 1;
+  Y := 0;
+  Center := False;
+  while Y < Size.Y do
+  begin
+    MoveChar(B, ' ', Lo(C), 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) do Inc(P);
+      until (P > L) or (P >= I + Size.X) or (S[P] = #13);
+      TildeCount:=0; TempS:=copy(S,I,P-I);
+      repeat
+        Po:=Pos('~',TempS);
+        if Po>0 then begin Inc(TildeCount); Delete(TempS,1,Po); end;
+      until Po=0;
+      if P > I + Size.X + TildeCount then
+        if J > I then P := J else P := I + Size.X;
+      T:=copy(S,I,P-I);
+      if Center then J := (Size.X - {P + I}CStrLen(T)) div 2 else J := 0;
+      MoveCStr(B[J],T,C);
+      while (P <= L) and (S[P] = ' ') do Inc(P);
+      if (P <= L) and (S[P] = #13) then
+      begin
+        Center := False;
+        Inc(P);
+        if (P <= L) and (S[P] = #10) then Inc(P);
+      end;
+    end;
+    WriteLine(0, Y, Size.X, 1, B);
+    Inc(Y);
+  end;
+ end { Wrap=false } else
+ begin
+  C := Color;
+  GetText(S);
+  I:=1;
+  for Y:=0 to Size.Y-1 do
+  begin
+    MoveChar(B, ' ', C, Size.X);
+    CurS:='';
+    if S<>'' then
+    begin
+    P:=Pos(#13,S);
+    if P=0 then P:=length(S)+1;
+    CurS:=copy(S,1,P-1);
+    CurS:=copy(CurS,Delta.X+1,255);
+    CurS:=copy(CurS,1,MaxViewWidth);
+    Delete(S,1,P);
+    end;
+    if CurS<>'' then MoveCStr(B,CurS,C);
+    WriteLine(0,Y,Size.X,1,B);
+  end;
+ end;
+end;
+
+procedure TUnsortedStringCollection.FreeItem(Item: Pointer);
+begin
+  if Item<>nil then DisposeStr(Item);
+end;
+
+constructor THSListBox.Init(var Bounds: TRect; ANumCols: Word; AHScrollBar, AVScrollBar: PScrollBar);
+begin
+  inherited Init(Bounds,ANumCols,AVScrollBar);
+  HScrollBar:=AHScrollBar;
+end;
+
+constructor TDlgWindow.Init(var Bounds: TRect; ATitle: TTitleStr; ANumber: Integer);
+begin
+  inherited Init(Bounds,ATitle);
+  Number:=ANumber;
+  Flags:=Flags or (wfMove + wfGrow + wfClose + wfZoom);
+end;
+
+constructor TMessageListBox.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
+begin
+  inherited Init(Bounds,1,AHScrollBar, AVScrollBar);
+  NoSelection:=true;
+end;
+
+procedure TMessageListBox.AddItem(P: PMessageItem);
+var W: integer;
+begin
+  if List=nil then New(List, Init(500,500));
+  W:=length(P^.GetText(255));
+  if W>MaxWidth then
+  begin
+    MaxWidth:=W;
+    if HScrollBar<>nil then
+       HScrollBar^.SetRange(0,MaxWidth);
+  end;
+  List^.Insert(P);
+  SetRange(List^.Count);
+  if Focused=List^.Count-1-1 then
+     FocusItem(List^.Count-1);
+  DrawView;
+end;
+
+function TMessageListBox.GetText(Item: Integer; MaxLen: Integer): String;
+var P: PMessageItem;
+    S: string;
+begin
+  P:=List^.At(Item);
+  S:=P^.GetText(MaxLen);
+  GetText:=copy(S,1,MaxLen);
+end;
+
+procedure TMessageListBox.Clear;
+begin
+  if List<>nil then Dispose(List, Done); List:=nil; MaxWidth:=0;
+  SetRange(0); DrawView;
+end;
+
+procedure TMessageListBox.Draw;
+var
+  I, J, Item: Integer;
+  NormalColor, SelectedColor, FocusedColor, Color: Word;
+  ColWidth, CurCol, Indent: Integer;
+  B: TDrawBuffer;
+  Text: String;
+  SCOff: Byte;
+  TC: byte;
+procedure MT(var C: word); begin if TC<>0 then C:=(C and $ff0f) or (TC and $f0); end;
+begin
+  if (Owner<>nil) then TC:=ord(Owner^.GetColor(6)) else TC:=0;
+  if State and (sfSelected + sfActive) = (sfSelected + sfActive) then
+  begin
+    NormalColor := GetColor(1);
+    FocusedColor := GetColor(3);
+    SelectedColor := GetColor(4);
+  end else
+  begin
+    NormalColor := GetColor(2);
+    SelectedColor := GetColor(4);
+  end;
+  if Transparent then
+    begin MT(NormalColor); MT(SelectedColor); end;
+  if NoSelection then
+     SelectedColor:=NormalColor;
+  if HScrollBar <> nil then Indent := HScrollBar^.Value
+  else Indent := 0;
+  ColWidth := Size.X div NumCols + 1;
+  for I := 0 to Size.Y - 1 do
+  begin
+    for J := 0 to NumCols-1 do
+    begin
+      Item := J*Size.Y + I + TopItem;
+      CurCol := J*ColWidth;
+      if (State and (sfSelected + sfActive) = (sfSelected + sfActive)) and
+        (Focused = Item) and (Range > 0) then
+      begin
+        Color := FocusedColor;
+        SetCursor(CurCol+1,I);
+        SCOff := 0;
+      end
+      else if (Item < Range) and IsSelected(Item) then
+      begin
+        Color := SelectedColor;
+        SCOff := 2;
+      end
+      else
+      begin
+        Color := NormalColor;
+        SCOff := 4;
+      end;
+      MoveChar(B[CurCol], ' ', Color, ColWidth);
+      if Item < Range then
+      begin
+        Text := GetText(Item, ColWidth + Indent);
+        Text := Copy(Text,Indent,ColWidth);
+        MoveStr(B[CurCol+1], Text, Color);
+        if ShowMarkers then
+        begin
+          WordRec(B[CurCol]).Lo := Byte(SpecialChars[SCOff]);
+          WordRec(B[CurCol+ColWidth-2]).Lo := Byte(SpecialChars[SCOff+1]);
+        end;
+      end;
+      MoveChar(B[CurCol+ColWidth-1], #179, GetColor(5), 1);
+    end;
+    WriteLine(0, I, Size.X, 1, B);
+  end;
+end;
+
+destructor TMessageListBox.Done;
+begin
+  inherited Done;
+  if List<>nil then Dispose(List, Done);
+end;
+
+constructor TMessageItem.Init(AClass: longint; AText, AModule: string; AID: longint);
+begin
+  inherited Init;
+  TClass:=AClass;
+  Text:=NewStr(AText); Module:=NewStr(AModule); ID:=AID;
+end;
+
+function TMessageItem.GetText(MaxLen: integer): string;
+var S: string;
+begin
+  if Text=nil then S:='' else S:=Text^;
+  if length(S)>MaxLen then S:=copy(S,1,MaxLen-2)+'..';
+  GetText:=S;
+end;
+
+procedure TMessageItem.Selected;
+begin
+end;
+
+destructor TMessageItem.Done;
+begin
+  inherited Done;
+  if Text<>nil then DisposeStr(Text);
+end;
+
+function TCompilerMessage.GetText(MaxLen: Integer): String;
+var ClassS: string[20];
+    S: string;
+begin
+  if TClass=
+    V_Fatal       then ClassS:='Fatal'       else if TClass =
+    V_Error       then ClassS:='Error'       else if TClass =
+    V_Normal      then ClassS:=''            else if TClass =
+    V_Warning     then ClassS:='Warning'     else if TClass =
+    V_Note        then ClassS:='Note'        else if TClass =
+    V_Hint        then ClassS:='Hint'        else if TClass =
+    V_Macro       then ClassS:='Macro'       else if TClass =
+    V_Procedure   then ClassS:='Procedure'   else if TClass =
+    V_Conditional then ClassS:='Conditional' else if TClass =
+    V_Info        then ClassS:='Info'        else if TClass =
+    V_Status      then ClassS:='Status'      else if TClass =
+    V_Used        then ClassS:='Used'        else if TClass =
+    V_Tried       then ClassS:='Tried'       else if TClass =
+    V_Debug       then ClassS:='Debug'
+  else ClassS:='???';
+  if ClassS<>'' then ClassS:=RExpand(ClassS,0)+': ';
+  S:=ClassS;
+  if (Module<>nil) and (ID<>0) then
+     S:=S+Module^+' ('+IntToStr(ID)+'): ';
+  if Text<>nil then S:=ClassS+Text^;
+  if length(S)>MaxLen then S:=copy(S,1,MaxLen-2)+'..';
+  GetText:=S;
+end;
+
+constructor TProgramInfoWindow.Init;
+var R,R2: TRect;
+    HSB,VSB: PScrollBar;
+    ST: PStaticText;
+begin
+  Desktop^.GetExtent(R); R.A.Y:=R.B.Y-13;
+  inherited Init(R, 'Program Information', wnNoNumber);
+
+  GetExtent(R); R.Grow(-1,-1); Inc(R.A.Y,4); R.B.Y:=R.A.Y+1;
+  New(ST, Init(R, CharStr('Ä', MaxViewWidth))); ST^.GrowMode:=gfGrowHiX; Insert(ST);
+  GetExtent(R); R.Grow(-1,-1); Inc(R.A.Y,5);
+  R2.Copy(R); Inc(R2.B.Y); R2.A.Y:=R2.B.Y-1;
+  New(HSB, Init(R2)); HSB^.GrowMode:=gfGrowLoY+gfGrowHiY+gfGrowHiX; Insert(HSB);
+  R2.Copy(R); Inc(R2.B.X); R2.A.X:=R2.B.X-1;
+  New(VSB, Init(R2)); VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY; Insert(VSB);
+  New(LogLB, Init(R,HSB,VSB));
+  LogLB^.GrowMode:=gfGrowHiX+gfGrowHiY;
+  LogLB^.Transparent:=true;
+  Insert(LogLB);
+end;
+
+procedure TProgramInfoWindow.AddMessage(AClass: longint; Msg, Module: string; Line: longint);
+begin
+  if AClass>=V_Info then Line:=0;
+  LogLB^.AddItem(New(PCompilerMessage, Init(AClass, Msg, Module, Line)));
+end;
+
+procedure TProgramInfoWindow.SizeLimits(var Min, Max: TPoint);
+begin
+  inherited SizeLimits(Min,Max);
+  Min.Y:=9;
+end;
+
+procedure TProgramInfoWindow.Close;
+begin
+  Hide;
+end;
+
+function TAdvancedStatusLine.GetStatusText: string;
+var S: string;
+begin
+  if StatusText=nil then S:='' else S:=StatusText^;
+  GetStatusText:=S;
+end;
+
+procedure TAdvancedStatusLine.SetStatusText(S: string);
+begin
+  if StatusText<>nil then DisposeStr(StatusText);
+  StatusText:=NewStr(S);
+  DrawView;
+end;
+
+procedure TAdvancedStatusLine.ClearStatusText;
+begin
+  SetStatusText('');
+end;
+
+procedure TAdvancedStatusLine.Draw;
+var B: TDrawBuffer;
+    C: word;
+    S: string;
+begin
+  S:=GetStatusText;
+  if S='' then inherited Draw else
+  begin
+    C:=GetColor(1);
+    MoveChar(B,' ',C,Size.X);
+    MoveStr(B[1],S,C);
+    WriteLine(0,0,Size.X,Size.Y,B);
+  end;
+end;
+
+constructor TTab.Init(var Bounds: TRect; ATabDef: PTabDef);
+begin
+  inherited Init(Bounds);
+  Options:=Options or ofSelectable or ofFirstClick or ofPreProcess or ofPostProcess;
+  GrowMode:=gfGrowHiX+gfGrowHiY+gfGrowRel;
+  TabDefs:=ATabDef;
+  ActiveDef:=-1;
+  SelectTab(0);
+  ReDraw;
+end;
+
+function TTab.TabCount: integer;
+var i: integer;
+    P: PTabDef;
+begin
+  I:=0; P:=TabDefs;
+  while (P<>nil) do
+    begin
+      Inc(I);
+      P:=P^.Next;
+    end;
+  TabCount:=I;
+end;
+
+function TTab.AtTab(Index: integer): PTabDef;
+var i: integer;
+    P: PTabDef;
+begin
+  i:=0; P:=TabDefs;
+  while (I<Index) do
+    begin
+      if P=nil then RunError($AA);
+      P:=P^.Next;
+      Inc(i);
+    end;
+  AtTab:=P;
+end;
+
+procedure TTab.SelectTab(Index: integer);
+var P: PTabItem;
+    V: PView;
+begin
+  if ActiveDef<>Index then
+  begin
+    if Owner<>nil then Owner^.Lock;
+    Lock;
+    { --- Update --- }
+    if TabDefs<>nil then
+       begin
+         DefCount:=1;
+         while AtTab(DefCount-1)^.Next<>nil do Inc(DefCount);
+       end
+       else DefCount:=0;
+    if ActiveDef<>-1 then
+    begin
+      P:=AtTab(ActiveDef)^.Items;
+      while P<>nil do
+        begin
+          if P^.View<>nil then Delete(P^.View);
+          P:=P^.Next;
+        end;
+    end;
+    ActiveDef:=Index;
+    P:=AtTab(ActiveDef)^.Items;
+    while P<>nil do
+      begin
+        if P^.View<>nil then Insert(P^.View);
+        P:=P^.Next;
+      end;
+    V:=AtTab(ActiveDef)^.DefItem;
+    if V<>nil then V^.Select;
+    ReDraw;
+    { --- Update --- }
+    UnLock;
+    if Owner<>nil then Owner^.UnLock;
+    DrawView;
+  end;
+end;
+
+procedure TTab.ChangeBounds(var Bounds: TRect);
+var D: TPoint;
+procedure DoCalcChange(P: PView); {$ifndef FPC}far;{$endif}
+var
+  R: TRect;
+begin
+  if P^.Owner=nil then Exit; { it think this is a bug in TV }
+  P^.CalcBounds(R, D);
+  P^.ChangeBounds(R);
+end;
+var
+    P: PTabItem;
+    I: integer;
+begin
+  D.X := Bounds.B.X - Bounds.A.X - Size.X;
+  D.Y := Bounds.B.Y - Bounds.A.Y - Size.Y;
+  inherited ChangeBounds(Bounds);
+  for I:=0 to TabCount-1 do
+  if I<>ActiveDef then
+    begin
+      P:=AtTab(I)^.Items;
+      while P<>nil do
+        begin
+          if P^.View<>nil then DoCalcChange(P^.View);
+          P:=P^.Next;
+        end;
+    end;
+end;
+
+procedure TTab.HandleEvent(var Event: TEvent);
+var Index : integer;
+    I     : integer;
+    X     : integer;
+    Len   : byte;
+    P     : TPoint;
+    V     : PView;
+    CallOrig: boolean;
+    LastV : PView;
+    FirstV: PView;
+function FirstSelectable: PView;
+var
+    FV : PView;
+begin
+  FV := First;
+  while (FV<>nil) and ((FV^.Options and ofSelectable)=0) and (FV<>Last) do
+        FV:=FV^.Next;
+  if FV<>nil then
+    if (FV^.Options and ofSelectable)=0 then FV:=nil;
+  FirstSelectable:=FV;
+end;
+function LastSelectable: PView;
+var
+    LV : PView;
+begin
+  LV := Last;
+  while (LV<>nil) and ((LV^.Options and ofSelectable)=0) and (LV<>First) do
+        LV:=LV^.Prev;
+  if LV<>nil then
+    if (LV^.Options and ofSelectable)=0 then LV:=nil;
+  LastSelectable:=LV;
+end;
+begin
+  if (Event.What and evMouseDown)<>0 then
+     begin
+       MakeLocal(Event.Where,P);
+       if P.Y<3 then
+          begin
+            Index:=-1; X:=1;
+            for i:=0 to DefCount-1 do
+                begin
+                  Len:=CStrLen(AtTab(i)^.Name^);
+                  if (P.X>=X) and (P.X<=X+Len+1) then Index:=i;
+                  X:=X+Len+3;
+                end;
+            if Index<>-1 then
+               SelectTab(Index);
+          end;
+     end;
+  if Event.What=evKeyDown then
+     begin
+       Index:=-1;
+       case Event.KeyCode of
+            kbTab,kbShiftTab  :
+              if GetState(sfSelected) then
+                 begin
+                   if Current<>nil then
+                   begin
+                   LastV:=LastSelectable; FirstV:=FirstSelectable;
+                   if ((Current=LastV) or (Current=PLabel(LastV)^.Link)) and (Event.KeyCode=kbShiftTab) then
+                      begin
+                        if Owner<>nil then Owner^.SelectNext(true);
+                      end else
+                   if ((Current=FirstV) or (Current=PLabel(FirstV)^.Link)) and (Event.KeyCode=kbTab) then
+                      begin
+                        Lock;
+                        if Owner<>nil then Owner^.SelectNext(false);
+                        UnLock;
+                      end else
+                   SelectNext(Event.KeyCode=kbShiftTab);
+                   ClearEvent(Event);
+                   end;
+                 end;
+       else
+       for I:=0 to DefCount-1 do
+           begin
+             if Upcase(GetAltChar(Event.KeyCode))=AtTab(I)^.ShortCut
+                then begin
+                       Index:=I;
+                       ClearEvent(Event);
+                       Break;
+                     end;
+           end;
+       end;
+       if Index<>-1 then
+          begin
+            Select;
+            SelectTab(Index);
+            V:=AtTab(ActiveDef)^.DefItem;
+            if V<>nil then V^.Focus;
+          end;
+     end;
+  CallOrig:=true;
+  if Event.What=evKeyDown then
+     begin
+     if ((Owner<>nil) and (Owner^.Phase=phPostProcess) and (GetAltChar(Event.KeyCode)<>#0)) or GetState(sfFocused)
+        then
+        else CallOrig:=false;
+     end;
+  if CallOrig then inherited HandleEvent(Event);
+end;
+
+function TTab.GetPalette: PPalette;
+begin
+  GetPalette:=nil;
+end;
+
+procedure TTab.Draw;
+var B          : TDrawBuffer;
+    i          : integer;
+    C1,C2,C3,C : word;
+    HeaderLen  : integer;
+    X,X2       : integer;
+    Name       : PString;
+    ActiveKPos : integer;
+    ActiveVPos : integer;
+    FC         : char;
+    ClipR      : TRect;
+procedure SWriteBuf(X,Y,W,H: integer; var Buf);
+var i: integer;
+begin
+  if Y+H>Size.Y then H:=Size.Y-Y;
+  if X+W>Size.X then W:=Size.X-X;
+  if Buffer=nil then WriteBuf(X,Y,W,H,Buf)
+                else for i:=1 to H do
+                         Move(Buf,Buffer^[X+(Y+i-1)*Size.X],W*2);
+end;
+procedure ClearBuf;
+begin
+  MoveChar(B,' ',C1,Size.X);
+end;
+begin
+  if InDraw then Exit;
+  InDraw:=true;
+  { - Start of TGroup.Draw - }
+  if Buffer = nil then
+  begin
+    GetBuffer;
+  end;
+  { - Start of TGroup.Draw - }
+
+  C1:=GetColor(1); C2:=(GetColor(7) and $f0 or $08)+GetColor(9)*256; C3:=GetColor(8)+GetColor({9}8)*256;
+  HeaderLen:=0; for i:=0 to DefCount-1 do HeaderLen:=HeaderLen+CStrLen(AtTab(i)^.Name^)+3; Dec(HeaderLen);
+  if HeaderLen>Size.X-2 then HeaderLen:=Size.X-2;
+
+  { --- 1. sor --- }
+  ClearBuf; MoveChar(B[0],'³',C1,1); MoveChar(B[HeaderLen+1],'³',C1,1);
+  X:=1;
+  for i:=0 to DefCount-1 do
+      begin
+        Name:=AtTab(i)^.Name; X2:=CStrLen(Name^);
+        if i=ActiveDef
+           then begin
+                  ActiveKPos:=X-1;
+                  ActiveVPos:=X+X2+2;
+                  if GetState(sfFocused) then C:=C3 else C:=C2;
+                end
+           else C:=C2;
+        MoveCStr(B[X],' '+Name^+' ',C); X:=X+X2+3;
+        MoveChar(B[X-1],'³',C1,1);
+      end;
+  SWriteBuf(0,1,Size.X,1,B);
+
+  { --- 0. sor --- }
+  ClearBuf; MoveChar(B[0],'Ú',C1,1);
+  X:=1;
+  for i:=0 to DefCount-1 do
+      begin
+        if I<ActiveDef then FC:='Ú'
+                       else FC:='¿';
+        X2:=CStrLen(AtTab(i)^.Name^)+2;
+        MoveChar(B[X+X2],{'Â'}FC,C1,1);
+        if i=DefCount-1 then X2:=X2+1;
+        if X2>0 then
+        MoveChar(B[X],'Ä',C1,X2);
+        X:=X+X2+1;
+      end;
+  MoveChar(B[HeaderLen+1],'¿',C1,1);
+  MoveChar(B[ActiveKPos],'Ú',C1,1); MoveChar(B[ActiveVPos],'¿',C1,1);
+  SWriteBuf(0,0,Size.X,1,B);
+
+  { --- 2. sor --- }
+  MoveChar(B[1],'Ä',C1,Max(HeaderLen,0)); MoveChar(B[HeaderLen+2],'Ä',C1,Max(Size.X-HeaderLen-3,0));
+  MoveChar(B[Size.X-1],'¿',C1,1);
+  MoveChar(B[ActiveKPos],'Ù',C1,1);
+  if ActiveDef=0 then MoveChar(B[0],'³',C1,1)
+                 else MoveChar(B[0],{'Ã'}'Ú',C1,1);
+  MoveChar(B[HeaderLen+1],'Ä'{'Á'},C1,1); MoveChar(B[ActiveVPos],'À',C1,1);
+  MoveChar(B[ActiveKPos+1],' ',C1,Max(ActiveVPos-ActiveKPos-1,0));
+  SWriteBuf(0,2,Size.X,1,B);
+
+  { --- marad‚k sor --- }
+  ClearBuf; MoveChar(B[0],'³',C1,1); MoveChar(B[Size.X-1],'³',C1,1);
+  SWriteBuf(0,3,Size.X,Size.Y-4,B);
+
+  { --- Size.X . sor --- }
+  MoveChar(B[0],'À',C1,1); MoveChar(B[1],'Ä',C1,Max(Size.X-2,0)); MoveChar(B[Size.X-1],'Ù',C1,1);
+  SWriteBuf(0,Size.Y-1,Size.X,1,B);
+
+  { - End of TGroup.Draw - }
+  if Buffer <> nil then
+  begin
+    Lock;
+    Redraw;
+    UnLock;
+  end;
+  if Buffer <> nil then WriteBuf(0, 0, Size.X, Size.Y, Buffer^) else
+  begin
+    GetClipRect(ClipR);
+    Redraw;
+    GetExtent(ClipR);
+  end;
+  { - End of TGroup.Draw - }
+  InDraw:=false;
+end;
+
+function TTab.Valid(Command: Word): Boolean;
+var PT : PTabDef;
+    PI : PTabItem;
+    OK : boolean;
+begin
+  OK:=true;
+  PT:=TabDefs;
+  while (PT<>nil) and (OK=true) do
+        begin
+          PI:=PT^.Items;
+          while (PI<>nil) and (OK=true) do
+                begin
+                  if PI^.View<>nil then OK:=OK and PI^.View^.Valid(Command);
+                  PI:=PI^.Next;
+                end;
+          PT:=PT^.Next;
+        end;
+  Valid:=OK;
+end;
+
+procedure TTab.SetState(AState: Word; Enable: Boolean);
+begin
+  inherited SetState(AState,Enable);
+  if (AState and sfFocused)<>0 then DrawView;
+end;
+
+destructor TTab.Done;
+var P,X: PTabDef;
+procedure DeleteViews(P: PView); {$ifndef FPC}far;{$endif}
+begin
+  if P<>nil then Delete(P);
+end;
+begin
+  ForEach(@DeleteViews);
+  inherited Done;
+  P:=TabDefs;
+  while P<>nil do
+        begin
+          X:=P^.Next;
+          DisposeTabDef(P);
+          P:=X;
+        end;
+end;
+
+
+END.
+{
+  $Log$
+  Revision 1.1  1998-12-22 14:27:54  peter
+    * moved
+
+  Revision 1.4  1998/12/22 10:39:53  peter
+    + options are now written/read
+    + find and replace routines
+
+}

ide/text/makefile.fpc

@@ -0,0 +1,663 @@
+#
+#   $Id$
+#   Copyright (c) 1998 by the Free Pascal Development Team
+#
+#   Common makefile for Free Pascal
+#
+#   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.
+#
+
+#####################################################################
+# Force default settings
+#####################################################################
+
+# Latest release version
+override RELEASEVER:=0.99.9
+
+#####################################################################
+# Autodetect OS (Linux or Dos or Windows NT)
+# define inlinux when running under linux
+# define inWinNT when running under WinNT
+#####################################################################
+
+PWD=$(strip $(wildcard $(addsuffix /pwd.exe,$(subst ;, ,$(PATH)))))
+ifeq ($(PWD),)
+PWD=$(strip $(wildcard $(addsuffix /pwd,$(subst :, ,$(PATH)))))
+ifeq ($(PWD),)
+nopwd:
+	@echo
+	@echo You need the GNU pwd,cp,mv,rm,install utils to use this makefile!
+	@echo Get ftp://tflily.fys.kuleuven.ac.be/pub/fpc/dist/gnuutils.zip
+	@echo
+	@exit
+else
+inlinux=1
+endif
+else
+PWD:=$(subst \,/,$(firstword $(PWD)))
+endif
+
+# Detect NT - NT sets OS to Windows_NT
+ifndef inlinux
+ifeq ($(OS),Windows_NT)
+inWinNT=1
+endif
+endif
+
+
+#####################################################################
+# Targets
+#####################################################################
+
+# Target OS
+ifndef OS_TARGET
+ifdef inlinux
+OS_TARGET=linux
+else
+ifdef inWinNT
+OS_TARGET=win32
+else
+OS_TARGET=go32v2
+endif
+endif
+endif
+
+# Source OS
+ifndef OS_SOURCE
+ifdef inlinux
+OS_SOURCE=linux
+else
+ifndef inWinNT
+OS_SOURCE=win32
+else
+OS_SOURCE=go32v2
+endif
+endif
+endif
+
+# CPU
+ifndef CPU
+CPU=i386
+endif
+
+# Options
+ifndef OPT
+OPT=
+endif
+
+# What compiler to use ?
+ifndef PP
+PP=ppc386
+endif
+
+# assembler, redefine it if cross compiling
+ifndef AS
+AS=as
+endif
+
+# linker, but probably not used 
+ifndef LD
+LD=ld
+endif
+
+# Release ? Then force OPT and don't use extra opts via commandline
+ifdef RELEASE
+override OPT:=-Xs -OG2p2 -n
+endif
+
+# Verbose settings (warning,note,info)
+ifdef VERBOSE
+override OPT+=-vwni
+endif
+
+#####################################################################
+# Shell commands
+#####################################################################
+
+# To copy pograms
+ifndef COPY
+COPY=cp -fp
+endif
+
+# To move pograms
+ifndef MOVE
+MOVE=mv -f
+endif
+
+# Check delete program
+ifndef DEL
+DEL=rm -f
+endif
+
+# Check deltree program
+ifndef DELTREE
+DELTREE=rm -rf
+endif
+
+# To install files
+ifndef INSTALL
+ifdef inlinux
+INSTALL=install -m 644
+else
+INSTALL=$(COPY)
+# ginstall has the strange thing to stubify all .o files !
+#INSTALL=ginstall -m 644
+endif
+endif
+
+# To install programs
+ifndef INSTALLEXE
+ifdef inlinux
+INSTALLEXE=install -m 755
+else
+INSTALLEXE=$(COPY)
+# ginstall has the strange thing to stubify all .o files !
+#INSTALLEXE=ginstall -m 755
+endif
+endif
+
+# To make a directory.
+ifndef MKDIR
+ifdef inlinux
+MKDIR=install -m 755 -d
+else
+MKDIR=ginstall -m 755 -d
+endif
+endif
+
+
+#####################################################################
+# Default Tools
+#####################################################################
+
+# ppas.bat / ppas.sh
+ifdef inlinux
+PPAS=ppas.sh
+else
+PPAS=ppas.bat
+endif
+
+# ldconfig to rebuild .so cache
+ifdef inlinux
+LDCONFIG=ldconfig
+else
+LDCONFIG=
+endif
+
+# Where is the ppumove program ?
+ifndef PPUMOVE
+PPUMOVE=ppumove
+endif
+
+# diff
+ifndef DIFF
+DIFF=diff
+endif
+
+# date
+ifndef DATE
+# first try go32v2 specific gdate
+DATE=$(strip $(wildcard $(addsuffix /gdate.exe,$(subst ;, ,$(PATH)))))
+# try generic date.exe
+ifeq ($(DATE),)
+DATE=$(strip $(wildcard $(addsuffix /date.exe,$(subst ;, ,$(PATH)))))
+# finally try for linux
+ifeq ($(DATE),)
+DATE=$(strip $(wildcard $(addsuffix /date,$(subst :, ,$(PATH)))))
+ifeq ($(DATE),)
+DATE=
+endif
+else
+DATE:=$(subst \,/,$(firstword $(DATE)))
+endif
+else
+DATE:=$(subst \,/,$(firstword $(DATE)))
+endif
+endif
+
+# Sed
+ifndef SED
+SED=$(strip $(wildcard $(addsuffix /sed.exe,$(subst ;, ,$(PATH)))))
+ifeq ($(SED),)
+SED=$(strip $(wildcard $(addsuffix /sed,$(subst :, ,$(PATH)))))
+ifeq ($(SED),)
+SED=
+endif
+else
+SED:=$(subst \,/,$(firstword $(SED)))
+endif
+endif
+
+
+#####################################################################
+# Default Directories
+#####################################################################
+
+# Base dir
+ifdef PWD
+BASEDIR=$(shell $(PWD))
+endif
+
+# set the directory to the rtl base
+ifndef RTLDIR
+ifdef RTL
+RTLDIR=$(RTL)
+else
+RTLDIR:=$(BASEDIR)/../rtl
+endif
+endif
+
+# specify where units are.
+ifndef UNITDIR
+UNITDIR=$(RTLDIR)/$(OS_TARGET)
+ifeq ($(OS_TARGET),go32v1)
+UNITDIR=$(RTLDIR)/dos/go32v1
+endif
+ifeq ($(OS_TARGET),go32v2)
+UNITDIR=$(RTLDIR)/dos/go32v2
+endif
+endif
+
+# set the prefix directory where to install everything
+ifndef PREFIXINSTALLDIR
+ifdef inlinux
+PREFIXINSTALLDIR=/usr
+else
+PREFIXINSTALLDIR=/pp
+endif
+endif
+
+# set the base directory where to install everything
+ifndef BASEINSTALLDIR
+ifdef inlinux
+BASEINSTALLDIR=$(PREFIXINSTALLDIR)/lib/fpc/$(RELEASEVER)
+else
+BASEINSTALLDIR=$(PREFIXINSTALLDIR)
+endif
+endif
+
+
+#####################################################################
+# Install Directories based on BASEINSTALLDIR
+#####################################################################
+
+# Linux binary really goes to baseinstalldir
+ifndef LIBINSTALLDIR
+ifdef inlinux
+LIBINSTALLDIR=$(BASEINSTALLDIR)
+else
+LIBINSTALLDIR=$(BASEINSTALLDIR)/lib
+endif
+endif
+
+# set the directory where to install the binaries
+ifndef BININSTALLDIR
+ifdef inlinux
+BININSTALLDIR=$(PREFIXINSTALLDIR)/bin
+else
+BININSTALLDIR=$(BASEINSTALLDIR)/bin/$(OS_TARGET)
+endif
+endif
+
+# set the directory where to install the units.
+ifndef UNITINSTALLDIR
+ifdef inlinux
+UNITINSTALLDIR=$(BASEINSTALLDIR)/linuxunits
+else
+UNITINSTALLDIR=$(BASEINSTALLDIR)/rtl/$(OS_TARGET)
+endif
+endif
+
+# set the directory where to install the units.
+ifndef STATIC_UNITINSTALLDIR
+ifdef inlinux
+STATIC_UNITINSTALLDIR=$(BASEINSTALLDIR)/staticunits
+else
+STATIC_UNITINSTALLDIR=$(BASEINSTALLDIR)/rtl/$(OS_TARGET)/static
+endif
+endif
+
+# set the directory where to install the units.
+ifndef SHARED_UNITINSTALLDIR
+ifdef inlinux
+SHARED_UNITINSTALLDIR=$(BASEINSTALLDIR)/sharedunits
+else
+SHARED_UNITINSTALLDIR=$(BASEINSTALLDIR)/rtl/$(OS_TARGET)/shared
+endif
+endif
+
+# set the directory where to install the libs (must exist)
+ifndef STATIC_LIBINSTALLDIR
+ifdef inlinux
+STATIC_LIBINSTALLDIR=$(BASEINSTALLDIR)/staticunits
+else
+STATIC_LIBINSTALLDIR=$(STATIC_UNITINSTALLDIR)
+endif
+endif
+
+# set the directory where to install the libs (must exist)
+ifndef SHARED_LIBINSTALLDIR
+ifdef inlinux
+SHARED_LIBINSTALLDIR=$(PREFIXINSTALLDIR)/lib
+else
+SHARED_LIBINSTALLDIR=$(SHARED_UNITINSTALLDIR)
+endif
+endif
+
+# Where the .msg files will be stored
+ifndef MSGINSTALLDIR
+ifdef inlinux
+MSGINSTALLDIR=$(BASEINSTALLDIR)/msg
+else
+MSGINSTALLDIR=$(BININSTALLDIR)
+endif
+endif
+
+# Where the doc files will be stored
+ifndef DOCINSTALLDIR
+ifdef inlinux
+DOCINSTALLDIR=$(PREFIXINSTALLDIR)/doc/fpc/$(RELEASEVER)
+else
+DOCINSTALLDIR=$(BASEINSTALLDIR)/doc
+endif
+endif
+
+
+#####################################################################
+# Compiler Command Line
+#####################################################################
+
+# Load commandline OPTDEF and add CPU define
+override PPOPTDEF=$(OPTDEF) -d$(CPU)
+
+# Load commandline OPT and add target and unit dir to be sure
+override PPOPT=$(OPT) -T$(OS_TARGET) -Fu$(UNITDIR) $(NEEDOPT)
+
+# Add include dirs INC and PROCINC
+ifdef INC
+override PPOPT+=-I$(INC)
+endif
+ifdef PROCINC
+override PPOPT+=-I$(PROCINC)
+endif
+ifdef OSINC
+override PPOPT+=-I$(OSINC)
+endif
+
+# Target dirs
+ifdef TARGETDIR
+override PPOPT+=-FE$(TARGETDIR)
+endif
+ifdef UNITTARGETDIR
+override PPOPT+=-FU$(UNITTARGETDIR)
+endif
+
+# Smartlinking
+ifeq ($(SMARTLINK),YES)
+ifeq ($(LIBTYPE),shared)
+override SMARTLINK=NO
+else
+override PPOPT+=-Cx
+endif
+endif
+
+# Add library type, for static libraries smartlinking is automatic used
+ifeq ($(LIBTYPE),shared)
+override PPOPT+=-CD
+else
+ifeq ($(LIBTYPE),static)
+override PPOPT+=-CS
+endif
+endif
+
+# Add library name
+ifneq ($(LIBNAME),)
+override PPOPT:=$(PPOPT) -o$(LIBNAME)
+endif
+
+# Add defines from PPOPTDEF to PPOPT
+override PPOPT:=$(PPOPT) $(PPOPTDEF)
+
+# Was a config file specified ?
+ifdef CFGFILE
+override PPOPT:=$(PPOPT) @$(CFGFILE)
+endif
+
+override COMPILER=$(PP) $(PPOPT)
+
+
+#####################################################################
+# Default extensions
+#####################################################################
+
+# Default needed extensions (Go32v2,Linux)
+PPLEXT=.ppl
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.so
+
+# Executable extension
+ifdef inlinux
+EXEEXT=
+else
+EXEEXT=.exe
+endif
+
+# Go32v1
+ifeq ($(OS_TARGET),go32v1)
+PPUEXT=.pp1
+OEXT=.o1
+ASMEXT=.s1
+SMARTEXT=.sl1
+STATICLIBEXT=.a1
+SHAREDLIBEXT=.so1
+endif
+
+# Win32
+ifeq ($(OS_TARGET),win32)
+PPUEXT=.ppw
+OEXT=.ow
+ASMEXT=.sw
+SMARTEXT=.slw
+STATICLIBEXT=.aw
+SHAREDLIBEXT=.dll
+endif
+
+# OS/2
+ifeq ($(OS_TARGET),os2)
+PPUEXT=.ppo
+ASMEXT=.so2
+OEXT=.o2
+SMARTEXT=.so
+STATICLIBEXT=.ao
+SHAREDLIBEXT=.dll
+endif
+
+# determine libary extension.
+ifeq ($(LIBTYPE),static)
+LIBEXT=$(STATICLIBEXT)
+else
+LIBEXT=$(SHAREDLIBEXT)
+endif
+
+# library prefix
+LIBPREFIX=lib
+ifeq ($(OS_TARGET),go32v2)
+LIBPREFIX=
+endif
+ifeq ($(OS_TARGET),go32v1)
+LIBPREFIX=
+endif
+
+# determine with .pas extension is used
+ifdef EXEOBJECTS
+override TESTPAS:=$(strip $(wildcard $(addsuffix .pas,$(firstword $(EXEOBJECTS)))))
+else
+override TESTPAS:=$(strip $(wildcard $(addsuffix .pas,$(firstword $(UNITOBJECTS)))))
+endif
+
+ifeq ($(TESTPAS),)
+PASEXT=.pp
+else
+PASEXT=.pas
+endif
+
+
+#####################################################################
+# Export commandline values, so nesting use the same values
+#####################################################################
+
+export OS_SOURCE OS_TARGET OPT OPTDEF CPU PP RELEASE VERBOSE
+export SMARTLINK LIBTYPE LIBNAME
+export BASEINSTALLDIR
+
+
+#####################################################################
+# General compile rules
+#####################################################################
+
+# Create Filenames
+EXEFILES=$(addsuffix $(EXEEXT),$(EXEOBJECTS))
+UNITFILES=$(addsuffix $(PPUEXT),$(UNITOBJECTS))
+UNITOFILES=$(addsuffix $(OEXT),$(UNITOBJECTS))
+
+.PHONY : all clean install \
+         info cfginfo objectinfo installinfo filesinfo
+
+.SUFFIXES : $(EXEEXT) $(PPUEXT) $(PASEXT)
+
+ifdef DEFAULTUNITS
+all: units
+else
+all: units exes
+endif
+
+units: $(UNITFILES)
+
+exes: $(EXEFILES)
+
+# General compile rules
+%$(PPUEXT): %$(PASEXT)
+	$(COMPILER) $<
+
+%$(EXEEXT): %$(PASEXT)
+	$(COMPILER) $<
+
+
+
+#####################################################################
+# Install rules
+#####################################################################
+
+install : all
+ifdef EXEOBJECTS
+	$(MKDIR) $(BININSTALLDIR)
+	$(INSTALLEXE) $(EXEFILES) $(BININSTALLDIR)
+endif
+ifdef UNITOBJECTS
+	$(MKDIR) $(UNITINSTALLDIR)
+ifeq ($(SMARTLINK),YES)
+	$(INSTALL) $(LIBPREFIX)$(LIBNAME)$(LIBEXT) $(UNITINSTALLDIR)
+else
+	$(INSTALL) $(UNITFILES) $(UNITOFILES) $(UNITINSTALLDIR)
+endif
+endif
+
+
+#####################################################################
+# Clean rules
+#####################################################################
+
+clean:
+	-$(DEL) *$(OEXT) *$(ASMEXT) *$(PPUEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) $(PPAS) link.res log
+	-$(DELTREE) *$(SMARTEXT)
+ifdef EXEOBJECTS
+	-$(DEL) $(EXEFILES)
+endif
+
+
+#####################################################################
+# Depend rules
+#####################################################################
+
+depend:
+	makedep $(UNITOBJECTS)
+
+#####################################################################
+# Info rules
+#####################################################################
+
+info: cfginfo objectinfo installinfo
+
+cfginfo:
+	@echo
+	@echo  == Configuration info ==
+	@echo
+	@echo  Source.... $(OS_SOURCE)
+	@echo  Target.... $(OS_TARGET)
+	@echo  Basedir... $(BASEDIR)
+	@echo  Pwd....... $(PWD)
+ifdef SED
+	@echo  Sed....... $(SED)
+endif
+	@echo
+
+objectinfo:
+	@echo
+	@echo  == Object info ==
+	@echo
+	@echo  UnitObjects... $(UNITOBJECTS)
+	@echo  ExeObjects.... $(EXEOBJECTS)
+	@echo
+
+installinfo:
+	@echo
+	@echo  == Install info ==
+	@echo
+	@echo  BaseInstallDir....... $(BASEINSTALLDIR)
+	@echo  BinInstallDir........ $(BININSTALLDIR)
+	@echo  UnitInstallDir....... $(UNITINSTALLDIR)
+	@echo  StaticUnitInstallDir. $(STATIC_UNITINSTALLDIR)
+	@echo  SharedUnitInstallDir. $(SHARED_UNITINSTALLDIR)
+	@echo  LibInstallDir........ $(LIBINSTALLDIR)
+	@echo  StaticLibInstallDir.. $(STATIC_LIBINSTALLDIR)
+	@echo  SharedLibInstallDir.. $(SHARED_LIBINSTALLDIR)
+	@echo  MsgInstallDir........ $(MSGINSTALLDIR)
+	@echo  DocInstallDir........ $(DOCINSTALLDIR)
+	@echo
+
+# try to get the files in the currentdir
+PASFILES:=$(wildcard *.pas)
+PPFILES:=$(wildcard *.pp)
+INCFILES:=$(wildcard *.inc)
+MSGFILES:=$(wildcard *.msg)
+ASFILES:=$(wildcard *.as)
+
+filesinfo:
+	@echo
+	@echo  == Files info ==
+	@echo
+ifdef PASFILES
+	@echo  Pas files are $(PASFILES)
+endif
+ifdef PPFILES
+	@echo  PP  files are $(PPFILES)
+endif
+ifdef INCFILES
+	@echo  Inc files are $(INCFILES)
+endif
+ifdef MSGFILES
+	@echo  Msg files are $(MSGFILES)
+endif
+ifdef ASFILES
+	@echo  As  files are $(ASFILES)
+endif
+

ide/text/program.pt

@@ -0,0 +1,6 @@
+program ;
+
+uses ;
+
+BEGIN
+END.

ide/text/test.pas

@@ -0,0 +1,7 @@
+program TestProgram;
+
+var Hello : word;
+
+BEGIN
+  writeln('Hello world!');
+END.

ide/text/unit.pt

@@ -0,0 +1,15 @@
+unit ;
+
+interface
+
+uses ;
+
+const
+
+type
+
+var
+
+implementation
+
+end.

ide/text/weditor.pas

@@ -0,0 +1,2657 @@
+{
+    $Id$
+    This file is part of the Free Pascal Integrated Development Environment
+    Copyright (c) 1998 by Berczi Gabor
+
+    Code editor template objects
+
+    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.
+
+ **********************************************************************}
+unit WEditor;
+
+interface
+
+{$ifndef FPC}
+  {$define TPUNIXLF}
+{$endif}
+
+uses
+  Objects,Drivers,Views,Commands;
+
+const
+      MaxLineLength = 255;
+      MaxLineCount  = 16380;
+
+      efBlockInsCursor      = $00000001;
+      efAutoIndent          = $00000002;
+      efPersistentBlocks    = $00000004;
+      efVerticalBlocks      = $00000008;
+      efUseTabCharacters    = $00000010;
+      efBackSpaceUnindents  = $00000020;
+      efSyntaxHighlight     = $00000040;
+      efAutoBrackets        = $00000080;
+      efHighlightColumn     = $00000100;
+      efHighlightRow        = $00000200;
+      efBackupFiles         = $00001000;
+
+      attrAsm       = 1;
+      attrComment   = 2;
+      attrForceFull = 128;
+      attrAll       = attrAsm+attrComment;
+
+      edOutOfMemory   = 0;
+      edReadError     = 1;
+      edWriteError    = 2;
+      edCreateError   = 3;
+      edSaveModify    = 4;
+      edSaveUntitled  = 5;
+      edSaveAs        = 6;
+      edFind          = 7;
+      edSearchFailed  = 8;
+      edReplace       = 9;
+      edReplacePrompt = 10;
+      edTooManyLines  = 11;
+      edGotoLine      = 12;
+
+      ffmOptions         = $0007; ffsOptions     = 0;
+      ffmDirection       = $0008; ffsDirection   = 3;
+      ffmScope           = $0010; ffsScope       = 4;
+      ffmOrigin          = $0020; ffsOrigin      = 5;
+      ffDoReplace        = $0040;
+      ffReplaceAll       = $0080;
+
+
+      ffCaseSensitive    = $0001;
+      ffWholeWordsOnly   = $0002;
+      ffPromptOnReplace  = $0004;
+
+      ffForward          = $0000;
+      ffBackward         = $0008;
+
+      ffGlobal           = $0000;
+      ffSelectedText     = $0010;
+
+      ffFromCursor       = $0000;
+      ffEntireScope      = $0020;
+
+      coTextColor         = 0;
+      coWhiteSpaceColor   = 1;
+      coCommentColor      = 2;
+      coReservedWordColor = 3;
+      coIdentifierColor   = 4;
+      coStringColor       = 5;
+      coNumberColor       = 6;
+      coAssemblerColor    = 7;
+      coSymbolColor       = 8;
+      coDirectiveColor    = 9;
+
+      coFirstColor        = 0;
+      coLastColor         = coDirectiveColor;
+
+      CIndicator          = #2#3;
+      CEditor             = #33#34#35#36#37#38#39#40#41#42#43#44#45#46#47#48;
+
+      TAB           = #9;
+
+type
+    PLine = ^TLine;
+    TLine = record
+      Text          : PString;
+      Format        : PString;
+      BeginsWithAsm,
+      EndsWithAsm   : boolean;
+      BeginsWithComment,
+      EndsWithComment : boolean;
+      BeginsWithDirective,
+      EndsWithDirective : boolean;
+    end;
+
+    PLineCollection = ^TLineCollection;
+    TLineCollection = object(TCollection)
+      function  At(Index: Integer): PLine;
+      procedure FreeItem(Item: Pointer); virtual;
+    end;
+
+    PIndicator = ^TIndicator;
+    TIndicator = object(TView)
+      Location: TPoint;
+      Modified: Boolean;
+      constructor Init(var Bounds: TRect);
+      procedure Draw; virtual;
+      function GetPalette: PPalette; virtual;
+      procedure SetState(AState: Word; Enable: Boolean); virtual;
+      procedure SetValue(ALocation: TPoint; AModified: Boolean);
+    end;
+
+    TSpecSymbolClass =
+      (ssCommentPrefix,ssCommentSuffix,ssStringPrefix,ssStringSuffix,
+       ssDirectivePrefix,ssDirectiveSuffix,ssAsmPrefix,ssAsmSuffix);
+
+    PCodeEditor = ^TCodeEditor;
+    TCodeEditor = object(TScroller)
+      Indicator  : PIndicator;
+      Lines      : PLineCollection;
+      SelStart   : TPoint;
+      SelEnd     : TPoint;
+      Highlight  : TRect;
+      CurPos     : TPoint;
+      CanUndo    : Boolean;
+      Modified   : Boolean;
+      IsReadOnly : Boolean;
+      Overwrite  : Boolean;
+      NoSelect   : Boolean;
+      Flags      : longint;
+      TabSize    : integer;
+      constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar:
+                    PScrollBar; AIndicator: PIndicator; AbufSize:Sw_Word);
+      procedure   ConvertEvent(var Event: TEvent); virtual;
+      procedure   HandleEvent(var Event: TEvent); virtual;
+      procedure   SetState(AState: Word; Enable: Boolean); virtual;
+      procedure   Draw; virtual;
+      procedure   DrawCursor; virtual;
+      procedure   TrackCursor(Center: boolean); virtual;
+      procedure   UpdateIndicator; virtual;
+      procedure   LimitsChanged; virtual;
+      procedure   SelectionChanged; virtual;
+      procedure   HighlightChanged; virtual;
+      procedure   ScrollTo(X, Y: Integer); virtual;
+      procedure   SetInsertMode(InsertMode: boolean); virtual;
+      procedure   SetCurPtr(X, Y: Integer); virtual;
+      procedure   SetSelection(A, B: TPoint); virtual;
+      procedure   SetHighlight(A, B: TPoint); virtual;
+      procedure   SelectAll(Enable: boolean); virtual;
+      function    InsertFrom(Editor: PCodeEditor): Boolean; virtual;
+      function    InsertText(S: string): Boolean; virtual;
+      function    GetPalette: PPalette; virtual;
+      function    IsClipboard: Boolean;
+      destructor  Done; virtual;
+    public
+      function    GetLineCount: integer; virtual;
+      function    GetLineText(I: integer): string; virtual;
+      procedure   SetLineText(I: integer; S: string); virtual;
+      function    GetLineFormat(I: integer): string; virtual;
+      procedure   SetLineFormat(I: integer; S: string); virtual;
+      function    GetErrorMessage: string; virtual;
+      procedure   SetErrorMessage(S: string); virtual;
+    private
+      KeyState: Integer;
+      ErrorMessage: PString;
+      function    GetLine(I: integer): PLine;
+      procedure   CheckSels;
+      function    UpdateAttrs(FromLine: integer; Attrs: byte): integer;
+      procedure   DrawLines(FirstLine: integer);
+      procedure   HideHighlight;
+    public
+     { Syntax highlight support }
+      function    GetSpecSymbolCount(SpecClass: TSpecSymbolClass): integer; virtual;
+      function    GetSpecSymbol(SpecClass: TSpecSymbolClass; Index: integer): string; virtual;
+      function    IsReservedWord(S: string): boolean; virtual;
+    public
+      SearchRunCount: integer;
+      procedure Indent; virtual;
+      procedure CharLeft; virtual;
+      procedure CharRight; virtual;
+      procedure WordLeft; virtual;
+      procedure WordRight; virtual;
+      procedure LineStart; virtual;
+      procedure LineEnd; virtual;
+      procedure LineUp; virtual;
+      procedure LineDown; virtual;
+      procedure PageUp; virtual;
+      procedure PageDown; virtual;
+      procedure TextStart; virtual;
+      procedure TextEnd; virtual;
+      function  InsertLine: Sw_integer; virtual;
+      procedure BackSpace; virtual;
+      procedure DelChar; virtual;
+      procedure DelWord; virtual;
+      procedure DelStart; virtual;
+      procedure DelEnd; virtual;
+      procedure DelLine; virtual;
+      procedure InsMode; virtual;
+      procedure StartSelect; virtual;
+      procedure EndSelect; virtual;
+      procedure DelSelect; virtual;
+      procedure HideSelect; virtual;
+      procedure CopyBlock; virtual;
+      procedure MoveBlock; virtual;
+      procedure AddChar(C: char); virtual;
+      function  ClipCopy: Boolean; virtual;
+      procedure ClipCut; virtual;
+      procedure ClipPaste; virtual;
+      procedure Undo; virtual;
+      procedure Find; virtual;
+      procedure Replace; virtual;
+      procedure DoSearchReplace; virtual;
+      procedure GotoLine; virtual;
+    end;
+
+    PFileEditor = ^TFileEditor;
+    TFileEditor = object(TCodeEditor)
+      FileName: string;
+      constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar:
+                    PScrollBar; AIndicator: PIndicator;AFileName: string);
+      function    Save: Boolean; virtual;
+      function    SaveAs: Boolean; virtual;
+      function    LoadFile: boolean; virtual;
+      function    SaveFile: boolean; virtual;
+      function    Valid(Command: Word): Boolean; virtual;
+      function    ShouldSave: boolean; virtual;
+    end;
+
+    TCodeEditorDialog = function(Dialog: Integer; Info: Pointer): Word;
+
+const
+     DefaulTCodeEditorFlags : longint =
+      efBackupFiles+efAutoIndent+efPersistentBlocks+efBackSpaceUnindents+efSyntaxHighlight;
+     DefaultTabSize     : integer = 8;
+
+     ToClipCmds         : TCommandSet = ([cmCut,cmCopy,cmClear]);
+     FromClipCmds       : TCommandSet = ([cmPaste]);
+     UndoCmds           : TCommandSet = ([cmUndo,cmRedo]);
+
+function StdEditorDialog(Dialog: Integer; Info: Pointer): word;
+
+const
+     EditorDialog       : TCodeEditorDialog = StdEditorDialog;
+     Clipboard          : PCodeEditor = nil;
+     FindStr            : String[80] = '';
+     ReplaceStr         : String[80] = '';
+     FindFlags          : word = ffPromptOnReplace;
+     WhiteSpaceChars    : set of char = [#0,#32,#255];
+     AlphaChars         : set of char = ['A'..'Z','a'..'z','_'];
+     NumberChars        : set of char = ['0'..'9'];
+
+implementation
+
+uses Dos,MsgBox,Dialogs,App,StdDlg,HistList,Validate;
+
+type
+     TFindDialogRec = record
+       Find: String[80];
+       Options: Word;
+       Direction: word;
+       Scope: word;
+       Origin: word;
+     end;
+
+     TReplaceDialogRec = record
+       Find: String[80];
+       Replace: String[80];
+       Options: Word;
+       Direction: word;
+       Scope: word;
+       Origin: word;
+     end;
+
+     TGotoLineDialogRec = record
+       LineNo  : string[5];
+       Lines   : integer;
+     end;
+
+const
+     kbShift = kbLeftShift+kbRightShift;
+
+const
+  FirstKeyCount = 36;
+  FirstKeys: array[0..FirstKeyCount * 2] of Word = (FirstKeyCount,
+    Ord(^A), cmWordLeft, Ord(^C), cmPageDown,
+    Ord(^D), cmCharRight, Ord(^E), cmLineUp,
+    Ord(^F), cmWordRight, Ord(^G), cmDelChar,
+    Ord(^H), cmBackSpace, Ord(^K), $FF02,
+    Ord(^L), cmSearchAgain, Ord(^M), cmNewLine,
+    Ord(^Q), $FF01,
+    Ord(^R), cmPageUp, Ord(^S), cmCharLeft,
+    Ord(^T), cmDelWord, Ord(^U), cmUndo,
+    Ord(^V), cmInsMode, Ord(^X), cmLineDown,
+    Ord(^Y), cmDelLine, kbLeft, cmCharLeft,
+    kbRight, cmCharRight, kbCtrlLeft, cmWordLeft,
+    kbCtrlRight, cmWordRight, kbHome, cmLineStart,
+    kbEnd, cmLineEnd, kbUp, cmLineUp,
+    kbDown, cmLineDown, kbPgUp, cmPageUp,
+    kbPgDn, cmPageDown, kbCtrlPgUp, cmTextStart,
+    kbCtrlPgDn, cmTextEnd, kbIns, cmInsMode,
+    kbDel, cmDelChar, kbShiftIns, cmPaste,
+    kbShiftDel, cmCut, kbCtrlIns, cmCopy,
+    kbCtrlDel, cmClear);
+  QuickKeyCount = 10;
+  QuickKeys: array[0..QuickKeyCount * 2] of Word = (QuickKeyCount,
+    Ord('A'), cmReplace, Ord('C'), cmTextEnd,
+    Ord('D'), cmLineEnd, Ord('F'), cmFind,
+    Ord('H'), cmDelStart, Ord('R'), cmTextStart,
+    Ord('S'), cmLineStart, Ord('Y'), cmDelEnd,
+    Ord('G'), cmJumpLine, Ord('P'), cmReplace );
+  BlockKeyCount = 6;
+  BlockKeys: array[0..BlockKeyCount * 2] of Word = (BlockKeyCount,
+    Ord('B'), cmStartSelect, Ord('C'), cmCopyBlock,
+    Ord('H'), cmHideSelect, Ord('K'), cmEndSelect,
+    Ord('Y'), cmDelSelect, Ord('V'), cmMoveBlock);
+  KeyMap: array[0..2] of Pointer = (@FirstKeys, @QuickKeys, @BlockKeys);
+
+function ScanKeyMap(KeyMap: Pointer; KeyCode: Word): Word;
+type
+  pword = ^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;
+
+function IsWordSeparator(C: char): boolean;
+begin
+  IsWordSeparator:=C in[' ',#0,#255,':','=','''','"','.',',','/',';','$','#','(',')','<','>','^','*','+','-','?','&'];
+end;
+
+function IsSpace(C: char): boolean;
+begin
+  IsSpace:=C in[' ',#0,#255];
+end;
+
+function EatIO: integer;
+begin
+  EatIO:=IOResult;
+end;
+
+function Max(A,B: longint): longint;
+begin
+  if A>B then Max:=A else Max:=B;
+end;
+
+function Min(A,B: longint): longint;
+begin
+  if A<B then Min:=A else Min:=B;
+end;
+
+function StrToInt(S: string): longint;
+var L: longint;
+    C: integer;
+begin
+  Val(S,L,C); if C<>0 then L:=-1;
+  StrToInt:=L;
+end;
+
+function CharStr(C: char; Count: byte): string;
+var S: string;
+begin
+  S[0]:=chr(Count);
+  FillChar(S[1],Count,C);
+  CharStr:=S;
+end;
+
+function RExpand(S: string; MinLen: byte): string;
+begin
+  if length(S)<MinLen then
+     S:=S+CharStr(' ',MinLen-length(S));
+  RExpand:=S;
+end;
+
+function RTrim(S: string): string;
+begin
+  while (length(S)>0) and (S[length(S)] in [' ',#0,#255]) do
+    Delete(S,length(S),1);
+  RTrim:=S;
+end;
+
+function DirAndNameOf(Path: string): string;
+var D: DirStr; N: NameStr; E: ExtStr;
+begin
+  FSplit(Path,D,N,E);
+  DirAndNameOf:=D+N;
+end;
+
+function PointOfs(P: TPoint): longint;
+begin
+  PointOfs:=longint(P.Y)*MaxLineLength+P.X;
+end;
+
+{$ifndef FPC}
+function Scan_F(var Block; Size: Word; Str: String): Word; near; assembler;
+asm
+        PUSH    DS
+        LES     DI,Block
+        LDS     SI,Str
+        MOV     CX,Size
+        JCXZ    @@3
+        CLD
+        LODSB
+        CMP     AL,1
+        JB      @@5
+        JA      @@1
+        LODSB
+        REPNE   SCASB
+        JNE     @@3
+        JMP     @@5
+@@1:    XOR     AH,AH
+        MOV     BX,AX
+        DEC     BX
+        MOV     DX,CX
+        SUB     DX,AX
+        JB      @@3
+        LODSB
+        INC     DX
+        INC     DX
+@@2:    DEC     DX
+        MOV     CX,DX
+        REPNE   SCASB
+        JNE     @@3
+        MOV     DX,CX
+        MOV     CX,BX
+        REP     CMPSB
+        JE      @@4
+        SUB     CX,BX
+        ADD     SI,CX
+        ADD     DI,CX
+        INC     DI
+        OR      DX,DX
+        JNE     @@2
+@@3:    XOR     AX,AX
+        JMP     @@6
+@@4:    SUB     DI,BX
+@@5:    MOV     AX,DI
+        SUB     AX,WORD PTR Block
+@@6:    DEC     AX
+        POP     DS
+end;
+
+function IScan_F(var Block; Size: Word; Str: String): Word; near; assembler;
+var
+  S: String;
+asm
+        PUSH    DS
+        MOV     AX,SS
+        MOV     ES,AX
+        LEA     DI,S
+        LDS     SI,Str
+        XOR     AH,AH
+        LODSB
+        STOSB
+        MOV     CX,AX
+        MOV     BX,AX
+        JCXZ    @@9
+@@1:    LODSB
+        CMP     AL,'a'
+        JB      @@2
+        CMP     AL,'z'
+        JA      @@2
+        SUB     AL,20H
+@@2:    STOSB
+        LOOP    @@1
+        SUB     DI,BX
+        LDS     SI,Block
+        MOV     CX,Size
+        JCXZ    @@8
+        CLD
+        SUB     CX,BX
+        JB      @@8
+        INC     CX
+@@4:    MOV     AH,ES:[DI]
+        AND     AH,$DF
+@@5:    LODSB
+        AND     AL,$DF
+        CMP     AL,AH
+        LOOPNE  @@5
+        JNE     @@8
+        DEC     SI
+        MOV     DX,CX
+        MOV     CX,BX
+@@6:    REPE    CMPSB
+        JE      @@10
+        MOV     AL,DS:[SI-1]
+        CMP     AL,'a'
+        JB      @@7
+        CMP     AL,'z'
+        JA      @@7
+        SUB     AL,20H
+@@7:    CMP     AL,ES:[DI-1]
+        JE      @@6
+        SUB     CX,BX
+        ADD     SI,CX
+        ADD     DI,CX
+        INC     SI
+        MOV     CX,DX
+        OR      CX,CX
+        JNE     @@4
+@@8:    XOR     AX,AX
+        JMP     @@11
+@@9:    MOV     AX, 1
+        JMP     @@11
+@@10:   SUB     SI,BX
+        MOV     AX,SI
+        SUB     AX,WORD PTR Block
+        INC     AX
+@@11:   DEC     AX
+        POP     DS
+end;
+
+function Scan_B(var Block; Size: Word; Str: String): Word; near; assembler;
+asm
+        PUSH    DS
+        LES     DI,Block
+        LDS     SI,Str
+        MOV     CX,Size
+        JCXZ    @@3
+        CLD
+        LODSB
+        CMP     AL,1
+        JB      @@5
+        JA      @@1
+        LODSB
+        STD
+        REPNE   SCASB
+        JNE     @@3
+        JMP     @@5
+@@1:    XOR     AH,AH
+        ADD     SI, AX    { !! }
+        DEC     SI
+        ADD     DI, CX    { !! }
+        DEC     DI
+        SUB     DI, AX
+        STD
+        MOV     BX,AX
+        DEC     BX
+        MOV     DX,CX
+{        SUB     DX,AX}
+        JB      @@3
+        LODSB
+        INC     DX
+        INC     DX
+@@2:    DEC     DX
+        MOV     CX,DX
+        REPNE   SCASB
+        JNE     @@3
+        MOV     DX,CX
+        MOV     CX,BX
+        REP     CMPSB
+        JE      @@4
+        SUB     CX,BX
+        SUB     SI,CX { ADD }
+        SUB     DI,CX { ADD }
+        DEC     DI    { INC DI }
+        OR      DX,DX
+        JNE     @@2
+@@3:    XOR     AX,AX
+        JMP     @@6
+@@4:    ADD     DI,BX
+@@5:    MOV     AX,DI
+        SUB     AX,WORD PTR Block
+@@6:    DEC     AX
+        POP     DS
+end;
+
+function IScan_B(var Block; Size: Word; Str: String): Word; near; assembler;
+var
+  S: String;
+asm
+        PUSH    DS
+        MOV     AX,SS
+        MOV     ES,AX
+        LEA     DI,S
+        LDS     SI,Str
+        XOR     AH,AH
+        LODSB
+        STOSB
+        MOV     CX,AX
+        MOV     BX,AX
+        JCXZ    @@9
+@@1:    LODSB
+        CMP     AL,'a'
+        JB      @@2
+        CMP     AL,'z'
+        JA      @@2
+        SUB     AL,20H
+@@2:    STOSB
+        LOOP    @@1
+        SUB     DI,BX
+        LDS     SI,Block
+        ADD     SI,Size
+        SUB     SI, BX
+        MOV     CX,Size
+        JCXZ    @@8
+        CLD
+        SUB     CX,BX
+        JB      @@8
+        INC     CX
+        ADD     SI, 2
+@@4:    SUB     SI, 2
+        MOV     AH,ES:[DI]
+        AND     AH,$DF
+        ADD     SI,2
+@@5:    SUB     SI,2
+        LODSB
+        AND     AL,$DF
+        CMP     AL,AH
+        LOOPNE  @@5
+        JNE     @@8
+        DEC     SI
+        MOV     DX,CX
+        MOV     CX,BX
+@@6:    REPE    CMPSB
+        JE      @@10
+        MOV     AL,DS:[SI-1]
+        CMP     AL,'a'
+        JB      @@7
+        CMP     AL,'z'
+        JA      @@7
+        SUB     AL,20H
+@@7:    CMP     AL,ES:[DI-1]
+        JE      @@6
+        SUB     CX,BX
+        ADD     SI,CX
+        ADD     DI,CX
+        INC     SI
+        MOV     CX,DX
+        OR      CX,CX
+        JNE     @@4
+@@8:    XOR     AX,AX
+        JMP     @@11
+@@9:    MOV     AX, 1
+        JMP     @@11
+@@10:   SUB     SI,BX
+        MOV     AX,SI
+        SUB     AX,WORD PTR Block
+        INC     AX
+@@11:   DEC     AX
+        POP     DS
+end;
+
+
+function PosB(SubS, InS: string; CaseSensitive: boolean): byte;
+var W: word;
+begin
+  if CaseSensitive then W:=Scan_B(InS[1],length(Ins),SubS)
+                   else W:=IScan_B(InS[1],length(Ins),SubS);
+  if W=$ffff then W:=0 else W:=W+1;
+  PosB:=W;
+end;
+
+function PosF(SubS, InS: string; CaseSensitive: boolean): byte;
+var W: word;
+begin
+  if CaseSensitive then W:=Scan_F(InS[1],length(Ins),SubS)
+                   else W:=IScan_F(InS[1],length(Ins),SubS);
+  if W=$ffff then W:=0 else W:=W+1;
+  PosF:=W;
+end;
+
+{$else}
+
+function PosB(SubS, InS: string; CaseSensitive: boolean): byte;
+begin
+  PosB:=0;
+end;
+
+function PosF(SubS, InS: string; CaseSensitive: boolean): byte;
+begin
+  PosF:=0;
+end;
+
+{$endif}
+
+
+function NewLine(S: string): PLine;
+var P: PLine;
+begin
+  New(P); FillChar(P^,SizeOf(P^),0);
+  P^.Text:=NewStr(S);
+  NewLine:=P;
+end;
+
+procedure DisposeLine(P: PLine);
+begin
+  if P<>nil then
+  begin
+    if P^.Text<>nil then DisposeStr(P^.Text);
+    if P^.Format<>nil then DisposeStr(P^.Format);
+    Dispose(P);
+  end;
+end;
+
+function TLineCollection.At(Index: Integer): PLine;
+begin
+  At:=inherited At(Index);
+end;
+
+procedure TLineCollection.FreeItem(Item: Pointer);
+begin
+  if Item<>nil then DisposeLine(Item);
+end;
+
+constructor TIndicator.Init(var Bounds: TRect);
+begin
+  inherited Init(Bounds);
+  GrowMode := gfGrowLoY + gfGrowHiY;
+end;
+
+procedure TIndicator.Draw;
+var
+  Color: Byte;
+  Frame: Char;
+  L: array[0..1] of Longint;
+  S: String[15];
+  B: TDrawBuffer;
+begin
+  Color := GetColor(1);
+  if (State and sfDragging = 0) and (State and sfActive <> 0) then
+  begin
+    Frame := #205;
+  end else
+  begin
+    if (State and sfDragging)<>0 then Color := GetColor(2);
+    Frame := #196;
+  end;
+  MoveChar(B, Frame, Color, Size.X);
+  if Modified then WordRec(B[0]).Lo := 15;
+  L[0] := Location.Y + 1;
+  L[1] := Location.X + 1;
+  FormatStr(S, ' %d:%d ', L);
+  MoveStr(B[8 - Pos(':', S)], S, Color);
+  WriteBuf(0, 0, Size.X, 1, B);
+end;
+
+function TIndicator.GetPalette: PPalette;
+const
+  P: string[Length(CIndicator)] = CIndicator;
+begin
+  GetPalette := @P;
+end;
+
+procedure TIndicator.SetState(AState: Word; Enable: Boolean);
+begin
+  inherited SetState(AState, Enable);
+  if (AState = sfDragging) or (AState=sfActive) then DrawView;
+end;
+
+procedure TIndicator.SetValue(ALocation: TPoint; AModified: Boolean);
+begin
+  if (Location.X<>ALocation.X) or
+     (Location.Y<>ALocation.Y) or
+     (Modified <> AModified) then
+  begin
+    Location := ALocation;
+    Modified := AModified;
+    DrawView;
+  end;
+end;
+
+constructor TCodeEditor.Init(var Bounds: TRect; AHScrollBar, AVScrollBar:
+                    PScrollBar; AIndicator: PIndicator; AbufSize:Sw_Word);
+begin
+  inherited Init(Bounds,AHScrollBar,AVScrollBar);
+  SetState(sfCursorVis,true);
+  Flags:=DefaulTCodeEditorFlags; TabSize:=DefaultTabSize;
+  Indicator:=AIndicator;
+  New(Lines, Init(500,1000));
+  UpdateIndicator; LimitsChanged;
+end;
+
+function TCodeEditor.GetErrorMessage: string;
+var S: string;
+begin
+  if ErrorMessage=nil then S:='' else S:=ErrorMessage^;
+  GetErrorMessage:=S;
+end;
+
+procedure TCodeEditor.SetErrorMessage(S: string);
+begin
+  if ErrorMessage<>nil then DisposeStr(ErrorMessage);
+  ErrorMessage:=NewStr(S);
+  DrawView;
+end;
+
+procedure TCodeEditor.TrackCursor(Center: boolean);
+var D: TPoint;
+begin
+  D:=Delta;
+  if CurPos.Y<Delta.Y then D.Y:=CurPos.Y else
+   if CurPos.Y>Delta.Y+Size.Y-1 then D.Y:=CurPos.Y-Size.Y+1;
+  if CurPos.X<Delta.X then D.X:=CurPos.X else
+   if CurPos.X>Delta.X+Size.X-1 then D.X:=CurPos.X-Size.X+1;
+  if ((Delta.X<>D.X) or (Delta.Y<>D.Y)) and Center then
+  begin
+     while (CurPos.Y-D.Y)<(Size.Y div 2) do Dec(D.Y);
+     while (CurPos.Y-D.Y)>(Size.Y div 2) do Inc(D.Y);
+  end;
+  if (Delta.X<>D.X) or (Delta.Y<>D.Y) then
+    ScrollTo(D.X,D.Y);
+  DrawCursor;
+  UpdateIndicator;
+end;
+
+procedure TCodeEditor.ScrollTo(X, Y: Integer);
+begin
+  inherited ScrollTo(X,Y);
+  if (HScrollBar=nil) or (VScrollBar=nil) then
+     begin Delta.X:=X; Delta.Y:=Y; end;
+  DrawView;
+end;
+
+procedure TCodeEditor.UpdateIndicator;
+begin
+  if Indicator<>nil then
+  begin
+    Indicator^.Location:=CurPos;
+    Indicator^.Modified:=Modified;
+    Indicator^.DrawView;
+  end;
+end;
+
+procedure TCodeEditor.LimitsChanged;
+begin
+  SetLimit(MaxLineLength+1,GetLineCount);
+end;
+
+procedure TCodeEditor.ConvertEvent(var Event: TEvent);
+var
+  Key: Word;
+begin
+  if Event.What = evKeyDown then
+  begin
+    if (GetShiftState and kbShift <> 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;
+
+procedure TCodeEditor.HandleEvent(var Event: TEvent);
+var DontClear : boolean;
+procedure CheckScrollBar(P: PScrollBar; var D: Sw_Integer);
+begin
+  if (Event.InfoPtr = P) and (P^.Value <> D) then
+  begin
+    D := P^.Value;
+    DrawView;
+  end;
+end;
+var StartP,P: TPoint;
+procedure GetMousePos(var P: TPoint);
+begin
+  MakeLocal(Event.Where,P);
+  Inc(P.X,Delta.X); Inc(P.Y,Delta.Y);
+end;
+begin
+  ConvertEvent(Event);
+  case Event.What of
+    evMouseDown :
+      if MouseInView(Event.Where) then
+      if Event.Buttons=mbLeftButton then
+      begin
+        GetMousePos(P);
+        StartP:=P;
+        SetCurPtr(P.X,P.Y);
+        repeat
+          GetMousePos(P);
+          if PointOfs(P)<PointOfs(StartP)
+             then SetSelection(P,StartP)
+             else SetSelection(StartP,P);
+          SetCurPtr(P.X,P.Y);
+          DrawView;
+        until not MouseEvent(Event, evMouseMove+evMouseAuto);
+        DrawView;
+      end;
+    evKeyDown :
+      begin
+        DontClear:=false;
+        case Event.KeyCode of
+          kbTab : begin Indent; ClearEvent(Event); end;
+        else if Event.CharCode in[#32..#255] then
+                begin NoSelect:=true; AddChar(Event.CharCode); NoSelect:=false; end
+               else DontClear:=true;
+        end;
+        if DontClear=false then ClearEvent(Event);
+      end;
+    evCommand :
+      begin
+        DontClear:=false;
+        case Event.Command of
+          cmCharLeft    : CharLeft;
+          cmCharRight   : CharRight;
+          cmWordLeft    : WordLeft;
+          cmWordRight   : WordRight;
+          cmLineStart   : LineStart;
+          cmLineEnd     : LineEnd;
+          cmLineUp      : LineUp;
+          cmLineDown    : LineDown;
+          cmPageUp      : PageUp;
+          cmPageDown    : PageDown;
+          cmTextStart   : TextStart;
+          cmTextEnd     : TextEnd;
+          cmNewLine     : InsertLine;
+          cmBackSpace   : BackSpace;
+          cmDelChar     : DelChar;
+          cmDelWord     : DelWord;
+          cmDelStart    : DelStart;
+          cmDelEnd      : DelEnd;
+          cmDelLine     : DelLine;
+          cmInsMode     : InsMode;
+          cmStartSelect : StartSelect;
+          cmHideSelect  : HideSelect;
+          cmUpdateTitle : ;
+          cmEndSelect   : EndSelect;
+          cmDelSelect   : DelSelect;
+          cmCopyBlock   : CopyBlock;
+          cmMoveBlock   : MoveBlock;
+        { ------ }
+          cmFind        : Find;
+          cmReplace     : Replace;
+          cmSearchAgain : DoSearchReplace;
+          cmJumpLine    : GotoLine;
+        { ------ }
+          cmCut         : ClipCut;
+          cmCopy        : ClipCopy;
+          cmPaste       : ClipPaste;
+          cmUndo        : Undo;
+          cmClear       : DelSelect;
+        else DontClear:=true;
+        end;
+        if DontClear=false then ClearEvent(Event);
+      end;
+    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;
+  end;
+end;
+
+procedure TCodeEditor.Draw;
+var SelectColor,
+    HighlightColColor,
+    HighlightRowColor,
+    ErrorMessageColor  : word;
+    B: TDrawBuffer;
+    X,Y,AX,AY,MaxX: integer;
+    PX: TPoint;
+    LineCount: integer;
+    Line: PLine;
+    LineText,Format: string;
+    C: char;
+    FreeFormat: array[0..255] of boolean;
+    Color: word;
+    ColorTab: array[coFirstColor..coLastColor] of word;
+    ErrorLine: integer;
+    ErrorMsg: string[MaxViewWidth];
+const NulLine : TLine = (Text: nil; Format: nil);
+begin
+  ErrorMsg:=copy(GetErrorMessage,1,MaxViewWidth);
+  if ErrorMsg='' then ErrorLine:=-1 else
+  if (CurPos.Y-Delta.Y)<(Size.Y div 2) then ErrorLine:=Size.Y-1
+     else ErrorLine:=0;
+  LineCount:=GetLineCount;
+  ColorTab[coTextColor]:=GetColor(1);
+  ColorTab[coWhiteSpaceColor]:=GetColor(2);
+  ColorTab[coCommentColor]:=GetColor(3);
+  ColorTab[coReservedWordColor]:=GetColor(4);
+  ColorTab[coIdentifierColor]:=GetColor(5);
+  ColorTab[coStringColor]:=GetColor(6);
+  ColorTab[coNumberColor]:=GetColor(7);
+  ColorTab[coAssemblerColor]:=GetColor(8);
+  ColorTab[coSymbolColor]:=GetColor(9);
+  ColorTab[coDirectiveColor]:=GetColor(13);
+  SelectColor:=GetColor(10);
+  HighlightColColor:=GetColor(11); HighlightRowColor:=GetColor(12);
+  ErrorMessageColor:=GetColor(16);
+  for Y:=0 to Size.Y-1 do
+  if Y=ErrorLine then
+  begin
+    MoveChar(B,' ',ErrorMessageColor,Size.X);
+    MoveStr(B,ErrorMsg,ErrorMessageColor);
+    WriteLine(0,Y,Size.X,1,B);
+  end else
+  begin
+    AY:=Delta.Y+Y;
+    Color:=ColorTab[coTextColor];
+    FillChar(FreeFormat,SizeOf(FreeFormat),true);
+    MoveChar(B,' ',Color,Size.X);
+    if AY<LineCount then Line:=GetLine(AY) else Line:=@NulLine;
+    LineText:=GetLineText(AY);
+    Format:=GetLineFormat(AY);
+
+    if (Flags and efSyntaxHighlight)<>0 then MaxX:=length(LineText)+1
+       else MaxX:=Size.X+Delta.X;
+    for X:=1 to Min(MaxX,255) do
+    begin
+      AX:=Delta.X+X-1;
+      if X<=length(LineText) then C:=LineText[X] else C:=' ';
+
+      PX.X:=AX-Delta.X; PX.Y:=AY;
+      if (Highlight.A.X<>Highlight.B.X) or (Highlight.A.Y<>Highlight.B.Y) then
+      begin
+         if (PointOfs(Highlight.A)<=PointOfs(PX)) and (PointOfs(PX)<PointOfs(Highlight.B)) then
+         begin
+            Color:=SelectColor;
+            FreeFormat[X]:=false;
+         end;
+      end else
+      { no highlight }
+      begin
+        if (Flags and efVerticalBlocks<>0) then
+           begin
+             if (SelStart.X<=AX) and (AX<=SelEnd.X) and
+                (SelStart.Y<=AY) and (AY<=SelEnd.Y) then
+                begin Color:=SelectColor; FreeFormat[X]:=false; end;
+           end else
+         if PointOfs(SelStart)<>PointOfs(SelEnd) then
+          if (PointOfs(SelStart)<=PointOfs(PX)) and (PointOfs(PX)<PointOfs(SelEnd)) then
+             begin Color:=SelectColor; FreeFormat[X]:=false; end;
+      end;
+      if ( ((Flags and efHighlightRow)   <>0) and (AY=CurPos.Y) ) then
+         begin Color:=(Color and $f0)  or (HighlightRowColor and $0f); FreeFormat[X]:=false; end;
+      if ( ((Flags and efHighlightColumn)<>0) and (AX=CurPos.X) ) then
+         begin Color:=HighlightColColor; FreeFormat[X]:=false; end;
+
+      if FreeFormat[X] then
+         if X<=length(Format) then
+            Color:=ColorTab[ord(Format[X])] else Color:=ColorTab[coTextColor];
+
+      if (0<=X-1-Delta.X) and (X-1-Delta.X<MaxViewWidth) then
+      MoveChar(B[X-1-Delta.X],C,Color,1);
+    end;
+    WriteLine(0,Y,Size.X,1,B);
+  end;
+  DrawCursor;
+end;
+
+procedure TCodeEditor.DrawCursor;
+begin
+  SetCursor(CurPos.X-Delta.X,CurPos.Y-Delta.Y);
+  SetState(sfCursorIns,Overwrite);
+end;
+
+function TCodeEditor.GetLineCount: integer;
+begin
+  GetLineCount:=Lines^.Count;
+end;
+
+function TCodeEditor.GetLine(I: integer): PLine;
+begin
+  GetLine:=Lines^.At(I);
+end;
+
+function TCodeEditor.GetLineText(I: integer): string;
+var S: string;
+    L: PLine;
+    P: byte;
+    TabS: string;
+begin
+  if I<Lines^.Count then
+  begin
+    L:=Lines^.At(I);
+    if L^.Text=nil then S:='' else S:=L^.Text^;
+  end else S:='';
+  if ((Flags and efUseTabCharacters)<>0) and (TabSize>0) then
+  begin
+     TabS:=CharStr(' ',TabSize);
+    repeat
+      P:=Pos(TAB,S);
+      if P<>0 then
+           S:=copy(S,1,P-1)+TabS+copy(S,P+1,255);
+    until P=0;
+  end;
+  GetLineText:=S;
+end;
+
+procedure TCodeEditor.SetLineText(I: integer; S: string);
+var L: PLine;
+    TabS: string;
+    P: byte;
+    AddCount: word;
+begin
+  AddCount:=0;
+  while (Lines^.Count<I+1) do
+    begin Lines^.Insert(NewLine('')); Inc(AddCount); end;
+  if AddCount>0 then LimitsChanged;
+  L:=Lines^.At(I);
+  if L^.Text<>nil then DisposeStr(L^.Text);
+  if ((Flags and efUseTabCharacters)<>0) and (TabSize>0) then
+  begin
+    TabS:=CharStr(' ',TabSize);
+    repeat
+      P:=Pos(TabS,S);
+      if P>0 then
+         S:=copy(S,1,P-1)+TAB+copy(S,P+TabSize,255);
+    until P=0;
+  end;
+  L^.Text:=NewStr(S);
+end;
+
+function TCodeEditor.GetLineFormat(I: integer): string;
+var P: PLine;
+    S: string;
+begin
+  if I<GetLineCount then P:=Lines^.At(I) else P:=nil;
+  if (P=nil) or (P^.Format=nil) then S:='' else
+     S:=P^.Format^;
+  GetLineFormat:=S;
+end;
+
+procedure TCodeEditor.SetLineFormat(I: integer; S: string);
+var P: PLine;
+begin
+  if I<GetLineCount then
+  begin
+    P:=Lines^.At(I);
+    if P^.Format<>nil then DisposeStr(P^.Format);
+    P^.Format:=NewStr(S);
+  end;
+end;
+
+function TCodeEditor.GetSpecSymbolCount(SpecClass: TSpecSymbolClass): integer;
+begin
+  GetSpecSymbolCount:=0;
+end;
+
+function TCodeEditor.GetSpecSymbol(SpecClass: TSpecSymbolClass; Index: integer): string;
+begin
+  GetSpecSymbol:='';
+  Abstract;
+end;
+
+function TCodeEditor.IsReservedWord(S: string): boolean;
+begin
+  IsReservedWord:=false;
+end;
+
+procedure TCodeEditor.Indent;
+var S, PreS: string;
+    Shift: integer;
+begin
+  S:=GetLineText(CurPos.Y);
+  if CurPos.Y>0 then PreS:=RTrim(GetLineText(CurPos.Y-1)) else PreS:='';
+  if CurPos.X>=length(PreS) then Shift:=TabSize else
+    begin
+      Shift:=1;
+      while (CurPos.X+Shift<length(PreS)) and (PreS[CurPos.X+Shift]<>#32) do
+            Inc(Shift);
+    end;
+  SetLineText(CurPos.Y,RExpand(copy(S,1,CurPos.X+1),CurPos.X+1)+CharStr(' ',Shift)+copy(S,CurPos.X+2,255));
+  SetCurPtr(CurPos.X+Shift,CurPos.Y);
+  UpdateAttrs(CurPos.Y,attrAll);
+  DrawLines(CurPos.Y);
+  Modified:=true;
+  UpdateIndicator;
+end;
+
+procedure TCodeEditor.CharLeft;
+begin
+  if CurPos.X>0 then
+     SetCurPtr(CurPos.X-1,CurPos.Y);
+end;
+
+procedure TCodeEditor.CharRight;
+begin
+  if CurPos.X<MaxLineLength then
+     SetCurPtr(CurPos.X+1,CurPos.Y);
+end;
+
+procedure TCodeEditor.WordLeft;
+var X, Y: integer;
+    Line: string;
+    GotIt,FoundNonSeparator: boolean;
+begin
+  X:=CurPos.X; Y:=CurPos.Y; GotIt:=false;
+  FoundNonSeparator:=false;
+  while (Y>=0) do
+  begin
+    if Y=CurPos.Y then
+       begin
+         X:=length(GetLineText(Y)); if CurPos.X<X then X:=CurPos.X; Dec(X);
+         if (X=-1) then
+            begin Dec(Y); if Y>=0 then X:=length(GetLineText(Y)); Break; end;
+       end else X:=length(GetLineText(Y))-1;
+    Line:=GetLineText(Y);
+    while (X>=0) and (GotIt=false) do
+    begin
+      if FoundNonSeparator then
+      begin
+         if IsWordSeparator(Line[X+1]) then begin Inc(X); GotIt:=true; Break; end;
+      end else
+      if IsWordSeparator(Line[X+1])=false then FoundNonSeparator:=true;
+      Dec(X);
+      if (X=0) and (IsWordSeparator(Line[1])=false) then
+         begin GotIt:=true; Break; end;
+    end;
+    if GotIt then Break;
+    X:=0;
+    Dec(Y);
+    if Y>=0 then begin X:=length(GetLineText(Y)); Break; end;
+  end;
+  if Y<0 then Y:=0; if X<0 then X:=0;
+  SetCurPtr(X,Y);
+end;
+
+procedure TCodeEditor.WordRight;
+var X, Y: integer;
+    Line: string;
+    GotIt: boolean;
+begin
+  X:=CurPos.X; Y:=CurPos.Y; GotIt:=false;
+  while (Y<GetLineCount) do
+  begin
+    if Y=CurPos.Y then
+       begin
+         X:=CurPos.X; Inc(X);
+         if (X>length(GetLineText(Y))-1) then
+            begin Inc(Y); X:=0; end;
+       end else X:=0;
+    Line:=GetLineText(Y);
+    while (X<=length(Line)+1) and (GotIt=false) and (Line<>'') do
+    begin
+      if X=length(Line)+1 then begin GotIt:=true; Dec(X); Break end;
+      if IsWordSeparator(Line[X]) then
+         begin
+           while (Y<GetLineCount) and
+                 (X<=length(Line)) and (IsWordSeparator(Line[X])) do
+                 begin
+                   Inc(X);
+                   if X>=length(Line) then
+                      begin GotIt:=true; Dec(X); Break; end;
+                 end;
+           if (GotIt=false) and (X<length(Line)) then
+           begin
+             Dec(X);
+             GotIt:=true;
+             Break;
+           end;
+         end;
+      Inc(X);
+    end;
+    if GotIt then Break;
+    X:=0;
+    Inc(Y);
+    if (Y<GetLineCount) then
+    begin
+      Line:=GetLineText(Y);
+      if (Line<>'') and (IsWordSeparator(Line[1])=false) then Break;
+    end;
+  end;
+  if Y=GetLineCount then Y:=GetLineCount-1;
+  SetCurPtr(X,Y);
+end;
+
+procedure TCodeEditor.LineStart;
+begin
+  SetCurPtr(0,CurPos.Y);
+end;
+
+procedure TCodeEditor.LineEnd;
+begin
+  if CurPos.Y<GetLineCount
+     then SetCurPtr(length(GetLineText(CurPos.Y)),CurPos.Y)
+     else SetCurPtr(0,CurPos.Y);
+end;
+
+procedure TCodeEditor.LineUp;
+begin
+  if CurPos.Y>0 then
+     SetCurPtr(CurPos.X,CurPos.Y-1);
+end;
+
+procedure TCodeEditor.LineDown;
+begin
+  if CurPos.Y<GetLineCount-1 then
+     SetCurPtr(CurPos.X,CurPos.Y+1);
+end;
+
+procedure TCodeEditor.PageUp;
+begin
+  ScrollTo(Delta.X,Max(Delta.Y-Size.Y,0));
+  SetCurPtr(CurPos.X,Max(0,CurPos.Y-(Size.Y)));
+end;
+
+procedure TCodeEditor.PageDown;
+begin
+  ScrollTo(Delta.X,Min(Delta.Y+Size.Y,GetLineCount-1));
+  SetCurPtr(CurPos.X,Min(GetLineCount-1,CurPos.Y+(Size.Y{-1})));
+end;
+
+procedure TCodeEditor.TextStart;
+begin
+  SetCurPtr(0,0);
+end;
+
+procedure TCodeEditor.TextEnd;
+begin
+  SetCurPtr(length(GetLineText(GetLineCount-1)),GetLineCount-1);
+end;
+
+function TCodeEditor.InsertLine: Sw_integer;
+var Ind: Sw_integer;
+    S,IndentStr: string;
+procedure CalcIndent(LineOver: Sw_integer);
+begin
+  if (LineOver<0) or (LineOver>GetLineCount) then Ind:=0 else
+  begin
+    IndentStr:=GetLineText(LineOver);
+    Ind:=0;
+    while (Ind<length(IndentStr)) and (IndentStr[Ind+1]=#32) do
+          Inc(Ind);
+  end;
+  IndentStr:=CharStr(' ',Ind);
+end;
+var SelBack: integer;
+begin
+  if IsReadOnly then begin InsertLine:=-1; Exit; end;
+  if CurPos.Y<GetLineCount then S:=GetLineText(CurPos.Y) else S:='';
+  if Overwrite=false then
+  begin
+    SelBack:=0;
+    if GetLineCount>0 then
+    begin
+      S:=GetLineText(CurPos.Y);
+      SelBack:=length(S)-SelEnd.X;
+      while (length(S)>0) and (S[length(S)]=' ') do
+        Delete(S,length(S),1);
+      SetLineText(CurPos.Y, S);
+    end;
+    CalcIndent(CurPos.Y);
+    Lines^.AtInsert(CurPos.Y+1,NewLine(IndentStr+copy(S,CurPos.X+1,255)));
+    LimitsChanged;
+    SetLineText(CurPos.Y,copy(S,1,CurPos.X-1+1));
+    if PointOfs(SelStart)<>PointOfs(SelEnd) then { !!! check it - it's buggy !!! }
+      begin SelEnd.Y:=CurPos.Y+1; SelEnd.X:=length(GetLineText(CurPos.Y+1))-SelBack; end;
+    UpdateAttrs(CurPos.Y,attrAll);
+    SetCurPtr(Ind,CurPos.Y+1);
+  end else
+  begin
+    if CurPos.Y=GetLineCount-1 then
+    CalcIndent(CurPos.Y);
+    begin
+      Lines^.Insert(NewLine(IndentStr));
+      LimitsChanged;
+    end;
+    SetCurPtr(Ind,CurPos.Y+1);
+  end;
+  DrawLines(CurPos.Y);
+end;
+
+procedure TCodeEditor.BackSpace;
+var S,PreS: string;
+    CP: integer;
+begin
+  if IsReadOnly then Exit;
+  if CurPos.X=0 then
+  begin
+    if CurPos.Y>0 then
+    begin
+      S:=GetLineText(CurPos.Y-1);
+      SetLineText(CurPos.Y-1,S+GetLineText(CurPos.Y));
+      Lines^.AtDelete(CurPos.Y);
+      LimitsChanged;
+      SetCurPtr(length(S),CurPos.Y-1);
+    end;
+  end else
+  begin
+    S:=GetLineText(CurPos.Y);
+
+    CP:=CurPos.X-1;
+    if (Flags and efBackspaceUnindents)<>0 then
+    begin
+      if CurPos.Y>0 then PreS:=GetLineText(CurPos.Y) else PreS:='';
+      PreS:=RExpand(PreS,255);
+      while (CP>0) and (S[CP]=#32) and (PreS[CP]<>#32) do
+            Dec(CP);
+    end;
+
+    SetLineText(CurPos.Y,copy(S,1,CP)+copy(S,CurPos.X+1,255));
+    SetCurPtr(CP,CurPos.Y);
+  end;
+  UpdateAttrs(CurPos.Y,attrAll);
+  DrawLines(CurPos.Y);
+  Modified:=true;
+  UpdateIndicator;
+end;
+
+procedure TCodeEditor.DelChar;
+var S: string;
+begin
+  if IsReadOnly then Exit;
+  S:=GetLineText(CurPos.Y);
+  if CurPos.X=length(S) then
+  begin
+    if CurPos.Y<GetLineCount-1 then
+    begin
+      SetLineText(CurPos.Y,S+GetLineText(CurPos.Y+1));
+      Lines^.AtFree(CurPos.Y+1);
+      LimitsChanged;
+    end;
+  end else
+  begin
+    S:=GetLineText(CurPos.Y);
+    SetLineText(CurPos.Y,copy(S,1,CurPos.X)+copy(S,CurPos.X+2,255));
+  end;
+  UpdateAttrs(CurPos.Y,attrAll);
+  DrawLines(CurPos.Y);
+  Modified:=true;
+  UpdateIndicator;
+end;
+
+procedure TCodeEditor.DelWord;
+begin
+  if IsReadOnly then Exit;
+  Modified:=true;
+  UpdateIndicator;
+end;
+
+procedure TCodeEditor.DelStart;
+begin
+  if IsReadOnly then Exit;
+  Modified:=true;
+  UpdateIndicator;
+end;
+
+procedure TCodeEditor.DelEnd;
+var S: string;
+begin
+  if IsReadOnly then Exit;
+  S:=GetLineText(CurPos.Y);
+  if (S<>'') and (CurPos.X<>length(S)) then
+  begin
+    SetLineText(CurPos.Y,copy(S,1,CurPos.X));
+    UpdateAttrs(CurPos.Y,attrAll);
+    DrawLines(CurPos.Y);
+    Modified:=true;
+    UpdateIndicator;
+  end;
+end;
+
+procedure TCodeEditor.DelLine;
+begin
+  if IsReadOnly then Exit;
+  if GetLineCount>0 then
+  begin
+    Lines^.AtFree(CurPos.Y);
+    LimitsChanged;
+    SetCurPtr(0,CurPos.Y);
+    UpdateAttrs(Max(0,CurPos.Y-1),attrAll);
+    DrawLines(CurPos.Y);
+    Modified:=true;
+    UpdateIndicator;
+  end;
+end;
+
+procedure TCodeEditor.InsMode;
+begin
+  SetInsertMode(not not Overwrite);
+end;
+
+procedure TCodeEditor.StartSelect;
+begin
+  if (PointOfs(SelStart)=PointOfs(SelEnd)) then
+     SetSelection(SelStart,Limit);
+  SetSelection(CurPos,SelEnd);
+  if PointOfs(SelEnd)<PointOfs(SelStart) then
+     SetSelection(SelStart,SelStart);
+  CheckSels;
+  DrawView;
+end;
+
+procedure TCodeEditor.EndSelect;
+var P: TPoint;
+begin
+  P:=CurPos; P.X:=Min(SelEnd.X,length(GetLineText(SelEnd.Y))); CheckSels;
+  SetSelection(SelStart,P);
+  DrawView;
+end;
+
+procedure TCodeEditor.DelSelect;
+var LineDelta, LineCount, CurLine: Sw_integer;
+    StartX,EndX,LastX: Sw_integer;
+    S: string;
+begin
+  if IsReadOnly then Exit;
+  if (SelStart.X=SelEnd.X) and (SelStart.Y=SelEnd.Y) then Exit;
+  LineCount:=(SelEnd.Y-SelStart.Y)+1;
+  LineDelta:=0; LastX:=CurPos.X;
+  CurLine:=SelStart.Y;
+  while (LineDelta<LineCount) do
+  begin
+    S:=GetLineText(CurLine);
+    if LineDelta=0 then StartX:=SelStart.X else StartX:=0;
+    if LineDelta=LineCount-1 then EndX:=SelEnd.X else EndX:=length(S);
+    if (LineDelta<LineCount-1) and
+       ( (StartX=0) and (EndX>=length(S)) )
+       then begin
+              Lines^.AtFree(CurLine);
+              if CurLine>0 then LastX:=length(GetLineText(CurLine-1))
+                           else LastX:=0;
+            end
+       else begin
+              SetLineText(CurLine,copy(S,1,StartX)+copy(S,EndX+1,255));
+              LastX:=StartX;
+              if (StartX=0) and (0<LineDelta) and
+                 not(((LineDelta=LineCount-1) and (StartX=0) and (StartX=EndX))) then
+              begin
+                S:=GetLineText(CurLine-1);
+                SetLineText(CurLine-1,S+GetLineText(CurLine));
+                Lines^.AtFree(CurLine);
+                LastX:=length(S);
+              end else
+              Inc(CurLine);
+            end;
+    Inc(LineDelta);
+  end;
+  SetCurPtr(LastX,CurLine-1);
+  HideSelect;
+  UpdateAttrs(CurPos.Y,attrAll);
+  DrawLines(CurPos.Y);
+  Modified:=true;
+  UpdateIndicator;
+end;
+
+procedure TCodeEditor.HideSelect;
+begin
+  SetSelection(CurPos,CurPos);
+end;
+
+procedure TCodeEditor.CopyBlock;
+var Temp: PCodeEditor;
+    R: TRect;
+begin
+  if IsReadOnly then Exit;
+  if (SelStart.X=SelEnd.X) and (SelStart.Y=SelEnd.Y) then Exit;
+  GetExtent(R);
+  New(Temp, Init(R, nil, nil, nil,0));
+  Temp^.InsertFrom(@Self);
+  InsertFrom(Temp);
+  Dispose(Temp, Done);
+end;
+
+procedure TCodeEditor.MoveBlock;
+var Temp: PCodeEditor;
+    R: TRect;
+    OldPos: TPoint;
+begin
+  if IsReadOnly then Exit;
+  if (SelStart.X=SelEnd.X) and (SelStart.Y=SelEnd.Y) then Exit;
+  GetExtent(R);
+  New(Temp, Init(R, nil, nil, nil,0));
+  Temp^.InsertFrom(@Self);
+  OldPos:=CurPos; Dec(OldPos.Y,Temp^.GetLineCount-1);
+  DelSelect;
+  SetCurPtr(OldPos.X,OldPos.Y);
+  InsertFrom(Temp);
+  Dispose(Temp, Done);
+end;
+
+procedure TCodeEditor.AddChar(C: char);
+const OpenBrackets  : string[10] = '[({';
+      CloseBrackets : string[10] = '])}';
+var S: string;
+    BI: byte;
+begin
+  if IsReadOnly then Exit;
+  S:=GetLineText(CurPos.Y);
+  if Overwrite and (CurPos.X<length(S)) then
+    SetLineText(CurPos.Y,copy(S,1,CurPos.X)+C+copy(S,CurPos.X+2,255))
+  else
+    SetLineText(CurPos.Y,RExpand(copy(S,1,CurPos.X),CurPos.X)+C+copy(S,CurPos.X+1,255));
+  if PointOfs(SelStart)<>PointOfs(SelEnd) then
+    if (CurPos.Y=SelEnd.Y) and (CurPos.X<SelEnd.X) then
+      Inc(SelEnd.X);
+  SetCurPtr(CurPos.X+1,CurPos.Y);
+  BI:=Pos(C,OpenBrackets);
+  if ((Flags and efAutoBrackets)<>0) and (BI>0) then
+  begin
+    AddChar(CloseBrackets[BI]); SetCurPtr(CurPos.X-1,CurPos.Y);
+  end;
+  UpdateAttrs(CurPos.Y,attrAll);
+  DrawLines(CurPos.Y);
+  Modified:=true;
+  UpdateIndicator;
+end;
+
+function TCodeEditor.ClipCopy: Boolean;
+var OK: boolean;
+begin
+  OK:=Clipboard<>nil;
+  if OK then OK:=Clipboard^.InsertFrom(@Self);
+  ClipCopy:=OK;
+end;
+
+procedure TCodeEditor.ClipCut;
+begin
+  if IsReadOnly then Exit;
+  if Clipboard<>nil then
+     if Clipboard^.InsertFrom(@Self) then
+     begin
+        DelSelect;
+        Modified:=true;
+        UpdateIndicator;
+     end;
+end;
+
+procedure TCodeEditor.ClipPaste;
+begin
+  if IsReadOnly then Exit;
+  if Clipboard<>nil then
+     begin
+       InsertFrom(Clipboard);
+       Modified:=true;
+       UpdateIndicator;
+     end;
+end;
+
+procedure TCodeEditor.Undo;
+begin
+end;
+
+procedure TCodeEditor.GotoLine;
+var
+  GotoRec: TGotoLineDialogRec;
+begin
+  with GotoRec do
+  begin
+    LineNo:='1';
+    Lines:=GetLineCount;
+    if EditorDialog(edGotoLine, @GotoRec) <> cmCancel then
+    begin
+      SetCurPtr(0,StrToInt(LineNo)-1);
+      TrackCursor(true);
+    end;
+  end;
+end;
+
+procedure TCodeEditor.Find;
+var
+  FindRec: TFindDialogRec;
+  DoConf: boolean;
+begin
+  with FindRec do
+  begin
+    Find := FindStr;
+    Options := (FindFlags and ffmOptions) shr ffsOptions;
+    Direction := (FindFlags and ffmDirection) shr ffsDirection;
+    Scope := (FindFlags and ffmScope) shr ffsScope;
+    Origin := (FindFlags and ffmOrigin) shr ffsOrigin;
+    DoConf:= (FindFlags and ffPromptOnReplace)<>0;
+    if EditorDialog(edFind, @FindRec) <> cmCancel then
+    begin
+      FindStr := Find;
+      FindFlags := (Options shl ffsOptions) or (Direction shl ffsDirection) or
+                   (Scope shl ffsScope) or (Origin shl ffsOrigin);
+      FindFlags := FindFlags and not ffDoReplace;
+      if DoConf then
+        FindFlags := (FindFlags or ffPromptOnReplace);
+      SearchRunCount:=0;
+      DoSearchReplace;
+    end;
+  end;
+end;
+
+procedure TCodeEditor.Replace;
+var
+  ReplaceRec: TReplaceDialogRec;
+  Re: word;
+begin
+  if IsReadOnly then Exit;
+  with ReplaceRec do
+  begin
+    Find := FindStr;
+    Replace := ReplaceStr;
+    Options := (FindFlags and ffmOptions) shr ffsOptions;
+    Direction := (FindFlags and ffmDirection) shr ffsDirection;
+    Scope := (FindFlags and ffmScope) shr ffsScope;
+    Origin := (FindFlags and ffmOrigin) shr ffsOrigin;
+    Re:=EditorDialog(edReplace, @ReplaceRec);
+    if Re <> cmCancel then
+    begin
+      FindStr := Find;
+      ReplaceStr := Replace;
+      FindFlags := (Options shl ffsOptions) or (Direction shl ffsDirection) or
+                   (Scope shl ffsScope) or (Origin shl ffsOrigin);
+      FindFlags := FindFlags or ffDoReplace;
+      if Re = cmYes then
+        FindFlags := FindFlags or ffReplaceAll;
+      SearchRunCount:=0;
+      DoSearchReplace;
+    end;
+  end;
+end;
+
+procedure TCodeEditor.DoSearchReplace;
+var S: string;
+    DX,DY,P,Y,X: integer;
+    Count: integer;
+    Found,CanExit: boolean;
+    SForward,DoReplace,DoReplaceAll: boolean;
+    LeftOK,RightOK: boolean;
+    FoundCount: integer;
+    A,B: TPoint;
+    AreaStart,AreaEnd: TPoint;
+    CanReplace,Confirm: boolean;
+    Re: word;
+function ContainsText(var SubS: string; var S: string; Start: word): integer;
+var P: integer;
+begin
+  if Start<=0 then P:=0 else
+  if SForward then
+     begin
+       P:=PosF(SubS,copy(S,Start,255),(FindFlags and ffCaseSensitive)<>0);
+       if P>0 then Inc(P,Start-1);
+     end else
+     begin
+       P:=PosF(SubS,copy(S,1,Start),(FindFlags and ffCaseSensitive)<>0);
+     end;
+  ContainsText:=P;
+end;
+function InArea(X,Y: integer): boolean;
+begin
+  InArea:=((AreaStart.Y=Y) and (AreaStart.X<=X)) or
+          ((AreaStart.Y<Y) and (Y<AreaEnd.Y)) or
+          ((AreaEnd.Y=Y) and (X<AreaEnd.X));
+end;
+begin
+  Inc(SearchRunCount);
+
+  SForward:=(FindFlags and ffmDirection)=ffForward;
+  DoReplace:=(FindFlags and ffDoReplace)<>0;
+  Confirm:=(FindFlags and ffPromptOnReplace)<>0;
+  DoReplaceAll:=(FindFlags and ffReplaceAll)<>0;
+  Count:=GetLineCount; FoundCount:=0;
+
+  if SForward then DY:=1 else DY:=-1; DX:=DY;
+
+  if (FindFlags and ffmScope)=ffGlobal
+     then begin AreaStart.X:=0; AreaStart.Y:=0; AreaEnd.X:=length(GetLineText(Count-1)); AreaEnd.Y:=Count-1; end
+     else begin AreaStart:=SelStart; AreaEnd:=SelEnd; end;
+
+  X:=CurPos.X-DX; Y:=CurPos.Y;;
+  if SearchRunCount=1 then
+    if (FindFlags and ffmOrigin)=ffEntireScope then
+       if SForward then begin X:=AreaStart.X-1; Y:=AreaStart.Y; end
+                   else begin X:=AreaEnd.X+1; Y:=AreaEnd.Y; end;
+
+  X:=X+DX;
+  CanExit:=false;
+  if DoReplace and (Confirm=false) and (Owner<>nil) then Owner^.Lock;
+  if InArea(X,Y) then
+  repeat
+    S:=GetLineText(Y);
+    P:=ContainsText(FindStr,S,X+1);
+    Found:=P<>0;
+    if Found then
+      begin A.X:=P-1; A.Y:=Y; B.Y:=Y; B.X:=A.X+length(FindStr); end;
+    Found:=Found and InArea(A.X,A.Y);
+
+    if Found and ((FindFlags and ffWholeWordsOnly)<>0) then
+     begin
+       LeftOK:=(A.X<=0) or (not( (S[A.X] in AlphaChars) or (S[A.X] in NumberChars) ));
+       RightOK:=(B.X>=length(S)) or (not( (S[B.X+1] in AlphaChars) or (S[B.X+1] in NumberChars) ));
+       Found:=LeftOK and RightOK;
+     end;
+
+    if Found then Inc(FoundCount);
+
+    if Found then
+      begin
+        SetCurPtr(B.X,B.Y);
+        TrackCursor(true);
+        SetHighlight(A,B);
+        if (DoReplace=false) then CanExit:=true else
+          begin
+            if Confirm=false then CanReplace:=true else
+              begin
+                Re:=EditorDialog(edReplacePrompt,@CurPos);
+                case Re of
+                  cmYes    : CanReplace:=true;
+                  cmNo     : CanReplace:=false;
+                else {cmCancel} begin CanReplace:=false; CanExit:=true; end;
+                end;
+              end;
+            if CanReplace then
+              begin
+                if Owner<>nil then Owner^.Lock;
+                SetSelection(A,B);
+                DelSelect;
+                InsertText(ReplaceStr);
+                if Owner<>nil then Owner^.UnLock;
+              end;
+            if (DoReplaceAll=false) then CanExit:=true;
+          end;
+      end;
+
+    if CanExit=false then
+      begin
+        Y:=Y+DY;
+        if SForward then X:=0 else X:=255;
+        CanExit:=(Y>=Count) or (Y<0);
+      end;
+    if CanExit=false then
+       CanExit:=InArea(X,Y)=false;
+  until CanExit;
+  if (FoundCount=0) or (DoReplace) then
+    SetHighlight(CurPos,CurPos);
+  if DoReplace and (Confirm=false) and (Owner<>nil) then Owner^.UnLock;
+  if (FoundCount=0) then
+    EditorDialog(edSearchFailed,nil);
+end;
+
+procedure TCodeEditor.SetInsertMode(InsertMode: boolean);
+begin
+  Overwrite:=not InsertMode;
+  DrawCursor;
+end;
+
+procedure TCodeEditor.SetCurPtr(X,Y: integer);
+var OldPos,OldSEnd,OldSStart: TPoint;
+    Extended: boolean;
+begin
+  X:=Max(0,Min(MaxLineLength+1,X)); Y:=Max(0,Min(GetLineCount-1,Y));
+  OldPos:=CurPos; OldSEnd:=SelEnd; OldSStart:=SelStart;
+  CurPos.X:=X; CurPos.Y:=Y;
+  TrackCursor(false);
+  if (NoSelect=false) and ((GetShiftState and kbShift)<>0) then
+  begin
+    CheckSels;
+    Extended:=false;
+    if PointOfs(OldPos)=PointOfs(SelStart) then
+      begin SetSelection(CurPos,SelEnd); Extended:=true; end;
+    CheckSels;
+    if Extended=false then
+     if PointOfs(OldPos)=PointOfs(SelEnd) then
+        begin SetSelection(SelStart,CurPos); Extended:=true; end;
+    CheckSels;
+    if (Extended=false) then
+       if PointOfs(OldPos)<=PointOfs(CurPos)
+          then begin SetSelection(OldPos,CurPos); Extended:=true; end
+          else begin SetSelection(CurPos,OldPos); Extended:=true; end;
+    DrawView;
+  end else
+   if (Flags and efPersistentBlocks)=0 then
+      begin HideSelect; DrawView; end;
+  if PointOfs(SelStart)=PointOfs(SelEnd) then
+     SetSelection(CurPos,CurPos);
+  if (Flags and (efHighlightColumn+efHighlightRow))<>0 then
+     DrawView;
+  if ((CurPos.X<>OldPos.X) or (CurPos.Y<>OldPos.Y)) and
+     ((Highlight.A.X<>HighLight.B.X) or (Highlight.A.Y<>HighLight.B.Y)) then
+     HideHighlight;
+  if (OldPos.Y<>CurPos.Y) and (0<=OldPos.Y) and (OldPos.Y<GetLineCount) then
+     SetLineText(OldPos.Y,RTrim(GetLineText(OldPos.Y)));
+  if ((CurPos.X<>OldPos.X) or (CurPos.Y<>OldPos.Y)) and (GetErrorMessage<>'') then
+    SetErrorMessage('');
+end;
+
+procedure TCodeEditor.CheckSels;
+begin
+  if (SelStart.Y>SelEnd.Y) or
+     ( (SelStart.Y=SelEnd.Y) and (SelStart.X>SelEnd.X) ) then
+       SetSelection(SelEnd,SelStart);
+end;
+
+function TCodeEditor.UpdateAttrs(FromLine: integer; Attrs: byte): integer;
+type TCharClass = (ccWhiteSpace,ccAlpha,ccNumber,ccSymbol);
+var LastCC: TCharClass;
+    InAsm,InComment,InDirective,InString: boolean;
+    X,ClassStart: Sw_integer;
+    SymbolConcat: string;
+    LineText,Format: string;
+function MatchSymbol(What, S: string): boolean;
+var Match: boolean;
+begin
+  Match:=false;
+  if length(What)>=length(S) then
+    if copy(What,1+length(What)-length(S),length(S))=S then
+       Match:=true;
+  MatchSymbol:=Match;
+end;
+var MatchedSymbol: boolean;
+    MatchingSymbol: string;
+function MatchesAnySpecSymbol(What: string; SClass: TSpecSymbolClass; PartialMatch: boolean): boolean;
+var I: Sw_integer;
+    S: string;
+    Match,Found: boolean;
+begin
+  Found:=false;
+  if What<>'' then
+  for I:=1 to GetSpecSymbolCount(SClass) do
+  begin
+    S:=GetSpecSymbol(SClass,I-1);
+    if PartialMatch then Match:=MatchSymbol(What,S)
+                    else Match:=What=S;
+    if Match then
+       begin MatchingSymbol:=S; Found:=true; Break; end;
+  end;
+  MatchedSymbol:=MatchedSymbol or Found;
+  MatchesAnySpecSymbol:=Found;
+end;
+function IsCommentPrefix: boolean;
+begin
+  IsCommentPrefix:=MatchesAnySpecSymbol(SymbolConcat,ssCommentPrefix,true);
+end;
+function IsCommentSuffix: boolean;
+begin
+  IsCommentSuffix:=MatchesAnySpecSymbol(SymbolConcat,ssCommentSuffix,true);
+end;
+function IsStringPrefix: boolean;
+begin
+  IsStringPrefix:=MatchesAnySpecSymbol(SymbolConcat,ssStringPrefix,true);
+end;
+function IsStringSuffix: boolean;
+begin
+  IsStringSuffix:=MatchesAnySpecSymbol(SymbolConcat,ssStringSuffix,true);
+end;
+function IsDirectivePrefix: boolean;
+begin
+  IsDirectivePrefix:=MatchesAnySpecSymbol(SymbolConcat,ssDirectivePrefix,true);
+end;
+function IsDirectiveSuffix: boolean;
+begin
+  IsDirectiveSuffix:=MatchesAnySpecSymbol(SymbolConcat,ssDirectiveSuffix,true);
+end;
+function IsAsmPrefix(WordS: string): boolean;
+begin
+  IsAsmPrefix:=MatchesAnySpecSymbol(WordS,ssAsmPrefix,false);
+end;
+function IsAsmSuffix(WordS: string): boolean;
+begin
+  IsAsmSuffix:=MatchesAnySpecSymbol(WordS,ssAsmSuffix,false);
+end;
+function GetCharClass(C: char): TCharClass;
+var CC: TCharClass;
+begin
+  C:=Upcase(C);
+  if C in WhiteSpaceChars then CC:=ccWhiteSpace else
+  if C in AlphaChars      then CC:=ccAlpha else
+  if C in NumberChars     then CC:=ccNumber else
+  CC:=ccSymbol;
+  GetCharClass:=CC;
+end;
+procedure FormatWord(SClass: TCharClass; StartX,EndX: Sw_integer);
+var FX: Sw_integer;
+    C: byte;
+    WordS: string;
+begin
+  C:=0;
+  WordS:=copy(LineText,StartX,EndX-StartX+1);
+  if IsAsmSuffix(WordS) and (InAsm=true) and (InComment=false) and
+     (InString=false) and (InDirective=false) then InAsm:=false;
+  if InDirective then C:=coDirectiveColor else
+  if InComment then C:=coCommentColor else
+  if InString then C:=coStringColor else
+  if InAsm then C:=coAssemblerColor else
+  case SClass of
+    ccWhiteSpace : C:=coWhiteSpaceColor;
+    ccNumber     : C:=coNumberColor;
+    ccSymbol     : C:=coSymbolColor;
+    ccAlpha      :
+      begin
+        WordS:=copy(LineText,StartX,EndX-StartX+1);
+        if IsReservedWord(WordS) then C:=coReservedWordColor
+                                 else C:=coIdentifierColor;
+      end;
+  end;
+  for FX:=StartX to EndX do
+   Format[FX]:=chr(C);
+  if IsAsmPrefix(WordS) and (InAsm=false) and (InComment=false) and
+     (InDirective=false) then InAsm:=true;
+end;
+procedure ProcessChar(C: char);
+var CC: TCharClass;
+    EX: Sw_integer;
+begin
+  CC:=GetCharClass(C);
+  if ( (CC<>LastCC) and
+       ( (CC<>ccAlpha) or (LastCC<>ccNumber) ) and
+       ( (CC<>ccNumber) or (LastCC<>ccAlpha) )
+     ) or
+     (X>length(LineText)) or (CC=ccSymbol) then
+  begin
+    MatchedSymbol:=false;
+    EX:=X-1;
+    if (CC=ccSymbol) then
+    begin
+      if length(SymbolConcat)>=High(SymbolConcat) then
+         Delete(SymbolConcat,1,1);
+      SymbolConcat:=SymbolConcat+C;
+    end;
+    case CC of
+      ccSymbol :
+        if IsCommentSuffix and (InComment) then
+           Inc(EX) else
+        if IsStringSuffix and (InString) then
+           Inc(EX) else
+        if IsDirectiveSuffix and (InDirective) then
+           Inc(EX);
+    end;
+    if (C='$') and (MatchedSymbol=false) and (IsDirectivePrefix=false) then
+       CC:=ccNumber;
+    if CC<>ccSymbol then SymbolConcat:='';
+    FormatWord(LastCC,ClassStart,EX);
+    ClassStart:=EX+1;
+    case CC of
+      ccAlpha  : ;
+      ccNumber :
+        if (LastCC<>ccAlpha) then;
+      ccSymbol :
+          if IsDirectivePrefix {and (InComment=false)} and (InDirective=false) then
+             begin InDirective:=true; InComment:=false; Dec(ClassStart,length(MatchingSymbol)-1); end else
+          if IsDirectiveSuffix and (InComment=false) and (InDirective=true) then
+             InDirective:=false else
+          if IsCommentPrefix and (InString=false) then
+              begin InComment:=true; {InString:=false; }Dec(ClassStart,length(MatchingSymbol)-1); end else
+          if IsCommentSuffix and (InComment) then
+              begin InComment:=false; InString:=false; end else
+          if IsStringPrefix and (InComment=false) and (InString=false) then
+             begin InString:=true; Dec(ClassStart,length(MatchingSymbol)-1); end else
+          if IsStringSuffix and (InComment=false) and (InString=true) then
+             InString:=false;
+    end;
+    if MatchedSymbol and (InComment=false) then SymbolConcat:='';
+    LastCC:=CC;
+  end;
+end;
+var CurLine: Sw_integer;
+    Line,NextLine,OldLine: PLine;
+    C: char;
+begin
+  if ((Flags and efSyntaxHighlight)=0) or (FromLine>=GetLineCount) then
+  begin
+    SetLineFormat(FromLine,'');
+    UpdateAttrs:=GetLineCount-1;
+    Exit;
+  end;
+  CurLine:=FromLine;
+  repeat
+    Line:=Lines^.At(CurLine);
+    if CurLine>0 then
+       begin
+         InAsm:=Lines^.At(CurLine-1)^.EndsWithAsm;
+         InComment:=Lines^.At(CurLine-1)^.EndsWithComment;
+         InDirective:=Lines^.At(CurLine-1)^.EndsWithDirective;
+       end else
+       begin
+         InAsm:=false; InComment:=false; InDirective:=false;
+       end;
+    OldLine:=Line;
+    Line^.BeginsWithAsm:=InAsm; Line^.BeginsWithComment:=InComment;
+    Line^.BeginsWithDirective:=InDirective;
+    LineText:=GetLineText(CurLine);
+    Format[0]:=LineText[0]; FillChar(Format[1],SizeOf(Format)-1,coTextColor);
+    LastCC:=ccWhiteSpace; ClassStart:=1; SymbolConcat:='';
+    InString:=false;
+    if LineText<>'' then
+      for X:=1 to length(LineText)+1 do
+      begin
+        if X<=length(LineText) then C:=LineText[X] else C:=' ';
+        ProcessChar(C);
+      end;
+    SetLineFormat(CurLine,Format);
+    Line^.EndsWithAsm:=InAsm; Line^.EndsWithComment:=InComment;
+    Line^.EndsWithDirective:=InDirective;
+    Inc(CurLine);
+    if CurLine>=GetLineCount then Break;
+    NextLine:=Lines^.At(CurLine);
+    if (Attrs and attrForceFull)=0 then
+      if (InAsm=false) and (NextLine^.BeginsWithAsm=false) and
+         (InComment=false) and (NextLine^.BeginsWithComment=false) and
+         (InDirective=false) and (NextLine^.BeginsWithDirective=false) and
+         (OldLine^.EndsWithComment=Line^.EndsWithComment) and
+         (OldLine^.EndsWithAsm=Line^.EndsWithAsm) and
+         (OldLine^.EndsWithDirective=Line^.EndsWithDirective) and
+         (NextLine^.BeginsWithAsm=Line^.EndsWithAsm) and
+         (NextLine^.BeginsWithComment=Line^.EndsWithComment) and
+         (NextLine^.BeginsWithDirective=Line^.EndsWithDirective) and
+         (NextLine^.Format<>nil)
+         then Break;
+  until false;
+  UpdateAttrs:=CurLine;
+end;
+
+procedure TCodeEditor.DrawLines(FirstLine: integer);
+begin
+  DrawView;
+end;
+
+function TCodeEditor.InsertText(S: string): Boolean;
+var I: integer;
+begin
+  for I:=1 to length(S) do
+    AddChar(S[I]);
+end;
+
+function TCodeEditor.InsertFrom(Editor: PCodeEditor): Boolean;
+var OK: boolean;
+    LineDelta,LineCount: Sw_integer;
+    StartPos,DestPos: TPoint;
+    LineStartX,LineEndX: Sw_integer;
+    S,OrigS: string;
+    VerticalBlock: boolean;
+    SEnd: TPoint;
+begin
+  OK:=(Editor^.SelStart.X<>Editor^.SelEnd.X) or (Editor^.SelStart.Y<>Editor^.SelEnd.Y);
+  if OK then
+  begin
+    StartPos:=CurPos; DestPos:=CurPos;
+    VerticalBlock:=(Editor^.Flags and efVerticalBlocks)<>0;
+    LineDelta:=0; LineCount:=(Editor^.SelEnd.Y-Editor^.SelStart.Y)+1;
+    OK:=GetLineCount<MaxLineCount;
+    while OK and (LineDelta<LineCount) do
+    begin
+      if (LineDelta<LineCount-1) and (VerticalBlock=false) then
+      if (LineDelta<>0) or (Editor^.SelEnd.X=0) then
+         begin Lines^.AtInsert(DestPos.Y,NewLine('')); LimitsChanged; end;
+      if (LineDelta=0) or VerticalBlock
+         then LineStartX:=Editor^.SelStart.X else LineStartX:=0;
+      if (LineDelta=LineCount-1) or VerticalBlock
+         then LineEndX:=Editor^.SelEnd.X-1 else LineEndX:=255;
+      if LineEndX<=LineStartX then S:='' else
+      S:=RExpand(
+            copy(Editor^.GetLineText(Editor^.SelStart.Y+LineDelta),LineStartX+1,LineEndX-LineStartX+1),
+          Min(LineEndX-LineStartX+1,255));
+      if VerticalBlock=false then
+         begin
+           OrigS:=GetLineText(DestPos.Y);
+           SetLineText(DestPos.Y,RExpand(copy(OrigS,1,DestPos.X),DestPos.X)+S+copy(OrigS,DestPos.X+1,255));
+           if LineDelta=LineCount-1 then
+              begin SEnd.Y:=DestPos.Y; SEnd.X:=DestPos.X+length(S); end else
+              begin Inc(DestPos.Y); DestPos.X:=0; end;
+         end else
+         begin
+           S:=RExpand(S,LineEndX-LineStartX+1);
+         end;
+      Inc(LineDelta);
+      OK:=GetLineCount<MaxLineCount;
+    end;
+    if OK=false then EditorDialog(edTooManyLines,nil);
+    UpdateAttrs(StartPos.Y,attrAll);
+    LimitsChanged;
+    SetSelection(CurPos,SEnd);
+    if IsClipboard then
+       begin Inc(DestPos.X,length(S)); SetCurPtr(DestPos.X,DestPos.Y); end;
+    DrawView;
+  end;
+  InsertFrom:=OK;
+end;
+
+function TCodeEditor.IsClipboard: Boolean;
+begin
+  IsClipboard:=(Clipboard=@Self);
+end;
+
+procedure TCodeEditor.HideHighlight;
+begin
+  SetHighlight(CurPos,CurPos);
+end;
+
+procedure TCodeEditor.SetSelection(A, B: TPoint);
+begin
+  SelStart:=A; SelEnd:=B;
+  SelectionChanged;
+end;
+
+procedure TCodeEditor.SetHighlight(A, B: TPoint);
+begin
+  Highlight.A:=A; Highlight.B:=B;
+  HighlightChanged;
+end;
+
+procedure TCodeEditor.SelectAll(Enable: boolean);
+var A,B: TPoint;
+begin
+  if (Enable=false) or (GetLineCount=0) then
+     begin A:=CurPos; B:=CurPos end else
+     begin A.X:=0; A.Y:=0; B.Y:=GetLineCount-1; B.X:=length(GetLineText(B.Y)); end;
+  SetSelection(A,B);
+  DrawView;
+end;
+
+procedure TCodeEditor.SelectionChanged;
+var Enable,CanPaste: boolean;
+begin
+  Enable:=((SelStart.X<>SelEnd.X) or (SelStart.Y<>SelEnd.Y)) and (Clipboard<>nil);
+  SetCmdState(ToClipCmds,Enable);
+  CanPaste:=(Clipboard<>nil) and ((Clipboard^.SelStart.X<>Clipboard^.SelEnd.X) or
+            (Clipboard^.SelStart.Y<>Clipboard^.SelEnd.Y));
+  SetCmdState(FromClipCmds,CanPaste);
+end;
+
+procedure TCodeEditor.HighlightChanged;
+begin
+  DrawView;
+end;
+
+function TCodeEditor.GetPalette: PPalette;
+const P: string[length(CEditor)] = CEditor;
+begin
+  GetPalette:=@P;
+end;
+
+destructor TCodeEditor.Done;
+begin
+  inherited Done;
+  Dispose(Lines, Done);
+end;
+
+constructor TFileEditor.Init(var Bounds: TRect; AHScrollBar, AVScrollBar:
+            PScrollBar; AIndicator: PIndicator;AFileName: string);
+begin
+  inherited Init(Bounds,AHScrollBAr,AVScrollBAr,AIndicator,0);
+  FileName:=AFileName;
+  UpdateIndicator;
+end;
+
+function TFileEditor.LoadFile: boolean;
+
+{$ifdef TPUNIXLF}
+  procedure readln(var t:text;var s:string);
+  var
+    c : char;
+    i : longint;
+  begin
+    c:=#0;
+    i:=0;
+    while (not eof(t)) and (c<>#10) do
+     begin
+       read(t,c);
+       if c<>#10 then
+        begin
+          inc(i);
+          s[i]:=c;
+        end;
+     end;
+    if (i>0) and (s[i]=#13) then
+     dec(i);
+    s[0]:=chr(i);
+  end;
+{$endif}
+
+var S: string;
+    OK: boolean;
+    f: text;
+    FM,Line: Sw_integer;
+begin
+  Lines^.FreeAll;
+{$I-}
+  FM:=FileMode; FileMode:=0;
+  Assign(f,FileName);
+  Reset(f);
+  OK:=(IOResult=0);
+  while OK and (Eof(f)=false) and (GetLineCount<MaxLineCount) do
+  begin
+    readln(f,S);
+    OK:=OK and (IOResult=0);
+    if OK then Lines^.Insert(NewLine(S));
+  end;
+  FileMode:=FM;
+  Close(F);
+  EatIO;
+{$I+}
+  LimitsChanged;
+  Line:=-1;
+  repeat
+    Line:=UpdateAttrs(Line+1,attrAll+attrForceFull);
+  until Line>=GetLineCount-1;
+  TextStart;
+  LoadFile:=OK;
+end;
+
+function TFileEditor.SaveFile: boolean;
+var S: string;
+    OK: boolean;
+    f: text;
+    Line: Sw_integer;
+    P: PLine;
+    BAKName: string;
+begin
+{$I-}
+  if (Flags and efBackupFiles)<>0 then
+  begin
+     BAKName:=DirAndNameOf(FileName)+'.bak';
+     Assign(f,BAKName);
+     Erase(f);
+     EatIO;
+     Assign(f,FileName);
+     Rename(F,BAKName);
+     EatIO;
+  end;
+  Assign(f,FileName);
+  Rewrite(f);
+  OK:=(IOResult=0); Line:=0;
+  while OK and (Line<GetLineCount) do
+  begin
+    P:=Lines^.At(Line);
+    if P^.Text=nil then S:='' else S:=P^.Text^;
+    writeln(f,S);
+    Inc(Line);
+    OK:=OK and (IOResult=0);
+  end;
+  Close(F);
+  EatIO;
+{$I+}
+  if OK then begin Modified:=false; UpdateIndicator; end;
+  SaveFile:=OK;
+end;
+
+function TFileEditor.ShouldSave: boolean;
+begin
+  ShouldSave:=Modified or (FileName='');
+end;
+
+function TFileEditor.Save: Boolean;
+begin
+  if ShouldSave=false then begin Save:=true; Exit; end;
+  if FileName = '' then Save := SaveAs else Save := SaveFile;
+end;
+
+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;
+
+procedure TCodeEditor.SetState(AState: Word; Enable: Boolean);
+begin
+  inherited SetState(AState,Enable);
+  if (AState and (sfActive+sfSelected+sfFocused))<>0 then
+     SelectionChanged;
+end;
+
+function TFileEditor.Valid(Command: Word): Boolean;
+var OK: boolean;
+    D: Sw_integer;
+begin
+  OK:=inherited Valid(Command);
+  if OK and ((Command=cmClose) or (Command=cmQuit)) then
+     if IsClipboard=false then
+       begin
+         OK:=true;
+         if Modified then
+         begin
+           if FileName = '' then D := edSaveUntitled else D := edSaveModify;
+           case EditorDialog(D, @FileName) of
+             cmYes    : OK := Save;
+             cmNo     : Modified := False;
+             cmCancel : OK := False;
+           end;
+         end;
+    end;
+  Valid:=OK;
+end;
+
+function CreateFindDialog: PDialog;
+var R,R1,R2: TRect;
+    D: PDialog;
+    IL1: PInputLine;
+    CB1: PCheckBoxes;
+    RB1,RB2,RB3: PRadioButtons;
+begin
+  R.Assign(0,0,56,15);
+  New(D, Init(R, 'Find'));
+  with D^ do
+  begin
+    Options:=Options or ofCentered;
+    GetExtent(R); R.Grow(-3,-2);
+    R1.Copy(R); R1.B.X:=17; R1.B.Y:=R1.A.Y+1; R2.Copy(R); R2.A.X:=17; R2.B.Y:=R2.A.Y+1;
+    New(IL1, Init(R2, 80));
+    IL1^.Data^:=FindStr;
+    Insert(IL1);
+    Insert(New(PLabel, Init(R1, '~T~ext to find', IL1)));
+
+    R1.Copy(R); Inc(R1.A.Y,2); R1.B.Y:=R1.A.Y+1; R1.B.X:=R1.A.X+(R1.B.X-R1.A.X) div 2-1;
+    R2.Copy(R1); R2.Move(0,1); R2.B.Y:=R2.A.Y+2;
+    New(CB1, Init(R2,
+      NewSItem('~C~ase sensitive',
+      NewSItem('~W~hole words only',
+      nil))));
+    Insert(CB1);
+    Insert(New(PLabel, Init(R1, 'Options', CB1)));
+
+    R1.Copy(R); Inc(R1.A.Y,2); R1.B.Y:=R1.A.Y+1; R1.A.X:=R1.B.X-(R1.B.X-R1.A.X) div 2+1;
+    R2.Copy(R1); R2.Move(0,1); R2.B.Y:=R2.A.Y+2;
+    New(RB1, Init(R2,
+      NewSItem('Forwar~d~',
+      NewSItem('~B~ackward',
+      nil))));
+    Insert(RB1);
+    Insert(New(PLabel, Init(R1, 'Direction', RB1)));
+
+    R1.Copy(R); Inc(R1.A.Y,6); R1.B.Y:=R1.A.Y+1; R1.B.X:=R1.A.X+(R1.B.X-R1.A.X) div 2-1;
+    R2.Copy(R1); R2.Move(0,1); R2.B.Y:=R2.A.Y+2;
+    New(RB2, Init(R2,
+      NewSItem('~G~lobal',
+      NewSItem('~S~elected text',
+      nil))));
+    Insert(RB2);
+    Insert(New(PLabel, Init(R1, 'Scope', RB2)));
+
+    R1.Copy(R); Inc(R1.A.Y,6); R1.B.Y:=R1.A.Y+1; R1.A.X:=R1.B.X-(R1.B.X-R1.A.X) div 2+1;
+    R2.Copy(R1); R2.Move(0,1); R2.B.Y:=R2.A.Y+2;
+    New(RB3, Init(R2,
+      NewSItem('~F~rom cursor',
+      NewSItem('~E~ntire scope',
+      nil))));
+    Insert(RB3);
+    Insert(New(PLabel, Init(R1, 'Origin', RB3)));
+
+    GetExtent(R); R.Grow(-13,-1); R.A.Y:=R.B.Y-2; R.B.X:=R.A.X+10;
+    Insert(New(PButton, Init(R, 'O~K', cmOK, bfDefault)));
+    R.Move(19,0);
+    Insert(New(PButton, Init(R, 'Cancel', cmCancel, bfNormal)));
+  end;
+  IL1^.Select;
+  CreateFindDialog := D;
+end;
+
+function CreateReplaceDialog: PDialog;
+var R,R1,R2: TRect;
+    D: PDialog;
+    IL1,IL2: PInputLine;
+    CB1: PCheckBoxes;
+    RB1,RB2,RB3: PRadioButtons;
+begin
+  R.Assign(0,0,56,18);
+  New(D, Init(R, 'Replace'));
+  with D^ do
+  begin
+    Options:=Options or ofCentered;
+    GetExtent(R); R.Grow(-3,-2);
+    R1.Copy(R); R1.B.X:=17; R1.B.Y:=R1.A.Y+1; R2.Copy(R); R2.A.X:=17; R2.B.Y:=R2.A.Y+1;
+    New(IL1, Init(R2, 80));
+    IL1^.Data^:=FindStr;
+    Insert(IL1);
+    Insert(New(PLabel, Init(R1, '~T~ext to find', IL1)));
+
+    R1.Copy(R); R1.Move(0,2); R1.B.X:=17; R1.B.Y:=R1.A.Y+1;
+    R2.Copy(R); R2.Move(0,2); R2.A.X:=17; R2.B.Y:=R2.A.Y+1;
+    New(IL2, Init(R2, 80));
+    IL2^.Data^:=ReplaceStr;
+    Insert(IL2);
+    Insert(New(PLabel, Init(R1, '    ~N~ew text', IL2)));
+
+    R1.Copy(R); Inc(R1.A.Y,4); R1.B.Y:=R1.A.Y+1; R1.B.X:=R1.A.X+(R1.B.X-R1.A.X) div 2-1;
+    R2.Copy(R1); R2.Move(0,1); R2.B.Y:=R2.A.Y+3;
+    New(CB1, Init(R2,
+      NewSItem('~C~ase sensitive',
+      NewSItem('~W~hole words only',
+      NewSItem('~P~rompt on replace',
+      nil)))));
+    Insert(CB1);
+    Insert(New(PLabel, Init(R1, 'Options', CB1)));
+
+    R1.Copy(R); Inc(R1.A.Y,4); R1.B.Y:=R1.A.Y+1; R1.A.X:=R1.B.X-(R1.B.X-R1.A.X) div 2+1;
+    R2.Copy(R1); R2.Move(0,1); R2.B.Y:=R2.A.Y+2;
+    New(RB1, Init(R2,
+      NewSItem('Forwar~d~',
+      NewSItem('~B~ackward',
+      nil))));
+    Insert(RB1);
+    Insert(New(PLabel, Init(R1, 'Direction', RB1)));
+
+    R1.Copy(R); Inc(R1.A.Y,9); R1.B.Y:=R1.A.Y+1; R1.B.X:=R1.A.X+(R1.B.X-R1.A.X) div 2-1;
+    R2.Copy(R1); R2.Move(0,1); R2.B.Y:=R2.A.Y+2;
+    New(RB2, Init(R2,
+      NewSItem('~G~lobal',
+      NewSItem('~S~elected text',
+      nil))));
+    Insert(RB2);
+    Insert(New(PLabel, Init(R1, 'Scope', RB2)));
+
+    R1.Copy(R); Inc(R1.A.Y,9); R1.B.Y:=R1.A.Y+1; R1.A.X:=R1.B.X-(R1.B.X-R1.A.X) div 2+1;
+    R2.Copy(R1); R2.Move(0,1); R2.B.Y:=R2.A.Y+2;
+    New(RB3, Init(R2,
+      NewSItem('~F~rom cursor',
+      NewSItem('~E~ntire scope',
+      nil))));
+    Insert(RB3);
+    Insert(New(PLabel, Init(R1, 'Origin', RB3)));
+
+    GetExtent(R); R.Grow(-13,-1); R.A.Y:=R.B.Y-2; R.B.X:=R.A.X+10; R.Move(-10,0);
+    Insert(New(PButton, Init(R, 'O~K~', cmOK, bfDefault)));
+    R.Move(11,0); R.B.X:=R.A.X+14;
+    Insert(New(PButton, Init(R, 'Change ~a~ll', cmYes, bfNormal)));
+    R.Move(15,0); R.B.X:=R.A.X+10;
+    Insert(New(PButton, Init(R, 'Cancel', cmCancel, bfNormal)));
+  end;
+  IL1^.Select;
+  CreateReplaceDialog := D;
+end;
+
+function CreateGotoLineDialog(Info: pointer): PDialog;
+var D: PDialog;
+    R,R1,R2: TRect;
+    IL: PInputLine;
+begin
+  R.Assign(0,0,40,7);
+  New(D, Init(R, 'Goto line'));
+  with D^ do
+  begin
+    Options:=Options or ofCentered;
+    GetExtent(R); R.Grow(-3,-2); R.B.Y:=R.A.Y+1;
+    R1.Copy(R); R1.B.X:=27; R2.Copy(R); R2.A.X:=27;
+    New(IL, Init(R2,5));
+    with TGotoLineDialogRec(Info^) do
+    IL^.SetValidator(New(PRangeValidator, Init(1, Lines)));
+    Insert(IL);
+    Insert(New(PLabel, Init(R1, 'Enter new line ~n~umber', IL)));
+
+    GetExtent(R); R.Grow(-8,-1); R.A.Y:=R.B.Y-2; R.B.X:=R.A.X+10;
+    Insert(New(PButton, Init(R, 'O~K', cmOK, bfDefault)));
+    R.Move(15,0);
+    Insert(New(PButton, Init(R, 'Cancel', cmCancel, bfNormal)));
+  end;
+  IL^.Select;
+  CreateGotoLineDialog:=D;
+end;
+
+function StdEditorDialog(Dialog: Integer; Info: Pointer): Word;
+var
+  R: TRect;
+  T: TPoint;
+begin
+  case Dialog of
+    edOutOfMemory:
+      StdEditorDialog := MessageBox('Not enough memory for this operation.',
+        nil, mfInsertInApp+ mfError + mfOkButton);
+    edReadError:
+      StdEditorDialog := MessageBox('Error reading file %s.',
+        @Info, mfInsertInApp+ mfError + mfOkButton);
+    edWriteError:
+      StdEditorDialog := MessageBox('Error writing file %s.',
+        @Info, mfInsertInApp+ mfError + mfOkButton);
+    edCreateError:
+      StdEditorDialog := MessageBox('Error creating file %s.',
+        @Info, mfInsertInApp+ mfError + mfOkButton);
+    edSaveModify:
+      StdEditorDialog := MessageBox('%s has been modified. Save?',
+        @Info, mfInsertInApp+ mfInformation + mfYesNoCancel);
+    edSaveUntitled:
+      StdEditorDialog := MessageBox('Save untitled file?',
+        nil, mfInsertInApp+ mfInformation + mfYesNoCancel);
+    edSaveAs:
+      StdEditorDialog :=
+        Application^.ExecuteDialog(New(PFileDialog, Init('*.*',
+        'Save file as', '~N~ame', fdOkButton, 101)), Info);
+    edGotoLine:
+      StdEditorDialog :=
+        Application^.ExecuteDialog(CreateGotoLineDialog(Info), Info);
+    edFind:
+      StdEditorDialog :=
+        Application^.ExecuteDialog(CreateFindDialog, Info);
+    edSearchFailed:
+      StdEditorDialog := MessageBox('Search string not found.',
+        nil, mfInsertInApp+ 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, 'Replace this occurence?',
+          nil, mfInsertInApp+ mfYesNoCancel + mfInformation);
+      end;
+  end;
+end;
+
+END.
+{
+  $Log$
+  Revision 1.1  1998-12-22 14:27:54  peter
+    * moved
+
+  Revision 1.3  1998/12/22 10:39:54  peter
+    + options are now written/read
+    + find and replace routines
+
+}

ide/text/whelp.pas

@@ -0,0 +1,860 @@
+{
+    $Id$
+    This file is part of the Free Pascal Integrated Development Environment
+    Copyright (c) 1998 by Berczi Gabor
+
+    Help support & Borland OA .HLP reader objects and routines
+
+    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.
+
+ **********************************************************************}
+{$R-}
+unit WHelp;
+
+interface
+
+uses Objects;
+
+const
+      MinFormatVersion  = $34;
+
+      Signature      = '$*$* &&&&$*$'#0;
+      ncRawChar      = $F;
+      ncRepChar      = $E;
+
+      rtFileHeader   = Byte ($0);
+      rtContext      = Byte ($1);
+      rtText         = Byte ($2);
+      rtKeyWord      = Byte ($3);
+      rtIndex        = Byte ($4);
+      rtCompression  = Byte ($5);
+      rtIndexTags    = Byte ($6);
+
+      ctNone         = $00;
+      ctNibble       = $02;
+
+type
+      FileStamp      = array [0..32] of char; {+ null terminator + $1A }
+      FileSignature  = array [0..12] of char; {+ null terminator }
+
+      THLPVersion = packed record
+        FormatVersion : byte;
+        TextVersion   : byte;
+      end;
+
+      THLPRecordHeader = packed record
+        RecType       : byte; {TPRecType}
+        RecLength     : word;
+      end;
+
+      THLPContextPos = packed record
+        LoW: word;
+        HiB: byte;
+      end;
+
+      THLPContexts = packed record
+        ContextCount : word;
+        Contexts     : array[0..0] of THLPContextPos;
+      end;
+
+      THLPFileHeader = packed record
+        Options         : word;
+        MainIndexScreen : word;
+        Maxscreensize   : word;
+        Height          : byte;
+        Width           : byte;
+        LeftMargin      : byte;
+      end;
+
+      THLPCompression = packed record
+        CompType      : byte;
+        CharTable     : array [0..13] of byte;
+      end;
+
+      THLPIndexDescriptor = packed record
+        LengthCode    : byte;
+        UniqueChars   : array [0..0] of byte;
+        Context       : word;
+      end;
+
+      THLPIndexTable = packed record
+        IndexCount    : word;
+        Entries       : record end;
+      end;
+
+      THLPKeywordDescriptor = record
+        KwContext     : word;
+      end;
+
+      THLPKeyWordRecord = record
+        UpContext     : word;
+        DownContext   : word;
+        KeyWordCount  : word;
+        Keywords      : array[0..0] of THLPKeywordDescriptor;
+      end;
+
+      TRecord = packed record
+        SClass   : byte;
+        Size     : word;
+        Data     : pointer;
+      end;
+
+      PIndexEntry = ^TIndexEntry;
+      TIndexEntry = packed record
+        Tag        : PString;
+        HelpCtx    : word;
+        FileID     : word;
+      end;
+
+      PKeywordDescriptor = ^TKeywordDescriptor;
+      TKeywordDescriptor = packed record
+        FileID     : word;
+        Context    : word;
+      end;
+
+      PKeywordDescriptors = ^TKeywordDescriptors;
+      TKeywordDescriptors = array[0..16382] of TKeywordDescriptor;
+
+      PTopic = ^TTopic;
+      TTopic = record
+        HelpCtx       : word;
+        FileOfs       : longint;
+        TextSize      : word;
+        Text          : pointer;
+        LinkCount     : word;
+        LinkSize      : word;
+        Links         : PKeywordDescriptors;
+        LastAccess    : longint;
+        FileID        : word;
+      end;
+
+      PUnsortedStringCollection = ^TUnsortedStringCollection;
+      TUnsortedStringCollection = object(TCollection)
+        function   At(Index: Integer): PString;
+        procedure FreeItem(Item: Pointer); virtual;
+      end;
+
+      PTopicCollection = ^TTopicCollection;
+      TTopicCollection = object(TCollection)
+        function   At(Index: Integer): PTopic;
+        procedure  FreeItem(Item: Pointer); virtual;
+        function   SearchTopic(AHelpCtx: word): PTopic;
+      end;
+
+      PIndexEntryCollection = ^TIndexEntryCollection;
+      TIndexEntryCollection = object(TSortedCollection)
+        function   At(Index: Sw_Integer): PIndexEntry;
+        procedure  FreeItem(Item: Pointer); virtual;
+        function   Compare(Key1, Key2: Pointer): Sw_Integer; virtual;
+      end;
+
+      PHelpFile = ^THelpFile;
+      THelpFile = object(TObject)
+        Version      : THLPVersion;
+        Header       : THLPFileHeader;
+        Compression  : THLPCompression;
+        Topics       : PTopicCollection;
+        IndexEntries : PIndexEntryCollection;
+        ID           : word;
+        constructor Init(AFileName: string; AID: word);
+        function    LoadTopic(HelpCtx: word): PTopic; virtual;
+        destructor  Done; virtual;
+      private
+        F: PBufStream;
+        TopicsRead     : boolean;
+        IndexTableRead : boolean;
+        CompressionRead: boolean;
+        IndexTagsRead  : boolean;
+        IndexTagsPos   : longint;
+        IndexTablePos  : longint;
+        function  ReadHeader: boolean;
+        function  ReadTopics: boolean;
+        function  ReadIndexTable: boolean;
+        function  ReadCompression: boolean;
+        function  ReadIndexTags: boolean;
+        function  ReadRecord(var R: TRecord; ReadData: boolean): boolean;
+        function  ReadTopic(T: PTopic): boolean;
+        procedure MaintainTopicCache;
+      end;
+
+      PHelpFileCollection = PCollection;
+
+      PHelpFacility = ^THelpFacility;
+      THelpFacility = object(TObject)
+        HelpFiles: PHelpFileCollection;
+        IndexTabSize: integer;
+        constructor Init;
+        function    AddHelpFile(FileName: string): boolean; virtual;
+        function    LoadTopic(SourceFileID: word; Context: word): PTopic; virtual;
+        function    TopicSearch(Keyword: string; var FileID, Context: word): boolean; virtual;
+        function    BuildIndexTopic: PTopic; virtual;
+        destructor  Done; virtual;
+      private
+        LastID: word;
+        function  SearchFile(ID: byte): PHelpFile;
+        function  SearchTopicInHelpFile(F: PHelpFile; Context: word): PTopic;
+        function  SearchTopicOwner(SourceFileID: word; Context: word): PHelpFile;
+      end;
+
+const TopicCacheSize    : integer = 10;
+      HelpStreamBufSize : integer = 4096;
+      HelpFacility      : PHelpFacility = nil;
+      MaxHelpTopicSize  : word = 65520;
+
+procedure DisposeTopic(P: PTopic);
+
+implementation
+
+uses
+  drivers;
+
+type
+     PByteArray = ^TByteArray;
+     TByteArray = array[0..65520] of byte;
+
+function CharStr(C: char; Count: byte): string;
+var S: string;
+begin
+  S[0]:=chr(Count);
+  FillChar(S[1],Count,C);
+  CharStr:=S;
+end;
+
+function RExpand(S: string; MinLen: byte): string;
+begin
+  if length(S)<MinLen then
+     S:=S+CharStr(' ',MinLen-length(S));
+  RExpand:=S;
+end;
+
+function UpcaseStr(S: string): string;
+var I: integer;
+begin
+  for I:=1 to length(S) do
+      S[I]:=Upcase(S[I]);
+  UpcaseStr:=S;
+end;
+
+procedure DisposeRecord(var R: TRecord);
+begin
+  with R do
+  if (Size>0) and (Data<>nil) then FreeMem(Data, Size);
+  FillChar(R, SizeOf(R), 0);
+end;
+
+function NewTopic(FileID: byte; HelpCtx: word; Pos: longint): PTopic;
+var P: PTopic;
+begin
+  New(P); FillChar(P^,SizeOf(P^), 0);
+  P^.HelpCtx:=HelpCtx; P^.FileOfs:=Pos; P^.FileID:=FileID;
+  NewTopic:=P;
+end;
+
+procedure DisposeTopic(P: PTopic);
+begin
+  if P<>nil then
+  begin
+    if (P^.TextSize>0) and (P^.Text<>nil) then
+       FreeMem(P^.Text,P^.TextSize);
+    P^.Text:=nil;
+    if (P^.LinkCount>0) and (P^.Links<>nil) then
+       FreeMem(P^.Links,P^.LinkSize);
+    P^.Links:=nil;
+    Dispose(P);
+  end;
+end;
+
+function CloneTopic(T: PTopic): PTopic;
+var NT: PTopic;
+begin
+  New(NT); Move(T^,NT^,SizeOf(NT^));
+  if NT^.Text<>nil then
+     begin GetMem(NT^.Text,NT^.TextSize); Move(T^.Text^,NT^.Text^,NT^.TextSize); end;
+  if NT^.Links<>nil then
+     begin GetMem(NT^.Links,NT^.LinkSize); Move(T^.Links^,NT^.Links^,NT^.LinkSize); end;
+  CloneTopic:=NT;
+end;
+
+function NewIndexEntry(Tag: string; FileID, HelpCtx: word): PIndexEntry;
+var P: PIndexEntry;
+begin
+  New(P); FillChar(P^,SizeOf(P^), 0);
+  P^.Tag:=NewStr(Tag); P^.FileID:=FileID; P^.HelpCtx:=HelpCtx;
+  NewIndexEntry:=P;
+end;
+
+procedure DisposeIndexEntry(P: PIndexEntry);
+begin
+  if P<>nil then
+  begin
+    if P^.Tag<>nil then DisposeStr(P^.Tag);
+    Dispose(P);
+  end;
+end;
+
+function TUnsortedStringCollection.At(Index: Integer): PString;
+begin
+  At:=inherited At(Index);
+end;
+
+procedure TUnsortedStringCollection.FreeItem(Item: Pointer);
+begin
+  if Item<>nil then DisposeStr(Item);
+end;
+
+function TTopicCollection.At(Index: Integer): PTopic;
+begin
+  At:=inherited At(Index);
+end;
+
+procedure TTopicCollection.FreeItem(Item: Pointer);
+begin
+  if Item<>nil then DisposeTopic(Item);
+end;
+
+function TTopicCollection.SearchTopic(AHelpCtx: word): PTopic;
+function Match(P: PTopic): boolean;{$ifndef FPC}far;{$endif}
+begin Match:=(P^.HelpCtx=AHelpCtx); end;
+begin
+  SearchTopic:=FirstThat(@Match);
+end;
+
+function TIndexEntryCollection.At(Index: Sw_Integer): PIndexEntry;
+begin
+  At:=inherited At(Index);
+end;
+
+procedure TIndexEntryCollection.FreeItem(Item: Pointer);
+begin
+  if Item<>nil then DisposeIndexEntry(Item);
+end;
+
+function TIndexEntryCollection.Compare(Key1, Key2: Pointer): Sw_Integer;
+var K1: PIndexEntry absolute Key1;
+    K2: PIndexEntry absolute Key2;
+    R: Sw_integer;
+    S1,S2: string;
+begin
+  S1:=UpcaseStr(K1^.Tag^); S2:=UpcaseStr(K2^.Tag^);
+  if S1<S2 then R:=-1 else
+  if S1>S2 then R:=1 else
+  R:=0;
+  Compare:=R;
+end;
+
+constructor THelpFile.Init(AFileName: string; AID: word);
+var OK: boolean;
+    FS,L: longint;
+    R: TRecord;
+begin
+  inherited Init;
+  ID:=AID;
+  New(Topics, Init(500,500));
+  New(IndexEntries, Init(200,100));
+  New(F, Init(AFileName, stOpenRead, HelpStreamBufSize));
+  OK:=F<>nil;
+  if OK then OK:=(F^.Status=stOK);
+  if OK then begin FS:=F^.GetSize; OK:=ReadHeader; end;
+  while OK do
+  begin
+    L:=F^.GetPos;
+    if (L>=FS) then Break;
+    OK:=ReadRecord(R,false);
+    if (OK=false) or (R.SClass=0) or (R.Size=0) then Break;
+    case R.SClass of
+      rtContext     : begin F^.Seek(L); OK:=ReadTopics; end;
+      rtText        : {Skip};
+      rtKeyword     : {Skip};
+      rtIndex       : begin IndexTablePos:=L; {OK:=ReadIndexTable; }end;
+      rtCompression : begin F^.Seek(L); OK:=ReadCompression; end;
+      rtIndexTags   : begin IndexTagsPos:=L; {OK:=ReadIndexTags; }end;
+    else {Skip};
+    end;
+    if OK then
+       begin Inc(L, SizeOf(THLPRecordHeader)); Inc(L, R.Size); F^.Seek(L); OK:=(F^.Status=stOK); end
+  end;
+  OK:=OK and (TopicsRead=true);
+  if OK=false then Fail;
+end;
+
+function THelpFile.ReadHeader: boolean;
+var S: string;
+    P: longint;
+    R: TRecord;
+    OK: boolean;
+begin
+  F^.Seek(0);
+  F^.Read(S[1],255); S[0]:=#255;
+  OK:=(F^.Status=stOK); P:=Pos(Signature,S);
+  OK:=OK and (P>0);
+  if OK then
+  begin
+    F^.Seek(P+length(Signature)-1);
+    F^.Read(Version,SizeOf(Version));
+    OK:=(F^.Status=stOK) and (Version.FormatVersion>=MinFormatVersion);
+    if OK then OK:=ReadRecord(R,true);
+    OK:=OK and (R.SClass=rtFileHeader) and (R.Size=SizeOf(Header));
+    if OK then Move(R.Data^,Header,SizeOf(Header));
+    DisposeRecord(R);
+  end;
+  ReadHeader:=OK;
+end;
+
+function THelpFile.ReadTopics: boolean;
+var OK: boolean;
+    R: TRecord;
+    L,I: longint;
+function GetCtxPos(C: THLPContextPos): longint;
+begin
+  GetCtxPos:=longint(C.HiB) shl 16 + C.LoW;
+end;
+begin
+  OK:=ReadRecord(R, true);
+  if OK then
+  with THLPContexts(R.Data^) do
+  for I:=1 to ContextCount-1 do
+  begin
+    if Topics^.Count=MaxCollectionSize then Break;
+    L:=GetCtxPos(Contexts[I]);
+    if (L and $800000)<>0 then L:=not L;
+    if (L=-1) and (Header.MainIndexScreen>0) then
+       L:=GetCtxPos(Contexts[Header.MainIndexScreen]);
+    if (L>0) then
+      Topics^.Insert(NewTopic(ID,I,L));
+  end;
+  DisposeRecord(R);
+  TopicsRead:=OK;
+  ReadTopics:=OK;
+end;
+
+function THelpFile.ReadIndexTable: boolean;
+var OK: boolean;
+    R: TRecord;
+    I: longint;
+    LastTag,S: string;
+    CurPtr,HelpCtx: word;
+    LenCode,CopyCnt,AddLen: byte;
+begin
+  if IndexTableRead then OK:=true else
+ begin
+  LastTag:=''; CurPtr:=0;
+  OK:=(IndexTablePos<>0);
+  if OK then begin F^.Seek(IndexTablePos); OK:=F^.Status=stOK; end;
+  if OK then OK:=ReadRecord(R, true);
+  if OK then
+  with THLPIndexTable(R.Data^) do
+  for I:=0 to IndexCount-1 do
+  begin
+    LenCode:=PByteArray(@Entries)^[CurPtr];
+    AddLen:=LenCode and $1f; CopyCnt:=LenCode shr 5;
+    S[0]:=chr(AddLen); Move(PByteArray(@Entries)^[CurPtr+1],S[1],AddLen);
+    LastTag:=copy(LastTag,1,CopyCnt)+S;
+    Move(PByteArray(@Entries)^[CurPtr+1+AddLen],HelpCtx,2);
+    IndexEntries^.Insert(NewIndexEntry(LastTag,ID,HelpCtx));
+    Inc(CurPtr,1+AddLen+2);
+  end;
+  DisposeRecord(R);
+  IndexTableRead:=OK;
+ end;
+  ReadIndexTable:=OK;
+end;
+
+function THelpFile.ReadCompression: boolean;
+var OK: boolean;
+    R: TRecord;
+begin
+  OK:=ReadRecord(R, true);
+  OK:=OK and (R.Size=SizeOf(THLPCompression));
+  if OK then Move(R.Data^,Compression,SizeOf(Compression));
+  DisposeRecord(R);
+  CompressionRead:=OK;
+  ReadCompression:=OK;
+end;
+
+function THelpFile.ReadIndexTags: boolean;
+var OK: boolean;
+begin
+  OK:={ReadRecord(R, true)}true;
+  IndexTagsRead:=OK;
+  ReadIndexTags:=OK;
+end;
+
+function THelpFile.ReadRecord(var R: TRecord; ReadData: boolean): boolean;
+var OK: boolean;
+    H: THLPRecordHeader;
+begin
+  FillChar(R, SizeOf(R), 0);
+  F^.Read(H,SizeOf(H));
+  OK:=F^.Status=stOK;
+  if OK then
+  begin
+    R.SClass:=H.RecType; R.Size:=H.RecLength;
+    if (R.Size>0) and ReadData then
+    begin
+      GetMem(R.Data,R.Size);
+      F^.Read(R.Data^,R.Size);
+      OK:=F^.Status=stOK;
+    end;
+    if OK=false then DisposeRecord(R);
+  end;
+  ReadRecord:=OK;
+end;
+
+function THelpFile.ReadTopic(T: PTopic): boolean;
+var SrcPtr,DestPtr: word;
+    NewR: TRecord;
+function ExtractTextRec(var R: TRecord): boolean;
+function GetNextNibble: byte;
+var B,N: byte;
+begin
+  B:=PByteArray(R.Data)^[SrcPtr div 2];
+  N:=( B and ($0f shl (4*(SrcPtr mod 2))) ) shr (4*(SrcPtr mod 2));
+  Inc(SrcPtr);
+  GetNextNibble:=N;
+end;
+procedure AddChar(C: char);
+begin
+  PByteArray(NewR.Data)^[DestPtr]:=ord(C);
+  Inc(DestPtr);
+end;
+var OK: boolean;
+    C: char;
+    P: pointer;
+function GetNextChar: char;
+var C: char;
+    I,N,Cnt: byte;
+begin
+  N:=GetNextNibble;
+  case N of
+    $00       : C:=#0;
+    $01..$0D  : C:=chr(Compression.CharTable[N]);
+    ncRawChar : C:=chr(GetNextNibble*16+GetNextNibble);
+    ncRepChar : begin
+                  Cnt:=2+GetNextNibble;
+                  C:=GetNextChar{$ifdef FPC}(){$endif};
+                  for I:=1 to Cnt-1 do AddChar(C);
+                end;
+  end;
+  GetNextChar:=C;
+end;
+begin
+  OK:=Compression.CompType in[ctNone,ctNibble];
+  if OK then
+  case Compression.CompType of
+       ctNone   : ;
+       ctNibble :
+         begin
+           NewR.SClass:=R.SClass;
+           NewR.Size:=MaxHelpTopicSize; { R.Size*2 <- bug fixed, i didn't care of RLL codings }
+           GetMem(NewR.Data, NewR.Size);
+           SrcPtr:=0; DestPtr:=0;
+           while SrcPtr<(R.Size*2) do
+           begin
+             C:=GetNextChar;
+             AddChar(C);
+           end;
+           DisposeRecord(R); R:=NewR;
+           if (R.Size>DestPtr) then
+           begin
+             P:=R.Data; GetMem(R.Data,DestPtr);
+             Move(P^,R.Data^,DestPtr); FreeMem(P,R.Size); R.Size:=DestPtr;
+           end;
+         end;
+  else OK:=false;
+  end;
+  ExtractTextRec:=OK;
+end;
+var OK: boolean;
+    TextR,KeyWR: TRecord;
+    W,I: word;
+begin
+  OK:=T<>nil;
+  if OK and (T^.Text=nil) then
+  begin
+    FillChar(TextR,SizeOf(TextR),0); FillChar(KeyWR,SizeOf(KeyWR),0);
+    F^.Seek(T^.FileOfs); OK:=F^.Status=stOK;
+    if OK then OK:=ReadRecord(TextR,true);
+    OK:=OK and (TextR.SClass=rtText);
+    if OK then OK:=ReadRecord(KeyWR,true);
+    OK:=OK and (KeyWR.SClass=rtKeyword);
+
+    if OK then OK:=ExtractTextRec(TextR);
+    if OK then
+    begin
+      if TextR.Size>0 then
+      begin
+        T^.Text:=TextR.Data; T^.TextSize:=TextR.Size;
+        TextR.Data:=nil; TextR.Size:=0;
+      end;
+      with THLPKeywordRecord(KeyWR.Data^) do
+      begin
+        T^.LinkCount:=KeywordCount;
+        W:=T^.LinkCount*SizeOf(T^.Links^[0]);
+        T^.LinkSize:=W; GetMem(T^.Links,T^.LinkSize);
+        if KeywordCount>0 then
+        for I:=0 to KeywordCount-1 do
+        begin
+          T^.Links^[I].Context:=Keywords[I].KwContext;
+          T^.Links^[I].FileID:=ID;
+        end;
+      end;
+    end;
+
+    DisposeRecord(TextR); DisposeRecord(KeyWR);
+  end;
+  ReadTopic:=OK;
+end;
+
+function THelpFile.LoadTopic(HelpCtx: word): PTopic;
+var T: PTopic;
+begin
+  T:=Topics^.SearchTopic(HelpCtx);
+  if (T<>nil) then
+     if T^.Text=nil then
+     begin
+       MaintainTopicCache;
+       if ReadTopic(T)=false then T:=nil;
+       if (T<>nil) and (T^.Text=nil) then T:=nil;
+     end;
+  if T<>nil then
+     begin T^.LastAccess:=GetDosTicks; T:=CloneTopic(T); end;
+  LoadTopic:=T;
+end;
+
+procedure THelpFile.MaintainTopicCache;
+var Count: integer;
+    MinP: PTopic;
+    MinLRU: longint;
+procedure CountThem(P: PTopic); {$ifndef FPC}far;{$endif}
+begin if (P^.Text<>nil) or (P^.Links<>nil) then Inc(Count); end;
+procedure SearchLRU(P: PTopic); {$ifndef FPC}far;{$endif}
+begin if P^.LastAccess<MinLRU then begin MinLRU:=P^.LastAccess; MinP:=P; end; end;
+var P: PTopic;
+begin
+  Count:=0; Topics^.ForEach(@CountThem);
+  if (Count>=TopicCacheSize) then
+  begin
+    MinLRU:=MaxLongint; P:=nil; Topics^.ForEach(@SearchLRU);
+    if P<>nil then
+    begin
+      FreeMem(P^.Text,P^.TextSize); P^.TextSize:=0; P^.Text:=nil;
+      FreeMem(P^.Links,P^.LinkSize); P^.LinkSize:=0; P^.LinkCount:=0; P^.Links:=nil;
+    end;
+  end;
+end;
+
+destructor THelpFile.Done;
+begin
+  if Topics<>nil then Dispose(Topics, Done);
+  if IndexEntries<>nil then Dispose(IndexEntries, Done);
+  if F<>nil then Dispose(F, Done);
+  inherited Done;
+end;
+
+constructor THelpFacility.Init;
+begin
+  inherited Init;
+  New(HelpFiles, Init(10,10));
+  IndexTabSize:=40;
+end;
+
+function THelpFacility.AddHelpFile(FileName: string): boolean;
+var H: PHelpFile;
+begin
+  New(H, Init(FileName, LastID+1));
+  if H<>nil then
+     begin
+       HelpFiles^.Insert(H); Inc(LastID);
+     end;
+  AddHelpFile:=true;
+end;
+
+function THelpFacility.SearchTopicOwner(SourceFileID: word; Context: word): PHelpFile;
+var P: PTopic;
+    HelpFile: PHelpFile;
+function Search(F: PHelpFile): boolean; {$ifndef FPC}far;{$endif}
+begin
+  P:=SearchTopicInHelpFile(F,Context); if P<>nil then HelpFile:=F;
+  Search:=P<>nil;
+end;
+begin
+  HelpFile:=nil;
+  if SourceFileID=0 then P:=nil else
+     begin
+       HelpFile:=SearchFile(SourceFileID);
+       P:=SearchTopicInHelpFile(HelpFile,Context);
+     end;
+  if P=nil then HelpFiles^.FirstThat(@Search);
+  if P=nil then HelpFile:=nil;
+  SearchTopicOwner:=HelpFile;
+end;
+
+function THelpFacility.LoadTopic(SourceFileID: word; Context: word): PTopic;
+var P: PTopic;
+    H: PHelpFile;
+begin
+  if (SourceFileID=0) and (Context=0) then
+     P:=BuildIndexTopic else
+  begin
+    H:=SearchTopicOwner(SourceFileID,Context);
+    if (H=nil) then P:=nil else
+       P:=H^.LoadTopic(Context);
+  end;
+  LoadTopic:=P;
+end;
+
+function THelpFacility.TopicSearch(Keyword: string; var FileID, Context: word): boolean;
+function ScanHelpFile(H: PHelpFile): boolean; {$ifndef FPC}far;{$endif}
+function Search(P: PIndexEntry): boolean; {$ifndef FPC}far;{$endif}
+begin
+  Search:=copy(UpcaseStr(P^.Tag^),1,length(Keyword))=Keyword;
+end;
+var P: PIndexEntry;
+begin
+  H^.ReadIndexTable;
+  P:=H^.IndexEntries^.FirstThat(@Search);
+  if P<>nil then begin FileID:=H^.ID; Context:=P^.HelpCtx; end;
+  ScanHelpFile:=P<>nil;
+end;
+begin
+  Keyword:=UpcaseStr(Keyword);
+  TopicSearch:=HelpFiles^.FirstThat(@ScanHelpFile)<>nil;
+end;
+
+function THelpFacility.BuildIndexTopic: PTopic;
+var T: PTopic;
+    Keywords: PIndexEntryCollection;
+    Lines: PUnsortedStringCollection;
+procedure InsertKeywordsOfFile(H: PHelpFile); {$ifndef FPC}far;{$endif}
+function InsertKeywords(P: PIndexEntry): boolean; {$ifndef FPC}far;{$endif}
+begin
+  Keywords^.Insert(P);
+  InsertKeywords:=Keywords^.Count>=MaxCollectionSize;
+end;
+begin
+  H^.ReadIndexTable;
+  if Keywords^.Count<MaxCollectionSize then
+  H^.IndexEntries^.FirstThat(@InsertKeywords);
+end;
+procedure AddLine(S: string);
+begin
+  if S='' then S:=' ';
+  Lines^.Insert(NewStr(S));
+end;
+procedure RenderTopic;
+var Size,CurPtr,I: word;
+    S: string;
+function CountSize(P: PString): boolean; {$ifndef FPC}far;{$endif} begin Inc(Size, length(P^)+1); CountSize:=Size>65200; end;
+begin
+  Size:=0; Lines^.FirstThat(@CountSize);
+  T^.TextSize:=Size; GetMem(T^.Text,T^.TextSize);
+  CurPtr:=0;
+  for I:=0 to Lines^.Count-1 do
+  begin
+    S:=Lines^.At(I)^;
+    Size:=length(S)+1; S[Size]:=#0;
+    Move(S[1],PByteArray(T^.Text)^[CurPtr],Size);
+    Inc(CurPtr,Size);
+    if CurPtr>=T^.TextSize then Break;
+  end;
+end;
+var Line: string;
+procedure FlushLine;
+begin
+  if Line<>'' then AddLine(Line); Line:='';
+end;
+var KWCount,NLFlag: integer;
+    LastFirstChar: char;
+procedure NewSection(FirstChar: char);
+begin
+  if FirstChar<=#64 then FirstChar:=#32;
+  FlushLine;
+  AddLine('');
+  AddLine(FirstChar);
+  AddLine('');
+  LastFirstChar:=FirstChar;
+  NLFlag:=0;
+end;
+procedure AddKeyword(KWS: string);
+begin
+  Inc(KWCount); if KWCount=1 then NLFlag:=0;
+  if (KWCount=1) or
+     ( (Upcase(KWS[1])<>LastFirstChar) and ( (LastFirstChar>#64) or (KWS[1]>#64) ) ) then
+     NewSection(Upcase(KWS[1]));
+  if (NLFlag mod 2)=0
+     then Line:=' '+#2+KWS+#2
+     else begin
+            Line:=RExpand(Line,IndexTabSize)+#2+KWS+#2;
+            FlushLine;
+          end;
+  Inc(NLFlag);
+end;
+var KW: PIndexEntry;
+    I: integer;
+begin
+  New(Keywords, Init(5000,1000));
+  HelpFiles^.ForEach(@InsertKeywordsOfFile);
+  New(Lines, Init((Keywords^.Count div 2)+100,100));
+  T:=NewTopic(0,0,0);
+  if HelpFiles^.Count=0 then AddLine('No help files installed.') else
+  begin
+    AddLine(' Help index');
+    KWCount:=0; Line:='';
+    T^.LinkCount:=Keywords^.Count;
+    T^.LinkSize:=T^.LinkCount*SizeOf(T^.Links^[0]);
+    GetMem(T^.Links,T^.LinkSize);
+
+    for I:=0 to Keywords^.Count-1 do
+    begin
+      KW:=Keywords^.At(I);
+      AddKeyword(KW^.Tag^);
+      T^.Links^[I].Context:=KW^.HelpCtx; T^.Links^[I].FileID:=KW^.FileID;
+    end;
+    FlushLine;
+    AddLine('');
+  end;
+  RenderTopic;
+  Dispose(Lines, Done);
+  Keywords^.DeleteAll; Dispose(Keywords, Done);
+  BuildIndexTopic:=T;
+end;
+
+function THelpFacility.SearchFile(ID: byte): PHelpFile;
+function Match(P: PHelpFile): boolean; {$ifndef FPC}far;{$endif}
+begin
+  Match:=(P^.ID=ID);
+end;
+begin
+  SearchFile:=HelpFiles^.FirstThat(@Match);
+end;
+
+function THelpFacility.SearchTopicInHelpFile(F: PHelpFile; Context: word): PTopic;
+var P: PTopic;
+begin
+  if F=nil then P:=nil else
+  P:=F^.Topics^.SearchTopic(Context);
+  SearchTopicInHelpFile:=P;
+end;
+
+destructor THelpFacility.Done;
+begin
+  inherited Done;
+  Dispose(HelpFiles, Done);
+end;
+
+END.
+{
+  $Log$
+  Revision 1.1  1998-12-22 14:27:54  peter
+    * moved
+
+  Revision 1.4  1998/12/22 10:39:55  peter
+    + options are now written/read
+    + find and replace routines
+
+}

ide/text/whlpview.pas

@@ -0,0 +1,1041 @@
+{
+    $Id$
+    This file is part of the Free Pascal Integrated Development Environment
+    Copyright (c) 1998 by Berczi Gabor
+
+    Help display objects
+
+    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.
+
+ **********************************************************************}
+unit WHlpView;
+
+interface
+
+uses
+  Objects,Drivers,Commands,Views,
+{$ifdef EDITORS}
+  Editors,
+{$else}
+  WEditor,
+{$endif}
+  WHelp;
+
+{$IFNDEF EDITORS}
+type
+    TEditor = TCodeEditor; PEditor = PCodeEditor;
+{$ENDIF}
+
+const
+     cmPrevTopic         = 90;
+     HistorySize         = 30;
+
+     CHelpViewer         = #33#34#35#36;
+     CHelpFrame          = #37#37#38#38#39;
+
+type
+      PHelpLink = ^THelpLink;
+      THelpLink = record
+        Bounds   : TRect;
+        Context  : word;
+      end;
+
+      PHelpColorArea = ^THelpColorArea;
+      THelpColorArea = record
+        Color    : byte;
+        Bounds   : TRect;
+      end;
+
+      PHelpKeyword = ^THelpKeyword;
+      THelpKeyword = record
+        KWord    : PString;
+        Index    : integer;
+      end;
+
+      PLinkCollection = ^TLinkCollection;
+      TLinkCollection = object(TCollection)
+        procedure FreeItem(Item: Pointer); virtual;
+      end;
+
+      PColorAreaCollection = ^TColorAreaCollection;
+      TColorAreaCollection = object(TCollection)
+        procedure FreeItem(Item: Pointer); virtual;
+      end;
+
+      PKeywordCollection = ^TKeywordCollection;
+      TKeywordCollection = object({TSorted}TCollection)
+        function  At(Index: Integer): PHelpKeyword;
+        procedure FreeItem(Item: Pointer); virtual;
+        function  Compare(Key1, Key2: Pointer): Integer; virtual;
+      end;
+
+{      TSearchRelation = (srEqual,srGreater,srLess,srGreatEqu,srLessEqu);
+
+      PAdvancedStringCollection = ^TAdvancedStringCollection;
+      TAdvancedStringCollection = object(TStringCollection)
+        function SearchItem(Key: pointer; Rel: TSearchRelation; var Index: integer): boolean; virtual;
+      end;}
+
+      PHelpTopic = ^THelpTopic;
+      THelpTopic = object(TObject)
+        Topic: PTopic;
+        Lines: PUnsortedStringCollection;
+        Links: PLinkCollection;
+        ColorAreas: PColorAreaCollection;
+        constructor Init(ATopic: PTopic);
+        procedure   SetParams(AMargin, AWidth: integer); virtual;
+        function    GetLineCount: integer; virtual;
+        function    GetLineText(Line: integer): string; virtual;
+        function    GetLinkCount: integer; virtual;
+        procedure   GetLinkBounds(Index: integer; var R: TRect); virtual;
+        function    GetLinkContext(Index: integer): word; virtual;
+        function    GetColorAreaCount: integer; virtual;
+        procedure   GetColorAreaBounds(Index: integer; var R: TRect); virtual;
+        function    GetColorAreaColor(Index: integer): word; virtual;
+        destructor  Done; virtual;
+      private
+        Width,Margin: integer;
+        StockItem: boolean;
+        procedure  ReBuild;
+      end;
+
+      THelpHistoryEntry = record
+        Context_     : word;
+        Delta_       : TPoint;
+        CurPos_      : TPoint;
+        CurLink_     : integer;
+        FileID_      : word;
+      end;
+
+      PHelpViewer = ^THelpViewer;
+      THelpViewer = object(TEditor)
+        Margin: integer;
+        HelpTopic: PHelpTopic;
+        CurLink: integer;
+        constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
+        procedure   ChangeBounds(var Bounds: TRect); virtual;
+        procedure   Draw; virtual;
+        procedure   HandleEvent(var Event: TEvent); virtual;
+        procedure   SetCurPtr(X,Y: integer); virtual;
+        function    GetLineCount: integer; virtual;
+        function    GetLineText(Line: integer): string; virtual;
+        function    GetLinkCount: integer; virtual;
+        procedure   GetLinkBounds(Index: integer; var R: TRect); virtual;
+        function    GetLinkContext(Index: integer): word; virtual;
+        function    GetLinkText(Index: integer): string; virtual;
+        function    GetColorAreaCount: integer; virtual;
+        procedure   GetColorAreaBounds(Index: integer; var R: TRect); virtual;
+        function    GetColorAreaColor(Index: integer): word; virtual;
+        procedure   SelectNextLink(ANext: boolean); virtual;
+        procedure   SwitchToIndex; virtual;
+        procedure   SwitchToTopic(SourceFileID: word; Context: word); virtual;
+        procedure   SetTopic(Topic: PTopic); virtual;
+        procedure   SetCurLink(Link: integer); virtual;
+        procedure   SelectLink(Index: integer); virtual;
+        procedure   PrevTopic; virtual;
+        procedure   RenderTopic; virtual;
+        procedure   Lookup(S: string); virtual;
+        function    GetPalette: PPalette; virtual;
+        destructor  Done; virtual;
+      private
+        History    : array[0..HistorySize] of THelpHistoryEntry;
+        HistoryPtr : integer;
+        WordList   : PKeywordCollection;
+        Lookupword : string;
+        InLookUp   : boolean;
+        IndexTopic : PTopic;
+        IndexHelpTopic: PHelpTopic;
+        function    LinkContainsPoint(var R: TRect; var P: TPoint): boolean;
+        procedure   ISwitchToTopic(SourceFileID: word; Context: word; RecordInHistory: boolean);
+        procedure   ISwitchToTopicPtr(P: PTopic; RecordInHistory: boolean);
+        procedure   BuildTopicWordList;
+      end;
+
+      PHelpFrame = ^THelpFrame;
+      THelpFrame = object(TFrame)
+        function GetPalette: PPalette; virtual;
+      end;
+
+      PHelpWindow = ^THelpWindow;
+      THelpWindow = object(TWindow)
+        HelpView: PHelpViewer;
+        HideOnClose: boolean;
+        constructor Init(var Bounds: TRect; ATitle: TTitleStr; ASourceFileID: word; AContext: word; ANumber: Integer);
+        procedure   InitFrame; virtual;
+        procedure   ShowIndex; virtual;
+        procedure   ShowTopic(SourceFileID: word; Context: word); virtual;
+        procedure   HandleEvent(var Event: TEvent); virtual;
+        procedure   Close; virtual;
+        function    GetPalette: PPalette; virtual; { needs to be overriden }
+      end;
+
+implementation
+
+uses Crt;
+
+const CommentColor = Blue;
+
+function Min(A,B: longint): longint; begin if A<B then Min:=A else Min:=B; end;
+function Max(A,B: longint): longint; begin if A>B then Max:=A else Max:=B; end;
+function CharStr(C: char; Count: byte): string;
+var S: string;
+begin S[0]:=chr(Count); if Count>0 then FillChar(S[1],Count,C); CharStr:=S; end;
+
+function Trim(S: string): string;
+const TrimChars : set of char = [#0,#9,' ',#255];
+begin
+  while (length(S)>0) and (S[1] in TrimChars) do Delete(S,1,1);
+  while (length(S)>0) and (S[length(S)] in TrimChars) do Delete(S,length(S),1);
+  Trim:=S;
+end;
+
+function UpcaseStr(S: string): string;
+var I: integer;
+begin
+  for I:=1 to length(S) do
+      S[I]:=Upcase(S[I]);
+  UpcaseStr:=S;
+end;
+
+function NewLink(Topic: word; StartP, EndP: TPoint): PHelpLink;
+var P: PHelpLink;
+begin
+  New(P); FillChar(P^, SizeOf(P^), 0);
+  P^.Context:=Topic; P^.Bounds.A:=StartP; P^.Bounds.B:=EndP;
+  NewLink:=P;
+end;
+
+procedure DisposeLink(P: PHelpLink);
+begin
+  if P<>nil then Dispose(P);
+end;
+
+function NewColorArea(Color: byte; StartP, EndP: TPoint): PHelpColorArea;
+var P: PHelpColorArea;
+begin
+  New(P); FillChar(P^, SizeOf(P^), 0);
+  P^.Color:=Color; P^.Bounds.A:=StartP; P^.Bounds.B:=EndP;
+  NewColorArea:=P;
+end;
+
+procedure DisposeColorArea(P: PHelpColorArea);
+begin
+  if P<>nil then Dispose(P);
+end;
+
+function NewKeyword(Index: integer; KWord: string): PHelpKeyword;
+var P: PHelpKeyword;
+begin
+  New(P); FillChar(P^, SizeOf(P^), 0);
+  P^.Index:=Index; P^.KWord:=NewStr(KWord);
+  NewKeyword:=P;
+end;
+
+procedure DisposeKeyword(P: PHelpKeyword);
+begin
+  if P<>nil then
+  begin
+    if P^.KWord<>nil then DisposeStr(P^.KWord);
+    Dispose(P);
+  end;
+end;
+
+procedure TLinkCollection.FreeItem(Item: Pointer);
+begin
+  if Item<>nil then DisposeLink(Item);
+end;
+
+procedure TColorAreaCollection.FreeItem(Item: Pointer);
+begin
+  if Item<>nil then DisposeColorArea(Item);
+end;
+
+function TKeywordCollection.At(Index: Integer): PHelpKeyword;
+begin
+  At:=inherited At(Index);
+end;
+
+procedure TKeywordCollection.FreeItem(Item: Pointer);
+begin
+  if Item<>nil then DisposeKeyword(Item);
+end;
+
+function TKeywordCollection.Compare(Key1, Key2: Pointer): Integer;
+var R: integer;
+    K1: PHelpKeyword absolute Key1;
+    K2: PHelpKeyword absolute Key2;
+    S1,S2: string;
+begin
+  S1:=UpcaseStr(K1^.KWord^); S2:=UpcaseStr(K2^.KWord^);
+  if S1<S2 then R:=-1 else
+  if S1>S2 then R:=1 else
+  R:=0;
+  Compare:=R;
+end;
+
+{function TAdvancedStringCollection.SearchItem(Key: pointer; Rel: TSearchRelation; var Index: integer): boolean;
+var
+  L, H, I, C: Integer;
+const resSmaller = -1; resEqual = 0; resGreater = 1;
+begin
+  Index:=-1;
+  case Rel of
+    srEqual  :
+      while (L <= H) and (Index=-1) do
+      begin
+        I := (L + H) shr 1;
+        C := Compare(KeyOf(Items^[I]), Key);
+        if C = resSmaller then L := I + 1 else
+        begin
+          H := I - 1;
+          if C = resEqual then
+          begin
+            if not Duplicates then L := I;
+            Index := L;
+          end;
+        end;
+      end;
+    srGreater  :
+      begin
+      end;
+    srLess     :
+      ;
+    srGreatEqu :
+      ;
+    srLessEqu  :
+      ;
+  else Exit;
+  end;
+  Search:=Index<>-1;
+end;}
+
+constructor THelpTopic.Init(ATopic: PTopic);
+begin
+  inherited Init;
+  Topic:=ATopic;
+  New(Lines, Init(100,100)); New(Links, Init(50,50)); New(ColorAreas, Init(50,50));
+end;
+
+procedure THelpTopic.SetParams(AMargin, AWidth: integer);
+begin
+  if Width<>AWidth then
+  begin
+    Width:=AWidth; Margin:=AMargin;
+    ReBuild;
+  end;
+end;
+
+procedure THelpTopic.ReBuild;
+var TextPos,LinkNo: word;
+    Line,CurWord: string;
+    C: char;
+    InLink,InColorArea: boolean;
+    LinkStart,LinkEnd,ColorAreaStart,ColorAreaEnd: TPoint;
+    CurPos: TPoint;
+    ZeroLevel: integer;
+procedure ClearLine;
+begin
+  Line:='';
+end;
+procedure AddWord(TheWord: string); forward;
+procedure NextLine;
+begin
+  Line:=CharStr(' ',Margin)+Line;
+  while copy(Line,length(Line),1)=' ' do Delete(Line,length(Line),1);
+  if Line='' then Line:=' ';
+  Lines^.Insert(NewStr(Line));
+  ClearLine;
+  CurPos.X:=Margin; Inc(CurPos.Y);
+  if InLink then LinkStart:=CurPos;
+end;
+procedure FlushLine;
+var W: string;
+begin
+  if CurWord<>'' then begin W:=CurWord; CurWord:=''; AddWord(W); end;
+  NextLine;
+end;
+procedure AddWord(TheWord: string);
+var W: string;
+begin
+  W:=TheWord; while copy(W,length(W),1)=' ' do Delete(W,length(W),1);
+  if (copy(Line+TheWord,1,1)<>' ') then
+    if (Line<>'') and (Margin+length(Line)+length(W)+Margin>Width) then
+       NextLine;
+  Line:=Line+TheWord;
+  CurPos.X:=Margin+length(Line);
+end;
+procedure CheckZeroLevel;
+begin
+  if ZeroLevel<>0 then
+     begin if CurWord<>'' then AddWord(CurWord+' '); CurWord:=''; ZeroLevel:=0; end;
+end;
+begin
+  Lines^.FreeAll; Links^.FreeAll;
+  if Topic=nil then Lines^.Insert(NewStr('No help available for this topic.')) else
+  begin
+    TextPos:=0; ClearLine; CurWord:=''; CurPos.X:=Margin; CurPos.Y:=0; LinkNo:=0;
+    InLink:=false; InColorArea:=false; ZeroLevel:=0;
+    while (TextPos<Topic^.TextSize) do
+    begin
+      C:=chr(PByteArray(Topic^.Text)^[TextPos]);
+      case C of
+        #0 : {if ZeroLevel=0 then ZeroLevel:=1 else
+                begin FlushLine; FlushLine; ZeroLevel:=0; end;}
+             if InLink then CurWord:=CurWord+' ' else
+                FlushLine;
+        #1 : Break;
+        #2 : begin
+               CheckZeroLevel;
+               if InLink=false then
+                  begin LinkStart:=CurPos; InLink:=true; end else
+                begin
+                  if CurWord<>'' then AddWord(CurWord); CurWord:='';
+                  LinkEnd:=CurPos; Dec(LinkEnd.X);
+                  Links^.Insert(NewLink(Topic^.Links^[LinkNo].Context,LinkStart,LinkEnd));
+                  Inc(LinkNo);
+                  InLink:=false;
+                end;
+              end;
+        #5 : begin
+               if InColorArea=false then
+                  ColorAreaStart:=CurPos else
+                begin
+                  if CurWord<>'' then AddWord(CurWord); CurWord:='';
+                  ColorAreaEnd:=CurPos; Dec(ColorAreaEnd.X);
+                  ColorAreas^.Insert(NewColorArea(CommentColor,ColorAreaStart,ColorAreaEnd));
+                end;
+               InColorArea:=not InColorArea;
+             end;
+        #32: if InLink then CurWord:=CurWord+C else
+                begin CheckZeroLevel; AddWord(CurWord+C); CurWord:=''; end;
+      else begin CheckZeroLevel; CurWord:=CurWord+C; end;
+      end;
+      CurPos.X:=Margin+length(Line)+length(CurWord);
+      Inc(TextPos);
+    end;
+    if (Line<>'') or (CurWord<>'') then FlushLine;
+  end;
+end;
+
+function THelpTopic.GetLineCount: integer;
+begin
+  GetLineCount:=Lines^.Count;
+end;
+
+function THelpTopic.GetLineText(Line: integer): string;
+var S: string;
+begin
+  if Line<GetLineCount then S:=PString(Lines^.At(Line))^ else S:='';
+  GetLineText:=S;
+end;
+
+function THelpTopic.GetLinkCount: integer;
+begin
+  GetLinkCount:=Links^.Count;
+end;
+
+procedure THelpTopic.GetLinkBounds(Index: integer; var R: TRect);
+var P: PHelpLink;
+begin
+  P:=Links^.At(Index);
+  R:=P^.Bounds;
+end;
+
+function THelpTopic.GetLinkContext(Index: integer): word;
+var P: PHelpLink;
+begin
+  P:=Links^.At(Index);
+  GetLinkContext:=P^.Context;
+end;
+
+function THelpTopic.GetColorAreaCount: integer;
+begin
+  GetColorAreaCount:=ColorAreas^.Count;
+end;
+
+procedure THelpTopic.GetColorAreaBounds(Index: integer; var R: TRect);
+var P: PHelpColorArea;
+begin
+  P:=ColorAreas^.At(Index);
+  R:=P^.Bounds;
+end;
+
+function THelpTopic.GetColorAreaColor(Index: integer): word;
+var P: PHelpColorArea;
+begin
+  P:=ColorAreas^.At(Index);
+  GetColorAreaColor:=P^.Color;
+end;
+
+destructor THelpTopic.Done;
+begin
+  inherited Done;
+  Dispose(Lines, Done); Dispose(Links, Done); Dispose(ColorAreas, Done);
+  if (Topic<>nil) then DisposeTopic(Topic);
+end;
+
+constructor THelpViewer.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
+begin
+  inherited Init(Bounds, AHScrollBar, AVScrollBar, nil, 0);
+  Flags:=0; IsReadOnly:=true;
+  New(WordList, Init(50,50));
+  Margin:=1; CurLink:=-1;
+end;
+
+procedure THelpViewer.ChangeBounds(var Bounds: TRect);
+begin
+  if Owner<>nil then Owner^.Lock;
+  inherited ChangeBounds(Bounds);
+  if (HelpTopic<>nil) and (HelpTopic^.Topic<>nil) and
+     (HelpTopic^.Topic^.FileID<>0) then RenderTopic;
+  if Owner<>nil then Owner^.UnLock;
+end;
+
+procedure THelpViewer.RenderTopic;
+begin
+  if HelpTopic<>nil then
+    HelpTopic^.SetParams(Margin,Size.X);
+{$ifndef EDITORS}
+  SetLimit(255,GetLineCount);
+{$endif}
+  DrawView;
+end;
+
+function THelpViewer.LinkContainsPoint(var R: TRect; var P: TPoint): boolean;
+var OK: boolean;
+begin
+  if (R.A.Y=R.B.Y) then
+    OK:= (P.Y=R.A.Y) and (R.A.X<=P.X) and (P.X<=R.B.X) else
+    OK:=
+    ( (R.A.Y=P.Y) and (R.A.X<=P.X) ) or
+    ( (R.A.Y<P.Y) and (P.Y<R.B.Y)  ) or
+    ( (R.B.Y=P.Y) and (P.X<=R.B.X) );
+  LinkContainsPoint:=OK;
+end;
+
+procedure THelpViewer.SetCurPtr(X,Y: integer);
+var OldCurLink,I: integer;
+    OldPos,P: TPoint;
+    R: TRect;
+begin
+  OldPos:=CurPos;
+  OldCurLink:=CurLink;
+  inherited SetCurPtr(X,Y);
+  CurLink:=-1;
+  P:=CurPos;
+  for I:=0 to GetLinkCount-1 do
+  begin
+    GetLinkBounds(I,R);
+    if LinkContainsPoint(R,P) then
+       begin CurLink:=I; Break; end;
+  end;
+  if OldCurLink<>CurLink then DrawView;
+  if ((OldPos.X<>CurPos.X) or (OldPos.Y<>CurPos.Y)) and (InLookup=false) then
+     Lookup('');
+end;
+
+function THelpViewer.GetLineCount: integer;
+var Count: integer;
+begin
+  if HelpTopic=nil then Count:=0 else Count:=HelpTopic^.GetLineCount;
+  GetLineCount:=Count;
+end;
+
+function THelpViewer.GetLineText(Line: integer): string;
+var S: string;
+begin
+  if HelpTopic=nil then S:='' else S:=HelpTopic^.GetLineText(Line);
+  GetLineText:=S;
+end;
+
+function THelpViewer.GetLinkCount: integer;
+var Count: integer;
+begin
+  if HelpTopic=nil then Count:=0 else Count:=HelpTopic^.GetLinkCount;
+  GetLinkCount:=Count;
+end;
+
+procedure THelpViewer.GetLinkBounds(Index: integer; var R: TRect);
+begin
+  HelpTopic^.GetLinkBounds(Index,R);
+end;
+
+function THelpViewer.GetLinkContext(Index: integer): word;
+begin
+  GetLinkContext:=HelpTopic^.GetLinkContext(Index);
+end;
+
+function THelpViewer.GetLinkText(Index: integer): string;
+var S: string;
+    R: TRect;
+    Y,StartX,EndX: integer;
+begin
+  S:=''; GetLinkBounds(Index,R);
+  Y:=R.A.Y;
+  while (Y<=R.B.Y) do
+  begin
+    if Y=R.A.Y then StartX:=R.A.X else StartX:=Margin;
+    if Y=R.B.Y then EndX:=R.B.X else EndX:=255;
+    S:=S+copy(GetLineText(Y),StartX+1,EndX-StartX+1);
+    Inc(Y);
+  end;
+  GetLinkText:=S;
+end;
+
+function THelpViewer.GetColorAreaCount: integer;
+var Count: integer;
+begin
+  if HelpTopic=nil then Count:=0 else Count:=HelpTopic^.GetColorAreaCount;
+  GetColorAreaCount:=Count;
+end;
+
+procedure THelpViewer.GetColorAreaBounds(Index: integer; var R: TRect);
+begin
+  HelpTopic^.GetColorAreaBounds(Index,R);
+end;
+
+function THelpViewer.GetColorAreaColor(Index: integer): word;
+begin
+  GetColorAreaColor:=HelpTopic^.GetColorAreaColor(Index);
+end;
+
+procedure THelpViewer.SelectNextLink(ANext: boolean);
+var I,Link: integer;
+    R: TRect;
+begin
+  if HelpTopic=nil then Exit;
+  Link:=CurLink;
+  if Link<>-1 then
+  begin
+    if ANext then
+       begin Inc(Link); if Link>=GetLinkCount then Link:=0; end else
+       begin Dec(Link); if Link=-1 then Link:=GetLinkCount-1; end;
+  end else
+  for I:=0 to GetLinkCount-1 do
+  begin
+    GetLinkBounds(I,R);
+    if (R.A.Y>CurPos.Y) or
+       (R.A.Y=CurPos.Y) and (R.A.X>CurPos.X) then
+       begin Link:=I; Break; end;
+  end;
+  if (Link=-1) and (GetLinkCount>0) then
+     if ANext then Link:=0
+              else Link:=GetLinkCount-1;
+  SetCurLink(Link);
+end;
+
+procedure THelpViewer.SetCurLink(Link: integer);
+var R: TRect;
+begin
+  if Link<>-1 then
+  begin
+    GetLinkBounds(Link,R);
+    SetCurPtr(R.A.X,R.A.Y);
+    TrackCursor(true);
+  end;
+end;
+
+procedure THelpViewer.SwitchToIndex;
+begin
+  if IndexTopic=nil then
+     IndexTopic:=HelpFacility^.BuildIndexTopic;
+  ISwitchToTopicPtr(IndexTopic,true);
+end;
+
+procedure THelpViewer.SwitchToTopic(SourceFileID: word; Context: word);
+begin
+  ISwitchToTopic(SourceFileID,Context,true);
+end;
+
+procedure THelpViewer.ISwitchToTopic(SourceFileID: word; Context: word; RecordInHistory: boolean);
+var P: PTopic;
+begin
+  if HelpFacility=nil then P:=nil else
+    if (SourceFileID=0) and (Context=0) and (HelpTopic<>nil) then
+       P:=IndexTopic else
+     P:=HelpFacility^.LoadTopic(SourceFileID, Context);
+  ISwitchToTopicPtr(P,RecordInHistory);
+end;
+
+procedure THelpViewer.ISwitchToTopicPtr(P: PTopic; RecordInHistory: boolean);
+var HistoryFull: boolean;
+begin
+  if (P<>nil) and RecordInHistory and (HelpTopic<>nil) then
+  begin
+    HistoryFull:=HistoryPtr>=HistorySize;
+    if HistoryFull then
+       Move(History[1],History[0],SizeOf(History)-SizeOf(History[0]));
+    with History[HistoryPtr] do
+    begin
+      {SourceTopic_:=SourceTopic; }Context_:=HelpTopic^.Topic^.HelpCtx;
+      FileID_:=HelpTopic^.Topic^.FileID;
+      Delta_:=Delta; CurPos_:=CurPos; CurLink_:=CurLink;
+    end;
+    if HistoryFull=false then Inc(HistoryPtr);
+  end;
+
+  if Owner<>nil then Owner^.Lock;
+  SetTopic(P);
+  DrawView;
+  if Owner<>nil then Owner^.UnLock;
+end;
+
+procedure THelpViewer.PrevTopic;
+begin
+  if HistoryPtr>0 then
+  begin
+    if Owner<>nil then Owner^.Lock;
+    Dec(HistoryPtr);
+    with History[HistoryPtr] do
+    begin
+      ISwitchToTopic(FileID_,Context_,false);
+      ScrollTo(Delta_.X,Delta_.Y);
+      SetCurPtr(CurPos_.X,CurPos_.Y);
+      TrackCursor(false);
+      if CurLink<>CurLink_ then SetCurLink(CurLink_);
+    end;
+    DrawView;
+    if Owner<>nil then Owner^.UnLock;
+  end;
+end;
+
+procedure THelpViewer.SetTopic(Topic: PTopic);
+begin
+  CurLink:=-1;
+  if (HelpTopic=nil) or (Topic<>HelpTopic^.Topic) then
+ begin
+  if (HelpTopic<>nil) and (HelpTopic<>IndexHelpTopic) then
+     Dispose(HelpTopic, Done);
+  HelpTopic:=nil;
+  if Topic<>nil then
+     begin
+       if (Topic=IndexTopic) and (IndexHelpTopic<>nil) then
+          HelpTopic:=IndexHelpTopic else
+       New(HelpTopic, Init(Topic));
+       if Topic=IndexTopic then
+          IndexHelpTopic:=HelpTopic;
+     end;
+ end;
+  if Owner<>nil then Owner^.Lock;
+  SetCurPtr(0,0); TrackCursor(false);
+  RenderTopic;
+  BuildTopicWordList;
+  Lookup('');
+  DrawView;
+  if Owner<>nil then Owner^.UnLock;
+end;
+
+procedure THelpViewer.BuildTopicWordList;
+var I: integer;
+begin
+  WordList^.FreeAll;
+  for I:=0 to GetLinkCount-1 do
+    WordList^.Insert(NewKeyword(I,Trim(GetLinkText(I))));
+end;
+
+procedure THelpViewer.Lookup(S: string);
+var Index, I: Sw_integer;
+    W: string;
+    OldLookup: string;
+    R: TRect;
+    P: PHelpKeyword;
+begin
+  InLookup:=true;
+  OldLookup:=LookupWord;
+  S:=UpcaseStr(S);
+  Index:=-1;
+  I:=0; {J:=0;
+  while (J<GetLinkCount) do
+    begin
+      GetLinkBounds(J,R);
+      if (R.A.Y<CurPos.Y) or ((R.A.Y=CurPos.Y) and (R.B.X<CurPos.X))
+         then Inc(J) else
+           begin I:=J; Break; end;
+    end;}
+  if S='' then LookupWord:='' else
+  begin
+    while (Index=-1) and (I<WordList^.Count) do
+      begin
+        W:=UpcaseStr(Trim(WordList^.At(I)^.KWord^));
+        if copy(W,1,length(S))=S then Index:=I else
+{        if W>S then Break else}
+        Inc(I);
+      end;
+    if Index<>-1 then
+    begin
+      W:=Trim(WordList^.At(Index)^.KWord^);
+      LookupWord:=copy(W,1,length(S));
+    end;
+  end;
+
+  if LookupWord<>OldLookup then
+  begin
+    if Index=-1 then SetCurLink(CurLink) else
+    begin
+      if Owner<>nil then Owner^.Lock;
+      P:=WordList^.At(Index);
+      S:=GetLinkText(P^.Index);
+      I:=Pos(LookupWord,S); if I=0 then I:=1;
+      GetLinkBounds(P^.Index,R);
+      SetCurPtr(R.A.X+(I-1)+length(Lookupword),R.A.Y);
+      CurLink:=P^.Index; DrawView;
+      TrackCursor(true);
+      if Owner<>nil then Owner^.UnLock;
+    end;
+  end;
+  InLookup:=false;
+end;
+
+procedure THelpViewer.SelectLink(Index: integer);
+var ID: word;
+    Ctx: word;
+begin
+  if Index=-1 then Exit;
+  if HelpTopic=nil then begin ID:=0; Ctx:=0; end else
+     begin
+       ID:=HelpTopic^.Topic^.FileID;
+       Ctx:=GetLinkContext(Index);
+     end;
+  SwitchToTopic(ID,Ctx);
+end;
+
+procedure THelpViewer.HandleEvent(var Event: TEvent);
+var DontClear: boolean;
+procedure GetMousePos(var P: TPoint);
+begin
+  MakeLocal(Event.Where,P);
+  Inc(P.X,Delta.X); Inc(P.Y,Delta.Y);
+end;
+begin
+  case Event.What of
+    evMouseDown :
+      if MouseInView(Event.Where) then
+      if (Event.Buttons=mbLeftButton) and (Event.Double) then
+      begin
+        inherited HandleEvent(Event);
+        if CurLink<>-1 then
+           SelectLink(CurLink);
+      end;
+    evCommand :
+      begin
+        DontClear:=false;
+        case Event.Command of
+          cmPrevTopic :
+            PrevTopic;
+        else DontClear:=true;
+        end;
+        if DontClear=false then ClearEvent(Event);
+      end;
+    evKeyDown :
+      begin
+        DontClear:=false;
+        case Event.KeyCode of
+          kbTab :
+            SelectNextLink(true);
+          kbShiftTab :
+            begin NoSelect:=true; SelectNextLink(false); NoSelect:=false; end;
+          kbEnter :
+            if CurLink<>-1 then
+              SelectLink(CurLink);
+        else
+          case Event.CharCode of
+             #32..#255 :
+               begin NoSelect:=true; Lookup(LookupWord+Event.CharCode); NoSelect:=false; end;
+          else DontClear:=true;
+          end;
+        end;
+        TrackCursor(false);
+        if DontClear=false then ClearEvent(Event);
+      end;
+  end;
+  inherited HandleEvent(Event);
+end;
+
+procedure THelpViewer.Draw;
+var NormalColor, LinkColor,
+    SelectColor, SelectionColor: word;
+    B: TDrawBuffer;
+    DX,DY,X,Y,I,MinX,MaxX,ScreenX: integer;
+    LastLinkDrawn,LastColorAreaDrawn: integer;
+    S: string;
+    R: TRect;
+{$ifndef EDITORS}
+    SelR : TRect;
+{$endif}
+    C: word;
+    CurP: TPoint;
+begin
+  NormalColor:=GetColor(1); LinkColor:=GetColor(2);
+  SelectColor:=GetColor(3); SelectionColor:=GetColor(4);
+{$ifndef EDITORS}
+  SelR.A:=SelStart; SelR.B:=SelEnd;
+{$endif}
+  LastLinkDrawn:=0; LastColorAreaDrawn:=0;
+  for DY:=0 to Size.Y-1 do
+  begin
+    Y:=Delta.Y+DY;
+    MoveChar(B,' ',NormalColor,Size.X);
+    if Y<GetLineCount then
+    begin
+      S:=copy(GetLineText(Y),Delta.X+1,255);
+      MoveStr(B,S,NormalColor);
+
+      for I:=LastColorAreaDrawn to GetColorAreaCount-1 do
+      begin
+        GetColorAreaBounds(I,R);
+        if R.A.Y>Y then Break;
+        LastColorAreaDrawn:=I;
+        if Y=R.B.Y then MaxX:=R.B.X else MaxX:=(length(S)-1);
+        if Y=R.A.Y then MinX:=R.A.X else MinX:=0;
+        if (R.A.Y<=Y) and (Y<=R.B.Y) then
+        begin
+          C:=GetColorAreaColor(I);
+          for DX:=MinX to MaxX do
+          begin
+            X:=DX;
+            ScreenX:=X-(Delta.X);
+            if (ScreenX>0) then
+            begin
+{              CurP.X:=X; CurP.Y:=Y;
+              if LinkAreaContainsPoint(R,CurP) then}
+              B[ScreenX]:=(B[ScreenX] and $f0ff) or (C shl 8);
+            end;
+          end;
+        end;
+      end;
+
+      for I:=LastLinkDrawn to GetLinkCount-1 do
+      begin
+        GetLinkBounds(I,R);
+        if R.A.Y>Y then Break;
+        LastLinkDrawn:=I;
+        if Y=R.B.Y then MaxX:=R.B.X else MaxX:=(length(S)-1);
+        if Y=R.A.Y then MinX:=R.A.X else MinX:=0;
+        if (R.A.Y<=Y) and (Y<=R.B.Y) then
+          for DX:=MinX to MaxX do
+          begin
+            X:=DX;
+            ScreenX:=X-(Delta.X);
+            if (ScreenX>=0) then
+            begin
+              CurP.X:=X; CurP.Y:=Y;
+              if LinkContainsPoint(R,CurP) then
+                if I=CurLink then C:=SelectColor else C:=LinkColor;
+              B[ScreenX]:=(B[ScreenX] and $ff) or (C shl 8);
+            end;
+          end;
+      end;
+
+{$ifndef EDITORS}
+      if ((SelR.A.X<>SelR.B.X) or (SelR.A.Y<>SelR.B.Y)) and (SelR.A.Y<=Y) and (Y<=SelR.B.Y) then
+      begin
+        if Y=SelR.A.Y then MinX:=SelR.A.X else MinX:=0;
+        if Y=SelR.B.Y then MaxX:=SelR.B.X-1 else MaxX:=255;
+        for DX:=MinX to MaxX do
+        begin
+          X:=DX;
+          ScreenX:=X-(Delta.X);
+          if (ScreenX>=0) and (ScreenX<MaxViewWidth) then
+            B[ScreenX]:=(B[ScreenX] and $0fff) or ((SelectionColor and $f0) shl 8);
+        end;
+      end;
+{$endif}
+
+    end;
+    WriteLine(0,DY,Size.X,1,B);
+  end;
+  DrawCursor;
+end;
+
+function THelpViewer.GetPalette: PPalette;
+const P: string[length(CHelpViewer)] = CHelpViewer;
+begin
+  GetPalette:=@P;
+end;
+
+destructor THelpViewer.Done;
+begin
+  inherited Done;
+  Dispose(WordList, Done);
+end;
+
+function THelpFrame.GetPalette: PPalette;
+const P: string[length(CHelpFrame)] = CHelpFrame;
+begin
+  GetPalette:=@P;
+end;
+
+constructor THelpWindow.Init(var Bounds: TRect; ATitle: TTitleStr; ASourceFileID: word; AContext: word; ANumber: Integer);
+var R: TRect;
+    VSB,HSB: PScrollBar;
+begin
+  inherited Init(Bounds, ATitle, ANumber);
+  GetExtent(R); R.Grow(0,-1); R.A.X:=R.B.X-1;
+  New(VSB, Init(R)); VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY; Insert(VSB);
+  GetExtent(R); R.Grow(-1,0); R.A.Y:=R.B.Y-1;
+  New(HSB, Init(R)); HSB^.GrowMode:=gfGrowLoY+gfGrowHiX+gfGrowHiY; Insert(HSB);
+  GetExtent(R); R.Grow(-1,-1);
+  New(HelpView, Init(R, HSB, VSB));
+  HelpView^.GrowMode:=gfGrowHiX+gfGrowHiY;
+  if (ASourceFileID<>0) or (AContext<>0) then
+     ShowTopic(ASourceFileID, AContext);
+  Insert(HelpView);
+end;
+
+procedure THelpWindow.InitFrame;
+var R: TRect;
+begin
+  GetExtent(R);
+  Frame:=New(PHelpFrame, Init(R));
+end;
+
+procedure THelpWindow.ShowIndex;
+begin
+  HelpView^.SwitchToIndex;
+end;
+
+procedure THelpWindow.ShowTopic(SourceFileID: word; Context: word);
+begin
+  HelpView^.SwitchToTopic(SourceFileID, Context);
+end;
+
+procedure THelpWindow.HandleEvent(var Event: TEvent);
+begin
+  case Event.What of
+    evKeyDown :
+      case Event.KeyCode of
+        kbEsc :
+          begin
+            Event.What:=evCommand; Event.Command:=cmClose;
+          end;
+      end;
+  end;
+  inherited HandleEvent(Event);
+end;
+
+procedure THelpWindow.Close;
+begin
+  if HideOnClose then Hide else inherited Close;
+end;
+
+function THelpWindow.GetPalette: PPalette;
+begin
+  GetPalette:=nil;
+end;
+
+END.
+{
+  $Log$
+  Revision 1.1  1998-12-22 14:27:54  peter
+    * moved
+
+  Revision 1.3  1998/12/22 10:39:56  peter
+    + options are now written/read
+    + find and replace routines
+
+}

ide/text/wini.pas

@@ -0,0 +1,343 @@
+{
+    $Id$
+    This file is part of the Free Pascal Integrated Development Environment
+    Copyright (c) 1998 by B‚rczi G bor
+
+    Reading and writing .INI files
+
+    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.
+
+ **********************************************************************}
+unit WINI;
+
+interface
+
+uses Objects;
+
+type
+    PINIEntry = ^TINIEntry;
+    TINIEntry = object(TObject)
+      constructor Init(ALine: string);
+      function    GetText: string;
+      function    GetTag: string;
+      function    GetComment: string;
+      function    GetValue: string;
+      procedure   SetValue(S: string);
+      destructor  Done; virtual;
+    private
+      Tag      : PString;
+      Value    : PString;
+      Comment  : PString;
+      Text     : PString;
+      Modified : boolean;
+      procedure Split;
+    end;
+
+    PINISection = ^TINISection;
+    TINISection = object(TObject)
+      constructor Init(AName: string);
+      function    GetName: string;
+      procedure   AddEntry(S: string);
+      destructor  Done; virtual;
+    private
+      Name     : PString;
+      Entries  : PCollection;
+    end;
+
+    PINIFile = ^TINIFile;
+    TINIFile = object(TObject)
+      constructor Init(AFileName: string);
+      function    Read: boolean; virtual;
+      function    Update: boolean; virtual;
+      function    IsModified: boolean; virtual;
+      destructor  Done; virtual;
+    private
+      ReadOnly: boolean;
+      Sections: PCollection;
+      FileName: PString;
+    end;
+
+const MainSectionName : string[40] = 'MainSection';
+      CommentChar     : char = ';';
+
+implementation
+
+
+function LTrim(S: string): string;
+begin
+  while copy(S,1,1)=' ' do Delete(S,1,1);
+  LTrim:=S;
+end;
+
+
+function RTrim(S: string): string;
+begin
+  while copy(S,length(S),1)=' ' do Delete(S,length(S),1);
+  RTrim:=S;
+end;
+
+
+function Trim(S: string): string;
+begin
+  Trim:=RTrim(LTrim(S));
+end;
+
+
+function GetStr(P: PString): string;
+begin
+  if P=nil then GetStr:='' else GetStr:=P^;
+end;
+
+
+function EatIO: integer;
+begin
+  EatIO:=IOResult;
+end;
+
+
+constructor TINIEntry.Init(ALine: string);
+begin
+  inherited Init;
+  Text:=NewStr(ALine);
+  Split;
+end;
+
+
+function TINIEntry.GetText: string;
+var S,CoS: string;
+begin
+  if Text=nil then
+    begin
+      CoS:=GetComment;
+      S:=GetTag+'='+GetValue;
+      if Trim(S)='=' then S:=CoS else
+        if CoS<>'' then S:=S+' '+CommentChar+' '+CoS;
+    end
+    else S:=Text^;
+  GetText:=S;
+end;
+
+
+function TINIEntry.GetTag: string;
+begin
+  GetTag:=GetStr(Tag);
+end;
+
+
+function TINIEntry.GetComment: string;
+begin
+  GetComment:=GetStr(Comment);
+end;
+
+
+function TINIEntry.GetValue: string;
+begin
+  GetValue:=GetStr(Value);
+end;
+
+
+procedure TINIEntry.SetValue(S: string);
+begin
+  if GetValue<>S then
+  begin
+    if Text<>nil then DisposeStr(Text); Text:=nil;
+    Value:=NewStr(S);
+    Modified:=true;
+  end;
+end;
+
+
+procedure TINIEntry.Split;
+var S,ValueS: string;
+    P,P2: byte;
+    C: char;
+    InString: boolean;
+begin
+  S:=GetText;
+  P:=Pos('=',S); P2:=Pos(CommentChar,S);
+  if (P2<>0) and (P2<P) then P:=0;
+  if P<>0 then
+    begin
+      Tag:=NewStr(copy(S,1,P-1));
+      P2:=P+1; InString:=false; ValueS:='';
+      while (P2<=length(S)) do
+        begin
+          C:=S[P2];
+          if C='"' then InString:=not InString else
+          if (C=CommentChar) and (InString=false) then Break else
+          ValueS:=ValueS+C;
+          Inc(P2);
+        end;
+      Value:=NewStr(ValueS);
+      Comment:=NewStr(copy(S,P2+1,255));
+    end else
+    begin
+      Tag:=nil;
+      Value:=nil;
+      Comment:=NewStr(S);
+    end;
+end;
+
+
+destructor TINIEntry.Done;
+begin
+  inherited Done;
+  if Text<>nil then DisposeStr(Text);
+  if Tag<>nil then DisposeStr(Tag);
+  if Value<>nil then DisposeStr(Value);
+  if Comment<>nil then DisposeStr(Comment);
+end;
+
+
+constructor TINISection.Init(AName: string);
+begin
+  inherited Init;
+  Name:=NewStr(AName);
+  New(Entries, Init(50,500));
+end;
+
+
+function TINISection.GetName: string;
+begin
+  GetName:=GetStr(Name);
+end;
+
+procedure TINISection.AddEntry(S: string);
+var E: PINIEntry;
+begin
+  New(E, Init(S));
+  Entries^.Insert(E);
+end;
+
+
+destructor TINISection.Done;
+begin
+  inherited Done;
+  if Name<>nil then DisposeStr(Name);
+  Dispose(Entries, Done);
+end;
+
+
+constructor TINIFile.Init(AFileName: string);
+begin
+  inherited Init;
+  FileName:=NewStr(AFileName);
+  New(Sections, Init(50,50));
+  Read;
+end;
+
+function TINIFile.Read: boolean;
+var f: text;
+    OK: boolean;
+    S,TS: string;
+    P: PINISection;
+    I: integer;
+begin
+  New(P, Init(MainSectionName));
+  Sections^.Insert(P);
+  Assign(f,FileName^);
+{$I-}
+  Reset(f);
+  OK:=EatIO=0;
+  while OK and (Eof(f)=false) do
+    begin
+      readln(f,S);
+      TS:=Trim(S);
+      OK:=EatIO=0;
+      if OK then
+      if TS<>'' then
+      if copy(TS,1,1)='[' then
+      begin
+        I:=Pos(']',TS); if I=0 then I:=length(TS)+1;
+        New(P, Init(copy(TS,2,I-2)));
+        Sections^.Insert(P);
+      end else
+      begin
+        P^.AddEntry(S);
+      end;
+    end;
+  Close(f);
+  EatIO;
+{$I+}
+  Read:=true;
+end;
+
+function TINIFile.IsModified: boolean;
+
+  function SectionModified(P: PINISection): boolean; {$ifndef FPC}far;{$endif}
+
+    function EntryModified(E: PINIEntry): boolean; {$ifndef FPC}far;{$endif}
+    begin
+      EntryModified:=E^.Modified;
+    end;
+
+  begin
+    SectionModified:=(P^.Entries^.FirstThat(@EntryModified)<>nil);
+  end;
+
+begin
+  IsModified:=(Sections^.FirstThat(@SectionModified)<>nil);
+end;
+
+
+function TINIFile.Update: boolean;
+var f: text;
+    OK: boolean;
+    P: PINISection;
+    E: PINIEntry;
+    I,J: integer;
+begin
+  Assign(f,FileName^);
+{$I-}
+  Rewrite(f);
+  OK:=EatIO=0;
+  if OK then
+  for I:=0 to Sections^.Count-1 do
+    begin
+      P:=Sections^.At(I);
+      if I<>0 then writeln(f,'['+P^.GetName+']');
+      for J:=0 to P^.Entries^.Count-1 do
+        begin
+          E:=P^.Entries^.At(J);
+          writeln(f,E^.GetText);
+          OK:=EatIO=0;
+          if OK=false then Break;
+        end;
+      if OK and ((I>0) or (P^.Entries^.Count>0)) and (I<Sections^.Count-1) then
+        writeln(f,'');
+      OK:=OK and (EatIO=0);
+      if OK=false then Break;
+    end;
+  Close(f);
+  EatIO;
+{$I+}
+  Update:=true;
+end;
+
+destructor TINIFile.Done;
+begin
+  if IsModified then
+    Update;
+  inherited Done;
+  if FileName<>nil then
+    DisposeStr(FileName);
+  Dispose(Sections, Done);
+end;
+
+
+END.
+{
+  $Log$
+  Revision 1.1  1998-12-22 14:27:55  peter
+    * moved
+
+  Revision 1.1  1998/12/22 10:39:57  peter
+    + options are now written/read
+    + find and replace routines
+
+}