libtexttools3-dev 2.0.7-2 / usr / share / ada / adainclude / texttools / controls.adb

------------------------------------------------------------------------------
-- 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 os; use os; -- for SessionLog debug
with Ada.Strings;
with Interfaces.C, GNAT.RegExp;
use Interfaces.C, GNAT.RegExp;
with Ada.unchecked_deallocation;

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
  --
  -- These are defined here for speed.  They are initialized on
  -- package startup, to avoid calling To255 each time AutoSpell runs.

  ProcedureStr : constant str255 := To255( "procedure" );
  FunctionStr  : constant str255 := To255( "function" );
  PackageStr   : constant str255 := To255( "package" );
  ExceptionStr : constant str255 := To255( "exception" );
  TerminateStr : constant str255 := To255( "terminate" );
  SubtypeStr   : constant str255 := To255( "subtype" );
  EndStr       : constant str255 := To255( "end" );
  EndIfStr     : constant str255 := To255( "end if;" );
  EndLoopStr   : constant str255 := To255( "end loop;" );
  EndRecordStr : constant str255 := To255( "end record;" );
  ThenStr      : constant str255 := To255( "then" );
  ElseStr      : constant str255 := To255( "else" );
  LoopStr      : constant str255 := To255( "loop" );

---> Imports
--
-- Required for thermometers (used for Scroll Bar, too)

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

-- For GetEnv - See OS.adb for info about these.

type ACPath is new Interfaces.C.char_array( 1..1024 );
type CPathPtr is access all ACPath;

-- A C string, pointer to same, and a another pointer.

TempCPath     : aliased  ACPath;
TempCPathPtr  : constant CPathPtr := TempCPath'access;
TempCPtr      : CPathPtr;

-- Linux_GetEnv - get an environment variable's value

function Linux_GetEnv( env_var :  CPathPtr ) return CPathPtr;
  pragma Import( C, Linux_GetEnv, "getenv" ); -- from stdlib.h

---> 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;

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

  function in_bin( s : str255 ) return aBinIndex is
    ch  : character;
    bin : aBinIndex;
  begin
    if length( s ) = 0 then
       bin := aBinIndex'first;
    else
       ch := element( s, 1 );
       if ch in 'A'..'Z' then
          bin := ch;
       elsif ch in 'a'..'z' then
          bin := character'val( character'pos( ch ) - 32 );
       else
          bin := aBinIndex'first;
       end if;
    end if;
    return bin;
  end in_bin;

  function in_bin( s : string ) return aBinIndex is
  begin
     return in_bin( to255( s ) );
  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 : string ) return functionDataPtr is
    fp  : functionDataPtr := null;
    s2 : constant string := tostring( ToLower( to255( s ) ) );
  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.functionName.all = s then
               exit;
            end if;
         else
            if fp.functionName.all = s2 then
               exit;
            end if;
         end if;
         fp := fp.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;

  function findFunctionData( languageData : languageDataArray; funcLang : aSourceLanguage; s : str255 ) return functionDataPtr is
  begin
     return findFunctionData( languageData, funcLang, tostring( s ) );
  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;
    s2  : constant string := toString( ToLower( to255( s ) ) );
  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.keywordName.all = s then
               exit;
            end if;
         else
            if kp.keywordName.all = s2 then
               exit;
            end if;
         end if;
         kp := kp.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;

  function findKeywordData( languageData : languageDataArray; funcLang : aSourceLanguage; s : str255 ) return keywordDataPtr is
  begin
     return findKeywordData( languageData, funcLang, toString( s ));
  end findKeywordData;


---> Housekeeping


procedure StartupControls is
-- Initialize this package, set defaults
  TermEmu : Str255;
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
  TempCPath(1) := 'T';
  TempCPath(2) := 'E';
  TempCPath(3) := 'R';
  TempCPath(4) := 'M';
  TempCPath(5) := Interfaces.C.char( ASCII.NUL );
  TempCPtr := Linux_GetEnv( TempCPathPtr );
  IsConsoleEmu := false;
  IsMonoXEmu := false;
  IsColourXEmu := false;
  if TempCPtr /= null then
     TermEmu := To255( To_Ada( TempCPtr.all ) );
     if TermEmu = To255( "linux" ) or TermEmu = To255( "console" ) then
        IsConsoleEmu := true;
        SessionLog( "StartupControls: optimized for linux console emulation" );
     end if;
     if TermEmu = To255( "xterm" ) or TermEmu = To255( "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 if;
  PackageRunning := true;
end StartupControls;

procedure IdleControls( IdlePeriod : ATimeStamp ) 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 := NullStr255;
  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 := NullStr255;
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 := NullStr255;
  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;
  c.Text := To255( "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;
  c.Text := To255( "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;
  c.Text := To255( "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;
  c.Text := To255( "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 := NullStr255;
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 );
  Str255List.Clear( c.List );
  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 );
  BooleanList.Clear( c.Checks );
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 );
  BooleanList.Clear( c.Checks );
  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 );
  Str255List.Clear( c.KeywordList );
  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 := NullStr255;
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
  Str255List.Clear( c.List );
  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
  BooleanList.Clear( c.checks );
  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
  Str255List.Clear( c.KeywordList );
  Finalize( AnEditList( c ) );
end Finalize; -- ASourceEditList

---> Common Calls

function GetHotPos( HotKey : character; thetext : str255 ) return natural is
-- find position in string of the "Hot Key" character, else 0
-- no check for out of bounds
  tempstr : string(1..1);
  HotPos  : natural;
begin
  HotPos := 0;
  if HotKey /= NullKey then
     tempstr(1) := HotKey;
     HotPos := Index( thetext, tempstr );
     if HotPos = 0 then
        if HotKey >= 'a' and HotKey <= 'z' then
           tempstr(1) := character'val( character'pos( HotKey ) - 32 );
        elsif HotKey >= 'A' and HotKey <= 'Z' then
           tempstr(1) := character'val( character'pos( HotKey ) + 32 );
        end if;
        HotPos := Index( thetext, tempstr );
     end if;
  end if;
  return HotPos;
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 : str255 ) is
-- Set info bar text
begin
  NoError;
  c.HasInfo := true;
  c.InfoText := text;
end SetInfo;

function GetInfo( c : in RootControl'class ) return str255 is
-- return info bar text
begin
  NoError;
  return 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 : str255 ) is
