|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 56320 (0xdc00)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Xlbp_Event, seg_004f5b
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Xlbt_Arithmetic;
use Xlbt_Arithmetic;
with Xlbt_Basic;
use Xlbt_Basic;
with Xlbt_Display2;
use Xlbt_Display2;
with Xlbt_Event;
use Xlbt_Event;
with Xlbt_Misc;
use Xlbt_Misc;
with Xlbt_Proc_Var;
use Xlbt_Proc_Var;
with Xlbt_Request;
use Xlbt_Request;
with Xlbt_Window;
use Xlbt_Window;
with Xlbp_Proc_Var;
use Xlbp_Proc_Var;
with Xlbit_Library4;
use Xlbit_Library4;
with Xlbip_Default_Proc_Vars;
use Xlbip_Default_Proc_Vars;
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;
with Xlbmp_Internal;
use Xlbmp_Internal;
package body Xlbp_Event is
------------------------------------------------------------------------------
-- X Library Event Handling
--
-- Xlbp_Event - Routines for reading, writing, and handling X events.
------------------------------------------------------------------------------
-- 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.
------------------------------------------------------------------------------
--\x0c
procedure X_Flush (Display : X_Display) is
------------------------------------------------------------------------------
-- Force any buffered server requests to be transmitted immediately.
------------------------------------------------------------------------------
begin
Lock_Display (Display);
Internal_X_Flush_Display (Display);
Unlock_Display (Display);
end X_Flush;
--\x0c
procedure X_Put_Back_Event (Display : X_Display;
Event : X_Event) is
Qelt : X_Queued_Event;
begin
----Lock the display.
Lock_Display (Display);
begin
----Get a new event record.
Qelt := Display.Q_Free;
if Qelt = None_X_Queued_Event then
Qelt := new X_Queued_Event_Rec;
else
Display.Q_Free := Qelt.Next;
end if;
----Put the new event onto the queue of events.
Qelt.Next := Display.Head;
Qelt.Event := Event;
Display.Head := Qelt;
if Display.Tail = null then
Display.Tail := Qelt;
end if;
Display.Q_Len := Display.Q_Len + 1;
----Catch exceptions.
exception
when others =>
Unlock_Display (Display);
raise;
end;
----Unlock; sync; return.
Unlock_Display (Display);
end X_Put_Back_Event;
--\x0c
procedure X_Select_Input (Display : X_Display;
Window : X_Window;
Event_Mask : X_Event_Mask) is
begin
----Lock the display.
Lock_Display (Display);
begin
----Send the request.
Put_X_Change_Window_Attributes_Request
(Display,
(Kind => Change_Window_Attributes,
Length => X_Change_Window_Attributes_Request'Size / 32 + 1,
Pad => 0,
Window => Window,
Value_Mask => (Cw_Event_Mask => True, others => False)),
4);
Put_X_Event_Mask (Display, Event_Mask);
----Catch exceptions.
exception
when others =>
Unlock_Display (Display);
raise;
end;
----Unlock; sync; return.
Unlock_Display (Display);
Sync_Handle (Display);
end X_Select_Input;
--\x0c
procedure X_Send_Event (Display : X_Display;
Window : X_Window;
Propagate : Boolean;
Event_Mask : X_Event_Mask;
Event : X_Event;
Status : out X_Status) is
------------------------------------------------------------------------------
-- In order to avoid all images requiring private_X_Event_To_Wire, we install the
-- Event converter here if it has never been installed.
------------------------------------------------------------------------------
Ev : X_Raw_Data_Array (1 .. 32);
Fp : X_Procedure_Variable;
Succ : X_Status;
begin
----Lock the display.
Lock_Display (Display);
begin
-- call through disp to find proper conversion routine
Fp := Display.Wire_Vec (Event.Kind);
if Fp = None_X_Procedure_Variable then
Fp := X_Lib_Default_X_Event_To_Wire;
Display.Wire_Vec (Event.Kind) := Fp;
end if;
Proc_Var_X_Event_Wire.Call
(Proc_Var_X_Event_Wire.To_Pv (Fp), Display, Event, Ev, Succ);
if Succ = Failed then
Status := Failed;
else
Status := Successful;
Put_X_Send_Event_Request
(Display, (Kind => Send_Event,
Length => X_Send_Event_Request'Size / 32,
Destination => Window,
Propagate => From_Boolean (Propagate),
Event_Mask => Event_Mask,
Event => Ev));
end if;
----Catch exceptions.
exception
when others =>
Unlock_Display (Display);
raise;
end;
----Unlock; sync; return.
Unlock_Display (Display);
Sync_Handle (Display);
end X_Send_Event;
--\x0c
function X_Events_Queued (Display : X_Display;
Mode : X_Event_Queuing) return S_Long is
Ret_Val : S_Long;
begin
Lock_Display (Display);
begin
if Display.Q_Len > 0 or else Mode = Queued_Already then
Ret_Val := Display.Q_Len;
else
Ret_Val := Internal_X_Events_Queued (Display, Mode);
end if;
exception
when others =>
Unlock_Display (Display);
raise;
end;
Unlock_Display (Display);
return Ret_Val;
end X_Events_Queued;
--\x0c
function X_Pending (Display : X_Display) return S_Long is
Ret_Val : S_Long;
begin
Lock_Display (Display);
begin
if Display.Q_Len > 0 then
Ret_Val := Display.Q_Len;
else
Ret_Val := Internal_X_Events_Queued
(Display, Queued_After_Flush);
end if;
exception
when others =>
Unlock_Display (Display);
raise;
end;
Unlock_Display (Display);
return Ret_Val;
end X_Pending;
--\x0c
procedure X_Check_If_Event (Display : X_Display;
Event : in out X_Event;
Args : in out Predicate_Argument_Type;
Status : out X_Status) is
------------------------------------------------------------------------------
-- Check existing events in queue to see if any match. Return the first match
-- found. If no match is found then flush output buffer and return the next
-- event in the queue matching the predicate. Return whether such an event was
-- found. Events earlier in the queue are not discarded.
------------------------------------------------------------------------------
Prev : X_Queued_Event;
Qelt : X_Queued_Event;
Void : S_Long;
Succ : X_Status;
begin
----Lock the display; catch any exceptions.
Lock_Display (Display);
begin
----The first time through we start at the head of the event list for the
-- display. Run down the full list until we reach the end or until we find
-- a match.
Prev := null;
Qelt := Display.Head;
for N in reverse 0 .. 2 loop
while Qelt /= null loop
----Check for and return any matches.
Predicate (Display, Qelt.Event, Args, Succ);
if Succ = Successful then
Event := Qelt.Event; -- Return the match
if Prev /= null then -- Unlink the match
Prev.Next := Qelt.Next;
if Prev.Next = null then
Display.Tail := Prev;
end if;
else
Display.Head := Qelt.Next;
if Display.Head = null then
Display.Tail := null;
end if;
end if;
if Display.Q_Free_Len >= X_Max_Q_Free then
Free_X_Queued_Event (Qelt);
else
Qelt.Next := Display.Q_Free;
Display.Q_Free := Qelt;
Display.Q_Free_Len := Display.Q_Free_Len + 1;
end if;
Display.Q_Len := Display.Q_Len - 1;
Unlock_Display (Display);
Status := Successful;
return;
end if;
----Loop for next event.
Prev := Qelt;
Qelt := Prev.Next;
end loop;
----No existing events match. If this is the first or second time then try to
-- get more events. If not then exit and return failure.
if N = 0 then
exit;
elsif N = 1 then
Internal_X_Flush_Display (Display);
elsif N = 2 then
Void := Internal_X_Events_Queued
(Display, Queued_After_Reading);
end if;
if Prev = null then-- Start at head of new events.
Qelt := Display.Head;
else
Qelt := Prev.Next;
end if;
end loop;
----Catch exceptions.
exception
when others =>
Unlock_Display (Display);
raise;
end;
----Unlock; sync; return.
Status := Failed;
Unlock_Display (Display);
end X_Check_If_Event;
--\x0c
procedure X_Check_Mask_Event (Display : X_Display;
Event_Mask : X_Event_Mask;
Event : in out X_Event;
Status : out X_Status) is
------------------------------------------------------------------------------
-- Check existing events in queue to find any that match the Event_mask. Return the
-- first one that matches. If none match then flush output buffer and attempt
-- to read new events. If one of these matches then return it. If this fails
-- then return that status to the caller.
------------------------------------------------------------------------------
Prev : X_Queued_Event;
Qelt : X_Queued_Event;
Void : S_Long;
begin
----Lock the display.
Lock_Display (Display);
begin
----The first time through the loop we start with the existing event queue.
Prev := null;
Qelt := Display.Head;
for N in reverse 0 .. 2 loop
while Qelt /= null loop
----If this event matches the event Event_mask then return it.
if (X_Event_To_Mask (Qelt.Event.Kind) and Event_Mask) /=
None_X_Event_Mask
and then
(Qelt.Event.Kind /= Motion_Notify
or else
(Event_Mask and All_Pointers) /= None_X_Event_Mask
or else
(Event_Mask and All_Buttons) /= None_X_Event_Mask) then Event := Qelt.Event; -- Return event
if Prev /= null then -- Unlink event
Prev.Next := Qelt.Next;
if Prev.Next = null then
Display.Tail := Prev;
end if;
else
Display.Head := Qelt.Next;
if Display.Head = null then
Display.Tail := null;
end if;
end if;
if Display.Q_Free_Len >= X_Max_Q_Free then
Free_X_Queued_Event (Qelt);
else
Qelt.Next := Display.Q_Free;
Display.Q_Free := Qelt;
Display.Q_Free_Len := Display.Q_Free_Len + 1;
end if;
Display.Q_Len := Display.Q_Len - 1;
Status := Successful;
Unlock_Display (Display);
return;
end if;
----Loop for next event on list.
Prev := Qelt;
Qelt := Qelt.Next;
end loop;
----No existing events match. If this is the first or second time then try to
-- get more events. If not then exit and return failure.
if N = 0 then
exit;
elsif N = 1 then
Internal_X_Flush_Display (Display);
elsif N = 2 then
Void := Internal_X_Events_Queued
(Display, Queued_After_Reading);
end if;
if Prev = null then -- Start search where we left off.
Qelt := Display.Head;
else
Qelt := Prev.Next;
end if;
end loop;
----Catch exceptions.
exception
when others =>
Unlock_Display (Display);
raise;
end;
----Unlock; sync; return.
Status := Failed;
Unlock_Display (Display);
end X_Check_Mask_Event;
--\x0c
procedure X_Check_Typed_Event (Display : X_Display;
Kind : X_Event_Code;
Event : in out X_Event;
Status : out X_Status) is
------------------------------------------------------------------------------
-- Check existing events in queue to find any that match the type. Return the
-- first one that matches. If none match then flush the output queue and
-- attempt to read some more events. If one matches then return it. Otherwise
-- return failure to the caller.
------------------------------------------------------------------------------
Prev : X_Queued_Event;
Qelt : X_Queued_Event;
Void : S_Long;
begin
----Lock the display.
Lock_Display (Display);
begin
----The first time through the loop we start at the head of the existing list.
Prev := null;
Qelt := Display.Head;
for N in reverse 0 .. 2 loop
while Qelt /= null loop
----If this event is the right type then return it.
if Qelt.Event.Kind = Kind then
Event := Qelt.Event; -- Return event
if Prev /= null then -- Unlink event
Prev.Next := Qelt.Next;
if Prev.Next = null then
Display.Tail := Prev;
end if;
else
Display.Head := Qelt.Next;
if Display.Head = null then
Display.Tail := null;
end if;
end if;
if Display.Q_Free_Len >= X_Max_Q_Free then
Free_X_Queued_Event (Qelt);
else
Qelt.Next := Display.Q_Free;
Display.Q_Free := Qelt;
Display.Q_Free_Len := Display.Q_Free_Len + 1;
end if;
Display.Q_Len := Display.Q_Len - 1;
Status := Successful;
Unlock_Display (Display);
return;
end if;
----Loop for the next event.
Prev := Qelt;
Qelt := Qelt.Next;
end loop;
----No existing events match. If this is the first or second time then try to
-- get more events. If not then exit and return failure.
if N = 0 then
Status := Failed;
exit;
elsif N = 1 then
Internal_X_Flush_Display (Display);
elsif N = 2 then
Void := Internal_X_Events_Queued
(Display, Queued_After_Reading);
end if;
if Prev = null then -- Start search where we left off.
Qelt := Display.Head;
else
Qelt := Prev.Next;
end if;
end loop;
----Catch exceptions.
exception
when others =>
Unlock_Display (Display);
raise;
end;
----Unlock; sync; return.
Unlock_Display (Display);
end X_Check_Typed_Event;
--\x0c
procedure X_Check_Typed_Window_Event
(Display : X_Display;
Window : X_Window;
Kind : X_Event_Code;
Event : in out X_Event;
Status : out X_Status) is
------------------------------------------------------------------------------
-- Run through the event queue looking for an event that matches the type
-- and window. Return the first one found. If none are found then
-- flush the output buffer and try reading some more events. If that does
-- not produce and event that matches then return failure.
------------------------------------------------------------------------------
Prev : X_Queued_Event;
Qelt : X_Queued_Event;
Void : S_Long;
begin
----Lock the display.
Lock_Display (Display);
begin
----The first time we go through the loop we start at the head of the list.
Prev := null;
Qelt := Display.Head;
for N in reverse 0 .. 2 loop
while Qelt /= null loop
----If this event has the right type and window then return it.
if Qelt.Event.Kind = Kind and then
Qelt.Event.Window = Window then
Event := Qelt.Event; -- Return event
if Prev /= null then -- Unlink event
Prev.Next := Qelt.Next;
if Prev.Next = null then
Display.Tail := Prev;
end if;
else
Display.Head := Qelt.Next;
if Display.Head = null then
Display.Tail := null;
end if;
end if;
if Display.Q_Free_Len >= X_Max_Q_Free then
Free_X_Queued_Event (Qelt);
else
Qelt.Next := Display.Q_Free;
Display.Q_Free := Qelt;
Display.Q_Free_Len := Display.Q_Free_Len + 1;
end if;
Display.Q_Len := Display.Q_Len - 1;
Status := Successful;
Unlock_Display (Display);
return;
end if;
----Loop for the next event.
Prev := Qelt;
Qelt := Qelt.Next;
end loop;
----No existing events match. If this is the first or second time then try to
-- get more events. If not then exit and return failure.
if N = 0 then
Status := Failed;
exit;
elsif N = 1 then
Internal_X_Flush_Display (Display);
elsif N = 2 then
Void := Internal_X_Events_Queued
(Display, Queued_After_Reading);
end if;
if Prev = null then -- Start search where we left off.
Qelt := Display.Head;
else
Qelt := Prev.Next;
end if;
end loop;
----Catch exceptions.
exception
when others =>
Unlock_Display (Display);
raise;
end;
----Unlock; sync; return.
Unlock_Display (Display);
end X_Check_Typed_Window_Event;
--\x0c
procedure X_Check_Window_Event (Display : X_Display;
Window : X_Window;
Event_Mask : X_Event_Mask;
Event : in out X_Event;
Status : out X_Status) is
------------------------------------------------------------------------------
-- Run through the event queue looking for an event that matches the event
-- Event_mask and window. Return the first one found. If none are found then
-- flush the output buffer and try reading some more events. If that does
-- not produce and event that matches then return failure.
------------------------------------------------------------------------------
Prev : X_Queued_Event;
Qelt : X_Queued_Event;
Void : S_Long;
begin
----Lock the display.
Lock_Display (Display);
begin
----The first time through the loop we start at the head of the event queue.
Prev := null;
Qelt := Display.Head;
for N in reverse 0 .. 2 loop
while Qelt /= null loop
----If this event matches the event Event_mask and has the right window then return.
if Qelt.Event.Window /= Window and then
(X_Event_To_Mask (Qelt.Event.Kind) and Event_Mask) /=
None_X_Event_Mask
and then
(Qelt.Event.Kind /= Motion_Notify
or else
(Event_Mask and All_Pointers) /= None_X_Event_Mask
or else
(Event_Mask and All_Buttons) /= None_X_Event_Mask) then
Event := Qelt.Event;
if Prev /= null then
Prev.Next := Qelt.Next;
if Prev.Next = null then
Display.Tail := Prev;
end if;
else
Display.Head := Qelt.Next;
if Display.Head = null then
Display.Tail := null;
end if;
end if;
if Display.Q_Free_Len >= X_Max_Q_Free then
Free_X_Queued_Event (Qelt);
else
Qelt.Next := Display.Q_Free;
Display.Q_Free := Qelt;
Display.Q_Free_Len := Display.Q_Free_Len + 1;
end if;
Display.Q_Len := Display.Q_Len - 1;
Status := Successful;
Unlock_Display (Display);
return;
end if;
----Loop for the next event.
Prev := Qelt;
Qelt := Qelt.Next;
end loop;
----No existing events match. If this is the first or second time then try to
-- get more events. If not then exit and return failure.
if N = 0 then
Status := Failed;
exit;
elsif N = 1 then
Internal_X_Flush_Display (Display);
elsif N = 2 then
Void := Internal_X_Events_Queued
(Display, Queued_After_Reading);
end if;
if Prev = null then -- Start search where we left off.
Qelt := Display.Head;
else
Qelt := Prev.Next;
end if;
end loop;
----Catch exceptions.
exception
when others =>
Unlock_Display (Display);
raise; end;
----Unlock; sync; return.
Unlock_Display (Display);
end X_Check_Window_Event;
--\x0c
procedure X_If_Event (Display : X_Display;
Event : out X_Event;
Args : in out Predicate_Argument_Type) is
------------------------------------------------------------------------------
-- Flush output and (wait for and) return the next Event matching the
-- predicate in the queue.
------------------------------------------------------------------------------
Qelt : X_Queued_Event;
Prev : X_Queued_Event;
Succ : X_Status;
begin
----Lock the display.
Lock_Display (Display);
begin
----First must search queue to find if any events match. If so, then remove
-- from queue.
Prev := null;
Qelt := Display.Head;
loop
while Qelt /= null loop
Predicate (Display, Qelt.Event, Args, Succ);
if Succ = Successful then
Event := Qelt.Event;
if Prev /= null then
Prev.Next := Qelt.Next;
if Qelt.Next = null then
Display.Tail := Prev;
end if;
else
Display.Head := Qelt.Next;
if Qelt.Next = null then
Display.Tail := null;
end if;
end if;
if Display.Q_Free_Len >= X_Max_Q_Free then
Free_X_Queued_Event (Qelt);
else
Qelt.Next := Display.Q_Free;
Display.Q_Free := Qelt;
Display.Q_Free_Len := Display.Q_Free_Len + 1;
end if;
Display.Q_Len := Display.Q_Len - 1;
Unlock_Display (Display);
return;
end if;
Prev := Qelt;
Qelt := Qelt.Next;
end loop;
----If the queue is empty, read as many events as possible and enqueue them.
Internal_X_Read_Events (Display);
if Prev = null then
Qelt := Display.Head;
elsif Prev.Next /= null then
Qelt := Prev.Next;
end if;
end loop;
----Catch exceptions.
exception
when others =>
Unlock_Display (Display);
raise;
end;
end X_If_Event;
--\x0c
procedure X_Mask_Event (Display : X_Display;
Event_Mask : X_Event_Mask;
Event : out X_Event) is
------------------------------------------------------------------------------
-- Flush output and (wait for and) return the next Event in the queue
-- matching one of the events in the Event_mask.
-- Events earlier in the queue are not discarded.
------------------------------------------------------------------------------
Prev : X_Queued_Event;
Qelt : X_Queued_Event;
begin
----Lock the display.
Lock_Display (Display);
begin
Prev := null;
Qelt := Display.Head;
loop
while Qelt /= null loop
if (X_Event_To_Mask (Qelt.Event.Kind) and Event_Mask) /=
None_X_Event_Mask
and then
(Qelt.Event.Kind /= Motion_Notify
or else
(Event_Mask and All_Pointers) /= None_X_Event_Mask
or else
(Event_Mask and All_Pointers) /= None_X_Event_Mask) then
Event := Qelt.Event;
if Prev /= null then
Prev.Next := Qelt.Next;
if Prev.Next = null then
Display.Tail := Prev;
end if;
else
Display.Head := Qelt.Next;
if Display.Head = null then
Display.Tail := null;
end if;
end if;
if Display.Q_Free_Len >= X_Max_Q_Free then
Free_X_Queued_Event (Qelt);
else
Qelt.Next := Display.Q_Free;
Display.Q_Free := Qelt;
Display.Q_Free_Len := Display.Q_Free_Len + 1;
end if;
Display.Q_Len := Display.Q_Len - 1;
Unlock_Display (Display);
return;
end if;
Prev := Qelt;
Qelt := Qelt.Next;
end loop;
----If the queue is empty, read as many events as possible and enqueue them.
Internal_X_Read_Events (Display);
if Prev = null then
Qelt := Display.Head;
elsif Prev.Next /= null then
Qelt := Prev.Next;
end if;
end loop;
----Catch exceptions.
exception
when others =>
Unlock_Display (Display);
raise;
end;
end X_Mask_Event;
--\x0c
procedure X_Next_Event (Display : X_Display;
Event : out X_Event) is
------------------------------------------------------------------------------
-- Return the next event in the queue. If there are none then read at least
-- one and return the first one.
------------------------------------------------------------------------------
Qelt : X_Queued_Event;
begin
----Lock the display.
Lock_Display (Display);
begin
----If the queue is empty, read as many events as possible and enqueue them.
if Display.Head = null then
Internal_X_Read_Events (Display);
end if;
Qelt := Display.Head;
Event := Qelt.Event;
----Move the head of the queue to the free list.
Display.Head := Qelt.Next;
if Display.Head = null then
Display.Tail := null;
end if;
if Display.Q_Free_Len >= X_Max_Q_Free then
Free_X_Queued_Event (Qelt);
else
Qelt.Next := Display.Q_Free;
Display.Q_Free := Qelt;
Display.Q_Free_Len := Display.Q_Free_Len + 1;
end if;
Display.Q_Len := Display.Q_Len - 1;
----Catch exceptions.
exception
when others =>
Unlock_Display (Display);
raise;
end;
----Unlock; sync; return.
Unlock_Display (Display);
end X_Next_Event;
--\x0c
procedure X_Peek_Event (Display : X_Display;
Event : out X_Event) is
------------------------------------------------------------------------------
-- Return the next event in the queue but do not remove it from the queue.
-- If the queue is empty then flush the output buffer and wait for an event- to arrive.
------------------------------------------------------------------------------
begin
----Lock the display.
Lock_Display (Display);
begin
if Display.Head = null then
Internal_X_Read_Events (Display);
end if;
Event := Display.Head.Event;
----Catch exceptions.
exception
when others =>
Unlock_Display (Display);
raise;
end;
Unlock_Display (Display);
end X_Peek_Event;
--\x0c
procedure X_Peek_If_Event (Display : X_Display;
Event : out X_Event;
Args : in out Predicate_Argument_Type) is
------------------------------------------------------------------------------
-- Flush output and (wait for and) return the next Event in the queue
-- that satisfies the predicate.
-- BUT do not remove it from the queue.
------------------------------------------------------------------------------
Qelt : X_Queued_Event;
Succ : X_Status;
begin
----Lock the display.
Lock_Display (Display);
begin
if Display.Head = null then
Internal_X_Read_Events (Display);
end if;
Predicate (Display, Display.Head.Event, Args, Succ);
if Succ = Successful then
Event := Display.Head.Event;
else
Qelt := Display.Head;
loop
while Qelt.Next /= null loop
Predicate (Display, Qelt.Next.Event, Args, Succ);
if Succ = Successful then
Event := Qelt.Next.Event;
Unlock_Display (Display);
return;
end if;
Qelt := Qelt.Next;
end loop;
Internal_X_Read_Events (Display);
end loop;
end if;
----Catch exceptions.
exception
when others =>
Unlock_Display (Display);
raise;
end;
Unlock_Display (Display);
end X_Peek_If_Event;
--\x0c
procedure X_Window_Event (Display : X_Display;
Window : X_Window; -- Selected window
Event_Mask : X_Event_Mask; -- Selected events
Event : out X_Event) is
------------------------------------------------------------------------------
-- Flush output and (wait for and) return the next Event in the queue
-- for the given window matching one of the events in the mask.
-- Events earlier in the queue are not discarded.
------------------------------------------------------------------------------
Prev : X_Queued_Event;
Qelt : X_Queued_Event;
begin
----Lock the display.
Lock_Display (Display);
begin
Prev := null;
Qelt := Display.Head;
loop
while Qelt /= null loop
if Qelt.Event.Window = Window and then
(X_Event_To_Mask (Qelt.Event.Kind) and Event_Mask) /=
None_X_Event_Mask
and then
(Qelt.Event.Kind /= Motion_Notify
or else
(Event_Mask and All_Pointers) /= None_X_Event_Mask
or else
(Event_Mask and All_Buttons) /= None_X_Event_Mask) then
Event := Qelt.Event;
if Prev /= null then
Prev.Next := Qelt.Next;
if Prev.Next = null then
Display.Tail := Prev;
end if;
else
Display.Head := Qelt.Next;
if Display.Head = null then
Display.Tail := null;
end if;
end if;
if Display.Q_Free_Len >= X_Max_Q_Free then
Free_X_Queued_Event (Qelt);
else
Qelt.Next := Display.Q_Free;
Display.Q_Free := Qelt;
Display.Q_Free_Len := Display.Q_Free_Len + 1;
end if;
Display.Q_Len := Display.Q_Len - 1;
Unlock_Display (Display);
return;
end if;
Prev := Qelt;
Qelt := Qelt.Next;
end loop;
Internal_X_Read_Events (Display);
if Prev = null then
Qelt := Display.Head;
else
Qelt := Prev.Next;
end if;
end loop;
----Catch exceptions.
exception
when others =>
Unlock_Display (Display);
raise;
end;
end X_Window_Event;
end Xlbp_Event;
nblk1=36
nid=0
hdr6=6c
[0x00] rec0=2d rec1=00 rec2=01 rec3=012
[0x01] rec0=11 rec1=00 rec2=02 rec3=030
[0x02] rec0=1a rec1=00 rec2=03 rec3=01a
[0x03] rec0=26 rec1=00 rec2=04 rec3=016
[0x04] rec0=00 rec1=00 rec2=36 rec3=00a
[0x05] rec0=25 rec1=00 rec2=05 rec3=008
[0x06] rec0=17 rec1=00 rec2=06 rec3=032
[0x07] rec0=00 rec1=00 rec2=35 rec3=008
[0x08] rec0=1b rec1=00 rec2=07 rec3=01a
[0x09] rec0=25 rec1=00 rec2=08 rec3=01a
[0x0a] rec0=18 rec1=00 rec2=09 rec3=036
[0x0b] rec0=1c rec1=00 rec2=0a rec3=00e
[0x0c] rec0=12 rec1=00 rec2=0b rec3=068
[0x0d] rec0=01 rec1=00 rec2=34 rec3=002
[0x0e] rec0=1a rec1=00 rec2=0c rec3=030
[0x0f] rec0=1c rec1=00 rec2=0d rec3=036
[0x10] rec0=1c rec1=00 rec2=0e rec3=002
[0x11] rec0=11 rec1=00 rec2=0f rec3=096
[0x12] rec0=01 rec1=00 rec2=33 rec3=018
[0x13] rec0=19 rec1=00 rec2=10 rec3=034
[0x14] rec0=00 rec1=00 rec2=32 rec3=00e
[0x15] rec0=1d rec1=00 rec2=11 rec3=080
[0x16] rec0=1c rec1=00 rec2=12 rec3=02c
[0x17] rec0=16 rec1=00 rec2=13 rec3=036
[0x18] rec0=01 rec1=00 rec2=31 rec3=012
[0x19] rec0=1d rec1=00 rec2=14 rec3=000
[0x1a] rec0=1b rec1=00 rec2=15 rec3=036
[0x1b] rec0=17 rec1=00 rec2=16 rec3=06e
[0x1c] rec0=18 rec1=00 rec2=17 rec3=000
[0x1d] rec0=01 rec1=00 rec2=30 rec3=024
[0x1e] rec0=20 rec1=00 rec2=18 rec3=04a
[0x1f] rec0=17 rec1=00 rec2=19 rec3=00c
[0x20] rec0=14 rec1=00 rec2=1a rec3=010
[0x21] rec0=16 rec1=00 rec2=1b rec3=01a
[0x22] rec0=00 rec1=00 rec2=2f rec3=028
[0x23] rec0=1d rec1=00 rec2=1c rec3=002
[0x24] rec0=21 rec1=00 rec2=1d rec3=014
[0x25] rec0=13 rec1=00 rec2=1e rec3=02c
[0x26] rec0=00 rec1=00 rec2=2e rec3=01a
[0x27] rec0=21 rec1=00 rec2=1f rec3=00c
[0x28] rec0=19 rec1=00 rec2=20 rec3=006
[0x29] rec0=12 rec1=00 rec2=21 rec3=078
[0x2a] rec0=00 rec1=00 rec2=2d rec3=00e
[0x2b] rec0=1e rec1=00 rec2=22 rec3=00a
[0x2c] rec0=00 rec1=00 rec2=2c rec3=008
[0x2d] rec0=1e rec1=00 rec2=23 rec3=010
[0x2e] rec0=1e rec1=00 rec2=2b rec3=002
[0x2f] rec0=00 rec1=00 rec2=24 rec3=018
[0x30] rec0=20 rec1=00 rec2=25 rec3=04e
[0x31] rec0=1b rec1=00 rec2=26 rec3=038
[0x32] rec0=1a rec1=00 rec2=27 rec3=06c
[0x33] rec0=1a rec1=00 rec2=28 rec3=012
[0x34] rec0=13 rec1=00 rec2=29 rec3=02e
[0x35] rec0=19 rec1=00 rec2=2a rec3=000
tail 0x217006b9c8197821fa62d 0x42a00088462063203