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

⟦1d25382e2⟧ TextFile

    Length: 18312 (0x4788)
    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_Basic2;  
use Xlbt_Basic2;  
with Xlbt_Key;  
use Xlbt_Key;  
with Xlbt_Misc;  
use Xlbt_Misc;  
with Xlbt_Reply;  
use Xlbt_Reply;  
with Xlbt_Request;  
use Xlbt_Request;  
with Xlbt_Window;  
use Xlbt_Window;

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_Information is
------------------------------------------------------------------------------
-- X Library Miscellaneous Window Information
--
-- Xlbp_Window_Information - Provide useful miscellaneous information
------------------------------------------------------------------------------
-- 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_Get_Geometry (Display      :     X_Display;  
                              Drawable     :     X_Drawable;  
                              Root         : out X_Window;  
                              X            : out S_Short;  
                              Y            : out S_Short;  
                              Width        : out U_Short;  
                              Height       : out U_Short;  
                              Border_Width : out U_Short;  
                              Depth        : out U_Char;  
                              Status       : out X_Status) is
-------------------------------------------------------------------------------
-- X_Get_Geometry
------------------------------------------------------------------------------
        Rep  : X_Reply_Contents;  
        Succ : X_Status;  
    begin

----Lock the display.

        Lock_Display (Display);  
        begin

----Send the request.

            Put_X_Get_Geometry_Request  
               (Display, (Kind   => Get_Geometry,  
                          Length => X_Get_Geometry_Request'Size / 32,  
                          Pad    => 0,  
                          Id     => Drawable));

----Get the reply.

            Get_Reply (Display => Display,  
                       Code    => Get_Geometry,  
                       Reply   => Rep,  
                       Extra   => 0,  
                       Discard => True,  
                       Status  => Succ);

----If we failed then return that to the user.

            if Succ = Failed then  
                Root         := None_X_Window;  
                X            := 0;  
                Y            := 0;  
                Width        := 0;  
                Height       := 0;  
                Border_Width := 0;  
                Depth        := 0;  
                Status       := Failed;  
                Unlock_Display (Display);  
                Sync_Handle (Display);  
                return;  
            end if;

----Copy the info to our output parameters.

            Root         := Rep.Get_Geometry.Root;  
            X            := Rep.Get_Geometry.X;  
            Y            := Rep.Get_Geometry.Y;  
            Width        := Rep.Get_Geometry.Width;  
            Height       := Rep.Get_Geometry.Height;  
            Border_Width := Rep.Get_Geometry.Border_Width;  
            Depth        := Rep.Get_Geometry.Depth;

----Catch unexpected exceptions.

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

----Unlock; sync; and return success.

        Status := Successful;  
        Unlock_Display (Display);  
        Sync_Handle (Display);

    end X_Get_Geometry;

--\f

    procedure X_Get_Window_Attributes (Display :        X_Display;  
                                       Window  :        X_Window;  
                                       Values  : in out X_Window_Attributes;  
                                       Status  : out    X_Status) is
------------------------------------------------------------------------------
-- X_Get_Window_Attributes
------------------------------------------------------------------------------
        Rep  : X_Reply_Contents;  
        Succ : X_Status;  
    begin

----Lock the display.

        Lock_Display (Display);  
        begin

----Send the Window Attributes request.

            Put_X_Get_Window_Attributes_Request  
               (Display, (Kind   => Get_Window_Attributes,  
                          Length => X_Get_Window_Attributes_Request'Size / 32,  
                          Pad    => 0,  
                          Id     => Window));

----Get the reply to our query.

            Get_Reply (Display => Display,  
                       Code    => Get_Window_Attributes,  
                       Reply   => Rep,  
                       Extra   => 0,  
                       Discard => True,  
                       Status  => Succ);

----If that failed then return that as our status.

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

