libtexttools4-dev 2.1.0-6build2 / usr / share / ada / adainclude / texttools / windows.adb

------------------------------------------------------------------------------
-- WINDOWS (package body)                                                   --
--                                                                          --
-- Part of TextTools                                                        --
-- Designed and Programmed by Ken O. Burtch                                 --
--                                                                          --
------------------------------------------------------------------------------
--                                                                          --
--                 Copyright (C) 1999-2007 Ken O. Burtch                    --
--                                                                          --
-- 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                     --
--                                                                          --
------------------------------------------------------------------------------
-- Had to hard code dispatching in Open/Save dialogs under Gnat 3.05-why?
with unchecked_deallocation;
with system.address_to_access_conversions;
with Ada.Text_Io.Unbounded_IO; use Ada.text_io;

with strings; use strings;
with English; use English;
with Ada.Directories;
with Ada.IO_Exceptions;
with Ada.Containers;
with Ada.Calendar.Formatting;
with Ada.Strings.Fixed;

package body windows is

  PackageRunning : boolean := false;

  type AStdioFileID is new System.Address;
  -- a C standard IO (stdio) file id

  function popen( command, mode : string ) return AStdioFileID;
  pragma import( C, popen, "popen" );
  -- opens a pipe to command

  procedure pclose( result : out integer; fid : AStdioFileID );
  pragma import( C, pclose, "pclose" );
  pragma import_valued_procedure( pclose );
  -- closes a pipe

  function fputc( c : integer; fid : AStdioFileID ) return integer;
  pragma import( C, fputc, "fputc" );
  -- part of standard C library.  Writes one charctera to a file.

  function fputs( s : string; fid : AStdioFileID ) return integer;
  pragma import( C, fputs, "fputs" );
  -- part of standard C library.  Writes a string to a file.

  type ADirectoryEntry is array(1..256) of Character;

  package de_conv is new system.address_to_access_conversions(
     aDirectoryEntry );
  use de_conv;

  procedure CDesktop( maxx, maxy : integer );
  pragma import( C, CDesktop, "CDesktop" );

  -- Simple Clipboard for cut/paste of values between controls

type DataTypes is (ListData, StringData, IntegerData, BooleanData);
type ClipboardRec( DataType : DataTypes ) is record
     case DataType is
     when ListData   =>  l : StrList.vector;
     when StringData  => s : Unbounded_String;
     when IntegerData => i : integer;
     --when BooleanData => b : boolean;
     --gnat 2.00 gave me a constraint error after saving a false boolean
     --saving boolean as integer instead.
     when BooleanData => b : integer;
     end case;
end record;

type ClipboardType is access ClipboardRec;
Clipboard : ClipboardType := null;

  -- Utilities

procedure GetDirectory (L    : in out StrList.vector;
                        Path : in     String) is
   -- load the specified directory listing into the given list
   use Ada.Directories;
   procedure Process (Directory_Entry : in Directory_Entry_Type);
   procedure Process (Directory_Entry : in Directory_Entry_Type) is
      File : constant String := Simple_name (Directory_Entry);
   begin
      if Kind (Directory_Entry) = Directory then
	 L.Append (File & "/");
      else
	 L.Append (File);
      end if;
   end Process;
   package Sorting is new Strlist.Generic_Sorting;
