|
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: T V
Length: 28302 (0x6e8e)
Types: TextFile
Names: »V«
└─⟦85b835f43⟧ Bits:30000549 8mm tape, Rational 1000, Xlib rev 6.00
└─⟦0c20f784e⟧ »DATA«
└─⟦1abbe589f⟧
└─⟦059497ac5⟧
└─⟦this⟧
with Unchecked_Deallocation;
with Xlbt_Arithmetic;
use Xlbt_Arithmetic;
with Xlbt_Basic3;
use Xlbt_Basic3;
with Xlbt_Event3;
use Xlbt_Event3;
with Xlbt_Extension3;
use Xlbt_Extension3;
with Xlbt_Extension4;
use Xlbt_Extension4;
with Xlbt_Gc3;
use Xlbt_Gc3;
with Xlbt_Graphics3;
use Xlbt_Graphics3;
with Xlbt_Image;
use Xlbt_Image;
with Xlbt_Key3;
use Xlbt_Key3;
with Xlbt_Proc_Var;
use Xlbt_Proc_Var;
with Xlbt_Request3;
use Xlbt_Request3;
with Xlbt_String;
use Xlbt_String;
with Xlbt_Window4;
use Xlbt_Window4;
with Xlbt_Univ_Ptr;
use Xlbt_Univ_Ptr;
with Xlbt_Visual;
use Xlbt_Visual;
with Xlbmt_Network_Types;
use Xlbmt_Network_Types;
with Xlbmt_Parameters;
use Xlbmt_Parameters;
package Xlbt_Display3 is
------------------------------------------------------------------------------
-- X Library Display - Full Interface
--
-- Xlbt_Display3 - Types that need not be imported directly into most programs.
------------------------------------------------------------------------------
-- 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.
------------------------------------------------------------------------------
--\f
------------------------------------------------------------------------------
-- X_Display
------------------------------------------------------------------------------
type X_Display_Rec;
type X_Display is access X_Display_Rec;
type X_Display_Array is array (S_Natural range <>) of X_Display;
type X_Display_List is access X_Display_Array;
------------------------------------------------------------------------------
-- X_Depth; contains information for each possible display depth.
------------------------------------------------------------------------------
type X_Depth_Rec is
record
Depth : U_Char := 0; -- this depth (Z) of the depth
Visuals : -- the visuals possible with this depth
X_Visual_List := null;
end record;
type X_Depth is access X_Depth_Rec;
type X_Depth_Array is array (U_Char range <>) of X_Depth_Rec;
type X_Depth_List is access X_Depth_Array;
--/ if Pack then
--// pragma Pack (X_Depth_Array);
--/ end if;
--/ if Enable_Deallocation then
pragma Enable_Deallocation (X_Depth);
pragma Enable_Deallocation (X_Depth_List);
--/ end if;
None_X_Depth : constant X_Depth := null;
None_X_Depth_List : constant X_Depth_List := null;
procedure Free_X_Depth is new Unchecked_Deallocation (X_Depth_Rec,
X_Depth);
procedure Free_X_Depth_List is new Unchecked_Deallocation (X_Depth_Array,
X_Depth_List);
------------------------------------------------------------------------------
-- X_Display_Atoms - Cached atom values; used for ICCCM interactions.
------------------------------------------------------------------------------
type X_Display_Atoms is
record
Text : X_Atom := None_X_Atom;
Wm_Change_State : X_Atom := None_X_Atom;
Wm_Colormap_Windows : X_Atom := None_X_Atom;
Wm_Protocols : X_Atom := None_X_Atom;
Wm_Save_Yourself : X_Atom := None_X_Atom;
Wm_State : X_Atom := None_X_Atom;
end record;
------------------------------------------------------------------------------
-- X_Display_Flags - Internal flags indicating important state changes
------------------------------------------------------------------------------
type X_Display_Flags_Index is
(Xlib_Display_Io_Error, -- An I/O error occurred on the network
Xlib_Display_Closing); -- The display connection is closing down
type X_Display_Flags is array (X_Display_Flags_Index) of Boolean;
None_X_Display_Flags : constant X_Display_Flags := (others => False);
------------------------------------------------------------------------------
-- X_Error_String - Error Reporting Strings
------------------------------------------------------------------------------
type X_Error_String is
record
Ary : X_String (1 .. 128) := (others => Xlbt_String.Nul);
end record;
----We return an indication of errors via strings of this type.
procedure Err (Destination : out X_Error_String;
Source : X_String);
----We use this routine to assign error strings.
function Err (Source : X_Error_String) return X_String;
----We use this function to read out error strings.
------------------------------------------------------------------------------
-- Events queues - Events are queued within a display until they are requested
--
-- A queued Event always has an Event.Kind to uniquely identify what kind of
-- event it is. The Display entry is always a pointer to the display the event
-- was read from. The Window entry is nearly always a window of one type or
-- another, carefully selected to be useful to toolkit dispatchers.
------------------------------------------------------------------------------
type X_Event (Kind : X_Event_Code := Error_Event) is
record
Display : X_Display; -- Event came from this display
Serial : S_Long := 0; -- # of last request done by server
Send_Event : Boolean := False; -- True if sent by Client not Server
Window : X_Window := None_X_Window; -- Window the event was
-- queued from/for/about.
case Kind is
when Key_Press | Key_Release =>
Key : X_Key_Event;
when Button_Press | Button_Release =>
Button : X_Button_Event;
when Motion_Notify =>
Motion : X_Motion_Notify_Event;
when Enter_Notify | Leave_Notify =>
Enter_Leave : X_Enter_Leave_Event;
when Focus_In | Focus_Out =>
Focus : X_Focus_Event;
when Keymap_Notify =>
Keymap : X_Keymap_Notify_Event;
when Expose =>
Expose : X_Expose_Event;
when Graphics_Expose =>
Graphics_Expose : X_Graphics_Expose_Event;
when No_Expose =>
No_Expose : X_No_Expose_Event;
when Visibility_Notify =>
Visibility : X_Visibility_Notify_Event;
when Create_Notify =>
Create : X_Create_Notify_Event;
when Destroy_Notify =>
Destroy : X_Destroy_Notify_Event;
when Unmap_Notify =>
Unmap : X_Unmap_Notify_Event;
when Map_Notify =>
Map : X_Map_Notify_Event;
when Map_Request =>
Map_Request : X_Map_Request_Event;
when Reparent_Notify =>
Reparent : X_Reparent_Notify_Event;
when Configure_Notify =>
Configure : X_Configure_Notify_Event;
when Configure_Request =>
Configure_Request : X_Configure_Request_Event;
when Gravity_Notify =>
Gravity : X_Gravity_Notify_Event;
when Resize_Request =>
Resize_Request : X_Resize_Request_Event;
when Circulate_Notify =>
Circulate : X_Circulate_Notify_Event;
when Circulate_Request =>
Circulate_Request : X_Circulate_Request_Event;
when Property_Notify =>
Property : X_Property_Notify_Event;
when Selection_Clear =>
Selection_Clear : X_Selection_Clear_Event;
when Selection_Notify =>
Selection : X_Selection_Notify_Event;
when Selection_Request =>
Selection_Request : X_Selection_Request_Event;
when Colormap_Notify =>
Colormap : X_Colormap_Notify_Event;
when Client_Message =>
Client : X_Client_Message_Event;
when Mapping_Notify =>
Mapping : X_Mapping_Notify_Event;
when others =>
----Anything must be the responsibility of some extension.
Extension : X_Extension_Event;
end case;
end record;
--
None_X_Event : constant X_Event := (Error_Event, null, 0,
False, None_X_Window,
(Universal_Pointer_Event,
(Error_Event, 0, 0,
None_X_Universal_Pointer,
None_X_Procedure_Variable)));
------------------------------------------------------------------------------
-- X_Display Event Dispatch Vectors
------------------------------------------------------------------------------
type X_Event_Wire_Array is
array (X_Event_Code) of X_Procedure_Variable;
----Array of X_Event_Wire_Type;
type X_Wire_Event_Array is
array (X_Event_Code) of X_Procedure_Variable;
----Array of X_Wire_Event_Type;
------------------------------------------------------------------------------
-- X_Reply_S_Natural - Size of a reply based upon the request that got it.
------------------------------------------------------------------------------
type X_Reply_S_Natural is
array (X_Request_Code range Invalid_Request .. No_Operation) of
X_Raw_Data_Index;
------------------------------------------------------------------------------
-- X_Last_Request - X_Display Last_Request
--
-- Some requests don't go fully into the output buffer until a dissimilar
-- request comes along; one that cannot be merged with the pending request.
-- This is the buffer record for that merging. The requests wait in this
-- structure until a dissimilar request comes along; at that point the
-- request is placed into the buffer then then the new request is processed.
------------------------------------------------------------------------------
type X_Last_Request is
record
Kind : X_Request_Code := Invalid_Request;
Request_Position : X_Raw_Data_Index;
Spaces_Left : S_Natural;
Fill_Poly_Req : X_Fill_Poly_Request;
Poly_Fill_Arc_Req : X_Poly_Fill_Arc_Request;
Poly_Line_Req : X_Poly_Line_Request;
Poly_Point_Req : X_Poly_Point_Request;
Poly_Rectangle_Req : X_Poly_Rectangle_Request;
Poly_Fill_Rectangle_Req : X_Poly_Fill_Rectangle_Request;
Poly_Segment_Req : X_Poly_Segment_Request;
----Extensions create their own Poly_* type of requests.
Ext_Data : X_Universal_Pointer; -- Extension's request
Ext_Flush : X_Procedure_Variable; -- Extension's flush
end record;
------------------------------------------------------------------------------
-- X_Reconfigure_Wm_Window
------------------------------------------------------------------------------
type X_Reconfigure_Wm_Window is
record
Sequence_Number : S_Long := 0;
Old_Handler : X_Procedure_Variable := None_X_Procedure_Variable;
Succeeded : Boolean := False;
end record;
------------------------------------------------------------------------------
-- X_Queued_Event data type for use in input queueing.
------------------------------------------------------------------------------
type X_Queued_Event_Rec;
type X_Queued_Event is access X_Queued_Event_Rec;
type X_Queued_Event_Rec is
record
Next : X_Queued_Event;
Event : X_Event;
end record;
--/ if Enable_Deallocation then
pragma Enable_Deallocation (X_Queued_Event);
--/ end if;
None_X_Queued_Event : constant X_Queued_Event := null;
procedure Free_X_Queued_Event is
new Unchecked_Deallocation (X_Queued_Event_Rec,
X_Queued_Event);
------------------------------------------------------------------------------
-- X_Screen - Information about the screen.
------------------------------------------------------------------------------
type X_Screen_Rec is
record
Display : X_Display := null;
----Back pointer to display structure
Ext_Data : X_Ext_Data := null;
----Hook for extension to hang data
Root : X_Window := None_X_Window;
----Root window ID.
Width : U_Short := 0;
----Width and height of screen
Height : U_Short := 0;
----Width and height of screen
Mm_Width : U_Short := 0;
----Width and height in millimeters
Mm_Height : U_Short := 0;
----Width and height in millimeters
Depths : X_Depth_List := null;
----List of supported depths for the screen
Root_Depth : U_Char := 0;
----Bits per pixel
Root_Visual : X_Visual := null;
----Root visual
Default_Gc : X_Gc := null;
----GC for the root root visual
Default_Colormap : X_Colormap := None_X_Colormap;
----Default color map
White_Pixel : X_Pixel := None_X_Pixel;
----White pixel value
Black_Pixel : X_Pixel := None_X_Pixel;
----Black pixel value
Max_Maps : U_Short := 0;
----Max color map
Min_Maps : U_Short := 0;
----Min color maps
Backing_Store : X_Backing_Store_Hint := None_X_Backing_Store_Hint;
----Never, When_Mapped, Always
Save_Unders : Boolean := False;
----Do we have them available?
Root_Input_Mask : X_Event_Mask := None_X_Event_Mask;
----Initial root input mask
end record;
type X_Screen is access X_Screen_Rec;
type X_Screen_Array is array (X_Screen_Number range <>) of X_Screen;
type X_Screen_List is access X_Screen_Array;
--/ if Pack then
--// pragma Pack (X_Screen_Array);
--/ end if;
--/ if Enable_Deallocation then
pragma Enable_Deallocation (X_Screen);
pragma Enable_Deallocation (X_Screen_List);
--/ end if;
None_X_Screen : constant X_Screen := null;
None_X_Screen_List : constant X_Screen_List := null;
procedure Free_X_Screen is new Unchecked_Deallocation (X_Screen_Rec,
X_Screen);
procedure Free_X_Screen_List is new Unchecked_Deallocation (X_Screen_Array,
X_Screen_List);
------------------------------------------------------------------------------
-- X_Screen_Format - describes Z_Format data the screen will understand.
------------------------------------------------------------------------------
type X_Screen_Format_Rec is
record
Ext_Data : X_Ext_Data; -- hook for extension to hang data
Depth : U_Char; -- depth of this image format
Bits_Per_Pixel : U_Char; -- bits/pixel at this depth
Scan_Line_Pad : U_Char; -- scan lines are padded to this
-- multiple
end record;
type X_Screen_Format is access X_Screen_Format_Rec;
type X_Screen_Format_Array is array (U_Char range <>) of X_Screen_Format;
type X_Screen_Format_List is access X_Screen_Format_Array;
--/ if Pack then
--// pragma Pack (X_Screen_Format_Array);
--/ end if;
--/ if Enable_Deallocation then
pragma Enable_Deallocation (X_Screen_Format);
pragma Enable_Deallocation (X_Screen_Format_List);
--/ end if;
None_X_Screen_Format : constant X_Screen_Format := null;
None_X_Screen_Format_List : constant X_Screen_Format_List := null;
procedure Free_X_Screen_Format is
new Unchecked_Deallocation (X_Screen_Format_Rec,
X_Screen_Format);
procedure Free_X_Screen_Format_List is
new Unchecked_Deallocation (X_Screen_Format_Array,
X_Screen_Format_List);
--\f
------------------------------------------------------------------------------
-- X_Display
------------------------------------------------------------------------------
type X_Display_Rec is
record
-----------------------------------------------------------------
-- Misc. Info about display - obtained from server at startup
-----------------------------------------------------------------
Atoms : X_Display_Atoms;
----ICCCM information, version 1.
Bitmap_Unit : U_Char := 0;
----Padding and data requirements
Bitmap_Pad : U_Char := 0;
----Padding requirements on bitmaps
Bitmap_Bit_Order : X_Byte_Bit_Order := None_X_Byte_Bit_Order;
----least significant first or most significant first
Byte_Order : X_Byte_Bit_Order := None_X_Byte_Bit_Order;
----Screen byte order, Lsb/Msb_First
Cursor_Font : X_Font := None_X_Font;
----The Cursor font for this display.
Default_Screen : X_Screen_Number := 0;
----Default screen for operations
Motion_Buffer : S_Long := 0;
----Size of motion buffer
Pixmap_Format : X_Screen_Format_List := None_X_Screen_Format_List;
----Pixmap format list
Proto_Major_Version : U_Short := 0;
----Major version of server's X protocol
Proto_Minor_Version : U_Short := 0;
----Minor version of servers X protocol
Reconfigure_Wm_Window : X_Reconfigure_Wm_Window;
----ICCCM information, version 1.
Release : S_Long := 0;
----Release of the server
Resource_Base : X_Id := None_X_Id;
---Resource ID base
Resource_Mask : X_Id := None_X_Id;
----Resource ID mask bits
Resource_Id : X_Id := None_X_Id;
----Allocator current ID
Resource_Incr : S_Long := 0;
----Used to increment Resource_Id
Resource_Alloc : X_Procedure_Variable := None_X_Procedure_Variable;
-- Resource_Alloc : X_Alloc_Id.Pv ----Allocator function
Screens : X_Screen_List := null;
----Pointer to list of screens
Total_Visuals : S_Natural := 0;
----# Visuals in depths in screens
Vendor : X_String_Pointer := null;
----Vendor of the server hardware
Vnumber : S_Long := 0;
----Xlib's X protocol version number
-----------------------------------------------------------------
-- Error and other controls.
-----------------------------------------------------------------
Report_Error : X_Procedure_Variable := None_X_Procedure_Variable;
----X_Report_Error.Pv
----Report_Error is the lowest level error reporter, and is
-- called by all default higher level reporters. This should
-- not be assumed to be a fatal condition. X_Lib.Report_Error
-- is used if this is None.
Error : X_Procedure_Variable := None_X_Procedure_Variable;
----X_Error_Function.Pv
----Error will be called whenever an error event is received.
-- This is not assumed to be a fatal condition, i.e., it is
-- acceptable for this procedure to return. However, Error
-- should NOT perform any operations (directly or indirectly)
-- on the DISPLAY. X_Lib.Error is used if this is None.
Io_Error : X_Procedure_Variable := None_X_Procedure_Variable;
----X_Io_Error_Function.Pv
----IO_Error will be called if any sort of network error occurs.
-- This is assumed to be a fatal condition, i.e., IO_Error should
-- not return. It should abort the program or raise an exception.
-- X_Lib.Io_Error is used if this is None.
-----------------------------------------------------------------
-- Key translations
-----------------------------------------------------------------
Current : X_Window := None_X_Window;
----For use internally for Keymap
Key_Bindings : X_Key_Trans := None_X_Key_Trans;
----For X_Lookup_String
Key_Syms : X_Key_Sym_List_2d := null;
----This server's key symbols
-- C's Keys_Per_Mod field is now simply Key_Syms'Length(2)
Lock_Meaning : X_Key_Sym := No_Symbol;
----For X_Lookup_String
Mode_Switch : X_Key_Button_Mask := None_X_Key_Button_Mask;
----Keyboard group modifiers
-----Max/Min_Keycode are also Key_Syms'First(1)/'Last(1)
Max_Keycode : X_Key_Code := 0; -- maximum physical key code
Min_Keycode : X_Key_Code := 0; -- minimum physical key code
Modifier_Map : X_Modifier_Keymap := null;
----This server's modifier keymap
-----------------------------------------------------------------
-- Databases
-----------------------------------------------------------------
--/ if OLD_CONTEXT_MANAGER then
--// Contexts : X_Universal_Pointer := None_X_Universal_Pointer;
--// -- Always a X_Context_Hash_List. This breaks type recursion.
--// -- Context/Window pairs; initialized to nulls
--/ end if;
Database : X_Universal_Pointer := None_X_Universal_Pointer;
-- Always a X_Rm_Database. This breaks type recursion.
-- Resource database for this display/server
X_Defaults : X_String_Pointer := None_X_String_Pointer;
-----------------------------------------------------------------
-- Extensions
-----------------------------------------------------------------
Ext_Data : X_Ext_Data := null;
----Hook for extension to hang data
Ext_Number : X_Extension_Number := 0;
----Extension number on this display
Ext_Procs : X_Extension := null;
----Extension procedures/data
------------------------------------------------------------------
----Events and Requests
------------------------------------------------------------------
Head : X_Queued_Event := None_X_Queued_Event;
----Input Event queue.
Tail : X_Queued_Event := None_X_Queued_Event;
----Input Event queue.
Q_Len : S_Long := 0;
----Length of input Event queue
Q_Free : X_Queued_Event := None_X_Queued_Event;
----Free events, ready for reuse.
Q_Free_Len : S_Long := 0;
----Number of free events; always < X_Max_Q_Free.
Request : S_Long := 0;
----Sequence number of last request.
Last_Request_Read : S_Long := 0;
----Sequence number from the last event/error/reply received.
Last_Request : X_Last_Request;
----Data of the last request made or an Invalid_Request
Poly_Arc_Limit : S_Natural;
Poly_Point_Limit : S_Natural;
Poly_Rectangle_Limit : S_Natural;
Poly_Segment_Limit : S_Natural;
----Our self imposed limits on multiple-graphic requests.
Max_Request_Size : U_Short := 0;
----Max # of 32 bit words in request
Last_Error : X_Error_String;
----Latest error reported from XLib to application using this
-- display
Input : X_Buffer (X_Input_Buffer_Size);
----Input buffer;
Output : X_Buffer (X_Output_Buffer_Size);
----Output buffer
-----------------------------------------------------------------
-- Display/Connection controls and data
-----------------------------------------------------------------
Display_Name : X_String_Pointer := null;
-- connect
----"Host:display" string used on this
Lock : X_Mutex;
----Is someone in a critical section?
Network : X_Network_Connection;
----Network connection to server
Flags : X_Display_Flags := None_X_Display_Flags;
----Internal connection flags.
Synchandler : X_Procedure_Variable := None_X_Procedure_Variable;
----X_Synchandler_Type.Pv
----Synchronization handler
----The following vectors can be of fixed size because the protocol
-- predefines how many codes are available. While this could be
-- done using the extension list, there may be MANY events
-- processed, so a search through the extension list to find the
-- right procedure for each event might be expensive if many
-- extension events are being used.
Event_Vec : X_Wire_Event_Array;
----Vector for wire to Event
Wire_Vec : X_Event_Wire_Array;
----Vector for Event to wire
Reply_Size : X_Reply_S_Natural;
----Size of a reply for a given request code.
------------------------------------------------------------------
-- Other inter-object linkages
------------------------------------------------------------------
Display_Num : X_Display_Number := None_X_Display_Number;
----The Unique to the Xlib number of this display.
Next : X_Display := null;
----Next open Display on Xlib's list
end record;
--/ if Enable_Deallocation then
pragma Enable_Deallocation (X_Display);
pragma Enable_Deallocation (X_Display_List);
--/ end if;
None_X_Display : constant X_Display := null;
None_X_Display_List : constant X_Display_List := null;
--
procedure Free_X_Display_List is
new Unchecked_Deallocation (X_Display_Array,
X_Display_List);
--\f
end Xlbt_Display3;