-- Set the pathname of the window the iconic control refers to
begin
  c.link := link;
  c.NeedsRedrawing := true;
end SetLink;

function  GetLink( c : in AnIconicControl'class ) return str255 is
-- Return pathname to the window the iconic control refers to
begin
  return 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 : long_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 long_integer is
begin
  NoError;
  return c.max;
end GetMax;

procedure SetValue( c : in out AThermometer; value : long_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 long_integer is
begin
  NoError;
  return c.value;
end GetValue;


---> Scroll Bar Calls

procedure SetMax( c : in out AScrollBar; max : long_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 long_integer is
begin
  NoError;
  return c.max;
end GetMax;

procedure SetThumb( c : in out AScrollBar; thumb : long_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 long_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 : Str255 ) is
begin
  NoError;
  if c.text /= text then
     c.text := text;
     c.NeedsRedrawing := true;
  end if;
end SetText;

procedure SetText( c : in out AStaticLine; text : string ) is
begin
  SetText( c, To255( text ) );
end SetText;

function GetText( c : in AStaticLine ) return Str255 is
begin
  NoError;
  return 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 : Str255 ) is
begin
  NoError;
  if c.text /= text then
     c.text := text;
     c.NeedsRedrawing := true;
     c.cursorX := 0;
  end if;
end SetText;

function GetText( c : in AnEditLine'class ) return Str255 is
begin
  NoError;
  return 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( ToString( c.Text ) );
  exception when others => return 0;
end GetValue;


---> Long Integer Edit Lines

procedure SetValue( c : in out ALongIntEditLine; value : 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( ToString( 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 : Str255 ) is
begin
  NoError;
  if c.text /= text then
     c.NeedsRedrawing := true;
     c.text := text;
     c.HotPos := GetHotPos( c.HotKey, c.text );
  end if;
end SetText;

function GetText( c : in ACheckBox ) return Str255 is
begin
  NoError;
  return 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 : Str255 ) is
begin
  NoError;
  if c.text /= text then
     c.text := text;
     c.HotPos := GetHotPos( c.HotKey, c.text );
     c.NeedsRedrawing := true;
  end if;
end SetText;

function GetText( c : in ARadioButton ) return Str255 is
begin
  NoError;
  return 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 : Str255 ) is
begin
  NoError;
  if c.text /= text then
     c.text := text;
     c.HotPos := GetHotPos( c.HotKey, c.text );
     c.NeedsRedrawing := true;
  end if;
end SetText;

procedure SetText( c : in out ASimpleButton; text : string ) is
  Text255 : constant Str255 := To255( text );
begin
  NoError;
  if c.text /= text255 then
     c.text := text255;
     c.HotPos := GetHotPos( c.HotKey, c.text );
     c.NeedsRedrawing := true;
  end if;
end SetText;

function GetText( c : in ASimpleButton ) return Str255 is
begin
  NoError;
  return 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 : Str255 ) is
begin
  NoError;
  if c.text /= text then
     c.text := text;
     c.HotPos := GetHotPos( c.HotKey, c.text );
     c.NeedsRedrawing := true;
  end if;
end SetText;

function GetText( c : in AWindowButton ) return Str255 is
begin
  NoError;
  return 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: str255 ) is
begin
  NoError;
  c.Text := text;  -- assign new text
  c.NeedsRedrawing := true;
end SetText;

function GetText( c : ARectangle) return str255 is
begin
  NoError;
  return 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 Str255List.List ) is
begin
  NoError;
  Str255List.Copy( FromList => List, ToList => c.List );
  if Str255List.length( c.List ) > 0 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 Str255List.List 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 Str255; overflow: in out Str255; width : 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( text );
    SessionLog( "overflow=" ); SessionLog( 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 : Str255List.AListIndex := 0 ) is
  Overflow : str255;
  Index    : Str255List.AListIndex;
  Text     : Str255;
  CarryCursor : boolean;
  CarryAmount : integer;

  function isParagraphStart( text : str255 ) return boolean is
    -- does the line of text look like the start of a paragraph (blank line or
    -- indented)
  begin
    if length( text ) = 0 then
       return true;
    elsif Element( text, 1 ) = ' ' then
       return true;
    end if;
    return false;
  end isParagraphStart;

