|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - downloadIndex: B T
Length: 25033 (0x61c9)
Types: TextFile
Names: »B«
└─⟦85b835f43⟧ Bits:30000549 8mm tape, Rational 1000, Xlib rev 6.00
└─⟦0c20f784e⟧ »DATA«
└─⟦1abbe589f⟧
└─⟦059497ac5⟧
└─⟦this⟧
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;