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

⟦7926d72e9⟧ TextFile

    Length: 13082 (0x331a)
    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_Basic;  
use Xlbt_Basic;  
with Xlbt_Host;  
use Xlbt_Host;  
with Xlbt_Misc;  
use Xlbt_Misc;  
with Xlbt_Reply;  
use Xlbt_Reply;  
with Xlbt_Request;  
use Xlbt_Request;  
with Xlbt_String;  
use Xlbt_String;

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

package body Xlbp_Host is
------------------------------------------------------------------------------
-- X Library Host Access Control
--
-- Xlbp_Host - Control access to the X server on a host-name basis.
------------------------------------------------------------------------------
-- 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_Add_Host (Display : X_Display;  
                          Host    : X_Host_Address) is
------------------------------------------------------------------------------
-- X_Add_Host
------------------------------------------------------------------------------
        Host_Address_String : constant X_String := Host.Address.all;  
        Host_Address_Length : S_Natural := Host_Address_String'Length;  
        Extra_Words : U_Short := U_Short (Host_Address_Length + 3) / 4 * 4;  
    begin

----Lock the display.

        Lock_Display (Display);  
        begin

----Send the request; the address string follows it.

            Put_X_Change_Hosts_Request  
               (Display, (Kind        => Change_Hosts,  
                          Length      => X_Change_Hosts_Request'Size / 32  
                                             + Extra_Words,  
                          Pad         => 0,  
                          Mode        => Host_Insert,  
                          Host_Family => Host.Family,  
                          Host_Length => U_Short (Host_Address_Length)),  
                Host_Address_Length);  
            Put_X_String (Display, Host_Address_String);

----Catch unexpected exceptions.

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

----Unlock the display and sync up.

        Unlock_Display (Display);  
        Sync_Handle (Display);

    end X_Add_Host;

--\f

    procedure X_Add_Hosts (Display : X_Display;  
                           Hosts   : X_Host_Address_Array) is
------------------------------------------------------------------------------
-- Add each of the hosts is a list of hosts.
------------------------------------------------------------------------------
    begin

        for I in Hosts'Range loop  
            X_Add_Host (Display, Hosts (I));  
        end loop;

    end X_Add_Hosts;

--\f

    function X_List_Hosts (Display : X_Display) return X_Host_List is
------------------------------------------------------------------------------
-- Obtain a list of valid hosts from the server.
------------------------------------------------------------------------------
        Reply : X_Reply_Contents;  
        Host  : X_Wire_Host_Reply;  
        Succ  : X_Status;  
    begin

----Lock the display.

        Lock_Display (Display);  
        begin

----Send the request for a list of hosts.

            Put_X_List_Hosts_Request  
               (Display, (Kind   => List_Hosts,  
                          Length => X_List_Hosts_Request'Size / 32,  
                          Pad    => 0));

----Get the reply header.

            Get_Reply (Display => Display,  
                       Code    => List_Hosts,  
                       Reply   => Reply,  
                       Extra   => 0,  
                       Discard => False,  
                       Status  => Succ);

----If we failed to get a reply then return as if there were no hosts.

            if Succ = Failed then  
                Unlock_Display (Display);  
                Sync_Handle (Display);  
                return None_X_Host_List;  
            end if;

----If we succeeded but there are no hosts then return an empty list.

            if Reply.List_Hosts.N_Hosts = 0 then  
                Unlock_Display (Display);  
                Sync_Handle (Display);  
                return None_X_Host_List;  
            end if;

----Allocate a new array to hold the info.

            declare  
                Outbuf : X_Host_List;  
            begin  
                Outbuf.Enabled := To_Boolean (Reply.List_Hosts.Enabled);

----Read each of the host addresses.

                Outbuf.List := new X_Host_Address_Array  
                                      (1 .. S_Natural  
                                               (Reply.List_Hosts.N_Hosts));  
                for Op in 1 .. S_Natural (Reply.List_Hosts.N_Hosts) loop  
                    Get_X_Wire_Host_Reply (Display, Host);  
                    Outbuf.List (Op) :=  
                       (Family  => Host.Family,  
                        Address => new X_String  
                                          (1 .. S_Natural (Host.Name_Length)));  
                    Get_X_String (Display, Outbuf.List (Op).Address.all);  
                end loop;  
                Unlock_Display (Display);  
                Sync_Handle (Display);  
                return Outbuf;  
            exception  
                when others =>  
                    Free_X_Host_List (Outbuf);  
                    raise;  
            end;

----Catch unexpected exceptions before passing them on.

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

    end X_List_Hosts;

--\f

    procedure X_Remove_Host (Display : X_Display;  
                             Host    : X_Host_Address) is
------------------------------------------------------------------------------
-- X_Remove_Host
------------------------------------------------------------------------------
        Host_Address_String : constant X_String := Host.Address.all;  
        Host_Address_Length : S_Natural := Host_Address_String'Length;  
        Extra_Words : U_Short := U_Short (Host_Address_Length + 3) / 4 * 4;  
    begin

