libtexttools5-dev 2.1.0-8 / usr / share / ada / adainclude / texttools / controls.ads

------------------------------------------------------------------------------
-- 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 common; use common;
  pragma Elaborate( common ); -- remind Ada that Common elaborates first
with strings; use strings;
with userio;  use userio;
with Ada.Finalization;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;

package controls is

-- For Source Edit Lists

type aSourceLanguage is ( unknownLanguage, Ada_Language, C, CPP, Java, Bush,
    Perl, PHP, HTML, Shell );
pragma convention(C, aSourceLanguage);

--  LANGUAGE DATA
--
-- This record contains all the information for a language, such as lists
-- of keywords and functions as used by TIA.
--
-- The data is stored in linked lists sorted by language and alphabetic bins
--
-- Some of the data is compressed to save memory.
------------------------------------------------------------------------------

type stringPtr is access all string;

type packedStringPtr is access all packed_string;

type ACommentStyle is (None, AdaStyle, ShellStyle, CStyle, HTMLStyle, PHPStyle);
pragma convention( C, ACommentStyle );

subtype aBinIndex is character range '@'..'Z';

type functionData;
type functionDataPtr is access functionData;
type functionData is record
     functionName : stringPtr;
     functionInfo : packedStringPtr;
     functionProto: packedstringPtr;
     next         : functionDataPtr;
