⟦95c09a938⟧

TextFile

--/ if R1000 then
with Debug_Tools;
--/ end if;

with Text_Io;

with Xlbt_Arithmetic;  
use Xlbt_Arithmetic;  
with Xlbt_Basic;  
use Xlbt_Basic;  
with Xlbt_Event;  
use Xlbt_Event;  
with Xlbt_Event2;  
use Xlbt_Event2;  
with Xlbt_Geometry;  
use Xlbt_Geometry;  
with Xlbt_Hint;  
use Xlbt_Hint;  
with Xlbt_Key;  
use Xlbt_Key;  
with Xlbt_Keyboard;  
use Xlbt_Keyboard;  
with Xlbt_Misc;  
use Xlbt_Misc;  
with Xlbt_Pointer;  
use Xlbt_Pointer;  
with Xlbt_String;  
use Xlbt_String;  
with Xlbt_Visual;  
use Xlbt_Visual;  
with Xlbt_Window;  
use Xlbt_Window;

with Xlbp_Atom;  
use Xlbp_Atom;  
with Xlbp_Display;  
use Xlbp_Display;  
with Xlbp_Event;  
use Xlbp_Event;  
with Xlbp_Geometry;  
use Xlbp_Geometry;  
with Xlbp_Hint;  
use Xlbp_Hint;  
with Xlbp_Key;  
use Xlbp_Key;  
with Xlbp_Sync;  
use Xlbp_Sync;  
with Xlbp_Window;  
use Xlbp_Window;

with Xlbmp_Error_Log;  
use Xlbmp_Error_Log;

package body Xev_Main is

--
-- xev - event diagnostics
--
-- $XConsortium: xev.c,v 1.8 88/10/09 15:44:28 rws Exp $
--
-- Copyright 1988 Massachusetts Institute of Technology
--
-- 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 appear in all copies and that both that
-- copyright notice and this permission notice appear in supporting
-- documentation, and that the name of M.I.T. not be used in advertising or
-- publicity pertaining to distribution of the software without specific,
-- written prior permission.  M.I.T. makes no representations about the
-- suitability of this software for any purpose.  It is provided "as is"
-- without express or implied warranty.
--
-- Author:  Jim Fulton, MIT X Consortium


    Inner_Window_Width      : constant := 50;  
    Inner_Window_Height     : constant := 50;  
    Inner_Window_Border     : constant := 4;  
    Inner_Window_X          : constant := 10;  
    Inner_Window_Y          : constant := 10;  
    Outer_Window_Min_Width  : constant :=  
       (Inner_Window_Width + 2 * (Inner_Window_Border + Inner_Window_X));  
    Outer_Window_Min_Height : constant :=  
       (Inner_Window_Height + 2 * (Inner_Window_Border + Inner_Window_Y));  
    Outer_Window_Def_Width  : constant := (Outer_Window_Min_Width + 100);  
    Outer_Window_Def_Height : constant := (Outer_Window_Min_Height + 100);  
    Outer_Window_Def_X      : constant := 100;  
    Outer_Window_Def_Y      : constant := 100;


    Yes     : constant String := "YES";  
    No      : constant String := "NO";  
    Unknown : constant String := "unknown";

    Dpy    : X_Display;  
    Screen : S_Long;

    subtype X_Keyboard_As_Bits_Index is S_Natural range 8 .. 32 * 8 - 1;