----Lock the display.

        Lock_Display (Display);  
        begin

----Send the request; the address follows it.

            Put_X_Change_Hosts_Request  
               (Display, (Kind        => Change_Hosts,  
                          Length      => X_Change_Hosts_Request'Size / 32  
                                             + Extra_Words,  
                          Pad         => 0,  
                          Mode        => Host_Delete,  
                          Host_Family => Host.Family,  
                          Host_Length => U_Short (Host_Address_Length)),  
                Host_Address_Length);  
            Put_X_String (Display, Host_Address_String);

----Catch unexpected exceptions.

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

----Unlock the display and sync up.

        Unlock_Display (Display);  
        Sync_Handle (Display);

    end X_Remove_Host;

--\f

    procedure X_Remove_Hosts (Display : X_Display;  
                              Hosts   : X_Host_Address_Array) is
------------------------------------------------------------------------------
-- Remove each of the hosts is a list of hosts.
------------------------------------------------------------------------------
    begin

        for I in Hosts'Range loop  
            X_Remove_Host (Display, Hosts (I));  
        end loop;

    end X_Remove_Hosts;

--\f

    procedure X_Disable_Access_Control (Display : X_Display) is  
    begin  
        X_Set_Access_Control (Display, Disable_Access);  
    end X_Disable_Access_Control;

--\f

    procedure X_Enable_Access_Control (Display : X_Display) is  
    begin  
        X_Set_Access_Control (Display, Enable_Access);  
    end X_Enable_Access_Control;

--\f

    procedure X_Set_Access_Control (Display : X_Display;  
                                    Mode    : X_Change_Access) is  
    begin

----Lock up the display.

        Lock_Display (Display);  
        begin

----Send the request.

            Put_X_Set_Access_Control_Request  
               (Display, (Kind   => Set_Access_Control,  
                          Length => X_Set_Access_Control_Request'Size / 32,  
                          Mode   => Mode));

----Catch unexpected exceptions.

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

----Unlock the display and call the Synchandler.

        Unlock_Display (Display);  
        Sync_Handle (Display);

    end X_Set_Access_Control;

--\f

    procedure X_Kill_Client (Display  : X_Display;  
                             Resource : X_Id) is
------------------------------------------------------------------------------
-- X_Kill_Client
------------------------------------------------------------------------------
    begin

----Lock the display.

        Lock_Display (Display);  
        begin

----Send the request.

            Put_X_Kill_Client_Request  
               (Display, (Kind   => Kill_Client,  
                          Length => X_Kill_Client_Request'Size / 32,  
                          Pad    => 0,  
                          Id     => Resource));

----Catch unexpected exceptions.

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

----Unlock the display; sync up; and return.

        Unlock_Display (Display);  
        Sync_Handle (Display);

    end X_Kill_Client;

--\f

    procedure X_Set_Close_Down_Mode (Display : X_Display;  
                                     Mode    : X_Close_Down_Mode) is
------------------------------------------------------------------------------
-- X_Set_Close_Down_Mode
------------------------------------------------------------------------------
    begin

----Lock the display.

        Lock_Display (Display);  
        begin

----Send the request.

            Put_X_Set_Close_Down_Mode_Request  
               (Display, (Kind   => Set_Close_Down_Mode,  
                          Length => X_Set_Close_Down_Mode_Request'Size / 32,  
                          Mode   => Mode));

----Catch unexpected exceptions.

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

----Unlock; sync up; and return.

        Unlock_Display (Display);  
        Sync_Handle (Display);

    end X_Set_Close_Down_Mode;

--\f

    procedure X_Add_To_Save_Set (Display : X_Display;  
                                 Window  : X_Window) is  
    begin  
        X_Change_Save_Set (Display, Window, Set_Mode_Insert);  
    end X_Add_To_Save_Set;

--\f

    procedure X_Change_Save_Set (Display : X_Display;  
                                 Window  : X_Window;  
                                 Mode    : X_Change_Save_Set_Mode) is  
    begin

----Lock the display.

        Lock_Display (Display);  
        begin

            Put_X_Change_Save_Set_Request  
               (Display, (Kind   => Change_Save_Set,  
                          Length => X_Change_Save_Set_Request'Size / 32,  
                          Mode   => Mode,  
                          Window => Window));

----Catch unexpected exceptions.

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

----Unlock the display; sync up; and return.

        Unlock_Display (Display);  
        Sync_Handle (Display);

    end X_Change_Save_Set;

--\f

    procedure X_Remove_From_Save_Set (Display : X_Display;  
                                      Window  : X_Window) is  
    begin  
        X_Change_Save_Set (Display, Window, Set_Mode_Delete);  
    end X_Remove_From_Save_Set;

--\f

end Xlbp_Host;