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

⟦0016b7018⟧ TextFile

    Length: 29270 (0x7256)
    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_Display2;  
use Xlbt_Display2;  
with Xlbt_Error;  
use Xlbt_Error;  
with Xlbt_Extension;  
use Xlbt_Extension;  
with Xlbt_Extension2;  
use Xlbt_Extension2;  
with Xlbt_Event;  
use Xlbt_Event;  
with Xlbt_Font;  
use Xlbt_Font;  
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_Visual;  
use Xlbt_Visual;

with Xlbp_Proc_Var;  
use Xlbp_Proc_Var;

with Xlbit_Library4;  
use Xlbit_Library4;

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_Extension is
------------------------------------------------------------------------------
-- X Library Extensions
--
-- Xlbp_Extension - Used to establish and control extensions to the X Library
-- and to the X protocol.
------------------------------------------------------------------------------
-- 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

    procedure X_Query_Extension (Display      :     X_Display;  
                                 Name         :     X_String;  
                                 Major_Opcode : out X_Request_Code;  
                                 First_Event  : out X_Event_Code;  
                                 First_Error  : out X_Error_Code;  
                                 Present      : out Boolean;  
                                 Status       : out X_Status) is  
        Rep  : X_Reply_Contents;  
        Succ : X_Status;  
    begin

----Lock the display.

        Lock_Display (Display);  
        begin

