------------------------------------------------------------------------------
-- CONTROLS - Texttools control (widget) definitions                        --
--                                                                          --
-- Developed by Ken O. Burtch                                               --
------------------------------------------------------------------------------
--                                                                          --
--              Copyright (C) 1999-2007 PegaSoft Canada                     --
--                                                                          --
-- This is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
-- sion.  This is distributed in the hope that it will be useful, but WITH- --
-- OUT 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  distributed with this;  see file COPYING.  If not, write --
-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
-- MA 02111-1307, USA.                                                      --
--                                                                          --
-- As a special exception,  if other files  instantiate  generics from this --
-- unit, or you link  this unit with other files  to produce an executable, --
-- this  unit  does not  by itself cause  the resulting  executable  to  be --
-- covered  by the  GNU  General  Public  License.  This exception does not --
-- however invalidate  any other reasons why  the executable file  might be --
-- covered by the  GNU Public License.                                      --
--                                                                          --
-- This is maintained at http://www.pegasoft.ca/tt.html                     --
--                                                                          --
------------------------------------------------------------------------------

with Ada.Containers;
with os; use os; -- for SessionLog debug
with Ada.Characters.Handling;
with Ada.Strings.Fixed;
with Ada.Strings.Maps.Constants;
with GNAT.RegExp; use GNAT.RegExp;
with ada.finalization; use Ada.Finalization;
with Ada.Unchecked_Deallocation;
with Ada.Environment_Variables;

--  Will be Ada.Strings.Fixed.Equal_Case_Insensitive one day.
with Equal_Case_Insensitive;

package body controls is

  PackageRunning : boolean := false; -- true if package has been started

  pragma suppress( range_check );

  DisplayInfo  : ADisplayInfoRec;   -- display characteristics
  IsConsoleEmu : boolean;           -- true if TERM = linux or console
  IsMonoXEmu   : boolean;           -- true if TERM = xterm
  IsColourXEmu : boolean;           -- true if TERM = xterm-color

  -- For AutoSpell, strings used by AutoSpell
  --

  Strings_Used_By_Autospell : constant array (Positive range <>) of Unbounded_String
    := (To_Unbounded_String ("procedure"),
	To_Unbounded_String ("function"),
	To_Unbounded_String ("package"),
	To_Unbounded_String ("exception"),
	To_Unbounded_String ("terminate"),
	To_Unbounded_String ("subtype"),
	To_Unbounded_String ("end"),
	To_Unbounded_String ("end if;"),
	To_Unbounded_String ("end loop;"),
	To_Unbounded_String ("end record;"),
	To_Unbounded_String ("then"),
	To_Unbounded_String ("else"),
	To_Unbounded_String ("loop"));
	
---> Imports
--
-- Required for thermometers (used for Scroll Bar, too)

procedure CTextStyle( c1, c2, c3 : character );
   pragma Import( C, CTextStyle, "CTextStyle" );

---> Source Edit Language Support

  procedure init( languageData: in out languageDataArray ) is
  begin
    -- clear linked lists
    for l  in aSourceLanguage'range loop
        for ch in keywordArray'range loop
            languageData(l).functionBin( ch ) := null;
        end loop;
        for ch in keywordArray'range loop
            languageData(l).keywordBin( ch ) := null;
        end loop;
    end loop;
    -- specify language case sensitivity (default is not sensitive)
    languageData( UNKNOWNLANGUAGE ).caseSensitive := true;
    languageData( BUSH  ).caseSensitive := true;
    languageData( C     ).caseSensitive := true;
    languageData( CPP   ).caseSensitive := true;
    languageData( JAVA  ).caseSensitive := true;
    languageData( SHELL ).caseSensitive := true;
    languageData( C     ).commentStyle := CStyle;
    languageData( CPP   ).commentStyle := CStyle;
    languageData( UNKNOWNLANGUAGE ).commentStyle := AdaStyle;
    languageData( ADA_LANGUAGE ).commentStyle := AdaStyle;
    languageData( BUSH  ).commentStyle := AdaStyle;
    languageData( PERL  ).commentStyle := ShellStyle;
    languageData( PHP   ).commentStyle := PHPStyle;
    languageData( HTML  ).commentStyle := HTMLStyle;
    languageData( SHELL ).commentStyle := ShellStyle;
  end init;

  procedure Slice (Inside : in StrList.Vector;
                   From   : in Positive;
                   Length : in Natural;
                   Result : in out StrList.Vector) is
  begin
     Result.Clear;
     Result.Reserve_Capacity (Ada.Containers.Count_Type (Length));
     for I in From .. From + Length - 1 loop
        Result.Append (Inside.Element (From));
     end loop;
  end Slice;
  procedure Slice (Inside : in BooleanList.Vector;
                   From   : in Positive;
                   Length : in Natural;
                   Result : in out BooleanList.Vector) is
  begin
     Result.Clear;
     Result.Reserve_Capacity (Ada.Containers.Count_Type (Length));
     for I in From .. From + Length - 1 loop
        Result.Append (Inside.Element (From));
     end loop;
  end Slice;


