DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400 Tapes

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about Rational R1000/400 Tapes

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download
Index: ┃ B T

⟦83ad7a794⟧ TextFile

    Length: 65897 (0x10169)
    Types: TextFile
    Names: »B«

Derivation

└─⟦85b835f43⟧ Bits:30000549 8mm tape, Rational 1000, Xlib rev 6.00
    └─ ⟦0c20f784e⟧ »DATA« 
        └─⟦1abbe589f⟧ 
            └─⟦059497ac5⟧ 
                └─⟦this⟧ 

TextFile

with Unchecked_Deallocation;

with Xlbt_Arithmetic;  
use Xlbt_Arithmetic;  
with Xlbt_Atom_Defs;  
use Xlbt_Atom_Defs;  
with Xlbt_Basic;  
use Xlbt_Basic;  
with Xlbt_Display2;  
use Xlbt_Display2;  
with Xlbt_Color;  
use Xlbt_Color;  
with Xlbt_Event;  
use Xlbt_Event;  
with Xlbt_Exceptions;  
use Xlbt_Exceptions;  
with Xlbt_Extension;  
use Xlbt_Extension;  
with Xlbt_Gc;  
use Xlbt_Gc;  
with Xlbt_Gc2;  
use Xlbt_Gc2;  
with Xlbt_Graphics;  
use Xlbt_Graphics;  
with Xlbt_Host;  
use Xlbt_Host;  
with Xlbt_Image;  
use Xlbt_Image;  
with Xlbt_Image2;  
use Xlbt_Image2;  
with Xlbt_Key;  
use Xlbt_Key;  
with Xlbt_Misc;  
use Xlbt_Misc;  
with Xlbt_Proc_Var;  
use Xlbt_Proc_Var;  
with Xlbt_Request;  
use Xlbt_Request;  
with Xlbt_Rm;  
use Xlbt_Rm;  
with Xlbt_Rm2;  
use Xlbt_Rm2;  
with Xlbt_String;  
use Xlbt_String;  
with Xlbt_Univ_Ptr;  
use Xlbt_Univ_Ptr;  
with Xlbt_Visual;  
use Xlbt_Visual;  
with Xlbt_Visual2;  
use Xlbt_Visual2;  
with Xlbt_Window;  
use Xlbt_Window;

with Xlbp_Display;  
use Xlbp_Display;  
with Xlbp_Error;  
use Xlbp_Error;  
with Xlbp_Font;  
use Xlbp_Font;  
with Xlbp_Gc;  
use Xlbp_Gc;  
with Xlbp_Proc_Var;  
use Xlbp_Proc_Var;  
with Xlbp_Rm;  
use Xlbp_Rm;  
with Xlbp_Sync;  
use Xlbp_Sync;  
with Xlbp_U_Char_Converters;  
use Xlbp_U_Char_Converters;  
with Xlbp_Window_Property;  
use Xlbp_Window_Property;

with Xlbit_Library3;  
use Xlbit_Library3;  
with Xlbit_Library4;  
use Xlbit_Library4;

with Xlbip_Default_Proc_Vars;  
use Xlbip_Default_Proc_Vars;  
with Xlbip_Get_Reply;  
use Xlbip_Get_Reply;  
with Xlbip_Internal;  
use Xlbip_Internal;  
with Xlbip_Put_Request;  
use Xlbip_Put_Request;

with Xlbmt_Network_Types;  
use Xlbmt_Network_Types;  
with Xlbmt_Parameters;  
use Xlbmt_Parameters;

with Xlbmp_Environment;  
use Xlbmp_Environment;  
with Xlbmp_Error_Log;  
use Xlbmp_Error_Log;  
with Xlbmp_Generic_Converters;  
use Xlbmp_Generic_Converters;  
with Xlbmp_Get;  
use Xlbmp_Get;  
with Xlbmp_Internal;  
use Xlbmp_Internal;  
with Xlbmp_Put;  
use Xlbmp_Put;

package body Xlbp_Display is
------------------------------------------------------------------------------
-- X Library Display
--
-- Xlbp_Display - Obtain information about a display connection.
------------------------------------------------------------------------------
-- Copyright 1989 - 1991 by Rational, Santa Clara, California.
-- Copyright 1985 - 1989 by the Massachusetts Institute of Technology
--
--                  All Rights Reserved.
--
-- Permission to use, copy, modify, and distribute this software and its
-- documentation for any purpose and without fee is hereby granted,
-- provided that the above copyright notice(s) appear in all copies and that
-- both that copyright notice(s) and this permission notice appear in
-- supporting documentation, and that the names of MIT or Rational not be
-- used in advertising or publicity pertaining to distribution of the software
-- without specific, written prior permission.
--
-- MIT and Rational disclaim all warranties with regard to this software,
-- including all implied warranties of merchantability and fitness, in no
-- event shall MIT or Rational be liable for any special, indirect or
-- consequential damages or any damages whatsoever resulting from loss of use,
-- data or profits, whether in an action of contract, negligence or other
-- tortious action, arising out of or in connection with the use or performance
-- of this software.
------------------------------------------------------------------------------

    function Default_X_Alloc_Id is  
       new Proc_Var_X_Alloc_Id.Value (Internal_X_Alloc_Id);

    procedure Free_X_Gc is  
       new Unchecked_Deallocation (Xlbt_Gc2.X_Gc_Rec,  
                                   X_Gc);

    X_Reply_Contents_Size : constant X_Reply_S_Natural :=
       ----Number of Raw data bytes that are used to contain the complete
       --  (non-variable portion) reply message for a given request code.
       X_Reply_S_Natural'  
          (  
           Get_Window_Attributes    => 44,  
           Get_Geometry             => 32,  
           Query_Tree               => 32,  
           Intern_Atom              => 32,  
           Get_Atom_Name            => 32,  
           Get_Property             => 32,  
           List_Properties          => 32,  
           Get_Selection_Owner      => 32,  
           Grab_Pointer             => 32,  
           Grab_Keyboard            => 32,  
           Query_Pointer            => 32,  
           Get_Motion_Events        => 32,  
           Translate_Coords         => 32,  
           Get_Input_Focus          => 32,  
           Query_Keymap             => 40,  
           Query_Font               => 60,  
           Query_Text_Extents       => 32,  
           List_Fonts               => 32,  
           List_Fonts_With_Info     => 60,  
           Get_Font_Path            => 32,  
           Get_Image                => 32,  
           List_Installed_Colormaps => 32,  
           Alloc_Color              => 32,  
           Alloc_Named_Color        => 32,  
           Alloc_Color_Cells        => 32,  
           Alloc_Color_Planes       => 32,  
           Query_Colors             => 32,  
           Lookup_Color             => 32,  
           Query_Best_Size          => 32,  
           Query_Extension          => 32,  
           List_Extensions          => 32,  
           Get_Keyboard_Mapping     => 32,  
           Get_Keyboard_Control     => 52,  
           Get_Pointer_Control      => 32,  
           Get_Screen_Saver         => 32,  
           List_Hosts               => 32,  
           Set_Pointer_Mapping      => 32,  
           Get_Pointer_Mapping      => 32,  
           Set_Modifier_Mapping     => 32,  
           Get_Modifier_Mapping     => 32,

           others                   => 0
           ----Should not happen.  Means we have a new Reply type and
           --  we were not told.  Since we are the one and only entity
           --  that allows replies to be created from bytes this means that
           --  somebody has slipped up; or else we're working with
           --  a malfunctioning or a too-new version server.
           );

--\f

------------------------------------------------------------------------------
-- Initial Connection Burst Sent
------------------------------------------------------------------------------

    type X_Conn_Client_Prefix is  
        record  
            Byte_Order          : U_Char;  
            Pad                 : U_Char;  
            Major_Version       : U_Short;  
            Minor_Version       : U_Short;  
            N_Bytes_Auth_Proto  : U_Short;    -- Authorization protocol name
            N_Bytes_Auth_String : U_Short;    -- Authorization data string
            Pad2                : U_Short;  
        end record;