----Send the request.

            Put_X_Query_Extension_Request  
               (Display,  
                (Kind    => Query_Extension,  
                 Length  =>  
                    X_Query_Extension_Request'Size / 32 + (Name'Length + 3) / 4,  
                 Pad     => 0,  
                 Pad1    => 0,  
                 Pad2    => 0,  
                 N_Bytes => Name'Length),  
                Name'Length);  
            Put_X_String (Display, Name);

----Read the reply.

            Get_Reply (Display => Display,  
                       Code    => Query_Extension,  
                       Reply   => Rep,  
                       Extra   => 0,  
                       Discard => True,  
                       Status  => Succ);  
            Status := Succ;  
            if Succ = Failed then  
                Major_Opcode := None_X_Request_Code;  
                First_Event  := X_Event_Code'Val (0);  
                First_Error  := X_Error_Code'Val (0);  
                Present      := False;  
                Unlock_Display (Display);  
                Sync_Handle (Display);  
                return;  
            end if;  
            Major_Opcode := Rep.Query_Extension.Major_Opcode;  
            First_Event  := Rep.Query_Extension.First_Event;  
            First_Error  := Rep.Query_Extension.First_Error;

----Catch exceptions.

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

----Unlock; sync; return our result.

        Present := To_Boolean (Rep.Query_Extension.Present);  
        Unlock_Display (Display);  
        Sync_Handle (Display);

    end X_Query_Extension;

--\f

    function X_List_Extensions (Display : X_Display)  
                               return X_String_Pointer_List is  
        Rep    : X_Reply_Contents;  
        Length : S_Natural;  
        Succ   : X_Status;  
    begin

----Lock the display.

        Lock_Display (Display);  
        begin

----Send the request.

            Put_X_List_Extensions_Request  
               (Display, (Kind   => List_Extensions,  
                          Length => X_List_Extensions_Request'Size / 32,  
                          Pad    => 0));

----Read the reply.

            Get_Reply (Display => Display,  
                       Code    => List_Extensions,  
                       Reply   => Rep,  
                       Extra   => 0,  
                       Discard => False,  
                       Status  => Succ);  
            if Succ = Failed or else  
               Rep.List_Extensions.N_Extensions = 0 then  
                Unlock_Display (Display);  
                Sync_Handle (Display);  
                return None_X_String_Pointer_List;

----Read the extra data.

            else  
                declare  
                    Actual : S_Natural;  
                    The_List : X_String_Pointer_List;  
                    Ch : X_String  
                            (1 .. S_Natural (Rep.List_Extensions.Length) * 4);  
                begin  
                    begin  
                        The_List := new X_String_Pointer_Array  
                                           (1 .. S_Natural (Rep.List_Extensions.  
                                                            N_Extensions));  
                    exception  
                        when others =>  
                            Eat_Raw_Data  
                               (Display, S_Natural (Rep.List_Extensions.Length *  
                                                    (32 / 8)));  
                            raise;  
                    end;  
                    Get_X_String (Display, Ch);
                    ----unpack into null terminated strings.
                    Length := Ch'First;  
                    for I in The_List'Range loop  
                        for J in Length .. Ch'Last loop  
                            if Ch (J) = Nul then  
                                Actual := J - Length;
                                ----Chop strings if they are too long for this
                                --  Ada implementation.
                                The_List (I)     := new X_String (1 .. Actual);  
                                The_List (I).all :=  
                                   Ch (Length .. Length + Actual - 1);  
                                Length           := J + 1;  
                                exit;  
                            end if;  
                        end loop;  
                    end loop;  
                    Unlock_Display (Display);  
                    Sync_Handle (Display);  
                    return The_List;  
                exception  
                    when others =>  
                        Free_X_String_Pointer_List (The_List);  
                        raise;  
                end;

            end if;

----Catch exceptions.

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

    end X_List_Extensions;

--\f

    function X_Init_Extension (Display : X_Display;  
                               Name    : X_String) return X_Ext_Codes is
------------------------------------------------------------------------------
-- This routine is used to link a extension in so it will be called
-- at appropriate times.
------------------------------------------------------------------------------
        The_Codes : X_Ext_Codes_Rec;  
        Extension : X_Extension;  
        Present   : Boolean;  
        Succ      : X_Status;  
    begin

----See if the extension exists.

        X_Query_Extension (Display, Name, The_Codes.Major_Opcode,  
                           The_Codes.First_Event,  
                           The_Codes.First_Error, Present, Succ);  
        if Succ = Failed then  
            return None_X_Ext_Codes;  
        end if;  
        if not Present then  
            return None_X_Ext_Codes;  
        end if;

----Create the X_Ext_Codes for the extension.

        Lock_Display (Display);  
        begin  
            Extension           := new X_Extension_Rec;  
            The_Codes.Extension := Display.Ext_Number;  
            Extension.Codes     := new X_Ext_Codes_Rec'(The_Codes);  
            Display.Ext_Number  := "+" (Display.Ext_Number, 1);

            -- chain it onto the disp list
            Extension.Next    := Display.Ext_Procs;  
            Display.Ext_Procs := Extension;  
        exception  
            when others =>  
                Unlock_Display (Display);  
                if Extension /= null then  
                    if Extension.Codes /= null then  
                        Free_X_Ext_Codes (Extension.Codes);  
                    end if;  
                    Free_X_Extension (Extension);  
                end if;  
                raise;  
        end;

        Unlock_Display (Display);  
        return Extension.Codes;       -- tell him which extension

    end X_Init_Extension;

--\f

    function X_Add_Extension (Display : X_Display) return X_Ext_Codes is
------------------------------------------------------------------------------
-- This routine is used to link a extension in so it will be called
-- at appropriate times.
------------------------------------------------------------------------------
        Extension : X_Extension;  
    begin

        Lock_Display (Display);  
        begin  
            Extension                 := new X_Extension_Rec;  
            Extension.Codes           := new X_Ext_Codes_Rec;  
            Extension.Codes.Extension := Display.Ext_Number;  
            Display.Ext_Number        := "+" (Display.Ext_Number, 1);

            -- chain it onto the disp list
            Extension.Next    := Display.Ext_Procs;  
            Display.Ext_Procs := Extension;  
        exception  
            when others =>  
                Unlock_Display (Display);  
                if Extension /= null then  
                    if Extension.Codes /= null then  
                        Free_X_Ext_Codes (Extension.Codes);  
                    end if;  
                    Free_X_Extension (Extension);  
                end if;  
                raise;  
        end;

        Unlock_Display (Display);  
        return Extension.Codes;       -- tell him which extension

    end X_Add_Extension;

--\f

    function Lookup_Extension  
                (Display   : X_Display;  
                 Extension : X_Extension_Number) return X_Extension is  
        Ext : X_Extension := Display.Ext_Procs;  
    begin

        while Ext /= null loop  
            if Ext.Codes.Extension = Extension then  
                return Ext;  
            end if;  
            Ext := Ext.Next;  
        end loop;  
        return null;

    end Lookup_Extension;

--\f

    function X_E_Set_Close_Display  
                (Display   : X_Display;  
                 Extension : X_Extension_Number;  
                 Proc      : Proc_Var_X_Close_Display_Extension.Pv)  
                return Proc_Var_X_Close_Display_Extension.Pv is
        -- routine to call when disp closed
        E        : X_Extension; -- for lookup of extension
        Old_Proc : X_Procedure_Variable;  
    begin

        E := Lookup_Extension (Display, Extension);  
        if E = null then  
            return Proc_Var_X_Close_Display_Extension.None;  
        end if;

        Lock_Display (Display);  
        Old_Proc        := E.Close_Display;  
        E.Close_Display := Proc_Var_X_Close_Display_Extension.From_Pv (Proc);  
        Unlock_Display (Display);

        return Proc_Var_X_Close_Display_Extension.To_Pv (Old_Proc);

    end X_E_Set_Close_Display;

--\f

    function X_E_Set_Create_Font (Display : X_Display;  
                                  Extension : X_Extension_Number;  
                                  Proc : Proc_Var_X_Display_Font_Extension.Pv)  
                                 return Proc_Var_X_Display_Font_Extension.Pv is
        -- routine to call when font created
        E        : X_Extension; -- for lookup of extension
        Old_Proc : X_Procedure_Variable;  
    begin

        E := Lookup_Extension (Display, Extension);  
        if E = null then  
            return Proc_Var_X_Display_Font_Extension.None;  
        end if;

        Lock_Display (Display);  
        Old_Proc      := E.Create_Font;  
        E.Create_Font := Proc_Var_X_Display_Font_Extension.From_Pv (Proc);  
        Unlock_Display (Display);

        return Proc_Var_X_Display_Font_Extension.To_Pv (Old_Proc);

    end X_E_Set_Create_Font;

--\f

    function X_E_Set_Free_Font (Display : X_Display;  
                                Extension : X_Extension_Number;  
                                Proc : Proc_Var_X_Display_Font_Extension.Pv)  
                               return Proc_Var_X_Display_Font_Extension.Pv is
        -- routine to call when font freed
        E        : X_Extension; -- for lookup of extension
        Old_Proc : X_Procedure_Variable;  
    begin

        E := Lookup_Extension (Display, Extension);  
        if E = null then  
            return Proc_Var_X_Display_Font_Extension.None;  
        end if;

        Lock_Display (Display);  
        Old_Proc    := E.Free_Font;  
        E.Free_Font := Proc_Var_X_Display_Font_Extension.From_Pv (Proc);  
        Unlock_Display (Display);

        return Proc_Var_X_Display_Font_Extension.To_Pv (Old_Proc);

    end X_E_Set_Free_Font;

--\f

    function X_E_Set_Copy_Gc (Display   : X_Display;  
                              Extension : X_Extension_Number;  
                              Proc      : Proc_Var_X_Display_Gc_Extension.Pv)  
                             return Proc_Var_X_Display_Gc_Extension.Pv is
        -- routine to call when GC copied
        E        : X_Extension; -- for lookup of extension
        Old_Proc : X_Procedure_Variable;  
    begin

        E := Lookup_Extension (Display, Extension);  
        if E = null then  
            return Proc_Var_X_Display_Gc_Extension.None;  
        end if;

        Lock_Display (Display);  
        Old_Proc  := E.Copy_Gc;  
        E.Copy_Gc := Proc_Var_X_Display_Gc_Extension.From_Pv (Proc);  
        Unlock_Display (Display);

        return Proc_Var_X_Display_Gc_Extension.To_Pv (Old_Proc);

    end X_E_Set_Copy_Gc;

--\f

    function X_E_Set_Create_Gc (Display   : X_Display;  
                                Extension : X_Extension_Number;  
                                Proc      : Proc_Var_X_Display_Gc_Extension.Pv)  
                               return Proc_Var_X_Display_Gc_Extension.Pv is
        -- routine to call when GC created
        E        : X_Extension; -- for lookup of extension
        Old_Proc : X_Procedure_Variable;  
    begin

        E := Lookup_Extension (Display, Extension);  
        if E = null then  
            return Proc_Var_X_Display_Gc_Extension.None;  
        end if;

        Lock_Display (Display);  
        Old_Proc    := E.Create_Gc;  
        E.Create_Gc := Proc_Var_X_Display_Gc_Extension.From_Pv (Proc);  
        Unlock_Display (Display);

        return Proc_Var_X_Display_Gc_Extension.To_Pv (Old_Proc);

    end X_E_Set_Create_Gc;

--\f

    function X_E_Set_Flush_Gc (Display   : X_Display;  
                               Extension : X_Extension_Number;  
                               Proc      : Proc_Var_X_Display_Gc_Extension.Pv)  
                              return Proc_Var_X_Display_Gc_Extension.Pv is
        -- routine to call when GC copied
        E        : X_Extension; -- for lookup of extension
        Old_Proc : X_Procedure_Variable;  
    begin

        E := Lookup_Extension (Display, Extension);  
        if E = null then  
            return Proc_Var_X_Display_Gc_Extension.None;  
        end if;

        Lock_Display (Display);  
        Old_Proc   := E.Flush_Gc;  
        E.Flush_Gc := Proc_Var_X_Display_Gc_Extension.From_Pv (Proc);  
        Unlock_Display (Display);

        return Proc_Var_X_Display_Gc_Extension.To_Pv (Old_Proc);

    end X_E_Set_Flush_Gc;

--\f

    function X_E_Set_Free_Gc (Display   : X_Display;  
                              Extension : X_Extension_Number;  
                              Proc      : Proc_Var_X_Display_Gc_Extension.Pv)  
                             return Proc_Var_X_Display_Gc_Extension.Pv is
        -- routine to call when GC freed
        E        : X_Extension; -- for lookup of extension
        Old_Proc : X_Procedure_Variable;  
    begin

        E := Lookup_Extension (Display, Extension);  
        if E = null then  
            return Proc_Var_X_Display_Gc_Extension.None;  
        end if;

        Lock_Display (Display);  
        Old_Proc  := E.Free_Gc;  
        E.Free_Gc := Proc_Var_X_Display_Gc_Extension.From_Pv (Proc);  
        Unlock_Display (Display);

        return Proc_Var_X_Display_Gc_Extension.To_Pv (Old_Proc);

    end X_E_Set_Free_Gc;

--\f

    function X_E_Set_Wire_To_Event (Display : X_Display;  
                                    Event   : X_Event_Code;  
                                    Proc    : Proc_Var_X_Wire_Event.Pv)  
                                   return Proc_Var_X_Wire_Event.Pv is
        -- Event routine to replace
        use Proc_Var_X_Wire_Event;  
        Old_Proc : X_Procedure_Variable;  
    begin

        Lock_Display (Display);  
        begin  
            Old_Proc := Display.Event_Vec (Event);  
            if Proc = Proc_Var_X_Wire_Event.None then  
                Display.Event_Vec (Event) := X_Lib_Default_X_Unknown_Wire_Event;  
            else  
                Display.Event_Vec (Event) :=  
                   Proc_Var_X_Wire_Event.From_Pv (Proc);  
            end if;  
        exception  
            when others =>  
                Unlock_Display (Display);  
                raise;  
        end;  
        Unlock_Display (Display);  
        return Proc_Var_X_Wire_Event.To_Pv (Old_Proc);

    end X_E_Set_Wire_To_Event;

--\f

    function X_E_Set_Event_To_Wire (Display : X_Display;  
                                    Event   : X_Event_Code;  
                                    Proc    : Proc_Var_X_Event_Wire.Pv)  
                                   return Proc_Var_X_Event_Wire.Pv is
        -- Event routine to replace
        use Proc_Var_X_Event_Wire;  
        Old_Proc : X_Procedure_Variable;  
    begin

        Lock_Display (Display);  
        begin  
            Old_Proc := Display.Wire_Vec (Event);  
            if Proc = Proc_Var_X_Event_Wire.None then  
                Display.Wire_Vec (Event) :=  
                   X_Lib_Default_X_Unknown_Native_Event;  
            else  
                Display.Wire_Vec (Event) :=  
                   Proc_Var_X_Event_Wire.From_Pv (Proc);  
            end if;  
        exception  
            when others =>  
                Unlock_Display (Display);  
                raise;  
        end;  
        Unlock_Display (Display);  
        return Proc_Var_X_Event_Wire.To_Pv (Old_Proc);

    end X_E_Set_Event_To_Wire;

--\f

    function X_E_Set_Error (Display   : X_Display;  
                            Extension : X_Extension_Number;  
                            Proc      : Proc_Var_X_Error_Extension.Pv)  
                           return Proc_Var_X_Error_Extension.Pv is
        -- routine to call when X error happens
        E        : X_Extension; -- for lookup of extension
        Old_Proc : X_Procedure_Variable;  
    begin

        E := Lookup_Extension (Display, Extension);  
        if E = null then  
            return Proc_Var_X_Error_Extension.None;  
        end if;

        Lock_Display (Display);  
        Old_Proc := E.Error;  
        E.Error  := Proc_Var_X_Error_Extension.From_Pv (Proc);  
        Unlock_Display (Display);

        return Proc_Var_X_Error_Extension.To_Pv (Old_Proc);

    end X_E_Set_Error;

--\f

    function X_E_Set_Error_String  
                (Display   : X_Display;  
                 Extension : X_Extension_Number;  
                 Proc      : Proc_Var_X_Error_String_Extension.Pv)  
                return Proc_Var_X_Error_String_Extension.Pv is
        -- routine to call when I/O error happens
        E        : X_Extension; -- for lookup of extension
        Old_Proc : X_Procedure_Variable;  
    begin

        E := Lookup_Extension (Display, Extension);  
        if E = null then  
            return Proc_Var_X_Error_String_Extension.None;  
        end if;

        Lock_Display (Display);  
        Old_Proc       := E.Error_String;  
        E.Error_String := Proc_Var_X_Error_String_Extension.From_Pv (Proc);  
        Unlock_Display (Display);

        return Proc_Var_X_Error_String_Extension.To_Pv (Old_Proc);

    end X_E_Set_Error_String;

--\f

    procedure X_Add_To_Extension_List (Structure : X_Display;  
                                       Ext_Data  : X_Ext_Data) is  
        P : X_Ext_Data := Structure.Ext_Data;  
    begin

        while P /= null loop  
            if P.Number = Ext_Data.Number then  
                P.Private_Data := Ext_Data.Private_Data;  
                P.Free_Private := Ext_Data.Free_Private;  
                return;  
            end if;  
            P := P.Next;  
        end loop;  
        P := new X_Ext_Data_Rec'((Ext_Data.Number, Ext_Data.Free_Private,  
                                  Ext_Data.Private_Data, Structure.Ext_Data));  
        Structure.Ext_Data := P;

    end X_Add_To_Extension_List;

