|
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 - downloadIndex: ┃ T V ┃
Length: 21138 (0x5292) Types: TextFile Names: »V«
└─⟦85b835f43⟧ Bits:30000549 8mm tape, Rational 1000, Xlib rev 6.00 └─ ⟦0c20f784e⟧ »DATA« └─⟦1abbe589f⟧ └─⟦059497ac5⟧ └─⟦this⟧
with Text_Io; with Unchecked_Deallocation; with Xlbt_Arithmetic; use Xlbt_Arithmetic; with Xlbt_Basic; use Xlbt_Basic; with Xlbt_Color; use Xlbt_Color; with Xlbt_Font; use Xlbt_Font; with Xlbt_Hint; use Xlbt_Hint; with Xlbt_Proc_Var; use Xlbt_Proc_Var; with Xlbt_String7; use Xlbt_String7; with Xlbt_String; use Xlbt_String; with Xlbt_String16; use Xlbt_String16; with Xlbt_Univ_Ptr; use Xlbt_Univ_Ptr; with Xlbt_Visual; use Xlbt_Visual; with Xlbip_String_Map_Generic; package Xlbt_Rm3 is ------------------------------------------------------------------------------ -- X Library Resource Manager - Full Interface -- -- Xlbt_Rm3 - Resource Manager Data Types ------------------------------------------------------------------------------ -- Copyright 1989 - 1991 by Rational, Santa Clara, California. -- Copyright 1987 - 1989 by Digital Equipment Corporation, Maynard, Mass. -- Copyright 1987 - 1989 by Massachusetts Institute of Technology, -- Cambridge, Massachusetts. -- -- 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 Digital, MIT, or Rational -- not be used in advertising or publicity pertaining to distribution of -- the software without specific, written prior permission. -- -- Digital, MIT, and Rational disclaim all warranties with regard to this -- software, including all implied warranties of merchantability and fitness, -- in no event shall Digital, 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 ------------------------------------------------------------------------------ -- Misc. X Resource Manager Types ------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- X_Rm_Dims ------------------------------------------------------------------------------ type X_Rm_Dims is record Width : U_Short := 0; Height : U_Short := 0; end record; ------------------------------------------------------------------------------ -- X_Rm_Pos ------------------------------------------------------------------------------ type X_Rm_Pos is record X_Pos : S_Short := 0; Y_Pos : S_Short := 0; end record; ------------------------------------------------------------------------------ -- X_Rm_Geometry ------------------------------------------------------------------------------ type X_Rm_Geometry is record The_Dims : X_Rm_Dims; The_Pos : X_Rm_Pos; end record; ------------------------------------------------------------------------------ -- X_Rm_Option_Kind ------------------------------------------------------------------------------ type X_Rm_Option_Kind is (X_Rm_Option_No_Arg, -- Value is specified in Option_Desc.value X_Rm_Option_Is_Arg, -- Value is the option string itself X_Rm_Option_Sticky_Arg, -- Value is characters immediately following option X_Rm_Option_Sep_Arg, -- Value is next argument in Arg_V X_Rm_Option_Res_Arg, -- Resource and value in next arg in Arg_V X_Rm_Option_Skip_Arg, -- Ignore this option and the next argument in Arg_V X_Rm_Option_Skip_Line, -- Ignore this option and the rest of Arg_V X_Rm_Option_Skip_N_Args);-- Ignore this option and the next -- X_Rm_Option_Desc_Rec.value arguments in -- Arg_V. None_X_Rm_Option_Kind : constant X_Rm_Option_Kind := X_Rm_Option_Kind'Val (0); ------------------------------------------------------------------------------ -- X_Rm_Option_Desc - Command line option mapping to resource entries ------------------------------------------------------------------------------ type X_Rm_Option_Desc is record Option : X_String_Pointer; ----Option abbreviation in Arg_V Specifier : X_String_Pointer; ----Resource name (sans application name) Arg_Kind : X_Rm_Option_Kind := None_X_Rm_Option_Kind; ----Which style of option it is Value : X_String_Pointer; ----Default value end record; type X_Rm_Option_Desc_Array is array (S_Natural range <>) of X_Rm_Option_Desc; --\f ------------------------------------------------------------------------------ -- X Resource Manager Quark/String Types ------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- X_Rm_Quark ------------------------------------------------------------------------------ type X_Rm_Quark is record Id : S_Long := 0; end record; --/ if Length_Clauses then for X_Rm_Quark'Size use 32; --/ end if; package X_Rm_Quark_Map is new Xlbip_String_Map_Generic (Character => X_Character, Index => S_Natural, String => X_String, String_Pointer => X_String_Pointer, Range_Type => X_Rm_Quark, Hash_Size => 211, Exact_Case_Match => True); type X_Rm_Class is new X_Rm_Quark; type X_Rm_Name is new X_Rm_Quark; type X_Rm_Representation is new X_Rm_Quark; type X_Rm_Quark_Array is array (S_Natural range <>) of X_Rm_Quark; type X_Rm_Class_Array is array (S_Natural range <>) of X_Rm_Class; type X_Rm_Name_Array is array (S_Natural range <>) of X_Rm_Name; type X_Rm_Representation_Array is array (S_Natural range <>) of X_Rm_Representation; --/ if Pack then --// pragma Pack (X_Rm_Quark_Array); --// pragma Pack (X_Rm_Class_Array); --// pragma Pack (X_Rm_Name_Array); --// pragma Pack (X_Rm_Representation_Array); --/ end if; type X_Rm_Quark_List is access X_Rm_Quark_Array; type X_Rm_Class_List is access X_Rm_Class_Array; type X_Rm_Name_List is access X_Rm_Name_Array; type X_Rm_Representation_List is access X_Rm_Representation_Array; --/ if Enable_Deallocation then pragma Enable_Deallocation (X_Rm_Quark_List); pragma Enable_Deallocation (X_Rm_Class_List); pragma Enable_Deallocation (X_Rm_Name_List); pragma Enable_Deallocation (X_Rm_Representation_List); --/ end if; None_X_Rm_Quark : constant X_Rm_Quark := (Id => 0); None_X_Rm_Class : constant X_Rm_Class := (Id => 0); None_X_Rm_Name : constant X_Rm_Name := (Id => 0); None_X_Rm_Representation : constant X_Rm_Representation := (Id => 0); None_X_Rm_Quark_List : constant X_Rm_Quark_List := null; None_X_Rm_Class_List : constant X_Rm_Class_List := null; None_X_Rm_Name_List : constant X_Rm_Name_List := null; None_X_Rm_Representation_List : constant X_Rm_Representation_List := null; procedure Free_X_Rm_Quark_List is new Unchecked_Deallocation (X_Rm_Quark_Array, X_Rm_Quark_List); procedure Free_X_Rm_Class_List is new Unchecked_Deallocation (X_Rm_Class_Array, X_Rm_Class_List); procedure Free_X_Rm_Name_List is new Unchecked_Deallocation (X_Rm_Name_Array, X_Rm_Name_List); procedure Free_X_Rm_Representation_List is new Unchecked_Deallocation (X_Rm_Representation_Array, X_Rm_Representation_List); ------------------------------------------------------------------------------ -- X_Rm_Status - Status of various RM operations; used when X_Status is not -- sufficient. ------------------------------------------------------------------------------ type X_Rm_Status is (Rm_Successful, -- Fully successful. Rm_Had_Errors, -- Had errors, recovery has been attempted. Rm_Failed); -- Had errors, no further recovery was possible. --\f ------------------------------------------------------------------------------ -- X Resource Manager Database Values ------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- X_Rm_Value_Kind - Explicit types of X_Rm_Value's. ------------------------------------------------------------------------------ type X_Rm_Value_Kind is (Is_None, -- Ada types Is_X_Rm_File_Type, Is_Boolean, Is_Float, -- -- Xlib simples Is_U_Char_List, Is_U_Char, Is_U_Short, Is_S_Char, Is_S_Short, Is_S_Long, Is_X_String7_Pointer, Is_X_String_Pointer, Is_X_String16_Pointer, Is_X_Universal_Pointer, -- -- Xlib composites Is_X_Atom, Is_X_Color, Is_X_Colormap, Is_X_Cursor, Is_X_Display, Is_X_Font, Is_X_Font_Struct, Is_X_Initial_Window_State, Is_X_Pixel, Is_X_Pixmap, Is_X_Screen, Is_X_Time, Is_X_Visual, Is_X_Window); ------------------------------------------------------------------------------ -- X_Rm_Value_Univ - Data stored when we have a Universal Pointer value. ------------------------------------------------------------------------------ type X_Rm_Universal_Pointer is record Pointer : X_Universal_Pointer; -- The data Free : X_Procedure_Variable; -- X_Univ_Free.Pv end record; None_X_Rm_Universal_Pointer : constant X_Rm_Universal_Pointer := (None_X_Universal_Pointer, None_X_Procedure_Variable); ------------------------------------------------------------------------------ -- X_Rm_File_Type - Text_Io.File_Type is limited private; ths is not. ------------------------------------------------------------------------------ type X_Rm_File_Type is access Text_Io.File_Type; procedure Free_X_Rm_File_Type is new Unchecked_Deallocation (Text_Io.File_Type, X_Rm_File_Type); --/ if Enable_Deallocation then pragma Enable_Deallocation (X_Rm_File_Type); --/ end if; None_X_Rm_File_Type : constant X_Rm_File_Type := null; ------------------------------------------------------------------------------ -- X_Rm_Value - Actual Resource Manager Value ------------------------------------------------------------------------------ type X_Rm_Value (Kind : X_Rm_Value_Kind := Is_None) is record case Kind is when Is_None => null; when Is_X_Rm_File_Type => V_X_Rm_File_Type : X_Rm_File_Type; when Is_Boolean => V_Boolean : Boolean := False; when Is_Float => V_Float : Float := 0.0; when Is_U_Char_List => V_U_Char_List : U_Char_List := null; when Is_U_Char => V_U_Char : U_Char := 0; when Is_U_Short => V_U_Short : U_Short := 0; when Is_S_Char => V_S_Char : S_Char := 0; when Is_S_Short => V_S_Short : S_Short := 0; when Is_S_Long => V_S_Long : S_Long := 0; when Is_X_String7_Pointer => V_X_String7_Pointer : X_String7_Pointer := null; when Is_X_String_Pointer => V_X_String_Pointer : X_String_Pointer := null; when Is_X_String16_Pointer => V_X_String16_Pointer : X_String16_Pointer := null; when Is_X_Universal_Pointer => V_X_Universal_Pointer : X_Rm_Universal_Pointer; when Is_X_Atom => V_X_Atom : X_Atom := None_X_Atom; when Is_X_Color => V_X_Color : X_Color := None_X_Color; when Is_X_Colormap => V_X_Colormap : X_Colormap := None_X_Colormap; when Is_X_Cursor => V_X_Cursor : X_Cursor := None_X_Cursor; when Is_X_Display => V_X_Display : X_Display := None_X_Display; when Is_X_Font => V_X_Font : X_Font := None_X_Font; when Is_X_Font_Struct => V_X_Font_Struct : X_Font_Struct := None_X_Font_Struct; when Is_X_Initial_Window_State => V_X_Initial_Window_State : X_Initial_Window_State := None_X_Initial_Window_State; when Is_X_Pixel => V_X_Pixel : X_Pixel := None_X_Pixel; when Is_X_Pixmap => V_X_Pixmap : X_Pixmap := None_X_Pixmap; when Is_X_Screen => V_X_Screen : X_Screen := None_X_Screen; when Is_X_Time => V_X_Time : X_Time := None_X_Time; when Is_X_Visual => V_X_Visual : X_Visual := None_X_Visual; when Is_X_Window => V_X_Window : X_Window := None_X_Window; end case; end record; None_X_Rm_Value : constant X_Rm_Value := (Kind => Is_None); --\f ------------------------------------------------------------------------------ -- X_Rm_Entry - Resource Database Entry ------------------------------------------------------------------------------ type X_Rm_Entry_Rec; type X_Rm_Entry is access X_Rm_Entry_Rec; --/ if Enable_Deallocation then pragma Enable_Deallocation (X_Rm_Entry); --/ end if; None_X_Rm_Entry : constant X_Rm_Entry := null; type X_Rm_Entry_Rec is record Owner : Boolean := False; ----True when deallocation of this Entry means that the Value -- should also be deallocated. I.e. True means that the -- enclosing database "owns" this data and is responsible for -- deallocating it when the database releases its last reference. Representation : X_Rm_Representation := None_X_Rm_Representation; ----The "actual" representation type of the data. The merely -- "physical" representation is the .Value.Kind enumeration -- value but this field indicates the representation type -- that the user wishes to think with. Value : X_Rm_Value; ----This field contains the data that makes up the X_Rm_Entry. end record; --\f ------------------------------------------------------------------------------ -- X Resource Manager Databases ------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- X_Rm_Binding ------------------------------------------------------------------------------ type X_Rm_Binding is (X_Rm_Bind_Tightly, X_Rm_Bind_Loosely); type X_Rm_Binding_Array is array (S_Natural range <>) of X_Rm_Binding; ------------------------------------------------------------------------------ -- X_Rm_Hash_Bucket - records a value and possibly dependent/refined values. ------------------------------------------------------------------------------ type X_Rm_Hash_Bucket_Rec; type X_Rm_Hash_Bucket is access X_Rm_Hash_Bucket_Rec; type X_Rm_Hash_Bucket_Array is array (S_Natural range 0 .. 58) of X_Rm_Hash_Bucket; -- 59 is a prime. type X_Rm_Hash_Table is access X_Rm_Hash_Bucket_Array; type X_Rm_Hash_Table_Set is array (X_Rm_Binding) of X_Rm_Hash_Table; type X_Rm_Hash_Table_Flags is array (X_Rm_Binding) of Boolean; --/ if Enable_Deallocation then pragma Enable_Deallocation (X_Rm_Hash_Bucket); pragma Enable_Deallocation (X_Rm_Hash_Table); --/ end if; ------------------------------------------------------------------------------ -- X_Rm_Hash_Bucket_Rec -- -- Next - Next bucket in this hash chain -- Name - Quark value corresponding to this name string -- Value - Value and type of node; if any -- Tables - Tables for tight/loose bindings of more qualified values -- Has_Values - True if the corresponding Tables(i) table has a value ------------------------------------------------------------------------------ type X_Rm_Hash_Bucket_Rec is record Next : X_Rm_Hash_Bucket := null; Name : X_Rm_Name := None_X_Rm_Name; Value : X_Rm_Entry := null; Tables : X_Rm_Hash_Table_Set := (null, null); Has_Values : X_Rm_Hash_Table_Flags := (False, False); end record; None_X_Rm_Hash_Bucket : constant X_Rm_Hash_Bucket := null; None_X_Rm_Hash_Table : constant X_Rm_Hash_Table := null; None_X_Rm_Hash_Bucket_Rec : constant X_Rm_Hash_Bucket_Rec := (null, None_X_Rm_Name, null, (null, null), (False, False)); procedure Free_X_Rm_Hash_Bucket is new Unchecked_Deallocation (X_Rm_Hash_Bucket_Rec, X_Rm_Hash_Bucket); procedure Free_X_Rm_Hash_Table is new Unchecked_Deallocation (X_Rm_Hash_Bucket_Array, X_Rm_Hash_Table); ------------------------------------------------------------------------------ -- X_Rm_Quark_Bit_List - array of bits used to speed RM processing ------------------------------------------------------------------------------ type X_Rm_Quark_Bit_Array is array (S_Natural range <>) of Boolean; type X_Rm_Quark_Bit_List is access X_Rm_Quark_Bit_Array; --/ if Pack then --// pragma Pack (X_Rm_Quark_Bit_Array); --/ end if; --/ if Enable_Deallocation then pragma Enable_Deallocation (X_Rm_Quark_Bit_List); --/ end if; None_X_Rm_Quark_Bit_List : constant X_Rm_Quark_Bit_List := null; procedure Free_X_Rm_Quark_Bit_List is new Unchecked_Deallocation (X_Rm_Quark_Bit_Array, X_Rm_Quark_Bit_List); ------------------------------------------------------------------------------ -- X_Rm_Database - A record (possibly) containing a Hash Bucket pointer. ------------------------------------------------------------------------------ type X_Rm_Database_Rec is record Contents : X_Rm_Hash_Bucket; end record; type X_Rm_Database is access X_Rm_Database_Rec; --/ if Enable_Deallocation then pragma Enable_Deallocation (X_Rm_Database); --/ end if; None_X_Rm_Database : constant X_Rm_Database := null; ------------------------------------------------------------------------------ -- X_Rm_Search_List - a series of related Hash Tables ------------------------------------------------------------------------------ type X_Rm_Search_List_Entry is new X_Rm_Hash_Table; type X_Rm_Search_List is array (S_Natural range <>) of X_Rm_Search_List_Entry; --\f end Xlbt_Rm3;