--/ if Length_Clauses then
    for X_Conn_Client_Prefix'Size use 32 * 3;
--/ end if;

--/ if Record_Rep_Clauses then
--//     for X_Conn_Client_Prefix use
--//         record
--//             Byte_Order          at 0 * X_Word range X_Byte0a .. X_Byte0b;
--//             Pad                 at 0 * X_Word range X_Byte1a .. X_Byte1b;
--//             Major_Version       at 0 * X_Word range X_Half1a .. X_Half1b;
--//             Minor_Version       at 1 * X_Word range X_Half0a .. X_Half0b;
--//             N_Bytes_Auth_Proto  at 1 * X_Word range X_Half1a .. X_Half1b;
--//             N_Bytes_Auth_String at 2 * X_Word range X_Half0a .. X_Half0b;
--//             Pad2                at 2 * X_Word range X_Half1a .. X_Half1b;
--//         end record;
--/ end if;

    procedure To_Raw is new Convert_Private_To_Raw (X_Conn_Client_Prefix);

    procedure Put_X_Conn_Client_Prefix is  
       new Put_Data_Private (X_Conn_Client_Prefix,  
                             To_Raw);

------------------------------------------------------------------------------
-- Connection setup structure.  This is followed by:
-- Num_Formats X_Pixmap_Format structures.
-- Num_Roots X_Window_Root structures.
------------------------------------------------------------------------------

    type X_Conn_Setup is  
        record  
            Release              : S_Long;  
            Rid_Base             : X_Id;  
            Rid_Mask             : X_Id;  
            Motion_Buffer_Size   : S_Long;  
            N_Bytes_Vendor       : U_Short;             -- Vendor string length
            Max_Request_Size     : U_Short;  
            Num_Roots            : X_Screen_Number;     -- # Root structs
            Num_Formats          : U_Char;              -- Pixmap format count
            Image_Byte_Order     : X_Byte_Bit_Order;  
            Bitmap_Bit_Order     : X_Byte_Bit_Order;  
            Bitmap_Scanline_Unit : U_Char;              -- 8, 16, 32
            Bitmap_Scanline_Pad  : U_Char;              -- 8, 16, 32
            Min_Keycode          : X_Key_Code;  
            Max_Keycode          : X_Key_Code;  
            Pad2                 : S_Long;  
        end record;

--/ if Length_Clauses then
    for X_Conn_Setup'Size use 32 * 8;
--/ end if;

--/ if Record_Rep_Clauses then
--//     for X_Conn_Setup use
--//         record
--//             Release              at 0 * X_Word range X_Word0a .. X_Word0b;
--//             Rid_Base             at 1 * X_Word range X_Word0a .. X_Word0b;
--//             Rid_Mask             at 2 * X_Word range X_Word0a .. X_Word0b;
--//             Motion_Buffer_Size   at 3 * X_Word range X_Word0a .. X_Word0b;
--//             N_Bytes_Vendor       at 4 * X_Word range X_Half0a .. X_Half0b;
--//             Max_Request_Size     at 4 * X_Word range X_Half1a .. X_Half1b;
--//             Num_Roots            at 5 * X_Word range X_Byte0a .. X_Byte0b;
--//             Num_Formats          at 5 * X_Word range X_Byte1a .. X_Byte1b;
--//             Image_Byte_Order     at 5 * X_Word range X_Byte2a .. X_Byte2b;
--//             Bitmap_Bit_Order     at 5 * X_Word range X_Byte3a .. X_Byte3b;
--//             Bitmap_Scanline_Unit at 6 * X_Word range X_Byte0a .. X_Byte0b;
--//             Bitmap_Scanline_Pad  at 6 * X_Word range X_Byte1a .. X_Byte1b;
--//             Min_Keycode          at 6 * X_Word range X_Byte2a .. X_Byte2b;
--//             Max_Keycode          at 6 * X_Word range X_Byte3a .. X_Byte3b;
--//             Pad2                 at 7 * X_Word range X_Word0a .. X_Word0b;
--//         end record;
--/ end if;

    procedure From_Raw is new Convert_Raw_To_Private (X_Conn_Setup);

    procedure Get_X_Conn_Setup is  
       new Get_Data_Private (X_Conn_Setup,  
                             From_Raw);

------------------------------------------------------------------------------
-- Initial Connection Burst Received
------------------------------------------------------------------------------

    type X_Conn_Setup_Prefix is  
        record  
            Success       : X_Boolean_Char;  
            Length_Reason : U_Char;         -- reason str length if failure
            Major_Version : U_Short;  
            Minor_Version : U_Short;  
            Length        : U_Short;        -- word count of setup info
        end record;

--/ if Length_Clauses then
    for X_Conn_Setup_Prefix'Size use 32 * 2;
--/ end if;

--/ if Record_Rep_Clauses then
--//     for X_Conn_Setup_Prefix use
--//         record
--//             Success       at 0 * X_Word range X_Byte0a .. X_Byte0b;
--//             Length_Reason at 0 * X_Word range X_Byte1a .. X_Byte1b;
--//             Major_Version at 0 * X_Word range X_Half1a .. X_Half1b;
--//             Minor_Version at 1 * X_Word range X_Half0a .. X_Half0b;
--//             Length        at 1 * X_Word range X_Half1a .. X_Half1b;
--//         end record;
--/ end if;

    procedure From_Raw is new Convert_Raw_To_Private (X_Conn_Setup_Prefix);

    procedure Get_X_Conn_Setup_Prefix is  
       new Get_Data_Private (X_Conn_Setup_Prefix,  
                             From_Raw);

------------------------------------------------------------------------------
-- X_Depths
------------------------------------------------------------------------------

    type X_Depths is  
        record  
            Depth     : U_Char;  
            Pad1      : U_Char;  
            N_Visuals : U_Short; -- number of X_Visual_Type's coming
            Pad2      : S_Long;  
        end record;

--/ if Length_Clauses then
    for X_Depths'Size use 32 * 2;
--/ end if;

--/ if Record_Rep_Clauses then
--//     for X_Depths use
--//         record
--//             Depth     at 0 * X_Word range X_Byte0a .. X_Byte0b;
--//             Pad1      at 0 * X_Word range X_Byte1a .. X_Byte1b;
--//             N_Visuals at 0 * X_Word range X_Half1a .. X_Half1b;
--//             Pad2      at 1 * X_Word range X_Word0a .. X_Word0b;
--//         end record;
--/ end if;

    procedure From_Raw is new Convert_Raw_To_Private (X_Depths);

    procedure Get_X_Depths is  
       new Get_Data_Private (X_Depths,  
                             From_Raw);

------------------------------------------------------------------------------
-- X_Pixmap_Format
------------------------------------------------------------------------------

    type X_Pixmap_Format is  
        record  
            Depth          : U_Char;  
            Bits_Per_Pixel : U_Char;  
            Scan_Line_Pad  : U_Char;  
            Pad1           : U_Char;  
            Pad2           : S_Long;  
        end record;

--/ if Length_Clauses then
    for X_Pixmap_Format'Size use 32 * 2;
--/ end if;

--/ if Record_Rep_Clauses then
--//     for X_Pixmap_Format use
--//         record
--//             Depth          at 0 * X_Word range X_Byte0a .. X_Byte0b;
--//             Bits_Per_Pixel at 0 * X_Word range X_Byte1a .. X_Byte1b;
--//             Scan_Line_Pad  at 0 * X_Word range X_Byte2a .. X_Byte2b;
--//             Pad1           at 0 * X_Word range X_Byte3a .. X_Byte3b;
--//             Pad2           at 1 * X_Word range X_Word0a .. X_Word0b;
--//         end record;
--/ end if;

    procedure From_Raw is new Convert_Raw_To_Private (X_Pixmap_Format);

    procedure Get_X_Pixmap_Format is  
       new Get_Data_Private (X_Pixmap_Format,  
                             From_Raw);