--\f

    procedure X_Add_To_Extension_List (Structure : X_Font_Struct;  
                                       Ext_Data  : X_Ext_Data) is  
        P : X_Ext_Data := Structure.Ext_Data;  
    begin

        while P /= null loop  
            if P.Number = Ext_Data.Number then  
                P.Free_Private := Ext_Data.Free_Private;  
                P.Private_Data := Ext_Data.Private_Data;  
                return;  
            end if;  
            P := P.Next;  
        end loop;  
        P := new X_Ext_Data_Rec'((Ext_Data.Number, Ext_Data.Free_Private,  
                                  Ext_Data.Private_Data, Structure.Ext_Data));  
        Structure.Ext_Data := P;

    end X_Add_To_Extension_List;

--\f

    procedure X_Add_To_Extension_List (Structure : X_Gc;  
                                       Ext_Data  : X_Ext_Data) is  
        P : X_Ext_Data := Structure.Ext_Data;  
    begin

        while P /= null loop  
            if P.Number = Ext_Data.Number then  
                P.Private_Data := Ext_Data.Private_Data;  
                P.Free_Private := Ext_Data.Free_Private;  
                return;  
            end if;  
            P := P.Next;  
        end loop;  
        P := new X_Ext_Data_Rec'((Ext_Data.Number, Ext_Data.Free_Private,  
                                  Ext_Data.Private_Data, Structure.Ext_Data));  
        Structure.Ext_Data := P;

    end X_Add_To_Extension_List;