end record;
type functionArray is array( aBinIndex'range ) of functionDataptr;

type keywordData;
type keywordDataPtr is access keywordData;
type keywordData is record
     keywordName  : stringPtr;
     keywordInfo  : packedStringPtr;
     keywordProto : packedstringPtr;
       next         : keywordDataPtr;
end record;
type keywordArray is array( aBinIndex'range ) of keywordDataptr;

type languageDataRecord is record
     caseSensitive : boolean := false;
     commentStyle  : aCommentStyle;
     functionCount : natural := 0;
     functionBin   : functionArray;
     keywordCount  : natural := 0;
     keywordBin    : keywordArray;
end record;

type languageDataArray is array( aSourcelanguage'range ) of
     languageDataRecord;
type languageDataPtr is access all languageDataArray;

procedure init( languageData : in out languageDataArray );
function in_bin( s : string ) return aBinIndex;
function findFunctionData( languageData : languageDataArray; funcLang : aSourceLanguage; s : string ) return functionDataPtr;
function findKeywordData( languageData : languageDataArray; funcLang : aSourceLanguage; s : string ) return keywordDataPtr;

---> Housekeeping

procedure StartupControls;
procedure IdleControls( IdlePeriod : in Duration );
procedure ShutdownControls;

---> Window Control Definitions
--
-- A control is an object in a window that performs input/output.
-- RootControl is the elementary pseudo-control.  All controls
-- inherit a frame, internal cursor location, a hot key, and a status.
-- There is also a NeedsRedrawing flag which indicates if the control
-- dirty.
--
-- Controls must support the following subprograms:
-- 1. a Hear procedure which handles input and determines how
--    the dialog manager should respond (go to next control, etc.).
-- 2. a Draw procedure to draw the control.  (Draw should take into
--    account the NeedsRedrawing flag, need not save colour/styles.)
-- 3. an Init procedure to setup the frame, hot key (if any) and to
--    initialize any defaults. (the constructor)
-- 4. Encode/Decode to save control info to a file.
-- 5. SetStatus for activating the control, etc.
-- 6. a Clear procedure to shutdown the control (and deallocate any
--    memory). (the destructor)
--
-- All controls inherit:
-- 1. an Invalid procedure to force a control to be redrawn (usually
--    when obscured by an overlapping window).
-- 2. GetStatus to return the control's status.
-- 3. a NeedsRedrawing function to reutnr the NeedsRedrawing flag.
-- 4. Free, the unchecked deallocation procedure.
-- ...and a few others.  See RootControl below.
--
-- Dialog Actions:
--   None - Remain on this control
--   Next - Go to next control
--   Back - Go to control before this one
--   ScanNext - Forward to next control with key as hotkey
--          (the usual result for a key with no meaning for control)
--   Up    - move up to next control
--   Down  - move down to next control
--   Left  - move left to next control
--   Right - move right to next control
--   Complete - this control completes a dialog (simple buttons)
--   FollowLink - follow the link; open a new subwindow
--   Fix Family - turn off/redraw the radio button's family members

type ADialogAction is (None, Next, Back, ScanNext, Up, Down, Left, Right,
     Complete, FollowLink, FixFamily);
pragma convention( C, ADialogAction );

-- Control Status:
--   Off       - control will never be selected
--   Standby   - control not currently selected
--   On        - control selected and is accepting input

type AControlStatus is (Off, Standby, On);

---> Control Numbers
--
-- Maximum number of controls is AControlNumber'Last; 0 = no control #

type AControlNumber is new short_integer range 0..63;

---> Control Definitions
--
-- RootControl, the elementary pseudo-control
--
-- GetHotKey - return hot key for this control (or NullKey)
-- SetInfo - set info bar text for this control
-- GetInfo - return same
-- HasInfo - true if info bar text was assigned

type RootControl is abstract tagged private;
type AControlPtr is access all RootControl'class;

procedure Init( c : in out RootControl; left,top,right,bottom : integer;
          HotKey : character );
procedure Finalize( c : in out RootControl );
procedure Hear( c : in out RootControl; i : AnInputRecord; d : in out
          ADialogAction );
procedure Move( c : in out RootControl'class; dx, dy : integer );
procedure Resize( c : in out RootControl; dleft, dtop, dright, dbottom : integer);
procedure Draw( c : in out RootControl );
procedure SetStatus( c : in out RootControl; status : AControlStatus);
function  GetStatus( c : in RootControl'class ) return AControlStatus;
function  Encode( c : in RootControl ) return EncodedString;
procedure Decode( estr : in out EncodedString; c : in out RootControl );

procedure Invalid( c : in out RootControl'class );
function  NeedsRedrawing( c : RootControl'class ) return boolean;
          pragma Inline( NeedsRedrawing );
function  GetHotKey( c : in RootControl'class ) return character;
          pragma Inline( GetHotKey );
procedure SetInfo( c : in out RootControl'class; text : in string );
function  GetInfo( c : in RootControl'class ) return String;
function  HasInfo( c : in RootControl'class ) return boolean;
procedure GetStickyness( c : in RootControl'class; left, top, right, bottom
  : in out boolean );
procedure SetStickyness( c : in out RootControl'class; left, top, right, bottom
  : boolean );
function  InControl( c : in RootControl'class; x, y : integer ) return boolean;
function  GetFrame( c : in RootControl'class ) return ARect;
procedure Scrollable( c : in out RootControl'class; b : boolean );
function  CanScroll( c : in RootControl'class ) return boolean;
procedure Free( cp : in out AControlPtr );

---> General Classes
--
-- All controls fall into one of two classes:
--
-- Iconic Controls: controls that represent information or another
--                  (auto) window (if a link is provided)
--                  (eg. a picture, a static line)
--
-- Gnat 2.03 bug: Compiler overlaps link with first variable in
-- derived class, so links don't work!
--
-- Window Controls: controls that change the environment of the current
--                  window; controls whose value can be edited/changed
--                  (eg. a checkbox, an edit list )
--

Type ANullControl is new RootControl with private;

type AnIconicControl is new RootControl with private;
type AnIconicControlPtr is access all AnIconicControl'class;

procedure Init( c : in out AnIconicControl; left, top,
  right, bottom : integer; HotKey : character );
procedure Finalize( c : in out AnIconicControl );
procedure Draw( c : in out AnIconicControl );
-- Hear is inherited.
procedure SetStatus( c : in out AnIconicControl; status : AControlStatus );
procedure Resize( c : in out AnIconicControl; dleft, dtop, dright,
  dbottom : integer );
function Encode( c : in AnIconicControl ) return EncodedString;
procedure Decode( estr : in out EncodedString; c : in out AnIconicControl );

procedure SetLink( c : in out AnIconicControl'class; link : in String );
function  GetLink( c : in AnIconicControl'class ) return String;
procedure SetCloseBeforeFollow( c : in out AnIconicControl'class;
   close : boolean := true );
function  GetCloseBeforeFollow( c : in AnIconicControl'class ) return boolean;

type AWindowControl is new RootControl with private;
type AWindowControlPtr is access all AWindowControl'class;

procedure Init( c : in out AWindowControl; left, top,
  right, bottom : integer; HotKey : character );
procedure Finalize( c : in out AWindowControl );
procedure Draw( c : in out AWindowControl );
-- Hear is inherited.
procedure SetStatus( c : in out AWindowControl; status : AControlStatus );
procedure Resize( c : in out AWindowControl; dleft, dtop, dright, dbottom
   : integer );
function Encode( c : in AWindowControl ) return EncodedString;
procedure Decode( estr : in out EncodedString; c : in out AWindowControl );

---> Thermometers
--
-- SetMax - indicated the value associated with 100%
-- GetMax - return same
-- SetValue - set the thermometer value (0..Max)
-- GetValue - return same

type AThermometer is new AWindowControl with private;

procedure Init( c : in out AThermometer; left,top,right,bottom : integer;
                HotKey : character := NullKey );
procedure Finalize( c : in out AThermometer );
procedure Hear( c : in out AThermometer; i : AnInputRecord; d : in out ADialogAction);
procedure Draw( c : in out AThermometer );
procedure Resize( c : in out AThermometer; dleft, dtop, dright, dbottom :
  integer );
procedure SetStatus( c : in out AThermometer; status : AControlStatus);
function  Encode( c : in AThermometer ) return EncodedString;
procedure Decode( estr : in out EncodedString; c : in out AThermometer );

function  GetMax( c : in AThermometer ) return integer;
function  GetValue( c : in AThermometer ) return integer;
procedure SetMax( c : in out AThermometer; max : in integer );
procedure SetValue( c : in out AThermometer; value : in Integer );


---> Scroll Bars
--
-- SetMax   - set the value associated with the end of the bar
-- GetMax   - return same
-- SetThumb - set the position of the thumb (0...Max)
-- GetThumb - return same
-- SetOwner - indicate the list control associated with this bar
-- GetOwner - return same

type AScrollBar is new AWindowControl with private;

procedure Init( c : in out AScrollBar; left,top,right,bottom : integer;
                  HotKey : character := NullKey );
procedure Finalize( c : in out AScrollBar );
procedure Hear( c : in out AScrollBar; i:AnInputRecord; d : in out ADialogAction);
procedure Draw( c : in out AScrollBar );
procedure Resize( c : in out AScrollBar; dleft, dtop, dright, dbottom :
  integer );
procedure SetStatus( c : in out AScrollBar; status : AControlStatus);
function  Encode( c : in AScrollBar ) return EncodedString;
procedure Decode( estr : in out EncodedString ; c : in out AScrollBar );

function  GetMax( c : in AScrollBar ) return integer;
function  GetThumb( c : in AScrollBar ) return integer;
procedure SetMax( c : in out AScrollBar; max : in integer );
procedure SetThumb( c : in out AScrollBar; thumb : in integer );
procedure SetOwner( c : in out AScrollBar; owner : AControlNumber );
function  GetOwner( c : in AScrollBar ) return AControlNumber;


---> Static Lines
--
-- SetText - set the text of the line
-- GetText - return the text of the line
-- SetStyle - set the print text of the line
-- GetStyle - return the print text of the line

type AStaticLine is new AnIconicControl with private;
procedure Init( c : in out AStaticLine; left,top,right,bottom : integer;
                HotKey : character := NullKey );
procedure Finalize( c : in out AStaticLine );
procedure Hear( c : in out AStaticLine; i:AnInputRecord; d:in out ADialogAction );
procedure Draw( c : in out AStaticLine );
procedure Resize( c : in out AStaticLine; dleft, dtop, dright, dbottom :
  integer );
procedure SetStatus( c : in out AStaticLine; status : AControlStatus);
function  Encode( c : in AStaticLine ) return EncodedString;
procedure Decode( estr : in out EncodedString; c : in out AStaticLine );

function  GetText( c : in AStaticLine ) return String;
procedure SetText( c : in out AStaticLine; text : in string );
function  GetStyle( c : in AStaticLine ) return ATextStyle;
procedure SetStyle( c : in out AStaticLine; style : ATextStyle );
function  GetColour( c : in AStaticLine ) return APenColourName;
procedure SetColour( c : in out AStaticLine; colour : APenColourName );


---> Edit Lines, elementary edit line
--
-- SetText - set the text of the edit line
-- GetText - return the text of the edit line
-- SetAdvanceMode - enable/disable auto advance when line is full
-- GetAdvanceMode - return auto advance setting

type AnEditLine is new AWindowControl with private; -- should be a class
type SomeEditLine is access all AnEditLine'class;

procedure Finalize( c : in out AnEditLine'class );
procedure Init( c : in out AnEditLine; left,top,right,bottom : integer;
                Max : natural := 0; HotKey : character := NullKey );
procedure Hear( c : in out AnEditLine; i : AnInputRecord; d : in out ADialogAction );
procedure Draw( c : in out AnEditLine );
procedure Resize( c : in out AnEditLine'class; dleft, dtop, dright, dbottom :
  integer );
procedure SetStatus( c : in out AnEditLine; status : AControlStatus);
function  Encode( c : in AnEditLine ) return EncodedString;
procedure Decode( estr : in out EncodedString; c : in out AnEditLine );

function  GetText( c : in AnEditLine'class ) return String;
procedure SetText( c : in out AnEditLine'class; text : in String);
function  GetAdvanceMode( c : in AnEditLine'class ) return boolean;
procedure SetAdvanceMode( c : in out AnEditLine'class; mode : boolean );
function  GetBlindMode( c : in AnEditLine'class ) return boolean;
procedure SetBlindMode( c : in out AnEditLine'class; mode : boolean );
function  GetMaxLength( c : in AnEditLine'class ) return integer;
procedure SetMaxLength( c : in out AnEditLine'class; MaxLength : integer );

---> Integer Edit Lines
--

type AnIntegerEditLine is new AnEditLine with private;

procedure Init( c : in out AnIntegerEditLine; left,top,right,bottom : integer;
                Max : natural := 0; HotKey : character := NullKey );
procedure Hear( c : in out AnIntegerEditLine; i : AnInputRecord;
                d : in out ADialogAction );
procedure Draw( c : in out AnIntegerEditLine );
procedure SetStatus( c : in out AnIntegerEditLine; status : AControlStatus);
function  Encode( c : in AnIntegerEditLine ) return EncodedString;
procedure Decode( estr : in out EncodedString; c : in out AnIntegerEditLine );

procedure SetValue( c : in out AnIntegerEditLine; value : integer );
function  GetValue( c : in AnIntegerEditLine ) return integer;

---> Long Integer Edit Lines
--

type ALongIntEditLine is new AnEditLine with private;

procedure Init( c : in out ALongIntEditLine;
                left,top,right,bottom : integer; Max : natural := 0;
                HotKey : character := NullKey );
procedure Hear( c : in out ALongIntEditLine; i : AnInputRecord;
                d : in out ADialogAction );
procedure Draw( c : in out ALongIntEditLine );
procedure SetStatus( c : in out ALongIntEditLine; status : AControlStatus);
function  Encode( c : in ALongIntEditLine ) return EncodedString;
procedure Decode( estr : in out EncodedString; c : in out ALongIntEditLine );

procedure SetValue( c : in out ALongIntEditLine; value : in long_integer );
function  GetValue( c : in ALongIntEditLine ) return long_integer;

---> Float Edit Lines
--

type AFloatEditLine is new AnEditLine with private;

procedure Init( c : in out AFloatEditLine; left,top,right,bottom : integer;
                Max : natural := 0; HotKey : character := NullKey );
procedure Hear( c : in out AFloatEditLine; i : AnInputRecord;
                d : in out ADialogAction );
procedure Draw( c : in out AFloatEditLine );
procedure SetStatus( c : in out AFloatEditLine; status : AControlStatus);
--  function  Encode( c : in AFloatEditLine ) return EncodedString;
--  procedure Decode( estr : in out EncodedString; c : in out AFloatEditLine );

procedure SetValue( c : in out AFloatEditLine; value : float );
function  GetValue( c : in AFloatEditLine ) return float;

---> Check Boxes
--
-- SetText - set the button's message
-- GetText - return the button's message
-- SetCheck - check/uncheck the button
-- GetCheck - return the button's check

type ACheckBox is new AWindowControl with private;

procedure Init( c : in out ACheckBox; left,top,right,bottom : integer;
                HotKey : character := NullKey );
procedure Finalize( c : in out ACheckBox );
procedure Hear( c : in out ACheckBox; i : AnInputRecord; d : in out ADialogAction );
procedure Draw( c : in out ACheckBox );
procedure Resize( c : in out ACheckBox; dleft, dtop, dright, dbottom :
  integer );
procedure SetStatus( c : in out ACheckBox; status : AControlStatus);
function  Encode( c : in ACheckBox ) return EncodedString;
procedure Decode( estr : in out EncodedString; c : in out ACheckBox );

function  GetText( c : in ACheckBox ) return String;
function  GetCheck( c : in ACheckBox ) return boolean;
procedure SetText( c : in out ACheckBox; text : in String);
procedure SetCheck( c : in out ACheckBox; checked : boolean );


---> Radio Buttons
--
-- GetText - return the button's message
-- SetText - set the button's message
-- SetCheck - check/uncheck the radio button
-- GetCheck - return the button's check
-- GetFamily - the the family number of the radio button

type ARadioButton is new AWindowControl with private;

procedure Init( c : in out ARadioButton; left,top,right,bottom : integer;
                family : integer := 0; HotKey : character := NullKey );
procedure Finalize( c : in out ARadioButton );
procedure Hear( c : in out ARadioButton; i : AnInputRecord; d : in out ADialogAction );
procedure Draw( c : in out ARadioButton );
procedure Resize( c : in out ARadioButton; dleft, dtop, dright, dbottom :
  integer );
procedure SetStatus( c : in out ARadioButton; status : AControlStatus);
function  Encode( c : in ARadioButton ) return EncodedString;
procedure Decode( estr : in out EncodedString; c : in out ARadioButton );

function  GetText( c : in ARadioButton ) return String;
function  GetCheck( c : in ARadioButton ) return boolean;
function  GetFamily( c : in ARadioButton ) return integer;
procedure SetText( c : in out ARadioButton; text : in String );
procedure SetCheck( c : in out ARadioButton; checked : boolean );


---> Simple Buttons
--
-- SetText - set the button's message
-- GetText - return the button's message

type ASimpleButton is new AWindowControl with private;

procedure Init( c : in out ASimpleButton; left,top,right,bottom : integer;
                HotKey : character := NullKey );
procedure Finalize( c : in out ASimpleButton );
procedure Hear( c : in out ASimpleButton; i : AnInputRecord; d : in out ADialogAction );
procedure Draw( c : in out ASimpleButton );
procedure Resize( c : in out ASimpleButton; dleft, dtop, dright, dbottom :
  integer );
procedure SetStatus( c : in out ASimpleButton; status : AControlStatus);
function  Encode( c : in ASimpleButton ) return EncodedString;
procedure Decode( estr : in out EncodedString; c : in out ASimpleButton );

function  GetText( c : in ASimpleButton ) return String;
procedure SetText( c : in out ASimpleButton; text : in String );
function  GetInstant( c : in ASimpleButton ) return boolean;
procedure SetInstant( c : in out ASimpleButton; instant : boolean := true );
function  GetColour( c : in ASimpleButton ) return APenColourName;
procedure SetColour( c : in out ASimpleButton; colour : APenColourName );

---> Window Buttons
--
-- SetText - set the button's message
-- GetText - return the button's message
-- SetLink - set the path to the window associated with this button
-- GetLink - return the window path

type AWindowButton is new AnIconicControl with private;

procedure Init( c : in out AWindowButton; left, top, right, bottom : integer;
                HotKey : character := NullKey );
procedure Finalize( c : in out AWindowButton );
procedure Hear( c : in out AWindowButton; i : AnInputRecord; d : in out
                ADialogAction );
procedure Draw( c : in out AWindowButton );
procedure Resize( c : in out AWindowButton; dleft, dtop, dright, dbottom :
  integer );
procedure SetStatus( c : in out AWindowButton; status : AControlStatus);
function  Encode( c : in AWindowButton ) return EncodedString;
procedure Decode( estr : in out EncodedString; c : in out AWindowButton );

procedure SetText( c : in out AWindowButton; text : in String );
function  GetText( c : in AWindowButton ) return String;
function  GetInstant( c : in AWindowButton ) return boolean;
procedure SetInstant( c : in out AWindowButton; instant : boolean := true );
procedure SetControlHit( c : in out AWindowButton; chit : AControlNumber );
function  GetControlHit( c : in AWindowButton ) return AControlNumber;

---> Rectangles
--
-- SetColours - set the foreground and background colours
-- GetColours - return the foreground and background colours

type ARectangle is new AnIconicControl with private;

procedure Init( c : in out ARectangle; left,top,right,bottom : integer;
                HotKey : character := NullKey );
procedure Finalize( c : in out ARectangle );
procedure Hear( c : in out ARectangle; i : AnInputRecord; d : in out
              ADialogAction );
procedure Draw( c : in out ARectangle );
procedure Resize( c : in out ARectangle; dleft, dtop, dright, dbottom :
  integer );
procedure SetStatus( c : in out ARectangle; status : AControlStatus);
function  Encode( c : in ARectangle ) return EncodedString;
procedure Decode( estr : in out EncodedString; c : in out ARectangle );

procedure SetColours( c : in out ARectangle;
   FrameColour, BackColour : APenColourName );
procedure GetColours( c : in ARectangle;
   FrameColour, BackColour : in out APenColourName );
procedure SetText (C : in out ARectangle; Text : in String );
function  GetText (C : in ARectangle) return String;


---> Lines
--
-- SetColour - select the colour of the line
-- GetColour - return the colour of the line
-- SetDrawDir - DownRight => line is drawn from top-left to bottom-right
--    of the control frame, else bottom-left to top-right.
-- GetDrawDir - return the drawing direction

type ALine is new AnIconicControl with private;

procedure Init( c : in out ALine'class; left, top, right, bottom : integer;
                HotKey : character := NullKey );
procedure Finalize( c : in out ALine'class );
procedure Hear( c : in out ALine'class; i : AnInputRecord; d : in out ADialogAction);
procedure Draw( c : in out ALine );
procedure Resize( c : in out ALine'class; dleft, dtop, dright, dbottom : integer );
procedure SetStatus( c : in out ALine'class; status : AControlStatus);
function  Encode( c : in ALine'class ) return EncodedString;
procedure Decode( estr : in out EncodedString; c : in out ALine'class );

procedure SetColour( c : in out ALine'class; Colour : APenColourName );
function  GetColour( c : in ALine'class ) return APenColourName;
procedure SetDrawDir( c : in out ALine; DownRight : boolean );
function  GetDrawDir( c : in ALine ) return boolean;

-- Section Separators
--
-- On Graphics Displays, centered in drawing grid appropriately

type AnHorizontalSep is new ALine with private;
procedure Draw( c : in out AnHorizontalSep );

type AVerticalSep is new ALine with private;
procedure Draw( c : in out AVerticalSep );

---> Static Lists, the elementary static list
--
-- Is the list the belongs to the control a pointer to a list, or
-- a copy of a list supplied by the programmer?  A pointer makes it
-- handy to read the list, but offers no protection against failure
-- to inform the control to update.  I'll compromise here: SetList
-- COPIES and GetList returns a pointer.
--
-- that it can't be copied by assignment.
-- SetList - install the text to display in the box
-- SetOrigin - change top line being displayed
-- GetList - return the list of text
-- GetOrigin - return the origin
-- GetCurrent - return line the cursor is on
-- GetPosition - return the position on the line
-- SetCursor - move the cursor to a specific place
-- GetLength - return number of lines
-- JustifyText - format text to fit within specified width
-- WrapText - wrap long lines
-- SetScrollBar - set the scroll bar (or thermometer) to be associated
--   with this list control
-- GetScrollBar - return the associated scroll bar (or 0)

type AStaticList is new AWindowControl with private;
type SomeListControl is access all AStaticList'class;

procedure Init( c : in out AStaticList; left,top,right,bottom : integer;
                HotKey : character := NullKey );
procedure Finalize( c : in out AStaticList );
procedure Hear( c : in out AStaticList; i : AnInputRecord; d : in out ADialogAction);
procedure Draw( c : in out AStaticList );
procedure Resize( c : in out AStaticList'class; dleft, dtop, dright, dbottom : integer );
procedure SetStatus( c : in out AStaticList'class; status : AControlStatus);
function  Encode( c : in AStaticList'class ) return EncodedString;
procedure Decode( estr : in out EncodedString; c : in out AStaticList'class );

procedure SetList( c : in out AStaticList'class; list : in out StrList.Vector );
procedure SetOrigin( c : in out AStaticList'class; origin : Natural);
function  GetList( c : in AStaticList'class ) return StrList.Vector;
function  GetOrigin( c : in AStaticList'class ) return Natural;
function  GetCurrent( c : in AStaticList'class ) return Natural ;
function  GetLength( c : in AStaticList'class ) return Natural;
function  GetPositionY( c : in AStaticList'class ) return integer;
procedure JustifyText( c : in out AStaticList;
                       width : integer;
                       startingAt : Natural := 0 );
procedure WrapText( c : in out AStaticList );
procedure MoveCursor( c : in out AStaticList'class; dx : integer;
   dy : integer );
procedure SetScrollBar( c : in out AStaticList'class; bar : AControlNumber );
function  GetScrollBar( c : in AStaticList'class ) return AControlNumber;
function CopyLine (c : in AStaticList'Class) return String;
-- copy line at current position
procedure PasteLine( c : in out AStaticList'class; text : in string );
procedure ReplaceLine( c : in out AStaticList'class; text : in string );

procedure FindText( c : in out AStaticList'class; str2find : in String;
               Backwards, IsRegExp : boolean := false );
-- IsRegexp is actually ignored.
procedure ReplaceText( c : in out AStaticList'class; str2find,
   str2repl : in String; Backwards, IsRegExp : boolean := false );
-- IsRegExp is assumed false, since no regexp support is implemented.
procedure SetFindPhrase( c : in out AStaticList'class; phrase : in string );

procedure SetMark( c : in out AStaticList'class; mark : integer );
function  GetMark( c : in AStaticList'class ) return integer;
-- mark position.  Use -1 to denote no mark set.

procedure CopyLines( c : in out AStaticList'class; mark2 : integer;
  Lines : in out StrList.Vector );
-- copy lines between mark2 and mark set with SetMark
procedure PasteLines( c : in out AStaticList'class; Lines :
   in out StrList.Vector );

---> Check Lists
--
-- SetChecks - install list of check boxes
-- GetChecks - return pointer to list of checks

type ACheckList is new AStaticList with private;

procedure Init( c : in out ACheckList; left,top,right,bottom : integer;
                HotKey : character := NullKey );
procedure Finalize( c : in out ACheckList );
procedure Hear( c : in out ACheckList; i : AnInputRecord; d : in out ADialogAction);
procedure Draw( c : in out ACheckList );

procedure SetChecks( c : in out ACheckList; checks : in out BooleanList.Vector );
function  GetChecks( c : in ACheckList ) return BooleanList.Vector;


---> Radio Lists
--
-- SetChecks - install list of radio button checks + first to check
-- GetChecks - return a pointer to the list of checks
-- GetCheck  - return the number of the item checked

type ARadioList is new AStaticList with private;

procedure Init( c : in out ARadioList; left,top,right,bottom : integer;
                HotKey : character := NullKey );
procedure Finalize( c : in out ARadioList );
procedure Hear( c : in out ARadioList; i : AnInputRecord; d : in out ADialogAction);
procedure Draw( c : in out ARadioList );

procedure SetChecks( c : in out ARadioList; checks : in out BooleanList.Vector;
          Default : Natural := 1 );
function  GetChecks( c : in ARadioList ) return BooleanList.Vector;
function  GetCheck( c : in ARadioList ) return Natural;


---> Edit Lists
--
-- GetPosition - get horizontal position of cursor (left side = 1)
-- SetCursor - move the cursor to a specific position in the text

type AnEditList is new AStaticList with private;
procedure Init( c : in out AnEditList; left,top,right,bottom : integer;
                HotKey : character := NullKey );
procedure Finalize( c : in out AnEditList );
procedure Hear( c : in out AnEditList; i : AnInputRecord;
   d : in out ADialogAction);
procedure Draw( c : in out AnEditList );

function  GetPosition( c : in AnEditList'class ) return integer;
procedure SetCursor( c : in out AnEditList'class; x : integer;
                     y : Natural);

procedure JustifyText( c : in out AnEditList;
                       width : integer;
                       startingAt : Natural := 0 );
procedure Touch( c : in out AnEditList'class );
-- set touch flag to true
procedure ClearTouch( c : in out AnEditList'class );
-- set touch flag to false
function  WasTouched( c : AnEditList'class ) return boolean;
-- true if Touch or received input.  Used for saving

---> SOURCE EDIT LIST
--
-- For displaying source code with hilighted keywords.  Provided for TIA.

type ASourceEditList is new AnEditList with private;

procedure Init( c : in out ASourceEditList; left,top,right,bottom : integer;
                HotKey : character := NullKey );
procedure Finalize( c : in out ASourceEditList );
procedure Hear( c : in out ASourceEditList; i : AnInputRecord;
   d : in out ADialogAction);
procedure Draw( c : in out ASourceEditList );

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

procedure SetHTMLTagsStyle( c : in out ASourceEditList; hilight : boolean );
-- choose to hilight html tags or not
procedure SetLanguageData( c : in out ASourceEditList; p : languageDataPtr );
procedure SetKeywordHilight( c : in out ASourceEditList; pcn : aPenColourName );
procedure SetFunctionHilight( c : in out ASourceEditList; pcn : aPenColourName );
procedure SetSourceLanguage( c : in out ASourceEditList; l : ASourceLanguage );

----> UNFINISHED CONTROLS

type AnHTMLBox is new AStaticList with private;

---> Pictures
--
-- Bit-mapped pictures.  They can double as traditional icons using the
-- text description as the icon caption.  APicture is a collection of
-- simple pictures optimized at different resolutions.

type ASimplePicture is new AnIconicControl with private;

type APicture is new ASimplePicture with private;

---> Scalable pictures
--
-- Traditional "draw" object composed of scalable geometric objects, like
-- lines, circles, rectangles, etc.

type ASketch is new AnIconicControl with private;

---> Animations
--
-- A collection of objects to be displayed through a sequence of states.
-- The objects can't be edited, hence an animation is iconic.

type AnAnimation is new AnIconicControl with private;

type ATreeList is new AStaticList with private; --dummy

PRIVATE

type RootControl is new Ada.Finalization.Controlled with record
     Frame       : ARect;          -- frame surrounding control
     Status      : AControlStatus; -- Off / Standby / On
     Name        : unbounded_string;   -- name of the control
     StickLeft   : boolean;    -- frame.left should adhere to window's left
     StickTop    : boolean;    -- frame.top  should adhere to window's top
     StickRight  : boolean;    -- frame.right should adhere to w's right
     StickBottom : boolean;    -- frame.top should adhere to w's bottom
     CursorX     : integer;    -- cursor location
     CursorY     : integer;
     Scrollable  : boolean;    -- true if ScrollWindow should ignore
     NeedsRedrawing : boolean; -- true if needs redrawing
     HotKey      : character;  -- key to jump to this item (else NullKey)
     HasInfo     : boolean;    -- true if text is valid for info bar
     InfoText    : Unbounded_String;     -- string to show in info bar if hilighted
end record;

type ANullControl is new RootControl with null record;

type AnIconicControl is new RootControl with record
     link              : Unbounded_String;  -- link to another system-controlled window
     CloseBeforeFollow : boolean; -- close before following link
end record;

type AWindowControl is new RootControl with null record;

type AThermometer is new AWindowControl with record
     Max   : integer;   -- ranges 0..max
     Value : integer; -- current value
end record;

type AScrollBar is new AWindowControl with record
     Max   : integer;   -- ranges 0..Max
     thumb : integer;   -- current position
     Owner : AControlNumber; -- related control (for window manager)
     -- optimizations for text screen
     DirtyThumb : boolean;   -- true if only thumb needs redrawing
     OldThumb   : integer;   -- old drawing position for thumb
end record;

type AStaticLine is new AnIconicControl with record
     Text   : Unbounded_String;      -- text in the static line
     Style  : ATextStyle;  -- the style of text (default normal)
     Colour : APenColourName;  -- colour of text
end record;

type AnEditLine is new AWindowControl with record -- should be a class
     Text : Unbounded_String;         -- text in the edit line
     Max  : natural;        -- maximum number of characters (not impl. yet)
     Origin : natural;      -- offset for display if text is wider than box
     AdvanceMode : boolean; -- auto-advance with last character?
     BlindMode : boolean;   -- true for blind text (eg. password entry)
     MaxLength : integer;   -- maximum number of characters
     -- optimzations for text screen
     DirtyText   : boolean; -- if only text right of cursor needs drawing
end record;

type AnIntegerEditLine is new AnEditLine with record
     value : integer;
end record;

type ALongIntEditLine is new AnEditLine with record
     value : long_integer;
end record;

type AFloatEditLine is new AnEditLine with record
     value : float;
end record;

type ACheckBox is new AWindowControl with record
     Text : Unbounded_String;     -- message of the button
     Checked : boolean; -- true if button's checked
     HotPos : natural;
end record;

type ARadioButton is new AWindowControl with record
     Text : Unbounded_String;     -- title
     Checked : boolean; -- true if button is "on"
     Family  : integer; -- a number to associate families
     HotPos  : natural;
end record;

type ASimpleButton is new AWindowControl with record
     Text   : Unbounded_String;  -- message of the button
     Instant: boolean; -- true if an instant selection on ScanNext
     HotPos : natural; -- position of hot key character
     Colour : APenColourName;
end record;

type AWindowButton is new AnIconicControl with record
     Text   : Unbounded_String;  -- message of the button
     Instant: boolean; -- true if an instant selection on ScanNext
     HotPos : natural; -- position of hot key character
     chit : AControlNumber; -- what was hit
end record;

type ARectangle is new AnIconicControl with record
     FrameColour : APenColourName; -- colour of the frame
     BackColour  : APenColourName; -- colour of the background
     Text        : unbounded_string;
end record;

type ALine is new AnIconicControl with record
     Colour     : APenColourName; -- colour of the line
     DownRight  : boolean;    -- true if line goes from top-left to b-r
end record;

type AnHorizontalSep is new ALine with null record;

type AVerticalSep is new ALine with null record;

type AStaticList is new AWindowControl with record
     List       : aliased StrList.Vector;  -- list of text
     Origin     : Natural;    -- line # at top of box
     ScrollBar  : AControlNumber;           -- reference value for window manager
     Mark       : integer;             -- as set by set mark
     FindPhrase : Unbounded_String := Null_Unbounded_String;     -- for hilighting purposes
end record;

type ACheckList is new AStaticList with record
     Checks : BooleanList.Vector;             -- list of selections (if any)
end record;

type ARadioList is new AStaticList with record
     Checks : BooleanList.Vector;             -- list of selections (if any)
     LastCheck : integer;              -- last selection (else 0)
end record;

type AnEditList is new AStaticList with record
     DirtyLine : boolean;                   -- if current line is dirty
     Touched   : boolean := false;          -- true if received input
     ForwardCharSearchMode : boolean := false; -- true if in mode
end record;

type ASourceEditList is new AnEditList with record
     KeywordList  : StrList.Vector;
     HTMLTagStyle : boolean := false;       -- true if hilighted
     InsertedLines : integer;          -- active insert block
     InsertedFirst : Natural; -- start of active insert block
                                            -- (if insertedLines /= 0)
     sourceLanguage : aSourceLanguage := unknownLanguage;
     keywordHilight : aPenColourName := yellow;
     functionHilight : aPenColourName := purple;
     languageData : languageDataPtr := null;
end record;

----> UNFINISHED CONTROLS

type AnHTMLBox is new AStaticList with record
   null;
end record;

type ASimplePicture is new AnIconicControl with record
     pic  : APictureID; -- ID of the picture
     path : unbounded_string;     -- path of the picture
     text : unbounded_string;     -- description (if can't be displayed)
end record;

type APicture is new ASimplePicture with record
     null; -- to be defined
end record;

type ASketch is new AnIconicControl with record
     null;
end Record;

type AnAnimation is new AnIconicControl with record
     X, Y : integer;             -- actually, redundant with control pos'n
     XVector, YVector : integer; -- motion offset information
     Enabled : boolean;          -- actually, redundant with status
     Visible : boolean;          -- actually, redundant with status
     Index : short_integer;      -- frame index
     AniStatus : short_integer;  -- grammer status
     --Stack  : AnAnimationStack;  -- the animation grammar
end record;

type ATreeList is new AStaticList with null record; --dummy

end controls;