------------------------------------------------------------------------------
-- X_Visual_Type - Describes each visual type available at each depth
------------------------------------------------------------------------------

    type X_Visual_Type is  
        record  
            Vis_Id           : X_Visual_Id;  
            Class            : X_Display_Class;  
            Bits_Per_Rgb     : U_Char;  
            Colormap_Entries : U_Short;  
            Red_Mask         : X_Red_Color_Mask;  
            Green_Mask       : X_Green_Color_Mask;  
            Blue_Mask        : X_Blue_Color_Mask;  
            Pad              : S_Long;  
        end record;

--/ if Length_Clauses then
    for X_Visual_Type'Size use 32 * 6;
--/ end if;

--/ if Record_Rep_Clauses then
--//     for X_Visual_Type use
--//         record
--//             Vis_Id           at 0 * X_Word range X_Word0a .. X_Word0b;
--//             Class            at 1 * X_Word range X_Byte0a .. X_Byte0b;
--//             Bits_Per_Rgb     at 1 * X_Word range X_Byte1a .. X_Byte1b;
--//             Colormap_Entries at 1 * X_Word range X_Half1a .. X_Half1b;
--//             Red_Mask         at 2 * X_Word range X_Word0a .. X_Word0b;
--//             Green_Mask       at 3 * X_Word range X_Word0a .. X_Word0b;
--//             Blue_Mask        at 4 * X_Word range X_Word0a .. X_Word0b;
--//             Pad              at 5 * X_Word range X_Word0a .. X_Word0b;
--//         end record;
--/ end if;

    procedure From_Raw is new Convert_Raw_To_Private (X_Visual_Type);

    procedure Get_X_Visual_Type is  
       new Get_Data_Private (X_Visual_Type,  
                             From_Raw);

------------------------------------------------------------------------------
-- X_Window_Root
------------------------------------------------------------------------------

    type X_Window_Root is  
        record  
            Wind_Id            : X_Window;  
            Default_Colormap   : X_Colormap;  
            White_Pixel        : X_Pixel;  
            Black_Pixel        : X_Pixel;  
            Current_Input_Mask : X_Event_Mask;  
            Pix_Width          : U_Short;  
            Pix_Height         : U_Short;  
            Mm_Width           : U_Short;  
            Mm_Height          : U_Short;  
            Min_Installed_Maps : U_Short;  
            Max_Installed_Maps : U_Short;  
            Root_Visual_Id     : X_Visual_Id;  
            Backing_Store      : X_Backing_Store_Hint;  
            Save_Unders        : X_Boolean_Char;  
            Root_Depth         : U_Char;  
            N_Depths           : U_Char;  -- # X_Depths's following
        end record;

--/ if Length_Clauses then
    for X_Window_Root'Size use 32 * 10;
--/ end if;

--/ if Record_Rep_Clauses then
--//     for X_Window_Root use
--//         record
--//             Wind_Id            at 0 * X_Word range X_Word0a .. X_Word0b;
--//             Default_Colormap   at 1 * X_Word range X_Word0a .. X_Word0b;
--//             White_Pixel        at 2 * X_Word range X_Word0a .. X_Word0b;
--//             Black_Pixel        at 3 * X_Word range X_Word0a .. X_Word0b;
--//             Current_Input_Mask at 4 * X_Word range X_Word0a .. X_Word0b;
--//             Pix_Width          at 5 * X_Word range X_Half0a .. X_Half0b;
--//             Pix_Height         at 5 * X_Word range X_Half1a .. X_Half1b;
--//             Mm_Width           at 6 * X_Word range X_Half0a .. X_Half0b;
--//             Mm_Height          at 6 * X_Word range X_Half1a .. X_Half1b;
--//             Min_Installed_Maps at 7 * X_Word range X_Half0a .. X_Half0b;
--//             Max_Installed_Maps at 7 * X_Word range X_Half1a .. X_Half1b;
--//             Root_Visual_Id     at 8 * X_Word range X_Word0a .. X_Word0b;
--//             Backing_Store      at 9 * X_Word range X_Byte0a .. X_Byte0b;
--//             Save_Unders        at 9 * X_Word range X_Byte1a .. X_Byte1b;
--//             Root_Depth         at 9 * X_Word range X_Byte2a .. X_Byte2b;
--//             N_Depths           at 9 * X_Word range X_Byte3a .. X_Byte3b;
--//         end record;
--/ end if;

    procedure From_Raw is new Convert_Raw_To_Private (X_Window_Root);

    procedure Get_X_Window_Root is  
       new Get_Data_Private (X_Window_Root,  
                             From_Raw);

------------------------------------------------------------------------------

--\f

    procedure X_Open_Display (Name    :        X_String;  
                              Display : out    X_Display;  
                              Error   : in out X_Error_String) is
------------------------------------------------------------------------------
-- Open a connection to the display whose name is contained in Disp, e.g.
-- "Thumper:0".  If Display /= Null upon return then the connection has been set
-- up and is ready to go.  If Display = Null upon return then Error contains a
-- textual representation of what went wrong.  The new X_Display is attached
-- to the X_Lib parameter; X_Lib supplies the "global context" for the
-- X_Display.
------------------------------------------------------------------------------
        Ldisplay       : X_Display := None_X_Display;  
        Client         : X_Conn_Client_Prefix;      -- client information
        Prefix         : X_Conn_Setup_Prefix;       -- prefix information
        Display_Num    : U_Char;  
        Screen_Num     : X_Screen_Number;   -- screen number
        Family         : X_Host_Protocol_Family;  
        Server_Addr    : X_Network_Host_Address;  
        Root_Visual_Id : X_Visual_Id;  
        Void           : Proc_Var_X_Synchandler.Pv;  
        Succ           : X_Status;  
        Conn_Auth_Name : U_Char_List;  
        Conn_Auth_Data : U_Char_List;

        Short_Reply         : exception;  
        Connection_Io_Error : exception;

------------------------------------------------------------------------------

        procedure Abandon_Connection (Displayi : in out X_Display) is
            ------------------------------------------------------------------------------
            -- Abandon_Connection is called if we get I/O, storage, or other fatal
            -- errors.  X_Open_Display returns NULL for the Display after this
            -- returns.
            ------------------------------------------------------------------------------
        begin  
            Internal_X_Disconnect_Display (Displayi.Network);  
            Lock_Display (Displayi); -- Free will unlock it.
            Internal_X_Free_Display_Structure (Displayi);
            -- Xau_Dispose_Auth (Auth_Ptr);
            Displayi := null;  
        end Abandon_Connection;

------------------------------------------------------------------------------

        procedure Convert_Visuals (Root_Visual : in out X_Visual;  
                                   Visuals     : in out X_Visual_List;  
                                   Length      :        U_Short) is
            -----------------------------------------------------------------------
            -- Called by Convert_Depths to read N_Visuals worth of X_Visual_Types
            -- for an X_Depths record that is being read for an X_Window_Root record
            --  that is being read for a new connection.
            -----------------------------------------------------------------------
            V : X_Visual_Type;  
        begin

            ----Allocate a new visual array.

            Visuals                := new X_Visual_Array (1 .. Length);  
            Ldisplay.Total_Visuals :=  
               Ldisplay.Total_Visuals + S_Natural (Length);

            ----Convert the Visuals one record at a time.  Put each new visual
            --  into the Visuals array.

            for K in Visuals'Range loop

                Get_X_Visual_Type (Ldisplay, V);

                Visuals (K) :=  
                   new X_Visual_Rec'((Class        => V.Class,  
                                      Bits_Per_Rgb => V.Bits_Per_Rgb,  
                                      Map_Entries  => V.Colormap_Entries,  
                                      Red_Mask     => V.Red_Mask,  
                                      Green_Mask   => V.Green_Mask,  
                                      Blue_Mask    => V.Blue_Mask,  
                                      Ext_Data     => null,  
                                      Visual_Id    => V.Vis_Id));

                ----If we happen upon the Root Visual then return it.

                if V.Vis_Id = Root_Visual_Id then  
                    Root_Visual := Visuals (K);  
                end if;  
            end loop;

        end Convert_Visuals;

