⟦5b4a978e5⟧

TextFile

with Xlbt_Arithmetic;  
use Xlbt_Arithmetic;  
with Xlbt_Basic;  
use Xlbt_Basic;  
with Xlbt_Error;  
use Xlbt_Error;  
with Xlbt_Event;  
use Xlbt_Event;  
with Xlbt_Exceptions;  
use Xlbt_Exceptions;  
with Xlbt_Reply;  
use Xlbt_Reply;  
with Xlbt_Request;  
use Xlbt_Request;  
with Xlbt_String;  
use Xlbt_String;

with Xlbip_Error_Converters;  
use Xlbip_Error_Converters;  
with Xlbip_Event_Converters;  
use Xlbip_Event_Converters;  
with Xlbip_Default_Proc_Vars;  
use Xlbip_Default_Proc_Vars;  
with Xlbip_Internal;  
use Xlbip_Internal;  
with Xlbip_Reply_Converters;  
use Xlbip_Reply_Converters;

with Xlbmt_Network_Types;  
use Xlbmt_Network_Types;

with Xlbmp_Error_Log;  
use Xlbmp_Error_Log;

package body Xlbip_Wire_Converters is
------------------------------------------------------------------------------
-- X Library Internal Protocol/Record Conversions
--
-- Xlbip_Wire_Converters - Converts between network byte streams and our Ada
--                         data types
------------------------------------------------------------------------------
-- Copyright 1989 - 1991 by Rational, Santa Clara, California.
--
--                  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 name of Rational not be used in
-- advertising or publicity pertaining to distribution of the software
-- without specific, written prior permission.
--
-- Rational disclaims all warranties with regard to this software, including
-- all implied warranties of merchantability and fitness, in no event shall
-- 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.
------------------------------------------------------------------------------

--\f

    procedure Internal_Wire_To_Error  
                 (Display    :     X_Display;  
                  Raw        :     X_Raw_Data_Array;  
                  Send_Event :     Boolean;  
                  Error      : out X_Error_Contents) is