--\f

    function Capitalize (Sin : String) return String is
        ----Capitalize the input string.  Each "word" in the string is
        --  capitalized.  The first letter is upper-case and the rest is lower.
        Sout : String (Sin'Range);  
        Sini : Natural := Sin'First;  
    begin  
        loop  
            if Sini > Sin'Last then  
                return Sout;  
            end if;  
            loop  
                if Sin (Sini) in 'a' .. 'z' then
                    ----Upper-case the first letter in a word.
                    Sout (Sini) := Character'Val (Character'Pos (Sin (Sini)) -  
                                                  (Character'Pos ('a') -  
                                                   Character'Pos ('A')));  
                    Sini        := Sini + 1;  
                    exit;  
                elsif Sin (Sini) in 'A' .. 'Z' or else  
                      Sin (Sini) in '0' .. '9' then  
                    Sout (Sini) := Sin (Sini);  
                    Sini        := Sini + 1;  
                    exit;  
                else  
                    Sout (Sini) := Sin (Sini);  
                    Sini        := Sini + 1;  
                    if Sini > Sin'Last then  
                        return Sout;  
                    end if;  
                end if;  
            end loop;  
            if Sini > Sin'Last then  
                return Sout;  
            end if;  
            loop  
                if Sin (Sini) in 'A' .. 'Z' then
                    ----Lower-case the rest of the word.
                    Sout (Sini) := Character'Val (Character'Pos (Sin (Sini)) -  
                                                  (Character'Pos ('A') -  
                                                   Character'Pos ('a')));  
                    Sini        := Sini + 1;  
                    if Sini > Sin'Last then  
                        return Sout;  
                    end if;  
                elsif Sin (Sini) in 'a' .. 'z' or else  
                      Sin (Sini) in '0' .. '9' then
                    ----Lower-case the rest of the word.
                    Sout (Sini) := Sin (Sini);  
                    Sini        := Sini + 1;  
                    if Sini > Sin'Last then  
                        return Sout;  
                    end if;  
                else
                    ----New word begins.
                    Sout (Sini) := Sin (Sini);  
                    Sini        := Sini + 1;  
                    exit;  
                end if;  
            end loop;  
        end loop;  
    end Capitalize;

--\f

    procedure Put (A : X_Atom) is  
    begin  
        S_Long_Io.Put (A.Number, Base => 10, Width => 0);  
        Text_Io.Put ('/');  
        S_Long_Io.Put (A.Number, Base => 16, Width => 0);  
    end Put;

    procedure Put (B : Boolean) is  
    begin  
        Text_Io.Put (Capitalize (Boolean'Image (B)));  
    end Put;

    procedure Put (B : X_Boolean_Char) is  
    begin  
        Text_Io.Put (Capitalize (X_Boolean_Char'Image (B)));  
    exception  
        when Constraint_Error =>  
            S_Long_Io.Put (S_Long (X_Boolean_Char'Pos (B)));  
            Text_Io.Put ("(!!)");  
    end Put;

    procedure Put (B : X_Boolean_Long) is  
    begin  
        Text_Io.Put (Capitalize (X_Boolean_Long'Image (B)));  
    exception  
        when Constraint_Error =>  
            S_Long_Io.Put (S_Long (X_Boolean_Long'Pos (B)));  
            Text_Io.Put ("(!!)");  
    end Put;

    procedure Put (B : X_Button_Name) is  
    begin  
        Text_Io.Put (Capitalize (X_Button_Name'Image (B)));  
    exception  
        when Constraint_Error =>  
            S_Long_Io.Put (S_Long (X_Button_Name'Pos (B)));  
            Text_Io.Put ("(!!)");  
    end Put;

    procedure Put (B : X_Circulate_Place) is  
    begin  
        Text_Io.Put (Capitalize (X_Circulate_Place'Image (B)));  
    exception  
        when Constraint_Error =>  
            S_Long_Io.Put (S_Long (X_Circulate_Place'Pos (B)));  
            Text_Io.Put ("(!!)");  
    end Put;

    procedure Put (C : X_Colormap) is  
    begin  
        S_Long_Io.Put (C.Id.Number, Base => 16);  
    end Put;

    procedure Put (B : X_Colormap_State) is  
    begin  
        Text_Io.Put (Capitalize (X_Colormap_State'Image (B)));  
    exception  
        when Constraint_Error =>  
            S_Long_Io.Put (S_Long (X_Colormap_State'Pos (B)));  
            Text_Io.Put ("(!!)");  
    end Put;

    procedure Put (D : X_Drawable) is  
    begin  
        S_Long_Io.Put (D.Id.Number, Base => 16);  
    end Put;

    procedure Put (B : X_Enter_Leave_Detail) is  
    begin  
        Text_Io.Put (Capitalize (X_Enter_Leave_Detail'Image (B)));  
    exception  
        when Constraint_Error =>  
            S_Long_Io.Put (S_Long (X_Enter_Leave_Detail'Pos (B)));  
            Text_Io.Put ("(!!)");  
    end Put;

    procedure Put (B : X_Enter_Leave_Mode) is  
    begin  
        Text_Io.Put (Capitalize (X_Enter_Leave_Mode'Image (B)));  
    exception  
        when Constraint_Error =>  
            S_Long_Io.Put (S_Long (X_Enter_Leave_Mode'Pos (B)));  
            Text_Io.Put ("(!!)");  
    end Put;

    procedure Put (B : X_Focus_Detail) is  
    begin  
        Text_Io.Put (Capitalize (X_Focus_Detail'Image (B)));  
    exception  
        when Constraint_Error =>  
            S_Long_Io.Put (S_Long (X_Focus_Detail'Pos (B)));  
            Text_Io.Put ("(!!)");  
    end Put;

    procedure Put (B : X_Focus_Mode) is  
    begin  
        Text_Io.Put (Capitalize (X_Focus_Mode'Image (B)));  
    exception  
        when Constraint_Error =>  
            S_Long_Io.Put (S_Long (X_Focus_Mode'Pos (B)));  
            Text_Io.Put ("(!!)");  
    end Put;

    procedure Put (K : X_Key_Code) is  
    begin  
        S_Long_Io.Put (S_Long (K), Width => 0);  
    end Put;

    procedure Put (K : X_Key_Sym) is  
    begin  
        S_Long_Io.Put (S_Long (K), Base => 16, Width => 0);  
    end Put;


    procedure Put (B : X_Mapping_Request_Type) is  
    begin  
        Text_Io.Put (Capitalize (X_Mapping_Request_Type'Image (B)));  
    exception  
        when Constraint_Error =>  
            S_Long_Io.Put (S_Long (X_Mapping_Request_Type'Pos (B)), Width => 0);  
            Text_Io.Put ("(!!)");  
    end Put;

    procedure Put (B : X_Motion_Notify_Detail) is  
    begin  
        Text_Io.Put (Capitalize (X_Motion_Notify_Detail'Image (B)));  
    exception  
        when Constraint_Error =>  
            S_Long_Io.Put (S_Long (X_Motion_Notify_Detail'Pos (B)), Width => 0);  
            Text_Io.Put ("(!!)");  
    end Put;

    procedure Put (B : X_Property_State) is  
    begin  
        Text_Io.Put (Capitalize (X_Property_State'Image (B)));  
    exception  
        when Constraint_Error =>  
            S_Long_Io.Put (S_Long (X_Property_State'Pos (B)), Width => 0);  
            Text_Io.Put ("(!!)");  
    end Put;

    procedure Put (B : X_Visibility_Notify_State) is  
    begin  
        Text_Io.Put (Capitalize (X_Visibility_Notify_State'Image (B)));  
    exception  
        when Constraint_Error =>  
            S_Long_Io.Put  
               (S_Long (X_Visibility_Notify_State'Pos (B)), Width => 0);  
            Text_Io.Put ("(!!)");  
    end Put;

    procedure Put (B : X_Window_Stacking) is  
    begin  
        Text_Io.Put (Capitalize (X_Window_Stacking'Image (B)));  
    exception  
        when Constraint_Error =>  
            S_Long_Io.Put (S_Long (X_Window_Stacking'Pos (B)), Width => 0);  
            Text_Io.Put ("(!!)");  
    end Put;

    procedure Put (S : in out X_String_Pointer) is  
    begin  
        if S = null then  
            Text_Io.Put (Unknown);  
        else  
            Text_Io.Put (To_String (S.all));  
            Free_X_String_Pointer (S);  
        end if;  
    end Put;

    procedure Put (T : X_Time) is  
    begin  
        S_Long_Io.Put (S_Long (T), Base => 16, Width => 0);  
    end Put;

    procedure Put (W : X_Window) is  
    begin  
        S_Long_Io.Put (W.Drawable.Id.Number, Base => 16, Width => 0);  
    end Put;

--\f

    procedure Put (S : S_Short) is  
    begin  
        S_Long_Io.Put (S_Long (S), Width => 0);  
    end Put;

    procedure Put (S : S_Char) is  
    begin  
        S_Long_Io.Put (S_Long (S), Width => 0);  
    end Put;

    procedure Put (U : U_Short) is  
    begin  
        S_Long_Io.Put (S_Long (U), Width => 0);  
    end Put;

    procedure Put (U : U_Char) is  
    begin  
        S_Long_Io.Put (S_Long (U), Width => 0);  
    end Put;

--\f

    generic  
        type Index_Type is (<>);  
        type Array_Type is array (Index_Type) of Boolean;  
        Prefix  : in String;  
        Postfix : in String;  
    procedure Generic_Put (Mask : Array_Type);

    procedure Generic_Put (Mask : Array_Type) is  
        First : Boolean := True;  
    begin  
        Text_Io.Put ('(');  
        for I in Mask'Range loop  
            if Mask (I) then  
                if not First then  
                    Text_Io.Put (',');  
                else  
                    First := False;  
                end if;  
                declare  
                    Name : constant String := Capitalize (Index_Type'Image (I));  
                    Name1 : Natural := Name'First;  
                    Name2 : Natural := Name'Last;  
                begin  
                    if Prefix /= "" and then  
                       Name'Length >= Prefix'Length and then  
                       Name (Name'First .. Name'First - 1 + Prefix'Length) =  
                          Prefix then  
                        Name1 := Name1 + Prefix'Length;  
                    end if;  
                    if Postfix /= "" and then  
                       Name (Name'Last - 4 .. Name'Last) = Postfix then  
                        Name2 := Name2 - Postfix'Length;  
                    end if;  
                    Text_Io.Put (Name (Name1 .. Name2));  
                end;  
            end if;  
        end loop;  
        Text_Io.Put (')');  
    end Generic_Put;

    procedure Put is new Generic_Put (X_Enter_Leave_Flags_Index,  
                                      X_Enter_Leave_Flags,  
                                      "Enter_Leave_",  
                                      "");


    procedure Put is new Generic_Put (X_Key_Button_Mask_Index,  
                                      X_Key_Button_Mask,  
                                      "",  
                                      "_Mask");

    procedure Put (Mask : X_Keyboard_As_Bits_Short) is separate;

    procedure Put is new Generic_Put (X_Window_Changes_Mask_Index,  
                                      X_Window_Changes_Mask,  
                                      "Cw_",  
                                      "");

--\f

    procedure Prologue (E : X_Event; Event_Name : String) is separate;

--\f

    procedure Do_Keypress (E : X_Event) is separate;

--\f

    procedure Do_Keyrelease (E : X_Key_Release_Event) is separate;

--\f

    procedure Do_Buttonpress (E : X_Event) is separate;

--\f

    procedure Do_Buttonrelease (E : X_Button_Release_Event) is separate;

--\f

    procedure Do_Motionnotify (E : X_Motion_Notify_Event) is separate;

--\f

    procedure Do_Enternotify (E : X_Event) is separate;

--\f

    procedure Do_Leavenotify (E : X_Leave_Notify_Event) is separate;

--\f

    procedure Do_Focusin (E : X_Event) is separate;

--\f

    procedure Do_Focusout (E : X_Focus_Out_Event) is separate;

--\f

    procedure Do_Keymapnotify (E : X_Keymap_Notify_Event) is separate;

--\f

    procedure Do_Expose (E : X_Expose_Event) is separate;

--\f

    procedure Do_Graphicsexpose (E : X_Graphics_Expose_Event) is separate;

--\f

    procedure Do_Noexpose (E : X_No_Expose_Event) is separate;

--\f

    procedure Do_Visibilitynotify (E : X_Visibility_Notify_Event) is  
                 separate;

--\f

    procedure Do_Createnotify (E : X_Create_Notify_Event) is separate;

--\f

    procedure Do_Destroynotify (E : X_Destroy_Notify_Event) is separate;

--\f

    procedure Do_Unmapnotify (E : X_Unmap_Notify_Event) is separate;

--\f

    procedure Do_Mapnotify (E : X_Map_Notify_Event) is separate;

--\f

    procedure Do_Maprequest (E : X_Map_Request_Event) is separate;

--\f

    procedure Do_Reparentnotify (E : X_Reparent_Notify_Event) is separate;

--\f

    procedure Do_Configurenotify (E : X_Configure_Notify_Event) is separate;

--\f

    procedure Do_Configurerequest (E : X_Configure_Request_Event) is  
                 separate;

--\f

    procedure Do_Gravitynotify (E : X_Gravity_Notify_Event) is separate;

--\f

    procedure Do_Resizerequest (E : X_Resize_Request_Event) is separate;

--\f

    procedure Do_Circulatenotify (E : X_Circulate_Notify_Event) is separate;

--\f

    procedure Do_Circulaterequest (E : X_Circulate_Request_Event) is  
                 separate;

--\f

    procedure Do_Propertynotify (E : X_Property_Notify_Event) is separate;

--\f

    procedure Do_Selectionclear (E : X_Selection_Clear_Event) is separate;

--\f

    procedure Do_Selectionrequest (E : X_Selection_Request_Event) is  
                 separate;

--\f

    procedure Do_Selectionnotify (E : X_Selection_Notify_Event) is separate;

--\f

    procedure Do_Colormapnotify (E : X_Colormap_Notify_Event) is separate;

--\f

    procedure Do_Clientmessage (E : X_Client_Message_Event) is separate;

--\f

    procedure Do_Mappingnotify (E : X_Mapping_Notify_Event) is separate;

--\f

    procedure Set_Sizehints (Hintp      : in out X_Size_Hints;  
                             Min_Width  :        S_Long;  
                             Min_Height :        S_Long;  
                             Defwidth   :        S_Long;  
                             Defheight  :        S_Long;  
                             Defx       :        S_Long;  
                             Defy       :        S_Long;  
                             Geom       :        X_String) is separate;

--\f

    procedure Main (Display       : X_String             := "";  
                    Geometry      : X_String             := "";  
                    Backing_Store : X_Backing_Store_Hint := Not_Useful;  
                    Save_Under    : Boolean              := False;  
                    Border_Width  : U_Short              := 2;  
                    Sync          : Boolean              := False) is separate;

--\f

end Xev_Main;
DataMuseum.dk

Rational R1000/400 Tapes

⟦95c09a938⟧ TextFile

Derivation

TextFile