------------------------------------------------------------------------------

        procedure Convert_Depths (Root_Visual : in out X_Visual;  
                                  Depths      : in out X_Depth_List;  
                                  Length      :        U_Char) is
            -----------------------------------------------------------------------
            -- Called below to read N_Depths worth of X_Depths for an
            --  X_Window_Root record that is being read for a new connection.
            -----------------------------------------------------------------------
            D : X_Depths;  
        begin

            ----Allocate the new Depths array and then fill it.

            Depths := new X_Depth_Array (1 .. Length);

            ----Convert each Depth and read the Visuals that follow each one.

            for J in Depths'Range loop  
                Get_X_Depths (Ldisplay, D);

                ----Create the new Depth and read it's Visuals.

                Depths (J) := (Depth   => D.Depth,  
                               Visuals => null);  
                Convert_Visuals (Root_Visual,  
                                 Depths (J).Visuals,  
                                 D.N_Visuals);  
            end loop;

        end Convert_Depths;

------------------------------------------------------------------------------
----Continue the body of X_Open_Display

    begin

----Init our OUT parameters that might not otherwise be set if we get an error.

        Display := None_X_Display;

----Get the display name to use.  X_Display_Name takes care of looking at
--  environment variables if Name is empty.

        declare  
            Dname : constant X_String := X_Display_Name (Name);  
        begin  
            if Dname = "" then  
                Err (Error,  
                     X_Get_Error_String ("XlibError", "NoHost",  
                                         "No host or display name was given."));  
                return;  
            end if;

----Set the default error handlers.  This allows the global variables to
--  default to NULL for use with shared libraries.

----Attempt to allocate a display structure.

            Ldisplay      := new X_Display_Rec;  
            Ldisplay.Lock := new X_Mutex_Rec;

----Call the Connect routine to get the network socket.  The Succ status
--  indicates whether or not the connection failed.  The connect routine will
--  return the expanded display name in displaybuf.  Error are reported in
--  the Error string so we don't have to worry about doing that.

            Internal_X_Connect_Display (Display_Name  => Dname,  
                                        Expanded_Name => Ldisplay.Display_Name,  
                                        Display_Num   => Display_Num,  
                                        Screen_Num    => Screen_Num,  
                                        Family        => Family,  
                                        Server_Addr   => Server_Addr,  
                                        Connection    => Ldisplay.Network,  
                                        Status        => Succ,  
                                        Error         => Error);  
            if Succ = Failed then  
                Lock_Display (Ldisplay); -- Free will unlock it.
                Internal_X_Free_Display_Structure (Ldisplay);  
                return;  
            end if;  
        end;