----Return those attributes that we have.

            Values.Class := Rep.Get_Window_Attributes.Class;  
            Values.Bit_Gravity := Rep.Get_Window_Attributes.Bit_Gravity;  
            Values.Win_Gravity := Rep.Get_Window_Attributes.Win_Gravity;  
            Values.Backing_Store := Rep.Get_Window_Attributes.Backing_Store;  
            Values.Backing_Planes :=  
               Rep.Get_Window_Attributes.Backing_Bit_Planes;  
            Values.Backing_Pixel := Rep.Get_Window_Attributes.Backing_Pixel;  
            Values.Save_Under := To_Boolean  
                                    (Rep.Get_Window_Attributes.Save_Under);  
            Values.Colormap := Rep.Get_Window_Attributes.Colormap;  
            Values.Map_Installed :=  
               To_Boolean (Rep.Get_Window_Attributes.Map_Installed);  
            Values.Map_State := Rep.Get_Window_Attributes.Map_State;  
            Values.All_Event_Masks := Rep.Get_Window_Attributes.All_Event_Masks;  
            Values.Your_Event_Mask := Rep.Get_Window_Attributes.Your_Event_Mask;  
            Values.Do_Not_Propagate_Mask :=  
               X_Event_Mask_Short_To_Long  
                  (Rep.Get_Window_Attributes.Do_Not_Propagate_Mask);  
            Values.Override_Redirect := To_Boolean  
                                           (Rep.Get_Window_Attributes.Override);  
            Internal_X_Vid_To_Visual  
               (Display, Rep.Get_Window_Attributes.Visual_Id,  
                Values.Visual, Succ);

----Now send the Geometry request.

            Put_X_Get_Geometry_Request  
               (Display, (Kind   => Get_Geometry,  
                          Length => X_Get_Geometry_Request'Size / 32,  
                          Pad    => 0,  
                          Id     => Window.Drawable));

----Get the reply.

            Get_Reply (Display => Display,  
                       Code    => Get_Geometry,  
                       Reply   => Rep,  
                       Extra   => 0,  
                       Discard => True,  
                       Status  => Succ);

----If we failed this part then return failed as our status.

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

----Return the attributes that this gave us.

            Values.X            := Rep.Get_Geometry.X;  
            Values.Y            := Rep.Get_Geometry.Y;  
            Values.Width        := Rep.Get_Geometry.Width;  
            Values.Height       := Rep.Get_Geometry.Height;  
            Values.Border_Width := Rep.Get_Geometry.Border_Width;  
            Values.Depth        := Rep.Get_Geometry.Depth;  
            Values.Root         := Rep.Get_Geometry.Root;

----Find the correct screen so that applications have an easier time.

            for I in Display.Screens'Range loop  
                if Display.Screens (I).Root = Rep.Get_Geometry.Root then  
                    Values.Screen := Display.Screens (I);  
                    exit;  
                end if;  
            end loop;

----Catch unexpected exceptions.

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

----Unlock; sync; return a successful status.

        Status := Successful;  
        Unlock_Display (Display);  
        Sync_Handle (Display);

    end X_Get_Window_Attributes;

--\f

    procedure X_Query_Pointer (Display     :     X_Display;  
                               Window      :     X_Window;  
                               Root        : out X_Window;  
                               Child       : out X_Window;  
                               Root_X      : out U_Short;  
                               Root_Y      : out U_Short;  
                               Window_X    : out S_Short;  
                               Window_Y    : out S_Short;  
                               Mask        : out X_Key_Button_Mask;  
                               Same_Screen : out Boolean) is
------------------------------------------------------------------------------
-- X_Query_Pointer
------------------------------------------------------------------------------
        Rep  : X_Reply_Contents;  
        Succ : X_Status;  
    begin

----Lock the display.

        Lock_Display (Display);  
        begin

----Send the request.

            Put_X_Query_Pointer_Request  
               (Display, (Kind   => Query_Pointer,  
                          Length => X_Query_Pointer_Request'Size / 32,  
                          Pad    => 0,  
                          Id     => Window));

----Read the reply to our request.

            Get_Reply (Display => Display,  
                       Code    => Query_Pointer,  
                       Reply   => Rep,  
                       Extra   => 0,  
                       Discard => True,  
                       Status  => Succ);

----If we didn't get a reply then return all 0's.

            if Succ = Failed then  
                Root        := None_X_Window;  
                Child       := None_X_Window;  
                Root_X      := 0;  
                Root_Y      := 0;  
                Window_X    := 0;  
                Window_Y    := 0;  
                Mask        := None_X_Key_Button_Mask;  
                Same_Screen := False;  
                Unlock_Display (Display);  
                Sync_Handle (Display);  
                return;  
            end if;

----Return our results.

            Root        := Rep.Query_Pointer.Root;  
            Child       := Rep.Query_Pointer.Child;  
            Root_X      := Rep.Query_Pointer.Root_X;  
            Root_Y      := Rep.Query_Pointer.Root_Y;  
            Window_X    := Rep.Query_Pointer.Win_X;  
            Window_Y    := Rep.Query_Pointer.Win_Y;  
            Same_Screen := To_Boolean (Rep.Query_Pointer.Same_Screen);  
            Mask        := Rep.Query_Pointer.Mask;

