DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400 Tapes

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about Rational R1000/400 Tapes

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download
Index: ┃ B T

⟦ad41ffd41⟧ TextFile

    Length: 31612 (0x7b7c)
    Types: TextFile
    Names: »B«

Derivation

└─⟦85b835f43⟧ Bits:30000549 8mm tape, Rational 1000, Xlib rev 6.00
    └─ ⟦0c20f784e⟧ »DATA« 
        └─⟦1abbe589f⟧ 
            └─⟦059497ac5⟧ 
                └─⟦this⟧ 

TextFile

with Xlbt_Arithmetic;  
use Xlbt_Arithmetic;  
with Xlbt_Atom_Defs;  
use Xlbt_Atom_Defs;  
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_Misc;  
use Xlbt_Misc;  
with Xlbt_Proc_Var;  
use Xlbt_Proc_Var;  
with Xlbt_Reply;  
use Xlbt_Reply;  
with Xlbt_Request;  
use Xlbt_Request;  
with Xlbt_String;  
use Xlbt_String;  
with Xlbt_Window;  
use Xlbt_Window;

with Xlbp_Proc_Var;  
use Xlbp_Proc_Var;  
with Xlbp_U_Char_Converters;  
use Xlbp_U_Char_Converters;

with Xlbit_Library3;  
use Xlbit_Library3;

with Xlbip_Get_Reply;  
use Xlbip_Get_Reply;  
with Xlbip_Internal;  
use Xlbip_Internal;  
with Xlbip_Put_Request;  
use Xlbip_Put_Request;

with Xlbmt_Network_Types;  
use Xlbmt_Network_Types;

package body Xlbp_Window_Property is
------------------------------------------------------------------------------
-- X Library Window Properties
--
-- Xlbp_Window_Property - Working with window properties
------------------------------------------------------------------------------
-- Copyright 1989 - 1991 by Rational, Santa Clara, California.
-- Copyright 1988 by Wyse Technology, Inc., San Jose, Ca.,
-- 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, Rational, or Wyse
-- not be used in advertising or publicity pertaining to distribution of
-- the software without specific, written prior permission.
--
-- MIT, Rational, and Wyse disclaim all warranties with regard to this
-- software, including all implied warranties of merchantability and fitness,
-- in no event shall MIT, Rational, or Wyse 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 X_Change_Property (Display        : X_Display;  
                                 Window         : X_Window;  
                                 Property       : X_Atom;  
                                 Representation : X_Atom;  
                                 Format         : U_Char;       -- 8, 16, 32
                                 Mode           : X_Property_Mode;  
                                 Data           : U_Char_Array) is