--\f

    procedure X_Add_To_Extension_List (Structure : X_Screen;  
                                       Ext_Data  : X_Ext_Data) is  
        P : X_Ext_Data := Structure.Ext_Data;  
    begin

        while P /= null loop  
            if P.Number = Ext_Data.Number then  
                P.Private_Data := Ext_Data.Private_Data;  
                P.Free_Private := Ext_Data.Free_Private;  
                return;  
            end if;  
            P := P.Next;  
        end loop;  
        P := new X_Ext_Data_Rec'((Ext_Data.Number, Ext_Data.Free_Private,  
                                  Ext_Data.Private_Data, Structure.Ext_Data));  
        Structure.Ext_Data := P;

    end X_Add_To_Extension_List;

--\f

    procedure X_Add_To_Extension_List (Structure : X_Screen_Format;  
                                       Ext_Data  : X_Ext_Data) is  
        P : X_Ext_Data := Structure.Ext_Data;  
    begin

        while P /= null loop  
            if P.Number = Ext_Data.Number then  
                P.Private_Data := Ext_Data.Private_Data;  
                P.Free_Private := Ext_Data.Free_Private;  
                return;  
            end if;  
            P := P.Next;  
        end loop;  
        P := new X_Ext_Data_Rec'((Ext_Data.Number, Ext_Data.Free_Private,  
                                  Ext_Data.Private_Data, Structure.Ext_Data));  
        Structure.Ext_Data := P;

    end X_Add_To_Extension_List;