----Catch unexpected exceptions.

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

        Unlock_Display (Display);  
        Sync_Handle (Display);

    end X_Query_Pointer;

--\f

    procedure X_Query_Tree (Display  :     X_Display;  
                            Window   :     X_Window;  
                            Root     : out X_Window;  
                            Parent   : out X_Window;  
                            Children : out X_Window_List;  
                            Status   : out X_Status) is
------------------------------------------------------------------------------
-- X_Query_Tree
------------------------------------------------------------------------------
        Rep       : X_Reply_Contents;  
        N_Chillin : S_Natural;  
        Succ      : X_Status;  
    begin

----Lock the display.

        Lock_Display (Display);  
        begin

----Send the request.

            Put_X_Query_Tree_Request  
               (Display, (Kind   => Query_Tree,  
                          Length => X_Query_Tree_Request'Size / 32,  
                          Pad    => 0,  
                          Window => Window));

----Read the reply header.

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

----If we failed then return that info.

            if Succ = Failed then  
                Unlock_Display (Display);  
                Sync_Handle (Display);  
                Root     := None_X_Window;  
                Parent   := None_X_Window;  
                Children := None_X_Window_List;  
                Status   := Failed;  
                return;  
            end if;

----Return our new information.

            declare  
                Chillin : X_Window_List;  
            begin  
                N_Chillin := S_Natural (Rep.Query_Tree.N_Children);  
                Parent    := Rep.Query_Tree.Parent;  
                Root      := Rep.Query_Tree.Root;  
                Status    := Successful;  
                begin  
                    Chillin := new X_Window_Array (1 .. N_Chillin);  
                exception  
                    when others =>  
                        Eat_Raw_Data (Display, N_Chillin * (X_Window'Size / 8));  
                        raise;  
                end;

----Convert the children list and return it on the heap.  Yes, the subtype
--  is crucial.  If you remove it then your code will look correct but it will
--  not work; magic memory type layout, yuck.

                if N_Chillin /= 0 then  
                    Get_X_Window_Array (Display, Chillin.all);  
                end if;  
                Children := Chillin;  
            exception  
                when others =>  
                    Free_X_Window_List (Chillin);  
                    raise;  
            end;
----Catch unexpected exceptions.

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

----Normal return.

        Unlock_Display (Display);  
        Sync_Handle (Display);

    end X_Query_Tree;

--\f

    procedure X_Translate_Coordinates (Display       :     X_Display;  
                                       Source        :     X_Window;  
                                       Destination   :     X_Window;  
                                       Source_X      :     S_Short;  
                                       Source_Y      :     S_Short;  
                                       Destination_X : out S_Short;  
                                       Destination_Y : out S_Short;  
                                       Child         : out X_Window;  
                                       Same_Screen   : out Boolean) is
------------------------------------------------------------------------------
-- X_Translate_Coordinates
------------------------------------------------------------------------------
        Rep  : X_Reply_Contents;  
        Succ : X_Status;  
    begin

----Lock the display.

        Lock_Display (Display);  
        begin

----Send the request.

            Put_X_Translate_Coords_Request  
               (Display, (Kind       => Translate_Coords,  
                          Length     => X_Translate_Coords_Request'Size / 32,  
                          Pad        => 0,  
                          Src_Window => Source,  
                          Dst_Window => Destination,  
                          Src_X      => Source_X,  
                          Src_Y      => Source_Y));

----Read the reply.

            Get_Reply (Display => Display,  
                       Code    => Translate_Coords,  
                       Reply   => Rep,  
                       Extra   => 0,  
                       Discard => True,  
                       Status  => Succ);

----If we failed then return all 0's.

            if Succ = Failed then  
                Destination_X := 0;  
                Destination_Y := 0;  
                Child         := None_X_Window;  
                Same_Screen   := False;

----Return our results.

            else  
                Child         := Rep.Translate_Coords.Child;  
                Destination_X := Rep.Translate_Coords.Dst_X;  
                Destination_Y := Rep.Translate_Coords.Dst_Y;  
                Same_Screen   := To_Boolean (Rep.Translate_Coords.Same_Screen);  
            end if;

----Catch unexpected exceptions.

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

----Unlock; sync; and return.

        Unlock_Display (Display);  
        Sync_Handle (Display);

    end X_Translate_Coordinates;

--\f

end Xlbp_Window_Information;