DataMuseum.dk

top - download

    Length: 7309 (0x1c8d)
    Types: TextFile
    Names: »B«

└─⟦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_Display2;  
use Xlbt_Display2;  
with Xlbt_Proc_Var;  
use Xlbt_Proc_Var;  
with Xlbt_Reply;  
use Xlbt_Reply;  
with Xlbt_Request;  
use Xlbt_Request;

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;  
with Xlbmt_Parameters;  
use Xlbmt_Parameters;

package body Xlbp_Sync is
------------------------------------------------------------------------------
-- X Library Synchronize
--
-- Xlbp_Sync - Error detection server synchronization.
------------------------------------------------------------------------------
-- 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.
------------------------------------------------------------------------------
-- ****************************************************************************
-- * Date      - /Name/ Comment
-- *
-- *  7-NOV-90 - /GEB/ Implement the new multitasking protection scheme for
-- *           -  library state.
-- ****************************************************************************

--\f

    procedure X_Sync (Display : X_Display;  
                      Discard : Boolean) is
------------------------------------------------------------------------------
-- Like X_Flush but in addition it waits until all events and errors resulting
-- from the flushed requests (or requests prior to the flushed events) have
-- returned from the server.  Discard tells us whether to discard all events
-- or not.  Error events are always passed to the X_Error routine.
------------------------------------------------------------------------------
        Reprec : X_Reply_Contents;  
        Void   : X_Status;  
    begin

----Lock the display.

        Lock_Display (Display);  
        begin

----Send the request.

            Put_X_Get_Input_Focus_Request  
               (Display, (Kind   => Get_Input_Focus,  
                          Length => X_Get_Input_Focus_Request'Size / 32,  
                          Pad    => 0));

----Get the reply (and ignore it).

            Get_Reply (Display => Display,  
                       Code    => Get_Input_Focus,  
                       Reply   => Reprec,  
                       Extra   => 0,  
                       Discard => True,  
                       Status  => Void);

----Discard all pending events (if requested).

            if Discard and then Display.Head /= null then  
                declare  
                    Ev : X_Queued_Event;  
                begin  
                    while Display.Head /= None_X_Queued_Event loop  
                        Ev           := Display.Head;  
                        Display.Head := Ev.Next;  
                        if Display.Q_Free_Len >= X_Max_Q_Free then  
                            Free_X_Queued_Event (Ev);  
                        else  
                            Ev.Next            := Display.Q_Free;  
                            Display.Q_Free     := Ev;  
                            Display.Q_Free_Len := Display.Q_Free_Len + 1;  
                        end if;  
                    end loop;  
                end;  
                Display.Head  := null;  
                Display.Tail  := null;  
                Display.Q_Len := 0;  
            end if;

----Catch unexpected exceptions and unlock the display before passing them on.

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

----Unlock the display and return.

        Unlock_Display (Display);

    end X_Sync;

--\f

    procedure Private_X_Sync_Function (Display : X_Display) is
------------------------------------------------------------------------------
-- Default X_Synchandler_Pv value for all displays.
------------------------------------------------------------------------------
    begin  
        X_Sync (Display, Discard => False);  
    end Private_X_Sync_Function;

    function Default_X_Sync_Function_Type is  
       new Proc_Var_X_Synchandler.Value (Private_X_Sync_Function);

--\f

    function X_Synchronize (Display : X_Display;  
                            Onoff   : Boolean)  
                           return Proc_Var_X_Synchandler.Pv is
------------------------------------------------------------------------------
--  Turns the usage of the X_Set_After_Function on and off.
------------------------------------------------------------------------------
        Temp : Proc_Var_X_Synchandler.Pv;  
    begin

----Lock the display against meddling.

        Lock_Display (Display);

----Make the swap.

        Temp := Proc_Var_X_Synchandler.To_Pv (Display.Synchandler);  
        if Onoff then  
            Display.Synchandler := X_Lib_Default_X_Sync_Function;  
        else  
            Display.Synchandler := None_X_Procedure_Variable;
            -- None_X_Synchandler_Type
        end if;

----Unlock the display and return our old value.

        Unlock_Display (Display);  
        return Temp;

    end X_Synchronize;

--\f

    function X_Set_After_Function (Display : X_Display;  
                                   Funct   : Proc_Var_X_Synchandler.Pv)  
                                  return Proc_Var_X_Synchandler.Pv is
------------------------------------------------------------------------------
-- Set the function that will be called after each and every server request
-- is queued.  The previous "after" function is returned.
------------------------------------------------------------------------------
        use Proc_Var_X_Synchandler;  
        Temp : Proc_Var_X_Synchandler.Pv;  
    begin

        Lock_Display (Display);  
        Temp := Proc_Var_X_Synchandler.To_Pv (Display.Synchandler);  
        Display.Synchandler := Proc_Var_X_Synchandler.From_Pv (Funct);  
        Unlock_Display (Display);  
        return Temp;

    end X_Set_After_Function;

--\f

begin

    X_Lib_Default_X_Sync_Function :=  
       Proc_Var_X_Synchandler.From_Pv (Default_X_Sync_Function_Type);

end Xlbp_Sync;