|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - downloadIndex: ┃ B T ┃
Length: 52106 (0xcb8a)
Types: TextFile
Names: »B«
└─⟦85b835f43⟧ Bits:30000549 8mm tape, Rational 1000, Xlib rev 6.00
└─ ⟦0c20f784e⟧ »DATA«
└─⟦1abbe589f⟧
└─⟦059497ac5⟧
└─⟦this⟧
with Xlbt_Arithmetic;
use Xlbt_Arithmetic;
with Xlbt_Basic;
use Xlbt_Basic;
with Xlbt_Error;
use Xlbt_Error;
with Xlbt_Event;
use Xlbt_Event;
with Xlbt_Hint;
use Xlbt_Hint;
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 Xlbt_Visual;
use Xlbt_Visual;
with Xlbp_Atom;
use Xlbp_Atom;
with Xlbp_Display;
use Xlbp_Display;
with Xlbp_Event;
use Xlbp_Event;
with Xlbp_Extension;
use Xlbp_Extension;
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_Window is
------------------------------------------------------------------------------
-- X Library Window Controls
--
-- Xlbp_Window - Control functions for windows.
------------------------------------------------------------------------------
-- 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
function Count_X_Window_Attributes
(Mask : X_New_Window_Attributes) return S_Natural is
------------------------------------------------------------------------------
-- Count the number of 1's in an X_New_Window_Attributes mask.
------------------------------------------------------------------------------
Count : S_Natural := 0;
begin
for I in reverse Mask'Range loop
if Mask (I) then
Count := Count + 1;
end if;
end loop;
return Count;
end Count_X_Window_Attributes;
--\f
procedure Process_X_Window_Attributes (Display : X_Display;
Valuemask : X_New_Window_Attributes;
Attr : X_Set_Window_Attributes) is
------------------------------------------------------------------------------
-- Process_X_Window_Attributes - For each 1 bit in the mask put out the
-- corresponding attribute. Note: The order of these is crucial. The server
-- will be expecting them in this order.
------------------------------------------------------------------------------
begin
if Valuemask (Cw_Back_Pixmap) then
Put_X_Id (Display, Attr.Background_Pixmap.Drawable.Id);
end if;
if Valuemask (Cw_Back_Pixel) then
Put_X_Pixel (Display, Attr.Background_Pixel);
end if;
if Valuemask (Cw_Border_Pixmap) then
Put_X_Id (Display, Attr.Border_Pixmap.Drawable.Id);
end if;
if Valuemask (Cw_Border_Pixel) then
Put_X_Pixel (Display, Attr.Border_Pixel);
end if;
if Valuemask (Cw_Bit_Gravity) then
Put_S_Long (Display,
S_Long (X_Bit_Gravity'Pos (Attr.Bit_Gravity)));
end if;
if Valuemask (Cw_Win_Gravity) then
Put_S_Long (Display,
S_Long (X_Window_Gravity'Pos (Attr.Win_Gravity)));
end if;
if Valuemask (Cw_Backing_Store) then
Put_S_Long
(Display,
S_Long (X_Backing_Store_Hint'Pos (Attr.Backing_Store)));
end if;
if Valuemask (Cw_Backing_Planes) then
Put_X_Plane_Mask (Display, Attr.Backing_Planes);
end if;
if Valuemask (Cw_Backing_Pixel) then
Put_X_Pixel (Display,
Attr.Backing_Pixel);
end if;
if Valuemask (Cw_Override_Redirect) then
Put_S_Long (Display, S_Long (Boolean'Pos (Attr.Override_Redirect)));
end if;
if Valuemask (Cw_Save_Under) then
Put_S_Long (Display,
S_Long (Boolean'Pos (Attr.Save_Under)));
end if;
if Valuemask (Cw_Event_Mask) then
Put_X_Event_Mask (Display, Attr.Event_Mask);
end if;
if Valuemask (Cw_Dont_Propagate) then
Put_X_Event_Mask (Display,
Attr.Do_Not_Propagate_Mask);
end if;
if Valuemask (Cw_Colormap) then
Put_X_Id (Display, Attr.Colormap.Id);
end if;
if Valuemask (Cw_Cursor) then
Put_X_Id (Display, Attr.Cursor.Id);
end if;
end Process_X_Window_Attributes;
--\f
procedure X_Change_Window_Attributes (Display : X_Display;
Window : X_Window;
Values_Mask : X_New_Window_Attributes;
Values : X_Set_Window_Attributes) is
------------------------------------------------------------------------------
-- X_Change_Window_Attributes
------------------------------------------------------------------------------
Extra_Words : S_Natural;
Lvalues_Mask : X_New_Window_Attributes :=
"and" (Values_Mask, All_X_New_Window_Attributes);
begin
----Do nothing if we don't have to.
if Lvalues_Mask = None_X_New_Window_Attributes then
return;
end if;
Extra_Words := Count_X_Window_Attributes (Lvalues_Mask);
----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 +
U_Short (Extra_Words),
Pad => 0,
Window => Window,
Value_Mask => Lvalues_Mask),
Extra_Words);
----Send the extra data.
Process_X_Window_Attributes (Display, Lvalues_Mask, Values);
----Catch unexpected exceptions.
exception
when others =>
Unlock_Display (Display);
raise;
end;
----Unlock; sync; and return.
Unlock_Display (Display);
Sync_Handle (Display);
end X_Change_Window_Attributes;
--\f
procedure X_Circulate_Subwindows (Display : X_Display;
Window : X_Window;
Direction : X_Circulate_Place) is
------------------------------------------------------------------------------
-- X_Circulate_Subwindows
------------------------------------------------------------------------------
begin
----Lock the display.
Lock_Display (Display);
begin
----Send the request.
Put_X_Circulate_Window_Request
(Display, (Kind => Circulate_Window,
Length => X_Circulate_Window_Request'Size / 32,
Direction => Direction,
Window => Window));
----Catch unexpected exceptions.
exception
when others =>
Unlock_Display (Display);
raise;
end;
----Unlock; sync; and return.
Unlock_Display (Display);
Sync_Handle (Display);
end X_Circulate_Subwindows;
--\f
procedure X_Circulate_Subwindows_Down (Display : X_Display;
Window : X_Window) is
begin
X_Circulate_Subwindows (Display, Window, Lower_Highest);
end X_Circulate_Subwindows_Down;
--\f
procedure X_Circulate_Subwindows_Up (Display : X_Display;
Window : X_Window) is
begin
X_Circulate_Subwindows (Display, Window, Raise_Lowest);
end X_Circulate_Subwindows_Up;
--\f
function Count_X_Window_Changes_Mask
(Mask : X_Window_Changes_Mask) return S_Natural is
------------------------------------------------------------------------------
-- Count the 1's in the Mask.
------------------------------------------------------------------------------
Count : S_Natural;
begin
for I in reverse Mask'Range loop
if Mask (I) then
Count := Count + 1;
end if;
end loop;
return Count;
end Count_X_Window_Changes_Mask;
--\f
procedure Process_X_Window_Changes (Display : X_Display;
Mask : X_Window_Changes_Mask;
Changes : X_Window_Changes) is
------------------------------------------------------------------------------
-- Put out as many of the Changes to the server as indicated by Mask.
------------------------------------------------------------------------------
begin
if Mask (Cw_X) then
Put_S_Long (Display, S_Long (Changes.X));
end if;
if Mask (Cw_Y) then
Put_S_Long (Display, S_Long (Changes.Y));
end if;
if Mask (Cw_Width) then
Put_S_Long (Display, S_Long (Changes.Width));
end if;
if Mask (Cw_Height) then
Put_S_Long (Display, S_Long (Changes.Height));
end if;
if Mask (Cw_Border_Width) then
Put_S_Long (Display, S_Long (Changes.Border_Width));
end if;
if Mask (Cw_Sibling) then
Put_X_Id (Display, Changes.Sibling.Drawable.Id);
end if;
if Mask (Cw_Stack_Mode) then
Put_S_Long (Display,
S_Long (X_Window_Stacking'Pos (Changes.Stack_Mode)));
end if;
end Process_X_Window_Changes;
--\f
procedure X_Configure_Window (Display : X_Display;
Window : X_Window;
Values_Mask : X_Window_Changes_Mask;
Values : X_Window_Changes) is
------------------------------------------------------------------------------
-- X_Configure_Window
------------------------------------------------------------------------------
Extra_Words : S_Natural;
Lvalues_Mask : X_Window_Changes_Mask :=
"and" (Values_Mask, All_X_Window_Changes_Mask);
begin
----Do nothing if nothing changes.
if Lvalues_Mask = None_X_Window_Changes_Mask then
return;
end if;
Extra_Words := Count_X_Window_Changes_Mask (Lvalues_Mask);
----Lock the display.
Lock_Display (Display);
begin
----Send the request.
Put_X_Configure_Window_Request
(Display,
(Kind => Configure_Window,
Length => X_Configure_Window_Request'Size / 32 +
U_Short (Extra_Words),
Pad => 0,
Pad2 => 0,
Window => Window,
Mask => Lvalues_Mask),
Extra_Words * 4);
----Send the extra data.
Process_X_Window_Changes (Display, Lvalues_Mask, Values);
----Catch unexpected exceptions.
exception
when others =>
Unlock_Display (Display);
raise;
end;
----Unlock; sync; and return;
Unlock_Display (Display);
Sync_Handle (Display);
end X_Configure_Window;
--\f
function X_Create_Simple_Window (Display : X_Display;
Parent : X_Window;
X : S_Short;
Y : S_Short;
Width : U_Short_Positive;
Height : U_Short_Positive;
Border_Width : U_Short;
Border : X_Pixel;
Background : X_Pixel) return X_Window is
------------------------------------------------------------------------------
-- X_Create_Simple_Window
------------------------------------------------------------------------------
Wid : X_Window := X_Window'(Drawable => (Id => X_Alloc_Id (Display)));
begin
----Lock the display.
Lock_Display (Display);
begin
----Put out the request.
Put_X_Create_Window_Request
(Display,
(Kind => Create_Window,
Length => X_Create_Window_Request'Size / 32 + 2,
Parent => Parent,
X => X,
Y => Y,
Width => Width,
Height => Height,
Border_Width => Border_Width,
Depth => 0,
Class => Copy_From_Parent,
Visual => Copy_From_Parent_Visual_Id,
Window => Wid,
Mask => (Cw_Back_Pixel | Cw_Border_Pixel => True,
others => False)),
2 * 4);
----Put out the extra data.
Put_X_Pixel (Display, Background);
Put_X_Pixel (Display, Border);
----Catch unexpected exceptions.
exception
when others =>
Unlock_Display (Display);
raise;
end;
----Unlock; sync; and return the new window.
Unlock_Display (Display);
Sync_Handle (Display);
return Wid;
end X_Create_Simple_Window;
--\f
function X_Create_Window
(Display : X_Display;
Parent : X_Window;
X : S_Short;
Y : S_Short;
Width : U_Short_Positive;
Height : U_Short_Positive;
Border_Width : U_Short;
Depth : U_Char;
Class : X_Window_Class;
Visual : X_Visual;
Values_Mask : X_New_Window_Attributes;
Values : X_Set_Window_Attributes) return X_Window is
------------------------------------------------------------------------------
-- X_Create_Window
------------------------------------------------------------------------------
Wid : X_Window := X_Window'(Drawable => (Id => X_Alloc_Id (Display)));
Vid : X_Visual_Id := Copy_From_Parent_Visual_Id;
Att_Count : S_Natural := Count_X_Window_Attributes (Values_Mask);
Lvalues_Mask : X_New_Window_Attributes :=
"and" (Values_Mask, All_X_New_Window_Attributes);
begin
----Lock the display.
Lock_Display (Display);
begin
----Determine the proper Visual_Id to send.
if Visual /= None_X_Visual then
Vid := Visual.Visual_Id;
end if;
----Send the basic request.
Put_X_Create_Window_Request
(Display,
(Kind => Create_Window,
Length =>
X_Create_Window_Request'Size / 32 + U_Short (Att_Count),
Parent => Parent,
X => X,
Y => Y,
Width => Width,
Height => Height,
Border_Width => Border_Width,
Depth => Depth,
Class => Class,
Visual => Vid,
Window => Wid,
Mask => Lvalues_Mask),
Att_Count * 4);
----Send the remainder of the information.
if Att_Count > 0 then
Process_X_Window_Attributes (Display, Lvalues_Mask, Values);
end if;
----Catch unexpected conversions.
exception
when others =>
Unlock_Display (Display);
raise;
end;
----Unlock; sync; return new window.
Unlock_Display (Display);
Sync_Handle (Display);
return Wid;
end X_Create_Window;
--\f
procedure X_Destroy_Subwindows (Display : X_Display;
Window : X_Window) is
------------------------------------------------------------------------------
-- X_Destroy_Subwindows
------------------------------------------------------------------------------
begin
----Lock the display.
Lock_Display (Display);
begin
----Send the request
Put_X_Destroy_Subwindows_Request
(Display, (Kind => Destroy_Subwindows,
Length => X_Destroy_Subwindows_Request'Size / 32,
Pad => 0,
Id => Window));
----Catch unexpected exceptions.
exception
when others =>
Unlock_Display (Display);
raise;
end;
----Unlock; sync; and return.
Unlock_Display (Display);
Sync_Handle (Display);
end X_Destroy_Subwindows;
--\f
procedure X_Destroy_Window (Display : X_Display;
Window : X_Window) is
------------------------------------------------------------------------------
-- X_Destroy_Window
------------------------------------------------------------------------------
begin
----Lock the display.
Lock_Display (Display);
begin
----Send the request
Put_X_Destroy_Window_Request
(Display, (Kind => Destroy_Window,
Length => X_Destroy_Window_Request'Size / 32,
Pad => 0,
Id => Window));
----Catch unexpected exceptions.
exception
when others =>
Unlock_Display (Display);
raise;
end;
----Unlock; sync; and return.
Unlock_Display (Display);
Sync_Handle (Display);
end X_Destroy_Window;
--\f
procedure X_Iconify_Window (Display : X_Display;
Window : X_Window;
Screen : X_Screen_Number;
Status : out X_Status) is
------------------------------------------------------------------------------
-- Display - Specifies the display to use.
-- Window - Specifies the window to affect.
-- Screen - Specifies the screen
-- Status - Receives Successful if the request has been made; receives
-- Failed if the request could not be made
--
-- Sends an Xa_Wm_Change_State Client_Message event with a format of 32 and a
-- first data element of Iconic_State (as described in section 4.14 of the
-- ICCCM) to the root window of the specified screen. If the window is in
-- its normal state and if the window manager has elected to receive these
-- events then the window should change to the iconic state.
------------------------------------------------------------------------------
Ev : X_Client_Message_Event;
Root : X_Window := X_Root_Window (Display, Screen);
A : X_Atom;
Succ : X_Status;
begin
if Display.Atoms.Wm_Change_State = None_X_Atom then
A := X_Intern_Atom (Display, "WM_CHANGE_STATE", False);
if A = None_X_Atom then
Status := Failed;
return;
end if;
Lock_Display (Display);
Display.Atoms.Wm_Change_State := A;
Unlock_Display (Display);
end if;
Ev.Client.Window := Window;
Ev.Client.Message_Type := Display.Atoms.Wm_Change_State;
Ev.Client.Format := 32;
X_Client_Message_S_Long (Ev.Client.Data, 0,
X_Initial_Window_State'Pos (Iconic_State));
X_Client_Message_S_Long (Ev.Client.Data, 1, 0);
X_Client_Message_S_Long (Ev.Client.Data, 2, 0);
X_Client_Message_S_Long (Ev.Client.Data, 3, 0);
X_Client_Message_S_Long (Ev.Client.Data, 4, 0);
X_Send_Event
(Display => Display,
Window => Root,
Propagate => False,
Event_Mask =>
X_Event_Mask'
(Substructure_Redirect_Mask | Substructure_Notify_Mask =>
True,
others => False),
Event => Ev,
Status => Succ);
Status := Succ;
end X_Iconify_Window;
--\f
procedure X_Lower_Window (Display : X_Display;
Window : X_Window) is
------------------------------------------------------------------------------
-- X_Lower_Window
------------------------------------------------------------------------------
begin
----Lock the display.
Lock_Display (Display);
begin
----Send the request and the extra data.
Put_X_Configure_Window_Request
(Display,
(Kind => Configure_Window,
Length => X_Configure_Window_Request'Size / 32 + 1,
Pad => 0,
Pad2 => 0,
Window => Window,
Mask => (Cw_Stack_Mode => True, others => False)),
4);
Put_S_Long (Display,
S_Long (X_Window_Stacking'Pos (Below)));
----Catch unexpected exceptions.
exception
when others =>
Unlock_Display (Display);
raise;
end;
----Unlock; sync; and return.
Unlock_Display (Display);
Sync_Handle (Display);
end X_Lower_Window;
--\f
procedure X_Map_Raised (Display : X_Display;
Window : X_Window) is
------------------------------------------------------------------------------
-- X_Map_Raised
------------------------------------------------------------------------------
begin
----Lock the display;
Lock_Display (Display);
begin
----Send the request that causes the stacking.
Put_X_Configure_Window_Request
(Display,
(Kind => Configure_Window,
Length => X_Configure_Window_Request'Size / 32 + 1,
Pad => 0,
Pad2 => 0,
Window => Window,
Mask => (Cw_Stack_Mode => True, others => False)),
4);
Put_S_Long (Display,
S_Long (X_Window_Stacking'Pos (Above)));
----Send the request that causes it to be mapped so that the stacking matters.
Put_X_Map_Window_Request
(Display, (Kind => Map_Window,
Length => X_Map_Window_Request'Size / 32,
Pad => 0,
Id => Window));
----Catch unexpected exceptions.
exception
when others =>
Unlock_Display (Display);
raise;
end;
----Unlock; sync; and return.
Unlock_Display (Display);
Sync_Handle (Display);
end X_Map_Raised;
--\f
procedure X_Map_Subwindows (Display : X_Display;
Window : X_Window) is
------------------------------------------------------------------------------
-- X_Map_Subwindows
------------------------------------------------------------------------------
begin
----Lock the display;
Lock_Display (Display);
begin
----Send the request.
Put_X_Map_Subwindows_Request
(Display, (Kind => Map_Subwindows,
Length => X_Map_Subwindows_Request'Size / 32,
Pad => 0,
Id => Window));
----Catch unexpected exceptions.
exception
when others =>
Unlock_Display (Display);
raise;
end;
----Unlock; sync; and return.
Unlock_Display (Display);
Sync_Handle (Display);
end X_Map_Subwindows;
--\f
procedure X_Map_Window (Display : X_Display;
Window : X_Window) is
------------------------------------------------------------------------------
-- X_Map_Window
------------------------------------------------------------------------------
begin
----Lock the display;
Lock_Display (Display);
begin
----Send the request.
Put_X_Map_Window_Request
(Display, (Kind => Map_Window,
Length => X_Map_Window_Request'Size / 32,
Pad => 0,
Id => Window));
----Catch unexpected exceptions.
exception
when others =>
Unlock_Display (Display);
raise;
end;
----Unlock; sync; and return.
Unlock_Display (Display);
Sync_Handle (Display);
end X_Map_Window;
--\f
procedure X_Move_Resize_Window (Display : X_Display;
Window : X_Window;
X : S_Short;
Y : S_Short;
Width : U_Short_Positive;
Height : U_Short_Positive) is
------------------------------------------------------------------------------
-- X_Move_Resize_Window
------------------------------------------------------------------------------
begin
----Lock the display;
Lock_Display (Display);
begin
----Send the request.
Put_X_Configure_Window_Request
(Display,
(Kind => Configure_Window,
Length => X_Configure_Window_Request'Size / 32 + 4,
Pad => 0,
Pad2 => 0,
Window => Window,
Mask => (Cw_X | Cw_Y | Cw_Width | Cw_Height => True,
others => False)),
4 * 4);
----Put out the extra data for the request.
Put_S_Long (Display, S_Long (X));
Put_S_Long (Display, S_Long (Y));
Put_S_Long (Display, S_Long (Width));
Put_S_Long (Display, S_Long (Height));
----Catch unexpected exceptions.
exception
when others =>
Unlock_Display (Display);
raise;
end;
----Unlock; sync; and return.
Unlock_Display (Display);
Sync_Handle (Display);
end X_Move_Resize_Window;
--\f
procedure X_Move_Window (Display : X_Display;
Window : X_Window;
X : S_Short;
Y : S_Short) is
------------------------------------------------------------------------------
-- X_Move_Window
------------------------------------------------------------------------------
begin
----Lock the display;
Lock_Display (Display);
begin
----Send the request.
Put_X_Configure_Window_Request
(Display,
(Kind => Configure_Window,
Length => X_Configure_Window_Request'Size / 32 + 2,
Pad => 0,
Pad2 => 0,
Window => Window,
Mask => (Cw_X | Cw_Y => True,
others => False)), 2 * 4);
----Send the extra data for the request.
Put_S_Long (Display, S_Long (X));
Put_S_Long (Display, S_Long (Y));
----Catch unexpected exceptions.
exception
when others =>
Unlock_Display (Display);
raise;
end;
----Unlock; sync; and return.
Unlock_Display (Display);
Sync_Handle (Display);
end X_Move_Window;
--\f
procedure X_Raise_Window (Display : X_Display;
Window : X_Window) is
------------------------------------------------------------------------------
-- X_Raise_Window
------------------------------------------------------------------------------
begin
----Lock the display;
Lock_Display (Display);
begin
----Send the request.
Put_X_Configure_Window_Request
(Display,
(Kind => Configure_Window,
Length => X_Configure_Window_Request'Size / 32 + 1,
Pad => 0,
Pad2 => 0,
Window => Window,
Mask => (Cw_Stack_Mode => True,
others => False)), 4);
----Send the extra data for the request.
Put_S_Long (Display,
S_Long (X_Window_Stacking'Pos (Above)));
----Catch unexpected exceptions.
exception
when others =>
Unlock_Display (Display);
raise;
end;
----Unlock; sync; and return.
Unlock_Display (Display);
Sync_Handle (Display);
end X_Raise_Window;
--\f
procedure X_Reparent_Window (Display : X_Display;
Window : X_Window;
Parent : X_Window;
X : S_Short;
Y : S_Short) is
------------------------------------------------------------------------------
-- X_Reparent_Window
------------------------------------------------------------------------------
begin
----Lock the display.
Lock_Display (Display);
begin
----Send the request.
Put_X_Reparent_Window_Request
(Display, (Kind => Reparent_Window,
Length => X_Reparent_Window_Request'Size / 32,
Pad => 0,
Window => Window,
Parent => Parent,
X => X,
Y => Y));
----Catch unexpected exceptions.
exception
when others =>
Unlock_Display (Display);
raise;
end;
----Unlock; sync; and return
Unlock_Display (Display);
Sync_Handle (Display);
end X_Reparent_Window;
--\f
procedure Restack_Error_Handler (Display : X_Display;
Ev : X_Error_Contents) is
begin
if Ev.Serial = Display.Reconfigure_Wm_Window.Sequence_Number and then
Ev.Kind = Bad_Match then
Display.Reconfigure_Wm_Window.Succeeded := False;
return;
end if;
Proc_Var_X_Error_Function.Call
(Proc_Var_X_Error_Function.To_Pv
(Display.Reconfigure_Wm_Window.Old_Handler),
Display,
Ev);
end Restack_Error_Handler;
function Restack_Error_Handler_Pv is
new Proc_Var_X_Error_Function.Value (Restack_Error_Handler);
--\f
procedure X_Reconfigure_Wm_Window (Display : X_Display;
Window : X_Window;
Screen : X_Screen_Number;
Values_Mask : X_Window_Changes_Mask;
Values : X_Window_Changes;
Status : out X_Status) is
------------------------------------------------------------------------------
-- Display - Specifies the display to use.
-- Window - Specifies the window to affect.
-- Screen - Specifies the screen of the window.
-- Values_Mask - Specifies the values within the Values record.
-- Values - Specifies the values to change for the window.
--
-- Issues a Configure_Window request on the specified top-level window. If
-- the stacking mode is changed and the request fails with a Bad_Match error
-- then the error event is trapped and a synthetic Configure_Request_Event
-- containing the same configuration parameters is sent to the root of the
-- specified window. Window managers may elect to receive this event and treat
-- it as a request to reconfigure the window.
------------------------------------------------------------------------------
All_Mask_Bits : constant X_Window_Changes_Mask :=
X_Window_Changes_Mask'
(Cw_X | Cw_Y | Cw_Width | Cw_Height |
Cw_Border_Width | Cw_Sibling | Cw_Stack_Mode => True,
others => False);
Ev : X_Configure_Request_Event;
Root : X_Window := X_Root_Window (Display, Screen);
Succeeded : Boolean;
begin
----Only need to go through the trouble if we are actually changing the
-- stacking mode.
if not Values_Mask (Cw_Stack_Mode) then
X_Configure_Window (Display, Window, Values_Mask, Values);
Status := Successful;
return;
end if;
----We need to inline XConfigureWindow and XSync so that everything is done
-- while the display is locked.
Lock_Display (Display);
begin
----Remember the old error handler, set the new one, set the sequence
-- number to look for, clear the failure flag, try the request, and
-- restore the error handler.
Display.Reconfigure_Wm_Window.Old_Handler := Display.Error;
Display.Error := X_Lib_Default_Restack_Error_Handler;
Display.Reconfigure_Wm_Window.Sequence_Number :=
X_Next_Request (Display);
Display.Reconfigure_Wm_Window.Succeeded := True;
----X_Configure_Window( Display, Window, mask, changes );
declare
Extra_Words : S_Natural;
Lvalues_Mask : X_Window_Changes_Mask :=
Values_Mask and All_X_Window_Changes_Mask;
begin
Extra_Words := Count_X_Window_Changes_Mask (Lvalues_Mask);
----Send the request.
Put_X_Configure_Window_Request
(Display,
(Kind => Configure_Window,
Length => X_Configure_Window_Request'Size / 32 +
U_Short (Extra_Words),
Pad => 0,
Pad2 => 0,
Window => Window,
Mask => Lvalues_Mask),
Extra_Words * 4);
----Send the extra data.
Process_X_Window_Changes (Display, Lvalues_Mask, Values);
end;
----XSync (Display, 0)
declare
Reprec : X_Reply_Contents;
Void : X_Status;
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);
end;
----Put the world back together; copy the failure code out so that it can
-- be accessed once the display is unlocked.
Display.Error := Display.Reconfigure_Wm_Window.Old_Handler;
Succeeded := Display.Reconfigure_Wm_Window.Succeeded;
Display.Reconfigure_Wm_Window.Old_Handler :=
None_X_Procedure_Variable;
Display.Reconfigure_Wm_Window.Sequence_Number := 0;
Display.Reconfigure_Wm_Window.Succeeded := False;
Unlock_Display (Display);
Sync_Handle (Display);
exception
when others =>
Unlock_Display (Display);
raise;
end;
----If the request succeeded, then everything is okay; otherwise, send event.
if Succeeded then
Status := Successful;
return;
end if;
Ev.Configure_Request.Window := Window;
Ev.Configure_Request.Parent := Root;
Ev.Configure_Request.Value_Mask := Values_Mask and All_Mask_Bits;
Ev.Configure_Request.X := Values.X;
Ev.Configure_Request.Y := Values.Y;
Ev.Configure_Request.Width := Values.Width;
Ev.Configure_Request.Height := Values.Height;
Ev.Configure_Request.Border_Width := Values.Border_Width;
Ev.Configure_Request.Above := Values.Sibling;
Ev.Configure_Request.Stack_Mode := Values.Stack_Mode;
X_Send_Event
(Display => Display,
Window => Root,
Propagate => False,
Event_Mask =>
X_Event_Mask'
(Substructure_Redirect_Mask | Substructure_Notify_Mask =>
True,
others => False),
Event => Ev,
Status => Status);
end X_Reconfigure_Wm_Window;
--\f
procedure X_Resize_Window (Display : X_Display;
Window : X_Window;
Width : U_Short_Positive;
Height : U_Short_Positive) is
------------------------------------------------------------------------------
-- X_Resize_Window
------------------------------------------------------------------------------
begin
----Lock the display;
Lock_Display (Display);
begin
----Send the request.
Put_X_Configure_Window_Request
(Display,
(Kind => Configure_Window,
Length => X_Configure_Window_Request'Size / 32 + 2,
Pad => 0,
Pad2 => 0,
Window => Window,
Mask => (Cw_Width | Cw_Height => True,
others => False)),
2 * 4);
----Send the extra data for the request.
Put_S_Long (Display, S_Long (Width));
Put_S_Long (Display, S_Long (Height));
----Catch unexpected exceptions.
exception
when others =>
Unlock_Display (Display);
raise;
end;
----Unlock; sync; and return.
Unlock_Display (Display);
Sync_Handle (Display);
end X_Resize_Window;
--\f
procedure X_Restack_Windows (Display : X_Display;
Windows : X_Window_Array) is
------------------------------------------------------------------------------
-- X_Restack_Window
------------------------------------------------------------------------------
begin
----Lock the display;
Lock_Display (Display);
begin
----Send the request.
for I in Windows'First + 1 .. Windows'Last loop
Put_X_Configure_Window_Request
(Display,
(Kind => Configure_Window,
Length => X_Configure_Window_Request'Size / 32 + 2,
Pad => 0,
Pad2 => 0,
Window => Windows (I),
Mask => (Cw_Sibling | Cw_Stack_Mode => True,
others => False)),
2 * 4);
Put_X_Id (Display, Windows (I - 1).Drawable.Id);
Put_S_Long (Display, S_Long (X_Window_Stacking'Pos (Below)));
end loop;
----Catch unexpected exceptions.
exception
when others =>
Unlock_Display (Display);
raise;
end;
----Unlock; sync; and return.
Unlock_Display (Display);
Sync_Handle (Display);
end X_Restack_Windows;
--\f
procedure X_Set_Window_Background (Display : X_Display;
Window : X_Window;
Pixel : X_Pixel) is
------------------------------------------------------------------------------
-- X_Set_Window_Background
------------------------------------------------------------------------------
begin
----Lock the display.
Lock_Display (Display);
begin
----Put out 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_Back_Pixel => True, others => False)),
4);
Put_X_Pixel (Display, Pixel);
----Catch unexpected exceptions.
exception
when others =>
Unlock_Display (Display);
raise;
end;
----Unlock; sync; and return.
Unlock_Display (Display);
Sync_Handle (Display);
end X_Set_Window_Background;
--\f
procedure X_Set_Window_Background_Pixmap (Display : X_Display;
Window : X_Window;
Pixmap : X_Pixmap) is
------------------------------------------------------------------------------
-- X_Set_Window_Background_Pixmap
------------------------------------------------------------------------------
begin
----Lock the display.
Lock_Display (Display);
begin
----Put out 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_Back_Pixmap => True, others => False)),
4);
Put_X_Id (Display, Pixmap.Drawable.Id);
----Catch unexpected exceptions.
exception
when others =>
Unlock_Display (Display);
raise;
end;
----Unlock; sync; and return.
Unlock_Display (Display);
Sync_Handle (Display);
end X_Set_Window_Background_Pixmap;
--\f
procedure X_Set_Window_Border (Display : X_Display;
Window : X_Window;
Pixel : X_Pixel) is
------------------------------------------------------------------------------
-- X_Set_Window_Border
------------------------------------------------------------------------------
begin
----Lock the display.
Lock_Display (Display);
begin
----Put out 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_Border_Pixel => True, others => False)),
4);
Put_X_Pixel (Display, Pixel);
----Catch unexpected exceptions.
exception
when others =>
Unlock_Display (Display);
raise;
end;
----Unlock; sync; and return.
Unlock_Display (Display);
Sync_Handle (Display);
end X_Set_Window_Border;
--\f
procedure X_Set_Window_Border_Pixmap (Display : X_Display;
Window : X_Window;
Pixmap : X_Pixmap) is
------------------------------------------------------------------------------
-- X_Set_Window_Border_Pixmap
------------------------------------------------------------------------------
begin
----Lock the display.
Lock_Display (Display);
begin
----Put out 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_Border_Pixmap => True, others => False)),
4);
Put_X_Id (Display, Pixmap.Drawable.Id);
----Catch unexpected exceptions.
exception
when others =>
Unlock_Display (Display);
raise;
end;
----Unlock; sync; and return.
Unlock_Display (Display);
Sync_Handle (Display);
end X_Set_Window_Border_Pixmap;
--\f
procedure X_Set_Window_Border_Width (Display : X_Display;
Window : X_Window;
Width : U_Short) is
------------------------------------------------------------------------------
-- X_Set_Window_Border_Width
------------------------------------------------------------------------------
begin
----Lock the display.
Lock_Display (Display);
begin
----Put out the request
Put_X_Configure_Window_Request
(Display,
(Kind => Configure_Window,
Length => X_Configure_Window_Request'Size / 32 + 1,
Pad => 0,
Pad2 => 0,
Window => Window,
Mask => (Cw_Border_Width => True, others => False)),
4);
----Put out the extra data for the request.
Put_S_Long (Display, S_Long (Width));
----Catch unexpected exceptions.
exception
when others =>
Unlock_Display (Display);
raise;
end;
----Unlock; sync; and return.
Unlock_Display (Display);
Sync_Handle (Display);
end X_Set_Window_Border_Width;
--\f
procedure X_Unmap_Subwindows (Display : X_Display;
Window : X_Window) is
------------------------------------------------------------------------------
-- X_Unmap_Subwindows
------------------------------------------------------------------------------
begin
----Lock the display;
Lock_Display (Display);
begin
----Send the request.
Put_X_Unmap_Subwindows_Request
(Display, (Kind => Unmap_Subwindows,
Length => X_Unmap_Subwindows_Request'Size / 32,
Pad => 0,
Id => Window));
----Catch unexpected exceptions.
exception
when others =>
Unlock_Display (Display);
raise;
end;
----Unlock; sync; and return.
Unlock_Display (Display);
Sync_Handle (Display);
end X_Unmap_Subwindows;
--\f
procedure X_Unmap_Window (Display : X_Display;
Window : X_Window) is
------------------------------------------------------------------------------
-- X_Unmap_Window
------------------------------------------------------------------------------
begin
----Lock the display;
Lock_Display (Display);
begin
----Send the request.
Put_X_Unmap_Window_Request
(Display, (Kind => Unmap_Window,
Length => X_Unmap_Window_Request'Size / 32,
Pad => 0,
Id => Window));
----Catch unexpected exceptions.
exception
when others =>
Unlock_Display (Display);
raise;
end;
----Unlock; sync; and return.
Unlock_Display (Display);
Sync_Handle (Display);
end X_Unmap_Window;
--\f
procedure X_Withdraw_Window (Display : X_Display;
Window : X_Window;
Screen : X_Screen_Number;
Status : out X_Status) is
------------------------------------------------------------------------------
-- Display - Specifies the display to use.
-- Window - Specifies the window to affect.
-- Screen - Specifies the screen
-- Status - Receives Successful if the request has been made; receives
-- Failed if the request could not be made
--
-- Unmaps the specified window and sends a synthetic Unmap_Notify event to
-- the root window of the specified screen. If the window has elected to
-- receive these events then the window should change to the withdraw state
-- where neither the window nor its icon are visible.
------------------------------------------------------------------------------
Ev : X_Unmap_Notify_Event;
Root : X_Window := X_Root_Window (Display, Screen);
begin
X_Unmap_Window (Display, Window);
Ev.Unmap.Event := Root;
Ev.Unmap.Window := Window;
Ev.Unmap.From_Configure := False;
X_Send_Event
(Display => Display,
Window => Root,
Propagate => False,
Event_Mask =>
X_Event_Mask'
(Substructure_Redirect_Mask | Substructure_Notify_Mask =>
True,
others => False),
Event => Ev,
Status => Status);
end X_Withdraw_Window;
--\f
begin
X_Lib_Default_Restack_Error_Handler :=
Proc_Var_X_Error_Function.From_Pv (Restack_Error_Handler_Pv);
end Xlbp_Window;