begin
   Search (Path, "", Process => Process'Access);
   Sorting.Sort (L);
exception
   when Ada.IO_Exceptions.Name_Error | Ada.IO_Exceptions.Use_Error =>
      Sessionlog ("getdirectory: error opening directory '"
                    & path & "' - no such file or directory" );
end GetDirectory;

-- Shared Controls
--
-- To make the standard dialogs work in low memory situations, and to
-- get around some limitations to 'access, we allocate some basic controls
-- at startup to be shared amongst the standard dialogs.

type ASharedControlsRecord is record
     button1 : AControlPtr;
     button2 : AControlPtr;
     button3 : AControlPtr;
     text    : AControlptr;
     -- others for Save/Open dialogs later
end record;
Shared : ASharedControlsRecord; -- the shared controls

procedure SharedButton( sc : AControlPtr; x1, y1, x2, y2 : integer;
  HotKey : character; text : string ) is
-- initialized a button shared amongst the standard dialogs
begin
  if sc = null then
     SessionLog( "SharedButton: the pointer is null.  Package not started?" );
  end if;
  Finalize( ASimpleButton( sc.all ) );
  Init( ASimpleButton( sc.all ),  x1, y1, x2, y2, HotKey );
  SetText( ASimpleButton( sc.all ), text );
  AddControl( sc, IsGlobal => false );
end SharedButton;

procedure SharedLine( sc : AControlPtr; x1, y1, x2, y2 : integer;
   text : string ) is
-- initialized a static line shared amongst the standard dialogs
begin
  if sc = null then
     SessionLog( "SharedLine: the pointer is null.  Package not started?" );
  end if;
  Finalize( AStaticLine( sc.all ) );
  Init( AStaticLine( sc.all ), x1, y1, x2, y2 );
  SetText( AStaticLine( sc.all ), text );
  --SetStyle( AStaticLine( sc.all ), Normal );
  AddControl( sc, IsGlobal => false );
end SharedLine;

-- These should be replaced, not renamed

ChimeSkipMinutes : Ada.Calendar.Formatting.Minute_Number := 0;
-- last minutes chime rang (set in DoDialog)

-- Display Info

DisplayInfo : ADisplayInfoRec;

procedure Free is new Unchecked_Deallocation(
                  Object => ClipboardRec,
                  Name => ClipboardType );

-- Note Pad

NotePadData : StrList.Vector;

procedure AppendNotepad (S : in StrList.Vector) is
begin
   NotePadData := S;
end AppendNotepad;


-- General Window I/O
--
-- Pen motion

procedure MoveTo( x, y : integer ) is
  -- move the pen to a new position in the current window.  The pen will
  -- not move if the position is outside of the current window.  Use
  -- absolute coordinates.
  newx, newy : integer;
begin
  newx := Window( CurrentWindow ).content.left -1 + x;
  newy := Window( CurrentWindow ).content.top - 1 + y;
  if InRect( newx, newy, Window( CurrentWindow ).content ) then
     MoveToGlobal( newx, newy );
  end if;
  exception when others =>
     DrawErrLn;
     DrawErr( "MoveTo RT exception" );
     raise;
end MoveTo;

procedure Move( dx, dy : integer ) is
  -- move the pen to a new position in the current window.  The pen will
  -- not move if the position is outside of the current window.  Use
  -- relative coordinates.
  x, y : integer;
begin
  GetPenPos( x, y );
  x := x + dx;
  y := y + dy;
  if InRect( x, y, Window( CurrentWindow ).content ) then
     MoveToGlobal( x, y );
  end if;
  exception when others =>
     DrawErrLn;
     DrawErr( "Move RT exception" );
     raise;
end Move;


-- Coordinate Conversion

procedure ToGlobal( r : in out ARect ) is
  -- convert a rectangle with coordinates local to a window to global
  -- screen coordinates
begin
  OffsetRect( r, Window( CurrentWindow ).content.left - 1,
                 Window( CurrentWindow ).content.top - 1 );
end ToGlobal;

procedure ToGlobal( x, y : in out integer ) is
-- convert a point with coordinates local to a window to global
-- screen coordinates
begin
  x := x + Window( CurrentWindow ).content.left - 1;
  y := y + Window( CurrentWindow ).content.right - 1;
end ToGlobal;

procedure ToLocal( r : in out ARect ) is
  -- convert a rectangle with global screen coordinates to coordinates
  -- local to the current window
begin
  OffsetRect( r, - (Window( CurrentWindow ).content.left - 1),
                 - (Window( CurrentWindow ).content.top - 1) );
end ToLocal;

procedure ToLocal( x, y : in out integer ) is
  -- convert a point with global screen coordinates to coordinates
  -- local to the current window
begin
  x := x - (Window( CurrentWindow ).content.left - 1);
  y := y - (Window( CurrentWindow ).content.top - 1);
end ToLocal;


-- General Window I/O

procedure print is
begin
  DrawLn;
  RevealNow;
end print;

procedure print( s : string ) is
begin
  Draw( s );
  RevealNow;
end print;

procedure print( i : integer ) is
begin
  Draw( i );
  RevealNow;
end print;

procedure print( l : long_integer ) is
begin
  Draw( l );
  RevealNow;
end print;


-- Window Info Bars

procedure DrawInfo( id : AWindowNumber ) is
  -- Draw a window's info bar (if any)
  win : AWindow renames Window( id );
  InfoBar : ARect renames Window( id ).InfoBar;
begin
  if win.HasInfoBar then
     SetTextStyle( Status );
     SetPenColour( White );
     MoveToGlobal( InfoBar.left, InfoBar.top );
     Draw( To_String (Win.InfoText), InfoBar.right - InfoBar.left + 1, true );
  end if;
  exception when others =>
     DrawErrLn;
     DrawErr( "DrawInfo RT exception" );
     raise;
end DrawInfo;

procedure DrawInfo is
  -- short-cut for current window
begin
  DrawInfo( CurrentWindow );
end DrawInfo;

procedure SetInfoText( text : in string ) is
  -- change text in the info bar and redraw
  cw : AWindow renames Window( CurrentWindow );
begin
  if cw.HasInfoBar then
     cw.InfoText := To_Unbounded_String (Text);
     DrawInfo;
  end if;
  exception when others =>
     DrawErrLn;
     DrawErr( "SetInfoText RT exception" );
     raise;
end SetInfoText;

-- Window timeouts

procedure SetWindowTimeout( c : AControlNumber; t : in Duration ) is
begin
  Window( CurrentWindow ).TimeoutControl := c;
  Window( CurrentWindow ).Timeout := t;
end SetWindowTimeout;


-- Window titles

procedure SetWindowTitle( title : in string) is
begin
  Window( CurrentWindow ).title := To_Unbounded_String (Title);
  DrawWindow;
end SetWindowTitle;


-- Window Inquiries

function GetWindowTitle( id : AWindowNumber ) return string is
begin
   if Id not in Window'First .. Nextwindow - 1 then
      Error( TT_WindowExistance );
      return "";
   end if;
   NoError;
   return To_String (Window( id ).Title);
end GetWindowTitle;

function GetWindowStyle( id : AWindowNumber ) return AWindowStyle is
begin
   if Id not in Window'First .. Nextwindow - 1 then
      Error( TT_WindowExistance );
      return Normal;
   end if;
  NoError;
  return Window( id ).style;
end GetWindowStyle;

function GetWindowCallBack( id : AWindowNumber ) return
  AWindowDrawingCallBack is
begin
   if Id not in Window'First .. Nextwindow - 1 then
      Error( TT_WindowExistance );
      return null;
   end if;
  NoError;
  return Window( id ).DrawCB;
end GetWindowCallBack;

function GetWindowHasFrame( id : AWindowNumber ) return boolean is
begin
   if Id not in Window'First .. Nextwindow - 1 then
      Error( TT_WindowExistance );
      return False;
   end if;
  NoError;
  return Window( id ).HasFrame;
end GetWindowHasFrame;

function GetWindowFrame( id : AWindowNumber ) return ARect is
begin
   if Id not in Window'First .. Nextwindow - 1 then
      Error( TT_WindowExistance );
      return Nullrect;
   end if;
  NoError;
  return Window( id ).Frame;
end GetWindowFrame;

function GetWindowFrameColour( id : AWindowNumber ) return APenColourName is
begin
   if Id not in Window'First .. Nextwindow - 1 then
      Error( TT_WindowExistance );
      return White;
   end if;
  NoError;
  return Window( id ).FrameColour;
end GetWindowFrameColour;

function GetWindowContent( id : AWindowNumber ) return ARect is
begin
   if Id not in Window'First .. Nextwindow - 1 then
      Error( TT_WindowExistance );
      return nullrect;
   end if;
  NoError;
  return Window( id ).Content;
end GetWindowContent;

function GetWindowHasInfoBar( id : AWindowNumber ) return boolean is
begin
   if Id not in Window'First .. Nextwindow - 1 then
      Error( TT_WindowExistance );
      return False;
   end if;
  NoError;
  return Window( id ).HasInfoBar;
end GetWindowHasInfoBar;

function GetWindowInfoText( id : AWindowNumber ) return String is
begin
   if Id not in Window'First .. Nextwindow - 1 then
      Error( TT_WindowExistance );
      return "";
   end if;
  NoError;
  return To_String (Window( id ).InfoText);
end GetWindowInfoText;

function GetWindowXScroll( id : AWindowNumber ) return integer is
begin
   if Id not in Window'First .. Nextwindow - 1 then
      Error( TT_WindowExistance );
      return 0;
   end if;
  NoError;
  return Window( id ).XScroll;
end GetWindowXScroll;

function GetWindowYScroll( id : AWindowNumber ) return integer is
begin
   if Id not in Window'First .. Nextwindow - 1 then
      Error( TT_WindowExistance );
      return 0;
   end if;
  NoError;
  return Window( id ).YScroll;
end GetWindowYScroll;


-- Window Controls

procedure InitControlTable( ct : in out AControlTable ) is
  -- reset counters in a control table.  Does not deallocate existing
  -- controls.
begin
  ct.current := 0; -- initial selection is none
  ct.size := 0;    -- initial size is 0
end InitControlTable;

procedure AddControl( ptr : AControlPtr;  -- pointer to the control
          IsGlobal : boolean := true ; -- true if control in global coords.
          Control  : boolean := true ) is -- false if pgm wants to handle hits
  -- add a control entry to the table
   --  ct : AControlTable renames Window( CurrentWindow ).table;
   --  Content : ARect renames Window( CurrentWindow ).Content;
   frame, frame2 : ARect;
   --  dtop, dleft, dbottom, dright : integer := 0;
begin
  Frame := GetFrame( ptr.all );
  -- convert from local to global coordinates, if required
  if not IsGlobal then
     Frame2 := Frame;
     ToGlobal( frame );
     Move( ptr.all, frame.left - frame2.left, frame.top - frame2.top );
  end if;
  -- with scrollable windows, we can no longer constraint to the frame
  -- contrain frame to window (dirty trick, but safer this way)
  --if frame.left < content.left then
  --   dleft := frame.left - content.left;
  --end if;
  --if frame.top < content.top then
  --   dtop := frame.top - content.top;
  --end if;
  --if frame.right > content.right then
  --   dright := content.right - frame.right;
  --end if;
  --if frame.bottom > content.bottom then
  --   dbottom := content.bottom - frame.bottom;
  --end if;
  --Resize( ptr.all, dleft, dtop, dright, dbottom );
  -- GNAT 3.14 bug: rename clause doesn't point "ct" to right entry in
  -- control table.
  --if ct.size < AControlNumber'last then
  --   ct.size := ct.size + 1;
  --   if ct.size = 1 then
  --      ct.current := 1;
  --   end if;
  --   ct.control( ct.size ).ptr := ptr;
  --   ct.control( ct.size ).kind := kind;
  --   ct.control( ct.size ).mine := control;
  if Window( CurrentWindow ).table.size < AControlNumber'last then
     Window( CurrentWindow ).table.size := Window( CurrentWindow ).table.size + 1;
     if Window( CurrentWindow ).table.size = 1 then
        Window( CurrentWindow ).table.current := 1;
     end if;
     Window( CurrentWindow ).table.control( Window( CurrentWindow).table.size ).ptr := ptr;
     Window( CurrentWindow ).table.control( Window( CurrentWindow).table.size ).mine := control;
  else
     null;
  end if;
  exception when others =>
     DrawErrLn;
     DrawErr( "AddControl RT exception" );
     raise;
end AddControl;

procedure DeleteControl( id : AControlNumber ) is
  -- Remove a control from the current window.  Shift other controls
  -- down to fill in gap in the control table.
  ct : AControlTable renames Window( CurrentWindow ).Table;
begin
  if id <= ct.size then
     if Window( CurrentWindow ).Loaded then
        Free( ct.control(id).ptr );
     end if;
     for i in id..ct.size-1 loop
         ct.control( i ) := ct.control(i+1);
     end loop;
     ct.size := ct.size - 1;
  else
     Error( TT_ControlExistance );
  end if;
  exception when others =>
     DrawErrLn;
     DrawErr( "DeleteControl RT exception" );
     raise;
end DeleteControl;

function FindControl( x, y : integer ) return AControlNumber is
  -- find the control with this point inside its enclosing frame
begin
  for i in 1..Window( CurrentWindow ).Table.size loop
      if InControl( Window( CurrentWindow ).Table.Control(i).ptr.all,
         x, y ) then
         return i;
      end if;
  end loop;
  return 0;
  exception when others =>
     DrawErrLn;
     DrawErr( "FindControl RT exception" );
     raise;
end FindControl;

function GetControl( id : AControlNumber ) return AControlPtr is
 --return a pointer to a control (for an application to work with)
  cp : AControlPtr;
begin
  if id > Window( CurrentWindow ).Table.Size then
     cp := null;
  else
     cp := Window( CurrentWindow ).Table.Control( id ).ptr;
  end if;
  return cp;
end GetControl;

procedure DrawControls( ThisWindow : AWindowNumber ) is
  -- Draw a control.  If the control is off-screen, it will not be
  -- drawn.
begin
  WaitToReveal;
  for i in 1..Window( ThisWindow ).table.size loop
      if insideRect( getFrame( Window( ThisWindow ).table.control(i).ptr.all ),
         Window( CurrentWindow ).Content ) then
         Draw( Window( ThisWindow ).table.control(i).ptr.all );
      end if;
  end loop;
  Reveal;
  exception when others => DrawErrLn;
                          DrawErr("DrawControls RT Error" );
                          raise;
end DrawControls;

procedure DrawControls is
begin
  DrawControls( CurrentWindow );
end DrawControls;


-- Hilighting Controls

procedure HilightControl( ctr : in out AControlTableRecord ) is
  -- Dispatch Hilight, if the control is on the screen.
begin
   if insideRect( getFrame( ctr.ptr.all ), Window( CurrentWindow ).Content ) then
      if HasInfo( ctr.ptr.all ) then
         SetInfoText( GetInfo( ctr.ptr.all ) );
      end if;
      SetStatus( ctr.ptr.all, On );
      Draw( ctr.ptr.all );
    else
       error( TT_ParamError );
       DrawErrLn;
       DrawErr( "HilightControl: control not on screen" );
    end if;
    exception when others =>
       DrawErrLn;
       DrawErr( "HilightControl RT exception" );
       raise;
  end HilightControl;

procedure UnhilightControl( ctr : in out AControlTableRecord ) is
  -- set control to standby and redraw the control, if the control is on
  -- the screen.
begin
  if insideRect( getFrame( ctr.ptr.all ), Window( CurrentWindow ).Content ) then
     SetStatus( ctr.ptr.all, StandBy );
     Draw( ctr.ptr.all );
  else
     error( TT_ParamError );
     DrawErrLn;
     DrawErr( "UnhilightControl: control not on screen" );
  end if;
end UnhilightControl;


-- Searching Controls

function NextSelectableControl( ct : AControlTable ) return AControlNumber is
  -- Find the next active control that is on the screen.  The control
  -- status is not changed.
  ThisControl : AControlNumber;
  GiveUp      : AControlNumber;
begin
  ThisControl := ct.current;
  GiveUp := ct.current;
  while GetStatus( ct.control( ThisControl ).ptr.all ) = Off or
       not insideRect( getFrame( ct.control( thisControl ).ptr.all ),
       Window( CurrentWindow ).Content ) loop
     if ThisControl < ct.size then
        ThisControl := ThisControl + 1;
     else
        ThisControl := 1;
     end if;
     if ThisControl = GiveUp then
        DrawErr("NextSelectableControl: No selectable controls");
        DrawLn;
        exit;
     end if;
  end loop;
  return ThisControl;
end NextSelectableControl;

function BackSelectableControl( ct : AControlTable ) return AControlNumber is
  -- Like NextSelectableControl but search in reverse direction.  The
  -- control status is not changed.
  ThisControl : AControlNumber;
  GiveUp      : AControlNumber;
begin
  ThisControl := ct.current;
  GiveUp := ct.current;
  while GetStatus( ct.control( ThisControl ).ptr.all ) = Off or
       not insideRect( getFrame( ct.control( thisControl ).ptr.all ),
       Window( CurrentWindow ).Content ) loop
      if ThisControl > 1 then
         ThisControl := ThisControl - 1;
      else
         ThisControl := ct.size;
      end if;
      if ThisControl = GiveUp then
         DrawErr("BackSelectableControl: No selectable controls");
         DrawLn;
         exit;
      end if;
  end loop;
  return ThisControl;
  exception when others =>
     DrawErrLn;
     DrawErr( "BackSelectableControl RT exception" );
     raise;
end BackSelectableControl;

procedure NextControl is
  -- Select the next control (wrap at bottom of table) that is on the
  -- screen.  The control is not necessarily active.  Used when user
  -- types tab key.
  -- GNAT 3.14 bug
  --ct : AControlTable renames Window( CurrentWindow ).table;
  -- NOTE: should probably have a "give up" variable for bad windows
begin
  if Window( CurrentWindow ).table.size = 0 then
     Window( CurrentWindow ).table.current := 0;
     return;
  end if;
  loop
     if Window( CurrentWindow ).table.current < Window( CurrentWindow ).table.size then
        Window( CurrentWindow ).table.current := Window( CurrentWindow ).table.current + 1;
        Window( CurrentWindow ).table.current := NextSelectableControl( Window( CurrentWindow ).table );
        HilightControl( Window( CurrentWindow ).table.control( Window( CurrentWindow ).table.current ) );
     else
        Window( CurrentWindow ).table.current := 1;
        Window( CurrentWindow ).table.Current := NextSelectableControl( Window( CurrentWindow ).table );
        HilightControl( Window( CurrentWindow ).table.control( Window( CurrentWindow ).table.current ) );
     end if;
  exit when insideRect( getFrame( Window( CurrentWindow ).table.control( Window( CurrentWindow ).table.current ).ptr.all ), Window( CurrentWindow ).Content );
  end loop;
  exception when others =>
     DrawErrLn;
     DrawErr( "NextControl RT exception" );
     raise;
end NextControl;

procedure BackControl is
  -- select the control before the current one (wrap at top of table).
  -- Used when the user types ctrl-t.
  -- GNAT 3.14 bug
  -- ct : AControlTable renames Window( CurrentWindow ).table;
begin
  if Window( CurrentWindow ).table.size = 0 then
     Window( CurrentWindow ).table.current := 0;
     return;
  end if;
  loop
    if Window( CurrentWindow ).table.current >= 2 then
       Window( CurrentWindow ).table.current := Window( CurrentWindow ).table.current - 1;
       Window( CurrentWindow ).table.current := BackSelectableControl( Window( CurrentWindow ).table );
       HilightControl( Window( CurrentWindow ).table.control( Window( CurrentWindow ).table.current ) );
    else
       Window( CurrentWindow ).table.current := Window( CurrentWindow ).table.size;
       Window( CurrentWindow ).table.current := BackSelectableControl( Window( CurrentWindow ).table );
       HilightControl( Window( CurrentWindow ).table.control( Window( CurrentWindow ).table.current ) );
    end if;
  exit when insideRect( getFrame( Window( CurrentWindow ).table.control( Window( CurrentWindow ).table.current ).ptr.all ), Window( CurrentWindow ).Content );
  end loop;
  exception when others =>
     DrawErrLn;
     DrawErr( "BackControl RT exception" );
     raise;
end BackControl;

procedure MoveToNextControl( ct : in out AControlTable ) is
  -- Move to next control, no hilight (wrap at bottom of table).  The
  -- control must be on the screen.
begin
  if ct.size = 0 then
     ct.current := 0;
     return;
  end if;
  loop
    if ct.current < ct.size then
       ct.current := ct.current + 1;
       ct.current := NextSelectableControl( ct );
    else
       ct.current := 1;
       ct.Current := NextSelectableControl( ct );
    end if;
    exit when insideRect( getFrame( ct.control( ct.current ).ptr.all ), Window( CurrentWindow ).Content );
  end loop;
  exception when others =>
     DrawErrLn;
     DrawErr( "MoveToNextControl RT exception" );
     raise;
end MoveToNextControl;

procedure NextControlUp is
  -- Move up vertically to next control, no hilight (wrap at bottom of
  -- table).  Used when user moves "up".  The control must be on the screen.
  -- GNAT 3.14 bug
  --ct : AControLTable renames Window( CurrentWindow ).table;
    Distance     : integer;
    Perpend      : integer;
    BestDistance : integer;
    BestPerpend  : integer;
    BestControl  : AControlNumber;
    ThisFrame    : ARect;
    CurrentFrame : ARect;
  begin
    CurrentFrame := GetFrame( Window( CurrentWindow ).table.control( Window( CurrentWindow ).table.current ).ptr.all );
    BestDistance := integer'last;
    BestPerpend  := integer'last;
    BestControl  := Window( CurrentWindow ).table.current;
    for c in 1..Window( CurrentWindow ).table.size loop
      if c /= Window( CurrentWindow ).table.current and GetStatus( Window( CurrentWindow ).table.control( c ).ptr.all )
         /= Off and
         insideRect( getFrame( Window( CurrentWindow ).table.control( Window( CurrentWindow ).table.current ).ptr.all ), Window( CurrentWindow ).Content ) then
         ThisFrame := GetFrame( Window( CurrentWindow ).table.control( c ).ptr.all );
         distance := CurrentFrame.Bottom - ThisFrame.Bottom;
         if Distance < 0 then
            Distance := 1000 + Distance; -- last resort, start from bottom
         end if;
         perpend := abs( ( ThisFrame.left +
                           ( ThisFrame.right - ThisFrame.left ) / 2 ) -
                         ( CurrentFrame.left +
                           ( CurrentFrame.right - CurrentFrame.left ) / 2 ) );
         if Distance /= 0 then
            if Perpend < BestPerpend or
               ( Perpend = BestPerpend and Distance < BestDistance ) then
            --if Distance < BestDistance or (Distance = BestDistance
            --   and Perpend < BestPerpend) then
               BestDistance := Distance;
               BestPerpend := Perpend;
               BestControl := c;
            end if;
         end if;
      end if;
    end loop;
    Window( CurrentWindow ).table.current := BestControl;
    exception when others =>
       DrawErrLn;
       DrawErr( "NextControlUp RT exception" );
       raise;
  end NextControlUp;

procedure NextControlDown is
  -- Move down vertically to next control, no hilight (wrap at bottom of
  -- table).  Used when user moves "down".  The control must be on the screen.
  -- GNAT 3.14 bug
  -- ct : AControLTable renames Window( CurrentWindow ).table;
  Distance     : integer;
  Perpend      : integer;
  BestDistance : integer;
  BestPerpend  : integer;
  BestControl  : AControlNumber;
  ThisFrame    : ARect;
  CurrentFrame : ARect;
begin
  CurrentFrame := GetFrame( Window( CurrentWindow ).table.control( Window( CurrentWindow ).table.current ).ptr.all );
  BestDistance := integer'last;
  BestPerpend  := integer'last;
  BestControl  := Window( CurrentWindow ).table.current;
  for c in 1..Window( CurrentWindow ).table.size loop
    if c /= Window( CurrentWindow ).table.current and GetStatus( Window( CurrentWindow ).table.control( c ).ptr.all )
       /= Off and
       insideRect( getFrame( Window( CurrentWindow ).table.control( Window( CurrentWindow ).table.current ).ptr.all ), Window( CurrentWindow ).Content ) then
       ThisFrame := GetFrame( Window( CurrentWindow ).table.control( c ).ptr.all );
       distance := ThisFrame.Top - CurrentFrame.Top;
       if Distance < 0 then
          Distance := 1000 + Distance; -- last resort, start from top
       end if;
       perpend := abs( ( ThisFrame.left +
                         ( ThisFrame.right - ThisFrame.left ) / 2 ) -
                       ( CurrentFrame.left +
                         ( CurrentFrame.right - CurrentFrame.left ) / 2 ) );
       if Distance /= 0 then
          if Perpend < BestPerpend or
             ( Perpend = BestPerpend and Distance < BestDistance ) then
          --if Distance < BestDistance or (Distance = BestDistance and
          --   Perpend < BestPerpend) then
             BestDistance := Distance;
             BestPerpend := Perpend;
             BestControl := c;
          end if;
       end if;
    end if;
  end loop;
  Window( CurrentWindow ).table.current := BestControl;
  exception when others =>
     DrawErrLn;
     DrawErr( "NextControlDown RT exception" );
     raise;
end NextControlDown;

procedure NextControlLeft is
  -- Move left horizontally to next control, no hilight (wrap at bottom of
  -- table).  Used when user moves "left".  The control must be on the screen.
  -- GNAT 3.14 bug
  -- ct : AControLTable renames Window( CurrentWindow ).table;
  Distance     : integer;
  Perpend      : integer;
  BestDistance : integer;
  BestPerpend  : integer;
  BestControl  : AControlNumber;
  ThisFrame    : ARect;
  CurrentFrame : ARect;
begin
  CurrentFrame := GetFrame( Window( CurrentWIndow ).table.control( Window( CurrentWIndow ).table.current ).ptr.all );
  BestDistance := integer'last;
  BestPerpend  := integer'last;
  BestControl  := Window( CurrentWIndow ).table.current;
  for c in 1..Window( CurrentWIndow ).table.size loop
    if c /= Window( CurrentWIndow ).table.current and GetStatus( Window( CurrentWindow ).table.control( c ).ptr.all )
       /= Off and
       insideRect( getFrame( Window( CurrentWindow ).table.control( Window( CurrentWindow ).table.current ).ptr.all ), Window( CurrentWindow ).Content ) then
       ThisFrame := GetFrame( Window( CurrentWindow ).table.control( c ).ptr.all );
       distance :=  CurrentFrame.Right - ThisFrame.Right;
       if Distance < 0 then
          Distance := 1000 + Distance; -- last resort, start from right
       end if;
       perpend := abs( ( ThisFrame.top +
                         ( ThisFrame.bottom - ThisFrame.top ) / 2 ) -
                       ( CurrentFrame.top +
                         ( CurrentFrame.bottom - CurrentFrame.top ) / 2 ) );
       if Distance /= 0 then
          if Perpend < BestPerpend or
             ( Perpend = BestPerpend and Distance < BestDistance ) then
          --if Distance < BestDistance or (Distance = BestDistance and
          --   Perpend < BestPerpend) then
             BestDistance := Distance;
             BestPerpend := Perpend;
             BestControl := c;
          end if;
       end if;
    end if;
  end loop;
  Window( CurrentWindow ).table.current := BestControl;
  exception when others =>
     DrawErrLn;
     DrawErr( "NextControlLeft RT exception" );
     raise;
end NextControlLeft;

procedure NextControlRight is
  -- Move right horizontally to next control, no hilight (wrap at bottom of
  -- table).  Used when user moves "right".  The control must be on the screen.
  -- GNAT 3.14 bug
  -- ct : AControLTable renames Window( CurrentWindow ).table;
  Distance     : integer;
  Perpend      : integer;
  BestDistance : integer;
  BestPerpend  : integer;
  BestControl  : AControlNumber;
  ThisFrame    : ARect;
  CurrentFrame : ARect;
begin
  CurrentFrame := GetFrame( Window( CurrentWindow ).table.control( Window( CurrentWindow ).table.current ).ptr.all );
  BestDistance := integer'last;
  BestPerpend  := integer'last;
  BestControl  := Window( CurrentWindow ).table.current;
  for c in 1..Window( CurrentWindow ).table.size loop
    if c /= Window( CurrentWindow ).table.current and GetStatus( Window( CurrentWindow ).table.control( c ).ptr.all )
       /= Off and
       insideRect( getFrame( Window( CurrentWindow ).table.control( Window( CurrentWindow ).table.current ).ptr.all ), Window( CurrentWindow ).Content ) then
       ThisFrame := GetFrame( Window( CurrentWindow ).table.control( c ).ptr.all );
       distance := ThisFrame.Left - CurrentFrame.Left;
       if Distance < 0 then
          Distance := 1000 + Distance; -- last resort, start from left
       end if;
       perpend := abs( ( ThisFrame.top +
                         ( ThisFrame.bottom - ThisFrame.top ) / 2 ) -
                       ( CurrentFrame.top +
                         ( CurrentFrame.bottom - CurrentFrame.top ) / 2 ) );
       if Distance /= 0 then
          if Perpend < BestPerpend or
             ( Perpend = BestPerpend and Distance < BestDistance ) then
          --if Distance < BestDistance or (Distance = BestDistance and
          --   Perpend < BestPerpend) then
             BestDistance := Distance;
             BestPerpend := Perpend;
             BestControl := c;
          end if;
       end if;
    end if;
  end loop;
  Window( CurrentWindow ).table.current := BestControl;
  exception when others =>
     DrawErrLn;
     DrawErr( "NextControlRight RT exception" );
     raise;
end NextControlRight;

procedure FirstControl is
  -- select the first control in the table.  The control must be on the
  -- screen.
  -- GNAT 3.14 bug
  -- ct : AControLTable renames Window( CurrentWindow ).table;
begin
  if Window( CurrentWindow ).table.size = 0 then
     Window( CurrentWindow ).table.current := 0;
  else
     Window( CurrentWindow ).table.current := 1;
     Window( CurrentWindow ).table.current := NextSelectableControl( Window( CurrentWindow ).table );
     HilightControl( Window( CurrentWindow ).table.control( Window( CurrentWindow ).table.current ) );
  end if;
  exception when others =>
     DrawErrLn;
     DrawErr( "FirstControl RT exception" );
     raise;
end FirstControl;

function ScanControls( ScanKey : character ) return boolean is
  -- Do a hot key search.  The control must be on the screen.
  -- GNAT 3.14 bug
  -- ct : AControlTable renames Window( CurrentWindow ).table;
  KeyToFind : character;

  function ScanControlsForKey return boolean is
    GiveUp : AControlNumber;
    ThisKey : character;
    NoMatch : boolean;
  begin
    GiveUp := Window( CurrentWindow ).table.current;
    loop
      ThisKey := GetHotKey( Window( CurrentWindow ).table.control( Window( CurrentWindow ).table.current ).ptr.all );
      if ThisKey /= NullKey then
         if ThisKey = KeyToFind then
            NoMatch := false;
            exit;
         end if;
      end if;
      MoveToNextControl( Window( CurrentWindow ).table );
      if Window( CurrentWindow ).table.current = GiveUp then
         NoMatch := true;
         exit;
      end if;
    end loop;
    if not NoMatch then
       HilightControl( Window( CurrentWindow ).table.control( Window( CurrentWindow ).table.current ) );
    end if;
    return not NoMatch;
  end ScanControlsForKey;

begin
  KeyToFind := ScanKey;
  if ScanControlsForKey then
     return true;
  else
     if KeyToFind >= 'a' and KeyToFind <= 'z' then
        KeyToFind := character'val( character'pos( KeyToFind ) - 32 );
        return ScanControlsForKey;
     elsif KeyToFind >= 'A' and KeyToFind <= 'Z' then
        KeyToFind := character'val( character'pos( KeyToFind ) + 32 );
        return ScanControlsForKey;
     end if;
  end if;
  return false;
  exception when others =>
     DrawErrLn;
     DrawErr( "ScanControls RT exception" );
     raise;