begin
  NoError;                                                    -- assume OK
  c.Mark := -1;                                               -- mark invalid
  Index := StartingAt;                                        -- top-most line
  if Index = 0 then                                           -- none?
     Index := 1;                                              -- default line 1
  end if;
  Overflow := NullStr255;                                     -- no overflow yet
  CarryCursor := false;                                       -- no carry fwd

  while Index <= Str255List.Length( c.list ) loop
        Str255List.Find( c.list, index, text );               -- 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( text ) then                     -- new para?
              Str255List.Insert( c.list, index, NullStr255 );   -- push text down
              Text := Overflow;                                 -- ln contents
              --SessionLog( "Ending paragraph: " & ToString( Text ) ); -- DEBUG
           else                                                 -- otherwise
              if length( Overflow ) + length( Text ) < 256 then -- emergency handling
                 Str255List.Insert( c.list, index, Overflow );  -- this is not right!
                 Overflow := NullStr255;
              else
                 Text := Append( Overflow, ToString( Text ) );     -- 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 " & ToString( Text ) ); -- DEBUG
           Str255List.Replace( c.list, index, 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 := NullStr255;
           --SessionLog( ToString( Text) & " fits, exiting" ); -- DEBUG
           Str255List.Replace( c.list, index, text ); -- update list
           c.NeedsRedrawing := true;
           exit;
        else
           Overflow := NullStr255;
           --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 <= Str255List.length( c.list ) then
        Str255List.Replace( c.list, index, text );
     else
        Str255List.Queue( c.list, 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..Str255List.length( c.list ) loop
         Str255List.Find( c.list, 1, text );
         SessionLog( text );
    end loop;
    SessionLog( "index is " & Str255List.AListIndex'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 : Str255List.AListIndex := 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 : Str255List.AListIndex := 0 ) is

  Overflow : str255;
  Index    : Str255List.AListIndex;
  Text     : Str255;
  CarryCursor : boolean;
  CarryAmount : integer;
  insertedFirst : Str255List.AListIndex;
  insertedLast  : Str255List.AListIndex;

begin
  NoError;                                                    -- assume OK
  c.Mark := -1;                                               -- mark invalid
  Index := StartingAt;                                        -- top-most line
  if Index = 0 then                                           -- none?
     Index := 1;                                              -- default line 1
  end if;
  Overflow := NullStr255;                                     -- no overflow yet
  CarryCursor := false;                                       -- no carry fwd

  -- 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.

  insertedFirst := c.insertedFirst;
  insertedLast  := c.insertedFirst + c.insertedLines - 1;
  if startingAt < insertedFirst or startingAt > insertedLast then
     insertedFirst := 0;
     insertedLast := 0;
  end if;

  while Index <= Str255List.Length( c.list ) loop
        Str255List.Find( c.list, index, text );               -- 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?
                 Str255List.Insert( c.list, index, NullStr255 ); -- 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?
                 Text := Append( Overflow, ToString( Text ) );  -- carry fwd
                 -- SessionLog( "Carring forward in insert area: " & ToString( text ) ); -- DEBUG
              end if;
           else                                                 -- not ins area?
              Text := Append( Overflow, ToString( Text ) );     -- 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
           Str255List.Replace( c.list, index, 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 := NullStr255;
           --SessionLog( ToString( Text) & " fits, exiting" ); -- DEBUG
           Str255List.Replace( c.list, index, text ); -- update list
           c.NeedsRedrawing := true;
           exit;
        else
           Overflow := NullStr255;
           --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 <= Str255List.length( c.list ) then
        Str255List.Replace( c.list, index, text );
     else
        Str255List.Queue( c.list, 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..Str255List.length( c.list ) loop
         Str255List.Find( c.list, 1, text );
         SessionLog( text );
    end loop;
    SessionLog( "index is " & Str255List.AListIndex'image( index ) );
    raise;
end JustifyText;


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

procedure WrapText( c : in out AStaticList ) is
  line   : str255List.AListIndex;
  text   : str255;
  overflow : str255;
  width  : integer;
  offset : str255List.AListIndex;
begin
  NoError;
  line := 1;
  width := c.frame.right - c.frame.left + 1;
  while line <= Str255List.Length( c.list ) loop
        Str255List.Find( c.list, line, text );
        if length( text ) > width then
           CropText( text, overflow, width );
        else
           Overflow := nullStr255;
        end if;
        Str255List.Replace( c.list, line, text );
        offset := 1;
        if length( overflow ) > 0 then
           loop
             text := overflow;
           exit when length(text) <= width;
             CropText( text, overflow, width );
             Str255List.Insert( c.list, line+offset, text );
             offset := offset + 1;
           end loop;
           Str255List.Insert( c.list, line+offset, 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 : long_integer ) is
  NewLine        : long_integer;   -- the line being moved to
  TempOrigin     : long_integer;   -- possible new origin
  TempY          : long_integer;   -- possible new cursor position
  VisibleLines   : long_integer;   -- number of lines visible within list frame
  ScrollArea     : long_integer;   -- number of lines in which to trigger scrol
  LastLine       : long_integer;   -- last line in the list (or total # lines)
  LastScrollLine : long_integer;   -- last line that can be scrolled to
  OriginalOrigin : Str255List.AListIndex;
  OffsetY        : long_integer;
  text           : str255;

  -- 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 : long_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 := long_integer( c.frame.bottom - c.frame.top ) - 1;
  ScrollArea   := VisibleLines/4;
  LastLine     := long_integer( Str255List.Length( c.list ) );
  LastScrollLine := LastLine - VisibleLines + 1;
  OriginalOrigin := c.Origin;

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

  if long_integer( c.Origin ) + long_integer( c.CursorY ) + dy <= 1 then
     OffsetY := -( long_integer( c.Origin ) + long_integer( c.CursorY ) ) + 2;
  elsif long_integer( c.Origin ) + long_integer( c.CursorY ) +
     dy - 1 > LastLine then
     OffsetY := LastLine - long_integer( c.Origin ) - long_integer(
       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 := long_integer( c.Origin ) + long_integer( c.CursorY ) + OffsetY - 1;
  TempY   := long_integer( 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 := integer( 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 := integer( NewLine - TempOrigin + 1);
        else                                                    -- constrain
           c.NeedsRedrawing := c.Origin /= 1 or c.NeedsRedrawing;
           c.Origin := 1;
           c.CursorY := integer( 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 := integer( TempY );                          -- No scrolling
     elsif TempY <= VisibleLines - ScrollArea + 1 then          -- Not end
        c.CursorY := integer( 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 := integer( NewLine - TempOrigin + 1 );
        else
           c.NeedsRedrawing := c.Origin /= LastScrollLine or c.NeedsRedrawing;
           c.Origin := LastScrollLine;
           c.CursorY := integer( 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;
   Str255List.Find( c.list, GetCurrent( c ), text );
   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( long_integer'image( dy ) );
    raise;
end MoveCursor;

procedure SetOrigin( c : in out AStaticList'class; origin :
  Str255List.AListIndex ) is
   Height : long_integer;
begin
  NoError;
  if c.origin /= 0 and c.origin /= origin then
     if Str255List.Length( c.list ) > 0 then
        Height := long_integer( c.frame.bottom - c.frame.top );
        if origin <= long_integer( Str255List.Length( c.List ))
                     - (Height-2) then
           c.origin := origin;
        elsif Str255List.length(c.List) <= (Height - 2) then
           c.origin := 1; -- short list? constrain to first line
        else -- beyond last possible origin?  constrain to l.p.o.
           c.origin := Str255List.length( c.List ) - (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
  str255List.AListIndex is
begin
  NoError;
  return c.origin;
end GetOrigin;

function GetCurrent( c : in AStaticList'class ) return Str255List.AListIndex is
begin
  NoError;
  if Str255List.Length( c.List ) = 0 then
     return 0;
  else
     return Str255List.AListIndex( long_integer( c.Origin )
            + long_integer( c.CursorY - 1) );
  end if;
end GetCurrent;

function GetLength( c : in AStaticList'class ) return Str255List.AListIndex is
begin
  NoError;
  return Str255List.Length( c.List );
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 : str255;
  Backwards, IsRegExp : boolean := false ) is
  OldLine, Line : long_integer;
  TempStr : Str255;
  Criteria : RegExp;
begin
  NoError;
  if IsRegExp then
     Criteria := Compile( ToString( str2find ), true, true );
  elsif (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
          Str255List.Find( c.list, i, TempStr );
          if IsRegExp then
             if Match( ToString( TempStr ), Criteria ) then
                 Line := i;
                 exit;
             end if;
          elsif Index( TempStr, ToString( str2find ) ) > 0 then
             Line := i;
             exit;
          end if;
      end loop;
  else
      for i in OldLine+1..Str255List.Length( c.list ) loop
          Str255List.Find( c.list, i, TempStr );
          if IsRegExp then
             if Match( ToString( TempStr ), Criteria ) then
                 Line := i;
                 exit;
             end if;
          elsif Index( TempStr, ToString( str2find ) ) > 0 then
             Line := i;
             exit;
          end if;
      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 : str255; Backwards, IsRegExp : boolean := false ) is
   pragma Unreferenced (Isregexp);
  OldLine, Line : long_integer;
  TempStr : Str255;
  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
          Str255List.Find( c.list, i, TempStr );
          Loc := Index( TempStr, ToString( str2find ) );
          if Loc > 0 then
             Delete( TempStr, Loc, Loc+length( str2find )-1 );
             Insert( TempStr, Loc, ToString( str2repl ) );
             Str255List.Replace( c.list, i, TempStr );
             Line := i;
             exit;
          end if;
      end loop;
  else
      for i in OldLine+1..Str255List.Length( c.list ) loop
          Str255List.Find( c.list, i, TempStr );
          Loc := Index( TempStr, ToString( str2find ) );
          if Loc > 0 then
             Delete( TempStr, Loc, Loc+length( str2find )-1 );
             Insert( TempStr, Loc, ToString( str2repl ) );
             Str255List.Replace( c.list, i, TempStr );
             Line := i;
             exit;
          end if;
      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 : str255 ) is
begin
  NoError;
  if c.FindPhrase /= phrase then
     c.FindPhrase := phrase;
     c.NeedsRedrawing := true;
  end if;
end SetFindPhrase;

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

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

procedure CopyLine( c : in out AStaticList'class; text : in out Str255 ) is
  Current : Str255List.AListIndex;
-- copy line at current position
begin
  NoError;
  Current := GetCurrent( c );
  if Current > 0 then
     Str255List.Find( c.list, Current, text );
  else
     text := NullStr255;
  end if;
end CopyLine;

procedure PasteLine( c : in out AStaticList'class; Text : in Str255 ) is
  Current : Str255List.AListIndex;
-- insert a line into the current position, fix cursor if necessary
begin
  NoError;
  Current := GetCurrent( c );
  if Current > 0 then
     Str255List.Insert( c.list, Current, text );
  else
     Str255List.Push( c.list, text );
     c.origin := 1;
     c.cursorY := 1;
     c.cursorX := length(text) + 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 Str255 ) is
  Current : Str255List.AListIndex;
-- insert a line into the current position, fix cursor if necessary
begin
  NoError;
  Current := GetCurrent( c );
  if Current > 0 then
     Str255List.Replace( c.list, Current, text );
  else
     Str255List.Push( c.list, text );
     c.origin := 1;
     c.cursorY := 1;
     c.cursorX := length(text) + 1;
  end if;
  c.NeedsRedrawing := true;
  MoveCursor( c, 0, 0 );
end ReplaceLine;

procedure CopyLines( c : in out AStaticList'class; mark2 : long_integer;
  Lines : in out Str255List.List ) is
  -- copy lines at between mark and mark2
  StartPoint, EndPoint : Str255List.AListIndex;
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 > Str255List.Length( c.list ) then
        EndPoint := Str255List.Length( c.list );
     end if;
     Str255List.SubList( c.list, StartPoint, EndPoint - StartPoint + 1, Lines);
  else
     Str255List.Clear( Lines );
  end if;
end CopyLines;

procedure PasteLines( c : in out AStaticList'class; Lines : in out
  Str255List.List ) is
  TempStr : Str255;
begin
  NoError;
  if Str255List.Length( c.list ) > 0 then
     for i in 1..Str255List.Length( Lines ) loop
         Str255List.Find( Lines, i, TempStr );
         PasteLine( c, TempStr );
         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.List ) is
begin
  NoError;
  BooleanList.Copy( FromList => Checks, ToList => c.Checks );
  c.NeedsRedrawing := true;
  if BooleanList.IsEmpty( Checks ) then
     c.CursorX := 1;
  else
     c.CursorX := 2;
  end if;
end SetChecks;

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


---> Radio List Calls

procedure SetChecks( c : in out ARadioList ;
        checks : in out BooleanList.List; Default : BooleanList.AListIndex := 1 ) is
begin
  NoError;
  BooleanList.Copy( FromList => Checks, ToList => c.Checks );
  c.NeedsRedrawing := true;
  if BooleanList.IsEmpty( Checks ) then
     c.CursorX := 1;
     c.LastCheck := 0;
  else
     c.CursorX := 2;
     c.LastCheck := default;
     BooleanList.Replace( c.checks, default, true );
  end if;
  SetOrigin( c, Default );
end SetChecks;

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

function GetCheck( c : in ARadioList ) return BooleanList.AListIndex 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 : Str255List.AListIndex ) 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 := integer( long_integer(LengthX) * c.value / c.max + 1);
        -- chars included
     end if;
     -- compute text
     if LengthX > 3 then
        if c.Max > 0 then
           Percent := integer( 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 := integer( long_integer( 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 := integer( long_integer( 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(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 : str255;
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( text, c.frame.right - left + 1, c.AdvanceMode );
     else
        DrawEdit( 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( 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( 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( 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( 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 : Str255List.List;
  Line255  : Str255; -- temporary
  Offset   : integer := 1;
begin
  NoError;
  if c.needsRedrawing then
     SetPenColour( outline );
     FrameRect3D( c.frame );
     SetPenColour( white );
     if Str255List.IsEmpty( c.List ) 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 Str255List.length( c.list ) <
           Str255List.AListIndex( c.frame.bottom-c.frame.top-1 ) then
           FillRect( InsetRect( c.frame, 1, 1 ), black );
        end if;
        Str255List.SubList( c.list, c.origin,
              Str255List.AListIndex( c.frame.bottom - c.frame.top - 1),
              Contents );
        while Str255List.Length( Contents ) > 0 loop
              Str255List.Pull( Contents, Line255 );
              MoveToGlobal( c.frame.left + 1, c.frame.top + offset );
              Draw( Line255, c.frame.right - c.frame.left - 1, true );
              Offset := Offset + 1;
        end loop;
        Str255List.Clear( Contents );
     end if;
  end if;
  Draw( AWindowControl( c ) );
end Draw; -- AStaticList

procedure Draw( c : in out ACheckList ) is
  Contents : Str255List.List;
  Line255  : Str255; -- temporary
  Offset   : integer := 1;
  Selections:BooleanList.List;
  IsSelected : boolean := false;
begin
  NoError;
  if c.needsRedrawing then
     SetPenColour( outline );
     FrameRect3D( c.frame );
     SetPenColour( white );
     if Str255List.IsEmpty( c.List ) 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 Str255List.length( c.list ) <
           Str255List.AListIndex( c.frame.bottom-c.frame.top-1 ) then
           FillRect( InsetRect( c.frame, 1, 1 ), black );
        end if;
        Str255List.SubList( c.list, c.origin,
              Str255List.AListIndex( c.frame.bottom - c.frame.top - 1),
              Contents );
        BooleanList.SubList(c.checks, c.origin,
              BooleanList.AListIndex( c.frame.bottom - c.frame.top -1),
              Selections );
        while Str255List.Length( Contents ) > 0 loop
              Str255List.Pull( Contents, Line255 );
              MoveToGlobal( c.frame.left + 1, c.frame.top + offset );
              if BooleanList.Length( Selections ) > 0 then
                 BooleanList.Pull( Selections, IsSelected );
                 if DisplayInfo.C_Res > 0 then
                    SetTextStyle( normal );
                    SetPenColour( white );
                 end if;
                 if IsSelected then
                    Draw("[#] ");
                    SetTextStyle( bold );
                    if DisplayInfo.C_Res > 0 then
                       SetPenColour( yellow );
                    end if;
                 else
                    Draw("[ ] ");
                 end if;
              else
                  Draw("[-] ");
              end if;
              Draw( Line255, c.frame.right - c.frame.left - 5, true );
              Offset := Offset + 1;
        end loop;
        Str255List.Clear( Contents );
        BooleanList.Clear( Selections );
     end if;
  end if;
  Draw( AWindowControl( c ) );
end Draw; -- ACheckList

procedure Draw( c : in out ARadioList ) is
  Contents : Str255List.List;
  Line255  : Str255; -- temporary
  Offset   : integer := 1;
  Selections:BooleanList.List;
  IsSelected : boolean := false;
begin
  NoError;
  if c.needsRedrawing then
     SetPenColour( outline );
     FrameRect3D( c.frame );
     SetPenColour( white );
     if Str255List.IsEmpty( c.List ) 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 Str255List.length( c.list ) <
           Str255List.AListIndex( c.frame.bottom-c.frame.top-1 ) then
           FillRect( InsetRect( c.frame, 1, 1 ), black );
        end if;
        Str255List.SubList( c.list, c.origin,
              Str255List.AListIndex( c.frame.bottom - c.frame.top - 1),
              Contents );
        BooleanList.SubList(c.checks, c.origin,
              BooleanList.AListIndex( c.frame.bottom - c.frame.top -1),
              Selections );
        while Str255List.Length( Contents ) > 0 loop
              Str255List.Pull( Contents, Line255 );
              MoveToGlobal( c.frame.left + 1, c.frame.top + offset );
              if BooleanList.Length( Selections ) > 0 then
                 BooleanList.Pull( Selections, IsSelected );
                 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( Line255, c.frame.right - c.frame.left - 5, true );
              Offset := Offset + 1;
       end loop;
       Str255List.Clear( Contents );
       BooleanList.Clear( Selections );
     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 : Str255List.List;
  Line255  : Str255; -- temporary
  Offset   : integer := 1;
  Line     : long_integer;
  MarkedLine : long_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 := long_integer( c.origin ) + long_integer( c.CursorY ) - 1;
        Str255List.Find( c.list, line, Line255 );
        MoveToGlobal( c.frame.left+1, c.frame.top + c.CursorY );
        if line = MarkedLine then
           SetTextStyle( Emphasis );
        end if;
        Draw( Line255, c.frame.right - c.frame.left - 1, true );
        if line = MarkedLine then
           SetTextStyle( Normal );
        end if;
     else
        SetPenColour( outline );
        FrameRect3D( c.frame );
        SetPenColour( white );
        if Str255List.IsEmpty( c.List ) then
           FillRect( InsetRect( c.frame, 1, 1 ), black );
        else
           Str255List.SubList( c.list, c.origin,
              Str255List.AListIndex( c.frame.bottom - c.frame.top - 1),
              Contents );
           if Str255List.Length( Contents ) <
              Str255List.AListIndex( c.frame.bottom - c.frame.top - 1 ) then
              FillRect( InsetRect( c.frame, 1, 1 ), black );
           end if;
           for i in 1..Str255List.Length( Contents ) loop
              Str255List.Pull( Contents, Line255 );
              MoveToGlobal( c.frame.left + 1, c.frame.top + offset );
              if i = MarkedLine then
                 SetTextStyle( Emphasis );
                 Draw( Line255, c.frame.right - c.frame.left - 1, true );
                 SetTextStyle( Normal );
              else
                 Draw( Line255, c.frame.right - c.frame.left - 1, true );
              end if;
              Offset := Offset + 1;
           end loop;
           Str255List.Clear( Contents );
        end if;
     end if;
  end if;
  c.DirtyLine := false;
  Draw( AWindowControl( c ) );
end Draw; -- AnEditList

procedure Draw( c : in out ASourceEditList ) is
  Contents : Str255List.List;
  Line255  : Str255; -- temporary
  Offset   : integer := 1;
  Line     : long_integer;
  MarkedLine : long_integer;

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

  ProcedureWord : constant str255 := To255( "procedure" );
  FunctionWord  : constant str255 := To255( "function" );
  PackageWord   : constant str255 := To255( "package" );
  TaskWord      : constant str255 := To255( "task" );
  BodyWord      : constant str255 := To255( "body" );
  SubWord       : constant str255 := To255( "sub" );

  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( c.FindPhrase );
                 SetTextStyle( normal );
              end if;
           end if;
        end if;
    end loop;
  end HilightFindPhrase;

  procedure HilightKeyword( basex, basey, offset : integer;
                            word : string ) is
    word255 : str255;
    kp : keywordDataPtr;
    fp : functionDataPtr;
    Found : boolean := false;
  begin
    word255 := ToLower( To255( word ) );

    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..Str255List.Length( C.KeywordList ) loop
    --    Str255List.Find( c.KeywordList, i, word2test );
    --    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 := word = BodyWord; -- if body, still may be coming
   elsif c.SourceLanguage = Ada_Language or c.SourceLanguage = BUSH then
       if word255 = ProcedureWord or
          word255 = FunctionWord or
          word255 = PackageWord or
          word255 = TaskWord then
          TreatAsTitle := true;
       end if;
   elsif c.SourceLanguage = Perl then
       if word255 = FunctionWord or
          word255 = SubWord then
          TreatAsTitle := true;
       end if;
   elsif c.SourceLanguage = Shell or c.SourceLanguage = PHP then
       if word255 = FunctionWord 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;
    Line255 := 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( 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( 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( c.SourceLanguage ).CommentStyle = ShellStyle then
               if ch = '#' then
                  exit; -- the rest is Shell-style comment
               end if;
           elsif c.LanguageData( c.SourceLanguage ).CommentStyle = HTMLStyle then
               null;
           elsif c.LanguageData( 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( 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( c.SourceLanguage ).CommentStyle /= AdaStyle then
              if ch = ''' and not InStr then -- toggle singe quote literal
                 InStr2 := not InStr2;
              end if;
              if c.LanguageData( 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 := long_integer( c.origin ) + long_integer( c.CursorY ) - 1;
        Str255List.Find( c.list, line, Line255 );
        MoveToGlobal( c.frame.left+1, c.frame.top + c.CursorY );
        if line = MarkedLine then
           SetTextStyle( Emphasis );
        end if;
        Draw( 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 Str255List.IsEmpty( c.List ) then
           FillRect( InsetRect( c.frame, 1, 1 ), black );
        else
           Str255List.SubList( c.list, c.origin,
              Str255List.AListIndex( c.frame.bottom - c.frame.top - 1),
              Contents );
           if Str255List.Length( Contents ) <
              Str255List.AListIndex( c.frame.bottom - c.frame.top - 1 ) then
              FillRect( InsetRect( c.frame, 1, 1 ), black );
           end if;
           for i in 1..Str255List.Length( Contents ) loop
              Str255List.Pull( Contents, Line255 );
              MoveToGlobal( c.frame.left + 1, c.frame.top + offset );
              if i = MarkedLine then
                 SetTextStyle( Emphasis );
                 Draw( Line255, c.frame.right - c.frame.left - 1, true );
                 SetTextStyle( normal );
              else
                 Draw( 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;
           Str255List.Clear( Contents );
        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 : long_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 : long_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
    s : string(1..1);
  begin
    s(1) := k;
    if length( c.text ) < c.MaxLength then
       Insert( c.text, c.CursorX+1, s, Ada.Strings.Right );
       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 := NullStr255;
     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;
        if i.key = ' ' then
           c.checked := not c.checked;
           c.NeedsRedrawing := true;
           d := None;
        elsif i.key = RightKey then
           d := right;
        elsif i.key = LeftKey then
           d := left;
        elsif i.key = UpKey then
           d := up;
        elsif i.key = DownKey then
           d := down;
        elsif i.key = ReturnKey then
           d := Next;
        end if;
     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;
        if i.key = ' ' then
           c.checked := true;
           c.NeedsRedrawing := true;
           d := FixFamily;
        elsif i.key = RightKey then
           d := right;
        elsif i.key = LeftKey then
           d := left;
        elsif i.key = UpKey then
           d := up;
        elsif i.key = DownKey then
           d := down;
        elsif i.key = ReturnKey then
           d := Next;
        end if;
     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( 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( c.text );
          RevealNow;
          WaitFor( 6 );
          MoveToGlobal( c.frame.left+4, c.frame.top );
          SetTextStyle( Normal );
          Draw( 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 : long_integer;
  LastLine : long_integer;          -- last legal origin
  Height   : long_integer;          -- height of control
  NewOrigin: Str255List.AListIndex;

begin
  NoError;
  if c.Status = On and Str255List.Length( c.List ) > 0 then
    if i.InputType = ButtonUpInput then
       Distance := long_integer( (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 := long_integer( c.frame.bottom - c.frame.top );
     LastLine := long_integer( Str255List.Length(c.List) ) - (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 long_integer(c.Origin) + Height - 2 > LastLine then
             NewOrigin := LastLine;
          else
             NewOrigin := c.Origin + Str255List.AListIndex( Height - 2 );
          end if;
          if NewOrigin /= c.Origin then
             c.Origin := NewOrigin;
             c.NeedsRedrawing := true;
          end if;
     when PageUpKey =>
          if long_integer(c.Origin) - (Height - 2) < 1 then
             NewOrigin := 1;
          else
             NewOrigin := c.Origin - Str255List.AListIndex( 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 : long_integer;
  line : long_integer;
  b    : boolean := false;
begin
  NoError;
  if c.Status = On and Str255List.Length( c.List ) > 0 then
    if i.InputType = ButtonUpInput then
       Distance := long_integer( (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 BooleanList.IsEmpty( c.Checks ) then
          Line := GetCurrent( c );
          if BooleanList.Length( c.Checks ) >= Line then
             BooleanList.Find( c.Checks, Line, b );
             BooleanList.Replace( c.Checks, Line, not b );
             c.NeedsRedrawing := true;
          end if;
       end if;
    elsif i.InputType = KeyInput then
       if i.Key = ReturnKey or else i.Key = ' ' then
          if not BooleanList.IsEmpty( c.Checks ) then
             Line := GetCurrent( c );
             if BooleanList.Length( c.Checks ) >= Line then
                BooleanList.Find( c.Checks, Line, b );
                BooleanList.Replace( c.Checks, Line, not b );
                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 : long_integer;
  line : long_integer;
begin
  NoError;
  if c.Status = On and Str255List.Length( c.List ) > 0 then
    if i.InputType = ButtonUpInput then
       Distance := long_integer( (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 BooleanList.IsEmpty( c.Checks ) then
          Line := GetCurrent( c );
          if BooleanList.Length( c.Checks ) >= Line then
             if c.LastCheck /= 0 then
                BooleanList.Replace( c.Checks, c.LastCheck, false );
             end if;
             BooleanList.Replace( c.Checks, 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 BooleanList.IsEmpty( c.Checks ) then
             Line := GetCurrent( c );
             if BooleanList.Length( c.Checks ) >= Line then
                if c.LastCheck /= 0 then
                   BooleanList.Replace( c.Checks, c.LastCheck, false );
                end if;
                BooleanList.Replace( c.Checks, 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 : long_integer;
  line : long_integer; -- line # of text in list
  k    : character; -- the key typed
  text : str255;       -- the text

  procedure AdjustCursorForEOL is
  -- note! uses line and text
  begin
    Line := long_integer( c.origin ) + long_integer( c.CursorY - 1);
    Str255List.Find( c.list, line, text );
    if c.CursorX > length( text ) + 1 then
       c.CursorX := length( text ) + 1;
    end if;
  end AdjustCursorForEOL;

  procedure Add is
    s : string(1..1);
  begin
    s(1) := k;
    Insert( text, c.CursorX, s, Ada.Strings.Right );
    if length( text ) >= c.frame.right - c.frame.left then
       Str255List.Replace( c.list, line, text );
       JustifyText( c, c.frame.right - c.frame.left - 1, line );
       c.NeedsRedrawing := true;
    else
       Str255List.Replace( c.list, line, text );
       c.DirtyLine := true;
    end if;
    c.CursorX := c.CursorX + 1;
  end Add;

  procedure Del is

    function isParagraphStart( text : str255 ) return boolean is
      -- does the line of text look like the start of a paragraph (blank line or
      -- indented)
    begin
      if length( text ) = 0 then
         return true;
      elsif Element( text, 1 ) = ' ' then
         return true;
      end if;
      return false;
    end isParagraphStart;

    PrevText : str255;
    NextText : str255;

  begin
    if c.CursorX > 1 then
       c.CursorX := C.CursorX - 1;
       Delete( text, c.CursorX , c.CursorX  );
       Str255List.Replace( c.list, line, text );
       if Str255List.Length( c.list ) > 0 then
          Str255List.Find( c.list, line+1, NextText );
          if not isParagraphStart( NextText ) then
             Append( Text, ToString( NextText ) );
             Str255List.Replace( c.list, line, Text );     -- combine lines
             Str255List.Clear( c.list, line + 1 );         -- discard previous
             JustifyText( c, c.frame.right - c.frame.left - 1, line );
             c.NeedsRedrawing := true;
          else
             c.DirtyLine := true;
          end if;
       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 > Str255List.Length( c.list ) -
             Str255List.AListIndex( 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;
       Str255List.Find( c.list, line, PrevText );
       if length( Text ) > 0 then
          c.CursorX := length( PrevText );
       else
          c.CursorX := length( PrevText ) + 1;
       end if;
       Append( PrevText, ToString( Text ) );
       Str255List.Replace( c.list, line, PrevText ); -- combine lines
       Str255List.Clear( c.list, 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 : Str255List.AListIndex ) is
    begin
      Str255List.Clear( c.list, line );
      if Str255List.length( c.list ) = 0 then
         c.CursorX := 1;
         c.CursorY := 1;
      elsif line > Str255List.length( c.list ) 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 < Str255List.Length( c.list ) then
          c.CursorX := 1;
          MoveCursor( c, 0, +1 );
       end if;
    end if;
  end Right;

  procedure DoReturn is
    NewText : str255;
  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 ) );
       Str255List.Replace( c.list, line, Text );
    else
       NewText := NullStr255;
    end if;
    if line < Str255List.Length( c.list ) then
       Str255List.Insert( c.list, line+1, NewText );
    else
       Str255List.Queue( c.list, 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
    s       : string(1..1);
    NewLine : str255;
  begin
    s(1) := i.key;
    NewLine := To255( s );
    Str255List.Queue( c.list, NewLine );
    c.CursorX := 2;
    c.Origin := 1;
    c.CursorY := 1;
    c.needsRedrawing := true;
  end StartNewList;

  procedure StartBlankList is
  begin
    Str255List.Queue( c.list, NullStr255 );
    Str255List.Queue( c.list, NullStr255 );
    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 Str255List.Length( c.List ) > 0 then
       DistanceY := long_integer( (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 Str255List.Length( c.List ) > 0 then
          k := i.key;
          line := GetCurrent( c );
          --line := long_integer( c.origin ) + long_integer( c.CursorY - 1 );
          Str255List.Find( c.list, line, text );
          -- 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 : long_integer;
  line : long_integer; -- line # of text in list
  k    : character; -- the key typed
  text : str255;       -- the text

  procedure AdjustCursorForEOL is
  -- note! uses line and text
  begin
    Line := long_integer( c.origin ) + long_integer( c.CursorY - 1);
    Str255List.Find( c.list, line, text );
    if c.CursorX > length( text ) + 1 then
       c.CursorX := length( text ) + 1;
    end if;
  end AdjustCursorForEOL;

  procedure Add is
    s : string(1..1);
  begin
    -- Starting to insert new typing?  Start a new insert area.
    if c.InsertedLines = 0 then                                   -- starting?
       c.InsertedFirst := long_integer(c.origin) + long_integer(c.CursorY - 1);
       c.InsertedLines := 1;                                      -- this line
    end if;
    s(1) := k;                                                    -- to string
    Insert( text, c.CursorX, s, Ada.Strings.Right );              -- add char
    if length( text ) >= c.frame.right - c.frame.left then        -- too big?
       Str255List.Replace( c.list, line, text );                  -- update ln
       JustifyText( c, c.frame.right - c.frame.left - 1, line );  -- justify
       c.NeedsRedrawing := true;                                  -- redraw it
    else                                                          -- fits?
       Str255List.Replace( c.list, line, text );                  -- update ln
       c.DirtyLine := true;                                       -- redraw ln
    end if;
    c.CursorX := c.CursorX + 1;                                   -- advance
  end Add;

  procedure Del is
    PrevText : str255;
  begin
    if c.CursorX > 1 then
       c.CursorX := C.CursorX - 1;
       Delete( text, c.CursorX , c.CursorX  );
       Str255List.Replace( c.list, line, 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 > Str255List.Length( c.list ) -
             Str255List.AListIndex( 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;
       Str255List.Find( c.list, line, PrevText );
       if length( Text ) > 0 then
          c.CursorX := length( PrevText );
       else
          c.CursorX := length( PrevText ) + 1;
       end if;
       Append( PrevText, ToString( Text ) );
       Str255List.Replace( c.list, line, PrevText ); -- combine lines
       Str255List.Clear( c.list, 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 : Str255List.AListIndex ) is
    begin
      Str255List.Clear( c.list, line );
      if Str255List.length( c.list ) = 0 then
         c.CursorX := 1;
         c.CursorY := 1;
      elsif line > Str255List.length( c.list ) 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 < Str255List.Length( c.list ) 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
    space     : string( 1..1 );
    LineAbove : Str255;
    SpacePos  : integer;
  begin
    space(1) := ' ';
    -- DoReturn makes a new line, so we need to reload "text"
    line := GetCurrent( c );
    Str255List.Find( c.list, line, text );
    if line > 1 then  -- if current line is not the first (never =1?)
       Str255List.Find( c.list, line-1, LineAbove );
       if Length( LineAbove ) > 0 then -- previous line not blank
          SpacePos := 1;
          while Element( LineAbove, SpacePos ) = ' ' loop
             Insert( Text, c.CursorX, space, Ada.Strings.Right );
             SpacePos := SpacePos + 1;
             exit when SpacePos > Length( LineAbove ); -- all spaces?
          end loop;
          Str255List.Replace( c.list, line, Text );
          MoveCursor( c, SpacePos-1, 0 ); -- move to end of spaces
       end if;
    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 : Str255;
      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 := To255( Slice( Text, FirstPos, LastPos ) );
      if Word = EndStr 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 := To255( Slice( Text, FirstPos, LastPos ) );
      end if;

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

      Changed := false;
      if TypoOf( Word, ProcedureStr ) then
         Delete( Text, FirstPos, LastPos );
         Insert( Text, FirstPos, ToString( ProcedureStr ),
                 Ada.Strings.Right );
         Changed := true;
      elsif TypoOf( Word, FunctionStr ) then
         Delete( Text, FirstPos, LastPos );
         Insert( Text, FirstPos, ToString( FunctionStr ),
                 Ada.Strings.Right );
         Changed := true;
      elsif TypoOf( Word, PackageStr ) then
         Delete( Text, FirstPos, LastPos );
         Insert( Text, FirstPos, ToString( PackageStr ),
                 Ada.Strings.Right );
         Changed := true;
      elsif TypoOf( Word, ExceptionStr ) then
         Delete( Text, FirstPos, LastPos );
         Insert( Text, FirstPos, ToString( ExceptionStr ),
                 Ada.Strings.Right );
         Changed := true;
      elsif TypoOf( Word, TerminateStr ) then
         Delete( Text, FirstPos, LastPos );
         Insert( Text, FirstPos, ToString( TerminateStr ),
                 Ada.Strings.Right );
         Changed := true;
      elsif TypoOf( Word, SubtypeStr ) then
         Delete( Text, FirstPos, LastPos );
         Insert( Text, FirstPos, ToString( SubtypeStr ),
                 Ada.Strings.Right );
         Changed := true;
      elsif TypoOf( Word, EndIfStr ) then
         Delete( Text, FirstPos, LastPos );
         Insert( Text, FirstPos, ToString( EndIfStr ),
                 Ada.Strings.Right );
         Changed := true;
      elsif TypoOf( Word, EndLoopStr ) then
         Delete( Text, FirstPos, LastPos );
         Insert( Text, FirstPos, ToString( EndLoopStr ),
                 Ada.Strings.Right );
         Changed := true;
      elsif TypoOf( Word, EndRecordStr ) then
         Delete( Text, FirstPos, LastPos );
         Insert( Text, FirstPos, ToString( EndRecordStr ),
                 Ada.Strings.Right );
         Changed := true;
      elsif TypoOf( Word, ElseStr ) then
         Delete( Text, FirstPos, LastPos );
         Insert( Text, FirstPos, ToString( ElseStr ),
                 Ada.Strings.Right );
         Changed := true;
      end if;
      if Changed then
         Str255List.Replace( c.list, line, Text );
         SessionLog( "AutoSpell: " & 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 := To255( Slice( Text, FirstPos, LastPos ) );
            if TypoOf( Word, ThenStr ) then
               Delete( Text, FirstPos, LastPos );
               Insert( Text, FirstPos, ToString( ThenStr ),
                 Ada.Strings.Right );
               Changed := true;
            elsif TypoOf( Word, LoopStr ) then
               Delete( Text, FirstPos, LastPos );
               Insert( Text, FirstPos, ToString( LoopStr ),
                 Ada.Strings.Right );
               Changed := true;
            end if;
            if Changed then
               Str255List.Replace( c.list, line, Text );
               SessionLog( "AutoSpell: " & 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 : str255;

  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 := long_integer(c.origin) + long_integer(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 ) );
       Str255List.Replace( c.list, line, Text );
    else
       NewText := NullStr255;
    end if;
    if line < Str255List.Length( c.list ) then
       Str255List.Insert( c.list, line+1, NewText );
    else
       Str255List.Queue( c.list, 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
    s       : string(1..1);
    NewLine : str255;
  begin
    s(1) := i.key;
    NewLine := To255( s );
    Str255List.Queue( c.list, NewLine );
    c.CursorX := 2;
    c.Origin := 1;
    c.CursorY := 1;
    c.insertedLines := 0;
    c.needsRedrawing := true;
  end StartNewList;

  procedure StartBlankList is
  begin
    Str255List.Queue( c.list, NullStr255 );
    Str255List.Queue( c.list, NullStr255 );
    c.CursorX := 1;
    c.Origin := 1;
    c.CursorY := 2;
    c.insertedLines := 0;
    c.needsRedrawing := true;
  end StartBlankList;

begin
  NoError;
  if i.InputType = ButtonUpInput and Str255List.Length( c.List ) > 0 then
       DistanceY := long_integer( (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 Str255List.Length( c.List ) > 0 then
          k := i.key;
          line := GetCurrent( c );
          --line := long_integer( c.origin ) + long_integer( c.CursorY - 1 );
          Str255List.Find( c.list, line, text );
          -- 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 : str255;
begin
  NoError;
  estr := NullStr255;
  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, 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, 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, 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, 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, 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, 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, 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, c.text );
  Encode( estr, 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, 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, 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;