|
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: ┃ B T ┃
Length: 20208 (0x4ef0)
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_Display3;
use Xlbt_Display3;
with Xlbt_Rm3;
use Xlbt_Rm3;
with Xlbt_String;
use Xlbt_String;
with Xlbit_Library3;
use Xlbit_Library3;
with Xlbmt_Network_Types;
use Xlbmt_Network_Types;
package body Xlbp_Rm_Quark is
------------------------------------------------------------------------------
-- X Library Resource Manager - Quarks - Named constant strings
--
-- Xlbp_Rm_Quark - Manager of application/window/object resources
------------------------------------------------------------------------------
-- 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.
------------------------------------------------------------------------------
-- *****************************************************************************
-- * Date - /Name/ Comment
-- *
-- * 23-OCT-90 - /DRK/ Changed X_Rm_String_To_Quark to enforce restrictions
-- * - on characters allowed in component names.
-- * 24-OCT-90 - /DRK/ Changed X_Rm_String_To_Quark_List to accept '*' as
-- * - as a component separator, and to allow empty component
-- * - names.
-- * 7-NOV-90 - /GEB/ Implement the new multitasking protection scheme for
-- * - library state.
-- * 21-JAN-91 - /GEB/ Add X_Rm_Quark_To_String_Pointer and add the
-- * - X_Rm_String_Pointer_To_Quark routines for Xt.
-- *****************************************************************************
type X_Character_Vector is array (X_Character) of Boolean;
--/ if Pack then
--// pragma Pack (X_Character_Vector);
--/ end if;
Component_Name_Character : constant X_Character_Vector :=
X_Character_Vector'('a' .. 'z' | 'A' .. 'Z' => True,
'0' .. '9' | '-' | '_' => True,
others => False);
--\f
function X_Rm_String_To_Quark
(Str : X_String;
Validate : Boolean := True) return X_Rm_Quark is
------------------------------------------------------------------------------
-- Str - Specifies the string value being converted to a Quark.
-- The string need not be null terminated.
-- Validate - Specifies whether or not the String must be a valid
-- Component Name as defined by the Resource Manager.
--
-- Returns the Quark value that has or which will now correspond to the
-- contents of the specified string. Raises Constraint_Error if the string
-- is null. If Validate is True, Constraint_Error will be raised if any
-- characters except 'a'..'z', 'A'..'Z', '0'..'9', '-', or '_' are
-- present in the Str.
------------------------------------------------------------------------------
Quark : X_Rm_Quark;
Success : Boolean;
Map : X_Rm_Quark_Map.Map;
begin
----Validate the string if it is supposed to be a component name.
if Validate then
for Index in Str'Range loop
if not Component_Name_Character (Str (Index)) then
raise Constraint_Error;
end if;
end loop;
end if;
----Look for the string in the map. Return any quark found.
X_Lib.Seize_Quark_Map (Map);
begin
X_Rm_Quark_Map.Find (Map, Str, Quark, Success);
if Success then
X_Lib.Release_Quark_Map (Map);
return Quark;
end if;
----Generate a new quark value for this string and enter it in the map.
X_Lib.Get_Next_Quark (Quark);
X_Rm_Quark_Map.Insert (Map, Str, Quark);
X_Lib.Release_Quark_Map (Map);
return Quark;
exception
when others =>
X_Lib.Release_Quark_Map (Map);
raise;
end;
end X_Rm_String_To_Quark;
--\f
procedure X_Rm_String_To_Quark (Str : X_String;
Ptr : out X_String_Pointer;
Quark : out X_Rm_Quark;
Validate : Boolean := True) is
------------------------------------------------------------------------------
-- Str - Specifies the string value being converted to a Quark.
-- The string need not be null terminated.
-- Ptr - Receives the string pointer stored in the quark map for Str
-- Quark - Receives the Quark value representing Str
-- Validate - Specifies whether or not the Str must be a valid
-- Component Name as defined by the Resource Manager.
--
-- Returns the Quark value that has or which will now correspond to the
-- contents of the specified string. If Validate is True, Constraint_Error
-- will be raised if any characters other than 'a'..'z', 'A'..'Z', '0'..'9',
-- '-', or '_' are present in the Str. Note: The Ptr value belongs to the Xlib
-- and it must not be freed by the application.
------------------------------------------------------------------------------
Qrk : X_Rm_Quark := None_X_Rm_Quark;
P : X_String_Pointer;
Success : Boolean;
Map : X_Rm_Quark_Map.Map;
begin
----Validate the string if it is supposed to be a component name.
if Validate then
for Index in Str'Range loop
if not Component_Name_Character (Str (Index)) then
raise Constraint_Error;
end if;
end loop;
end if;
----Look for the string in the map. Return any quark found.
X_Lib.Seize_Quark_Map (Map);
begin
X_Rm_Quark_Map.Find (Map, Str, P, Qrk, Success);
if Success then
X_Lib.Release_Quark_Map (Map);
Ptr := P;
Quark := Qrk;
return;
end if;
----Generate a new quark value for this string and enter it in the map.
X_Lib.Get_Next_Quark (Qrk);
P := new X_String'(Str);
Ptr := P;
X_Rm_Quark_Map.Insert_Ptr (Map, P, Qrk);
X_Lib.Release_Quark_Map (Map);
return;
exception
when others =>
X_Lib.Release_Quark_Map (Map);
raise;
end;
end X_Rm_String_To_Quark;
--\f
procedure X_Rm_String_Pointer_To_Quark
(Str : in out X_String_Pointer;
Quark : out X_Rm_Quark;
Validate : Boolean := True) is
------------------------------------------------------------------------------
-- Str - Specifies the string value being converted to a Quark.
-- The string need not be null terminated.
-- Quark - Receives the quark value corresponding to the string.
-- Validate - Specifies whether or not the String must be a valid
-- Component Name as defined by the Resource Manager.
--
-- Returns the Quark value that has or which will now correspond to the
-- contents of the specified string. If an some existing Quark has the same
-- string value then that quark, and that string pointer, will be returned. If
-- no existing Quark has the same string value then a new Quark is created and
-- returned, and the X_String_Pointer Str argument becomes the property of
-- the Xlib and must not be free by the appliation. If Validate is True then
-- Constraint_Error will be raised if any characters other than 'a'..'z',
-- 'A'..'Z', '0'..'9', '-', or '_' are present in the Str.
------------------------------------------------------------------------------
Qrk : X_Rm_Quark := None_X_Rm_Quark;
Success : Boolean;
Map : X_Rm_Quark_Map.Map;
begin
----Validate the string if it is supposed to be a component name.
if Validate then
for Index in Str'Range loop
if not Component_Name_Character (Str (Index)) then
raise Constraint_Error;
end if;
end loop;
end if;
----Look for the string in the map. Return any quark found.
X_Lib.Seize_Quark_Map (Map);
begin
X_Rm_Quark_Map.Find_Ptr (Map, Str, Qrk, Success);
if Success then
X_Lib.Release_Quark_Map (Map);
Quark := Qrk;
return;
end if;
----Generate a new quark value for this string and enter it in the map.
X_Lib.Get_Next_Quark (Qrk);
Quark := Qrk;
X_Rm_Quark_Map.Insert_Ptr (Map, Str, Qrk);
X_Lib.Release_Quark_Map (Map);
return;
exception
when others =>
X_Lib.Release_Quark_Map (Map);
raise;
end;
end X_Rm_String_Pointer_To_Quark;
--\f
function X_Rm_Quark_To_String (Quark : X_Rm_Quark) return X_String is
------------------------------------------------------------------------------
-- Quark - Specifies the quark whose string value is queried.
--
-- Returns the string corresponding to the Quark. Returns "" for Quark values
-- obtained from X_Rm_Unique_Quarks. Raises Constraint_Error if an
-- uninitialized Quark value is passed.
------------------------------------------------------------------------------
Iter : X_Rm_Quark_Map.Iter;
Map : X_Rm_Quark_Map.Map;
begin
----Check for uninitialized quarks.
if Quark.Id = 0 then
raise Constraint_Error;
end if;
----Look up the unique quark value in the map.
X_Lib.Seize_Quark_Map (Map);
begin
X_Rm_Quark_Map.Initialize (Map, Iter, Quark);
----No entry means a "unique" quark.
if X_Rm_Quark_Map.Done (Iter) then
X_Lib.Release_Quark_Map (Map);
return "Unique#" & To_X_String (S_Long'Image (Quark.Id));
end if;
-----Anything else gets the key string back.
declare
Str : constant X_String := X_Rm_Quark_Map.Key (Iter);
begin
X_Lib.Release_Quark_Map (Map);
return Str;
end;
exception
when others =>
X_Lib.Release_Quark_Map (Map);
raise;
end;
end X_Rm_Quark_To_String;
--\f
function X_Rm_Quark_To_String_Pointer
(Quark : X_Rm_Quark) return X_String_Pointer is
------------------------------------------------------------------------------
-- Quark - Specifies the quark whose string value is queried.
--
-- Returns the string corresponding to the Quark. Returns "" for Quark values
-- obtained from X_Rm_Unique_Quarks. Raises Constraint_Error if an
-- uninitialized Quark value is passed. Note: This string belongs to the Xlib
-- and it must not be freed by the application. Quarks generated by
-- X_Rm_Unique_Quark were not created with a string value and return
-- None_X_String_Pointer.
------------------------------------------------------------------------------
Iter : X_Rm_Quark_Map.Iter;
Map : X_Rm_Quark_Map.Map;
begin
----Check for uninitialized quarks.
if Quark.Id = 0 then
raise Constraint_Error;
end if;
----Look up the unique quark value in the map.
X_Lib.Seize_Quark_Map (Map);
begin
X_Rm_Quark_Map.Initialize (Map, Iter, Quark);
----No entry means a "unique" quark.
if X_Rm_Quark_Map.Done (Iter) then
X_Lib.Release_Quark_Map (Map);
return None_X_String_Pointer;
end if;
-----Anything else gets the key string back.
declare
Str_Ptr : constant X_String_Pointer :=
X_Rm_Quark_Map.Key_Ptr (Iter);
begin
X_Lib.Release_Quark_Map (Map);
return Str_Ptr;
end;
exception
when others =>
X_Lib.Release_Quark_Map (Map);
raise;
end;
end X_Rm_Quark_To_String_Pointer;
--\f
function X_Rm_Unique_Quark return X_Rm_Quark is
Quark : X_Rm_Quark;
------------------------------------------------------------------------------
-- Returns a unique quark that does not correspond to any particular string
-- value.
------------------------------------------------------------------------------
begin
X_Lib.Get_Next_Quark (Quark);
return Quark;
end X_Rm_Unique_Quark;
--\f
procedure X_Rm_String_To_Quark_List (Str : X_String;
List : out Quark_Array_Type) is
------------------------------------------------------------------------------
-- Str - Specifies a series of names separated by '.' or '*'.
-- The string need not be null terminated. If an Ascii.Nul is
-- found then it is considered to be the "end" of the string.
-- List - Receives a list of Quarks; terminated by a None_Quark. The
-- list must be long enough.
--
-- Called with a string of the form "name1.name2*name3.name4" where the number
-- of names in the string must be at least one less than List'Length.
--
-- For each name in the list the corresponding Quark value is placed into
-- the Quarks list in the same order as the names appear in the Name string.
-- In Quarks, the quark corresponding to the last name will be followed by a
-- None_Quark entry. (That is why List'Length > number of names.)
--
-- Will raise Constraint_Error if the Quarks list is too small or if the
-- list is not a valid Resource_Name as defined by the resource manager.
------------------------------------------------------------------------------
One_Name : S_Natural;
List_Last : S_Natural := List'First;
I : S_Long;
begin
----Loop over the entire contents of the string looking for separators.
-- For each name found we create/lookup a quark value.
-- We stop looping when we hit end-of-string or an Ascii.Nul.
One_Name := Str'First;
I := Str'First - 1;
loop
I := I + 1;
exit when I > Str'Last or else Str (I) = Nul;
----See if we've found the next separator.
if Str (I) = '.' or else Str (I) = '*' then
if I /= Str'First then
List (List_Last) :=
String_To_Quark (Str (One_Name .. I - 1),
Validate => False);
List_Last := List_Last + 1;
end if;
One_Name := I + 1;
end if;
end loop;
----We fell out of the loop. Grab the final name the string contained.
List (List_Last) := String_To_Quark (Str (One_Name .. I - 1),
Validate => False);
List_Last := List_Last + 1;
List (List_Last) := None_Quark;
end X_Rm_String_To_Quark_List;
--\f
procedure X_Rm_String_To_Binding_Quark_List
(Str : X_String;
Bindings : out X_Rm_Binding_Array;
Quarks : out Quark_Array_Type) is
------------------------------------------------------------------------------
-- Str - Specifies a series of names separated by '.' or '*'.
-- The string need not be null terminated. If an Ascii.Nul is
-- found then it is considered to be the "end" of the string.
-- Bindings- Receives a list of binding values indicating '.' and '*'
-- separators for the Quarks list.
-- List - Receives a list of Quarks; terminated by a None_Quark. The
-- list must be long enough.
--
-- Called with a string of the form "name1.name2*name3.name4" where the number
-- of names in the string must be at least one less than Min( List'Length,
-- Bindings'Length+1 ). The legal separators between the names are Ascii.'.'
-- and Ascii.'*'. Anything that isn't Ascii.'.', Ascii.'*', or Ascii.Nul is
-- taken to be part of a name.
--
-- For each name in the list the corresponding Quark value is placed into
-- the Quarks list in the same order as the names appear in the Name string.
-- In Quarks, the quark corresponding to the last name will be followed by a
-- None_Quark entry. (That is why List'Length > number of names.)
--
-- For each entry in the Quarks list there is a Bindings entry. The Binding
-- entry indicates that the name was preceded by a '.' (Bind_Tightly), by
-- a '*' (Bind_Loosely), or is the first name in the string (Bind_Tightly).
--
-- Will raise Constraint_Error if the Quarks or Bindings list is too
-- small or if the list is not a valid Resource_Name as defined by the
-- resource manager.
------------------------------------------------------------------------------
Binding : X_Rm_Binding;
Bindings_Last : S_Natural := Bindings'First;
Quarks_Last : S_Natural := Quarks'First;
One_Name : S_Natural;
I : S_Long;
begin
----Loop over the entire contents of the string looking for dots. For each
-- non-empty name found between dots we create/lookup a quark value.
-- We stop looping when we hit end-of-string or an Ascii.Nul.
Binding := X_Rm_Bind_Tightly;
One_Name := Str'First;
I := Str'First - 1;
loop
I := I + 1;
exit when I > Str'Last or else Str (I) = Nul;
----See if we just found the separating '.' or '*' between names.
if Str (I) = '.' or else Str (I) = '*' then
if I /= Str'First then
-- Found a complete name
Bindings (Bindings_Last) := Binding;
Bindings_Last := Bindings_Last + 1;
Quarks (Quarks_Last) :=
String_To_Quark (Str (One_Name .. I - 1),
Validate => False);
Quarks_Last := Quarks_Last + 1;
end if;
One_Name := I + 1;
if Str (I) = '*' then
Binding := X_Rm_Bind_Loosely;
else
Binding := X_Rm_Bind_Tightly;
end if;
end if;
end loop;
----We fell out of the loop. Grab the final name the string contained.
Bindings (Bindings_Last) := Binding;
Quarks (Quarks_Last) := String_To_Quark (Str (One_Name .. I - 1),
Validate => False);
Quarks_Last := Quarks_Last + 1;
Quarks (Quarks_Last) := None_Quark;
end X_Rm_String_To_Binding_Quark_List;
--\f
end Xlbp_Rm_Quark;