end ScanControls;

function CurrentControl return AControlNumber is
  -- Return a pointer to the active control
  -- GNAT 3.14 bug
  -- ct : AControlTable renames Window( CurrentWindow ).table;
begin
  return Window( CurrentWindow ).table.current;
end CurrentControl;

function FindClickedControl( dt : aDialogTaskRecord ) return boolean is
  -- find an active control that mouse was clicked in, if any
  -- GNAT 3.14 bug
  -- ct : AControlTable renames Window( CurrentWindow ).table;
  Found : boolean := false;
  OldCurrent : AControlNumber;
  Frame : aRect;
begin
  -- no controls in window?  nothing to detect
  if Window( CurrentWindow ).table.size = 0 then
     return false;
  end if;
  -- save old current so we know when we've checked every control
  OldCurrent := CurrentControl;
  loop
    Frame := GetFrame( Window( CurrentWindow ).table.control( CurrentControl ).ptr.all );
    if InRect( dt.InputRec.UpLocationX, dt.InputRec.UpLocationY,
       Frame ) then
         Found := true;
         exit;
    end if;
    -- this changes CurrentControl
     if Window( CurrentWindow ).table.current < Window( CurrentWindow ).table.size then
        Window( CurrentWindow ).table.current := Window( CurrentWindow ).table.current + 1;
     else
        Window( CurrentWindow ).table.current := 1;
     end if;
     Window( CurrentWindow ).table.current := NextSelectableControl( Window( CurrentWindow ).table );
    exit when CurrentControl = OldCurrent;
  end loop;
  HilightControl( Window( CurrentWindow ).table.control( Window( CurrentWindow ).table.current ) );
  return Found;
end FindClickedControl;

procedure FixRadioFamily( selectedButton : AControlNumber ) is
  -- For a radio button family, turn off all other radio buttons
  -- except for the selected radio button.  It does not select
  -- the selected button.  Radio buttons are redrawn if they are
  -- visible.
  -- GNAT 3.14 bug
  -- ct : AControlTable renames Window( CurrentWindow ).table;
  Target : integer;
begin
  WaitToReveal;
  Target :=GetFamily(ARadioButton(Window( CurrentWindow ).table.control(selectedButton).ptr.all));
  for c in 1..Window( CurrentWindow ).table.size loop
    if Window( CurrentWindow ).table.control(c).ptr.all in aRadioButton'class and then c /= selectedButton then
      if GetFamily( ARadioButton( Window( CurrentWindow ).table.control(c).ptr.all ) ) = Target then
         if GetCheck( ARadioButton( Window( CurrentWindow ).table.control(c).ptr.all ) ) then
            SetCheck( ARadioButton( Window( CurrentWindow ).table.control(c).ptr.all ), false );
            Invalid( Window( CurrentWindow ).table.control(c).ptr.all );

            if insideRect( getFrame( Window( CurrentWindow ).table.control( c ).ptr.all ), Window( CurrentWindow ).Content ) then
               Draw( ARadioButton( Window( CurrentWindow ).table.control(c).ptr.all ) );
            end if;
         end if;
      end if;
    end if;
  end loop;
  Reveal;
  exception when others =>
     DrawErrLn;
     DrawErr( "FixRadioFamily RT exception" );
     raise;
end FixRadioFamily;

procedure InvalidateControls( ThisWindow : AWindowNumber ) is
  -- Mark all controls in a window as invalid (needing to be redrawn).
begin
  for i in 1..Window( ThisWindow ).table.size loop
      Invalid( Window( ThisWindow ).table.control(i).ptr.all );
  end loop;
end InvalidateControls;


--- Clipboard for the Window Manager


procedure ClearClipboard is
  -- Clear contents of clipboard
begin
  if Clipboard /= null then
     Free( Clipboard );
     Clipboard := null;
  end if;
end ClearClipboard;

procedure NewClipboard( s : string ) is
  -- Add string data to clipboard
begin
  ClearClipboard;
  Clipboard := new ClipboardRec( StringData );
  Clipboard.all.s := To_Unbounded_String (S);
  exception when others =>
      StopAlert( "NewClipboard(s): RT Error" );
end NewClipboard;

procedure NewClipboard (sl : strList.Vector) is
-- Add string list data to clipboard
begin
  ClearClipboard;
  Clipboard := new ClipboardRec( ListData );
  Clipboard.all.l := sl;
  exception when others =>
      StopAlert( "NewClipboard(sl): RT Error" );
end NewClipboard;

procedure NewClipboard( i : integer ) is
-- Add integer data to clipboard
begin
  ClearClipboard;
  Clipboard := new ClipboardRec( IntegerData );
  Clipboard.all.i := i;
  exception when others =>
     StopAlert( "NewClipboard(i): RT Error" );
end NewClipboard;

procedure NewClipboard( b : boolean ) is
-- Add boolean data to clipboard
begin
  ClearClipboard;
  Clipboard := new ClipboardRec( BooleanData );
  Clipboard.all.b := boolean'pos(b);
  exception when constraint_error =>
     StopAlert( "NewClipboard(b): Constraint Error" );
  when others =>
     StopAlert( "NewClipboard(b): RT Error" );
end NewClipboard;

procedure LoadClipboard is
  -- Copy value from the current control into the window manager clipboard.
  -- Don't know if GNAT 3.14 bug affects this, but I'll expand it anyway
  --ctr : AControlTableRecord renames
  --      Window( CurrentWindow ).table.control( CurrentControl );
   Sl   : StrList.Vector;
begin
  if Window( CurrentWindow ).table.control( CurrentControl ).ptr.all in aThermometer then
       NewClipboard( GetValue( AThermometer( Window( CurrentWindow ).table.control( CurrentControl ).ptr.all ) ) );
  elsif Window( CurrentWindow ).table.control( CurrentControl ).ptr.all in aScrollBar then
       NewClipboard( GetThumb( AScrollBar( Window( CurrentWindow ).table.control( CurrentControl ).ptr.all ) ) );
  elsif Window( CurrentWindow ).table.control( CurrentControl ).ptr.all in aStaticLine then
       NewClipboard( GetText( AStaticLine( Window( CurrentWindow ).table.control( CurrentControl ).ptr.all ) ) );
  elsif Window( CurrentWindow ).table.control( CurrentControl ).ptr.all in anEditLine then
       NewClipboard( GetText( AnEditLine( Window( CurrentWindow ).table.control( CurrentControl ).ptr.all ) ) );
  elsif Window( CurrentWindow ).table.control( CurrentControl ).ptr.all in aCheckBox then
       NewClipboard( GetCheck( ACheckBox( Window( CurrentWindow ).table.control( CurrentControl ).ptr.all ) ) );
    elsif Window( CurrentWindow ).table.control( CurrentControl ).ptr.all in aRadioButton then
       NewClipboard( GetCheck( ARadioButton( Window( CurrentWindow ).table.control( CurrentControl ).ptr.all ) ) );
  elsif Window( CurrentWindow ).table.control( CurrentControl ).ptr.all in aSimpleButton then
       NewClipboard( GetText( ASimpleButton( Window( CurrentWindow ).table.control( CurrentControl ).ptr.all ) ) );
  elsif Window( CurrentWindow ).table.control( CurrentControl ).ptr.all in aRectangle then
     null;
  elsif Window( CurrentWindow ).table.control( CurrentControl ).ptr.all in aLine then
     null;
  elsif Window( CurrentWindow ).table.control( CurrentControl ).ptr.all in aWindowButton then
       NewClipboard( GetText( AWindowButton( Window( CurrentWindow ).table.control( CurrentControl ).ptr.all ) ) );
  elsif Window( CurrentWindow ).table.control( CurrentControl ).ptr.all in aStaticLine then
       if GetMark( AStaticList( Window( CurrentWindow ).table.control( CurrentControl ).ptr.all ) ) < 0 then
	  NewClipboard (CopyLine (AStaticList (Window (CurrentWindow).table.Control (CurrentControl).ptr.all)));
       else
          CopyLines( AStaticList( Window( CurrentWindow ).table.control( CurrentControl ).ptr.all ),
             GetCurrent( AStaticList( Window( CurrentWindow ).table.control( CurrentControl ).ptr.all ) ), sl );
          NewClipboard( sl );
       end if;
  elsif Window( CurrentWindow ).table.control( CurrentControl ).ptr.all in aCheckList then
       if GetMark( ACheckList( Window( CurrentWindow ).table.control( CurrentControl ).ptr.all ) ) < 0 then
	  NewClipboard (CopyLine (AcheckList (Window (CurrentWindow).table.Control (CurrentControl).ptr.all)));
       else
          CopyLines( ACheckList( Window( CurrentWindow ).table.control( CurrentControl ).ptr.all ),
             GetCurrent( ACheckList( Window( CurrentWindow ).table.control( CurrentControl ).ptr.all ) ), sl );
          NewClipboard( sl );
       end if;
  elsif Window( CurrentWindow ).table.control( CurrentControl ).ptr.all in aRadioList then
       if GetMark( ARadioList( Window( CurrentWindow ).table.control( CurrentControl ).ptr.all ) ) < 0 then
	  NewClipboard (CopyLine (ARadioList (Window (CurrentWindow).table.Control (CurrentControl).ptr.all)));
       else
          CopyLines( ARadioList( Window( CurrentWindow ).table.control( CurrentControl ).ptr.all ),
             GetCurrent( ARadioList( Window( CurrentWindow ).table.control( CurrentControl ).ptr.all ) ), sl );
          NewClipboard( sl );
       end if;
    elsif Window( CurrentWindow ).table.control( CurrentControl ).ptr.all in anEditList then
       if GetMark( AnEditList( Window( CurrentWindow ).table.control( CurrentControl ).ptr.all ) ) < 0 then
	  NewClipboard (CopyLine (AnEditList (Window (CurrentWindow).table.Control (CurrentControl).ptr.all)));
       else
          CopyLines( AnEditList( Window( CurrentWindow ).table.control( CurrentControl ).ptr.all ),
             GetCurrent( AnEditList( Window( CurrentWindow ).table.control( CurrentControl ).ptr.all ) ), sl );
          NewClipboard( sl );
       end if;
    elsif Window( CurrentWindow ).table.control( CurrentControl ).ptr.all in aTreeList then
       if GetMark( ATreeList( Window( CurrentWindow ).table.control( CurrentControl ).ptr.all ) ) < 0 then
	  NewClipboard (CopyLine (ATreeList (Window (CurrentWindow).table.Control (CurrentControl).ptr.all)));
       else
          CopyLines( ATreeList( Window( CurrentWindow ).table.control( CurrentControl ).ptr.all ),
             GetCurrent( ATreeList( Window( CurrentWindow ).table.control( CurrentControl ).ptr.all ) ), sl );
          NewClipboard( sl );
       end if;
  elsif Window( CurrentWindow ).table.control( CurrentControl ).ptr.all in aSourceEditList then
       if GetMark( ASourceEditList( Window( CurrentWindow ).table.control( CurrentControl ).ptr.all ) ) < 0 then
	  NewClipboard (CopyLine (ASourceEditList (Window (CurrentWindow).table.Control (CurrentControl).ptr.all)));
       else
          CopyLines( ASourceEditList( Window( CurrentWindow ).table.control( CurrentControl ).ptr.all ),
             GetCurrent( ASourceEditList( Window( CurrentWindow ).table.control( CurrentControl ).ptr.all ) ), sl );
            NewClipboard( sl );
       end if;
  else
       SessionLog( "LoadClipboard: Unknown control type" );
  end if;
  exception when others =>
     DrawErrLn;
     DrawErr( "LoadClipboard RT exception" );
     raise;
end LoadClipboard;

procedure PasteClipboard is
  -- Copy the value in the window manager clipboard into the current
  -- control.

    procedure PasteTypeError is
      -- show a warning for pasting invalid data for a control
    begin
      case Clipboard.all.DataType is
      when IntegerData =>
           CautionAlert( "Can't paste numbers here" );
      when StringData =>
           CautionAlert( "Can't paste text here" );
      when BooleanData =>
           CautionAlert( "Can't paste checks here" );
      when others =>
           StopAlert( "Can't paste this kind of info" );
      end case;
  end PasteTypeError;

    -- GNAT 3.14 bug maybe
    --ctr : AControlTableRecord renames
    --      Window( CurrentWindow ).table.control( CurrentControl );