------------------------------------------------------------------------------
-- Takes a series of bytes that are known to represent an error and converts
-- them to an X_Error_Contents suitable for processing by Ada code.
------------------------------------------------------------------------------
        Erx : X_Error_Contents (Kind => X_Error_Code'Val (Raw (Raw'First + 1)));  
        Seq : U_Short;  
    begin

        Erx.Send_Event := Send_Event;  
        case Erx.Kind is

            when Bad_Atom =>  
                From_Raw (Erx.Atom, Raw);  
                Seq := Erx.Atom.Sequence_Number;

            when Bad_Request |  
                 Bad_Match |  
                 Bad_Access |  
                 Bad_Alloc |  
                 Bad_Name |  
                 Bad_Length |  
                 Bad_Implementation =>  
                From_Raw (Erx.Nothing, Raw);  
                Seq := Erx.Nothing.Sequence_Number;

            when Bad_Window |  
                 Bad_Pixmap |  
                 Bad_Cursor |  
                 Bad_Font |  
                 Bad_Drawable |  
                 Bad_Color |  
                 Bad_Gc |  
                 Bad_Id_Choice =>  
                From_Raw (Erx.Resource, Raw);  
                Seq := Erx.Resource.Sequence_Number;

            when Bad_Value =>  
                From_Raw (Erx.Value, Raw);  
                Seq := Erx.Value.Sequence_Number;

            when others =>
                ----Should not happen.  Means we have a new Error type and
                --  we were not told.  Since we are the one and only place
                --  where errors are created from Raw this means that
                --  somebody has slipped up; or else we're working with
                --  a malfunctioning or a too-new version server.

                X_Report_Error  
                   ("XlibError", "NoNativeError",  
                    "Xlib; Unhandled wire error!  .Kind=%1 .Display=%2.",  
                    To_X_String (X_Error_Code'Image (Erx.Kind)),  
                    Display.Display_Name.all);  
                raise X_Library_Confusion;  
        end case;

----Set the proper serial number.

        Erx.Serial := Internal_X_Set_Last_Request_Read (Display,  
                                                        Error_Event,  
                                                        Seq);  
        Error      := Erx;

    end Internal_Wire_To_Error;

--\f

    procedure Internal_Wire_To_Event  
                 (Display    :     X_Display;  
                  Raw        :     X_Raw_Data_Array;  
                  Send_Event :     Boolean;  
                  Event      : out X_Event;  
                  Status     : out X_Status) is
------------------------------------------------------------------------------
-- Takes a series of bytes that are known to represent an event and it converts
-- them to an X_Event suitable for processing by Ada code.
------------------------------------------------------------------------------
        Seq : U_Short;  
        Evx : X_Event (Kind => X_Event_Code'Val (Raw (Raw'First)));  
    begin

        Evx.Display    := Display;  
        Evx.Send_Event := Send_Event;  
        case Evx.Kind is

            when Key_Press =>  
                From_Raw (Evx.Key, Raw);  
                Evx.Window := Evx.Key.Window;  
                Seq        := Evx.Key.Sequence_Number;

            when Key_Release =>  
                From_Raw (Evx.Key, Raw);  
                Evx.Window := Evx.Key.Window;  
                Seq        := Evx.Key.Sequence_Number;

            when Button_Press =>  
                From_Raw (Evx.Button, Raw);  
                Evx.Window := Evx.Button.Window;  
                Seq        := Evx.Button.Sequence_Number;

            when Button_Release =>  
                From_Raw (Evx.Button, Raw);  
                Evx.Window := Evx.Button.Window;  
                Seq        := Evx.Button.Sequence_Number;

            when Motion_Notify =>  
                From_Raw (Evx.Motion, Raw);  
                Evx.Window := Evx.Motion.Window;  
                Seq        := Evx.Motion.Sequence_Number;

            when Enter_Notify =>  
                From_Raw (Evx.Enter_Leave, Raw);  
                Evx.Window := Evx.Enter_Leave.Window;  
                Seq        := Evx.Enter_Leave.Sequence_Number;

            when Leave_Notify =>  
                From_Raw (Evx.Enter_Leave, Raw);  
                Evx.Window := Evx.Enter_Leave.Window;  
                Seq        := Evx.Enter_Leave.Sequence_Number;

            when Focus_In =>  
                From_Raw (Evx.Focus, Raw);  
                Evx.Window := Evx.Focus.Event;  
                Seq        := Evx.Focus.Sequence_Number;

            when Focus_Out =>  
                From_Raw (Evx.Focus, Raw);  
                Evx.Window := Evx.Focus.Event;  
                Seq        := Evx.Focus.Sequence_Number;

            when Keymap_Notify =>  
                From_Raw (Evx.Keymap, Raw);  
                Evx.Window := Display.Current;  
                Seq        := 0;

            when Expose =>  
                From_Raw (Evx.Expose, Raw);  
                Evx.Window := Evx.Expose.Window;  
                Seq        := Evx.Expose.Sequence_Number;

            when Graphics_Expose =>  
                From_Raw (Evx.Graphics_Expose, Raw);  
                Evx.Window := (Drawable => Evx.Graphics_Expose.Drawable);  
                Seq        := Evx.Graphics_Expose.Sequence_Number;

            when No_Expose =>  
                From_Raw (Evx.No_Expose, Raw);  
                Evx.Window := (Drawable => Evx.No_Expose.Drawable);  
                Seq        := Evx.No_Expose.Sequence_Number;

            when Visibility_Notify =>  
                From_Raw (Evx.Visibility, Raw);  
                Evx.Window := Evx.Visibility.Window;  
                Seq        := Evx.Visibility.Sequence_Number;

            when Create_Notify =>  
                From_Raw (Evx.Create, Raw);  
                Evx.Window := Evx.Create.Parent;  
                Seq        := Evx.Create.Sequence_Number;

            when Destroy_Notify =>  
                From_Raw (Evx.Destroy, Raw);  
                Evx.Window := Evx.Destroy.Event;  
                Seq        := Evx.Destroy.Sequence_Number;

            when Unmap_Notify =>  
                From_Raw (Evx.Unmap, Raw);  
                Evx.Window := Evx.Unmap.Event;  
                Seq        := Evx.Unmap.Sequence_Number;

            when Map_Notify =>  
                From_Raw (Evx.Map, Raw);  
                Evx.Window := Evx.Map.Event;  
                Seq        := Evx.Map.Sequence_Number;

            when Map_Request =>  
                From_Raw (Evx.Map_Request, Raw);  
                Evx.Window := Evx.Map_Request.Parent;  
                Seq        := Evx.Map_Request.Sequence_Number;

            when Reparent_Notify =>  
                From_Raw (Evx.Reparent, Raw);  
                Evx.Window := Evx.Reparent.Event;  
                Seq        := Evx.Reparent.Sequence_Number;

            when Configure_Notify =>  
                From_Raw (Evx.Configure, Raw);  
                Evx.Window := Evx.Configure.Event;  
                Seq        := Evx.Configure.Sequence_Number;

            when Configure_Request =>  
                From_Raw (Evx.Configure_Request, Raw);  
                Evx.Window := Evx.Configure_Request.Parent;  
                Seq        := Evx.Configure_Request.Sequence_Number;

            when Gravity_Notify =>  
                From_Raw (Evx.Gravity, Raw);  
                Evx.Window := Evx.Gravity.Event;  
                Seq        := Evx.Gravity.Sequence_Number;

            when Resize_Request =>  
                From_Raw (Evx.Resize_Request, Raw);  
                Evx.Window := Evx.Resize_Request.Window;  
                Seq        := Evx.Resize_Request.Sequence_Number;

            when Circulate_Notify =>  
                From_Raw (Evx.Circulate, Raw);  
                Evx.Window := Evx.Circulate.Event;  
                Seq        := Evx.Circulate.Sequence_Number;

            when Circulate_Request =>  
                From_Raw (Evx.Circulate_Request, Raw);  
                Evx.Window := Evx.Circulate_Request.Parent;  
                Seq        := Evx.Circulate_Request.Sequence_Number;

            when Property_Notify =>  
                From_Raw (Evx.Property, Raw);  
                Evx.Window := Evx.Property.Window;  
                Seq        := Evx.Property.Sequence_Number;

            when Selection_Clear =>  
                From_Raw (Evx.Selection_Clear, Raw);  
                Evx.Window := Evx.Selection_Clear.Owner;  
                Seq        := Evx.Selection_Clear.Sequence_Number;

            when Selection_Notify =>  
                From_Raw (Evx.Selection, Raw);  
                Evx.Window := Evx.Selection.Requestor;  
                Seq        := Evx.Selection.Sequence_Number;

            when Selection_Request =>  
                From_Raw (Evx.Selection_Request, Raw);  
                Evx.Window := Evx.Selection_Request.Owner;  
                Seq        := Evx.Selection_Request.Sequence_Number;

            when Colormap_Notify =>  
                From_Raw (Evx.Colormap, Raw);  
                Evx.Window := Evx.Colormap.Window;  
                Seq        := Evx.Colormap.Sequence_Number;

            when Client_Message =>  
                From_Raw (Evx.Client, Raw);  
                Evx.Window := Evx.Client.Window;  
                Seq        := Evx.Client.Sequence_Number;

            when Mapping_Notify =>  
                From_Raw (Evx.Mapping, Raw);  
                Evx.Window := None_X_Window;  
                Seq        := Evx.Mapping.Sequence_Number;

            when others =>
                ----Should not happen.  Means we have a new Event type and
                --  we were not told.  Since we are the one and only place
                --  where events are created from Raw this means that
                --  somebody has slipped up; or else we're working with
                --  a malfunctioning or a too-new version server.

                Default_X_Unknown_Wire_Event  
                   (Display, Raw, Send_Event, Event, Status);  
                raise X_Library_Confusion;  
        end case;  
        Status := Successful;