----Look up the authorization protocol name and data if necessary.

        X_Lib.Get_Authorization (Conn_Auth_Name, Conn_Auth_Data);  
        if Conn_Auth_Name = None_U_Char_List or else  
           Conn_Auth_Data = None_U_Char_List then  
            declare  
                Num : constant X_String := To_X_String  
                                              (U_Char'Image (Display_Num));  
            begin
                -- Auth_Ptr := Xau_Get_Auth_By_Addr
                --                (Family      => Family,
                --                 Server_Addr => Server_Addr,
                --                 Display_Num => Num (Num'First + 1 .. Num'Last),
                --                 Auth_Name   => conn_Auth_Name);
                -- if Auth_Ptr /= None_X_Auth then
                --     Conn_Auth_Name := Auth_Ptr.Name;
                --     Conn_Auth_Data := Auth_Ptr.Data;
                -- else
                Conn_Auth_Name := None_U_Char_List;  
                Conn_Auth_Data := None_U_Char_List;
                -- end if;
            end;  
        end if;

----Free the Server_Addr data.  We won't need it further.

        Free_X_Network_Host_Address (Server_Addr);

----Send the Hello message.  The first byte of the Hello message is the byte
--  order code.  The authentication key is normally sent right after the
--  connection.  This (in MIT's case) will be Kerberos.

        Client.Byte_Order    := Character'Pos (X_Lib_Indian);  
        Client.Major_Version := Xlbmt_Parameters.X_Protocol;  
        Client.Minor_Version := Xlbmt_Parameters.X_Protocol_Revision;  
        if Conn_Auth_Name /= None_U_Char_List then  
            Client.N_Bytes_Auth_Proto := Conn_Auth_Name'Length;  
        else  
            Client.N_Bytes_Auth_Proto := 0;  
        end if;  
        if Conn_Auth_Data /= None_U_Char_List then  
            Client.N_Bytes_Auth_String := Conn_Auth_Data'Length;  
        else  
            Client.N_Bytes_Auth_String := 0;  
        end if;

----Put the X_Conn_Client_Prefix record in the buffer.

        Put_X_Conn_Client_Prefix (Ldisplay, Client);

----Put the Conn_Auth_Name in the buffer.

        if Conn_Auth_Name /= None_U_Char_List then  
            Put_U_Char_Array (Ldisplay, Conn_Auth_Data.all);  
        end if;

----Put the Conn_Auth_Data in the buffer;

        if Conn_Auth_Data /= None_U_Char_List then  
            Put_U_Char_Array (Ldisplay, Conn_Auth_Data.all);  
        end if;

----Get rid of the authorization information.

        -- Xau_Dispose_Auth (Auth_Ptr);

----Transmit our information and check for errors.

        Internal_X_Flush_Display (Ldisplay);

----Now see if connection was accepted...

        Get_X_Conn_Setup_Prefix (Ldisplay, Prefix);

----Check the Major/Minor version numbers to see if they match.

        if Prefix.Major_Version < Xlbmt_Parameters.X_Protocol then  
            X_Report_Warning  
               ("XlibMessage", "OldMajor",  
                "Xlib; Mismatch on major version.  Client built for major" &  
                   Lf &  
                   "version %1 and server is version %2.",  
                To_X_String (S_Natural'Image (Xlbmt_Parameters.X_Protocol)),  
                To_X_String  
                   (S_Natural'Image (S_Natural (Prefix.Major_Version))) & '.');  
        end if;  
        if Prefix.Minor_Version /= Xlbmt_Parameters.X_Protocol_Revision then  
            X_Report_Warning  
               ("XlibMessage", "OldMinor",  
                "Xlib; Mismatch on minor version.  Client built for minor" &  
                   Lf &  
                   "version %1 and server is version %2.",  
                To_X_String  
                   (S_Natural'Image (Xlbmt_Parameters.X_Protocol_Revision)),  
                To_X_String  
                   (S_Natural'Image (S_Natural (Prefix.Minor_Version))) & '.');  
        end if;

----If the connection is refused then grab the reason and return.

        if Prefix.Success = False then  
            declare  
                Reason : X_String (1 .. S_Natural (Prefix.Length) * 4);  
                Last   : S_Natural := Reason'Last;  
            begin  
                Get_X_String (Ldisplay, Reason);  
                for I in reverse Reason'Last - 2 .. Reason'Last loop  
                    if Reason (I) = Nul then  
                        Last := I;  
                        exit;  
                    end if;  
                end loop;  
                Err (Error,  
                     X_Get_Error_String ("XlibError", "ConnectRefused",  
                                         "X server connection refused:") &  
                     ' ' & Reason (1 .. Last));  
                Abandon_Connection (Ldisplay);  
                return;  
            end;  
        end if;

----The connection was accepted.  Read the rest of the setup information.

        declare  
            Setup : X_Conn_Setup;  
        begin  
            Get_X_Conn_Setup (Ldisplay, Setup);

----We succeeded at authorization, so let us move the data into the display
--  structure.

            Ldisplay.Proto_Major_Version := Prefix.Major_Version;  
            Ldisplay.Proto_Minor_Version := Prefix.Minor_Version;  
            Ldisplay.Release := Setup.Release;  
            Ldisplay.Resource_Base := Setup.Rid_Base;  -- base of all ID's
            Ldisplay.Resource_Id := (Number => 0);  
            Ldisplay.Resource_Mask := Setup.Rid_Mask;  
            Ldisplay.Resource_Incr :=            -- Just 1 bit at bottom of mask
               (Shift (Ldisplay.Resource_Mask.Number, 1) xor  
                Ldisplay.Resource_Mask.Number) and  
               Ldisplay.Resource_Mask.Number;  
            Ldisplay.Min_Keycode := Setup.Min_Keycode;  
            Ldisplay.Max_Keycode := Setup.Max_Keycode;  
            Ldisplay.Motion_Buffer := Setup.Motion_Buffer_Size;  
            Ldisplay.Byte_Order := Setup.Image_Byte_Order;  
            Ldisplay.Bitmap_Unit := Setup.Bitmap_Scanline_Unit;  
            Ldisplay.Bitmap_Pad := Setup.Bitmap_Scanline_Pad;  
            Ldisplay.Bitmap_Bit_Order := Setup.Bitmap_Bit_Order;  
            Ldisplay.Max_Request_Size := Setup.Max_Request_Size;  
            Ldisplay.Event_Vec :=  
               X_Wire_Event_Array'(others =>  
                                      X_Lib_Default_X_Unknown_Wire_Event);  
            Ldisplay.Wire_Vec :=  
               X_Event_Wire_Array'(others =>  
                                      X_Lib_Default_X_Unknown_Native_Event);  
            Ldisplay.Reply_Size := X_Reply_Contents_Size;

----Compute maximum sizes for the various Poly-whatever graphics requests
--  that we are willing to generate.

            Ldisplay.Poly_Arc_Limit       :=
               (S_Natural (Ldisplay.Max_Request_Size) - 8) /  
                  (X_Arc'Size / 32);  
            Ldisplay.Poly_Point_Limit     :=
               (S_Natural (Ldisplay.Max_Request_Size) - 8) /  
                  (X_Point'Size / 32);  
            Ldisplay.Poly_Rectangle_Limit :=
               (S_Natural (Ldisplay.Max_Request_Size) - 8) /  
                  (X_Rectangle'Size / 32);  
            Ldisplay.Poly_Segment_Limit   :=
               (S_Natural (Ldisplay.Max_Request_Size) - 8) /  
                  (X_Segment'Size / 32);


----Now init event_Vec/Wire_Vec the way we really want it.  Ada is too stupid
--  to realize that "Key_Press..Last_Event-1" is a "static" expression so we
--  can't use an aggregate.

            for I in Key_Press .. X_Event_Code'Pred (Last_Event) loop  
                Ldisplay.Event_Vec (I) := X_Lib_Default_X_Wire_To_Event;  
                Ldisplay.Wire_Vec (I)  := None_X_Procedure_Variable;  
            end loop;

----Now extract the vendor str...  String must be null terminated, padded to
--  multiple of 4 bytes.

            Ldisplay.Vendor := new X_String  
                                      (1 .. S_Natural (Setup.N_Bytes_Vendor));  
            Get_X_String (Ldisplay, Ldisplay.Vendor.all);

----Now iterate down setup information.....
--  First decode the Z axis Screen format information.

            declare  
                Pm     : X_Pixmap_Format;  
                Length : S_Natural := S_Natural (Setup.Num_Formats);  
            begin  
                Ldisplay.Pixmap_Format :=  
                   new X_Screen_Format_Array (0 .. U_Char (Length - 1));  
                for I in Ldisplay.Pixmap_Format'Range loop  
                    Get_X_Pixmap_Format (Ldisplay, Pm);  
                    Ldisplay.Pixmap_Format (I) :=  
                       new X_Screen_Format_Rec'  
                              ((Depth          => Pm.Depth,  
                                Bits_Per_Pixel => Pm.Bits_Per_Pixel,  
                                Scan_Line_Pad  => Pm.Scan_Line_Pad,  
                                Ext_Data       => null));  
                end loop;  
            end;

----Next the Screen structures.  Deal with each one in turn.

            declare  
                Wr     : X_Window_Root;  
                Length : S_Natural := S_Natural (Setup.Num_Roots);  
            begin  
                Ldisplay.Screens :=  
                   new X_Screen_Array (0 .. X_Screen_Number (Length - 1));

                for I in Ldisplay.Screens'Range loop  
                    Get_X_Window_Root (Ldisplay, Wr);

                    Ldisplay.Screens (I) :=  
                       new X_Screen_Rec'  
                              ((Display          => Ldisplay,  
                                Root             => Wr.Wind_Id,  
                                Default_Colormap => Wr.Default_Colormap,  
                                White_Pixel      => Wr.White_Pixel,  
                                Black_Pixel      => Wr.Black_Pixel,  
                                Root_Input_Mask  => Wr.Current_Input_Mask,  
                                Width            => Wr.Pix_Width,  
                                Height           => Wr.Pix_Height,  
                                Mm_Width         => Wr.Mm_Width,  
                                Mm_Height        => Wr.Mm_Height,  
                                Min_Maps         => Wr.Min_Installed_Maps,  
                                Max_Maps         => Wr.Max_Installed_Maps,  
                                Root_Visual      => null,
                                -- filled in later, when we alloc Visuals
                                Backing_Store    => Wr.Backing_Store,  
                                Save_Unders      => Wr.Save_Unders =  
                                                       True,  
                                Root_Depth       => Wr.Root_Depth,  
                                Depths           => null,  
                                Default_Gc       => null,  
                                Ext_Data         => null));

                    Root_Visual_Id := Wr.Root_Visual_Id;

----Let's set up the depth structures for this screen.

                    Convert_Depths (Ldisplay.Screens (I).Root_Visual,  
                                    Ldisplay.Screens (I).Depths,  
                                    Wr.N_Depths);

                end loop;  
            end;

----Setup other information in this display structure.

            Ldisplay.Vnumber           := Xlbmt_Parameters.X_Protocol;  
            Ldisplay.Resource_Alloc    := X_Lib_Default_X_Alloc_Id;  
            Ldisplay.Default_Screen    :=  
               Screen_Num;  -- Value returned by Connect_Display
            Ldisplay.Last_Request.Kind := Invalid_Request;

----Now start talking to the server to setup all other information...

        end;

----Call into synchronization routine to make sure that we are synchronized.

        declare  
            Flag : Boolean;  
        begin  
            X_Lib.Get_Debug (Flag);  
            Void := X_Synchronize (Ldisplay, Flag);  
        end;

----Chain this stucture onto global list.

        X_Lib.Add_Display (Ldisplay);

----Make sure default screen is legal.

        if Screen_Num not in Ldisplay.Screens'Range then  
            Err (Error, X_Get_Error_String  
                           ("XlibError", "BadScrNum",  
                            "Screen number is out of server-defined range."));  
            Abandon_Connection (Ldisplay);  
            return;  
        end if;

----Set up other stuff clients are always going to use.

        for I in Ldisplay.Screens'Range loop  
            declare  
                Values : X_Gc_Values;  
            begin  
                Values.Foreground := Ldisplay.Screens (I).Black_Pixel;  
                Values.Background := Ldisplay.Screens (I).White_Pixel;  
                Ldisplay.Screens (I).Default_Gc :=  
                   X_Create_Gc  
                      (Ldisplay, Ldisplay.Screens (I).Root.Drawable,  
                       (Gc_Foreground | Gc_Background => True, others => False),  
                       Values);  
            end;  
        end loop;

----Get the resource manager database off the root window.

        declare  
            Actual_Type   : X_Atom;  
            Actual_Format : U_Char;  
            N_Items       : S_Natural;  
            Leftover      : S_Natural;  
            Data          : U_Char_List;  
        begin  
            X_Get_Window_Property  
               (Display        => Ldisplay,  
                Window         => X_Root_Window (Ldisplay, 0),  
                Property       => Xa_Resource_Manager,  
                Offset         => 0,  
                Maximum_Length => S_Long'Last / 4, --100_000_000,
                Delete         => False,  
                Representation => Xa_String,  
                Actual_Type    => Actual_Type,  
                Actual_Format  => Actual_Format,  
                N_Items        => N_Items,  
                Bytes_After    => Leftover,  
                Data           => Data,  
                Status         => Succ);  
            if Succ /= Failed then  
                if Actual_Type /= Xa_String or else  
                   Actual_Format /= 8 then  
                    Free_X_String_Pointer (Ldisplay.X_Defaults);  
                end if;  
            end if;  
            if Data /= None_U_Char_List then  
                Ldisplay.X_Defaults := new X_String (1 .. Data'Length);  
                From_Uca (Ldisplay.X_Defaults.all, Data.all);  
            else  
                Ldisplay.X_Defaults := None_X_String_Pointer;  
            end if;  
        exception  
            when others =>  
                Free_U_Char_List (Data);  
                raise;  
        end;  
        Ldisplay.Database := Univ_X_Rm_Database.To_X_Universal_Pointer  
                                (new X_Rm_Database_Rec);

----What do you know?  We made it.  Return the Display and go.

        Display := Ldisplay;  
        return;

----Handle the more onerous exceptions here.

    exception

        when Connection_Io_Error =>  
            Error := Ldisplay.Last_Error;  
            Abandon_Connection (Ldisplay);  
            return;

        when Short_Reply =>  
            Err (Error, X_Get_Error_String  
                           ("XlibError", "ShortHello",  
                            "Initial X server response too short."));  
            Abandon_Connection (Ldisplay);  
            return;

        when Storage_Error =>  
            Err (Error, X_Get_Error_String ("XlibError", "NoMemory",  
                                            "No free memory available."));  
            Abandon_Connection (Ldisplay);  
            return;

        when others =>  
            Abandon_Connection (Ldisplay);  
            raise;

    end X_Open_Display;

--\f

    procedure X_Close_Display (Display : in out X_Display) is
------------------------------------------------------------------------------
-- X_Sync the connection to the X server; close a connection that was
-- previously opened via X_Open_Display; free all associated storage.
------------------------------------------------------------------------------
        Ext : X_Extension;  
        Dp  : X_Display;  
        Cp  : X_Display;  
        Gc  : X_Gc;  
    begin

----Sync up with the server and discard all pending input events.

        Display.Flags (Xlib_Display_Closing) := True;  
        X_Sync (Display, Discard => True);

----Tell all of the extensions that this display is going away.

        Ext := Display.Ext_Procs;  
        while Ext /= null loop  
            if Ext.Close_Display /=  
               None_X_Procedure_Variable then  
                Proc_Var_X_Close_Display_Extension.Call  
                   (Proc_Var_X_Close_Display_Extension.To_Pv  
                       (Ext.Close_Display), Display, Ext.Codes);  
            end if;  
            Ext := Ext.Next;  
        end loop;

----Free the GC's for all of the screens.

        for I in Display.Screens'Range loop  
            Gc := Display.Screens (I).Default_Gc;  
            if Gc.Ext_Data /= null then  
                Free_X_Ext_Data_List (Gc.Ext_Data);  
            end if;  
            Free_X_Gc (Display.Screens (I).Default_Gc);  
        end loop;

----Free the cursor font, if any.

        if Display.Cursor_Font /= None_X_Font then  
            X_Unload_Font (Display, Display.Cursor_Font);  
        end if;

----Begin the actual disconnection.

        Lock_Display (Display);               -- Prevent other use
        Internal_X_Disconnect_Display (Display.Network); -- Actually disconnect

----Remove the display from the list of open displays and free the storage.

        X_Lib.Remove_Display (Display);  
        Internal_X_Free_Display_Structure (Display);

    end X_Close_Display;

--\f

    procedure X_No_Op (Display : X_Display) is
------------------------------------------------------------------------------
-- Send a No-Operation request to the server.
------------------------------------------------------------------------------
    begin

----Lock the display.

        Lock_Display (Display);  
        begin

----Send the request.

            Put_X_No_Operation_Request  
               (Display, (Kind   => No_Operation,  
                          Length => X_No_Operation_Request'Size / 32,  
                          Pad    => 0));

----Catch unexpected exceptions and unlock the display before passing them on.

        exception  
            when others =>  
                Unlock_Display (Display);  
                raise;  
        end;

----Unlock the display and return.

        Unlock_Display (Display);  
        Sync_Handle (Display);

    end X_No_Op;

--\f

------------------------------------------------------------------------------
-- Display functions
------------------------------------------------------------------------------

    function X_All_Planes return X_Plane_Mask is  
    begin  
        return All_Planes;  
    end X_All_Planes;

------------------------------------------------------------------------------

    function X_Bitmap_Bit_Order (Display : X_Display) return X_Byte_Bit_Order is  
    begin  
        return Display.Bitmap_Bit_Order;  
    end X_Bitmap_Bit_Order;

------------------------------------------------------------------------------

    function X_Bitmap_Pad (Display : X_Display) return U_Char is  
    begin  
        return Display.Bitmap_Pad;  
    end X_Bitmap_Pad;

------------------------------------------------------------------------------

    function X_Bitmap_Unit (Display : X_Display) return U_Char is  
    begin  
        return Display.Bitmap_Unit;  
    end X_Bitmap_Unit;

------------------------------------------------------------------------------

    function X_Connection_Number (Display : X_Display)  
                                 return X_Network_Connection is  
    begin  
        return Display.Network;  
    end X_Connection_Number;

------------------------------------------------------------------------------

    function X_Default_Root_Window (Display : X_Display) return X_Window is  
    begin  
        return Display.Screens (Display.Default_Screen).Root;  
    end X_Default_Root_Window;

------------------------------------------------------------------------------

    function X_Default_Screen (Display : X_Display) return X_Screen_Number is  
    begin  
        return Display.Default_Screen;  
    end X_Default_Screen;

------------------------------------------------------------------------------

    function X_Default_Screen_Of_Display  
                (Display : X_Display) return X_Screen is  
    begin  
        return Display.Screens (Display.Default_Screen);  
    end X_Default_Screen_Of_Display;

------------------------------------------------------------------------------

    function X_Display_Name (Display : X_String) return X_String is
------------------------------------------------------------------------------
-- If the parameter is "" then we query the Environment to determine the
-- name of the default display to be used.  If the parameter is not "" then
-- we simply return it.
------------------------------------------------------------------------------
        Ptr : X_String_Pointer;  
    begin

        if Display /= "" and then  
           Display (Display'First) /= Nul then  
            return Display;  
        end if;  
        Ptr := X_Env_Get_Environment_Variable ("DISPLAY");  
        if Ptr = None_X_String_Pointer then  
            return "";  
        end if;  
        declare  
            Str : constant X_String := Ptr.all;  
        begin  
            Free_X_String_Pointer (Ptr);  
            return Str;  
        end;

    end X_Display_Name;

------------------------------------------------------------------------------

    function X_Display_String (Display : X_Display) return X_String is  
    begin  
        return Display.Display_Name.all;  
    end X_Display_String;

------------------------------------------------------------------------------

    function X_Image_Byte_Order (Display : X_Display) return X_Byte_Bit_Order is  
    begin  
        return Display.Byte_Order;  
    end X_Image_Byte_Order;

------------------------------------------------------------------------------

    function X_Last_Known_Request_Processed  
                (Display : X_Display) return S_Long is  
    begin  
        return Display.Last_Request_Read;  
    end X_Last_Known_Request_Processed;

------------------------------------------------------------------------------

    function X_List_Pixmap_Formats (Display : X_Display)  
                                   return X_Pixmap_Format_Values_List is
------------------------------------------------------------------------------
--  Display - Specifies the display to use.
--
-- Returns an array of X_Pixmap_Format_Values that describe the types of Z
-- format images that are supported by the specified display.
------------------------------------------------------------------------------
        Formats : X_Pixmap_Format_Values_List :=  
           new X_Pixmap_Format_Values_Array  
                  (S_Natural (Display.Pixmap_Format'First) ..  
                      S_Natural (Display.Pixmap_Format'Last));  
    begin

        for I in Display.Pixmap_Format'Range loop  
            Formats (S_Natural (I)).Depth := Display.Pixmap_Format (I).Depth;  
            Formats (S_Natural (I)).Bits_Per_Pixel :=  
               Display.Pixmap_Format (I).Bits_Per_Pixel;  
            Formats (S_Natural (I)).Scan_Line_Pad :=  
               Display.Pixmap_Format (I).Scan_Line_Pad;  
        end loop;  
        return Formats;

    end X_List_Pixmap_Formats;

------------------------------------------------------------------------------

    function X_Max_Request_Size (Display : X_Display) return U_Short is  
    begin  
        return Display.Max_Request_Size;  
    end X_Max_Request_Size;

------------------------------------------------------------------------------

    function X_Next_Request (Display : X_Display) return S_Long is  
    begin  
        return Display.Request + 1;  
    end X_Next_Request;

------------------------------------------------------------------------------

    function X_Protocol_Revision (Display : X_Display) return U_Short is  
    begin  
        return Display.Proto_Minor_Version;  
    end X_Protocol_Revision;

------------------------------------------------------------------------------

    function X_Protocol_Version (Display : X_Display) return U_Short is  
    begin  
        return Display.Proto_Major_Version;  
    end X_Protocol_Version;

------------------------------------------------------------------------------

    function X_Q_Length (Display : X_Display) return S_Long is  
    begin  
        return Display.Q_Len;  
    end X_Q_Length;

------------------------------------------------------------------------------

    function X_Resource_Database (Display : X_Display) return X_Rm_Database is  
        Db : X_Rm_Database := None_X_Rm_Database;  
    begin

----Lock the display.

        Lock_Display (Display);

----Get the database; if there is one.

        if Display.Database /= None_X_Universal_Pointer then  
            Db := Univ_X_Rm_Database.From_X_Universal_Pointer  
                     (Display.Database);  
        end if;

----Unlock and return the database.

        Unlock_Display (Display);  
        return Db;

    exception  
        when others =>  
            Unlock_Display (Display);  
            raise;

    end X_Resource_Database;

------------------------------------------------------------------------------

    function X_Resource_Manager_String  
                (Display : X_Display) return X_String_Pointer is  
    begin  
        return Display.X_Defaults;  
    end X_Resource_Manager_String;

------------------------------------------------------------------------------

    procedure X_Set_Resource_Database (Display  : X_Display;  
                                       Database : X_Rm_Database) is  
        New_Uv : X_Universal_Pointer := None_X_Universal_Pointer;  
    begin

----Lock the display.

        Lock_Display (Display);

----If we have a new database then get a universal pointer for it; this may
--  fail with storage error and such so do it before we zap the old database.

        if Database /= None_X_Rm_Database then  
            New_Uv := Univ_X_Rm_Database.To_X_Universal_Pointer (Database);  
        end if;

----If there is an old database then free the universal pointer; never the
--  database.

        if Display.Database /= None_X_Universal_Pointer then  
            Univ_X_Rm_Database.Free_X_Universal_Pointer (Display.Database);  
        end if;

----Set the new database and unlock the display.

        Display.Database := New_Uv;  
        Unlock_Display (Display);

    exception  
        when others =>  
            Unlock_Display (Display);  
            raise;  
    end X_Set_Resource_Database;

------------------------------------------------------------------------------

    function X_Screen_Count (Display : X_Display) return X_Screen_Number is  
    begin  
        return Display.Screens'Length;  
    end X_Screen_Count;

------------------------------------------------------------------------------

    function X_Server_Vendor (Display : X_Display) return X_String is  
    begin  
        return Display.Vendor.all;  
    end X_Server_Vendor;

------------------------------------------------------------------------------

    function X_Vendor_Release (Display : X_Display) return S_Long is  
    begin  
        return Display.Release;  
    end X_Vendor_Release;

------------------------------------------------------------------------------

--\f

------------------------------------------------------------------------------
-- Screen N of Display functions
------------------------------------------------------------------------------

    function X_Black_Pixel (Display : X_Display;  
                            Screen  : X_Screen_Number) return X_Pixel is  
    begin  
        return Display.Screens (Screen).Black_Pixel;  
    end X_Black_Pixel;

------------------------------------------------------------------------------

    function X_Default_Colormap (Display : X_Display;  
                                 Screen  : X_Screen_Number) return X_Colormap is  
    begin  
        return Display.Screens (Screen).Default_Colormap;  
    end X_Default_Colormap;

------------------------------------------------------------------------------

    function X_Default_Depth (Display : X_Display;  
                              Screen  : X_Screen_Number) return U_Char is  
    begin  
        return Display.Screens (Screen).Root_Depth;  
    end X_Default_Depth;

------------------------------------------------------------------------------

    function X_Default_Gc (Display : X_Display;  
                           Screen  : X_Screen_Number) return X_Gc is  
    begin  
        return Display.Screens (Screen).Default_Gc;  
    end X_Default_Gc;

------------------------------------------------------------------------------

    function X_Default_Visual (Display : X_Display;  
                               Screen  : X_Screen_Number) return X_Visual is  
    begin  
        return Display.Screens (Screen).Root_Visual;  
    end X_Default_Visual;

------------------------------------------------------------------------------

    function X_Display_Cells (Display : X_Display;  
                              Screen  : X_Screen_Number) return U_Short is  
    begin  
        return X_Default_Visual (Display, Screen).Map_Entries;  
    end X_Display_Cells;

------------------------------------------------------------------------------

    function X_Display_Height (Display : X_Display;  
                               Screen  : X_Screen_Number) return U_Short is  
    begin  
        return Display.Screens (Screen).Height;  
    end X_Display_Height;

------------------------------------------------------------------------------

    function X_Display_Height_Mm (Display : X_Display;  
                                  Screen  : X_Screen_Number) return U_Short is  
    begin  
        return Display.Screens (Screen).Mm_Height;  
    end X_Display_Height_Mm;

------------------------------------------------------------------------------

    function X_Display_Planes (Display : X_Display;  
                               Screen  : X_Screen_Number) return U_Char is  
    begin  
        return Display.Screens (Screen).Root_Depth;  
    end X_Display_Planes;

------------------------------------------------------------------------------

    function X_Display_Width (Display : X_Display;  
                              Screen  : X_Screen_Number) return U_Short is  
    begin  
        return Display.Screens (Screen).Width;  
    end X_Display_Width;

------------------------------------------------------------------------------

    function X_Display_Width_Mm (Display : X_Display;  
                                 Screen  : X_Screen_Number) return U_Short is  
    begin  
        return Display.Screens (Screen).Mm_Width;  
    end X_Display_Width_Mm;

------------------------------------------------------------------------------

    function X_List_Depths (Display : X_Display;  
                            Screen  : X_Screen_Number) return U_Char_List is
------------------------------------------------------------------------------
--  Display - Specifies the display to use.
--  Screen - Specifies the number of the screen connected to the display.
--
-- Returns an array of the supported depths for this screen.
------------------------------------------------------------------------------
        Scr    : X_Screen;  
        Result : U_Char_List;  
    begin

        if Screen not in Display.Screens'Range then  
            return None_U_Char_List;  
        end if;

        Scr    := Display.Screens (Screen);  
        Result := new U_Char_Array (S_Natural (Scr.Depths'First) ..  
                                       S_Natural (Scr.Depths'Last));  
        for I in Scr.Depths'Range loop  
            Result (S_Natural (I)) := Scr.Depths (I).Depth;  
        end loop;  
        return Result;

    end X_List_Depths;

------------------------------------------------------------------------------

    function X_Root_Window (Display : X_Display;  
                            Screen  : X_Screen_Number) return X_Window is  
    begin  
        return Display.Screens (Screen).Root;  
    end X_Root_Window;

------------------------------------------------------------------------------

    function X_Screen_Of_Display (Display : X_Display;  
                                  Screen  : X_Screen_Number) return X_Screen is  
    begin  
        return Display.Screens (Screen);  
    end X_Screen_Of_Display;

------------------------------------------------------------------------------

    function X_White_Pixel (Display : X_Display; Screen : X_Screen_Number)  
                           return X_Pixel is  
    begin  
        return Display.Screens (Screen).White_Pixel;  
    end X_White_Pixel;

------------------------------------------------------------------------------

--\f

------------------------------------------------------------------------------
-- Screen oriented functions (toolkit)
------------------------------------------------------------------------------

    function X_Black_Pixel_Of_Screen (Screen : X_Screen) return X_Pixel is  
    begin  
        return Screen.Black_Pixel;  
    end X_Black_Pixel_Of_Screen;

------------------------------------------------------------------------------

    function X_Cells_Of_Screen (Screen : X_Screen) return U_Short is  
    begin  
        return X_Default_Visual_Of_Screen (Screen).Map_Entries;  
    end X_Cells_Of_Screen;

------------------------------------------------------------------------------

    function X_Default_Colormap_Of_Screen  
                (Screen : X_Screen) return X_Colormap is  
    begin  
        return Screen.Default_Colormap;  
    end X_Default_Colormap_Of_Screen;

------------------------------------------------------------------------------

    function X_Default_Depth_Of_Screen (Screen : X_Screen) return U_Char is  
    begin  
        return Screen.Root_Depth;  
    end X_Default_Depth_Of_Screen;

------------------------------------------------------------------------------

    function X_Default_Gc_Of_Screen (Screen : X_Screen) return X_Gc is  
    begin  
        return Screen.Default_Gc;  
    end X_Default_Gc_Of_Screen;

------------------------------------------------------------------------------

    function X_Default_Visual_Of_Screen (Screen : X_Screen) return X_Visual is  
    begin  
        return Screen.Root_Visual;  
    end X_Default_Visual_Of_Screen;

------------------------------------------------------------------------------

    function X_Display_Of_Screen (Screen : X_Screen) return X_Display is  
    begin  
        return Screen.Display;  
    end X_Display_Of_Screen;

------------------------------------------------------------------------------

    function X_Does_Backing_Store (Screen : X_Screen)  
                                  return X_Backing_Store_Hint is  
    begin  
        return Screen.Backing_Store;  
    end X_Does_Backing_Store;

------------------------------------------------------------------------------

    function X_Does_Save_Unders (Screen : X_Screen) return Boolean is  
    begin  
        return Screen.Save_Unders;  
    end X_Does_Save_Unders;

------------------------------------------------------------------------------

    function X_Event_Mask_Of_Screen (Screen : X_Screen) return X_Event_Mask is  
    begin  
        return Screen.Root_Input_Mask;  
    end X_Event_Mask_Of_Screen;

------------------------------------------------------------------------------

    function X_Height_Of_Screen (Screen : X_Screen) return U_Short is  
    begin  
        return Screen.Height;  
    end X_Height_Of_Screen;

------------------------------------------------------------------------------

    function X_Height_Mm_Of_Screen (Screen : X_Screen) return U_Short is  
    begin  
        return Screen.Mm_Height;  
    end X_Height_Mm_Of_Screen;

------------------------------------------------------------------------------

    function X_Max_Cmaps_Of_Screen (Screen : X_Screen) return U_Short is  
    begin  
        return Screen.Max_Maps;  
    end X_Max_Cmaps_Of_Screen;

------------------------------------------------------------------------------

    function X_Min_Cmaps_Of_Screen (Screen : X_Screen) return U_Short is  
    begin  
        return Screen.Min_Maps;  
    end X_Min_Cmaps_Of_Screen;

------------------------------------------------------------------------------

    function X_Planes_Of_Screen (Screen : X_Screen) return U_Char is  
    begin  
        return Screen.Root_Depth;  
    end X_Planes_Of_Screen;

------------------------------------------------------------------------------

    function X_Root_Window_Of_Screen (Screen : X_Screen) return X_Window is  
    begin  
        return Screen.Root;  
    end X_Root_Window_Of_Screen;

------------------------------------------------------------------------------

    function X_Screen_Number_Of_Screen  
                (Screen : X_Screen) return X_Screen_Number is  
    begin  
        for I in Screen.Display.Screens'Range loop  
            if Screen = Screen.Display.Screens (I) then  
                return I;  
            end if;  
        end loop;  
    end X_Screen_Number_Of_Screen;

------------------------------------------------------------------------------

    function X_White_Pixel_Of_Screen (Screen : X_Screen) return X_Pixel is  
    begin  
        return Screen.White_Pixel;  
    end X_White_Pixel_Of_Screen;

------------------------------------------------------------------------------

    function X_Width_Of_Screen (Screen : X_Screen) return U_Short is  
    begin  
        return Screen.Width;  
    end X_Width_Of_Screen;

------------------------------------------------------------------------------

    function X_Width_Mm_Of_Screen (Screen : X_Screen) return U_Short is  
    begin  
        return Screen.Mm_Width;  
    end X_Width_Mm_Of_Screen;

------------------------------------------------------------------------------

    function X_Visual_Id_From_Visual (Visual : X_Visual) return X_Visual_Id is  
    begin  
        return Visual.Visual_Id;  
    end X_Visual_Id_From_Visual;
------------------------------------------------------------------------------

--\f

begin

    X_Lib_Default_X_Alloc_Id :=  
       Proc_Var_X_Alloc_Id.From_Pv (Default_X_Alloc_Id);

    if X_Conn_Client_Prefix'Size /= 8 * 4 * 3 then  
        raise X_Library_Confusion;  
    end if;  
    if X_Conn_Setup'Size /= 8 * 4 * 8 then  
        raise X_Library_Confusion;  
    end if;  
    if X_Conn_Setup_Prefix'Size /= 8 * 4 * 2 then  
        raise X_Library_Confusion;  
    end if;  
    if X_Depths'Size /= 8 * 4 * 2 then  
        raise X_Library_Confusion;  
    end if;  
    if X_Pixmap_Format'Size /= 8 * 4 * 2 then  
        raise X_Library_Confusion;  
    end if;  
    if X_Visual_Type'Size /= 8 * 4 * 6 then  
        raise X_Library_Confusion;  
    end if;  
    if X_Window_Root'Size /= 8 * 4 * 10 then  
        raise X_Library_Confusion;  
    end if;

end Xlbp_Display;