begin
  if Window( CurrentWindow ).table.control( CurrentControl ).ptr.all in aThermometer then
       if Clipboard /= null and then Clipboard.all.DataType = IntegerData then
          SetValue( AThermometer( Window( CurrentWindow ).table.control( CurrentControl ).ptr.all ), Clipboard.all.i );
       else
          PasteTypeError;
       end if;
  elsif Window( CurrentWindow ).table.control( CurrentControl ).ptr.all in aScrollBar then
       if Clipboard /= null and then Clipboard.all.DataType = IntegerData then
          SetThumb( AScrollBar( Window( CurrentWindow ).table.control( CurrentControl ).ptr.all ), Clipboard.all.i );
       else
          PasteTypeError;
       end if;
  elsif Window( CurrentWindow ).table.control( CurrentControl ).ptr.all in aStaticLine then
       if Clipboard /= null and then Clipboard.all.DataType = StringData then
          SetText( AStaticLine( Window( CurrentWindow ).table.control( CurrentControl ).ptr.all ), To_String (Clipboard.all.S) );
       else
          PasteTypeError;
       end if;
  elsif Window( CurrentWindow ).table.control( CurrentControl ).ptr.all in anEditLine then
       if Clipboard /= null then
          if Clipboard.all.DataType = StringData then
             SetText( AnEditLine( Window( CurrentWindow ).table.control( CurrentControl ).ptr.all ), To_String (Clipboard.all.S) );
          elsif Clipboard.all.DataType = IntegerData then
             SetText( AnEditLine( Window( CurrentWindow ).table.control( CurrentControl ).ptr.all ), integer'image( Clipboard.all.i ));
          else
             PasteTypeError;
          end if;
       end if;
  elsif Window( CurrentWindow ).table.control( CurrentControl ).ptr.all in aCheckBox then
       if Clipboard /= null and then Clipboard.all.DataType = BooleanData then
          SetCheck( ACheckBox( Window( CurrentWindow ).table.control( CurrentControl ).ptr.all ), boolean'val( Clipboard.all.b ) );
       else
          PasteTypeError;
       end if;
  elsif Window( CurrentWindow ).table.control( CurrentControl ).ptr.all in aRadioButton then
       if Clipboard /= null and then Clipboard.all.DataType = BooleanData then
          SetCheck( ARadioButton( Window( CurrentWindow ).table.control( CurrentControl ).ptr.all ), boolean'val( Clipboard.all.b ) );
          FixRadioFamily( CurrentControl );
       else
          PasteTypeError;
       end if;
  elsif Window( CurrentWindow ).table.control( CurrentControl ).ptr.all in aSimpleButton then
       null;
  elsif Window( CurrentWindow ).table.control( CurrentControl ).ptr.all in aRectangle then
       null;
  elsif Window( CurrentWindow ).table.control( CurrentControl ).ptr.all in aLine then
       null;
  elsif Window( CurrentWindow ).table.control( CurrentControl ).ptr.all in aWindowButton then
       null;
  elsif Window( CurrentWindow ).table.control( CurrentControl ).ptr.all in aStaticList then
       null;
  elsif Window( CurrentWindow ).table.control( CurrentControl ).ptr.all in aCheckList then
       null;
  elsif Window( CurrentWindow ).table.control( CurrentControl ).ptr.all in aRadioList then
       null;
  elsif Window( CurrentWindow ).table.control( CurrentControl ).ptr.all in aTreeList then
       null;
  elsif Window( CurrentWindow ).table.control( CurrentControl ).ptr.all in anEditList then
       if Clipboard /= null then
          if Clipboard.all.DataType = StringData then
             PasteLine( AnEditList( Window( CurrentWindow ).table.control( CurrentControl ).ptr.all ), To_String (Clipboard.all.S) );
          elsif Clipboard.all.DataType = IntegerData then
             PasteLine( AnEditList( Window( CurrentWindow ).table.control( CurrentControl ).ptr.all ), integer'image( Clipboard.all.i ) );
          elsif Clipboard.all.DataType = ListData then
             PasteLines( AnEditList( Window( CurrentWindow ).table.control( CurrentControl ).ptr.all ), Clipboard.all.l );
          else
             PasteTypeError;
          end if;
       end if;
       Invalid( Window( CurrentWindow ).table.control( CurrentControl ).ptr.all );
       Touch( AnEditList( Window( CurrentWindow ).table.control( CurrentControl ).ptr.all ) );
  elsif Window( CurrentWindow ).table.control( CurrentControl ).ptr.all in aSourceEditList then
       if Clipboard /= null then
          if Clipboard.all.DataType = StringData then
             PasteLine( AnEditList( Window( CurrentWindow ).table.control( CurrentControl ).ptr.all ), To_String (Clipboard.all.S) );
          elsif Clipboard.all.DataType = IntegerData then
             PasteLine( AnEditList( Window( CurrentWindow ).table.control( CurrentControl ).ptr.all ), integer'image( Clipboard.all.i ) );
          elsif Clipboard.all.DataType = ListData then
             PasteLines( AnEditList( Window( CurrentWindow ).table.control( CurrentControl ).ptr.all ), Clipboard.all.l );
          else
             PasteTypeError;
          end if;
       end if;
       Invalid( Window( CurrentWindow ).table.control( CurrentControl ).ptr.all );
       Touch( AnEditList( Window( CurrentWindow ).table.control( CurrentControl ).ptr.all ) );
  else
     null;
  end if;
  exception when others =>
     DrawErrLn;
     DrawErr( "PasteClipboard RT exception" );
     raise;
end PasteClipboard;

procedure DoDialog( DialogTask : in out ADialogTaskRecord;
                    TaskCB : in ADialogTaskCallBack := null;
                    HearInCB : in ADialogTaskCallBack := null;
                    HearOutCB : in ADialogTaskCallBack := null ) is
   use Ada.Calendar;
   --
-- This is the dialog manager.  This procedure handles input in the
-- current window and returns events for the application to handle.
-- Its duties include:
--  * displaying the clock on the screen
--  * ringing the chime every 15
--  * invoking the idle tasks for the other packages
--  * the accessories window
--  * following window button links
--  * handling interaction between scroll bars / thermometers & boxes)
--  * handling hot keys
--  * handling cut/copy/paste, screen redraw key, etc.
-- An application spends most of its time here.
--
   cp                 : AControlPtr;  -- just a control pointer
   MovedToNewControl  : boolean;      -- true if scancontrols was successful
   table              : AControlTable renames Window(CurrentWindow).table;
   LoopTime           : Time; -- time input loop was started
   IdleMark           : Time; -- for idle tasks
   IdleTime           : Duration; -- for idle tasks
   -- Chime
   ChimeMark          : Time; -- time clock was last check for chime
   -- ChimeSkipMinutes is global (ie across all executions of DoDialog)
   Minutes            : Formatting.Minute_Number;
   
   procedure ShowAccessoriesWindow is
     -- Show the pop-up desk accessories window

     dialogWindow  : AWindowNumber;   -- last window
     dialogControl : AControlNumber;  -- last active control
     pragma Unreferenced (DialogWindow, Dialogcontrol);
     item          : AControlNumber;
     width         : constant integer := 20; -- content dimensions of our window
     height        : constant integer := 5;
     DialogTask : ADialogTaskRecord;

     procedure ShowCalendar is
	-- The Calendar desk accessor
	Y : constant String := Year_Number'Image (Year (Clock));
	CalList  : StrList.Vector;
     begin
	Runit ("/usr/bin/cal", "-y", Y, Results => Callist);
	CalList.Append ("Today is " & Formatting.Image (Clock));
	ShowListInfo( "Calendar for" & Y, 0, 1, 79, 24, CalList );
	pragma Unreferenced (Callist);
     end ShowCalendar;
     
     procedure ShowNotepad is
       -- Notepad desk accessory

       NotePadSave : StrList.Vector;
       SaveChanges : boolean;
     begin
        NotePadSave := Notepaddata;
        EditListInfo( "Notepad", 0, 1, 79, 24, NotePadData, SaveChanges );
       if not SaveChanges then
          Notepaddata := NotePadSave;
       end if;
     end ShowNotePad;

   begin
     dialogWindow := CurrentWindow;
     dialogControl := CurrentControl;
     OpenWindow(  "Accessories Menu", 2, 2, width + 1 + 2, height + 1 + 2 );
     SharedButton( Shared.Button1, 2, 2, 7, 2, 'o', s_OK );
     SharedButton( Shared.Button2, 2, 3, 13, 3, 'c', "Calendar");
     SharedButton( Shared.Button3, 2, 4, 13, 4, 'n', "Notepad");
     DialogTask.control := 1;
     DoDialog( DialogTask ); -- recursion here
     item := DialogTask.Control;
     if item = 2 then
        ShowCalendar;
     elsif item = 3 then
        ShowNotepad;
     end if;
     CloseWindow;
     HilightControl(  Window( CurrentWindow ).table.control(CurrentControl));
   end ShowAccessoriesWindow;

   function DoFollowLink return AControlNumber is
     -- For a window button, load the new window indicated
     -- by the window button or launch an application (lynx) to
     -- display the web page/etc.  Returns control hit, or 0.

     wb : AWindowButton renames AWindowButton(
          Window( CurrentWindow ).Table.control( CurrentControl ).ptr.all );
     link : constant String := GetLink( wb );
     DT : ADialogTaskRecord;
   begin
     if Ada.Strings.Fixed.Head (Link, 9) = "window://" then
        LoadWindow( Ada.Strings.Fixed.Tail (Link, Link'Length - 10));
        NoteAlert( link );     -- testing
        DoDialog( DT ); -- recursion here;
        NoteAlert( "Closing autowindow" ); -- testing
        CloseWindow;
        return DT.control;
     elsif Ada.Strings.Fixed.Head (Link, 6) = "http:/" then
        SessionLog( "DoFollowLink: following " & link );
        ShellOut( "lynx " & link );
        return 0;
     elsif Ada.Strings.Fixed.Head (Link, 6) = "file:/" then
        SessionLog( "DoFollowLink: following " & link );
        ShellOut( "lynx " & link );
        return 0;
     elsif Ada.Strings.Fixed.Head (link, 7 ) = "unix://" then
        SessionLog( "DoFollowLink: following " & link );
        ShellOut( Ada.Strings.Fixed.Tail (Link, Link'Length - 8) );
        return 0;
     else
        StopAlert( "DoFollowLink: Can't follow this type" );
        return 0;
     end if;
     exception
     when Status_Error =>
        NoteAlert( "DoFollowLink: " & Link & " open" );
        return 0;
     when Use_Error =>
        NoteAlert( "DoFollowLink: Use error" );
        return 0;
     when Name_Error =>
        NoteAlert( "DoFollowLink: " & Link & " not found" );
        return 0;
     when others =>
        NoteAlert( "DoFollowLink: Unable to load " & Link);
        return 0;
   end DoFollowLink;

   procedure AdjustScrollBar is
     -- Fix a scroll bar or thermometer to accurately reflect a list
     -- control's position.  The list control must be the current control.
     -- If the bar/thermometer is on the screen, it will be redrawn.

     sb  : AControlNumber;
     psn : Natural;
     max : integer;
     list: AControlTableRecord renames Table.Control( CurrentControl );
   begin
     if Table.Control( CurrentControl ).ptr.all in aStaticList then
        sb := GetScrollBar( AStaticList( list.ptr.all ) );
        psn:= GetCurrent( AStaticList( list.ptr.all ) ) - 1;
        max:= GetLength( AStaticList( list.ptr.all ) );
     elsif Table.Control( CurrentControl ).ptr.all in aCheckList then
        sb := GetScrollBar( ACheckList( list.ptr.all ) );
        psn:= GetCurrent( ACheckList( list.ptr.all ) ) - 1;
        max:= GetLength( ACheckList( list.ptr.all ) );
     elsif Table.Control( CurrentControl ).ptr.all in aRadioList then
        sb := GetScrollBar( ARadioList( list.ptr.all ) );
        psn:= GetCurrent( ARadioList( list.ptr.all ) ) - 1;
        max:= GetLength( ARadioList( list.ptr.all ) );
     elsif Table.Control( CurrentControl ).ptr.all in anEditList then
        sb  := GetScrollBar( AnEditList( list.ptr.all ) );
        psn := GetCurrent( AnEditList( list.ptr.all ) );
        max := GetLength( AnEditList( list.ptr.all ) );
     elsif Table.Control( CurrentControl ).ptr.all in aTreeList then
        sb  := GetScrollBar( ATreeList( list.ptr.all ) );
        psn := GetCurrent( ATreeList( list.ptr.all ) );
        max := GetLength( ATreeList( list.ptr.all ) );
     elsif Table.Control( CurrentControl ).ptr.all in aSourceEditList then
        sb  := GetScrollBar( ASourceEditList( list.ptr.all ) );
        psn := GetCurrent( ASourceEditList( list.ptr.all ) );
        max := GetLength( ASourceEditList( list.ptr.all ) );
     else
        StopAlert( "AdjustScrollBar: unknown control type" );
     end if;
     if sb /= 0 then
        if Table.Control( sb ).ptr.all in aScrollBar then
           if GetMax( AScrollBar( Table.Control( sb ).ptr.all ) ) /= max then
              SetMax( AScrollBar( Table.Control( sb ).ptr.all ), max );
           end if;
           SetThumb( AScrollBar( Table.Control( sb ).ptr.all ), psn);
           UnhilightControl( list );
           if insideRect( getFrame( Window( CurrentWindow ).table.control( sb ).ptr.all ), Window( CurrentWindow ).Content ) then
              Draw( Table.Control( sb ).ptr.all );
           end if;
           HilightControl( list );
        elsif Table.Control( sb ).ptr.all in aThermometer then
           if GetMax( AThermometer( Table.Control( sb ).ptr.all ) ) /= max then
              SetMax( AThermometer( Table.Control( sb ).ptr.all ), max );
           end if;
           SetValue( AThermometer( Table.Control( sb ).ptr.all ), psn);
           if insideRect( getFrame( Window( CurrentWindow ).table.control( sb ).ptr.all ), Window( CurrentWindow ).Content ) then
              Draw( Table.Control( sb ).ptr.all );
           end if;
        else
           StopAlert( "AdjustScrollBar: Control not a scroll bar or therm" );
        end if;
     end if;
     exception when others => DrawErrLn;
                              DrawErr("AdjustScrollBar: RT error");
                              raise;
   end AdjustScrollBar;

   procedure AdjustListControl is
     -- Fix a list control so its current position is updated to
     -- reflect an associated scroll bar or thermometer.  The list
     -- is redrawn if it is on the screen.

     list: AControlNumber;
     psn : integer;
     max : integer;
     len : Natural;
     sb  : AControlTableRecord renames Table.Control( CurrentControl );
   begin
     if Table.Control( CurrentControl ).ptr.all in aScrollBar then
        list := GetOwner( AScrollBar( sb.ptr.all ) );
        psn  := GetThumb( AScrollBar( sb.ptr.all ) ) + 1;
        max  := GetMax( AScrollBar( sb.ptr.all ) );
     else
        StopAlert( "AdjustListControl: not a scroll bar" );
     end if;
     if list /= 0 then
        if Table.Control( list ).ptr.all in aStaticList then
           len := GetLength( AStaticList( Table.Control( list ).ptr.all ) );
           SetOrigin( AStaticList( Table.Control( list ).ptr.all ), len * psn / max );
           if insideRect( getFrame( Window( CurrentWindow ).table.control( currentControl ).ptr.all ), Window( CurrentWindow ).Content ) then
              UnhilightControl( sb );
              Draw( Table.Control( list ).ptr.all );
              HilightControl( sb );
           end if;
        elsif Table.Control( list ).ptr.all in aCheckList then
           len := GetLength( ACheckList( Table.Control( list ).ptr.all ) );
           SetOrigin( ACheckList( Table.Control( list ).ptr.all ), len * psn / max );
           if insideRect( getFrame( Window( CurrentWindow ).table.control( currentControl ).ptr.all ), Window( CurrentWindow ).Content ) then
              UnhilightControl( sb );
              Draw( Table.Control( list ).ptr.all );
              HilightControl( sb );
           end if;
        elsif Table.Control( list ).ptr.all in aRadioList then
           len := GetLength( ARadioList( Table.Control( list ).ptr.all ) );
           SetOrigin( ARadioList( Table.Control( list ).ptr.all ), len * psn / max );
           if insideRect( getFrame( Window( CurrentWindow ).table.control( currentControl ).ptr.all ), Window( CurrentWindow ).Content ) then
              UnhilightControl( sb );
              Draw( Table.Control( list ).ptr.all );
              HilightControl( sb );
           end if;
        elsif Table.Control( list ).ptr.all in anEditList then
           len := GetLength( AnEditList( Table.Control( list ).ptr.all ) );
           SetOrigin( AnEditList( Table.Control( list ).ptr.all ), len * psn / max );
           if insideRect( getFrame( Window( CurrentWindow ).table.control( currentControl ).ptr.all ), Window( CurrentWindow ).Content ) then
              UnhilightControl( sb );
              Draw( Table.Control( list ).ptr.all );
              HilightControl( sb );
           end if;
        elsif Table.Control( list ).ptr.all in aTreeList then
           len := GetLength( ATreeList( Table.Control( list ).ptr.all ) );
           SetOrigin( ATreeList( Table.Control( list ).ptr.all ), len * psn / max );
           if insideRect( getFrame( Window( CurrentWindow ).table.control( currentControl ).ptr.all ), Window( CurrentWindow ).Content ) then
              UnhilightControl( sb );
              Draw( Table.Control( list ).ptr.all );
              HilightControl( sb );
           end if;
        elsif Table.Control( list ).ptr.all in aSourceEditList then
           len := GetLength( ASourceEditList( Table.Control( list ).ptr.all ) );
           SetOrigin( ASourceEditList( Table.Control( list ).ptr.all ), len * psn / max );
           if insideRect( getFrame( Window( CurrentWindow ).table.control( currentControl ).ptr.all ), Window( CurrentWindow ).Content ) then
              UnhilightControl( sb );
              Draw( Table.Control( list ).ptr.all );
              HilightControl( sb );
           end if;
        else
           StopAlert( "AdjustListControl: Control not a List" );
        end if;
     end if;
    exception when others => DrawErrLn;
                             DrawErr("AdjustListControl: RT error ");
                             raise;
  end AdjustListControl;

   procedure AdjustMyScrollBars is
   begin
     if Table.Control( CurrentControl ).ptr.all in aScrollBar then
        AdjustListControl;
     elsif Table.Control( CurrentControl ).ptr.all in aStaticList then
        AdjustScrollBar;
     elsif Table.Control( CurrentControl ).ptr.all in aCheckList then
        AdjustScrollBar;
     elsif Table.Control( CurrentControl ).ptr.all in aRadioList then
        AdjustScrollBar;
     elsif Table.Control( CurrentControl ).ptr.all in anEditList then
        AdjustScrollBar;
     elsif Table.Control( CurrentControl ).ptr.all in aTreeList then
        AdjustScrollBar;
     elsif Table.Control( CurrentControl ).ptr.all in aSourceEditList then
        AdjustScrollBar;
     else
        null;
     end if;
   end AdjustMyScrollBars;


  function DoStandardActions return boolean is
  -- handle standard actions return from a control's Hear
  -- call
    exitloop : boolean := false; -- true if exit event loop
  begin
    case DialogTask.Action is
    when Next     =>
         UnhilightControl( Table.Control( CurrentControl ) );
         NextControl;
         HilightControl( Table.Control( CurrentControl ) );
    when Back     =>
         UnhilightControl( Table.Control( CurrentControl ) );
         BackControl;
         HilightControl( Table.Control( CurrentControl ) );
    when Up =>
         UnhilightControl( Table.Control( CurrentControl ) );
         NextControlUp;
         HilightControl( Table.Control( CurrentControl ) );
    when Down =>
         UnhilightControl( Table.Control( CurrentControl ) );
         NextControlDown;
         HilightControl( Table.Control( CurrentControl ) );
    when Left =>
         UnhilightControl( Table.Control( CurrentControl ) );
         NextControlLeft;
         HilightControl( Table.Control( CurrentControl ) );
    when Right =>
         UnhilightControl( Table.Control( CurrentControl ) );
         NextControlRight;
         HilightControl( Table.Control( CurrentControl ) );
    when Complete =>
         DialogTask.MyTask := Complete;
         DialogTask.Control := CurrentControl;
         --- inputrec and action already filled
         exitloop := true;
    when ScanNext =>
         UnhilightControl( Table.Control( CurrentControl ) );
         MovedToNewControl := ScanControls( DialogTask.InputRec.Key );
         HilightControl( Table.Control( CurrentControl ) );
         -- if moved to a different control, check for a button
         -- and if it's instant, give it a return key to activate
         -- it.
         if MovedToNewControl then
         if Table.Control( CurrentControl ).ptr.all in aSimpleButton then
            if GetInstant( ASimpleButton( Table.Control( CurrentControl ).ptr.all ) ) then
               declare
                  fakeInput : AnInputRecord (KeyInput);
               begin
                  fakeInput.key := ReturnKey;
                  Hear( Table.Control( CurrentControl ).ptr.all, fakeInput, DialogTask.action );
               end;
               DialogTask.MyTask := Complete;
               DialogTask.Control := CurrentControl;
               exitloop := true;
            end if;
         elsif Table.Control( CurrentControl ).ptr.all in aWindowButton then
            if GetInstant( AWindowButton( Table.Control( CurrentControl ).ptr.all ) ) then
               declare
                  fakeInput : AnInputRecord (KeyInput);
               begin
                  fakeInput.key := ReturnKey;
                  Hear( Table.Control( CurrentControl ).ptr.all, fakeInput, DialogTask.action );
               end;
               -- handle instant follow links here since it won't make it
               -- around again after top of loop.  Normal follow links
               -- will hit the "when FollowLink" case.
               if DialogTask.action = FollowLink then
                  SetControlHit( AWindowButton( cp.all ), DoFollowLink );
                  --DialogTask.Action := none;
               end if;
             end if;
         end if;
         end if; --b
    when FollowLink =>
            SetControlHit( AWindowButton( cp.all ), DoFollowLink );
    when None     =>
         if Table.Control( CurrentControl ).mine then
            AdjustMyScrollBars;
         else
            DialogTask.MyTask := Hit;
            DialogTask.Control := CurrentControl;
            -- InputRec and Action already filled
            if TaskCB /= null then
               TaskCB.all( DialogTask );
            else
               DialogTask.MyTask := DialogError;
               Error( TT_NoDialogTaskCB );
               exitloop := true;
            end if;
         end if;
    when others   =>
         DrawErr ("DoDialog: unabled to handle control result");
         DrawErrLn;
    end case;
    return exitloop;
  end DoStandardActions;

  procedure DrawTime( timestr : in string ) is
    -- draw time in bottom-right of screen, but don't lose
    -- current cursor position or pen attributes
    OldX, OldY : integer;
    OldColour : APenColourName;
    OldStyle  : ATextStyle;
  begin
    GetPenPos( OldX, OldY );
    OldColour := GetPenColour;
    OldStyle  := GetTextStyle;
    SetTextStyle( Footnote );
    SetPenColour( outline );
    MoveToGlobal( DisplayInfo.H_Res-7, DisplayInfo.V_Res-1 );
    Draw( Ada.Strings.Fixed.Head (TimeStr, 5) );  -- show "hh:mm"
    MoveToGlobal( OldX, OldY );
    SetPenColour( OldColour );
    SetTextStyle( OldStyle );
  end DrawTime;
  
  use Ada.Containers;
 begin -- DoDialog

   NoError;
   DialogTask.MyTask := None;
   DialogTask.Action := None;
   if length( Window( CurrentWindow ).Title ) > 0 then
      SessionLog( "DoDialog: Dialog for window called '" &
		    To_String (Window( CurrentWindow ).Title) & "'" );
   else
      SessionLog( "DoDialog: Running dialog for untitled window" );
   end if;
   if Window( CurrentWindow ).table.size = 0 then
      DialogTask.MyTask := DialogError;
      DialogTask.control := AControlNumber'First;
      Error( TT_NoControls );
      return;
   end if;

   DrawControls;
   FirstControl;
   HilightControl( Table.Control( CurrentControl ) );
   IdleMark := Clock;
   ChimeMark := Clock;

   loop
      LoopTime := Clock;
      -- Hour and Quarterly Chimes
      if LoopTime - ChimeMark > 15.0 then -- check every 15 seconds
         ChimeMark := LoopTime;               -- update the chime mark
	 Minutes := Formatting.Minute (Clock);
         DrawTime (Formatting.Image (Clock));
         if Minutes /= ChimeSkipMinutes then  -- already chimed this min?
            if Minutes = 0 then            -- if not, 00 is hour chime
               Beep( HourChime );             -- etc.
               ChimeSkipMinutes := Minutes;
            elsif Minutes = 15 then
               Beep( QuarterChime1 );
               ChimeSkipMinutes := Minutes;
            elsif Minutes = 30 then
               Beep( QuarterChime2 );
               ChimeSkipMinutes := Minutes;
            elsif Minutes = 45 then
               Beep( QuarterChime3 );
               ChimeSkipMinutes := Minutes;
            end if;
         end if;
      end if;
      GetInput( DialogTask.InputRec, Response => Erratic );
      if DialogTask.InputRec.InputType = NullInput then
         IdleTime := LoopTime - IdleMark;
         if IdleTime > 30.0 then -- 30 seconds of null activity?
            IdleCommon (IdleTime);
            IdleOS( IdleTime );
            IdleUserIO( IdleTime );
            IdleControls( IdleTime );
            IdleWindows( IdleTime );
         end if;
         if Window( CurrentWindow ).Timeout > 0.0 then
            if IdleTime > Window( CurrentWindow ).Timeout then
               SessionLog ("DoDialog: Time out after"
                             & Duration'Image (Window (CurrentWindow).Timeout)
                             & " second(s).");
               UnhilightControl( Table.Control( CurrentControl ) );
               Table.current := Window( CurrentWindow ).TimeoutControl;
               HilightControl( Table.Control( CurrentControl ) );
               SetInputString (" ");
            end if;
         end if;
      else
         IdleMark := LoopTime; -- return secs
      end if;
      --
      -- Intercept Dialog Input
      --
      if DialogTask.InputRec.InputType = KeyInput then
         case DialogTask.InputRec.Key is
         when TabKey => UnhilightControl( Table.Control( CurrentControl ) );
                        NextControl;
                        HilightControl( Table.Control( CurrentControl ) );
         when BackKey => UnhilightControl( Table.Control( CurrentControl ) );
                         BackControl;
                         HilightControl( Table.Control( CurrentControl ) );
         when HelpKey => ShowAccessoriesWindow;
         when CopyKey => LoadClipboard;
	    if Clipboard.all.DataType = ListData
	      and then Clipboard.all.L.Length > 1 then
                             if Window( CurrentWindow ).HasInfoBar then
                                Window( CurrentWindow ).InfoText := To_Unbounded_String
				  ("Coped" & Count_Type'Image (Clipboard.all.L.Length) & " lines");
                                DrawInfo( CurrentWIndow );
                             end if;
                          end if;
         when PasteKey => PasteClipboard;
                          DrawControls;
                          HilightControl( Table.Control( CurrentControl ) );
                          if Clipboard.all.DataType = ListData
			    and then Clipboard.all.L.Length > 1 then
                              if Window( CurrentWindow ).HasInfoBar then
                                 Window( CurrentWindow ).InfoText := To_Unbounded_String
				   ( "Pasted" & Count_Type'Image (Clipboard.all.L.Length) & " lines" );
                                 DrawInfo( CurrentWIndow );
                              end if;
                          end if;
                          if Table.Control( CurrentControl ).mine then
                             AdjustMyScrollBars;
                          end if;
         when RedrawKey => RefreshDesktop;
                          HilightControl( Table.Control( CurrentControl ) );
                          SessionLog( "DoDialog: User refreshed screen" );
         when MarkKey =>
            declare
               cp : AControlPtr renames Table.Control( CurrentControl ).ptr;
            begin
            if Table.Control( CurrentControl ).ptr.all in aStaticList then
               if GetCurrent( AStaticList( cp.all ) ) =
                  GetMark( AStaticList( cp.all ) ) then
                  SetMark( AStaticList( cp.all ), -1 );
               else
                  SetMark( AStaticList( cp.all ),
                     GetCurrent( AStaticList( cp.all ) ) );
               end if;
               Draw( AStaticList( cp.all ) );
            elsif Table.Control( CurrentControl ).ptr.all in aRadioList then
               if GetCurrent( ARadioList( cp.all ) ) =
                  GetMark( ARadioList( cp.all ) ) then
                     SetMark( ARadioList( cp.all ), -1 );
               else
                  SetMark( ARadioList( cp.all ),
                  GetCurrent( ARadioList( cp.all ) ) );
               end if;
               Draw( ARadioList( cp.all ) );
             elsif Table.Control( CurrentControl ).ptr.all in anEditList then
               if GetCurrent( AnEditList( cp.all ) ) =
                  GetMark( AnEditList( cp.all ) ) then
                  SetMark( AnEditList( cp.all ), -1 );
               else
                  SetMark( AnEditList( cp.all ),
                  GetCurrent( AnEditList( cp.all ) ) );
               end if;
               Draw( AnEditList( cp.all ) );
             elsif Table.Control( CurrentControl ).ptr.all in aTreeList then
               if GetCurrent( ATreeList( cp.all ) ) =
                  GetMark( ATreeList( cp.all ) ) then
                  SetMark( ATreeList( cp.all ), -1 );
               else
                  SetMark( ATreeList( cp.all ),
                     GetCurrent( ATreeList( cp.all ) ) );
               end if;
               Draw( ATreeList( cp.all ) );
             elsif Table.Control( CurrentControl ).ptr.all in aSourceEditList then
               if GetCurrent( ASourceEditList( cp.all ) ) =
                  GetMark( ASourceEditList( cp.all ) ) then
                  SetMark( ASourceEditList( cp.all ), -1 );
               else
                  SetMark( ASourceEditList( cp.all ),
                     GetCurrent( ASourceEditList( cp.all ) ) );
               end if;
               Draw( ASourceEditList( cp.all ) );
             end if;
             end;
         when others =>
              -- ClearKey => LoadClipboard first, then process normally
              -- by allowing control to do the clearing
              if DialogTask.InputRec.Key = ClearKey then
                 LoadClipboard;
                 if Clipboard.all.DataType = ListData and then Clipboard.all.L.Length > 1 then
                    if Window( CurrentWindow ).HasInfoBar then
                       Window( CurrentWindow ).InfoText := To_Unbounded_String( "Cut" & Count_Type'Image (Clipboard.all.L.Length) & " lines" );
                       DrawInfo( CurrentWIndow );
                    end if;
                 end if;
                 if Table.Control( CurrentControl ).mine then
                    AdjustMyScrollBars;
                 end if;
              end if;
              if HearInCB /= null then
                 HearInCB.all( DialogTask );
              end if;
              --
              -- Treat alt keypresses as a request for hot key scan
              --
              if character'pos( DialogTask.InputRec.Key ) >= 128 then
                 -- strip high bit leaving the key that was alt'ed
                 DialogTask.InputRec.Key := character'val(
                     character'pos( DialogTask.InputRec.Key ) - 128 );
                 -- do a hot key scan
                 DialogTask.Action := ScanNext;
              else
                --
                -- Pass Other Input Keys to the Active Control
                --
                cp := Table.control( CurrentControl ).ptr;
                Hear( cp.all, DialogTask.InputRec, DialogTask.Action );
                if HearOutCB /= null then
                   HearOutCB.all( DialogTask );
                end if;
              end if;
              if DialogTask.Action = FixFamily then
                 FixRadioFamily( CurrentControl );
                 DialogTask.Action := None; -- do before drawing
              end if;
              Draw( Table.control( CurrentControl ).ptr.all );
              --HilightControl( Table.Control( CurrentControl));
              RevealNow;
              if DoStandardActions then
                 exit; -- exit if necessary
              end if;
         end case;
      elsif DialogTask.InputRec.InputType = ButtonDownInput then
         null; -- not supported
      elsif DialogTask.InputRec.InputType = MoveInput then
         -- apparently not yet working on ncurses
         if FindClickedControl( DialogTask ) then
            if GetStatus( Table.Control( CurrentControl).ptr.all ) /= off
               and HasInfo( Table.Control( CurrentControl).ptr.all ) then
                 SetInfoText(
                   GetInfo( Table.Control( CurrentControl).ptr.all ) );
            end if;
         end if;
      elsif DialogTask.InputRec.InputType = ButtonUpInput then
         if FindClickedControl( DialogTask ) then
            cp := Table.control( CurrentControl ).ptr;
            if HearInCB /= null then
               HearInCB.all( DialogTask );
            end if;
            Hear( cp.all, DialogTask.InputRec, DialogTask.Action );
            if HearOutCB /= null then
               HearOutCB.all( DialogTask );
            end if;
            if DialogTask.Action = FixFamily then
               FixRadioFamily( CurrentControl );
               DialogTask.Action := None; -- do before drawing
            end if;
            Draw( Table.control( CurrentControl ).ptr.all );
            --HilightControl( Table.Control( CurrentControl));
            RevealNow;
            if DoStandardActions then
               exit; -- exit if necessary
            end if;
         else
            if HearInCB /= null then
               HearInCB.all( DialogTask );
            end if;
            -- No HearOut since nothing actually clicked on
            SessionLog( "DoDialog: clicked in window background" );
         end if; -- clicked in an active control
      end if; -- Key Input
   end loop;
   exception when others => DrawErrLn;
                            DrawErr( "DoDialog RT exception" );
                            raise;
 end DoDialog;


  --- Windows


procedure EraseWindow is
-- Erase a window
  w : AWindow renames Window( CurrentWindow );
begin
  NoError;
  WaitToReveal;
  EraseRect( w.Content );
  MoveToGlobal( w.Content.Left, w.Content.Top );
  Reveal;
  exception when others =>
     DrawErrLn;
     DrawErr( "EraseWindow RT exception" );
     raise;
end EraseWindow;

procedure EraseWindow( id : AWindowNumber ) is
-- Erase a window
  w : AWindow renames Window( id );
begin
  NoError;
  WaitToReveal;
  EraseRect( w.Content );
  MoveToGlobal( w.Content.Left, w.Content.Top );
  Reveal;
  exception when others =>
     DrawErrLn;
     DrawErr( "EraseWindow RT exception" );
     raise;
end EraseWindow;

procedure DrawWindow( id : AWindowNumber;
  Redraw : RedrawingAmounts := none ) is
-- Draw a window
  First : integer; -- x coordinate of title
  Width : integer; -- width of the title
  Frame : ARect renames Window( id ).frame;
  OldColour : APenColourName;
  OldStyle  : ATextStyle;
begin
  NoError;
  WaitToReveal;
  OldColour := GetPenColour;
  OldStyle  := GetTextStyle;
  SetPenColour( outline );
  SetTextStyle( Normal );
  if Redraw = Whole then
     EraseWindow( id );
     InvalidateControls( id );
  end if;
  if Window( id ).style = Frameless then
     CDesktop( DisplayInfo.H_Res-1, DisplayInfo.V_Res-1);
  elsif Window( id ).HasFrame then
     if DisplayInfo.C_Res > 0 then
        if Window( id ).Style = Status then
           if IsBlueBackground then
              SetPenColour( White );
           else
              SetPenColour( Green ); -- green hard to see on blue
           end if;
        elsif Window( id ).Style = Warning then
           SetPenColour( yellow );
        elsif Window( id ).Style = Danger then
           SetPenColour( red );
        elsif Window( id ).FrameColour = outline then
           if IsBlueBackground then
              SetPenColour( White );
           else
              SetPenColour( Green ); -- green hard to see on blue
           end if;
        else
           SetPenColour( Window( id ).FrameColour );
        end if;
     end if;
     if Redraw /= none then  -- redraw frame/whole then...
        FrameRect3D( Frame );
        SetPenColour( outline );
        width := Length (Window( id ).title);
        first := Frame.left + ( (Frame.right - Frame.left - width) / 2  );
        if first <= Frame.left then
           first := Frame.left + 1;
        end if;
        if width > Frame.right - Frame.left - 2 then
           width := Frame.right - Frame.left - 2;
        end if;
        MoveToGlobal( first, Frame.top );
        Draw( To_String (Window( id ).Title), width, true );
        MoveToGlobal( Window(id).content.left, Window(id).content.top );
     end if; -- redraw frame/whole
  end if;
  DrawControls( id );
  DrawInfo( id );
  SetPenColour( OldColour );
  SetTextStyle( OldStyle );
  if Window( id ).DrawCB /= null then
     Window( id ).DrawCB.all; -- execute call back (if any)
  end if;
  Reveal;
  exception when others => DrawErrLn;
                           DrawErr("DrawWindow(2) RT error");
                           raise;
end DrawWindow;

procedure DrawWindow( Redraw : RedrawingAmounts := none ) is
begin
  DrawWindow( CurrentWindow, Redraw );
  exception when others => DrawErrLn;
                           DrawErr("DrawWindow(1) RT error");
                           raise;
end DrawWindow;

-- Reset Window

procedure ResetWindow( id : AWindowNumber ) is
begin
  MoveToGlobal( Window(id).frame.left, Window(id).frame.top );
  SetTextStyle( Normal );
  SetPenColour( Black );
  SetTextColour( Black );
  exception when others =>
     DrawErrLn;
     DrawErr( "ResetWindow RT exception" );
     raise;
end ResetWindow;

procedure ResetWindow is
begin
  ResetWindow( CurrentWindow );
end ResetWindow;

procedure RefreshDesktop is
  Amount : array( 1..AWindowNumber'last ) of RedrawingAmounts;
  First2Redo : AWindowNumber;
begin
  NoError;

    -- Identify windows to be redrawn

  First2Redo := NextWindow - 1;         -- start at top window
  Amount( First2Redo ) := whole; -- always redraw top window
  for ThisWindow in reverse 1..NextWindow-2 loop
      Amount( ThisWindow ) := none;
      -- redraw window if not buried under other windows
      for OverWindow in ThisWindow+1..NextWindow-1 loop
          -- if overwindow doesn't completely obscure this window
          -- then some drawing will need to be done
          if not InsideRect( Inner => Window( ThisWindow ).frame,
                             Outer => Window( OverWindow ).frame ) then
             if InsideRect( Inner => Window( ThisWindow ).content,
                            Outer => Window( OverWindow ).frame ) then
                -- contents inside covering window? no need to redraw
                -- any more than the exposed frame
                Amount( ThisWindow ) := frame;
             else
                -- contents not entirely inside the covering window?
                -- more than frame obscured->redraw whole window
                Amount( ThisWindow ) := whole;
             end if;
             First2Redo := ThisWindow;
          end if;
      end loop;
  end loop;
  Amount( CurrentWindow ) := whole;
  -- always (actually, this is always the top window in the current
  -- version of this package and we've already set the top window
  -- to redraw)

  -- Redraw visible windows

  WaitToReveal;
  ResetUserIO;
  for ThisWindow in First2Redo..NextWindow-1 loop
      if Amount( ThisWindow ) /= none then
         DrawWindow( id => ThisWindow, Redraw => Amount( ThisWindow ) );
      end if;
  end loop;
  Reveal;
  RevealNow; -- just in case application called WaitToReveal too many
             -- times
  exception when others =>
     DrawErrLn;
     DrawErr( "RefreshDesktop RT exception" );
     raise;
end RefreshDesktop;

procedure MoveWindow( id : AWindowNumber; dx, dy : integer ) is
   pragma Unreferenced (Id);
  -- Move (as if it was dragged by a mouse) to a new location.  No part
  -- of the window may be moved off the screen.  Does not erase or redraw
  -- the window.
  ct : AControlTable renames Window( CurrentWindow ).table;
begin
  NoError;
  if Window( CurrentWindow ).HasFrame then
     if not insideRect( OffsetRect( Window( CurrentWindow ).Frame, dx, dy ), Window( 1 ).Content ) then
        Error( TT_ParamError );
        return;
     end if;
  elsif not insideRect( OffsetRect( Window( CurrentWindow ).Content, dx, dy ), Window( 1 ).Content ) then
     Error( TT_ParamError );
     return;
  end if;
  for i in 1..ct.size loop
      Move( ct.control(i).ptr.all, dx, dy );
  end loop;
  if Window( CurrentWindow ).HasFrame then
     OffsetRect( Window( CurrentWindow ).frame, dx, dy );
  end if;
  OffsetRect( Window( CurrentWindow ).content, dx , dy );
  if Window( CurrentWindow ).HasInfoBar then
     OffsetRect( Window( CurrentWindow ).InfoBar, dx, dy );
  end if;
  exception when others =>
     DrawErrLn;
     DrawErr( "MoveWindow RT exception" );
     raise;
end MoveWindow;

procedure MoveWindow( dx, dy : integer ) is
begin
  MoveWindow( CurrentWindow, dx, dy );
end MoveWindow;

procedure ScrollWindow( id : AWindowNumber; dx, dy : integer ) is
  -- Scroll (move all the controls) in a window.  Fixed controls are
  -- not moved.  Does not erase or redraw the window.
  ct : AControlTable renames Window( CurrentWindow ).table;
begin
  NoError;
  for i in 1..ct.size loop
      if CanScroll( ct.control(i).ptr.all ) then
         Move( ct.control(i).ptr.all, dx, dy );
      end if;
  end loop;
  window( id ).xscroll := window( id ).xscroll + dx;
  window( id ).yscroll := window( id ).yscroll + dy;
  exception when others =>
     DrawErrLn;
     DrawErr( "ScrollWindow RT exception" );
     raise;
end ScrollWindow;

procedure ScrollWindow( dx, dy : integer ) is
begin
  ScrollWindow( CurrentWindow, dx, dy );
end ScrollWindow;

function OpenWindow( title : in string ; l, t, r, b : integer;
         Style : AWindowStyle := Normal;
         HasInfoBar : boolean := false;
         CallBack : AWindowDrawingCallBack := null )
         return AWindowNumber is
  -- Create a new, empty window and draws it.  Returns an ID
  -- number for the window.
  id : AWindowNumber;
begin
  NoError;
  id := 1;
  if NextWindow > 0 then
     GetPenPos( Window( CurrentWindow ).SaveX,
        Window( CurrentWindow ).SaveY ); -- remember cursor position
     id := NextWindow;
     CurrentWindow := id;
     if NextWindow = AWindowNumber'Last then
        NextWindow := 0;
     else
        NextWindow := NextWindow + 1;
     end if;
     SetRect( Window( id ).Frame, l, t, r, b );
     SetRect( Window( id ).Content, l+1, t+1, r-1, b-1 );
     Window( id ).Relative := false;
     Window( id ).HasFrame := true;
     Window( id ).FrameColour := Outline;
     Window( id ).title := To_Unbounded_String (Title);
     Window( id ).HasInfoBar := HasInfoBar;
     Window( id ).InfoText := Null_Unbounded_String;
     Window( id ).Style := Style;
     Window( id ).Timeout := -1.0;
     Window( id ).Loaded := false;
     Window( id ).XScroll := 0;
     Window( id ).YScroll := 0;
     if HasInfoBar then
        SetRect( Window( id ).InfoBar, l+1, b-1, r-1, b-1 );
        SetRect( Window( id ).Content, l+1, t+1, r-1, b-2 );
     end if;
     Window( id ).ParentFile := null_unbounded_string;
     InitControlTable( Window( id ).table );
     Window( id ).DrawCB := CallBack;
     DrawWindow( id, Redraw => whole );
  else
     Error( TT_WindowExistance );
  end if;
  return id;
  exception when others =>
     DrawErr( "OpenWindow RT exception" );
     DrawErrLn;
     raise;
end OpenWindow;

procedure OpenWindow( title : in string ; l, t, r, b : integer;
          Style : AWindowStyle := Normal;
          HasInfoBar : boolean := false;
          CallBack : AWindowDrawingCallBack := null ) is
   DiscardedId : AWindowNumber;
   pragma Unreferenced (Discardedid);
begin
  DiscardedId := OpenWindow( title, l, t, r, b, Style, HasInfoBar,
                 CallBack );
end OpenWindow;

procedure SaveWindow( path : string; arch : APathName := "") is
-- save a window to a text file so that it can be loaded later by
-- LoadWindow
-- NOTE: BROKEN RIGHT NOW
  f    : file_type;      -- text file for saving window
  cw   : AWindow renames Window( CurrentWindow );
  estr : EncodedString;  -- for writing to text file

  procedure SaveWindowDetails is
  -- save window info
  begin
    estr := Null_Unbounded_String;
    Encode( estr, To_String (Cw.Title) );
    Put_Line( f, To_String( estr ) );
    estr := Null_Unbounded_String;
    --Encode( estr, cw.HasFrame ); -- this is calculated by window type
    Encode( estr, cw.Relative );
    Put_Line( f, To_String( estr ) );
    estr := Null_Unbounded_String;
    Encode( estr, cw.Frame );
    Encode( estr, cw.Content );
    Encode( estr, cw.HasInfoBar );
    if cw.HasInfoBar then
       Encode( estr, cw.InfoBar );
      end if;
      Encode( estr, Integer( AWindowStyle'pos( cw.Style ) ) );
      Encode( estr, Integer( cw.Table.size ) );
      Put_Line( f, To_String( estr ) );
      estr := Null_Unbounded_String;
      Encode( estr, To_String (Cw.SoundPath) );
      Put_Line( f, To_String( estr ) );
      estr := Null_Unbounded_String;
      Encode( estr, To_String (Cw.SongPath) );
      Put_Line( f, To_String( estr ) );
      estr := Null_Unbounded_String;
--Encode( estr, cw.Timeout );
--Encode( estr, Integer( cw.TimeoutControl ) );
      Put_Line( f, To_String( estr ) );
      estr := Null_Unbounded_String;
      Encode( estr, To_String (Cw.ParentFile) );
      Put_Line( f, To_String( estr ) );
      -- ignore info text
    end SaveWindowDetails;

    procedure SaveWindowControls is
    -- save individual controls in the current window
      ctr : AControlTableRecord;
      ec  : EncodedString;
    begin
      for i in 1..cw.Table.Size loop
        ctr := cw.table.control(i);
        estr := Null_Unbounded_String;
        estr := Encode( ctr.ptr.all );
        Put_line( f, To_String( ec ) );
      end loop;
    end SaveWindowControls;

begin
  NoError;
  Open( f, out_file, Expandpath (Path));
  SaveWindowDetails;
  SaveWindowControls;
  if Arch'length > 0 then
     Archive (Arch, Path);
     Delete (F);
  else
     Close (F);
  end if;
exception
   when others =>
      if Is_Open (F) then
	 Close (F);
      end if;
      DrawErr( "SaveWindow RT exception" );
      DrawErrLn;
      raise;
end SaveWindow;

procedure LoadWindow( path : string; arch : APathName := "") is
   -- Load a window previously saved with SaveWindow.
   f    : file_type;      -- for reading text file
   estr : EncodedString;  -- encoded information
   
  procedure SetupWindow is
  -- read title & frame & open the window
    NewTitle : Unbounded_String;
    NewFrame : ARect;
    Relative : boolean;
  begin
    Estr := Ada.Text_IO.Unbounded_IO.Get_Line (f);
    Decode( estr, NewTitle );
    Estr := Ada.Text_IO.Unbounded_IO.Get_Line (f);
    Decode( estr, Relative );
    Estr := Ada.Text_IO.Unbounded_IO.Get_Line (f);
    Decode( estr, NewFrame );
    OpenWindow( To_String (NewTitle),
        NewFrame.left, NewFrame.top, NewFrame.right, NewFrame.bottom );
    Window( CurrentWindow ).Loaded := true;
    Window( CurrentWindow ).Relative := Relative;
  end SetupWindow;

  procedure FillInWindow is
  -- fill in window details after the window has been opened
    cw : AWindow renames Window( CurrentWindow );
    TempInt : integer;
  begin
    Decode( estr, cw.Content );
    Decode( estr, cw.HasInfoBar );
    if cw.HasInfoBar then
       Decode( estr, cw.InfoBar );
    end if;
    Decode( estr, Tempint );
    cw.Style := AWindowStyle'val( TempInt );
    Decode( estr, TempInt );
    cw.Table.Size := AControlNumber( TempInt );
    Estr := Ada.Text_IO.Unbounded_IO.Get_Line (f);
    Decode( estr, cw.SoundPath );
    Estr := Ada.Text_IO.Unbounded_IO.Get_Line (f);
    Decode( estr, cw.SongPath );
    Estr := Ada.Text_IO.Unbounded_IO.Get_Line (f);
--Decode( estr, cw.Timeout );
--Decode( estr, TempInt );
    cw.TimeoutControl := AControlNumber( TempInt );
    Estr := Ada.Text_IO.Unbounded_IO.Get_Line (f);
    Decode( estr, cw.ParentFile );
    -- ignore info text
  end FillInWindow;

  procedure FillInControls is
  -- allocate, initialize and setup the window's controls
    ct : AControlTable renames Window( CurrentWindow ).Table;
    --TempInt : integer;
  begin
    for i in 1..ct.Size loop
      Estr := Ada.Text_IO.Unbounded_IO.Get_Line (f);
      --Decode( estr, ct.control(i).ptr ); -- this is wrong
      raise program_error;               -- so don't do it
    end loop;
  end FillInControls;

begin
  NoError;
  if Arch'Length > 0 then
     Extract( path, arch );
  end if;
  if LastError = TT_OK then
     Open( f, in_file, path );
     SetupWindow;
     FillInWindow;
     FillInControls;
     DrawWindow( CurrentWindow, Redraw => Whole );
     Close( f );
  end if;
  exception when others =>
     DrawErr( "LoadWindow RT exception" );
     DrawErrLn;
     raise;
end LoadWindow;

procedure CloseWindow is
  -- Delete a window and its controls.  Entire desktop is redrawn.

  procedure ClearControls is
    ct : AControlTable renames Window( CurrentWindow ).table;
  begin
    for i in 1..ct.size loop
        --Finalize will do this: was Clear( ct.control(i).ptr.all );
        if Window( CurrentWindow ).Loaded then
           Free( ct.control(i).ptr );
        end if;
    end loop;
  end ClearControls;

begin
  NoError;
  if NextWindow > 2 then -- never close main window
     ClearControls;
     --EraseRect( Window( CurrentWindow ).Frame ); -- necessary?
     if NextWindow = 0 then
        NextWindow := AWindowNumber'last;
     else
        NextWindow := NextWindow - 1;
     end if;
     if CurrentWindow = NextWindow then -- if top window
        CurrentWindow := CurrentWindow - 1;
     end if;
     RefreshDesktop;
     MoveToGlobal( Window( CurrentWindow).SaveX,
                   Window( CurrentWindow).SaveY );
  else
     Error( TT_WindowExistance );
  end if;
  exception when others =>
      DrawErr( "CloseWindow RT exception" );
      DrawErrLn;
      raise;
end CloseWindow;

---> Standard Alerts

procedure NoteAlert( message : string ) is
-- Show an informational message in a window with an OK button.
  DT      : ADialogTaskRecord;
  OK      : aliased ASimpleButton;
  text    : aliased AStaticLine;
  pragma Unreferenced (Ok, Text);
  CenterX : integer;
begin
  NoError;
  CenterX := Window( 1 ).content.right / 2;
  OpenWindow( s_Note, CenterX-30, 10, CenterX+30, 16, Status );
  SharedButton( Shared.Button1, 27, 4, 32, 4, 'o', s_OK );
  SharedLine( Shared.Text, 1, 2, 58, 2, message );
  Beep( Status );
  DoDialog( DT );
  pragma Unreferenced (Dt);
  CloseWindow;
  exception when others =>
     DrawErr( "NoteAlert NT exception" );
     DrawErrLn;
     raise;
end NoteAlert;

procedure CautionAlert( message : string ) is
-- Show a warning message in a window with an OK button.
  DT   : ADialogTaskRecord;
  CenterX : integer;
begin
  NoError;
  CenterX := Window( 1 ).content.right / 2;
  OpenWindow( s_Caution, CenterX-30, 10, CenterX+30, 16, Warning );
  SharedButton( Shared.Button1, 27, 4, 32, 4, 'o', s_OK );
  SharedLine( Shared.Text, 1, 2, 58, 2, message );
  SetStyle( AStaticLine( Shared.Text.all ), Status );
  SessionLog( s_Caution & ": " & message );
  Beep( Warning );
  DoDialog( DT );
  pragma Unreferenced (Dt);
  CloseWindow;
  exception when others =>
     DrawErrLn;
     DrawErr( "CautionAlert RT exception" );
     raise;
end CautionAlert;

procedure StopAlert( message : string ) is
-- Show an error message in a window with an OK button.
  DT   : ADialogTaskRecord;
  CenterX : integer;
begin
  NoError;
  CenterX := Window( 1 ).content.right / 2;
  OpenWindow( s_Warning, CenterX-30, 10, CenterX+30, 16, Danger );
  SharedButton( Shared.Button1, 27, 4, 32, 4, 'o', s_OK );
  SharedLine( Shared.Text, 1, 2, 58, 2, message );
  SetStyle( AStaticLine( Shared.text.all ), Failure );
  SessionLog( s_Warning & ": " & message );
  Beep( Warning );
  DoDialog( DT );
  pragma Unreferenced (Dt);
  CloseWindow;
  exception when others =>
     DrawErrLn;
     DrawErr( "StopAlert RT exception" );
     raise;
end StopAlert;

function YesAlert( message : string; kind : BeepStyles ) return boolean is
  DT   : ADialogTaskRecord;
  CenterX : integer;
-- Ask the user a yes/no question, default "yes", in a caution window.
begin
  NoError;
  CenterX := Window( 1 ).content.right / 2;
  OpenWindow( "", CenterX-30, 10 , CenterX+30, 16 );
  SharedButton( Shared.Button1, 22, 4, 28, 4, 'y', s_yes );
  SharedButton( Shared.Button2, 32, 4, 37, 4, 'n', s_no );
  SharedLine( Shared.Text, 1, 2, 58, 2, message );
  if kind = Failure then
     SetStyle( AStaticLine( Shared.Text.all ), Failure );
  elsif kind = Warning then
     SetStyle( AStaticLine( Shared.Text.all ), Warning );
  end if;
  Beep( kind );
  DoDialog( DT );
  CloseWindow;
  return DT.control = 1;
  exception when others =>
     DrawErrLn;
     DrawErr( "YesAlert RT exception" );
     raise;
end YesAlert;

function NoAlert( message : string; kind : BeepStyles ) return boolean is
  DT   : ADialogTaskRecord;
  CenterX : integer;
-- Ask the user a yes/no question, default "no", in a caution window.
begin
  NoError;
  CenterX := Window( 1 ).content.right / 2;
  OpenWindow( "", CenterX-30, 10, CenterX+30, 16, Warning );
  SharedButton( Shared.Button1, 22, 4, 27, 4, 'n', s_no );
  SharedButton( Shared.Button2, 32, 4, 38, 4, 'y', s_yes );
  SharedLine( Shared.Text, 1, 2, 58, 2, message );
  if kind = Failure then
     SetStyle( AStaticLine( Shared.Text.all ), Failure );
  elsif kind = Warning then
     SetStyle( AStaticLine( Shared.Text.all ), Warning );
  end if;
  Beep( kind );
  DoDialog( DT );
  CloseWindow;
  return DT.control = 1;
  exception when others =>
    DrawErrLn;
    DrawErr( "NoAlert RT exception" );
    raise;
end NoAlert;

function CancelAlert( message, OKCaption : string; kind : BeepStyles )
  return boolean is
   DT     : ADialogTaskRecord;
  CenterX : integer;
-- Ask the user a yes/cancel question, default "cancel", in the kind
-- of window indicated by "kind".
begin
  NoError;
  CenterX := Window( 1 ).content.right / 2;
  OpenWindow( "", CenterX-30, 10, CenterX+30, 16 );
  SharedButton( Shared.Button1, 19, 4, 27, 4, 'o', OKCaption);
  SharedButton( Shared.Button2, 32, 4, 41, 4, 'c', s_cancel );
  SharedLine( Shared.Text, 1, 2, 58, 2, message );
  if kind = Failure then
     SetStyle( AStaticLine( Shared.Text.all ), Failure );
  elsif kind = Warning then
     SetStyle( AStaticLine( Shared.Text.all ), Warning );
  end if;
  Beep( kind );
  DoDialog( DT );
  CloseWindow;
  return DT.control = 1;
  exception when others =>
     DrawErrLn;
     DrawErr( "CancelAlert RT exception" );
     raise;
end CancelAlert;

function YesCancelAlert( message : string; kind : BeepStyles )
  return AControlNumber is
  DT   : ADialogTaskRecord;
  CenterX : integer;
-- Ask the user a yes/no/cancel question, default "cancel", in the kind
-- of window indicated by "kind".
begin
  NoError;
  CenterX := Window( 1 ).content.right / 2;
  OpenWindow( "", CenterX-30, 10, CenterX+30, 16 );
  SharedButton( Shared.Button1, 15, 4, 21, 4, 'y', s_yes );
  SharedButton( Shared.Button2, 27, 4, 32, 4, 'n', s_no );
  SharedButton( Shared.Button3, 37, 4, 47, 4, 'c', s_cancel );
  SharedLine( Shared.Text, 1, 2, 58, 2, message );
  if kind = Failure then
     SetStyle( AStaticLine( Shared.Text.all ), Failure );
  elsif kind = Warning then
     SetStyle( AStaticLine( Shared.Text.all ), Warning );
  end if;
  Beep( kind );
  DoDialog( DT );
  CloseWindow;
  return DT.control;
  exception when others =>
    DrawErrLn;
    DrawErr( "YesCancelAlert RT exception" );
    raise;
end YesCancelAlert;

procedure ValidateFilename( desc : in out AValidateFilenameRec ) is
-- Check and correct a filename
  OriginalFilename : constant String := To_String (desc.Filename); -- filename originally to be validated
  ValidFilename    : Unbounded_String; -- corrected filename from os.ValidateFilename
  ErrMsg           : unbounded_string; -- error message returned from os.VF
begin
   loop
     ValidateFilename (UNIXFS, To_String (Desc.Filename), ValidFilename, ErrMsg );
     exit when length( ErrMsg ) = 0;
     if YesAlert( "Bad filename since " & To_String( ErrMsg ) &
        "; fix it?", warning ) then
        desc.filename := ValidFilename;
     else
        desc.replied := false;
        exit;
     end if;
   end loop;
   if not desc.replied then
      desc.filename := To_Unbounded_String (OriginalFilename);
   end if;
end ValidateFilename;

procedure SelectOpenFile( sofrec : in out ASelectOpenFileRec ) is
  FileList: StrList.vector;  -- list of files in current directory
  BoolList: BooleanList.Vector; -- for selection

  ListBox      : AControlPtr; --aliased ARadioList; -- for lists
  OpenButton   : AControlPtr; --aliased ASimpleButton;
  CloseButton  : AControlPtr; --aliased ASimpleButton;
  CancelButton : AControlPtr; --aliased ASimpleButton;
  AcceptButton : AControlPtr; --aliased ASimpleButton;
  HomesButton  : AControlPtr; --aliased ASimpleButton;
  PathLine     : AControlPtr; --aliased AStaticLine;
  PromptLine   : AControlPtr; --aliased AStaticLine;
  --ListBar      : aliased AScrollBar;

  Hit : AControlNumber;          -- window control hit (DoDialog)
  DT  : ADialogTaskRecord;
  Item : Natural; -- file/home selected by user
  ShowingHomes : boolean; -- true if showing homes, not files
  OriginalPath : constant String := Ada.Directories.Current_Directory;
  
  procedure GetDirectoryCheckList is
  begin
     Filelist.Clear;
     Boollist.Clear;
     GetDirectory (FileList, Ada.Directories.Current_Directory);
     for i in 1 .. FileList.Length loop
	BoolList.Append (false );
     end loop;
     SetList( ARadioList( ListBox.all ), FileList );
     SetChecks( ARadioList( ListBox.all ), BoolList );
  end GetDirectoryCheckList;

  procedure GetHomes is
    -- get list of drives/homes/etc & install in ListBox
    -- FileList and BoolList should be emptied first
     File : File_Type;
  begin
     -- Should be modified with LANG=C
     -- And tested.
     Boollist.Clear;
     Create (File, In_File, "");	--  temp file
     UNIX( "df | cut -c57-80 > " & Name (File));
     Loadlist (File, Filelist);
     Delete (File);
     
     FileList.Delete_Last;
     FileList.Append ("Home");
     for i in 1 .. Filelist.Length loop
	BoolList.Append (false );
     end loop;
     SetList( ARadioList( ListBox.all ), FileList );
     SetChecks( ARadioList( ListBox.all ), BoolList );
  exception
     when others =>
	if Is_Open (File) then
	   Delete (File);
	end if;
  end GetHomes;

  procedure HandleSetPathErrors is
  begin
    if LastError = TT_SystemError then
         StopAlert( "You can't access that folder" );
    elsif LastError /= 0 then
         StopAlert( "Can't move to that folder" );
    end if;
  end HandleSetPathErrors;

begin
  NoError;
  OpenWindow ("", 5, 4, 60, 17 );
  ListBox := new ARadioList;
  Init( ARadioList( ListBox.all ), 1, 4, 40, 12 );
  AddControl( ListBox, IsGlobal => false );
  OpenButton := new ASimpleButton;
  Init( ASimpleButton( OpenButton.all ), 42, 4, 51, 4, 'o' ); -- 2 = open
  SetText( ASimpleButton( OpenButton.all ), "Open");
  AddControl( OpenButton, IsGlobal => false );
  AcceptButton := new ASimpleButton;
  Init( ASimpleButton( AcceptButton.all ), 42, 5, 51, 5, 'a' );
  SetText( ASimpleButton( AcceptButton.all ), "Accept"); -- 3 = accept
  AddControl( AcceptButton, IsGlobal => false );
  if not sofrec.Direct then
     SetStatus( AcceptButton.all, Off );
  end if;
  CloseButton := new ASimpleButton;
  Init( ASimpleButton( CloseButton.all ), 42, 6, 51, 6, 'c' ); -- 4 = close
  SetText( ASimpleButton( CloseButton.all ), "Close");
  AddControl( CloseButton, IsGlobal => false );
  HomesButton := new ASimpleButton;
  Init( ASimpleButton( HomesButton.all ), 42, 7, 51, 7, 'h' ); -- 5 = homes
  SetText( ASimpleButton( HomesButton.all ), "Homes");
  AddControl( HomesButton, IsGlobal => false );
  CancelButton := new ASimpleButton;
  Init( ASimpleButton( CancelButton.all ), 42, 9, 51, 9, 'l' );
  SetText( ASimpleButton( CancelButton.all ), s_cancel );
  AddControl( CancelButton, IsGlobal => false );
  PromptLine := new AStaticLine;
  Init( AStaticLine( PromptLine.all ), 1, 1, 51, 1 );
  SetText( AStaticLine( PromptLine.all ), To_String (Sofrec.Prompt));
  SetStyle( AStaticLine( PromptLine.all ), Heading );
  AddControl( PromptLine, IsGlobal => false );
  PathLine := new AStaticLine;
  Init( AStaticLine( PathLine.all ), 1, 3, 51, 3 );
  SetText( AStaticLine( PathLine.all ), "Path?");
  AddControl( PathLine, IsGlobal => false );
  --Init( ListBar, 26, 4, 26, 10 );
  --AddControl( ScrollBar, ListBar'access, IsGlobal => false );

  -- setup

  ShowingHomes := false;
  GetDirectoryCheckList;
  --SetMax( ListBar, filelist.length);
  --SetThumb( ListBar, 1 );

  loop
    if ShowingHomes then
       SetText( AStaticLine( PathLine.all ), "Homes:");
    else
       SetText( AStaticLine( PathLine.all ), Ada.Directories.Current_Directory);
    end if;
    DoDialog( DT );
    hit := DT.control;                  -- do dialog
    item := GetCheck( ARadioList( ListBox.all ) );        -- get list item

    sofrec.Fname := To_Unbounded_String (FileList.Element (Item)); -- extract it
    Filelist.Clear; -- blow away lists

    BooleanList.Clear( BoolList );
    case hit is
    when 2 => -- open
       if ShowingHomes then
          ShowingHomes := false;
          SetStatus( CloseButton.all, Standby );
          if item = 1 then -- home directory
             sofrec.fname := To_Unbounded_String (ExpandPath ("$HOME"));
          end if;
       end if;
       if IsDirectory (To_String (Sofrec.Fname)) then
          SetPath (To_String (Sofrec.Fname));
          HandleSetPathErrors;
          GetDirectoryCheckList;
       else
          sofrec.path := To_Unbounded_String (Ada.Directories.Current_Directory);
          sofrec.replied := true;
          exit;
       end if;
    when 3 => -- accept
       sofrec.path := To_Unbounded_String (Ada.Directories.Current_Directory);
       sofrec.replied := true;
       exit;
    when 4 => -- close
       Ada.Directories.Set_Directory ("..");
       HandleSetPathErrors;
       GetDirectoryCheckList;
    when 5 => -- homes
       GetHomes;
       ShowingHomes := true;
       SetStatus( CloseButton.all, Off );
    when 6 => -- cancel
       sofrec.replied := false;
       Ada.Directories.Set_Directory (OriginalPath);
       exit;
    when others =>
       StopAlert( "SelectOpenFile: Unknown Window Control" );
    end case;
 end loop;
 CloseWindow;
 exception when others =>
    DrawErrLn;
    DrawErr( "SelectOpenFile RT exception" );
    raise;
end SelectOpenFile;

procedure SelectSaveFile( ssfrec : in out ASelectSaveFileRec ) is
  FileList: StrList.Vector;  -- list of files in current directory
  BoolList: BooleanList.Vector; -- for selection

  ListBox      : AControlPtr; --aliased ARadioList; -- for lists
  NameLine     : AControlPtr; --aliased AnEditLine; -- file name
  SaveButton   : AControlPtr; --aliased ASimpleButton;
  OpenButton   : AControlPtr; --aliased ASimpleButton;
  CloseButton  : AControlPtr; --aliased ASimpleButton;
  CancelButton : AControlPtr; --aliased ASimpleButton;
  HomesButton  : AControlPtr; --aliased ASimpleButton;
  PathLine     : AControlPtr; --aliased AStaticLine;
  PromptLine   : AControlPtr; --aliased AStaticLine;
  --ListBar      : aliased AScrollBar;

  Hit : AControlNumber;          -- window control hit (DoDialog)
  DT : ADialogTaskRecord;
  Item : Natural; -- file/home selected by user
  ShowingHomes : boolean; -- true if showing homes, not files
  OriginalPath : constant String := Ada.Directories.Current_Directory;

  procedure GetDirectoryCheckList is
  begin
     Filelist.Clear;
    BoolList.Clear;
    GetDirectory (FileList, Ada.Directories.Current_Directory);
    for i in 1 .. filelist.length loop
       BoolList.Append (false );
    end loop;
    SetList( ARadioList( ListBox.all ), FileList );
    SetChecks( ARadioList( ListBox.all ), BoolList );
  end GetDirectoryCheckList;
  
  procedure GetHomes is
     -- get list of drives/homes/etc & install in ListBox
     -- FileList and BoolList should be emptied first
     File : File_Type;
  begin
     -- Should be modified with LANG=C
     -- And tested.
     Boollist.Clear;
     Create (File, In_File, "");	--  temp file
     UNIX( "df | cut -c57-80 > " & Name (File));
     Loadlist (File, Filelist);
     Delete (File);
     
     FileList.Delete_Last;
     FileList.Append ("Home");
     for i in 1 .. Filelist.Length loop
	BoolList.Append (false );
     end loop;
     SetList( ARadioList( ListBox.all ), FileList );
     SetChecks( ARadioList( ListBox.all ), BoolList );
  exception
     when others =>
	if Is_Open (File) then
	   Delete (File);
	end if;
  end GetHomes;

begin
  NoError;
  OpenWindow ("", 5, 4, 60, 18 );
  ListBox := new ARadioList;
  Init( ARadioList( ListBox.all ), 1, 4, 40, 12 );
  AddControl( ListBox, IsGlobal => false );
  NameLine := new AnEditLine;
  Init( AnEditLine( NameLine.all ), 1, 13, 51, 13 );
  SetText( AnEditLine(NameLine.all), To_String (Ssfrec.Default));
  AddControl( NameLine, IsGlobal => false );
  OpenButton := new ASimpleButton;
  Init( ASimpleButton( OpenButton.all ), 42, 4, 51, 4, 'o' ); -- 3 = open
  SetText( ASimpleButton( OpenButton.all ), "Open");
  AddControl( OpenButton, IsGlobal => false );
  SaveButton := new ASimpleButton;
  Init( ASimpleButton( SaveButton.all ), 42, 5, 51, 5, 's' ); -- 4 = save
  SetText( ASimpleButton( SaveButton.all ), "Save");
  AddControl( SaveButton, IsGlobal => false );
  CloseButton := new ASimpleButton;
  Init( ASimpleButton( CloseButton.all ), 42, 6, 51, 6, 'c' ); -- 5 = close
  SetText( ASimpleButton( CloseButton.all ), "Close");
  AddControl( CloseButton, IsGlobal => false );
  HomesButton := new ASimpleButton;
  Init( ASimpleButton( HomesButton.all ), 42, 7, 51, 7, 'h' ); -- 6 = homes
  SetText( ASimpleButton( HomesButton.all ), "Homes");
  AddControl( HomesButton, IsGlobal => false );
  CancelButton := new ASimpleButton;
  Init( ASimpleButton( CancelButton.all ), 42, 9, 51, 9, s_cancel_Hot );
  SetText( ASimpleButton( CancelButton.all ), s_cancel );
  AddControl( CancelButton, IsGlobal => false );
  PromptLine := new AStaticLine;
  Init( AStaticLine( PromptLine.all ), 1, 1, 51, 1 );
  SetText( AStaticLine( PromptLine.all ), To_String (Ssfrec.Prompt));
  SetStyle( AStaticLine( PromptLine.all ), Heading );
  AddControl( PromptLine, IsGlobal => false );
  PathLine := new AStaticLine;
  Init( AStaticLine( PathLine.all ), 1, 3, 51, 3 );
  SetText( AStaticLine( PathLine.all ), "Path?");
  AddControl( PathLine, IsGlobal => false );
  --Init( ListBar, 26, 4, 26, 10 );
  --AddControl( ScrollBar, ListBar, IsGlobal => false );

  -- setup

  ShowingHomes := false;
  GetDirectoryCheckList;

  --SetMax( ListBar, filelist.length);
  --SetThumb( ListBar, 1 );

  loop
    if ShowingHomes then
       SetText( AStaticLine( PathLine.all ), "Homes:");
    else
       SetText( AStaticLIne( PathLine.all ), Ada.Directories.Current_Directory);
    end if;
    DoDialog( DT );
    hit := DT.control;                  -- do dialog
    item := GetCheck( ARadioList( ListBox.all ) );   -- get list item
    ssfrec.Fname := To_Unbounded_String (FileList.Element (Item)); -- extract it
    Filelist.Clear; -- blow away lists
    BooleanList.Clear( BoolList );
    case hit is
    when 3 => -- open
       if ShowingHomes then
          ShowingHomes := false;
          SetStatus( CloseButton.all, Standby );
          SetStatus( SaveButton.all, Standby );
          DrawControls;
          if item = 1 then -- home directory
             ssfrec.fname := To_Unbounded_String (ExpandPath ("$HOME"));
          end if;
       end if;
       --TmpStr := Append( To255("test -d "), To_String( ssfrec.fname ));
       --if UNIX( TmpStr ) then --directory?
       if Isdirectory (To_String (Ssfrec.Fname)) then
          begin
             SetPath (ExpandPath (To_String (Ssfrec.Fname)));
          exception
             when Ada.IO_Exceptions.Name_Error | Ada.IO_Exceptions.Use_Error =>
               StopAlert( "You can't access that folder" );
          end;
          GetDirectoryCheckList;
       else
          StopAlert( "This isn't a folder" );
       end if;
    when 4 => -- save
       ssfrec.path := To_Unbounded_String (Ada.Directories.Current_Directory);
       ssfrec.fname := To_Unbounded_String (GetText( AnEditLine( NameLine.all ) ));
       if ssfrec.fname = Null_Unbounded_String then
          CautionAlert( "What's the file name?" );
       else
          if NotEmpty (To_String (Ssfrec.Fname)) then
             if not NoAlert( "Overwrite this file? ", Warning ) then
                ssfrec.replied := true;
                exit;
             end if;
          else
            ssfrec.replied := true;
            exit;
          end if;
       end if;
       GetDirectoryCheckList;
    when 5 => -- close
       begin
          Ada.Directories.Set_Directory ("..");
       exception
          when Ada.IO_Exceptions.Name_Error | Ada.IO_Exceptions.Use_Error =>
            StopAlert( "You can't access that folder" );
       end;
       GetDirectoryCheckList;
    when 6 => -- homes
       GetHomes;
       ShowingHomes := true;
       SetStatus( ASimpleButton( CloseButton.all ), Off );
       SetStatus( ASimpleButton( SaveButton.all ), Off );
    when 7 => -- cancel
       ssfrec.replied := false;
       Ada.Directories.Set_Directory (OriginalPath);
       exit;
    when others =>
       StopAlert( "SelectSaveFile: Unknown Window Control" );
    end case;
 end loop;
 CloseWindow;
 exception when others =>
  DrawErrLn;
    DrawErr( "SelectSaveFile RT exception" );
    raise;
end SelectSaveFile;


procedure ShowListInfo( title : string;
                        t : integer;
                        lst : in out Strlist.Vector;
                        last : boolean := false;
                        longLines : LongLineHandling := none ) is
-- display a list for the user to view; list isn't cleared.  List is full-
-- screen except with the top of the window at t.
begin
  ShowListInfo( title, 0, t, DisplayInfo.H_Res-1, DisplayInfo.V_Res-1, lst, last, none );
end ShowListInfo;

procedure ShowListInfo( title : string;
                        l, t, r, b : integer;
                        lst : in out Strlist.Vector;
                        last : boolean := false;
                        longLines : LongLineHandling := none ) is
-- display a list for the user to view; list isn't cleared
  TheList      : aliased AStaticList;
  TheScrollBar : aliased AScrollBar;
  OKButton     : aliased ASimpleButton;
  DT           : ADialogTaskRecord;
  CenterX      : integer;
begin
  OpenWindow( title, l, t, r, b, Normal, false );
  CenterX := Window( currentWindow ).content.right / 2;

  Init( TheList, 1, 1, r-3, b-3 );
  SetList( TheList, lst );
  AddControl( TheList'unchecked_access, IsGlobal => False );
  if longLines = wrap then
     WrapText( TheList );
  elsif longLines = justify then
     JustifyText( TheList, r-3-1 );
  end if;

  Init( TheScrollBar, r-2, 1, r-2, b-3 );
  AddControl( TheScrollBar'unchecked_access, IsGlobal => False );

  Init( OKButton, CenterX-3, b-2, CenterX+3, b-2, 'o' );
  SetText( OKButton, s_OK );
  AddControl( OKButton'unchecked_access, IsGlobal => False );

  SetScrollBar( TheList, 2 );
  SetMax( TheScrollBar, Natural (lst.length) );
  SetOwner( TheScrollBar, 1 );
  if last then
     SetThumb( TheScrollBar, Natural (Lst.Length));
     MoveCursor( TheList, 0, Natural (Lst.Length) - 1);
  end if;
  DoDialog( DT );
  pragma Unreferenced (Dt);
  CloseWindow;
end ShowListInfo;

procedure EditListInfo( title : string;
                        t : integer;
                        lst : in out Strlist.Vector;
                        result : out boolean;
                        last : boolean := false ) is
begin
  EditListInfo( title, 0, t, DisplayInfo.H_Res-1, DisplayInfo.V_Res-1, lst,
    result, last );
end EditListInfo;

procedure EditListInfo( title : string;
                        l, t, r, b : integer;
                        lst : in out Strlist.vector;
                        result : out boolean;
                        last : boolean := false) is
-- display a list for the user to view; list isn't cleared
  ssf          : ASelectSaveFileRec;
  ListHeader   : Strlist.Vector;
  TheList      : aliased AnEditList;
  TheScrollBar : aliased AScrollBar;
  OKButton     : aliased ASimpleButton;
  CancelButton : aliased ASimpleButton;
  SaveButton   : aliased ASimpleButton;
  EmailButton  : aliased ASimpleButton;
  PrintButton  : aliased ASimpleButton;
  DT           : ADialogTaskRecord;

  procedure EmailText is
    PipeID : AStdioFileID;
    Result : Integer;
    WhoLabel : aliased AStaticLine;
    WhoLine : aliased AnEditLine;
    SubjectLabel : aliased AStaticLine;
    SubjectLine : aliased AnEditLine;
    OKButton : aliased ASimpleButton;
    DT : ADialogTaskRecord;

    procedure Process (Position : in Strlist.Cursor);
    procedure Process (Position : in Strlist.Cursor) is
    begin
       Result := fputs( Strlist.Element (Position) & ASCII.CR & ASCII.LF & ASCII.NUL,
                        PipeID );
       pragma Assert (Result >= 0);
    end Process;

  begin
    OpenWindow( "Person & Subject", 2, 2, 30, 8, normal, false );
    Init( WhoLabel, 1, 2, 3, 2 );
    SetText( WhoLabel, "To:" );
    AddControl( WhoLabel'unchecked_access, IsGlobal => false );
    Init( WhoLine, 4, 2, 26, 2 );
    AddControl( WhoLine'unchecked_access, IsGlobal => false );
    Init( SubjectLabel, 1, 3, 3, 3 );
    SetText( SubjectLabel, "Re:" );
    AddControl( SubjectLabel'unchecked_access, IsGlobal => false );
    Init( SubjectLine, 4, 3, 26, 3 );
    AddControl( SubjectLine'unchecked_access, IsGlobal => false );
    Init( OKButton, 12, 5, 18, 5, s_OK_Hot );
    SetText( OKButton, s_OK );
    AddControl( OKButton'unchecked_access, IsGlobal => false );
    DoDialog( DT );
    declare
       Who2Mail : constant String := GetText (WhoLine);
       Subject : Unbounded_String := To_Unbounded_String (GetText (SubjectLine));
    begin
       CloseWindow;
       if Who2Mail'Length = 0 then
	  SessionLog( "EmailText: no recipient specified" );
	  return;
       end if;
       if Length (Subject) = 0 then
	  Subject := To_Unbounded_String ("No Subject");
       end if;
       PipeID := popen( "mail -s " &
			  "'" & To_String (Subject) & "' " & Who2Mail & ASCII.NUL,
			"w" &  ASCII.NUL);
    end;
    ListHeader := GetList( TheList ); -- get list header (so don't clear)
    Listheader.Iterate (Process'Access);
    pclose( Result, PipeID );
    pragma Assert (Result = 0);
    SessionLog( "EmailText: Email sent" );
  end EmailText;

  procedure PrintText is
    PipeID : AStdioFileID;
    Result : integer;
    procedure Process (Position : in Strlist.Cursor);
    procedure Process (Position : in Strlist.Cursor) is
    begin
       Result := fputs( Strlist.Element (Position) & ASCII.CR & ASCII.LF & ASCII.NUL,
                        PipeID );
       pragma Assert (Result >= 0);
    end Process;

  begin
    PipeID := popen( "lpr" & ASCII.NUL, "w"  & ASCII.NUL);
    ListHeader := GetList( TheList ); -- get list header (so don't clear)

    Listheader.Iterate (Process'Access);
    Result := fputc( character'pos( ASCII.FF ), PipeID );
    pragma Assert (Result >= 0);
    pclose( Result, PipeID );
    pragma Assert (Result /= -1);
    SessionLog( "PrintText: Printing spooled" );
  end PrintText;

begin
  OpenWindow( Title, l, t, r, b, normal, true );

  Init( TheList, 1, 1, r-4, b-4 );
  SetList( TheList, lst );
  AddControl( TheList'unchecked_access, IsGlobal => false );

  Init( TheScrollBar, r-3, 1, r-3, b-4 );
  AddControl( TheScrollBar'unchecked_access, IsGlobal => false );

  Init( OKButton, 2, b-3, 15, b-3, 'o' );
  SetText( OKButton, s_OK );
  SetInfo( OKButton, "Accept with any changes");
  AddControl( OKButton'unchecked_access, IsGlobal => false );

  Init( CancelButton, 16, b-3, 30, b-3, 'l' );
  SetText( CancelButton, s_Cancel );
  SetInfo( CancelButton, "Discard any changes");
  AddControl( CancelButton'unchecked_access, IsGlobal => false );

  Init( SaveButton, 31, b-3, 45, b-3, s_Save_Hot );
  SetText( SaveButton, s_Save );
  SetInfo( SaveButton, "Save to a file and continue making changes");
  AddControl( SaveButton'unchecked_access, IsGlobal => false );

  Init( EmailButton, 46, b-3, 60, b-3, 'e' );
  SetText( EmailButton, "Email" );
  SetInfo( EmailButton, "Email this to someone");
  AddControl( EmailButton'unchecked_access, IsGlobal => false );

  Init( PrintButton, 61, b-3, 75, b-3, 'p' );
  SetText( PrintButton, "Print" );
  SetInfo( PrintButton, "Print this");
  AddControl( PrintButton'unchecked_access, IsGlobal => false );

  SetScrollBar( TheList, 2 );
  SetMax( TheScrollBar, Natural (lst.Length));
  SetOwner( TheScrollBar, 1 );

  if last then
     SetThumb( TheScrollBar, Natural (Lst.Length));
     SetCursor( TheList, 1, Natural (lst.length));
  end if;

  -- doesn't work for X Windows
  --if not IsLocal then
  --   SetStatus( SaveButton, Off );
  --end if;
  loop
    DoDialog( DT );
    if DT.control = 3 then
       ListHeader := GetList( TheList ); -- get list header (so don't clear)
       Lst.Clear;          -- erase old list
       Lst := ListHeader;
       exit;
     elsif DT.control = 5 then
       ssf.prompt := To_Unbounded_String ("Save as ...");
       ssf.default := To_Unbounded_String ("untitled.txt");
       SelectSaveFile( ssf );
       if ssf.replied then
          ListHeader := GetList( TheList );
          SaveList (To_String (Ssf.Path) & "/" & To_String (Ssf.Fname), ListHeader );
       end if;
     elsif DT.control = 6 then
       EmailText;
     elsif DT.control = 7 then
       PrintText;
     else
       exit;
     end if;
  end loop;
  CloseWindow;
  result := DT.control = 3;
end EditListInfo;


--- Housekeeping


procedure StartupWindows is

  procedure InitializeSharedControls is
  -- allocate the controls to be shared by dialogs/alerts in this package
  begin
    Shared.Button1 := new ASimpleButton;
    Shared.Button2 := new ASimpleButton;
    Shared.Button3 := new ASimpleButton;
    Shared.Text    := new AStaticLine;
    if Shared.Text = Null then
       SessionLog( "StartupWindows: Error allocating shared controls" );
    end if;
  end InitializeSharedControls;

begin
  NoError;
  if PackageRunning then
     SessionLog( "StartupWindows: Windows package is already running" );
     return;
  end if;
  GetDisplayInfo( DisplayInfo ); -- NoError implied
  SessionLog( "StartupWindows: DisplayInfo.H_Res = " & DisplayInfo.H_Res'img );
  SessionLog( "StartupWindows: DisplayInfo.V_Res = " & DisplayInfo.V_Res'img );
  NextWindow := 2;
  CurrentWindow := 1;
  SessionLog( "StartupWindows: Setting up global window" );
  Window( CurrentWindow ).HasFrame := false;
  Window( CurrentWindow ).Relative := false;
  Window( CurrentWindow ).Title := Null_Unbounded_String;
  Window( CurrentWindow ).ParentFile := Null_Unbounded_String;
  Window( CurrentWindow ).Style := Frameless;
  SetRect( Window( CurrentWindow ).Frame, 0, 0, DisplayInfo.H_Res-1,
     DisplayInfo.V_Res-1 );
  SetRect( Window( CurrentWindow ).Content, 0, 0, DisplayInfo.H_Res-1,
     DisplayInfo.V_Res-1 );
  SessionLog( "StartupWindows: Setting up global window control table" );
  InitControlTable( Window( CurrentWindow ).table );
  Clipboard := null;
  SessionLog( "StartupWindows: Drawing global window" );
  DrawWindow;
  SessionLog( "StartupWindows: Initialing Shared Controls" );
  InitializeSharedControls;
  SessionLog( "StartupWindows: Done Window Startup" );
end StartupWindows;

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

procedure ShutdownWindows is
  procedure ClearSharedControls is
  begin
    Finalize( Shared.Button1.all );
    Finalize( Shared.Button2.all );
    Finalize( Shared.Button3.all );
    Finalize( Shared.Text.all );
  end ClearSharedControls;
begin
  NoError;
  if PackageRunning then
     ClearSharedControls;
     PackageRunning := false;
  end if;
  notepaddata.Clear;
end ShutdownWindows;

procedure ShellOut( cmd : string) is
  BackgroundSave : boolean;
begin
  NoError;
  BackgroundSave := IsBlueBackground;
  Sessionlog( "ShellOut: - " & cmd );
  ShutdownUserIO;
  UNIX( cmd );
  StartupUserIO;
  if IsBlueBackground /= BackgroundSave then
     BlueBackground( BackgroundSave );
  end if;
  RefreshDesktop;
end ShellOut;

end windows;