--  IN BIN
--
-- Determine which bin string s will be stored in.  The bins are
-- case-insensitive.
------------------------------------------------------------------------------

  function in_bin( s : in string ) return aBinIndex is
  begin
     if S'Length = 0 then
	return aBinIndex'first;
     end if;
     case S (S'First) is
	when 'A'..'Z' =>
	   return S (S'First);
	when 'a'..'z' =>
	   return character'Val (character'Pos (S(S'First)) - 32 );
	when others =>
	   return aBinIndex'first;
     end case;
  end in_bin;

--  FIND FUNCTION DATA
--
-- Find data on a language's function by looking it up in the language data
-- record.  Returns null if function doesn't exist.
------------------------------------------------------------------------------

  function findFunctionData( languageData : languageDataArray; funcLang : aSourceLanguage; s : in string ) return functionDataPtr is
    fp  : functionDataPtr := null;
  begin
    if s'length = 0 then
       fp := null;
    else
       fp := languageData( funcLang ).functionBin( in_bin( s )  );
       while fp /= null loop
         if languageData( funcLang ).caseSensitive then
            if fp.all.FunctionName.all = s then
               exit;
            end if;
         else
            if fp.all.functionName.all = Ada.Characters.Handling.To_Lower (s) then
               exit;
            end if;
         end if;
         fp := fp.all.next;
       end loop;
    end if;
    return fp;
  exception when ada.strings.length_error => -- string too long?
    SessionLog( "findFunctionData: length_error raised" );
    return null;
  when others =>
    SessionLog( "findKeywordData: unknown exception raised" );
    raise;
  end findFunctionData;

--  FIND KEYWORD DATA
--
-- Find data on a language's keyword by looking it up in the language data
-- record.  Returns null if keyword doesn't exist.
------------------------------------------------------------------------------

  function findKeywordData( languageData : languageDataArray; funcLang : aSourceLanguage; s : string ) return keywordDataPtr is
    kp  : keywordDataPtr := null;
  begin
    if s'length = 0 then
       kp := null;
    else
       kp := languageData( funcLang ).keywordBin( in_bin( s )  );
       while kp /= null loop
         if languageData( funcLang ).caseSensitive then
            if kp.all.keywordName.all = s then
               exit;
            end if;
         else
            if kp.all.keywordName.all = Ada.Characters.Handling.To_Lower (s) then
               exit;
            end if;
         end if;
         kp := kp.all.next;
       end loop;
    end if;
    return kp;
  exception when ada.strings.length_error => -- string too long?
    SessionLog( "findKeywordData: length_error raised" );
    return null;
  when others =>
    SessionLog( "findKeywordData: unknown exception raised" );
    raise;
  end findKeywordData;

---> Housekeeping


procedure StartupControls is
-- Initialize this package, set defaults
begin
  NoError;
  -- if package is already running, don't start again
  if PackageRunning then
     return;
  end if;
  -- look up information on the display
  GetDisplayInfo( DisplayInfo );
  -- discover terminal emulation
  IsConsoleEmu := false;
  IsMonoXEmu := false;
  IsColourXEmu := false;
  if Ada.Environment_Variables.Exists ("TERM") then
     declare
	Termemu : constant String := Ada.Environment_Variables.Value ("TERM");
     begin
	if TermEmu = "linux" or TermEmu = "console" then
	   IsConsoleEmu := true;
	   SessionLog( "StartupControls: optimized for linux console emulation" );
	elsif TermEmu = "xterm" or Termemu = "xterm-color" then
	   if DisplayInfo.C_Res = 0 then
	      IsMonoXEmu := true;
	      SessionLog( "StartupControls: optimized for monochrome X emulation" );
	   else
	      SessionLog( "StartupControls: optimized for colour X emulation" );
	      IsColourXEmu := true;
	   end if;
	end if;
     end;
  end if;
  PackageRunning := true;
end StartupControls;

procedure IdleControls( IdlePeriod : in Duration ) is
   pragma Unreferenced (IdlePeriod);
begin
  NoError;
end IdleControls;

procedure ShutdownControls is
-- Shut down this package
begin
  NoError;
  PackageRunning := false;
end ShutdownControls;

procedure FreeControlPtr is new Ada.Unchecked_Deallocation( RootControl'class,
  AControlPtr );

procedure Free( cp : in out AControlPtr ) is
begin
   FreeControlPtr( cp );                  --  dispatch
end Free;

-- Utilities

procedure DrawHotKey( x, y : integer; key : character ) is
begin
  MoveToGlobal( x, y );
  if IsConsoleEmu or IsColourXEmu then
     -- Linux VGA console and colour X don't show underline
     CTextStyle( 'y', 'n', 'n' );
  else
     -- else do underlining
     CTextStyle( 'n', 'n', 'y' );
  end if;
  Draw( key );
  CTextStyle( 'n', 'n', 'n' );
end DrawHotKey;

---> Window Control Implementations

---> Inits
--
-- Initialize a control's variables to default values.  Assign the
-- frame and hot key as given by the caller.

procedure Init( c : in out RootControl;
  left, top, right, bottom : integer; HotKey : character ) is
begin
  NoError;
  SetRect( c.frame, left, top, right, bottom );
  c.CursorX := 0;
  c.CursorY := 0;
  c.Status := Standby;
  c.NeedsRedrawing := true;
  c.HotKey := HotKey;
  c.HasInfo := false;
  c.InfoText := Null_Unbounded_String;
  c.StickLeft := false;
  c.StickTop  := false;
  c.StickRight := false;
  c.StickBottom := false;
  c.Scrollable := true;
end Init; -- RootControl

procedure Init( c : in out AnIconicControl;
  left, top, right, bottom : integer; HotKey : character ) is
begin
  Init( RootControl( c ), left, top, right, bottom, HotKey );
  c.Link := Null_Unbounded_String;
end Init; -- IconicControl

procedure Init(c : in out AWindowControl;
  left, top, right, bottom : integer; HotKey : character ) is
begin
  Init( RootControl( c ), left, top, right, bottom, HotKey );
end Init; -- WindowControl

procedure Init( c : in out AThermometer;
  left, top, right, bottom : integer; HotKey : character := NullKey ) is
begin
  Init( AWindowControl( c ), left, top, right, bottom, HotKey );
  c.Value := 0;
  c.Max   := 0;
end Init; -- AThermometer

procedure Init( c : in out AScrollBar;
  left, top, right, bottom : integer; HotKey : character := NullKey ) is
begin
  Init( AWindowControl( c ), left, top, right, bottom, HotKey );
  c.owner := 0;
  c.DirtyThumb := false;
  c.Thumb := 0;
  c.Max := 0;
end Init; -- AScrollBar

procedure Init( c : in out AStaticLine;
  left, top, right, bottom : integer; HotKey : character := NullKey ) is
begin
  Init( AnIconicControl( c ), left, top, right, bottom, HotKey );
  c.Status := Off;
  c.Style := Normal;
  c.Colour := none;
end Init; -- AStaticLine

procedure Init( c : in out AnEditLine;
  left, top, right, bottom : integer; Max : natural := 0;
  HotKey : character := NullKey ) is
begin
  Init( AWindowControl( c ), left, top, right, bottom, HotKey );
  c.text := Null_Unbounded_String;
  if c.Max = 0 then
     c.Max := right - left + 1;
  else
     c.Max := Max;
  end if;
  c.AdvanceMode := false;
  c.BlindMode := false;
  c.DirtyText := false;
  c.MaxLength := c.frame.right - c.frame.left + 1;
end Init; -- AnEditLine

procedure Init( c : in out AnIntegerEditLine;
  left, top, right, bottom : integer; Max : natural := 0;
  HotKey : character := NullKey ) is
begin
  Init( AnEditLine( c ), left, top, right, bottom, Max, HotKey );
  c.value := 0;
  c.MaxLength := integer'width;
end Init; -- AnIntegerEditLine

procedure Init( c : in out ALongIntEditLine;
  left, top, right, bottom : integer; Max : natural := 0;
  HotKey : character := NullKey ) is
begin
  Init( AnEditLine( c ), left, top, right, bottom, Max, HotKey );
  c.value := 0;
  c.MaxLength := long_integer'width;
end Init; -- ALongIntEditLine

procedure Init( c : in out AFloatEditLine;
  left, top, right, bottom : integer; Max : natural := 0;
  HotKey : character := NullKey ) is
begin
  Init( AnEditLine( c ), left, top, right, bottom, Max, HotKey );
  c.value := 0.0;
end Init; -- AFloatEditLine

procedure Init( c : in out ACheckBox;
  left, top, right, bottom : integer; HotKey : character := NullKey ) is
begin
  Init( AWindowControl( c ), left, top, right, bottom, HotKey );
  c.CursorX := 1;
  Set_Unbounded_String (C.Text, "Check");
  c.HotPos := 0;
end Init; -- ACheckBox

procedure Init( c : in out ARadioButton;
  left, top, right, bottom : integer;
  Family : integer := 0; HotKey : character := NullKey ) is
begin
  Init( AWindowControl( c ), left, top, right, bottom, HotKey );
  c.CursorX := 1;
  c.Family := Family;
  Set_Unbounded_String (C.Text, "Radio");
  c.HotPos := 0;
end Init; -- ARadioButton

procedure Init( c : in out ASimpleButton;
  left, top, right, bottom : integer; HotKey : character := NullKey ) is
begin
  Init( AWindowControl( c ), left, top, right, bottom, HotKey );
  c.CursorX := 1;
  Set_Unbounded_String (C.Text, "OK");
  c.Instant := false;
  c.HotPos := 0;
  c.Colour := none;
end Init; -- ASimpleButton

procedure Init( c : in out AWindowButton;
  left, top, right, bottom : integer; HotKey : character := NullKey ) is
begin
  Init( AnIconicControl( c ), left, top, right, bottom, HotKey );
  c.CursorX := 1;
  Set_Unbounded_String (C.Text, "Help");
  c.Instant := false;
  c.HotPos := 0;
end Init; -- AWindowButton

procedure Init( c : in out ARectangle;
  left, top, right, bottom : integer; HotKey : character := NullKey ) is
begin
  Init( AnIconicControl( c ), left, top, right, bottom, HotKey );
  c.Status := off;
  c.FrameColour := Outline;
  c.BackColour := Black;
  c.Text := Null_Unbounded_String;
end Init; -- ARectangle

procedure Init( c : in out ALine'class;
  left, top, right, bottom : integer; HotKey : character := NullKey ) is
begin
  Init( AnIconicControl( c ), left, top, right, bottom, HotKey );
  c.Status := Off;
  c.Colour := Outline;
  c.DownRight := true;
end Init; -- ALine

procedure Init( c : in out AStaticList;
  left, top, right, bottom : integer; HotKey : character := NullKey ) is
begin
  Init( AWindowControl( c ), left, top, right, bottom, HotKey );
  C.List.Clear;
  c.Origin := 0;
  c.CursorX := 1;
  c.CursorY := 1;
  c.ScrollBar := 0;
  c.Mark := -1;
end Init; -- AStaticList

procedure Init( c : in out ACheckList;
  left, top, right, bottom : integer; HotKey : character := NullKey ) is
begin
  Init( AStaticList( c ), left, top, right, bottom, HotKey );
  C.Checks.Clear;
end Init; -- ACheckList

procedure Init( c : in out ARadioList;
  left, top, right, bottom : integer; HotKey : character := NullKey ) is
begin
  Init( AStaticList( c ), left, top, right, bottom, HotKey );
  C.Checks.Clear;
  c.LastCheck := 0;
end Init; -- ARadioList

procedure Init( c : in out AnEditList;
  left, top, right, bottom : integer; HotKey : character := NullKey ) is
begin
  Init( AStaticList( c ), left, top, right, bottom, HotKey );
  c.DirtyLine := false;
end Init; -- ACheckList

procedure Init( c : in out ASourceEditList;
  left, top, right, bottom : integer; HotKey : character := NullKey ) is
begin
  Init( AStaticList( c ), left, top, right, bottom, HotKey );
  c.KeywordList.Clear;
  c.InsertedFirst := 0;
  c.InsertedLines := 0;
end Init; -- ACheckList


---> Finalizations (formerly Clears)
--
-- Deallocate memory, etc. for the control

procedure Finalize( c : in out RootControl ) is
begin
  NoError;
  c.NeedsRedrawing := true;
end Finalize; -- RootControl

procedure Finalize( c : in out AnIconicControl ) is
begin
  Finalize( RootControl( c ) );
  c.link := Null_Unbounded_String;
end Finalize; -- AnIconicControl;

procedure Finalize( c : in out AWindowControl ) is
begin
  Finalize( RootControl( c ) );
end Finalize; -- AWindowControl;

procedure Finalize( c : in out AThermometer ) is
begin
  Finalize( AWindowControl( c ) );
end Finalize; -- AThermometer

procedure Finalize( c : in out AScrollBar ) is
begin
  Finalize( AWindowControl( c ) );
end Finalize; -- AScrollBar

procedure Finalize( c : in out AStaticLine ) is
begin
  Finalize( AnIconicControl( c ) );
end Finalize; -- AStaticLine

procedure Finalize( c : in out AnEditLine'class ) is
begin
  Finalize( AWindowControl( c ) );
end Finalize; -- AnEditLine

procedure Finalize( c : in out ACheckBox ) is
begin
  Finalize( AWindowControl( c ) );
end Finalize; -- ACheckBox

procedure Finalize( c : in out ARadioButton ) is
begin
  Finalize( AWindowControl( c ) );
end Finalize; -- ARadioButton

procedure Finalize( c : in out ASimpleButton ) is
begin
  Finalize( AWindowControl( c ) );
end Finalize; -- ASimpleButton

procedure Finalize( c : in out AWindowButton ) is
begin
  Finalize( AnIconicControl( c ) );
end Finalize; -- AWindowButton

procedure Finalize( c : in out ARectangle ) is
begin
  Finalize( AnIconicControl( c ) );
end Finalize; -- ARectangle

procedure Finalize( c : in out ALine'class ) is
begin
  Finalize( AnIconicControl( c ) );
end Finalize; -- ALine

procedure Finalize( c : in out AStaticList ) is
begin
   c.List.Clear;
  Finalize( AWindowControl( c ) );
end Finalize; -- AStaticList

procedure Finalize( c : in out ACheckList ) is
begin
  Finalize( AStaticList( c ) );
end Finalize; -- ACheckList

procedure Finalize( c : in out ARadioList ) is
begin
   C.Checks.Clear;
   Finalize( AStaticList( c ) );
end Finalize; -- ARadioList

procedure Finalize( c : in out AnEditList ) is
begin
  Finalize( AStaticList( c ) );
end Finalize; -- AnEditList

procedure Finalize( c : in out ASourceEditList ) is
begin
   c.KeywordList.Clear;
  Finalize( AnEditList( c ) );
end Finalize; -- ASourceEditList

---> Common Calls

function GetHotPos( HotKey : character; thetext : in string) return natural is
-- find position in string of the "Hot Key" character, else 0
-- no check for out of bounds
begin
   if HotKey = NullKey then
      return 0;
   else
      return Ada.Strings.Fixed.Index
	(Source => Thetext,
	 Pattern => (1 => Hotkey),
	 Mapping => Ada.Strings.Maps.Constants.Lower_Case_Map);
   end if;
end GetHotPos;

procedure Invalid( c : in out RootControl'class ) is
-- mark a control as dirty (ie. needs redrawing)
begin
  NoError;
  c.NeedsRedrawing := true;
end Invalid;

function NeedsRedrawing( c : RootControl'class ) return boolean is
-- return dirty flag
begin
  NoError;
  return c.NeedsRedrawing;
end NeedsRedrawing;

procedure Move( c : in out RootControl'class; dx, dy : integer ) is
begin
  NoError;
  OffsetRect( c.frame, dx, dy );
  Invalid( c );
end Move;

function GetHotKey( c : in RootControl'class ) return character is
-- return hot key
begin
  NoError;
  return c.HotKey;
end GetHotKey;

procedure SetInfo( c : in out RootControl'class; text : in string ) is
-- Set info bar text
begin
  NoError;
  c.HasInfo := true;
  Set_Unbounded_String (C.InfoText, Text);
end SetInfo;

function GetInfo( c : in RootControl'class ) return string is
-- return info bar text
begin
  NoError;
  return To_String (C.InfoText);
end GetInfo;

function HasInfo( c : in RootControl'class ) return boolean is
-- true if info bar text as assigned
begin
  NoError;
  return c.HasInfo;
end HasInfo;

procedure GetStickyness( c : in RootControl'class; left, top, right, bottom
  : in out boolean ) is
-- return true for each direction that's sticky
begin
  NoError;
  left := c.StickLeft;
  top := c.StickTop;
  right:= c.StickRight;
  bottom := c.StickBottom;
end GetStickyness;

procedure SetStickyness( c : in out RootControl'class; left, top, right,
  bottom : boolean ) is
-- set stickyness for each direction
begin
  NoError;
  c.StickLeft := left;
  c.StickTop := top;
  c.StickRight := right;
  c.StickBottom := bottom;
end SetStickyness;

function InControl( c : in RootControl'class; x, y : integer )
  return boolean is
begin
  return InRect( x, y, c.frame );
end InControl;

function GetFrame( c : in RootControl'class ) return ARect is
begin
  return c.frame;
end GetFrame;

procedure Scrollable( c : in out RootControl'class; b : boolean ) is
begin
  c.scrollable := b;
end Scrollable;

function CanScroll( c : in RootControl'class ) return boolean is
begin
  return c.scrollable;
end CanScroll;


---> Iconic control calls

procedure SetLink( c : in out AnIconicControl'class; link : in string ) is
-- Set the pathname of the window the iconic control refers to
begin
   Set_Unbounded_String (C.Link, Link);
  c.NeedsRedrawing := true;
end SetLink;

function  GetLink( c : in AnIconicControl'class ) return string is
-- Return pathname to the window the iconic control refers to
begin
  return To_String (C.Link);
end GetLink;

procedure SetCloseBeforeFollow( c : in out AnIconicControl'class;
  close : boolean := true ) is
begin
  c.CloseBeforeFollow := close;
end SetCloseBeforeFollow;

function GetCloseBeforeFollow( c : in AnIconicControl'class ) return boolean
  is
begin
  return c.CloseBeforeFollow;
end GetCloseBeforeFollow;

---> Thermometer Calls

procedure SetMax( c : in out AThermometer; max : integer ) is
begin
  NoError;
  if c.Max < 0 then
     c.Max := 0;
  else
     c.max := max;
  end if;
  c.NeedsRedrawing := true;
end SetMax;

function GetMax( c : in AThermometer ) return integer is
begin
  NoError;
  return c.max;
end GetMax;

procedure SetValue( c : in out AThermometer; value : integer ) is
begin
 NoError;
 if c.Value < 0 then
    c.Value := 0;
 else
    c.value := value;
 end if;
 c.NeedsRedrawing := true;
end SetValue;

function GetValue( c : in AThermometer ) return integer is
begin
  NoError;
  return c.value;
end GetValue;


---> Scroll Bar Calls

procedure SetMax( c : in out AScrollBar; max : in integer ) is
begin
  NoError;
  if c.Max < 0 then
     c.Max := 0;
  else
     c.max := max;
  end if;
  c.NeedsRedrawing := true;
end SetMax;

function GetMax( c : in AScrollBar ) return integer is
begin
  NoError;
  return c.max;
end GetMax;

procedure SetThumb( c : in out AScrollBar; thumb : in integer ) is
begin
  NoError;
  if Thumb < 0 then
     c.thumb := 0;
  else
     c.thumb := thumb;
  end if;
  c.DirtyThumb := true;
end SetThumb;

function GetThumb( c : in AScrollBar ) return integer is
begin
  NoError;
  return c.thumb;
end GetThumb;

procedure SetOwner( c : in out AScrollBar; Owner : AControlNumber ) is
begin
  NoError;
  c.owner := owner;
end SetOwner;

function GetOwner( c : in AScrollBar ) return AControlNumber is
begin
  NoError;
  return c.owner;
end GetOwner;


---> Static Line Calls

procedure SetText( c : in out AStaticLine; text : in String) is
begin
  NoError;
  if c.text /= text then
     Set_Unbounded_String (C.Text, Text);
     c.NeedsRedrawing := true;
  end if;
end SetText;

function GetText( c : in AStaticLine ) return String is
begin
  NoError;
  return To_String (C.Text);
end GetText;

procedure SetStyle( c : in out AStaticLine ; style : ATextStyle ) is
begin
  NoError;
  if c.style /= style then
     c.style := style;
     c.NeedsRedrawing := true;
  end if;
end SetStyle;

function GetStyle( c : in AStaticLine ) return ATextStyle is
begin
  NoError;
  return c.style;
end GetStyle;

procedure SetColour( c : in out AStaticLine; colour : APenColourName ) is
begin
  NoError;
  if c.colour /= colour then
     c.colour := colour;
     c.needsRedrawing := true;
  end if;
end SetColour;

function GetColour( c : in AStaticLine ) return APenColourName is
begin
  NoError;
  return c.colour;
end GetColour;

---> Edit Line Calls

procedure SetText( c : in out AnEditLine'class; text : in String) is
begin
  NoError;
  if c.text /= text then
     c.text := To_Unbounded_String (Text);
     c.NeedsRedrawing := true;
     c.cursorX := 0;
  end if;
end SetText;

function GetText( c : in AnEditLine'class ) return String is
begin
  NoError;
  return To_String (C.Text);
end GetText;

procedure SetAdvanceMode( c : in out AnEditLine'class; mode : boolean ) is
begin
  NoError;
  c.AdvanceMode := mode;
end SetAdvanceMode;

function GetAdvanceMode( c : in AnEditLine'class ) return boolean is
begin
  NoError;
  return c.AdvanceMode;
end GetAdvanceMode;

procedure SetBlindMode( c : in out AnEditLine'class; mode : boolean ) is
begin
  NoError;
  c.NeedsRedrawing := c.NeedsRedrawing or (mode xor c.BlindMode);
  c.BlindMode := mode;
end SetBlindMode;

function GetBlindMode( c : in AnEditLine'class ) return boolean is
begin
  NoError;
  return c.BlindMode;
end GetBlindMode;

procedure SetMaxLength( c : in out AnEditLine'class; MaxLength : integer ) is
begin
  NoError;
  c.MaxLength := MaxLength;
end SetMaxLength;

function GetMaxLength( c : in AnEditLine'class ) return integer is
begin
  NoError;
  return c.MaxLength;
end GetMaxLength;

---> Integer Edit Lines

procedure SetValue( c : in out AnIntegerEditLine; value : integer ) is
begin
  NoError;
  c.value := value;
end SetValue;

function  GetValue( c : in AnIntegerEditLine ) return integer is
begin
  NoError;
  return integer'Value (To_String (C.Text));
  exception when others => return 0;
end GetValue;


---> Long Integer Edit Lines

procedure SetValue( c : in out ALongIntEditLine; value : in Long_Integer ) is
begin
  NoError;
  c.value := value;
end SetValue;

function  GetValue( c : in ALongIntEditLine ) return Long_Integer is
begin
  NoError;
  return Long_Integer'value( To_String( c.Text ) );
  exception when others => return 0;
end GetValue;


---> Float Edit Lines

procedure SetValue( c : in out AFloatEditLine; value : float ) is
begin
  NoError;
  c.value := value;
end SetValue;

function  GetValue( c : in AFloatEditLine ) return float is
begin
  NoError;
  return c.value;
end GetValue;


---> Check Box Calls

procedure SetText( c : in out ACheckBox; text : in String ) is
begin
  NoError;
  if c.text /= text then
     c.NeedsRedrawing := true;
     c.text := To_Unbounded_String (Text);
     c.HotPos := GetHotPos( c.HotKey, text );
  end if;
end SetText;

function GetText( c : in ACheckBox ) return String is
begin
  NoError;
  return To_String (C.Text);
end GetText;

procedure SetCheck( c : in out ACheckBox; checked : boolean ) is
begin
  NoError;
  c.NeedsRedrawing := c.NeedsRedrawing or c.checked /= checked;
  c.checked := checked;
end SetCheck;

function GetCheck( c : in ACheckBox ) return boolean is
begin
  NoError;
  return c.checked;
end GetCheck;


---> Radio Button Calls

procedure SetText( c : in out ARadioButton; text : in String) is
begin
  NoError;
  if c.text /= text then
     c.text := To_Unbounded_String (Text);
     c.HotPos := GetHotPos( c.HotKey, text );
     c.NeedsRedrawing := true;
  end if;
end SetText;

function GetText( c : in ARadioButton ) return String is
begin
  NoError;
  return To_String (C.Text);
end GetText;

procedure SetCheck( c : in out ARadioButton; checked : boolean ) is
begin
  NoError;
  c.NeedsRedrawing := c.NeedsRedrawing or c.checked /= checked;
  c.checked := checked;
end SetCheck;

function GetCheck( c : in ARadioButton ) return boolean is
begin
  NoError;
  return c.Checked;
end GetCheck;

function GetFamily( c : in ARadioButton ) return integer is
begin
  NoError;
  return c.Family;
end GetFamily;


---> Simple Button Calls

procedure SetText( c : in out ASimpleButton; text : in String) is
begin
  NoError;
  if c.text /= text then
     Set_Unbounded_String (C.Text, Text);
     c.HotPos := GetHotPos( c.HotKey, text );
     c.NeedsRedrawing := true;
  end if;
end SetText;

function GetText( c : in ASimpleButton ) return String is
begin
  NoError;
  return To_String (C.Text);
end GetText;

procedure SetInstant( c : in out ASimpleButton; instant : boolean := true ) is
begin
  NoError;
  if c.Instant /= Instant then
     c.Instant := Instant;
     c.NeedsRedrawing := true;
  end if;
end SetInstant;

function GetInstant( c : in ASimpleButton ) return boolean is
begin
  NoError;
  return c.Instant;
end GetInstant;

procedure SetColour( c : in out ASimpleButton; colour : APenColourName ) is
begin
  NoError;
  if c.colour /= colour then
     c.colour := colour;
     c.NeedsRedrawing := true;
  end if;
end SetColour;

function GetColour( c : in ASimpleButton ) return APenColourName is
begin
  NoError;
  return c.colour;
end GetColour;

---> Window Button Calls

procedure SetText( c : in out AWindowButton; text : in String) is
begin
  NoError;
  if c.text /= text then
     Set_Unbounded_String (C.Text, Text);
     c.HotPos := GetHotPos( c.HotKey, text );
     c.NeedsRedrawing := true;
  end if;
end SetText;

function GetText( c : in AWindowButton ) return String is
begin
  NoError;
  return To_String (C.Text);
end GetText;

procedure SetInstant( c : in out AWindowButton; instant : boolean := true ) is
begin
  NoError;
  c.instant := Instant;
end SetInstant;

function GetInstant( c : in AWindowButton ) return boolean is
begin
  NoError;
  return c.instant;
end GetInstant;

procedure SetControlHit( c : in out AWindowButton; chit : AControlNumber ) is
begin
  NoError;
  c.chit := chit;
end SetControlHit;

function GetControlHit( c : in AWindowButton ) return AControlNumber is
begin
  NoError;
  return c.chit;
end GetControlHit;


---> Rectangles

procedure SetColours( c : in out ARectangle;
  FrameColour, BackColour : APenColourName ) is
begin
  NoError;
  c.FrameColour := FrameColour;
  c.BackColour := BackColour;
  c.NeedsRedrawing := true;
end SetColours;

procedure GetColours( c : in ARectangle;
  FrameColour, BackColour : in out APenColourName ) is
begin
  NoError;
  FrameColour := c.FrameColour;
  BackColour := c.BackColour;
end GetColours;

procedure SetText( c : in out ARectangle; text: in string) is
begin
  NoError;
  Set_Unbounded_String (C.Text, Text);  -- assign new text
  c.NeedsRedrawing := true;
end SetText;

function GetText( c : ARectangle) return string is
begin
  NoError;
  return To_String (C.Text);
end GetText;

---> Lines

procedure SetColour( c : in out ALine'class; Colour : APenColourName ) is
begin
  NoError;
  c.Colour := Colour;
end SetColour;

function GetColour( c : in ALine'class ) return APenColourName is
begin
  NoError;
  return c.Colour;
end GetColour;

procedure SetDrawDir( c : in out ALine; DownRight : boolean ) is
begin
  NoError;
  c.DownRight := DownRight;
end SetDrawDir;

function GetDrawDir( c : in ALine ) return boolean is
begin
  NoError;
  return c.DownRight;
end GetDrawDir;


---> Static Lists

procedure SetList( c : in out AStaticList'class; list : in out StrList.Vector ) is
begin
  NoError;
  C.List := List;
  if not C.List.Is_Empty then
     c.origin := 1;
  else
     c.origin := 0;
  end if;
  c.CursorY := 1;
  c.Mark := -1;    -- mark no longer valid
  c.NeedsRedrawing := true;
end SetList;

function GetList( c : in AStaticList'class ) return StrList.Vector is
begin
  NoError;
  return c.list;
end GetList;


-- CROP TEXT
--
-- Crop long lines, returning the amount that won't fit in overflow.
-- Utility procedure for JustifyText.

procedure CropText (text : in out unbounded_string;
		    overflow: out unbounded_string;
		    width : in integer ) is
  CropIndex : integer;
  ch        : character;
begin
  CropIndex := length( text );         -- start at right end
<<Crop>> while CropIndex > 0 loop        -- unless we run out
    ch := Element( text, CropIndex );
    exit when ch = ' ';                -- stop looking at a space
    CropIndex := CropIndex - 1;        -- else keep backing left
  end loop;
  if CropIndex = 0 then -- hard break
     Overflow := Tail( text, length(text) - width );
     Delete( text, width+1, length( text ));
  elsif CropIndex > Width then         -- not good enough?
     CropIndex := CropIndex - 1;       -- keep backing left
     goto Crop;
  else -- normal break (on a space)
     Overflow := Tail( text, length( text ) - CropIndex );
     Delete( text, CropIndex + 1, length( text ) ); -- leave space
  end if;
exception when others =>
    DrawErrLn;
    DrawErr( "CropText exception: Info dumped to session log" );
    SessionLog( "CropText exception" );
    SessionLog( "text=" ); SessionLog( To_String (Text));
    SessionLog( "overflow=" ); SessionLog( To_String (Overflow));
    raise;
end CropText;

------------------------------------------------------------------------------
-- JUSTIFY TEXT (Static)
--
-- Crop long lines and wrap text in a static list control.  Understands that
-- blank lines and indented words are new paragraphs.  If one line is
-- justified, only continue until the text is adjust for that one line.
-- Otherwise, continue to check all lines in the document.
--
-- width => width of the window to justify to
-- startingAt = 0 => Justify entire document, else the line to justify
-- ToDo: Recursive Justify when overflow exceeds max line length

procedure JustifyText( c : in out AStaticList;
                       width : integer;
                       startingAt : Natural := 0 ) is
  Text : Unbounded_String := Null_Unbounded_String;
  
  function isParagraphStart( text : in String ) return boolean is
    -- does the line of text look like the start of a paragraph (blank line or
    -- indented)
  begin
     return Text'Length = 0
       or else Text (Text'First) = ' ';
  end isParagraphStart;
  
  Overflow : Unbounded_String := Null_Unbounded_String;	-- no overflow yet
  Index    : Natural := StartingAt;	-- top-most line
  CarryCursor : boolean := false;	-- no carry fwd
  CarryAmount : integer;
begin
  NoError;                                                    -- assume OK
  c.Mark := -1;                                               -- mark invalid
  if Index = 0 then                                           -- none?
     Index := 1;                                              -- default line 1
  end if;
  
  while Index <= Natural (C.List.Length) loop
     Set_Unbounded_String (Text, c.List.Element (Index)); -- get this line

        -- Handle Overflow
        --
        -- Was there extra text after the last line was justified? Prefix it
        -- to the current line.  If we're leaving the insert block area, then
        -- we don't want the text to flow beyond the insert block: insert a
        -- new line to hold the extra text.

        if length( Overflow ) > 0 then                          -- carry fwd?
           --SessionLog( "Overflow: " & ToString( Overflow ) );    -- DEBUG
           if IsParagraphStart (To_String (Text)) then                     -- new para?
              C.List.Insert (index, "");   -- push text down
              Text := Overflow;                                 -- ln contents
              --SessionLog( "Ending paragraph: " & ToString( Text ) ); -- DEBUG
           else                                                 -- otherwise
              if length( Overflow ) + length( Text ) < 256 then -- emergency handling
                 C.List.Insert (Index, To_String (Overflow) );  -- this is not right!
                 Overflow := Null_Unbounded_String;
              else
                 Insert (Text, 1, To_String (Overflow)); -- carry fwd
              end if;
              --SessionLog( "Carring forward normally: " & ToString( text ) ); -- DEBUG
           end if;
        end if;

        -- Save and Split
        --
        -- If the length of the text (or the cursor position which may be 1 beyond
        -- the end of the line) is over the length of the line, split the line
        -- and remember to move the cursor when we're through.

        if length( text ) > width or (Index = startingAt and c.CursorX > width) then
                                                                -- new line too big?
           CropText( text, overflow, width );                   -- cut the text in two
           SessionLog( "Cropped to " & To_String (Text)); -- DEBUG
           C.List.Replace_Element (index, To_String (Text));           -- and save it

           -- recursion will go here (if overflow still bigger)
           -- reposition the cursor

           -- Is this the cursor line?  Mark the cursor for moving (if it needs
           -- to move).  It will have to move back by the length of the new
           -- line of text.  Note: Never move cursor until all justification is
           -- complete.

           if Index = startingAt and then c.CursorX > length(text) then
              CarryCursor := true;
              CarryAmount := length( text );
           end if;
           c.NeedsRedrawing := true;

        elsif startingAt > 0 then
           Overflow := null_unbounded_string;
           --SessionLog( ToString( Text) & " fits, exiting" ); -- DEBUG
           C.List.Replace_Element (index, To_String (Text)); -- update list
           c.NeedsRedrawing := true;
           exit;
        else
           Overflow := null_unbounded_string;
           --SessionLog( "No Overflow" ); -- DEBUG
        end if;

        Index := Index + 1;
  end loop;

  -- Final Line
  --
  -- Clean up the final line

  if length( Overflow ) > 0 then
     --SessionLog( "Final overflow: " & ToString( Overflow ) ); -- DEBUG
     if index <= Natural (C.List.Length) then
        C.List.Replace_Element (index, To_String (Text));
     else
        C.List.Append (To_String (Overflow));
     end if;
  end if;
  -- if cursor was on last line, will have to move it forward now
  if CarryCursor then
     MoveCursor( c, -CarryAmount, +1); -- move down a line
  end if;
  exception when others =>
    DrawErrLn;
    DrawErr( "JustifyText exception: list dumped to session log" );
    for i in 1 .. Natural (C.List.Length) loop
       SessionLog (C.List.Element (I));
    end loop;
    SessionLog( "index is " & Natural'image( index ) );
    raise;
end JustifyText;


------------------------------------------------------------------------------
-- JUSTIFY TEXT (Edit)
--
-- Crop long lines and wrap text in a edit list control.  Understands that
-- blank lines and indention indicates new paragraphs.
-- If one line is justified, only continue until the text is adjust for that
-- one line.  Otherwise, continue to check all lines in the document.
--
-- width      => width of the window to justify to
-- startingAt => Justify entire document (0) else the line to justify
-- ToDo: Recursive Justify when overflow exceeds max line length

procedure JustifyText( c : in out AnEditList;
                       width : integer;
                       startingAt : Natural := 0 ) is
begin
   -- Same justification policy as static lists.
   JustifyText( AStaticList( c ), width, startingAt );
end JustifyText;


-- JUSTIFY TEXT (SourceEdit)
--
-- Crop long lines and wrap text in a source edit control.  Understands that
-- the area where text is being inserted must be treated as its own paragraph.
-- If one line is justified, only continue until the text is adjust for that
-- one line.  Otherwise, continue to check all lines in the document.
--
-- width      => width of the window to justify to
-- startingAt => Justify entire document (0) else the line to justify
-- ToDo: Recursive Justify when overflow exceeds max line length

procedure JustifyText( c : in out ASourceEditList;
                       width : integer;
                       startingAt : Natural := 0 ) is

  Overflow : Unbounded_String := Null_Unbounded_String;	-- no overflow yet
  Index    : Natural := StartingAt;	-- top-most line
  Text     : Unbounded_String;
  CarryCursor : Boolean := false;	-- no carry fwd

  CarryAmount : integer;
  insertedFirst : Natural := c.insertedFirst;
  insertedLast  : Natural := c.insertedFirst + c.InsertedLines - 1;
begin
  NoError;                                                    -- assume OK
  c.Mark := -1;                                               -- mark invalid
  if Index = 0 then                                           -- none?
     Index := 1;                                              -- default line 1
  end if;
  -- Justifying an insert block is different from justifying an entire
  -- document.  So determine where we're justifying.  If in an insert block,
  -- determine extend of block.
  if startingAt < insertedFirst or startingAt > insertedLast then
     insertedFirst := 0;
     insertedLast := 0;
  end if;

  while Index <= Natural (C.List.Length) loop
        Text := To_Unbounded_String (C.List.Element (Index)); -- get this line

        -- Handle Overflow
        --
        -- Was there extra text after the last line was justified? Prefix it
        -- to the current line.  If we're leaving the insert block area, then
        -- we don't want the text to flow beyond the insert block: insert a
        -- new line to hold the extra text.

        if length( Overflow ) > 0 then                          -- carry fwd?
           --SessionLog( "Overflow: " & ToString( Overflow ) ); -- DEBUG
           if insertedFirst > 0 then                            -- in ins area?
              if index > insertedLast then                      -- leaving it?
                 C.list.Insert (index, "" ); -- push text down
                 c.insertedLines := c.insertedLines + 1;        -- inc ins area
                 Text := Overflow;                              -- ln contents
                 if length( text ) <= width then                -- all fits?
                    insertedFirst := 0;                         -- we've left the
                    insertedLast := 0;                          -- insert area
                    --SessionLog( "Leaving insert area" ); -- DEBUG
                 else
                    insertedLast := insertedLast + 1;           -- still in area
                    --SessionLog( "Extending insert area" ); -- DEBUG
                 end if;
              else                                              -- not leaving?
                 Insert (Text, 1, To_String (Overflow)); -- carry fwd
                 -- SessionLog( "Carring forward in insert area: " & ToString( text ) ); -- DEBUG
              end if;
           else                                                 -- not ins area?
              Insert (Text, 1, To_String (Overflow));     -- carry fwd
              --SessionLog( "Carring forward normally: " & ToString( text ) ); -- DEBUG
           end if;
        end if;

        -- Save and Split
        --
        -- If the length of the text (or the cursor position which may be 1 beyond
        -- the end of the line) is over the length of the line, split the line
        -- and remember to move the cursor when we're through.

        if length( text ) > width or (Index = startingAt and c.CursorX > width) then
                                                                -- new line too big?
           CropText( text, overflow, width );                   -- cut the text in two
           --SessionLog( "Cropped to " & ToString( Text ) ); -- DEBUG
           C.List.Replace_Element (index, To_String (Text));           -- and save it

           -- recursion will go here (if overflow still bigger)
           -- reposition the cursor

           -- Is this the cursor line?  Mark the cursor for moving (if it needs
           -- to move).  It will have to move back by the length of the new
           -- line of text.  Note: Never move cursor until all justification is
           -- complete.

           if Index = startingAt and then c.CursorX > length(text) then
              CarryCursor := true;
              CarryAmount := length( text );
           end if;
           c.NeedsRedrawing := true;

        elsif startingAt > 0 then
           Overflow := Null_Unbounded_String;
           --SessionLog( ToString( Text) & " fits, exiting" ); -- DEBUG
           C.List.Replace_Element (index, To_String (Text)); -- update list
           c.NeedsRedrawing := true;
           exit;
        else
           Overflow := Null_Unbounded_String;
           --SessionLog( "No Overflow" ); -- DEBUG
        end if;

        Index := Index + 1;
  end loop;

  -- Final Line
  --
  -- Clean up the final line

  if length( Overflow ) > 0 then
     --SessionLog( "Final overflow: " & ToString( Overflow ) ); -- DEBUG
     if index <= Natural (C.List.Length) then
        C.List.Replace_Element (index, To_String (Text));
     else
        C.List.Append (To_String (Overflow));
     end if;
  end if;
  -- if cursor was on last line, will have to move it forward now
  if CarryCursor then
     MoveCursor( c, -CarryAmount, +1); -- move down a line
  end if;
  exception when others =>
    DrawErrLn;
    DrawErr( "JustifyText exception: list dumped to session log" );
    for i in 1 .. Natural (C.List.Length) loop
       SessionLog (C.List.Element (I));
    end loop;
    SessionLog( "index is " & Natural'image( index ) );
    raise;
end JustifyText;


------------------------------------------------------------------------------
-- WRAP TEXT (Static)
--
-- Wrap long lines

procedure WrapText( c : in out AStaticList ) is
  line   : Natural := 1;
  text   : Unbounded_String;
  overflow : Unbounded_String;
  width  : constant Integer := c.frame.right - c.frame.left + 1;
  offset : Natural;
begin
  NoError;
  while line <= Natural (C.List.Length) loop
        Text := To_Unbounded_String (C.List.Element (line));
        if length( text ) > width then
           CropText ( text, overflow, width );
	   C.List.Replace_Element (line, To_String (Text));
	else
           Overflow := Null_Unbounded_String;
        end if;
	offset := 1;
        if length( overflow ) > 0 then
           loop
             text := overflow;
           exit when length(text) <= width;
             CropText( text, overflow, width );
             C.List.Insert (line+offset, To_String (Text));
             offset := offset + 1;
           end loop;
           C.List.Insert (line+offset, To_String (Text));
           offset := offset + 1;
        end if;
        line := line + offset;
  end loop;
end WrapText;

------------------------------------------------------------------------------
-- MOVE CURSOR
--
-- Move the cursor and scroll the list as necessary.  Sound simple?  Not
-- really.  Constrain the cursor to reasonable positions and don't allow
-- the text area to move beyond the top or bottom of the control.  Do so
-- in a way that the user doesn't lose their context.
--
-- dx and dy are the change in X and Y position.

procedure MoveCursor( c : in out AStaticList'class;
                      dx : integer;
                      dy : integer ) is
  NewLine        : integer;   -- the line being moved to
  TempOrigin     : integer;   -- possible new origin
  TempY          : integer;   -- possible new cursor position
  VisibleLines   : integer;   -- number of lines visible within list frame
  ScrollArea     : integer;   -- number of lines in which to trigger scrol
  LastLine       : integer;   -- last line in the list (or total # lines)
  LastScrollLine : integer;   -- last line that can be scrolled to
  OriginalOrigin : Natural;
  OffsetY        : integer;
  text           : unbounded_string;

  -- These functions are provided to make MoveCursor easier to read.
  -- That's why they are inlined.

  function TooSmallToScroll return boolean is
    -- If the last scrollable line on screen is < 1, the text is smaller
    -- than the bounding rectangle; if 1, it fits exactly.
  begin
    return LastScrollLine < 2;
  end TooSmallToScroll;
  pragma Inline( TooSmallToScroll );

  -- function InLast3QuartersOfRect( rectline : integer)  return boolean is
  --   -- If line rectline is in the bottom of the list rectangle, where
  --   -- rectline 1 is the top of the rectangle's drawing area.
  -- begin
  --   return ( rectline >= VisibleLines - ScrollArea + 1 );
  -- end InLast3QuartersOfRect;
  -- pragma Inline( InLast3QuartersOfRect );

begin
  NoError;

  -- Calculate some basic numbers that we will need.

  VisibleLines := integer( c.frame.bottom - c.frame.top ) - 1;
  ScrollArea   := VisibleLines/4;
  LastLine     := Natural (C.List.Length);
  LastScrollLine := LastLine - VisibleLines + 1;
  OriginalOrigin := c.Origin;

  -- Constrain DY: it must not move the cursor of the list.

  if c.Origin + c.CursorY + dy <= 1 then
     OffsetY := -(c.Origin + c.CursorY) + 2;
  elsif C.Origin + c.CursorY +
     dy - 1 > LastLine then
     OffsetY := LastLine - c.Origin - c.CursorY + 1;
  else
     OffsetY := dy;
  end if;

  -- The line the cursor will now fall on.  We don't know yet which line
  -- in the control will have the cursor (TempY).

  NewLine := c.Origin + c.CursorY + OffsetY - 1;
  TempY   := c.CursorY + OffsetY;

  -- Constrain Top of List
  --
  -- Is the cursor moving beyond top of list frame? Near top 1/4 of control?
  -- Scroll.   Moving into first lines?  Constrain. Otherwise move cursor.

  if OffsetY < 0 then                                           -- Moving up?
     if TempY > ScrollArea then                                 -- Not top of
        c.CursorY := TempY;                          -- of list? OK
     else                                                       -- else scroll
        TempOrigin := NewLine - ScrollArea + 1;                 -- +1 so no 0
        if TempOrigin >  0 then                                 -- in list?
           c.NeedsRedrawing := c.Origin /= TempOrigin or c.NeedsRedrawing;
           c.Origin := TempOrigin;
           c.CursorY := NewLine - TempOrigin + 1;
        else                                                    -- constrain
           c.NeedsRedrawing := c.Origin /= 1 or c.NeedsRedrawing;
           c.Origin := 1;
           c.CursorY := NewLine;
        end if;
     end if;

  -- Constrain Bottom of List
  --
  -- Is the cursor moving below the bottom of list frame?   Near bottom 3/4
  -- of control?  Scroll.  Moving into final lines?  Constrain.  Otherwise
  -- move cursor.  Special case: don't scroll down if document is too short
  -- to fit in the control.

  elsif OffsetY > 0 then                                        -- moving down?
     if TooSmallToScroll then                                   -- Too short?
        c.CursorY := TempY;                          -- No scrolling
     elsif TempY <= VisibleLines - ScrollArea + 1 then          -- Not end
        c.CursorY := TempY;                          -- of list? OK
     else                                                       -- else scroll
        TempOrigin := NewLine - (VisibleLines-ScrollArea);
        if TempOrigin <= LastScrollLine then
           c.NeedsRedrawing := c.Origin /= TempOrigin or c.NeedsRedrawing;
           c.Origin := TempOrigin;
           c.CursorY := NewLine - TempOrigin + 1;
        else
           c.NeedsRedrawing := c.Origin /= LastScrollLine or c.NeedsRedrawing;
           c.Origin := LastScrollLine;
           c.CursorY := NewLine - LastScrollLine + 1;
        end if;
     end if;

   else
      -- Always check if origin needs to be fixed due to LastScrollLine
      -- (even if no y motion)
      if LastScrollLine > 0 and then NewLine > LastScrollLine then
         if OriginalOrigin /= LastScrollLine then
            c.NeedsRedrawing := true;
            c.Origin := LastScrollLine;
            c.CursorY := integer( NewLine - LastScrollLine + 1 );
         end if;
      end if;
   end if;

   -- move x-ward
   --
   -- constrain the cursor to the line of text
   c.CursorX := c.CursorX + dx;
   Text := To_Unbounded_String (C.List.Element (GetCurrent( c )));
   if c.CursorX > length( text ) + 1 then
      c.CursorX := length( text ) + 1;
   end if;
   -- further constrain the cursor to control frame
   if c.CursorX > c.frame.right - c.frame.left - 1 then
      c.CursorX := c.frame.right - c.frame.left - 1;
   elsif c.CursorX < 1 then
      c.CursorX := 1;
   end if;
exception when others =>
    DrawErrLn;
    DrawErr( "MoveCursor exception" );
    SessionLog( "MoveCursor exception" );
    SessionLog( "dx=" );
    SessionLog( integer'image( dx ) );
    SessionLog( "dy=" );
    SessionLog( integer'image( dy ) );
    raise;
end MoveCursor;

procedure SetOrigin( c : in out AStaticList'class; origin :
  Natural ) is
   Height : integer;
begin
  NoError;
  if c.origin /= 0 and c.origin /= origin then
     if not C.List.Is_Empty then
        Height := c.frame.bottom - c.frame.top;
        if origin <= Natural (C.List.Length) - (Height-2) then
           c.origin := origin;
        elsif Natural (C.List.Length) <= (Height - 2) then
           c.origin := 1; -- short list? constrain to first line
        else -- beyond last possible origin?  constrain to l.p.o.
           c.origin := Natural (C.List.Length) - (Height - 2);
        end if;
        c.NeedsRedrawing := true;
     end if;
  end if;
  exception when others => DrawErrLn;
                           DrawErr("SetOrigin RT error");
                           raise;
end SetOrigin;

function GetOrigin( c : in AStaticList'class ) return
  Natural is
begin
  NoError;
  return c.origin;
end GetOrigin;

function GetCurrent( c : in AStaticList'class ) return Natural is
begin
  NoError;
  if C.List.Is_Empty then
     return 0;
  else
     return c.Origin + c.CursorY - 1;
  end if;
end GetCurrent;

function GetLength( c : in AStaticList'class ) return Natural is
begin
  NoError;
  return Natural (C.List.Length);
end GetLength;

function GetPositionY( c : in AStaticList'class ) return integer is
begin
  NoError;
  return c.CursorY;
end GetPositionY;

procedure SetScrollBar( c : in out AStaticList'class; bar : AControlNumber ) is
begin
  NoError;
  c.ScrollBar := bar;
end SetScrollBar;

function GetScrollBar( c : in AStaticList'class ) return AControlNumber is
begin
  NoError;
  return c.ScrollBar;
end GetScrollBar;

procedure FindText( c : in out AStaticList'class; str2find : in string;
  Backwards, IsRegExp : boolean := false ) is
  OldLine, Line : Integer;
  Criteria : RegExp;
begin
  NoError;
  if IsRegExp then
     Criteria := Compile( str2find, true, true );
  elsif c.FindPhrase /= str2find then
     c.FindPhrase := To_Unbounded_String (Str2find); -- hilight, if available
     c.NeedsRedrawing := true;
  end if;
  OldLine := GetCurrent( c );
  Line := 0;
  if Backwards then
      for i in reverse 1 .. OldLine-1 loop
         declare
	    Tempstr : constant String := C.List.Element (I);
	 begin
	    if IsRegExp then
	       if Match( TempStr, Criteria ) then
		  Line := i;
		  exit;
	       end if;
	    elsif Ada.Strings.Fixed.Index( TempStr, str2find) > 0 then
	       Line := i;
	       exit;
	    end if;
	 end;
      end loop;
  else
     for i in OldLine + 1 .. Natural (C.list.Length) loop
	declare
	   TempStr : constant String := C.List.Element (I);
	begin
	   if IsRegExp then
	      if Match( TempStr, Criteria ) then
                 Line := i;
                 exit;
	      end if;
	   elsif Ada.Strings.Fixed.Index( TempStr, str2find) > 0 then
	      Line := i;
	      exit;
	   end if;
	end;
     end loop;
  end if;
  if Line > 0 then
     MoveCursor( c, 0, Line - OldLine );
  else
     Beep( Failure );
  end if;
end FindText;

procedure ReplaceText( c : in out AStaticList'class; str2find,
  str2repl : in string; Backwards, IsRegExp : boolean := false ) is
   pragma Unreferenced (Isregexp);
   OldLine, Line : integer;
  Loc     : integer;
begin
  NoError;
  c.NeedsRedrawing := true; -- always redraw
  --if (c.FindPhrase /= str2find ) then
  --   c.FindPhrase := str2find; -- hilight, if available
  --   c.NeedsRedrawing := true;
  --end if;
  OldLine := GetCurrent( c );
  Line := 0;
  if Backwards then
      for i in reverse 1..OldLine-1 loop
	 declare
	    Tempstr : constant String := C.List.Element (I);
	 begin
	    Loc := Ada.Strings.Fixed.Index( TempStr, str2find);
	    if Loc > 0 then
	       C.List.Replace_Element (i, Ada.Strings.Fixed.Replace_Slice (Tempstr, Loc, Loc + Str2find'Length - 1, str2repl));
	       Line := i;
	       exit;
	    end if;
	 end;
      end loop;
  else
     for i in OldLine + 1 .. Natural (C.List.Length) loop
	declare
	   Tempstr : constant String := C.List.Element (I);
	begin
	   Loc := Ada.Strings.Fixed.Index ( TempStr, str2find);
	   if Loc > 0 then
	      C.List.Replace_Element (I, Ada.Strings.Fixed.Replace_Slice (Tempstr, Loc, Loc + Str2find'Length - 1, Str2repl));
	      Line := i;
	      exit;
	   end if;
	end;
     end loop;
  end if;
  if Line > 0 then
     MoveCursor( c, 0, Line - OldLine );
  else
     Beep( Failure );
  end if;
end ReplaceText;

procedure SetFindPhrase( c : in out AStaticList'class; phrase : in string) is
begin
  NoError;
  if c.FindPhrase /= phrase then
     c.FindPhrase := To_Unbounded_String (Phrase);
     c.NeedsRedrawing := true;
  end if;
end SetFindPhrase;

procedure SetMark( c : in out AStaticList'class; mark : integer ) is
begin
  NoError;
  if Mark >= -1 and Mark <= Natural (C.list.Length) then
     c.Mark := Mark;
  else
     c.Mark := -1;
  end if;
  c.NeedsRedrawing := true;
end SetMark;

function GetMark( c : in AStaticList'class ) return integer is
begin
  NoError;
  return c.Mark;
end GetMark;

function CopyLine (c : in AStaticList'Class) return String is
  Current : constant Natural := GetCurrent (C);
begin
   NoError;
   if Current > 0 then
      return C.List.Element (Current);
   else
      return "";
   end if;
end CopyLine;

procedure PasteLine( c : in out AStaticList'class; Text : in String ) is
  Current : Natural;
-- insert a line into the current position, fix cursor if necessary
begin
  NoError;
  Current := GetCurrent( c );
  if Current > 0 then
     C.List.Insert (Current, text);
  else
     C.List.Append (Text);
     c.origin := 1;
     c.cursorY := 1;
     c.cursorX := Text'length + 1;
  end if;
  MoveCursor( c, 0, 0 ); -- make sure cursor is in valid position
  c.Mark := -1;          -- mark no longer valid
  c.NeedsRedrawing := true;
end PasteLine;

procedure ReplaceLine( c : in out AStaticList'class; Text : in String ) is
  Current : Natural;
-- insert a line into the current position, fix cursor if necessary
begin
  NoError;
  Current := GetCurrent( c );
  if Current > 0 then
     C.List.Replace_Element (Current, text );
  else
     C.List.Append (text);
     c.origin := 1;
     c.cursorY := 1;
     c.cursorX := Text'Length + 1;
  end if;
  c.NeedsRedrawing := true;
  MoveCursor( c, 0, 0 );
end ReplaceLine;

procedure CopyLines( c : in out AStaticList'class; mark2 : integer;
  Lines : in out StrList.Vector ) is
  -- copy lines at between mark and mark2
  StartPoint, EndPoint : Natural;
begin
  NoError;
  if c.Mark /= -1 then -- no mark set?
     if c.Mark < Mark2 then
        Startpoint := c.mark;
        Endpoint := mark2;
     else
        Startpoint := mark2;
        Endpoint := c.mark;
     end if;
     if EndPoint > Natural (C.List.Length) then
        EndPoint := Natural (c.list.Length);
     end if;
     Slice (C.List, Startpoint, Endpoint-Startpoint+1, Lines);
  else
     Lines.Clear;
  end if;
end CopyLines;

procedure PasteLines( c : in out AStaticList'class; Lines : in out
  StrList.Vector ) is
begin
  NoError;
  if not c.List.Is_Empty then
     for i in 1 .. Natural (Lines.Length) loop
        PasteLine( c, Lines.Element (i));
        MoveCursor( c, 0, +1 );
     end loop;
  else
     SetList( c, Lines );
  end if;
  -- c.Mark := -1; done by SetList and PasteLine
end PasteLines;

---> Check List Calls

procedure SetChecks( c : in out ACheckList ; Checks : in out BooleanList.Vector ) is
begin
  NoError;
  C.Checks := Checks;
  c.NeedsRedrawing := true;
  if Checks.Is_Empty then
     c.CursorX := 1;
  else
     c.CursorX := 2;
  end if;
end SetChecks;

function GetChecks( c : in ACheckList ) return BooleanList.Vector is
begin
  NoError;
  return c.Checks;
end GetChecks;


---> Radio List Calls

procedure SetChecks( c       : in out ARadioList ;
                     checks  : in out BooleanList.Vector;
                     Default : Natural := 1 ) is
begin
  NoError;
  C.Checks := Checks;
  c.NeedsRedrawing := true;
  if Checks.Is_Empty then
     c.CursorX := 1;
     c.LastCheck := 0;
  else
     c.CursorX := 2;
     c.LastCheck := Default;
     C.Checks.Replace_Element (Default, True);
  end if;
  SetOrigin( c, Default);
end SetChecks;

function GetChecks( c : in ARadioList ) return BooleanList.Vector is
begin
  NoError;
  return c.Checks;
end GetChecks;

function GetCheck( c : in ARadioList ) return Natural is
begin
  NoError;
  return C.LastCheck;
end GetCheck;

---> Edit List Calls

function GetPosition( c : in AnEditList'class ) return integer is
begin
  NoError;
  return c.CursorX;
end GetPosition;

procedure SetCursor( c : in out AnEditList'class; x : integer;
                     y : Natural ) is
begin
  NoError;
  c.cursorX := 1; -- home cursor to top of document
  c.cursorY := 1;
  MoveCursor( c, x - 1, y - 1 ); -- amount to move from home position
  c.NeedsRedrawing := true;
end SetCursor;

procedure Touch( c : in out AnEditList'class ) is
begin
  NoError;
  c.Touched := true;
end Touch;

procedure ClearTouch( c : in out AnEditList'class ) is
begin
  NoError;
  c.Touched := false;
end ClearTouch;

function WasTouched( c : AnEditList'class ) return boolean is
begin
  NoError;
  return c.Touched;
end WasTouched;


--> Source Edit List Calls


procedure SetHTMLTagsStyle( c : in out ASourceEditList; hilight : boolean ) is
begin
  NoError;
  c.HTMLTagStyle := hilight;
end SetHTMLTagsStyle;

procedure SetLanguageData( c : in out ASourceEditList; p : languageDataPtr ) is
begin
  NoError;
  c.languageData := p;
end SetLanguageData;

procedure SetSourceLanguage( c : in out ASourceEditList; l : ASourceLanguage ) is
begin
  NoError;
  c.sourceLanguage := l;
end SetSourceLanguage;

procedure SetKeywordHilight( c : in out ASourceEditList; pcn : aPenColourName ) is
begin
  NoError;
  c.keywordHilight := pcn;
end SetKeywordHilight;

procedure SetFunctionHilight( c : in out ASourceEditList; pcn : aPenColourName ) is
begin
  NoError;
  c.functionHilight := pcn;
end SetFunctionHilight;

---> Drawing Controls


procedure Draw( c : in out RootControl ) is
begin
  NoError;
  c.NeedsRedrawing := false;
  if c.Status = On then
     MoveToGlobal( c.frame.left + c.CursorX, c.frame.top + c.CursorY );
  end if;
end Draw;

procedure Draw( c : in out AnIconicControl ) is
begin
  Draw( RootControl( c ) );
end Draw;

procedure Draw( c : in out AWindowControl ) is
begin
  Draw( RootControl( c ) );
end Draw;

procedure Draw( c : in out AThermometer ) is
  CenterX : integer;
  CenterY : integer;
  LengthX : integer;
  LengthPercent : integer;
  Percent : integer;
  FirstTextChar : integer;
  LastTextChar : integer;
  Text : string(1..8);
  TextSize : integer;
  frame : ARect renames c.frame;

  procedure SetPercentText( p : string ) is
  -- Linux 2.03 gives constraint error on string-of-different-len assignment
    max : integer;
  begin
    max := Text'last;
    if p'last < Text'last then
       max := p'last;
    end if;
    for i in 1..max loop
        Text(i) := p(i);
    end loop;
    for i in max+1..Text'last loop
        Text(i) := ' ';
    end loop;
  end SetPercentText;

begin
  NoError;
  if c.needsRedrawing then
     SetTextStyle(Normal);
     -- compute postion
     LengthX := frame.right - frame.left + 1;
     CenterX := LengthX / 2 + frame.left;
     CenterY := (frame.bottom - frame.top ) / 2 + frame.top;
     if c.max = 0 then
        LengthPercent := 1;
     else
        LengthPercent := LengthX * c.value / c.max + 1;
        -- chars included
     end if;
     -- compute text
     if LengthX > 3 then
        if c.Max > 0 then
           Percent := 100 * c.value / c.max;
        else
           Percent := 0;
        end if;
        if Percent < 10 then
           TextSize := 2;
        elsif Percent < 100 then
           TextSize := 3;
        else
           TextSize := 4;
        end if;
        SetPercentText( integer'image( Percent ) );
          -- Text := integer'image( Percent );
        FirstTextChar := CenterX - frame.left - TextSize / 2;
        LastTextChar := FirstTextChar + TextSize - 1;
      else
        FirstTextChar := integer'last;
        LastTextChar := integer'last;
      end if;
      MoveToGlobal( frame.left, CenterY );
      if DisplayInfo.C_Res = 0 then -- monochrome display
         CTextStyle( 'y', 'y', 'n');
      else
         SetPenColour( thermFore );
      end if;
      for x in 1..LengthX loop
          if x = LengthPercent then
             if DisplayInfo.C_Res = 0 then
                CTextStyle( 'n', 'y', 'n' );
             else
                SetPenColour( thermBack );
             end if;
          end if;
          if x >= FirstTextChar and x <= LastTextChar then
             Draw( text( x-FirstTextChar+1) );
          elsif x = LastTextChar + 1 then
             Draw( '%' );
          elsif IsMonoXEmu and x < LengthPercent then
             -- x doesn't do dim/bold inversing
             Draw( '-' );       -- so we need to draw a line of minuses
          else
             Draw( ' ' );
          end if;
      end loop;
   end if;
   Draw( AWindowControl( c ) );
   exception when others => DrawErrLn;
                            DrawErr("DrawTherm RT error" );
                            raise;
end Draw; -- AThermometer

procedure Draw( c : in out AScrollBar ) is
  CenterX   : integer;
  CenterY   : integer;
  BarLength : integer; -- length of bar (in characters)
  Thumb     : integer; -- position of the thumb
  frame     : ARect renames c.frame;
begin
  NoError;
  if c.needsRedrawing or c.DirtyThumb then
     SetTextStyle( Normal );
     SetPenColour( scrollBack );
     if (frame.right-frame.left) > (frame.bottom-frame.top) then
        -- Horizontal Scroll Bar
        -- compute position
        BarLength := frame.right - frame.left + 1;
        CenterX := BarLength / 2 + frame.left;
        CenterY := (frame.bottom - frame.top ) / 2 + frame.top;
        if c.max = 0 then
           Thumb := 0;
        else
           Thumb := BarLength * c.thumb /
                         c.max + 1; -- chars included
           if Thumb > BarLength then
              Thumb := BarLength;
           end if;
        end if;
        if c.DirtyThumb and not c.needsRedrawing then
           -- if only a dirty thumb on horizontal bar
           if Thumb /= c.OldThumb then
              if DisplayInfo.C_Res = 0 then
                 CTextStyle( 'n', 'y', 'n' );
              else
                 SetPenColour( scrollBack );
              end if;
              MoveToGlobal( frame.left + c.OldThumb - 1,  CenterY );
              Draw( ' ' );
              MoveToGlobal( frame.left + Thumb - 1, CenterY );
              if DisplayInfo.C_Res = 0 then
                 CTextStyle( 'y', 'y', 'n' );
                 Draw( '#' );
              else
                 SetPenColour( scrollThumb );
                 Draw( ' ' );
              end if;
              Draw( '#' );
           end if;
        else -- draw whole thing
           MoveToGlobal( frame.left, CenterY );
           if DisplayInfo.C_Res > 0 then
              SetpenColour( scrollBack );
           else
              CTextStyle( 'n', 'y', 'n' );
           end if;
           for x in 1..BarLength loop
               if x = Thumb then
                  if DisplayInfo.C_Res > 0 then
                     SetPenColour( scrollThumb );
                     Draw( ' ' );
                  else
                     CTextStyle( 'y', 'y', 'n');
                     Draw( '#' );
                  end if;
               else
                  if x = Thumb + 1 then
                     if DisplayInfo.C_Res > 0 then
                        SetPenColour( scrollBack );
                     else
                        CTextStyle( 'n', 'y', 'n');
                      end if;
                  end if;
                  Draw( ' ' );
               end if;
           end loop;
        end if;
     else
        -- Vertical Scroll Bar
        -- compute position
        BarLength := frame.bottom - frame.top + 1;
        CenterY := BarLength / 2 + frame.top;
        CenterX := (frame.right - frame.left ) / 2 + frame.left;
        if c.max = 0 then
           Thumb := 0;
        else
           Thumb := BarLength * c.thumb / c.max + 1; -- chars included
           if Thumb > BarLength then
              Thumb := BarLength;
           end if;
        end if;
        if c.DirtyThumb and not c.needsRedrawing then
           -- if only a dirty thumb on horizontal bar
           if Thumb /= c.OldThumb then
              MoveToGlobal( CenterX, frame.top + c.OldThumb - 1 );
              if DisplayInfo.C_Res = 0 then
                 CTextStyle( 'n', 'y', 'n' );
              else
                 SetPenColour( scrollBack );
              end if;
              Draw( ' ' );
              MoveToGlobal( CenterX, frame.top + Thumb - 1 );
              if DisplayInfo.C_Res = 0 then
                 CTextStyle( 'y', 'y', 'n' );
                 Draw( '#' );
              else
                 SetPenColour( scrollThumb );
                 Draw( ' ' );
              end if;
           end if;
        else -- draw whole vertical scroll bar
           if DisplayInfo.C_Res > 0 then
              SetPenColour( scrollBack );
           else
              CTextStyle( 'n', 'y', 'n' );
           end if;
           for y in 1..BarLength loop
               MoveToGlobal( CenterX, frame.top + y - 1 );
               if y = Thumb then
                  if DisplayInfo.C_Res > 0 then
                     SetPenColour( scrollThumb );
                     Draw( ' ' );
                  else
                     CTextStyle( 'y', 'y', 'n' );
                     Draw( '#' );
                  end if;
               else
                  if y = Thumb + 1 then
                     if DisplayInfo.C_Res > 0 then
                        SetPenColour( scrollBack );
                     else
                        CTextStyle( 'n', 'y', 'n' );
                     end if;
                  end if;
                  Draw( ' ' );
               end if;
           end loop;
        end if;
     end if;
     c.DirtyThumb := false;
     c.OldThumb := Thumb;
  end if;
  Draw( AWindowControl( c ) );
  exception when others => DrawErrLn;
                           Draw("DrawScroll RT error");
                           raise;
end Draw; -- AScrollBar

procedure Draw( c : in out AStaticLine ) is
begin
  NoError;
  if c.needsRedrawing then
     if c.colour /= none then
        SetPenColour( c.colour );
     else
        SetPenColour( white );
     end if;
     SetTextStyle( c.style );
-- kludge because of problem iwth settextstyle
     if c.colour /= none then
        SetPenColour( c.colour );
     else
        SetPenColour( white );
     end if;
     MoveToGlobal( c.frame.left, c.frame.top );
     Draw(To_String (C.Text), c.frame.right - c.frame.left + 1, true );
  end if;
  Draw( AnIconicControl( c ) );
end Draw; -- AStaticLine

procedure Draw( c : in out AnEditLine ) is
  left : integer;
  text : Unbounded_String;
begin
  NoError;
  if c.needsRedrawing or c.DirtyText then
     SetTextStyle( Input );
     if c.DirtyText and not c.needsRedrawing then
        -- redraw only text from cursor - 1 to right
        -- the -1 is in case of a single character insert
        if c.cursorx >= 1 then
           left := c.frame.left + c.cursorx - 1;
           text := Tail( c.text, length(c.text) - c.cursorx + 1 );
        else
           left := c.frame.left;
           text := c.text;
        end if;
     else
        left := c.frame.left;
        text := c.text;
     end if;
     if c.BlindMode then
        for i in 1..length( text ) loop
            if Element( text, i ) /= ' ' then
               Replace_Element( text, i, '*' );
            end if;
        end loop;
     end if;
     MoveToGlobal( left, c.frame.top );
     if c.Status = On then
        DrawEdit( To_String (Text), c.frame.right - left + 1, c.AdvanceMode );
     else
        DrawEdit( To_String (Text), c.frame.right - left + 1, false );
     end if;
     c.DirtyText := false;
  end if;
  Draw( AWindowControl( c ) );
end Draw; -- AnEditLine

procedure Draw( c : in out AnIntegerEditLine ) is
begin
  Draw( AnEditLine( c ) );
end Draw; -- AnIntegerEditLine

procedure Draw( c : in out ALongIntEditLine ) is
begin
  Draw( AnEditLine( c ) );
end Draw; -- ALongIntEditLine

procedure Draw( c : in out AFloatEditLine ) is
begin
  Draw( AnEditLine( c ) );
end Draw; -- AFloatEditLine

procedure Draw( c : in out ACheckBox ) is
begin
  NoError;
  if c.needsRedrawing then
     SetTextStyle( Normal );
     SetPenColour( white );
     MoveToGlobal( c.frame.left, c.frame.top );
     if c.Status = Off then
        Draw( "[-] ");
     elsif c.checked then
        Draw( "[#] " );
     else
        Draw( "[ ] " );
     end if;
     Draw( To_String (C.Text), c.frame.right - c.frame.left - 3, true );
     if c.HotPos > 0 and c.HotPos < c.frame.right - c.frame.left - 3 then
        DrawHotKey( c.frame.left+3+c.HotPos, c.frame.top,
            Element( c.text, c.HotPos ) );
     end if;
  end if;
  Draw( AWindowControl( c ) );
end Draw; -- ACheckBox

procedure Draw( c : in out ARadioButton ) is
begin
  NoError;
  if c.needsRedrawing then
     SetTextStyle( Normal );
     SetPenColour( white );
     MoveToGlobal( c.frame.left, c.frame.top );
     if c.Status = Off then
        Draw( "(-) ");
     elsif c.checked then
        Draw( "(*) " );
     else
        Draw( "( ) " );
     end if;
     Draw( To_String (C.Text), c.frame.right - c.frame.left - 3, true );
     if c.HotPos > 0 and c.HotPos < c.frame.right - c.frame.left - 3 then
        DrawHotKey( c.frame.left+3+c.HotPos, c.frame.top,
                    Element( c.text, c.HotPos ) );
     end if;
  end if;
  Draw( AWindowControl( c ) );
end Draw; -- ARadioButton

procedure Draw( c : in out ASimpleButton ) is
begin
  NoError;
  if c.needsRedrawing then
     SetTextStyle( Normal );
     if c.colour = none then
        SetPenColour( white );
     end if;
     if c.colour /= none then
        SetPenColour( c.colour );
     end if;
     MoveToGlobal( c.frame.left, c.frame.top );
     if c.Instant then
        if c.Status = Off then
           Draw( "|-> " );
        else
           Draw( "| > " );
        end if;
     else
        if c.Status = Off then
           Draw( "<-> ");
        else
           Draw( "< > ");
        end if;
     end if;
     Draw( To_String (C.Text), c.frame.right - c.frame.left - 3, true );
     if c.HotPos > 0 and c.HotPos < c.frame.right - c.frame.left - 3 then
        DrawHotKey( c.frame.left+3+c.HotPos, c.frame.top,
           Element( c.text, c.HotPos ) );
     end if;
  end if;
  Draw( AWindowControl( c ) );
end Draw;

procedure Draw( c : in out AWindowButton ) is
begin
  NoError;
  if c.needsRedrawing then
     SetTextStyle( Normal );
     SetPenColour( white );
     MoveToGlobal( c.frame.left, c.frame.top );
     if c.Instant then
        if c.Status = Off then
           Draw( "|-> " );
        else
           Draw( "| > " );
        end if;
     else
        if c.Status = Off then
           Draw( "<-> ");
        else
           Draw( "< > ");
        end if;
     end if;
     Draw( To_String (C.Text), c.frame.right - c.frame.left - 3, true );
     if c.HotPos > 0 and c.HotPos < c.frame.right - c.frame.left - 3 then
        DrawHotKey( c.frame.left+3+c.HotPos, c.frame.top,
          Element( c.text, c.HotPos ) );
     end if;
  end if;
  Draw( AnIconicControl( c ) );
end Draw;

procedure Draw( c : in out ARectangle ) is
begin
  NoError;
  if c.needsRedrawing then
     SetPenColour( c.FrameColour );
     FrameRect3D( c.frame );
     if c.BackColour /= None then
        FillRect( InsetRect( c.frame, 1, 1), c.BackColour );
     end if;
  end if;
  Draw( AnIconicControl( c ) );
end Draw; -- ARectangle

procedure Draw( c : in out ALine ) is
begin
  NoError;
  if c.needsRedrawing then
     SetPenColour( c.Colour );
     if c.DownRight then
        DrawLine( c.frame.left, c.frame.top, c.frame.right, c.frame.bottom );
     else
        DrawLine( c.frame.left, c.frame.bottom, c.frame.right, c.frame.top );
     end if;
  end if;
  Draw( AnIconicControl( c ) );
end Draw; -- ALine

procedure Draw( c : in out AnHorizontalSep ) is
begin
  NoError;
  SetPenColour( c.Colour );
  if c.needsRedrawing then
     DrawHorizontalLine( c.frame.left, c.frame.right, c.frame.top );
  end if;
  Draw( AnIconicControl( c ) );
end Draw; -- AnHorizontalSep

procedure Draw( c : in out AVerticalSep ) is
begin
  NoError;
  SetPenColour( c.Colour );
  if c.needsRedrawing then
     DrawVerticalLine( c.frame.top, c.frame.bottom, c.frame.left );
  end if;
  Draw( AnIconicControl( c ) );
end Draw; -- AVerticalSep

procedure Draw( c : in out AStaticList ) is
  Contents : StrList.Vector;
  Offset   : integer := 1;
begin
  NoError;
  if c.needsRedrawing then
     SetPenColour( outline );
     FrameRect3D( c.frame );
     SetPenColour( white );
     if C.List.Is_Empty then
        null;
     else
        SetTextStyle( normal );
        -- if list is smaller than box, erase box before redrawing
        -- in case text was changed to a different number of lines
        if Natural (C.List.Length) < c.frame.bottom-c.frame.top-1 then
           FillRect( InsetRect( c.frame, 1, 1 ), black );
        end if;
        Slice (C.List, C.Origin, C.Frame.Bottom - C.Frame.Top - 1, Contents);
        while Ada.Containers.">" (Contents.Length, 0) loop
           declare
	      Temp_Line : constant String := Contents.Last_Element;
	   begin
	      Contents.Delete_Last;
	      MoveToGlobal( c.frame.left + 1, c.frame.top + offset );
	      Draw (Temp_Line, c.frame.right - c.frame.left - 1, true );
	      Offset := Offset + 1;
	   end;
        end loop;
        Contents.Clear;
     end if;
  end if;
  Draw( AWindowControl( c ) );
end Draw; -- AStaticList

procedure Draw( c : in out ACheckList ) is
  Contents : StrList.Vector;
  Offset   : integer := 1;
  Selections:BooleanList.Vector;
  IsSelected : constant boolean := false;
begin
  NoError;
  if c.needsRedrawing then
     SetPenColour( outline );
     FrameRect3D( c.frame );
     SetPenColour( white );
     if C.List.Is_Empty then
        Null;
     else
        SetTextStyle( normal );
        -- if list is smaller than box, erase box before redrawing
        -- in case text was changed to a different number of lines
        if Natural (C.List.Length) < c.frame.bottom-c.frame.top-1 then
           FillRect( InsetRect( c.frame, 1, 1 ), black );
        end if;
        Slice (c.list, c.origin, c.frame.bottom - c.frame.top - 1, Contents);
        Slice (c.checks, C.Origin, c.frame.bottom - c.frame.top -1, Selections);
        while not Contents.Is_Empty loop
           declare
	      Temp_Line : constant String := Contents.Last_Element;
	   begin
	      Contents.Delete_Last;
              MoveToGlobal( c.frame.left + 1, c.frame.top + offset );
              if not Selections.Is_Empty then
                 Selections.Append (IsSelected);
                 if DisplayInfo.C_Res > 0 then
                    SetTextStyle( normal );
                    SetPenColour( white );
                 end if;
                 Draw("[ ] ");
              else
		 Draw("[-] ");
              end if;
              Draw( Temp_Line, c.frame.right - c.frame.left - 5, true );
              Offset := Offset + 1;
	   end;
        end loop;
     end if;
  end if;
  Draw( AWindowControl( c ) );
end Draw; -- ACheckList

procedure Draw( c : in out ARadioList ) is
  Contents : Strlist.Vector;
  Offset   : integer := 1;
  Selections:BooleanList.Vector;
  IsSelected : boolean := false;
begin
  NoError;
  if c.needsRedrawing then
     SetPenColour( outline );
     FrameRect3D( c.frame );
     SetPenColour( white );
     if C.List.Is_Empty then
        Null;
     else
        SetTextStyle( normal );
        -- if list is smaller than box, erase box before redrawing
        -- in case text was changed to a different number of lines
        if Natural (C.list.Length) < C.frame.bottom-c.frame.top-1 then
           FillRect( InsetRect( c.frame, 1, 1 ), black );
        end if;
        Slice (C.List, C.Origin, C.Frame.Bottom - C.Frame.Top - 1, Contents);
        Slice (C.checks, C.Origin, c.frame.bottom - c.frame.top -1, Selections );
        while not Contents.Is_Empty loop
           declare
	      Temp_Line : constant String := Contents.Last_Element;
	   begin
	      Contents.Delete_Last;
              MoveToGlobal( c.frame.left + 1, c.frame.top + offset );
              if not Selections.Is_Empty then
                 Isselected := Selections.Last_Element;
                 Selections.Delete_Last;
                 if DisplayInfo.C_Res > 0 then
                    SetTextStyle( normal );
                    SetPenColour( white );
                 end if;
                 if IsSelected then
                    Draw("(*) ");
                    if DisplayInfo.C_Res > 0 then
                       SetPenColour( yellow );
                    end if;
                 else
                    Draw("( ) ");
                 end if;
              else
		 Draw("(-) ");
              end if;
              Draw (Temp_Line, c.frame.right - c.frame.left - 5, true );
              Offset := Offset + 1;
	   end;
       end loop;
     end if;
  end if;
  Draw( AWindowControl( c ) );
  exception when others => DrawErrLn;
                           DrawErr( "Draw(rl) exception" );
                           raise;
end Draw; -- ARadioList

procedure Draw( c : in out AnEditList ) is
  Contents : Strlist.Vector;
  Offset   : integer := 1;
  Line     : integer;
  MarkedLine : integer;
begin
  NoError;
  if c.needsRedrawing or c.DirtyLine then
     SetTextStyle( normal );
     SetPenColour( white );
     MarkedLine := c.Mark - c.origin + 1;
     if c.DirtyLine and not c.needsRedrawing then -- just do the line
        line := c.origin + c.CursorY - 1;
        declare
	   Temp_Line : constant String := c.List.Element (line);
	begin
	   MoveToGlobal( c.frame.left+1, c.frame.top + c.CursorY );
	   if line = MarkedLine then
	      SetTextStyle( Emphasis );
	   end if;
	   Draw( Temp_Line, c.frame.right - c.frame.left - 1, true );
	   if line = MarkedLine then
	      SetTextStyle( Normal );
	   end if;
	end;
     else
        SetPenColour( outline );
        FrameRect3D( c.frame );
        SetPenColour( white );
        if C.List.Is_Empty then
           FillRect( InsetRect( c.frame, 1, 1 ), black );
        else
           Slice ( c.list, c.origin,
              Natural( c.frame.bottom - c.frame.top - 1),
              Contents );
           if Natural (Contents.Length) < c.frame.bottom - c.frame.top - 1 then
              FillRect( InsetRect( c.frame, 1, 1 ), black );
           end if;
           for i in 1 .. Natural (Contents.Length) loop
	      declare
		 Temp_Line : constant String := Contents.Last_Element;
	      begin
		 Contents.Delete_Last;
		 MoveToGlobal( c.frame.left + 1, c.frame.top + offset );
		 if i = MarkedLine then
		    SetTextStyle( Emphasis );
		    Draw( Temp_Line, c.frame.right - c.frame.left - 1, true );
		    SetTextStyle( Normal );
		 else
		    Draw (Temp_Line, c.frame.right - c.frame.left - 1, true );
		 end if;
		 Offset := Offset + 1;
	      end;
	   end loop;
        end if;
     end if;
  end if;
  c.DirtyLine := false;
  Draw( AWindowControl( c ) );
end Draw; -- AnEditList

procedure Draw( c : in out ASourceEditList ) is
  Contents : Strlist.Vector;
  Line255  : Unbounded_String; -- temporary
  Offset   : integer := 1;
  Line     : integer;
  MarkedLine : integer;

  TreatAsTitle : boolean := false; -- treat next as title of something

  procedure HilightFindPhrase( basex, basey : integer ) is
    VisibleTextLength  : integer := 0;
    ch : character;
  begin
    VisibleTextLength := c.frame.right - c.frame.left - 1;
    ch := Element( c.FindPhrase, 1 );
    for i in 1..Length( Line255 ) - length( c.FindPhrase ) loop
        if Element( Line255, i ) = ch then
           if Slice( Line255, i, i+length( c.FindPhrase )-1 ) = c.FindPhrase then
              if i+length( c.FindPhrase)-1 <= VisibleTextLength then
                 SetTextStyle( bold );
                 MoveToGlobal( basex + i-1, basey );
                 Draw( To_String (C.FindPhrase) );
                 SetTextStyle( normal );
              end if;
           end if;
        end if;
    end loop;
  end HilightFindPhrase;

  procedure HilightKeyword( basex, basey, offset : integer;
                            word : string ) is
     kp : keywordDataPtr;
    fp : functionDataPtr;
    Found : boolean := false;
  begin
    kp := findKeywordData( c.languageData.all, c.sourceLanguage, word );
    if kp /= null then
       found := true;
       if DisplayInfo.C_Res > 0 then
          SetPenColour( c.keywordHilight );
          MoveToGlobal( basex + offset, basey );
          Draw( word );
          SetPenColour( white );
       else
          SetTextStyle( underline );
          MoveToGlobal( basex + offset, basey );
          Draw( word );
          SetTextStyle( normal );
       end if;
    else
       fp := findFunctionData( c.languageData.all, c.sourceLanguage, word );
       if fp /= null then
       found := true;
          if DisplayInfo.C_Res > 0 then
             SetPenColour( c.functionHilight );
             MoveToGlobal( basex + offset, basey );
             Draw( word );
             SetPenColour( white );
          else
             SetTextStyle( underline );
             MoveToGlobal( basex + offset, basey );
             Draw( word );
             SetTextStyle( normal );
          end if;
       end if;
    end if;

    --for i in 1 .. c.keywordlist.Length loop
    --    word2test := c.KeywordList.element (i);
    --    if word = word2test then
    --       if DisplayInfo.C_Res > 0 then
    --          SetPenColour( yellow );
    --          MoveToGlobal( basex + offset, basey );
    --          Draw( word );
    --          SetPenColour( white );
    --       else
    --          SetTextStyle( underline );
    --          MoveToGlobal( basex + offset, basey );
    --          Draw( word );
    --          SetTextStyle( normal );
    --       end if;
    --       Found := true;
    --       exit;
    --    end if;
    --end loop;
    if not Found and TreatAsTitle then
       if DisplayInfo.C_Res > 0 then
          SetPenColour( green );
          MoveToGlobal( basex + offset, basey );
          Draw( word );
          SetPenColour( white );
       else
          SetTextStyle( bold );
          MoveToGlobal( basex + offset, basey );
          Draw( word );
          SetTextStyle( normal );
       end if;
       TreatAsTitle := false;
   elsif Found and TreatAsTitle then
       TreatAsTitle := Equal_Case_Insensitive (Word, "body"); -- if body, still may be coming
   elsif c.SourceLanguage = Ada_Language or c.SourceLanguage = BUSH then
       if Equal_Case_Insensitive (Word, "procedure") or
	  Equal_Case_Insensitive (Word, "function") or
          Equal_Case_Insensitive (Word, "package") or
          Equal_Case_Insensitive (Word, "task") then
          TreatAsTitle := true;
       end if;
   elsif c.SourceLanguage = Perl then
       if Equal_Case_Insensitive (Word, "function") or
          Equal_Case_Insensitive (Word, "sub") then
          TreatAsTitle := true;
       end if;
   elsif c.SourceLanguage = Shell or c.SourceLanguage = PHP then
       if Equal_Case_Insensitive (Word, "function") then
          TreatAsTitle := true;
       end if;
    end if;
  end HilightKeyword;
  
  procedure HilightAllKeywords is
    -- locate potential keywords and pass them to HilightKeyword
    VisibleTextLength  : integer := 0;
    LastSpacePos       : integer := 0;
    WillBeLastSpacePos : integer := 0;
    InStr              : boolean := false;
    InStr2             : boolean := false;
    InStr3             : boolean := false;
    --NextIsTitle        : boolean := false;
    keywordBreakChar   : boolean;
    ch                 : character;
  begin
    VisibleTextLength := c.frame.right - c.frame.left - 1;
    Append (Line255, " ");
    if length( Line255 ) < VisibleTextLength then
       VisibleTextLength := length( Line255 );
    end if;
    -- Note: this won't hilight at end of line; eol requires
    -- special handling, but I can't be bothered right now
    for i in 1..VisibleTextLength loop
        ch := Element( Line255, i );
        keywordBreakChar := ( ch < 'a' or ch > 'z') and
                       ( ch < 'A' or ch > 'Z' ) and
                       ( ch < '0' or ch > '9' ) and
                       (  ch /= '_' ) and ( ch /= '.' );
        -- Hilighting HTML tags? Allow <,/,& and ?.
        if c.HTMLTagStyle then
           keywordBreakChar := keywordBreakChar and ( ch /= '<' ) and
               ( ch /= '/' ) and ( ch /= '&' ) and ( ch /= '?' ) and ( ch /= '.' );
        end if;
        -- // is a comment in PHP, but we want /XYZ to be treated as a keyword
        if ch = '/' and ( c.LanguageData.all ( c.SourceLanguage ).CommentStyle = PHPStyle and c.HTMLTagStyle ) then
           if i > 1 then -- test for // comment
              if ch = '/' and then Element( Line255, i-1 ) = '/' then
                 exit; -- the rest is C-style line comment
              end if;
           end if;
        end if;
        if keywordBreakChar then
           if c.LanguageData.all ( c.SourceLanguage ).CommentStyle = AdaStyle then
              if i > 1 then -- test for comment
                 if ch = '-' and then Element( Line255, i-1 ) = '-' then
                    exit; -- exit on Ada-style comment
                 elsif ch = '>' and then Element( Line255, i-1 ) = '=' then
                    -- special handling for => arrows
                    MoveToGlobal( c.frame.left + i-1,
                                  c.frame.top + offset );
                    SetPenColour( yellow );
                    Draw( "=>" );
                    SetPenColour( white );
                 end if;
              end if;
           elsif C.LanguageData.all ( c.SourceLanguage ).CommentStyle = ShellStyle then
               if ch = '#' then
                  exit; -- the rest is Shell-style comment
               end if;
           elsif C.LanguageData.all ( c.SourceLanguage ).CommentStyle = HTMLStyle then
               null;
           elsif C.LanguageData.all ( c.SourceLanguage ).CommentStyle = CStyle then
               if i > 1 then -- test for // comment
                  if ch = '/' and then Element( Line255, i-1 ) = '/' then
                     exit; -- the rest is C-style line comment
                  end if;
               end if;
           elsif C.LanguageData.all ( c.SourceLanguage ).CommentStyle = PHPStyle then
               if ch = '#' then
                  exit; -- exit on Shell-style comment
               elsif i > 1 then -- test for // comment
                  if ch = '/' and then Element( Line255, i-1 ) = '/' then
                     exit; -- the rest is C-style line comment
                  end if;
               end if;
           else
               null; -- unknown
           end if;
           LastSpacePos := WillBeLastSpacePos;
           WillBeLastSpacePos := i;
           if not (InStr or InStr2 or Instr3) and then LastSpacePos < i - 1 then
              HilightKeyword( c.frame.left + 1,
                     c.frame.top + offset, LastSpacePos,
                     Slice( Line255, LastSpacePos+1, i - 1 )
              );
           end if;
           -- toggle string literals
           if ch = '"' and not Instr2 then
              InStr := not InStr;
           end if;
           if C.LanguageData.all ( c.SourceLanguage ).CommentStyle /= AdaStyle then
              if ch = ''' and not InStr then -- toggle singe quote literal
                 InStr2 := not InStr2;
              end if;
              if C.LanguageData.all ( c.SourceLanguage ).Commentstyle = ShellStyle and not InStr then
                 if ch = '`' then -- toggle singe quote literal
                    InStr3 := not InStr3;
                 end if;
              end if;
           end if;
        end if;
    end loop;
  end HilightAllKeywords;

begin
  NoError;
  if c.needsRedrawing or c.DirtyLine then
     SetTextStyle( normal );
     SetPenColour( white );
     MarkedLine := c.Mark - c.origin + 1;
     if c.DirtyLine and not c.needsRedrawing then -- just do the line
        line := c.origin + c.CursorY - 1;
        Line255 := To_Unbounded_String (C.List.Element (Line));
        MoveToGlobal( c.frame.left+1, c.frame.top + c.CursorY );
        if line = MarkedLine then
           SetTextStyle( Emphasis );
        end if;
        Draw( To_String (Line255), c.frame.right - c.frame.left - 1, true );
        if line = MarkedLine then
           SetTextStyle( Normal );
        end if;
        offset := c.CursorY; -- needed for HilightAllKeywords
        HilightAllKeywords;
        if length( c.FindPhrase ) > 0 then
           HilightFindPhrase( c.frame.left+1, c.frame.top + c.CursorY );
        end if;
     else
        SetPenColour( outline );
        FrameRect3D( c.frame );
        SetPenColour( white );
        if C.List.Is_Empty then
           FillRect( InsetRect( c.frame, 1, 1 ), black );
        else
           Slice ( c.list, c.origin,
              Natural( c.frame.bottom - c.frame.top - 1),
              Contents );
           if Natural (Contents.Length) < c.frame.bottom - c.frame.top - 1 then
              FillRect( InsetRect( c.frame, 1, 1 ), black );
           end if;
           for i in 1 .. Natural (Contents.Length) loop
              Line255 := To_Unbounded_String (Contents.Last_Element);
              Contents.Delete_Last;
              MoveToGlobal( c.frame.left + 1, c.frame.top + offset );
              if i = MarkedLine then
                 SetTextStyle( Emphasis );
                 Draw( To_String (Line255), c.frame.right - c.frame.left - 1, true );
                 SetTextStyle( normal );
              else
                 Draw( To_String (Line255), c.frame.right - c.frame.left - 1, true );
                 HilightAllKeywords;
                 if length( c.FindPhrase ) > 0 then
                    HilightFindPhrase( c.frame.left+1, c.frame.top + offset );
                 end if;
              end if;
              Offset := Offset + 1;
           end loop;
        end if;
     end if;
  end if;
  c.DirtyLine := false;
  Draw( AWindowControl( c ) );
end Draw; -- ASourceEditList


---> Window Control Input


procedure Hear( c : in out RootControl; i : AnInputRecord; d : in out ADialogAction ) is
   pragma Unreferenced (C, I);
begin
  NoError;
  d := None;
end Hear;

procedure Hear( c : in out AThermometer; i : AnInputRecord; d : in out ADialogAction ) is
  diff : integer;
begin
  NoError;
  if c.Status = On and i.InputType = KeyInput then
     d := None;
     c.NeedsRedrawing := true;
     case i.key is
     when RightKey|' ' =>
          if c.value < c.max then
             c.value := c.value + 1;
          end if;
     when LeftKey|DeleteKey =>
          if c.value > 0 then
             c.value := c.value - 1;
          end if;
     when HomeKey =>
          c.value := 0;
     when EndKey =>
          c.value := c.max;
     when PageUpKey|UpKey =>
          diff := c.max / 10;
          if c.value < diff then
             c.value := 0;
          else
             c.value := c.value - diff;
          end if;
     when PageDownKey|DownKey =>
          diff := c.max / 10;
          if c.value + diff > c.max then
             c.value := c.max;
          else
             c.value := c.value + diff;
          end if;
     when ReturnKey =>
          d := Next;
     when others =>
          c.NeedsRedrawing := false;
          d := ScanNext;
     end case;
  else
     d := None;
  end if;
end Hear;

procedure Hear( c : in out AScrollBar; i : AnInputRecord; d : in out ADialogAction ) is
  diff : integer;
begin
  NoError;
  if c.Status = On then
     if i.InputType = ButtonUpInput then
        if c.Owner = 0 then
           d := complete;
        else
           d := None;
        end if;
        c.DirtyThumb := true;
        if (c.frame.bottom-c.frame.top) < (c.frame.right-c.frame.left) then
           -- Horizontal only
           if i.UpLocationX < c.frame.left + c.OldThumb - 1 then
              diff := c.max / 10;
              if c.thumb < diff then
                 c.thumb := 0;
              else
                 c.thumb := c.thumb - diff;
              end if;
           elsif i.UpLocationX > c.frame.left + c.OldThumb - 1 then
              diff := c.max / 10;
              if c.thumb + diff > c.max then
                 c.thumb := c.max;
              else
                 c.thumb := c.thumb + diff;
              end if;
           end if;
        else
           -- Vorizontal only
           if i.UpLocationY < c.frame.top + c.OldThumb - 1 then
              diff := c.max / 10;
              if c.thumb < diff then
                 c.thumb := 0;
              else
                 c.thumb := c.thumb - diff;
              end if;
           elsif i.UpLocationY > c.frame.top + c.OldThumb - 1 then
              diff := c.max / 10;
              if c.thumb + diff > c.max then
                 c.thumb := c.max;
              else
                 c.thumb := c.thumb + diff;
              end if;
           end if;
        end if;
     elsif i.InputType = KeyInput then
        if c.Owner = 0 then
           d := complete;
        else
           d := None;
        end if;
        c.DirtyThumb := true;
        case i.key is
        when RightKey|' ' =>
             if c.thumb < c.max then
                c.thumb := c.thumb + 1;
             end if;
        when LeftKey|DeleteKey =>
             if c.thumb > 0 then
                c.thumb := c.thumb - 1;
             end if;
        when PageUpKey|UpKey =>
             diff := c.max / 10;
             if c.thumb < diff then
                c.thumb := 0;
             else
                c.thumb := c.thumb - diff;
             end if;
        when PageDownKey|DownKey =>
             diff := c.max / 10;
             if c.thumb + diff > c.max then
                c.thumb := c.max;
             else
                c.thumb := c.thumb + diff;
             end if;
        when HomeKey =>
             c.thumb := 0;
        when EndKey =>
             c.thumb := c.max;
        when ReturnKey =>
             d := Next;
        when others =>
             c.DirtyThumb := false;
             --c.NeedsRedrawing := false;
             d := ScanNext;
        end case;
     end if;
  else
     d := None;
  end if;
end Hear;

procedure Hear( c : in out AStaticLine; i : AnInputRecord; d : in out ADialogAction ) is
   pragma Unreferenced (I);
begin
  NoError;
  if c.Status = On then
     d := ScanNext;
  else
     d := None;
  end if;
end Hear;

procedure Hear( c : in out AnEditLine; i : AnInputRecord; d : in out ADialogAction ) is

  k : character; -- the key typed

  procedure Add is
  begin
    if length( c.text ) < c.MaxLength then
       Insert( c.text, c.CursorX+1, (1 => K));
       c.CursorX := c.CursorX + 1;
       c.DirtyText := true;
    end if;
  end Add;

  procedure Del is
  begin
    if c.CursorX > 0 then
       c.CursorX := C.CursorX - 1;
       Delete( c.text, c.CursorX + 1, c.CursorX + 1  );
       c.DirtyText := true;
    end if;
  end Del;

  procedure Clear is
  begin
     c.text := Null_Unbounded_String;
     c.CursorX := 0;
     c.NeedsRedrawing := true;
  end Clear;

  procedure Left is
  begin
    if c.CursorX > 0 then
       c.CursorX := c.CursorX - 1;
    end if;
  end Left;

  procedure Right is
  begin
    if c.CursorX < Length( c.text ) then
       c.CursorX := c.CursorX + 1;
    end if;
  end Right;

  procedure Home is
  begin
    c.CursorX := 0;
  end Home;

  procedure Append is
  begin
    if Length( c.text ) = 0 then
       Home;
    else
       c.CursorX := length( c.text );
    end if;
  end Append;

begin
  NoError;
  if c.Status = On then
     if i.InputType = ButtonUpInput then
       c.CursorX := (i.UpLocationX - c.frame.left );
       if c.CursorX > length( c.Text ) then
          c.CursorX := length( c.Text );
       elsif c.CursorX < 0 then
          c.CursorX := 0;
       end if;
       d := None;
     elsif i.InputType = KeyInput then
     k := i.key;
     d := None;
     case k is
     when LeftKey => Left;
     when RightKey => Right;
     when DownKey|HomeKey => Home;
     when UpKey|EndKey => Append;
     when DeleteKey => Del;
     when ClearKey => Clear;
     when ReturnKey => d := Next;
     when others =>
          if k >= ' ' and k <= '~' then
             Add;
             if c.AdvanceMode then
                if length(c.text) = c.frame.right -
                    c.frame.left + 1 then -- field full? advance
                      d :=next;
                end if;
             end if;
          end if;
     end case;
     else
       d := none;
     end if;
  else
     d := none;
  end if;
end Hear;

procedure Hear( c : in out AnIntegerEditLine; i : AnInputRecord;
  d : in out ADialogAction ) is
begin
  NoError;
  if c.Status = On and i.InputType = KeyInput then
     if i.Key >= '0' and i.Key <= '9' then
           Hear( AnEditLine( c ), i, d );
     elsif i.Key = '+' or i.Key = '-' then
           if Length( c.text ) = 0 then
              Hear( AnEditLine( c ), i, d );
           else
              Beep( BadInput );
           end if;
     elsif i.Key <= ' ' or i.key = DeleteKey then
        Hear( AnEditLine( c ), i, d );
     else
        Beep( BadInput );
     end if;
  end if;
end Hear;

procedure Hear( c : in out ALongIntEditLine; i : AnInputRecord;
  d : in out ADialogAction ) is
begin
  NoError;
  if c.Status = On and i.InputType = KeyInput then
     if i.Key >= '0' and i.Key <= '9' then
        Hear( AnEditLine( c ), i, d );
     elsif i.Key = '+' or i.Key = '-' then
        if Length( c.text ) = 0 then
           Hear( AnEditLine( c ), i, d );
        else
           Beep( BadInput );
        end if;
     elsif i.Key <= ' ' or i.Key = DeleteKey then
        Hear( AnEditLine( c ), i, d );
     else
        Beep( BadInput );
     end if;
  end if;
end Hear;

procedure Hear( c : in out AFloatEditLine; i : AnInputRecord;
  d : in out ADialogAction ) is
begin
  NoError;
  if c.Status = On and i.InputType = KeyInput then
     if i.Key >= '0' and i.Key <='9' then
        Hear( AnEditLine( c ), i, d );
     elsif i.Key = '+' or i.Key = '-' then
        if length( c.text ) = 0 then
           Hear( AnEditLine( c ), i, d );
        else
           Beep( BadInput );
        end if;
     elsif i.Key <= ' ' or i.Key = '.' or i.Key = DeleteKey then
        Hear( AnEditLine( c ), i, d );
     else
        Beep( BadInput );
     end if;
  end if;
end Hear;

procedure Hear( c : in out ACheckBox; i : AnInputRecord; d : in out ADialogAction ) is
begin
  NoError;
  if c.Status = On then
     if i.InputType = ButtonUpInput then
        c.checked := not c.checked;
        c.NeedsRedrawing := true;
        d := None;
     elsif i.InputType = KeyInput then
        d := ScanNext;
        case i.key is
           when ' ' =>
              c.checked := not c.checked;
              c.NeedsRedrawing := true;
              d := None;
           when RightKey =>
              d := right;
           when LeftKey =>
              d := left;
           when UpKey =>
              d := up;
           when DownKey =>
              d := down;
           when ReturnKey =>
              d := Next;
           when others =>
              null;
        end case;
     end if;
  else
     d := None;
  end if;
end Hear;

procedure Hear( c : in out ARadioButton; i : AnInputRecord; d : in out ADialogAction ) is
begin
  NoError;
  if c.Status = On then
     if i.InputType = ButtonUpInput then
        c.checked := true;
        c.NeedsRedrawing := true;
        d := FixFamily;
     elsif i.InputType = KeyInput then
        d := ScanNext;
        case i.key is
           when ' ' =>
              c.checked := true;
              c.NeedsRedrawing := true;
              d := FixFamily;
           when RightKey =>
              d := right;
           when LeftKey =>
              d := left;
           when UpKey =>
              d := up;
           when DownKey =>
              d := down;
           when ReturnKey =>
              d := Next;
           when others =>
              null;
        end case;
     end if;
  else
     d := None;
  end if;
end Hear;

procedure Hear( c : in out ASimpleButton; i : AnInputRecord; d : in out ADialogAction ) is
  k : character; -- for delay

  procedure Blink is
  begin
    for i in 1..2 loop
      SetTextStyle( bold );
      SetPenColour( c.colour );
      MoveToGlobal( c.frame.left+4, c.frame.top );
      Draw( To_String (C.Text));
      RevealNow;
      WaitFor( 6 );
      Invalid( c );
      Draw( c );
      --MoveToGlobal( c.frame.left+4, c.frame.top );
      --SetTextStyle( Normal );
      --Draw( c.text );
      RevealNow;
      WaitFor( 6 );
    end loop;
  end Blink;

begin
  NoError;
  if c.Status = On then
     if i.InputType = ButtonUpInput then
        d := Complete;
        Blink;
     elsif i.InputType = KeyInput then
        k := i.key;
        if k = ReturnKey or else k = ' ' then
           d := Complete;
           Blink;
        elsif k = RightKey then
           d := Right;
        elsif k = DownKey then
           d := Down;
        elsif k = LeftKey then
           d := Left;
        elsif k = UpKey then
           d := Up;
        else
           d := ScanNext;
        end if;
     end if; -- key imput
  else
     d := None;
  end if;
end Hear;

procedure Hear( c : in out AWindowButton; i : AnInputRecord; d : in out ADialogAction ) is
  k : character; -- for delay
begin
  NoError;
  if c.Status = On and i.InputType = KeyInput then
     k := i.key;
     if k = ReturnKey or else k = ' ' then
        if length( c.link ) > 0 then
           d := FollowLink;
        else
           d := Complete;
        end if;
        for i in 1..2 loop
          SetTextStyle( bold );
          SetPenColour( white );
          MoveToGlobal( c.frame.left+4, c.frame.top );
          Draw( To_String (C.Text) );
          RevealNow;
          WaitFor( 6 );
          MoveToGlobal( c.frame.left+4, c.frame.top );
          SetTextStyle( Normal );
          Draw( To_String (C.Text) );
          RevealNow;
          WaitFor( 6 );
        end loop;
     elsif k = RightKey then
        d := Right;
     elsif k = DownKey then
        d := Down;
     elsif k = LeftKey then
        d := Left;
     elsif k = UpKey then
        d := Up;
     else
        d := ScanNext;
     end if;
  else
     d := None;
  end if;
end Hear;

procedure Hear( c : in out ARectangle; i : AnInputRecord; d : in out ADialogAction ) is
   pragma Unreferenced (I);
begin
  NoError;
  if c.Status = On then
     d := ScanNext;
  else
     d := None;
  end if;
end Hear; -- ARectangle

procedure Hear( c : in out ALine'class; i : AnInputRecord; d : in out ADialogAction ) is
   pragma Unreferenced (I);
begin
  NoError;
  if c.Status = On then
     d := ScanNext;
  else
     d := None;
  end if;
end Hear; -- ALine

procedure Hear( c : in out AStaticList; i : AnInputRecord; d : in out
 ADialogAction ) is
  Distance : integer;
  LastLine : integer;          -- last legal origin
  Height   : integer;          -- height of control
  NewOrigin: Natural;

begin
  NoError;
  if c.Status = On and not c.List.Is_Empty then
    if i.InputType = ButtonUpInput then
       Distance := i.UpLocationY - c.frame.top - c.CursorY;
       MoveCursor( c, 0, Distance );
       if Distance = 0 then
          if GetMark( c ) = GetCurrent( c ) then
             SetMark( c, -1 );
          else
             SetMark( c,  GetCurrent( c ) );
          end if;
       end if;
    elsif i.InputType = KeyInput then
     d := None;
     Height := c.frame.bottom - c.frame.top;
     LastLine := Natural ( C.List.Length) - (Height - 2);
     if LastLine < 1 then
        LastLine := 1;
     end if;
     case i.key is
     when UpKey|LeftKey =>
       MoveCursor( c, 0, -1 );
     when DownKey|RightKey =>
       MoveCursor( c, 0, +1 );
     when PageDownKey =>
          if c.Origin + Height - 2 > LastLine then
             NewOrigin := LastLine;
          else
             NewOrigin := c.Origin + Natural( Height - 2 );
          end if;
          if NewOrigin /= c.Origin then
             c.Origin := NewOrigin;
             c.NeedsRedrawing := true;
          end if;
     when PageUpKey =>
          if c.Origin - (Height - 2) < 1 then
             NewOrigin := 1;
          else
             NewOrigin := c.Origin - ( Height - 2 );
          end if;
          if NewOrigin /= c.Origin then
             c.Origin := NewOrigin;
             c.NeedsRedrawing := true;
          end if;
     when HomeKey =>
          c.Origin := 1;
          c.NeedsRedrawing := true;
     when EndKey =>
          if c.Origin /= LastLine then
             c.Origin := LastLine;
             c.NeedsRedrawing := true;
          end if;
     when others =>
          d := ScanNext;
     end case;
    end if; -- input type
  else
     d := ScanNext;
  end if;
  exception when others => DrawErrLn;  DrawErr( "Hear(sl) exceptions" ); raise;
end Hear; -- AStaticList

procedure Hear( c : in out ACheckList; i : AnInputRecord; d : in out
ADialogAction ) is
  Distance : integer;
  line : Integer;
begin
  NoError;
  if c.Status = On and not c.List.Is_Empty then
    if i.InputType = ButtonUpInput then
       Distance := i.UpLocationY - c.frame.top - c.CursorY;
       MoveCursor( c, 0, Distance );
       if Distance = 0 then
          if GetMark( c ) = GetCurrent( c ) then
             SetMark( c, -1 );
          else
             SetMark( c,  GetCurrent( c ) );
          end if;
       end if;
       if not C.Checks.Is_Empty then
          Line := GetCurrent (c);
          if Natural (c.Checks.Length) >= Line then
             C.Checks.Replace_Element (Line, not c.Checks.Element (Line));
             c.NeedsRedrawing := true;
          end if;
       end if;
    elsif i.InputType = KeyInput then
       if i.Key = ReturnKey or else i.Key = ' ' then
          if not C.Checks.Is_Empty then
             Line := GetCurrent (C);
             if Natural (C.Checks.Length) >= Line then
                C.Checks.Replace_Element (Line, not c.Checks.Element (Line));
                c.NeedsRedrawing := true;
             end if;
          end if;
       else
         Hear( AStaticList( c ), i, d );
       end if;
    end if;
  else
     d := ScanNext;
  end if;
end Hear; -- ACheckList

procedure Hear( c : in out ARadioList; i : AnInputRecord; d : in out
ADialogAction ) is
  Distance : integer;
  line : integer;
begin
  NoError;
  if c.Status = On and not c.List.Is_Empty then
    if i.InputType = ButtonUpInput then
       Distance := i.UpLocationY - c.frame.top - c.CursorY;
       MoveCursor( c, 0, Distance );
       if Distance = 0 then
          if GetMark( c ) = GetCurrent( c ) then
             SetMark( c, -1 );
          else
             SetMark( c,  GetCurrent( c ) );
          end if;
       end if;
       if not C.Checks.Is_Empty then
          Line := GetCurrent( c );
          if Natural (C.Checks.Length) >= Line then
             if c.LastCheck /= 0 then
                C.Checks.Replace_Element (C.LastCheck, false );
             end if;
             C.Checks.Replace_Element (Line, true );
             c.NeedsRedrawing := true;
             c.LastCheck := Line;
          end if;
       end if;
    elsif i.InputType = KeyInput then
       if i.Key = ReturnKey or else i.Key = ' ' then
          if not C.Checks.Is_Empty then
             Line := GetCurrent( c );
             if Natural (C.Checks.Length) >= Line then
                if c.LastCheck /= 0 then
                   C.Checks.Replace_Element (C.LastCheck, false );
                end if;
                C.Checks.Replace_Element (Line, True);
                c.NeedsRedrawing := true;
                c.LastCheck := Line;
             end if;
          end if;
       else
          Hear( AStaticList( c ), i, d );
       end if;
    end if;
  else
    d := ScanNext;
  end if;
  exception when others=> DrawErrLn; DrawErr( "Hear(rl) exception" ); raise;
end Hear; -- ARadioList

procedure Hear( c : in out AnEditList; i : AnInputRecord; d : in out
  ADialogAction ) is
  DistanceX : integer;
  DistanceY : integer;
  line : integer; -- line # of text in list
  k    : character; -- the key typed
  text : Unbounded_String;       -- the text

  procedure AdjustCursorForEOL is
  -- note! uses line and text
  begin
    Line := c.origin + c.CursorY - 1;
    Text := To_Unbounded_String (C.List.Element (line));
    if c.CursorX > length( text ) + 1 then
       c.CursorX := length( text ) + 1;
    end if;
  end AdjustCursorForEOL;

  procedure Add is
  begin
    Insert( text, c.CursorX, (1 => K));
    C.List.Replace_Element (line, To_String (Text) );
    if length( text ) >= c.frame.right - c.frame.left then
       JustifyText( c, c.frame.right - c.frame.left - 1, line );
       c.NeedsRedrawing := true;
    else
       c.DirtyLine := true;
    end if;
    c.CursorX := c.CursorX + 1;
  end Add;

  procedure Del is

    function isParagraphStart( A_Line_Of_Text : string ) return boolean is
      -- does the line of text look like the start of a paragraph (blank line or
      -- indented)
    begin
       if A_Line_Of_Text'Length = 0 then
         return true;
      elsif A_Line_Of_Text (A_Line_Of_Text'First) = ' ' then
         return true;
      end if;
      return false;
    end isParagraphStart;
    
  begin
     if c.CursorX > 1 then
	c.CursorX := C.CursorX - 1;
	Delete( text, c.CursorX , c.CursorX  );
	C.List.Replace_Element (Line, To_String (Text));
	if not C.list.Is_Empty then
	   declare
	      NextText : constant String := c.List.Element (line+1);
	   begin
	      if not isParagraphStart( NextText ) then
		 Append( Text, NextText);
		 C.List.Replace_Element (Line, To_String (Text));     -- combine lines
		 c.List.Delete (line + 1 );         -- discard previous
		 JustifyText( c, c.frame.right - c.frame.left - 1, line );
		 c.NeedsRedrawing := true;
	      else
		 c.DirtyLine := true;
	      end if;
	   end;
	end if;
     elsif line > 1 then -- move the cursor up
	line := line - 1;
	if c.CursorY > 1 then
	   if c.Origin > 1 and then line > Natural (c.list.Length) -
             (c.frame.bottom - c.frame.top) then
	      -- keep list in window
	      c.Origin := c.Origin - 1;          -- when del near bottom
	   else
	      c.CursorY := c.CursorY - 1;
	   end if;
	else
	   c.Origin := c.Origin - 1;
	end if;
	declare
	   Prevtext : constant String := c.List.Element (line);
	begin
	   if length( Text ) > 0 then
	      c.CursorX := PrevText'Length;
	   else
	      c.CursorX := PrevText'Length + 1;
	   end if;
	   C.List.Replace_Element (line, PrevText & To_String (Text)); -- combine lines
	end;
	C.List.Delete (line + 1 );         -- discard previous
	JustifyText( c, c.frame.right - c.frame.left - 1, line );
	c.NeedsRedrawing := true;
     end if;
  end Del;
  
  procedure Clear is

    procedure ClearALine( line : Natural ) is
    begin
       C.List.Delete (line );
      if C.List.Is_Empty then
         c.CursorX := 1;
         c.CursorY := 1;
      elsif line > Natural (C.List.Length) then
         MoveCursor( c, 0, -1 );
      else
         MoveCursor( c, 0, 0 );
      end if;
    end ClearALine;

  begin
    if c.mark < 0 then
       ClearALine( line );
    else
       -- clear n lines from mark
       for i in c.mark..line loop
           ClearALine( c.mark );
       end loop;
       -- reposition to mark
       MoveCursor( c, 0, -GetCurrent( c ) );
       MoveCursor( c, 0, c.mark-1 );
    end if;
    c.needsRedrawing := true;
  end Clear;

  procedure Left is
  begin
    if c.CursorX > 1 then
       c.CursorX := c.CursorX - 1; --MoveCursor(c, -1, 0 );
    else
       MoveCursor(c, 256, -1);
    end if;
  end Left;

  procedure Right is
  begin
    if c.CursorX <= Length( text ) then
       c.CursorX := c.CursorX + 1;
    else
       if line < Natural (c.list.Length) then
          c.CursorX := 1;
          MoveCursor( c, 0, +1 );
       end if;
    end if;
  end Right;

  procedure DoReturn is
    NewText : unbounded_string;
  begin
    -- should really cut off line, but that requires inserting a new
    -- string into the middle of the list -- not yet written

    if c.CursorX <= length( text ) then
       NewText := Tail( text, length( text ) - c.CursorX + 1 );
       Delete( Text, c.CursorX, length( text ) );
       C.List.Replace_Element (line, To_String (Text));
    else
       NewText := Null_Unbounded_String;
    end if;
    if line < Natural (c.list.Length) then
       C.List.Insert (line+1, To_String (NewText) );
    else
       C.List.Prepend (To_String (NewText) );
    end if;
    c.needsRedrawing := true;
    c.CursorX := 1;
    MoveCursor( c, 0, 1 );
  end DoReturn;

  procedure DoForwardSearch is
    newpos : integer;
  begin
    c.ForwardCharSearchMode := false;
    newpos := c.CursorX;
    for z in c.CursorX+1..length( text ) loop
        if Element( text, z ) = i.Key then
           newpos := z;
           exit;
        end if;
    end loop;
    if newpos = c.CursorX then
       Beep( Failure );
    else
       c.CursorX := newpos;
       c.needsRedrawing := true;
    end if;
  end DoForwardSearch;

  procedure StartNewList is
  begin
    C.List.Prepend ((1 => I.Key));
    c.CursorX := 2;
    c.Origin := 1;
    c.CursorY := 1;
    c.needsRedrawing := true;
  end StartNewList;

  procedure StartBlankList is
  begin
     C.List.Prepend ("");
     C.List.Prepend ("");
    c.CursorX := 1;
    c.Origin := 1;
    c.CursorY := 2;
    c.needsRedrawing := true;
  end StartBlankList;

begin
  NoError;
  d := None;
  if c.Status = On then
    if i.InputType = ButtonUpInput and not c.List.Is_Empty then
       DistanceY := i.UpLocationY - c.frame.top - c.CursorY;
       DistanceX := i.UpLocationX - c.frame.left - c.CursorX;
       MoveCursor( c, DistanceX, DistanceY );
       if DistanceY = 0 then
          if GetMark( c ) = GetCurrent( c ) then
             SetMark( c, -1 );
          else
             SetMark( c,  GetCurrent( c ) );
          end if;
       end if;
    elsif i.InputType = KeyInput then
       if not C.List.Is_Empty then
          k := i.key;
          line := GetCurrent( c );
          --line := c.origin + c.CursorY - 1;
          Text := To_Unbounded_String (C.List.Element (line));
          -- should be buffered in a field
          if c.ForwardCharSearchMode then
            DoForwardSearch;
            return;
          end if;
          case k is
          when LeftKey => Left;
          when RightKey => Right;
          when DeleteKey => Del;
          when ClearKey => Clear;
               c.Touched := true;
          when ReturnKey => DoReturn;
               c.Touched := true;
          when CSearchKey =>
               c.ForwardCharSearchMode := true;
          when others =>
            if k >= ' ' and k <= '~' then
               Add;
               c.Touched := true;
            else
               Hear( AStaticList( c ), i, d );
               AdjustCursorForEOL;
            end if;
          end case;
       elsif i.key >= ' ' and i.key <= '~' then
          StartNewList;
          c.Touched := true;
       elsif i.key = ReturnKey then
          StartBlankList;
          c.Touched := true;
       end if;
    end if;
  else
    d := None;
  end if;
end Hear; -- AnEditList

procedure Hear( c : in out ASourceEditList; i : AnInputRecord; d : in out
  ADialogAction ) is
  DistanceX : integer;
  DistanceY : integer;
  line : integer; -- line # of text in list
  k    : character; -- the key typed
  text : Unbounded_String;       -- the text

  procedure AdjustCursorForEOL is
  -- note! uses line and text
  begin
    Line := c.origin + c.CursorY - 1;
    Text := To_Unbounded_String (c.List.Element (line));
    if c.CursorX > length( text ) + 1 then
       c.CursorX := length( text ) + 1;
    end if;
  end AdjustCursorForEOL;

  procedure Add is
  begin
    -- Starting to insert new typing?  Start a new insert area.
    if c.InsertedLines = 0 then                                   -- starting?
       c.InsertedFirst := c.origin + c.CursorY - 1;
       c.InsertedLines := 1;                                      -- this line
    end if;
    Insert( text, c.CursorX, (1 => K));              -- add char
    if length( text ) >= c.frame.right - c.frame.left then        -- too big?
       C.List.Replace_Element (line, To_String (Text) );                  -- update ln
       JustifyText( c, c.frame.right - c.frame.left - 1, line );  -- justify
       c.NeedsRedrawing := true;                                  -- redraw it
    else                                                          -- fits?
       C.List.Replace_Element (line, To_String (Text));                  -- update ln
       c.DirtyLine := true;                                       -- redraw ln
    end if;
    c.CursorX := c.CursorX + 1;                                   -- advance
  end Add;

  procedure Del is
  begin
    if c.CursorX > 1 then
       c.CursorX := C.CursorX - 1;
       Delete( text, c.CursorX , c.CursorX  );
       C.List.Replace_Element (line, To_String (Text) );
       c.dirtyLine := true;
    elsif line > 1 then -- move the cursor up
       line := line - 1;
       if c.CursorY > 1 then
          if c.Origin > 1 and then line > Natural (c.list.Length) -
            (c.frame.bottom - c.frame.top) then
             -- keep list in window
             c.Origin := c.Origin - 1;          -- when del near bottom
          else
             c.CursorY := c.CursorY - 1;
         end if;
       else
          c.Origin := c.Origin - 1;
       end if;
       declare
	  Prevtext : constant String := C.List.Element (Line);
       begin
	  if length( Text ) > 0 then
	     c.CursorX := PrevText'Length;
	  else
	     c.CursorX := PrevText'Length + 1;
	  end if;
	  C.List.Replace_Element (line, PrevText & To_String (Text)); -- combine lines
       end;
       C.List.Delete (line + 1 );         -- discard previous
       -- insert area? justify it.  If no insert area, don't.
       if c.InsertedLines > 0 then
          if c.InsertedFirst = line+1 then
             c.InsertedFirst := c.InsertedFirst - 1;     -- lift ins area up
             c.InsertedLines := c.InsertedLines - 1;     -- move up bottom
          end if;
          c.InsertedLines := c.InsertedLines - 1;        -- move up bottom
          --JustifyText( c, c.frame.right - c.frame.left - 1, line );
       end if;
       c.NeedsRedrawing := true;
    end if;
  end Del;

  procedure Clear is

    procedure ClearALine( line : Natural ) is
    begin
      C.List.Delete (line );
      if c.List.Is_Empty then
         c.CursorX := 1;
         c.CursorY := 1;
      elsif line > Natural (C.List.Length) then
         MoveCursor( c, 0, -1 );
      else
         MoveCursor( c, 0, 0 );
      end if;
    end ClearALine;

  begin
    if c.mark < 0 then
       ClearALine( line );
    else
       -- clear n lines from mark
       for i in c.mark..line loop
           ClearALine( c.mark );
       end loop;
       -- reposition to mark
       MoveCursor( c, 0, -GetCurrent( c ) );
       MoveCursor( c, 0, c.mark-1 );
    end if;
    c.needsRedrawing := true;
  end Clear;

  procedure Left is
  begin
    if c.CursorX > 1 then
       c.CursorX := c.CursorX - 1; --MoveCursor(c, -1, 0 );
    else
       if c.InsertedLines > 0 then
          if line = c.InsertedFirst then
             c.InsertedLines := 0;
          end if;
       end if;
       MoveCursor(c, 256, -1);
    end if;
  end Left;

  procedure Right is
  begin
    if c.CursorX <= Length( text ) then
       c.CursorX := c.CursorX + 1;
    else
       if c.InsertedLines > 0 then
          if line = c.InsertedFirst + c.InsertedLines - 1 then
             c.InsertedLines := 0;
          end if;
       end if;
       if line < Natural (c.list.Length) then
          c.CursorX := 1;
          MoveCursor( c, 0, +1 );
       end if;
    end if;
  end Right;

  procedure DoIndent is
    -- indent line same number of spaces as line above it
  begin
    -- DoReturn makes a new line, so we need to reload "text"
    line := GetCurrent( c );
    Text := To_Unbounded_String (C.List.Element (Line));
    if line > 1 then  -- if current line is not the first (never =1?)
       declare
	  LineAbove : constant String := C.List.Element (line-1);
	  Spacepos : Positive := Lineabove'First;
       begin
	  while Spacepos <= Lineabove'Last
	    and then Lineabove (Spacepos) /= ' ' loop
	     Insert( Text, c.CursorX, (1=>' '));
	     SpacePos := SpacePos + 1;
	  end loop;
          C.List.Replace_Element (line, To_String (Text));
          MoveCursor( c, SpacePos-1, 0 ); -- move to end of spaces
       end;
    end if;
    c.NeedsRedrawing := true;
  end DoIndent;

  procedure DoReturn is

    procedure AutoSpell is
      -- extract the first word (or if "end", first two words)
      -- and if a mispelling of a long Ada keyword, replace
      -- it with the proper spelling.  Do only long keywords
      -- to avoid fixing legitimate identifiers.
      --
      -- assumes Text is the text to correct
      --
      FirstPos, SpacePos, LastPos : natural := 0;
      OldTextLength : integer;
      Word : unbounded_string;
      Changed : boolean := false; -- true if word was corrected
    begin
      OldTextLength := Length( Text );
      -- extract the word(s) to test
      for i in 1..Length( Text ) loop
          if Element( Text, i ) /= ' ' then
             FirstPos := i;
             exit;
          end if;
      end loop;
      if FirstPos = 0 then -- null string
         return;
      end if;
      for i in FirstPos + 1..length( Text ) loop
          if Element( text, i ) = ' ' then
             LastPos := i - 1;
             exit;
          end if;
      end loop;
      if LastPos = 0 then -- no trailing space?
         LastPos := length( Text );
      end if;
      Word := Unbounded_Slice( Text, FirstPos, LastPos );
      if Word = "end" and LastPos < length( Text ) then
         SpacePos := LastPos+1;
         LastPos := 0;
         for i in SpacePos+1..length( Text ) loop
             if Element( text, i ) = ' ' then
                LastPos := i - 1;
                exit;
             end if;
         end loop;
         if LastPos = 0 then -- no trailing space?
            LastPos := length( Text );
         end if;
         Word := Unbounded_Slice( Text, FirstPos, LastPos );
      end if;

      -- take first word (or if "end", first two words) and test
      -- for typos

      Changed := false;
      for I in Strings_Used_By_Autospell'Range loop
	 if TypoOf( To_String (Word), To_String (Strings_Used_By_Autospell (I))) then
	    Delete( Text, FirstPos, LastPos );
	    Insert( Text, FirstPos, To_String (Strings_Used_By_Autospell (I)));
	    Changed := true;
	    exit;
	 end if;
      end loop;
      if Changed then
         C.List.Replace_Element (line, To_String (Text) );
         SessionLog( "AutoSpell: " & To_String (Word) & " corrected" );
         -- spell checking will add no more than 1 letter
         if length( text ) > OldTextLength then
            c.CursorX := c.CursorX + 1;
         end if;
      elsif LastPos /= OldTextLength then
         -- no first word changes and not entire line?
         -- try fixing ending words
         OldTextLength := length( Text );
         FirstPos := 0;
         LastPos := length( Text );
         for i in reverse 1..LastPos-1 loop
             if Element( Text, i ) = ' '  then
                FirstPos := i+1;
                exit;
             end if;
         end loop;
         if FirstPos /= 0 then
            Changed := false;
            Word := Unbounded_Slice ( Text, FirstPos, LastPos);
            if TypoOf( To_String (Word), "then" ) then
               Delete( Text, FirstPos, LastPos );
               Insert( Text, FirstPos, "then");
               Changed := true;
            elsif TypoOf( To_String (Word), "loop") then
               Delete( Text, FirstPos, LastPos );
               Insert( Text, FirstPos, "loop");
               Changed := true;
            end if;
            if Changed then
               C.List.Replace_Element (line, To_String (Text));
               SessionLog( "AutoSpell: " & To_String (Word) & " corrected" );
               -- spell checking will add no more than 1 letter
               if length( text ) > OldTextLength then
                  c.CursorX := c.CursorX + 1;
               end if;
            end if;
         end if;
      end if;
    end AutoSpell;

    NewText : unbounded_string;

  begin
    -- should really cut off line, but that requires inserting a new
    -- string into the middle of the list -- not yet written
    if c.insertedLines = 0 then
       c.insertedFirst := c.origin + c.CursorY;
    end if;
    c.insertedLines := c.insertedLines + 1;
    AutoSpell;
    if c.CursorX <= length( text ) then
       NewText := Tail( text, length( text ) - c.CursorX + 1 );
       Delete( Text, c.CursorX, length( text ) );
       C.List.Replace_Element (line, To_String (Text) );
    else
       NewText := Null_Unbounded_String;
    end if;
    if line < Natural (c.list.Length) then
       C.List.Insert (line+1, To_String (NewText) );
    else
       C.List.Prepend (To_String (NewText) );
    end if;
    c.needsRedrawing := true;
    c.CursorX := 1;
    MoveCursor( c, 0, 1 );
    DoIndent;
  end DoReturn;

  procedure DoForwardSearch is
    newpos : integer;
  begin
    c.ForwardCharSearchMode := false;
    newpos := c.CursorX;
    for z in c.CursorX+1..length( text ) loop
        if Element( text, z ) = i.Key then
           newpos := z;
           exit;
        end if;
    end loop;
    if newpos = c.CursorX then
       Beep( Failure );
    else
       c.CursorX := newpos;
       c.needsRedrawing := true;
    end if;
  end DoForwardSearch;

  procedure StartNewList is
  begin
    C.List.Prepend ((1 => I.Key));
    c.CursorX := 2;
    c.Origin := 1;
    c.CursorY := 1;
    c.insertedLines := 0;
    c.needsRedrawing := true;
  end StartNewList;

  procedure StartBlankList is
  begin
    C.List.Prepend ("");
    C.List.Prepend ("");
    c.CursorX := 1;
    c.Origin := 1;
    c.CursorY := 2;
    c.insertedLines := 0;
    c.needsRedrawing := true;
  end StartBlankList;

begin
  NoError;
  if i.InputType = ButtonUpInput and not C.List.Is_Empty then
       DistanceY := i.UpLocationY - c.frame.top - c.CursorY;
       DistanceX := i.UpLocationX - c.frame.left - c.CursorX;
       MoveCursor( c, DistanceX, DistanceY );
       if DistanceY = 0 then
          if GetMark( c ) = GetCurrent( c ) then
             SetMark( c, -1 );
          else
             SetMark( c,  GetCurrent( c ) );
          end if;
       end if;
       c.InsertedLines := 0;
  elsif i.InputType = KeyInput then
       d := None;
       if not C.List.Is_Empty then
          k := i.key;
          line := GetCurrent( c );
          --line := c.origin + c.CursorY - 1;
          Text := To_Unbounded_String (C.List.Element (Line));
          -- should be buffered in a field
          if c.ForwardCharSearchMode then
            DoForwardSearch;
            return;
          end if;
          case k is
          when LeftKey =>
               Left;
          when RightKey =>
               Right;
          when UpKey =>
               if c.InsertedLines > 0 then
                  if GetCurrent( c ) = c.InsertedFirst then
                     c.InsertedLines := 0;
                  end if;
               end if;
               MoveCursor( c, 0, -1 );
          when DownKey =>
               if c.InsertedLines > 0 then
                  if GetCurrent( c ) = c.InsertedFirst + c.InsertedLines - 1 then
                     c.InsertedLines := 0;
                  end if;
               end if;
               MoveCursor( c, 0, +1 );
          when DeleteKey =>
               Del;
               c.Touched := true;
          when ClearKey =>
               Clear;
               c.Touched := true;
          when ReturnKey =>
               DoReturn;
               c.Touched := true;
          when CSearchKey =>
               c.ForwardCharSearchMode := true;
          when others =>
            if k >= ' ' and k <= '~' then
               Add;
               c.Touched := true;
            else
               Hear( AStaticList( c ), i, d );
               AdjustCursorForEOL;
            end if;
         end case;
       elsif i.key >= ' ' and i.key <= '~' then
         StartNewList;
         c.Touched := true;
       elsif i.key = ReturnKey then
         StartBlankList;
         c.Touched := true;
       end if;
  else
    d := None;
  end if;
end Hear; -- ASourceEditList


---> Status Selection


function  GetStatus( c : in RootControl'class ) return AControlStatus is
begin
  NoError;
  return c.status;
end GetStatus;

procedure SetStatus( c : in out RootControl; status : AControlStatus ) is
begin
  NoError;
  c.Status := status;
end SetStatus;

procedure SetStatus( c : in out AnIconicControl; status : AControlStatus ) is
begin
  SetStatus( RootControl( c ), status );
end SetStatus;

procedure SetStatus( c : in out AWindowControl; status : AControlStatus ) is
begin
  SetStatus( RootControl( c ), status );
end SetStatus;

procedure SetStatus( c : in out AThermometer; status : AControlStatus ) is
begin
  SetStatus( AWindowControl( c ), status );
end SetStatus;

procedure SetStatus( c : in out AScrollBar; status : AControlStatus ) is
begin
  SetStatus( AWindowControl( c ), status );
end SetStatus;

procedure SetStatus( c : in out AStaticLine; status : AControlStatus ) is
begin
  SetStatus( AnIconicControl( c ), status );
end SetStatus;

procedure SetStatus( c : in out ACheckBox; status : AControlStatus ) is
begin
  if c.status = Off xor status = Off then
     c.NeedsRedrawing := true;
  end if;
  SetStatus( AWindowControl( c ), status );
end SetStatus;

procedure SetStatus( c : in out ARadioButton; status : AControlStatus ) is
begin
  if c.status = Off xor status = Off then
     c.NeedsRedrawing := true;
  end if;
  SetStatus( AWindowControl( c ), status );
end SetStatus;

procedure SetStatus( c : in out AnEditLine; status : AControlStatus ) is
begin
  c.NeedsRedrawing := status /= c.status;
  SetStatus( AWindowControl( c ), status );
end SetStatus;

procedure SetStatus( c : in out AnIntegerEditLine; status : AControlStatus ) is
begin
  SetStatus( AnEditLine( c ), status );
end SetStatus;

procedure SetStatus( c : in out ALongIntEditLine; status : AControlStatus ) is
begin
  SetStatus( AnEditLine( c ), status );
end SetStatus;

procedure SetStatus( c : in out AFloatEditLine; status : AControlStatus ) is
begin
  SetStatus( AnEditLine( c ), status );
end SetStatus;

procedure SetStatus( c : in out ASimpleButton; status : AControlStatus ) is
begin
  if c.status = Off xor status = Off then
     c.NeedsRedrawing := true;
  end if;
  SetStatus( AWindowControl( c ), status );
end SetStatus;

procedure SetStatus( c : in out AWindowButton; status : AControlStatus ) is
begin
  if c.status = Off xor status = Off then
     c.NeedsRedrawing := true;
  end if;
  SetStatus( AnIconicControl( c ), status );
end SetStatus;

procedure SetStatus( c : in out ARectangle; status : AControlStatus ) is
begin
  SetStatus( AnIconicControl( c ), status );
end SetStatus;

procedure SetStatus( c : in out ALine'class; status : AControlStatus ) is
begin
  SetStatus( AnIconicControl( c ), status );
end SetStatus;

procedure SetStatus( c : in out AStaticList'class; status : AControlStatus ) is
begin
  SetStatus( AWindowControl( c ), status );
end SetStatus;


---> Encoding Controls as Strings


function Encode( c : in RootControl ) return EncodedString is
  estr : Encodedstring := Null_Unbounded_String;
begin
  NoError;
  Encode( estr, c.frame );
  Encode( estr, integer( AControlStatus'pos( c.Status ) ) );
  -- We'll init CursorX on Decode
  -- We'll init CursorY on Decode
  -- We'll init NeedsRedrawing on Decode
  Encode( estr, c.HotKey );
  Encode( estr, c.HasInfo );
  if c.HasInfo then
     Encode( estr, To_String (C.InfoText));
  end if;
  Encode( estr, c.StickLeft );
  Encode( estr, c.StickTop );
  Encode( estr, c.StickRight );
  Encode( estr, c.StickBottom );
  return estr;
end Encode;

function Encode( c : in AnIconicControl ) return EncodedString is
  estr : EncodedString;
begin
  estr := Encode( RootControl( c ) );
  Encode( estr, To_String (C.Link) );
  Encode( estr, c.CloseBeforeFollow );
  return estr;
end Encode;

function Encode( c : in AWindowControl ) return EncodedString is
begin
  return Encode( RootControl( c ) );
end Encode;

function Encode( c : in AThermometer ) return EncodedString is
  estr : EncodedString;
begin
  estr := Encode( AWindowControl( c ) );
  Encode( estr, c.max );
  Encode( estr, c.value );
  return estr;
end Encode;

function Encode( c : in AScrollBar ) return EncodedString is
  estr : EncodedString;
begin
  estr := Encode( AWindowControl( c ) );
  Encode( estr, c.max );
  Encode( estr, c.thumb );
  return estr;
end Encode;

function Encode( c : in AStaticLine ) return EncodedString is
  estr : EncodedString;
begin
  estr := Encode( AnIconicControl( c ) );
  Encode( estr, To_String (C.Text) );
  Encode( estr, integer( ATextStyle'pos( c.style ) ) );
  Encode( estr, integer( APenColourName'pos( c.colour ) ) ); -- should be RGB
  return estr;
end Encode;

function Encode( c : in AnEditLine ) return EncodedString is
  estr : EncodedString;
begin
  estr := Encode( AWindowControl( c ) );
  Encode( estr, To_String (c.Text) );
  Encode( estr, c.AdvanceMode );
  return estr;
end Encode;

function Encode( c : in AnIntegerEditLine ) return EncodedString is
  estr : EncodedString;
begin
  estr := Encode( AnEditLine( c ) );
  Encode( estr, c.value );
  return estr;
end Encode;

function Encode( c : in ALongIntEditLine ) return EncodedString is
  estr : EncodedString;
begin
  estr := Encode( AnEditLine( c ) );
  Encode( estr, c.value );
  return estr;
end Encode;

--  function Encode( c : in AFloatEditLine ) return EncodedString is
--    estr : EncodedString;
--  begin
--    estr := Encode( AnEditLine( c ) );
--    Error( TT_NotYetWritten ); -- encoding floats not yet written
--    return estr;
--  end Encode;

function Encode( c : in ACheckBox ) return EncodedString is
  estr : EncodedString;
begin
  estr := Encode( AWindowControl( c ) );
  Encode( estr, To_String (C.Text) );
  Encode( estr, c.checked );
  return estr;
end Encode;

function Encode( c : in ARadioButton ) return EncodedString is
  estr : EncodedString;
begin
  estr := Encode( AWindowControl( c ) );
  Encode( estr, To_String (C.Text) );
  Encode( estr, c.checked );
  Encode( estr, c.family );
  return estr;
end Encode;

function Encode( c : in ASimpleButton ) return EncodedString is
  estr : EncodedString;
begin
  estr := Encode( AWindowControl( c ) );
  Encode( estr, To_String (C.Text) );
  Encode( estr, c.instant );
  Encode( estr, integer( APenColourName'pos( c.colour ) ) ); -- should be RGB
  return estr;
end Encode;

function Encode( c : in AWindowButton ) return EncodedString is
  estr : EncodedString;
begin
  estr := Encode( AnIconicControl( c ) );
  Encode( estr, To_String (C.Text) );
  Encode( estr, To_String (c.Link) );
  return estr;
end Encode;

function Encode( c : in ARectangle ) return EncodedString is
  estr : EncodedString;
begin
  estr := Encode( AnIconicControl( c ) );
  Encode( estr, integer( APenColourName'pos( c.FrameColour ) ) );
  Encode( estr, integer( APenColourName'pos( c.BackColour ) ) );
  Encode( estr, To_String (C.Text) );
  return estr;
end Encode;

function Encode( c : in ALine'class ) return EncodedString is
  estr : EncodedString;
begin
  estr := Encode( AnIconicControl( c ) );
  Encode( estr, integer( APenColourName'pos( c.Colour ) ) );
  Encode( estr, c.DownRight );
  return estr;
end Encode;

function Encode( c : in AStaticList'class ) return EncodedString is
  --estr : EncodedString;
begin
  return Encode( AWindowControl( c ) );
end Encode;


  -- Decoding Controls From Strings


procedure Decode( estr : in out EncodedString; c : in out RootControl ) is
  TempInt : integer := integer'last;
begin
  NoError;
  Decode( estr, c.frame );
  Decode( estr, TempInt );
  c.Status := AControlStatus'val( TempInt );
  c.CursorX := 0;
  c.CursorY := 0;
  c.NeedsRedrawing := true;
  Decode( estr, c.HotKey );
  Decode( estr, c.HasInfo );
  if c.HasInfo then
     Decode( estr, c.InfoText );
  end if;
  Decode( estr, c.StickLeft );
  Decode( estr, c.StickTop );
  Decode( estr, c.StickRight );
  Decode( estr, c.StickBottom );
end Decode;

procedure Decode( estr : in out EncodedString; c : in out AnIconicControl ) is
begin
  Decode( estr, RootControl( c ) );
  Decode( estr, c.link );
  Decode( estr, c.CloseBeforeFollow );
end Decode;

procedure Decode( estr : in out EncodedString; c : in out AWindowControl ) is
begin
  Decode( estr, RootControl( c ) );
end Decode;

procedure Decode( estr : in out EncodedString; c : in out AThermometer ) is
begin
  Decode( estr, AWindowControl( c ) );
  Decode( estr, c.max );
  Decode( estr, c.value );
end Decode; -- AThermometer

procedure Decode( estr : in out EncodedString; c : in out AScrollBar ) is
begin
  Decode( estr, AWindowControl( c ) );
  Decode( estr, c.max );
  Decode( estr, c.thumb );
end Decode; -- AScrollBar

procedure Decode( estr : in out EncodedString; c : in out AStaticLine ) is
  tempInt : integer := integer'last;
begin
  Decode( estr, AnIconicControl( c ) );
  Decode( estr, c.text );
  Decode( estr, tempInt );
  c.Style := ATextStyle'val( tempInt );
  Decode( estr, tempInt );
  c.Colour := APenColourName'val( tempInt ); -- really should be RGB
end Decode; -- AStaticLine

procedure Decode( estr : in out EncodedString; c : in out AnEditLine ) is
begin
  Decode( estr, AWindowControl( c ) );
  Decode( estr, c.text );
  Decode( estr, c.AdvanceMode );
end Decode; -- AnEditLine

procedure Decode( estr : in out EncodedString; c : in out AnIntegerEditLine ) is
begin
  Decode( estr, AnEditLine( c ) );
  Decode( estr, c.value );
end Decode; -- AnIntegerEditLine

procedure Decode( estr : in out EncodedString; c : in out ALongIntEditLine ) is
begin
  Decode( estr, AnEditLine( c ) );
  Decode( estr, c.value );
end Decode; -- ALongIntEditLine

--  procedure Decode( estr : in out EncodedString; c : in out AFloatEditLine ) is
--  begin
--    Decode( estr, AnEditLine( c ) );
--    Error( TT_NotYetWritten );
--  end Decode; -- AFloatEditLine

procedure Decode( estr : in out EncodedString; c : in out ACheckBox ) is
begin
  Decode( estr, AWindowControl( c ) );
  c.CursorX := 1;
  Decode( estr, c.text );
  Decode( estr, c.checked );
end Decode; -- ACheckBox

procedure Decode( estr : in out EncodedString; c : in out ARadioButton ) is
begin
  Decode( estr, AWindowControl( c ) );
  c.CursorX := 1;
  Decode( estr, c.text );
  Decode( estr, c.checked );
  Decode( estr, c.family );
end Decode; -- ARadioButton

procedure Decode( estr : in out EncodedString; c : in out ASimpleButton ) is
  tempInt : integer := integer'last;
begin
  Decode( estr, AWindowControl( c ) );
  c.CursorX := 1;
  Decode( estr, c.text );
  Decode( estr, c.instant );
  c.HotPos := GetHotPos( c.HotKey, To_String (C.Text) );
  Decode( estr, tempInt );
  c.Colour := APenColourName'val( tempInt );
end Decode; -- ASimpleButton

procedure Decode( estr : in out EncodedString; c : in out AWindowButton ) is
begin
  Decode( estr, AnIconicControl( c ) );
  c.CursorX := 1;
  Decode( estr, c.text );
  Decode( estr, c.link );
end Decode; -- AWindowButton

procedure Decode( estr : in out EncodedString; c : in out ARectangle ) is
  tempint : integer := integer'last;
begin
  Decode( estr, AnIconicControl( c ) );
  Decode( estr, tempint );
  c.FrameColour := APenColourName'val( tempInt );
  Decode( estr, tempint );
  c.BackColour := APenColourName'val( tempInt );
  Decode( estr, c.text );
end Decode; -- ARectangle

procedure Decode( estr : in out EncodedString; c : in out ALine'class ) is
  tempint : integer := integer'last;
begin
  Decode( estr, AnIconicControl( c ) );
  Decode( estr, tempint );
  c.Colour := APenColourName'val( tempInt );
  Decode( estr, c.DownRight );
end Decode; -- ALine

procedure Decode( estr : in out EncodedString; c : in out AStaticList'class
) is begin
  Decode( estr, AWindowControl( c ) );
end Decode; -- AStaticList, etc.

---> Resizing

procedure Resize( c : in out RootControl; dleft, dtop, dright, dbottom : integer ) is
begin
  NoError;
  c.frame.left := c.frame.left + dleft;
  c.frame.top := c.frame.top + dtop;
  c.frame.right := c.frame.right + dright;
  c.frame.bottom := c.frame.bottom + dbottom;
  Invalid( c );
end Resize;

procedure Resize( c : in out AnIconicControl; dleft, dtop, dright, dbottom : integer ) is
begin
  Resize( RootControl( c ), dleft, dtop, dright, dbottom );
end Resize;

procedure Resize( c : in out AWindowControl; dleft, dtop, dright, dbottom : integer ) is
begin
  Resize( RootControl( c ), dleft, dtop, dright, dbottom );
end Resize;

procedure Resize( c : in out AThermometer; dleft, dtop, dright, dbottom :
integer ) is begin
  Resize( AWindowControl( c ), dleft, dtop, dright, dbottom );
end Resize;

procedure Resize( c : in out AScrollBar; dleft, dtop, dright, dbottom :
integer ) is begin
  Resize( AWindowControl( c ), dleft, dtop, dright, dbottom );
end Resize;

procedure Resize( c : in out AStaticLine; dleft, dtop, dright, dbottom :
integer ) is begin
  Resize( AnIconicControl( c ), dleft, dtop, dright, dbottom );
end Resize;

procedure Resize( c : in out ACheckBox; dleft, dtop, dright, dbottom :
integer ) is begin
  Resize( AWindowControl( c ), dleft, dtop, dright, dbottom );
end Resize;

procedure Resize( c : in out ARadioButton; dleft, dtop, dright, dbottom :
integer ) is begin
  Resize( AWindowControl( c ), dleft, dtop, dright, dbottom );
end Resize;

procedure Resize( c : in out AnEditLine'class; dleft, dtop, dright,
dbottom : integer ) is begin
  Resize( AWindowControl( c ), dleft, dtop, dright, dbottom );
end Resize;

procedure Resize( c : in out ASimpleButton; dleft, dtop, dright, dbottom :
integer ) is begin
  Resize( AWindowControl( c ), dleft, dtop, dright, dbottom );
end Resize;

procedure Resize( c : in out AWindowButton; dleft, dtop, dright, dbottom :
integer ) is begin
  Resize( AnIconicControl( c ), dleft, dtop, dright, dbottom );
end Resize;

procedure Resize( c : in out ARectangle; dleft, dtop, dright, dbottom :
integer ) is begin
  Resize( AnIconicControl( c ), dleft, dtop, dright, dbottom );
end Resize;

procedure Resize( c : in out ALine'class; dleft, dtop, dright, dbottom : integer
) is begin
  Resize( AnIconicControl( c ), dleft, dtop, dright, dbottom );
end Resize;

procedure Resize( c : in out AStaticList'class; dleft, dtop, dright,
dbottom : integer ) is begin
  Resize( AWindowControl( c ), dleft, dtop, dright, dbottom );
end Resize;

end controls;