--\f

    procedure X_Add_To_Extension_List (Structure : X_Visual;  
                                       Ext_Data  : X_Ext_Data) is  
        P : X_Ext_Data := Structure.Ext_Data;  
    begin

        while P /= null loop  
            if P.Number = Ext_Data.Number then  
                P.Private_Data := Ext_Data.Private_Data;  
                P.Free_Private := Ext_Data.Free_Private;  
                return;  
            end if;  
            P := P.Next;  
        end loop;  
        P := new X_Ext_Data_Rec'((Ext_Data.Number, Ext_Data.Free_Private,  
                                  Ext_Data.Private_Data, Structure.Ext_Data));  
        Structure.Ext_Data := P;

    end X_Add_To_Extension_List;

--\f

    function X_Find_On_Extension_List  
                (Structure : X_Display;  
                 Extension : X_Extension_Number) return X_Ext_Data is  
        P : X_Ext_Data := Structure.Ext_Data;  
    begin

        while P /= null loop  
            if P.Number = Extension then  
                return P;  
            end if;  
            P := P.Next;  
        end loop;  
        return None_X_Ext_Data;

    end X_Find_On_Extension_List;

--\f

    function X_Find_On_Extension_List  
                (Structure : X_Font_Struct;  
                 Extension : X_Extension_Number) return X_Ext_Data is  
        P : X_Ext_Data := Structure.Ext_Data;  
    begin

        while P /= null loop  
            if P.Number = Extension then  
                return P;  
            end if;  
            P := P.Next;  
        end loop;  
        return None_X_Ext_Data;

    end X_Find_On_Extension_List;