------------------------------------------------------------------------------
-- X_Change_Property
------------------------------------------------------------------------------
        Extra_Words   : S_Natural := (Data'Length + 3) / 4;  
        Element_Count : S_Long;  
    begin

----Make sure that our arguments make sense.

        case Format is  
            when 8 =>  
                Element_Count := Data'Length;  
            when 16 =>  
                if Data'Length rem 2 /= 0 then  
                    raise Constraint_Error; -- Data has an odd length.
                end if;  
                Element_Count := Data'Length / 2;  
            when 32 =>  
                if Data'Length rem 4 /= 0 then  
                    raise Constraint_Error; -- Data has non-modulo-4 length
                end if;  
                Element_Count := Data'Length / 4;  
            when others =>  
                raise Constraint_Error; -- He passed in a garbage format.
        end case;

----Lock the display.

        Lock_Display (Display);  
        begin

----Send the request.

            Put_X_Change_Property_Request  
               (Display, (Kind => Change_Property,  
                          Length => X_Change_Property_Request'Size / 32 +  
                                       U_Short (Extra_Words),  
                          Pad1 => 0,  
                          Pad2 => 0,  
                          Pad3 => 0,  
                          Mode => Mode,  
                          Window => Window,  
                          Property => Property,  
                          Representation => Representation,  
                          Format => Format,  
                          N_Units => Element_Count),  
                Extra_Words * 4);

----Send the extra data for the reply.

            Put_U_Char_Array (Display, Data);

----Catch unexpected exceptions.

        exception  
            when others =>  
                Unlock_Display (Display);  
                raise;  
        end;

----Unlock; sync; return;

        Unlock_Display (Display);  
        Sync_Handle (Display);

    end X_Change_Property;

--\f

    procedure X_Delete_Property (Display  : X_Display;  
                                 Window   : X_Window;  
                                 Property : X_Atom) is
------------------------------------------------------------------------------
-- X_Delete_Property
------------------------------------------------------------------------------
    begin

----Lock the display.

        Lock_Display (Display);  
        begin

----Send the request.

            Put_X_Delete_Property_Request  
               (Display, (Kind     => Delete_Property,  
                          Length   => X_Delete_Property_Request'Size / 32,  
                          Pad      => 0,  
                          Window   => Window,  
                          Property => Property));

----Catch unexpected exceptions;

        exception  
            when others =>  
                Unlock_Display (Display);  
                raise;  
        end;

----Unlock; sync; return.

        Unlock_Display (Display);  
        Sync_Handle (Display);

    end X_Delete_Property;

--\f

    procedure Free_X_Text_Property (Prop : in out X_Text_Property) is
------------------------------------------------------------------------------
--  Prop    - Specifies the X_Text_Property whose contents are to be freed
--
-- Called to free up any heap storage contained within an X_Text_Property.
-- Since an X_Text_Property is a record type and not an access type the
-- X_Text_Property itself is not freed; only its contents.
------------------------------------------------------------------------------
    begin

        Free_U_Char_List (Prop.Value);

    end Free_X_Text_Property;

--\f

    procedure X_Get_Window_Property (Display        :     X_Display;  
                                     Window         :     X_Window;  
                                     Property       :     X_Atom;  
                                     Offset         :     S_Natural;  
                                     Maximum_Length :     S_Natural;  
                                     Delete         :     Boolean;  
                                     Representation :     X_Atom;  
                                     Actual_Type    : out X_Atom;  
                                     Actual_Format  : out U_Char;  
                                     N_Items        : out S_Natural;  
                                     Bytes_After    : out S_Natural;  
                                     Data           : out U_Char_List;  
                                     Status         : out X_Status) is
------------------------------------------------------------------------------
-- X_Get_Window_Property
-- Call Get_Data_Raw (and friends) to retrieve the data.
------------------------------------------------------------------------------
        Uca          : U_Char_List;  
        Errorstatus  : X_Status;  
        Reply        : X_Reply_Contents;  
        Extra_Return : S_Natural;  
        Bytes_Total  : S_Natural;  
        Format       : U_Char;  
        Ni           : S_Natural;  
    begin

----Lock the display.

        Lock_Display (Display);  
        begin

----Send the request.

            Put_X_Get_Property_Request  
               (Display, (Kind           => Get_Property,  
                          Length         => X_Get_Property_Request'Size / 32,  
                          Window         => Window,  
                          Property       => Property,  
                          Representation => Representation,  
                          Delete         => From_Boolean (Delete),  
                          Data_Offset    => Offset,  
                          Data_Length    => Maximum_Length));

----Read the reply header.

            Get_Reply (Display => Display,  
                       Code    => Get_Property,  
                       Reply   => Reply,  
                       Extra   => 0,  
                       Discard => False,  
                       Status  => Errorstatus);

----If we failed for some reason then return that failure.

            if Errorstatus = Failed then  
                Actual_Type   := None_X_Atom;  
                Actual_Format := 8;  
                N_Items       := 0;  
                Bytes_After   := 0;  
                Data          := None_U_Char_List;  
                Status        := Failed;  
                Unlock_Display (Display);  
                Sync_Handle (Display);  
                return;  
            end if;

----Return the information from the reply.

            Actual_Type   := Reply.Get_Property.Property_Type;  
            Actual_Format := Reply.Get_Property.Format;  
            Format        := Reply.Get_Property.Format;  
            Extra_Return  := S_Natural (Reply.Get_Property.N_Items);  
            N_Items       := Extra_Return;  
            Ni            := Extra_Return;  
            Bytes_After   := S_Natural (Reply.Get_Property.Bytes_After);

----Validate the format.

            if Reply.Get_Property.Property_Type /= None_X_Atom then  
                case Reply.Get_Property.Format is  
                    when 8 =>  
                        null;  
                    when 16 =>  
                        null;  
                    when 32 =>  
                        null;

----This part of the code should never be reached.  If it is, the server
--  sent back a property with an invalid format.  This is a Bad_Implementation
--  error.

                    when others =>  
                        declare  
                            Error : X_Error_Contents :=  
                               (Kind       => Bad_Implementation,  
                                Send_Event => False,  
                                Serial     => Display.Request,  
                                Nothing    =>  
                                   (Kind            => Error_Event,  
                                    Code            => Bad_Implementation,  
                                    Sequence_Number =>  
                                       U_Short (Display.Request rem  
                                                (S_Long (U_Short'Last) + 1)),  
                                    Pad0            => (others => 0),  
                                    Major_Opcode    => Get_Property,  
                                    Minor_Opcode    => 0,  
                                    Pad             => (others => 0)));

                            Proc : X_Procedure_Variable;  
                        begin  
                            X_Lib.Get_Error (Display, Proc);  
                            Proc_Var_X_Error_Function.Call  
                               (Proc_Var_X_Error_Function.To_Pv (Proc),  
                                Display, Error);  
                        end;  
                        Actual_Type   := None_X_Atom;  
                        Actual_Format := 8;  
                        N_Items       := 0;  
                        Bytes_After   := 0;  
                        Status        := Failed;  
                        Unlock_Display (Display);  
                        Sync_Handle (Display);  
                        return;  
                end case;  
            end if;

----Figure the number of bytes in the message.

            if Ni = 0 then  
                Data := None_U_Char_List;  
            else  
                case Format is  
                    when 8 =>  
                        Bytes_Total := Ni;  
                    when 16 =>  
                        Bytes_Total := Ni * 2;  
                    when 32 =>  
                        Bytes_Total := Ni * 4;  
                    when others =>  
                        raise X_Library_Confusion;  
                end case;

----Allocate the space for the data and then read it.

                begin  
                    Uca := new U_Char_Array (1 .. Bytes_Total);  
                exception  
                    when others =>  
                        Eat_Raw_Data (Display, Bytes_Total);  
                        raise;  
                end;  
                Data := Uca;  
                Get_U_Char_Array (Display, Uca.all);  
            end if;

----Catch unexpected exceptions.

        exception  
            when others =>  
                Unlock_Display (Display);  
                raise;  
        end;

----Unlock; sync; and return success.

        Unlock_Display (Display);  
        Sync_Handle (Display);  
        Status := Successful;

    end X_Get_Window_Property;

--\f

    procedure X_Get_Text_Property (Display  :     X_Display;  
                                   Window   :     X_Window;  
                                   Data     : out X_String_Pointer;  
                                   Property :     X_Atom;  
                                   Status   : out X_Status) is
------------------------------------------------------------------------------
--  Display       - Specifies the display to use.
--  Window             - Specifies the window to use.
--  Data          - Receives a record of the received data
--  Property      - Specifies the property atom.
--  Status        - Returns Successful if we succeeded and Failed if not.
--
-- Called to obtain the "textual" data associated with some window's
-- (window-manager) property.  The Data'length received is equal to:
--      Length = (Data.Format / 8) * Data.N_Items
------------------------------------------------------------------------------
        Prop : X_Text_Property;  
        Stat : X_Status;  
    begin

        X_Get_Text_Property (Display, Window, Prop, Property, Stat);  
        if Stat /= Successful then  
            Status := Failed;  
            Data   := None_X_String_Pointer;  
            return;  
        end if;  
        X_Text_Property_To_String (Prop, Data, Status);  
        Free_X_Text_Property (Prop);

    exception

        when others =>  
            Free_X_Text_Property (Prop);  
            raise;

    end X_Get_Text_Property;

--\f

    procedure X_Get_Text_Property (Display  :     X_Display;  
                                   Window   :     X_Window;  
                                   Data     : out X_Text_Property;  
                                   Property :     X_Atom;  
                                   Status   : out X_Status) is
------------------------------------------------------------------------------
--  Display       - Specifies the display to use.
--  Window             - Specifies the window to use.
--  Data          - Receives a record of the received data
--  Property      - Specifies the property atom.
--  Status        - Returns Successful if we succeeded and Failed if not.
--
-- Called to obtain the "textual" data associated with some window's
-- (window-manager) property.  The Data'length received is equal to:
--      Length = (Data.Format / 8) * Data.N_Items
------------------------------------------------------------------------------
        Actual_Type   : X_Atom;  
        Actual_Format : U_Char;  
        N_Items       : S_Natural;  
        Leftover      : S_Natural;  
        Uca           : U_Char_List;  
        Stat          : X_Status;  
    begin

        X_Get_Window_Property (Display, Window, Property, 0, 1_000_000,  
                               False, Any_Property_Type, Actual_Type,  
                               Actual_Format, N_Items, Leftover, Uca, Stat);  
        if Stat /= Successful or else Actual_Type = None_X_Atom then  
            Data   := (Encoding => None_X_Atom,  
                       Format   => 0,  
                       N_Items  => 0,  
                       Value    => None_U_Char_List);  
            Status := Failed;  
        else  
            Data   := (Encoding => Actual_Type,  
                       Format   => Actual_Format,  
                       N_Items  => N_Items,  
                       Value    => Uca);  
            Status := Successful;  
        end if;

    end X_Get_Text_Property;

--\f

    function X_List_Properties (Display : X_Display;  
                                Window  : X_Window) return X_Atom_List is
------------------------------------------------------------------------------
-- X_List_Properties
------------------------------------------------------------------------------
        Rep  : X_Reply_Contents;  
        Stat : X_Status;  
    begin

----Lock the display.

        Lock_Display (Display);  
        begin

----Send the request.

            Put_X_List_Properties_Request  
               (Display, (Kind   => List_Properties,  
                          Length => X_List_Properties_Request'Size / 32,  
                          Pad    => 0,  
                          Id     => Window));

----Read the reply header.

            Get_Reply (Display => Display,  
                       Code    => List_Properties,  
                       Reply   => Rep,  
                       Extra   => 0,  
                       Discard => False,  
                       Status  => Stat);

----If we failed then return null as if the reply was no-properties.

            if Stat = Failed or else  
               Rep.List_Properties.N_Properties = 0 then  
                Unlock_Display (Display);  
                Sync_Handle (Display);  
                return None_X_Atom_List;  
            end if;

----Allocate an array of the correct size and read the properties.

            declare  
                List   : X_Atom_List;  
                Nbytes : constant S_Natural :=  
                   S_Natural (Rep.List_Properties.N_Properties) *  
                      X_Atom'Size / 8;  
            begin  
                begin  
                    List := new X_Atom_Array  
                                   (1 .. S_Natural  
                                            (Rep.List_Properties.N_Properties));  
                exception  
                    when others =>  
                        Eat_Raw_Data (Display, S_Natural (Rep.List_Properties.  
                                                          N_Properties) *  
                                               (X_Atom'Size / 8));  
                        raise;  
                end;  
                Get_X_Atom_Array (Display, List.all);  
                Unlock_Display (Display);  
                Sync_Handle (Display);  
                return List;  
            exception  
                when others =>  
                    Free_X_Atom_List (List);  
                    raise;  
            end;

----Catch unexpected exceptions.

        exception  
            when others =>  
                Unlock_Display (Display);  
                raise;  
        end;

    end X_List_Properties;

--\f

    procedure X_Rotate_Window_Properties (Display     : X_Display;  
                                          Window      : X_Window;  
                                          Properties  : X_Atom_Array;  
                                          N_Positions : S_Short) is
------------------------------------------------------------------------------
-- X_Rotate_Properties
------------------------------------------------------------------------------
    begin

----Lock the display.

        Lock_Display (Display);  
        begin

----Send the request.

            Put_X_Rotate_Properties_Request  
               (Display,  
                (Kind        => Rotate_Properties,  
                 Length      =>  
                    X_Rotate_Properties_Request'Size / 32 + Properties'Length,  
                 Pad         => 0,  
                 Window      => Window,  
                 N_Atoms     => Properties'Length,  
                 N_Positions => N_Positions));

----Send the extra data for the request.  The subtype is crucial.  If you get
--  rid of it and "eliminate the unnecessary copy" then you will send the
--  bounds of Properties as well as the data portion of Properties.  Prop has
--  no embedded bounds information; it is pure data.

            Put_X_Atom_Array (Display, Properties);

----Catch unexpected exceptions.

        exception  
            when others =>  
                Unlock_Display (Display);  
                raise;  
        end;

----Unlock; sync; and return.

        Unlock_Display (Display);  
        Sync_Handle (Display);

    end X_Rotate_Window_Properties;

--\f

    procedure X_Set_Text_Property (Display  : X_Display;  
                                   Window   : X_Window;  
                                   Data     : X_String;  
                                   Property : X_Atom) is
------------------------------------------------------------------------------
--  Display       - Specifies the display to use.
--  Window             - Specifies the window to use.
--  Data          - Specifies a record of the new data
--  Property      - Specifies the property atom.
--
-- Called to set the "textual" data associated with some window's
-- (window-manager) property.  The Data'length sent is expected to be equal to:
--      Length = (Data.Format / 8) * Data.N_Items
--
-- Free the storage in the Data after use with the Free_X_Text_Property routine.
------------------------------------------------------------------------------
        Prop : X_Text_Property;  
    begin

        X_String_To_Text_Property (Data, Prop);  
        X_Change_Property (Display, Window, Property, Prop.Encoding,  
                           Prop.Format, Prop_Mode_Replace, Prop.Value.all);  
        Free_X_Text_Property (Prop);

    exception

        when others =>  
            Free_X_Text_Property (Prop);  
            raise;

    end X_Set_Text_Property;

--\f

    procedure X_Set_Text_Property (Display  : X_Display;  
                                   Window   : X_Window;  
                                   Data     : X_Text_Property;  
                                   Property : X_Atom) is
------------------------------------------------------------------------------
--  Display       - Specifies the display to use.
--  Window             - Specifies the window to use.
--  Data          - Specifies a record of the new data
--  Property      - Specifies the property atom.
--
-- Called to set the "textual" data associated with some window's
-- (window-manager) property.  The Data'length sent is expected to be equal to:
--      Length = (Data.Format / 8) * Data.N_Items
--
-- Free the storage in the Data after use with the Free_X_Text_Property routine.
------------------------------------------------------------------------------
    begin

        X_Change_Property (Display, Window, Property, Data.Encoding,  
                           Data.Format, Prop_Mode_Replace, Data.Value.all);

    end X_Set_Text_Property;

--\f

    procedure X_String_List_To_Text_Property (List :     X_String_Pointer_Array;  
                                              Data : out X_Text_Property) is
------------------------------------------------------------------------------
--  List    - Specifies the list of strings to convert
--  Data    - Receives the converted list
--
-- Converts the list of strings into a X_Text_Property.  Each string is
-- included verbatim with an added trailing Ascii.Nul added to the end.
-- The final string does not have a trailing null.
--
-- Free the storage in the list after use with the Free_X_String(8)_List
-- routine.
-- Free the storage in the Data after use with the Free_X_Text_Property routine.
------------------------------------------------------------------------------
        N_Chars : S_Natural;  
        Ldata   : X_Text_Property;  
    begin

----Compute the number of characters that we will be placing into the property.

        if List'Length > 0 then  
            N_Chars := List'Length - 1;  
            for I in List'Range loop  
                N_Chars := N_Chars + List (I)'Length;  
            end loop;  
        else  
            N_Chars := 0;  
        end if;

----Allocate a UCA list that is that big.

        Ldata.Encoding := Xa_String;  
        Ldata.Format   := 8;  
        Ldata.N_Items  := N_Chars;  
        Ldata.Value    := new U_Char_Array (1 .. N_Chars);  
        Data           := Ldata;

----Now copy the strings into the Value.

        if List'Length = 0 then  
            return;  
        end if;  
        N_Chars := 0;  
        for I in List'First .. List'Last - 1 loop  
            To_Uca (Ldata.Value (N_Chars + 1 .. N_Chars + List (I)'Length),  
                    List (I).all);  
            N_Chars               := N_Chars + List (I)'Length + 1;  
            Ldata.Value (N_Chars) := 0;  
        end loop;  
        To_Uca (Ldata.Value (N_Chars + 1 .. N_Chars + List (List'Last)'Length),  
                List (List'Last).all);

    exception

        when others =>  
            Free_X_Text_Property (Ldata);  
            Data := None_X_Text_Property;  
            raise;

    end X_String_List_To_Text_Property;

--\f

    procedure X_Text_Property_To_String_List (Data : X_Text_Property;  
                                              List : out X_String_Pointer_List;  
                                              Status : out X_Status) is
------------------------------------------------------------------------------
--  Data    - Specifies the converted list
--  List    - Receives NULL or the result list
--  Status  - Receives Successful if we succeeded and Failed if not.
--
-- Converts the X_Text_Property into a list of strings.  Returns NULL if
-- Successful but the list is empty or if Failed.
--
-- Free the storage in the Data after use with the Free_X_Text_Property routine.
-- Free the storage in the list after use with the Free_X_String(8)_List
-- routine.
------------------------------------------------------------------------------
        N_Elem   : S_Natural;  
        End_Elem : S_Natural;  
        New_List : X_String_Pointer_List;  
    begin

----Make sure we understand how to do it.

        if Data.Encoding /= Xa_String or else Data.Format /= 8 then  
            List   := None_X_String_Pointer_List;  
            Status := Failed;  
            return;  
        end if;

----If there is no list then return null.

        if Data.N_Items = 0 then  
            List   := None_X_String_Pointer_List;  
            Status := Successful;  
            return;  
        end if;

----Count the number of strings.

        N_Elem   := 1;  
        End_Elem := Data.Value'First + Data.N_Items - 1;  
        for I in Data.Value'First .. End_Elem loop  
            if Data.Value (I) = 0 then  
                N_Elem := N_Elem + 1;  
            end if;  
        end loop;

----Allocate the result array and then go locate the various strings.

        New_List := new X_String_Pointer_Array (1 .. N_Elem);  
        N_Elem   := Data.Value'First;  
        for I in New_List'First .. New_List'Last - 1 loop  
            for J in N_Elem .. End_Elem loop  
                if Data.Value (J) = 0 then  
                    New_List (I) := new X_String (1 .. J - N_Elem - 1);  
                    From_Uca (New_List (I).all, Data.Value (N_Elem .. J - 1));  
                    exit;  
                end if;  
            end loop;  
        end loop;  
        New_List (New_List'Last) := new X_String (1 .. End_Elem - N_Elem - 1);  
        From_Uca (New_List (New_List'Last).all,  
                  Data.Value (N_Elem .. End_Elem));

----Return our result.

        List   := New_List;  
        Status := Successful;

    exception  
        when others =>  
            Free_X_String_Pointer_List (New_List);  
            raise;

    end X_Text_Property_To_String_List;

--\f

    procedure X_String_To_Text_Property (Str  :     X_String;  
                                         Data : out X_Text_Property) is
------------------------------------------------------------------------------
--  Str     - Specifies the string to convert
--  Data    - Receives the converted list
--
-- Converts the string into a X_Text_Property.
--
-- Free the storage in the list after use with the Free_X_String(8)_List
-- routine.
-- Free the storage in the Data after use with the Free_X_Text_Property routine.
------------------------------------------------------------------------------
        Ldata : X_Text_Property;  
    begin

----Allocate a UCA list that is that big.

        Ldata.Encoding := Xa_String;  
        Ldata.Format   := 8;  
        Ldata.N_Items  := Str'Length;  
        Ldata.Value    := new U_Char_Array (1 .. Str'Length);  
        Data           := Ldata;

----Now copy the string into the Value.

        To_Uca (Ldata.Value.all, Str);

    exception

        when others =>  
            Free_X_Text_Property (Ldata);  
            Data := None_X_Text_Property;  
            raise;

    end X_String_To_Text_Property;

--\f

    procedure X_Text_Property_To_String (Data   :     X_Text_Property;  
                                         Str    : out X_String_Pointer;  
                                         Status : out X_Status) is
------------------------------------------------------------------------------
--  Data    - Specifies the converted list
--
-- Converts the X_Text_Property into a single string.
-- Free the storage in the Data after use with the Free_X_Text_Property routine.
-- Free the storage in the string after use with the Free_X_String(8)_Pointer
-- routine.
------------------------------------------------------------------------------
        New_Str : X_String_Pointer;  
    begin

----Make sure we understand how to do it.

        if Data.Encoding /= Xa_String or else Data.Format /= 8 then  
            Str    := None_X_String_Pointer;  
            Status := Failed;  
            return;  
        end if;

----If there is no list then return null.

        if Data.N_Items = 0 then  
            Str    := None_X_String_Pointer;  
            Status := Successful;  
            return;  
        end if;

----Allocate the string and convert it.

        New_Str := new X_String (1 .. Data.N_Items);  
        From_Uca (New_Str.all, Data.Value.all);  
        Str    := New_Str;  
        Status := Successful;

    exception  
        when Constraint_Error =>
            ----We assume this to be a uca->string conversion error.
            Free_X_String_Pointer (New_Str);  
            Str    := null;  
            Status := Failed;  
            return;  
        when others =>  
            Free_X_String_Pointer (New_Str);  
            raise;

    end X_Text_Property_To_String;

--\f

end Xlbp_Window_Property;