----Set the proper serial number.

        Evx.Serial := Internal_X_Set_Last_Request_Read (Display,  
                                                        Evx.Kind,  
                                                        Seq);  
        Event      := Evx;

    exception  
        when others =>  
            Status := Failed;  
            raise;

    end Internal_Wire_To_Event;

--\f

    procedure Internal_Wire_To_Reply  
                 (Code       :     X_Request_Code;  
                  Raw        :     X_Raw_Data_Array;  
                  Send_Event :     Boolean;  
                  Reply      : out X_Reply_Contents;  
                  Length     : out S_Natural) is
------------------------------------------------------------------------------
-- Takes a series of bytes that are known to represent a reply and it converts
-- them to an X_Reply_Contents suitable for processing by Ada code.
------------------------------------------------------------------------------
        Repx : X_Reply_Contents (Kind => Code);  
    begin

        Repx.Send_Event := Send_Event;  
        case Code is

            when Alloc_Color =>  
                From_Raw (Repx.Alloc_Color, Raw);  
                Length := S_Natural (Repx.Alloc_Color.Length);

            when Alloc_Color_Cells =>  
                From_Raw (Repx.Alloc_Color_Cells, Raw);  
                Length := S_Natural (Repx.Alloc_Color_Cells.Length);

            when Alloc_Color_Planes =>  
                From_Raw (Repx.Alloc_Color_Planes, Raw);  
                Length := S_Natural (Repx.Alloc_Color_Planes.Length);

            when Alloc_Named_Color =>  
                From_Raw (Repx.Alloc_Named_Color, Raw);  
                Length := S_Natural (Repx.Alloc_Named_Color.Length);

            when Get_Atom_Name =>  
                From_Raw (Repx.Get_Atom_Name, Raw);  
                Length := S_Natural (Repx.Get_Atom_Name.Length);

            when Get_Font_Path =>  
                From_Raw (Repx.Get_Font_Path, Raw);  
                Length := S_Natural (Repx.Get_Font_Path.Length);

            when Get_Geometry =>  
                From_Raw (Repx.Get_Geometry, Raw);  
                Length := S_Natural (Repx.Get_Geometry.Length);

            when Get_Image =>  
                From_Raw (Repx.Get_Image, Raw);  
                Length := S_Natural (Repx.Get_Image.Length);

            when Get_Input_Focus =>  
                From_Raw (Repx.Get_Input_Focus, Raw);  
                Length := S_Natural (Repx.Get_Input_Focus.Length);

            when Get_Keyboard_Control =>  
                From_Raw (Repx.Get_Keyboard_Control, Raw);  
                Length := S_Natural (Repx.Get_Keyboard_Control.Length);

            when Get_Keyboard_Mapping =>  
                From_Raw (Repx.Get_Keyboard_Mapping, Raw);  
                Length := S_Natural (Repx.Get_Keyboard_Mapping.Length);

            when Get_Modifier_Mapping =>  
                From_Raw (Repx.Get_Modifier_Mapping, Raw);  
                Length := S_Natural (Repx.Get_Modifier_Mapping.Length);

            when Get_Motion_Events =>  
                From_Raw (Repx.Get_Motion_Events, Raw);  
                Length := S_Natural (Repx.Get_Motion_Events.Length);

            when Get_Pointer_Control =>  
                From_Raw (Repx.Get_Pointer_Control, Raw);  
                Length := S_Natural (Repx.Get_Pointer_Control.Length);

            when Get_Pointer_Mapping =>  
                From_Raw (Repx.Get_Pointer_Mapping, Raw);  
                Length := S_Natural (Repx.Get_Pointer_Mapping.Length);

            when Get_Property =>  
                From_Raw (Repx.Get_Property, Raw);  
                Length := S_Natural (Repx.Get_Property.Length);

            when Get_Screen_Saver =>  
                From_Raw (Repx.Get_Screen_Saver, Raw);  
                Length := S_Natural (Repx.Get_Screen_Saver.Length);

            when Get_Selection_Owner =>  
                From_Raw (Repx.Get_Selection_Owner, Raw);  
                Length := S_Natural (Repx.Get_Selection_Owner.Length);

            when Get_Window_Attributes =>  
                From_Raw (Repx.Get_Window_Attributes, Raw);  
                Length := S_Natural (Repx.Get_Window_Attributes.Length);

            when Grab_Keyboard =>  
                From_Raw (Repx.Grab_Keyboard, Raw);  
                Length := S_Natural (Repx.Grab_Keyboard.Length);

            when Grab_Pointer =>  
                From_Raw (Repx.Grab_Pointer, Raw);  
                Length := S_Natural (Repx.Grab_Pointer.Length);

            when Intern_Atom =>  
                From_Raw (Repx.Intern_Atom, Raw);  
                Length := S_Natural (Repx.Intern_Atom.Length);

            when List_Extensions =>  
                From_Raw (Repx.List_Extensions, Raw);  
                Length := S_Natural (Repx.List_Extensions.Length);

            when List_Fonts =>  
                From_Raw (Repx.List_Fonts, Raw);  
                Length := S_Natural (Repx.List_Fonts.Length);

            when List_Fonts_With_Info =>  
                From_Raw (Repx.List_Fonts_With_Info, Raw);  
                Length := S_Natural (Repx.List_Fonts_With_Info.Length);

            when List_Hosts =>  
                From_Raw (Repx.List_Hosts, Raw);  
                Length := S_Natural (Repx.List_Hosts.Length);

            when List_Installed_Colormaps =>  
                From_Raw (Repx.List_Installed_Colormaps, Raw);  
                Length := S_Natural (Repx.List_Installed_Colormaps.Length);

            when List_Properties =>  
                From_Raw (Repx.List_Properties, Raw);  
                Length := S_Natural (Repx.List_Properties.Length);

            when Lookup_Color =>  
                From_Raw (Repx.Lookup_Color, Raw);  
                Length := S_Natural (Repx.Lookup_Color.Length);

            when Query_Best_Size =>  
                From_Raw (Repx.Query_Best_Size, Raw);  
                Length := S_Natural (Repx.Query_Best_Size.Length);

            when Query_Colors =>  
                From_Raw (Repx.Query_Colors, Raw);  
                Length := S_Natural (Repx.Query_Colors.Length);

            when Query_Extension =>  
                From_Raw (Repx.Query_Extension, Raw);  
                Length := S_Natural (Repx.Query_Extension.Length);

            when Query_Font =>  
                From_Raw (Repx.Query_Font, Raw);  
                Length := S_Natural (Repx.Query_Font.Length);

            when Query_Keymap =>  
                From_Raw (Repx.Query_Keymap, Raw);  
                Length := S_Natural (Repx.Query_Keymap.Length);

            when Query_Pointer =>  
                From_Raw (Repx.Query_Pointer, Raw);  
                Length := S_Natural (Repx.Query_Pointer.Length);

            when Query_Text_Extents =>  
                From_Raw (Repx.Query_Text_Extents, Raw);  
                Length := S_Natural (Repx.Query_Text_Extents.Length);

            when Query_Tree =>  
                From_Raw (Repx.Query_Tree, Raw);  
                Length := S_Natural (Repx.Query_Tree.Length);

            when Set_Modifier_Mapping =>  
                From_Raw (Repx.Set_Modifier_Mapping, Raw);  
                Length := S_Natural (Repx.Set_Modifier_Mapping.Length);

            when Set_Pointer_Mapping =>  
                From_Raw (Repx.Set_Pointer_Mapping, Raw);  
                Length := S_Natural (Repx.Set_Pointer_Mapping.Length);

            when Translate_Coords =>  
                From_Raw (Repx.Translate_Coords, Raw);  
                Length := S_Natural (Repx.Translate_Coords.Length);

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

                X_Report_Error  
                   ("XlibError", "NoNativeReply",  
                    "Xlib; Unhandled wire reply  .Kind=%1 .Display=%2.",  
                    To_X_String (X_Request_Code'Image (Repx.Kind)));  
                raise X_Library_Confusion;  
        end case;

        Reply := Repx;

    end Internal_Wire_To_Reply;

--\f

    procedure Internal_Event_To_Wire  
                 (Display :     X_Display;  
                  Event   :     X_Event;  
                  Raw     : out X_Raw_Data_Array;  
                  Status  : out X_Status) is
------------------------------------------------------------------------------
-- Takes a series of Raw that are known to represent an event and it converts
-- them to an X_Event suitable for processing by Ada code.
------------------------------------------------------------------------------
    begin

        case Event.Kind is

            when Key_Press | Key_Release =>  
                To_Raw (Raw, Event.Key);

            when Button_Press | Button_Release =>  
                To_Raw (Raw, Event.Button);

            when Motion_Notify =>  
                To_Raw (Raw, Event.Motion);

            when Enter_Notify | Leave_Notify =>  
                To_Raw (Raw, Event.Enter_Leave);

            when Focus_In | Focus_Out =>  
                To_Raw (Raw, Event.Focus);

            when Keymap_Notify =>  
                To_Raw (Raw, Event.Keymap);

            when Expose =>  
                To_Raw (Raw, Event.Expose);

            when Graphics_Expose =>  
                To_Raw (Raw, Event.Graphics_Expose);

            when No_Expose =>  
                To_Raw (Raw, Event.No_Expose);

            when Visibility_Notify =>  
                To_Raw (Raw, Event.Visibility);

            when Create_Notify =>  
                To_Raw (Raw, Event.Create);

            when Destroy_Notify =>  
                To_Raw (Raw, Event.Destroy);

            when Unmap_Notify =>  
                To_Raw (Raw, Event.Unmap);

            when Map_Notify =>  
                To_Raw (Raw, Event.Map);

            when Map_Request =>  
                To_Raw (Raw, Event.Map_Request);

            when Reparent_Notify =>  
                To_Raw (Raw, Event.Reparent);

            when Configure_Notify =>  
                To_Raw (Raw, Event.Configure);

            when Configure_Request =>  
                To_Raw (Raw, Event.Configure_Request);

            when Gravity_Notify =>  
                To_Raw (Raw, Event.Gravity);

            when Resize_Request =>  
                To_Raw (Raw, Event.Resize_Request);

            when Circulate_Notify =>  
                To_Raw (Raw, Event.Circulate);

            when Circulate_Request =>  
                To_Raw (Raw, Event.Circulate_Request);

            when Property_Notify =>  
                To_Raw (Raw, Event.Property);

            when Selection_Clear =>  
                To_Raw (Raw, Event.Selection_Clear);

            when Selection_Notify =>  
                To_Raw (Raw, Event.Selection);

            when Selection_Request =>  
                To_Raw (Raw, Event.Selection_Request);

            when Colormap_Notify =>  
                To_Raw (Raw, Event.Colormap);

            when Client_Message =>  
                To_Raw (Raw, Event.Client);

            when Mapping_Notify =>  
                To_Raw (Raw, Event.Mapping);

            when others =>
                ----Should not happen.  Means we have a new Event type and
                --  we were not told.  Since we are the one and only place
                --  where events are created from Raw this means that
                --  somebody has slipped up; or else we're working with
                --  a malfunctioning or a too-new version server.

                Default_X_Unknown_Native_Event (Display, Event, Raw, Status);  
                raise X_Library_Confusion;  
        end case;  
        Status := Successful;

    exception  
        when others =>  
            Status := Failed;  
            raise;

    end Internal_Event_To_Wire;

--\f

end Xlbip_Wire_Converters;
DataMuseum.dk

Rational R1000/400 Tapes

⟦5b4a978e5⟧ TextFile

Derivation

TextFile