--\f

    function X_Find_On_Extension_List  
                (Structure : X_Gc;  
                 Extension : X_Extension_Number) return X_Ext_Data is  
        P : X_Ext_Data := Structure.Ext_Data;  
    begin

        while P /= null loop  
            if P.Number = Extension then  
                return P;  
            end if;  
            P := P.Next;  
        end loop;  
        return None_X_Ext_Data;

    end X_Find_On_Extension_List;

--\f

    function X_Find_On_Extension_List  
                (Structure : X_Screen;  
                 Extension : X_Extension_Number) return X_Ext_Data is  
        P : X_Ext_Data := Structure.Ext_Data;  
    begin

        while P /= null loop  
            if P.Number = Extension then  
                return P;  
            end if;  
            P := P.Next;  
        end loop;  
        return None_X_Ext_Data;

    end X_Find_On_Extension_List;

--\f

    function X_Find_On_Extension_List  
                (Structure : X_Screen_Format;  
                 Extension : X_Extension_Number) return X_Ext_Data is  
        P : X_Ext_Data := Structure.Ext_Data;  
    begin

        while P /= null loop  
            if P.Number = Extension then  
                return P;  
            end if;  
            P := P.Next;  
        end loop;  
        return None_X_Ext_Data;

    end X_Find_On_Extension_List;

--\f

    function X_Find_On_Extension_List  
                (Structure : X_Visual;  
                 Extension : X_Extension_Number) return X_Ext_Data is  
        P : X_Ext_Data := Structure.Ext_Data;  
    begin

        while P /= null loop  
            if P.Number = Extension then  
                return P;  
            end if;  
            P := P.Next;  
        end loop;  
        return None_X_Ext_Data;

    end X_Find_On_Extension_List;

--\f

    function X_Alloc_Id (Display : X_Display) return X_Id is
------------------------------------------------------------------------------
-- Request and allocate an X_Id for a new resource on a given display.
-- #define X_Alloc_ID(Display) ((*(Display)->resource_alloc)((Display)))
------------------------------------------------------------------------------
    begin

        return Proc_Var_X_Alloc_Id.Call  
                  (Proc_Var_X_Alloc_Id.To_Pv (Display.Resource_Alloc),  
                   Display);

    end X_Alloc_Id;

--\f

end Xlbp_Extension;