PreviousUpNext

15.4.1654  src/lib/x-kit/xclient/src/window/window.pkg

## window.pkg
#
# See also:
#     src/lib/x-kit/xclient/src/window/ro-pixmap-old.pkg
#     src/lib/x-kit/xclient/src/window/cs-pixmap-old.pkg
#     src/lib/x-kit/xclient/src/window/rw-pixmap-old.pkg

# Compiled by:
#     src/lib/x-kit/xclient/xclient-internals.sublib


###                 "The first rule of discovery is to have brains and good luck.
###                  The second rule of discovery is to sit tight and wait till you get a bright idea."
###
###                                                     -- Geore Polya



stipulate
    include package   threadkit;                        # threadkit                             is from   src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit.pkg
    #
    package e2s =  xerror_to_string;                    # xerror_to_string                      is from   src/lib/x-kit/xclient/src/to-string/xerror-to-string.pkg
    package g2d =  geometry2d;                          # geometry2d                            is from   src/lib/std/2d/geometry2d.pkg
    package s2w =  sendevent_to_wire;                   # sendevent_to_wire                     is from   src/lib/x-kit/xclient/src/wire/sendevent-to-wire.pkg
    package sa  =  standard_x11_atoms;                  # standard_x11_atoms                    is from   src/lib/x-kit/xclient/src/iccc/standard-x11-atoms.pkg
    package v2w =  value_to_wire;                       # value_to_wire                         is from   src/lib/x-kit/xclient/src/wire/value-to-wire.pkg
    package w2v =  wire_to_value;                       # wire_to_value                         is from   src/lib/x-kit/xclient/src/wire/wire-to-value.pkg
    package xt  =  xtypes;                              # xtypes                                is from   src/lib/x-kit/xclient/src/wire/xtypes.pkg
    package xtr =  xlogger;                             # xlogger                               is from   src/lib/x-kit/xclient/src/stuff/xlogger.pkg
    package xet =  xevent_types;                        # xevent_types                          is from   src/lib/x-kit/xclient/src/wire/xevent-types.pkg
    #
    package at  =  atom;                                # atom                                  is from   src/lib/x-kit/xclient/src/iccc/atom.pkg
    package cs  =  cursors;                             # cursors                               is from   src/lib/x-kit/xclient/src/window/cursors.pkg
    package di  =  xserver_ximp;                        # xserver_ximp                          is from   src/lib/x-kit/xclient/src/window/xserver-ximp.pkg
    package w2x =  windowsystem_to_xserver;             # windowsystem_to_xserver               is from   src/lib/x-kit/xclient/src/window/windowsystem-to-xserver.pkg
#   package dt  =  draw_types;                          # draw_types                            is from   src/lib/x-kit/xclient/src/window/draw-types.pkg
    package dy  =  display;                             # display                               is from   src/lib/x-kit/xclient/src/wire/display.pkg
    package ip  =  iccc_property;                       # iccc_property                         is from   src/lib/x-kit/xclient/src/iccc/iccc-property.pkg
    package sn  =  xsession_junk;                       # xsession_junk                         is from   src/lib/x-kit/xclient/src/window/xsession-junk.pkg
    package s2t =  xevent_router_ximp;                  # xevent_router_ximp                    is from   src/lib/x-kit/xclient/src/window/xevent-router-ximp.pkg
#   package ewp =  windowsystem_to_xevent_router;       # windowsystem_to_xevent_router         is from   src/lib/x-kit/xclient/src/window/windowsystem-to-xevent-router.pkg
#   package wr  =  xevent_to_widget_ximp;               # xevent_to_widget_ximp                 is from   src/lib/x-kit/xclient/src/window/xevent-to-widget-ximp.pkg
    package x2s =  xclient_to_sequencer;                # xclient_to_sequencer                  is from   src/lib/x-kit/xclient/src/wire/xclient-to-sequencer.pkg
    #
    trace =  xtr::log_if  xtr::io_logging  0;           # Conditionally write strings to tracing.log or whatever.
        #
        # To debug via tracelogging, near startup to
        #
        #   enable xtr::io_logging;
        #
        # and then annotate the code with lines like
        #
        #   trace {. sprintf "foo/top: bar d=%d" bar; };
        #
herein


    package   window
    : (weak)  Window                                    # Window                        is from   src/lib/x-kit/xclient/src/window/window.api
    {
#       Window = dt::Window;

        # Set the value of a property:
        #
        fun set_property (x: sn::Xsession, window_id, name, value)
            =
            x.windowsystem_to_xserver.xclient_to_sequencer.send_xrequest
                #
                (v2w::encode_change_property
                  {
                    window_id,
                    name,
                    property =>  value,
                    mode     =>  xt::REPLACE_PROPERTY
                  }
                );

        # User-level window attributes:
        #
        package a {

            Window_Attribute
              #
              = BACKGROUND_NONE
              | BACKGROUND_PARENT_RELATIVE
              | BACKGROUND_RW_PIXMAP          sn::Rw_Pixmap
              | BACKGROUND_RO_PIXMAP          sn::Ro_Pixmap
              | BACKGROUND_COLOR              rgb::Rgb
              #
              | BORDER_COPY_FROM_PARENT
              | BORDER_RW_PIXMAP              sn::Rw_Pixmap
              | BORDER_RO_PIXMAP              sn::Ro_Pixmap
              | BORDER_COLOR                  rgb::Rgb
              #
              | BIT_GRAVITY                   xt::Gravity
              | WINDOW_GRAVITY                xt::Gravity
              #
              | CURSOR_NONE
              | CURSOR                        cs::Xcursor
              ;
        };

        # Window configuration values:
        #
        package c {

            Window_Config
              #
              = ORIGIN      g2d::Point
              | SIZE        g2d::Size
              | BORDER_WID  Int
              | STACK_MODE                   xt::Stack_Mode
              | REL_STACK_MODE  (sn::Window, xt::Stack_Mode)
              ;
        };

        # Extract the Rgb8 from a color:
        #
        fun rgb8_of rgb
            =
            rgb8::rgb8_from_rgb rgb;

        # Map user-level window attributes
        # to internal x-window attributes: 
        #
        fun user_window_attribute_to_internal_window_attribute (a::BACKGROUND_NONE)
                =>
                xt::a::BACKGROUND_PIXMAP_NONE;

            user_window_attribute_to_internal_window_attribute (a::BACKGROUND_PARENT_RELATIVE)
                =>
                xt::a::BACKGROUND_PIXMAP_PARENT_RELATIVE;

            user_window_attribute_to_internal_window_attribute (a::BACKGROUND_RW_PIXMAP ({ pixmap_id, ... }: sn::Rw_Pixmap))
                =>
                xt::a::BACKGROUND_PIXMAP pixmap_id;

            user_window_attribute_to_internal_window_attribute (a::BACKGROUND_RO_PIXMAP (sn::RO_PIXMAP ({ pixmap_id, ... }: sn::Rw_Pixmap))) 
               => 
                xt::a::BACKGROUND_PIXMAP pixmap_id;

            user_window_attribute_to_internal_window_attribute (a::BACKGROUND_COLOR color)
                =>
                xt::a::BACKGROUND_PIXEL (rgb8_of color);

            user_window_attribute_to_internal_window_attribute (a::BORDER_COPY_FROM_PARENT)
                =>
                xt::a::BORDER_PIXMAP_COPY_FROM_PARENT;

            user_window_attribute_to_internal_window_attribute (a::BORDER_RW_PIXMAP ({ pixmap_id, ... }: sn::Rw_Pixmap))
                =>
                xt::a::BORDER_PIXMAP pixmap_id;

            user_window_attribute_to_internal_window_attribute (a::BORDER_RO_PIXMAP (sn::RO_PIXMAP ({ pixmap_id, ... }: sn::Rw_Pixmap)))
                =>
                xt::a::BORDER_PIXMAP pixmap_id;

            user_window_attribute_to_internal_window_attribute (a::BORDER_COLOR color)
                =>
                xt::a::BORDER_PIXEL (rgb8_of color);

            user_window_attribute_to_internal_window_attribute (a::BIT_GRAVITY g)
                =>
                xt::a::BIT_GRAVITY g;

            user_window_attribute_to_internal_window_attribute (a::WINDOW_GRAVITY g)
                =>
                xt::a::WINDOW_GRAVITY g;

            user_window_attribute_to_internal_window_attribute (a::CURSOR_NONE)
                =>
                xt::a::CURSOR_NONE;

            user_window_attribute_to_internal_window_attribute (a::CURSOR (cs::XCURSOR { id, ... } ))
                =>
                xt::a::CURSOR id;
        end;


        map_attributes
            =
            list::map  user_window_attribute_to_internal_window_attribute;

        standard_xevent_mask
            =
            xet::mask_of_xevent_list
              [
                xet::n::KEY_PRESS,
                xet::n::KEY_RELEASE,
                xet::n::BUTTON_PRESS,
                xet::n::BUTTON_RELEASE,
                xet::n::POINTER_MOTION,
                xet::n::ENTER_WINDOW,
                xet::n::LEAVE_WINDOW,
                xet::n::EXPOSURE,
                xet::n::STRUCTURE_NOTIFY,
                xet::n::SUBSTRUCTURE_NOTIFY,
                xet::n::PROPERTY_CHANGE
              ];

        popup_xevent_mask
            =
            xet::mask_of_xevent_list
              [
                xet::n::EXPOSURE,
                xet::n::STRUCTURE_NOTIFY,
                xet::n::SUBSTRUCTURE_NOTIFY
              ];

        exception BAD_WINDOW_SITE;

        fun check_site g
            =
            if (g2d::valid_site g)   g;
            else                   raise exception  BAD_WINDOW_SITE;
            fi;

        # Create a new X-window with the given xid 
        #
        fun create_window   (x: sn::Xsession)
            {
              window_id:        xt::Window_Id,
              parent_window_id: xt::Window_Id,
              visual_id:        xt::Visual_Id_Choice,
              # 
              io_class:         xt::Io_Class,
              depth:            Int,
              site:             g2d::Window_Site,
              attributes:       List( xt::a::Window_Attribute )
            }
            =
            x.windowsystem_to_xserver.xclient_to_sequencer.send_xrequest    msg
            where 
                msg =   v2w::encode_create_window                                                                       # value_to_wire         is from   src/lib/x-kit/xclient/src/wire/value-to-wire.pkg
                          {                                                                                             # value_to_wire_pith    is from   src/lib/x-kit/xclient/src/wire/value-to-wire-pith.pkg
                            window_id,
                            parent_window_id,
                            visual_id,
                            io_class,
                            depth,
                            site,
                            attributes
                          };
            end;




#       fun map_window  xsocket  window_id                                                                              # This was in window-io.pkg (phased out), but apparently is never used:
#           =                                                                                                           #
#           xok::send_xrequest  xsocket  (v2w::encode_map_window { window_id } );                                       # This functionality is replicated in    src/lib/x-kit/widget/xkit/app/guishim-imp-for-x.pkg


        fun change_window_attributes'  (windowsystem_to_xserver: w2x::Windowsystem_To_Xserver)  (window_id, attributes)
            =
            {   windowsystem_to_xserver.xclient_to_sequencer.send_xrequest
                      #
                      (v2w::encode_change_window_attributes  { window_id, attributes });
 
#               xok::flush_xsocket  xsocket;
            };


#       fun make_simple_top_window (screen as  { screen_info, xsession }: sn::Screen )
#           =
#           create_fn
#           where 
#               screen_info               ->  sn::SCREEN_INFO           { xscreen  => { root_window_id, ... }: dy::Xscreen, rootwindow_per_depth_imps, ... };
#               rootwindow_per_depth_imps ->  { depth, ... }: sn::Per_Depth_Imps;
#               xsession                  ->    { xdisplay => { xsocket, next_xid, ... }: dy::Xdisplay, ... }: sn::Xsession;
#
#               window_id = next_xid ();
#
#
#               fun create_fn { site, border_color, background_color }
#                   =
#                   {
#                       my (kidplug, window, wm_window_delete_slot)
#                           =
#                           wr::make_hostwindow_to_widget_router
#                               #
#                               (screen, rootwindow_per_depth_imps, window_id, site);
#
#                       create_window  xsocket
#                         {
#                           depth,
#                           #
#                           window_id,
#                           parent_window_id   => root_window_id,
#                           #
#                           io_class    => xt::INPUT_OUTPUT,
#                           visual_id   => xt::SAME_VISUAL_AS_PARENT,
#                           #
#                           site        => check_site site,
#                           #
#                           attributes
#                               =>
#                               [ xt::a::BORDER_PIXEL     (rgb8_of  border_color),
#                                 xt::a::BACKGROUND_PIXEL  background_color,
#                                 xt::a::EVENT_MASK        standard_xevent_mask
#                               ]
#                         };
#
#                       (window, kidplug, wm_window_delete_slot);
#                   };
#           end;
#
#       fun make_simple_subwindow ({ window_id=>parent_window_id, screen, to_hostwindow_drawimp, per_depth_imps, ... }: sn::Window )
#           =
#           create_fn
#           where 
#
#               screen ->   { xsession=>{ xdisplay => { xsocket, next_xid, ... }: dy::Xdisplay, ... }: sn::Xsession, ... }: sn::Screen;
#
#               window_id = next_xid ();
#
#               window    =  { window_id,
#                               screen,
#                               to_hostwindow_drawimp,
#                               per_depth_imps
#                            }: sn::Window;
#
#               per_depth_imps ->   { depth, ... }: sn::Per_Depth_Imps;
#
#               fun create_fn { site, border_color, background_color }
#                   =
#                   {   border_pixel
#                           =
#                           case border_color
#                               #
#                               NULL  =>   xt::a::BORDER_PIXMAP_COPY_FROM_PARENT;
#                               THE c =>   xt::a::BORDER_PIXEL (rgb8_of c);
#                           esac;
#
#
#                       background_pixel
#                           =
#                           case background_color
#                               #
#                               NULL  =>   xt::a::BACKGROUND_PIXMAP_PARENT_RELATIVE;
#                               THE c =>   xt::a::BACKGROUND_PIXEL c;
#                           esac;
#
#
#                         create_window   xsocket
#                            {
#                             window_id,
#                             parent_window_id,
#                             # 
#                             io_class   => xt::INPUT_OUTPUT,
#                             depth,
#                             # 
#                             visual_id  => xt::SAME_VISUAL_AS_PARENT,
#                             site       => check_site  site,
#                             # 
#                             attributes => [
#                                 border_pixel,
#                                 background_pixel,
#                                 xt::a::EVENT_MASK standard_xevent_mask
#                               ]
#                           };
#
#                         window;
#                   };
#           end;
#
#
#       # Create a simple popup window.
#       #
#       # These are simple windows used for menus
#       # and tooltips and such;  they are neither
#       # registered with nor decorated by the
#       # window manager.  
#       #
#       # Compare with the plain and transient
#       # windows provided by the hostwindow package:
#       #
#       #     src/lib/x-kit/widget/old/basic/hostwindow.pkg
#       #
#       fun make_simple_popup_window
#               (screen as  { screen_info, xsession }: sn::Screen )
#               { site, border_color, background_color }
#           =
#           (window, kidplug)
#           where 
#               screen_info               ->  sn::SCREEN_INFO { xscreen => { root_window_id, ... }: dy::Xscreen, rootwindow_per_depth_imps, ... };
#               rootwindow_per_depth_imps ->  { depth, ... }: sn::Per_Depth_Imps;
#               xsession                  ->  { xdisplay => { xsocket, next_xid, ... }: dy::Xdisplay, ... }: sn::Xsession;
#
#               window_id = next_xid();
#
#               my (kidplug, window, wm_window_delete_slot)
#                   =
#                   wr::make_hostwindow_to_widget_router (screen, rootwindow_per_depth_imps, window_id, site);
#
#               create_window  xsocket
#                  {
#                   window_id,
#                   parent_window_id  => root_window_id,
#                   #
#                   io_class   => xt::INPUT_OUTPUT,
#                   depth,
#                   #
#                   visual_id  => xt::SAME_VISUAL_AS_PARENT,
#                   site       => check_site  site,
#                   #
#                   attributes => [
#                       xt::a::OVERRIDE_REDIRECT TRUE,
#                       xt::a::SAVE_UNDER TRUE,
#                       xt::a::BORDER_PIXEL      (rgb8_of  border_color),
#                       xt::a::BACKGROUND_PIXEL  background_color,
#                       xt::a::EVENT_MASK        popup_xevent_mask
#                     ]
#                 };
#           end;
#
#       # Create a simple transient window:
#       #
#       fun make_transient_window prop_window { site, border_color, background_color }
#           =
#           (window, kidplug)
#           where 
#
#               prop_window                  ->  { window_id=>id, screen=>screen as  { screen_info, xsession }: sn::Screen, ... }: sn::Window;
#               screen_info                  ->  sn::SCREEN_INFO { xscreen => { root_window_id, ... }: dy::Xscreen, rootwindow_per_depth_imps, ... };
#
#               rootwindow_per_depth_imps ->  { depth, ... }: sn::Per_Depth_Imps;
#               xsession                     ->  { xdisplay => { xsocket, next_xid, ... }: dy::Xdisplay, ... }: sn::Xsession;
#
#               window_id = next_xid();
#
#               my (kidplug, window, wm_window_delete_slot)
#                   =
#                   wr::make_hostwindow_to_widget_router (screen, rootwindow_per_depth_imps, window_id, site);
#
#               create_window  xsocket
#                  {
#                   window_id,
#                   parent_window_id  => root_window_id,
#                   #
#                   io_class   => xt::INPUT_OUTPUT,
#                   depth,
#                   #
#                   visual_id  => xt::SAME_VISUAL_AS_PARENT,
#                   site       => check_site  site,
#                   #
#                   attributes => [
#                       xt::a::BORDER_PIXEL     (rgb8_of  border_color),
#                       xt::a::BACKGROUND_PIXEL background_color,
#                       xt::a::EVENT_MASK       standard_xevent_mask
#                     ]
#               };
#
#               set_property (xsession, window_id, sa::wm_transient_for, ip::make_transient_hint prop_window);
#
#           end;

        exception OP_UNSUPPORTED_ON_INPUT_ONLY_WINDOWS;

#       fun make_input_only_window  window  ({ col, row, wide, high } )
#           =
#           window
#           where  
#
#               window ->   { window_id=>parent_window_id, screen, per_depth_imps, to_hostwindow_drawimp, ... }: sn::Window;
#               screen ->    { xsession=>{ xdisplay => { xsocket, next_xid, ... }: dy::Xdisplay, ... }: sn::Xsession, ... }: sn::Screen;
#
#               window_id = next_xid();
#
#               fun draw_fn (arg as (di::d::DESTROY _))
#                       =>
#                       to_hostwindow_drawimp arg;
#
#                   draw_fn _
#                       =>
#                       raise exception OP_UNSUPPORTED_ON_INPUT_ONLY_WINDOWS;
#               end;
#
#               window
#                   =
#                   #                 {
#                       window_id,
#                       screen,
#                       to_hostwindow_drawimp =>  draw_fn,
#                       per_depth_imps
#                     }: sn::Window;
#
#               create_window  xsocket
#                  {
#                   window_id,
#                   parent_window_id,
#                   #   
#                   io_class   => xt::INPUT_ONLY,
#                   depth      => 0,
#                   #   
#                   visual_id  => xt::SAME_VISUAL_AS_PARENT,
#                   attributes => [xt::a::EVENT_MASK standard_xevent_mask],
#                   #
#                   site => check_site
#                               ( { upperleft    => { col, row },
#                                   size         => { wide, high },
#                                   border_thickness => 0
#                                 }
#                                 : g2d::Window_Site
#                               )
#               };
#           end;


                                                                # commandline           is from   src/lib/std/commandline.pkg
        # Set the standard window-manager
        # properties of a top-level window.
        #
        # This should be done before showing
        # (mapping) the window:
        #
        fun set_window_manager_properties

                window

                { window_name,
                  icon_name,
                  commandline_arguments,                        # Typically from:   commandline::get_arguments ().
                  size_hints,
                  nonsize_hints,
                  class_hints
                }
            =
            {   window ->  { window_id, screen =>  { xsession, ... }: sn::Screen, ... }: sn::Window;

                fun put_property (name, value)
                    =
                    set_property (xsession, window_id, name, value);

                fun put_string_prop (_, NULL)     =>   ();
                    put_string_prop (atom, THE s) =>   put_property (atom, ip::make_string_property s);
                end;

                put_string_prop (sa::wm_name,    window_name);
                put_string_prop (sa::wm_icon_name, icon_name);

                put_property (sa::wm_normal_hints, ip::make_window_manager_size_hints        size_hints);
                put_property (sa::wm_hints,        ip::make_window_manager_nonsize_hints  nonsize_hints);

                case class_hints
                    #         
                    THE { resource_name, resource_class }
                        =>
                        put_property
                          ( sa::wm_ilk,
                            ip::make_string_property (string::cat [resource_name, "\000", resource_class])
                          );

                    NULL => ();
                esac;

                case commandline_arguments
                    #         
                    [] => ();
                    _  => put_property
                            ( sa::wm_command,
                              ip::make_command_hints  commandline_arguments
                            );
                esac;
            };


        # Set the window-manager protocols for a window:
        #
        fun set_window_manager_protocols window atoml
            =
            {   window ->  { window_id, screen =>  { xsession, ... }: sn::Screen, ... }: sn::Window;

                fun put_property n a
                    =
                    set_property (xsession, window_id, n, ip::make_atom_property a);

                case (at::find_atom  xsession  "WM_PROTOCOLS")
                    #
                    NULL => FALSE;
                    THE protocols_atom => { apply (put_property protocols_atom) atoml; TRUE;};
                esac;
            };

        # Map window configuration values to a value list:
        #
        fun do_config_val arr
            =
            {   fun upd (i, v)
                    =
                    rw_vector::set (arr, i, THE v);


                \\ (c::ORIGIN ({ col, row } ))
                        =>
                        {   upd (0, unt::from_int col);
                            upd (1, unt::from_int row);
                        };

                   (c::SIZE ({ wide, high } ))
                        =>
                        {   upd (2, unt::from_int wide);
                            upd (3, unt::from_int high);
                        };

                   (c::BORDER_WID wide)
                       =>
                       upd (4, unt::from_int wide);

                   (c::STACK_MODE mode)
                        =>
                        {   rw_vector::set (arr, 5, NULL);
                            upd (6, v2w::stack_mode_to_wire mode);
                        };

                   (c::REL_STACK_MODE ({ window_id => xid, ... }: sn::Window, mode))
                        =>
                        {   upd (5, xt::xid_to_unt xid);
                            upd (6, v2w::stack_mode_to_wire mode);
                        };
                end;
            };

        do_config_vals
            =
            v2w::do_val_list 7 do_config_val;

        fun configure_window ({ window_id, screen =>  { xsession =>  (x: sn::Xsession), ... }: sn::Screen, ... }: sn::Window ) vals
            =
            x.windowsystem_to_xserver.xclient_to_sequencer.send_xrequest
              ( v2w::encode_configure_window
                  {
                    window_id,
                    vals => do_config_vals vals
                  }
              );

        fun move_window   window pt   =   configure_window window [c::ORIGIN pt];
        fun resize_window window size =   configure_window window [c::SIZE size];

        fun move_and_resize_window window ({ col, row, wide, high } )
            =
            configure_window window
              [ c::ORIGIN ({ col,  row  } ),
                c::SIZE   ( { wide, high } )
              ];

        # Show ("map") a window:
        #
        fun show_window ({ window_id, screen =>  { xsession => (x: sn::Xsession), ... }: sn::Screen, ... }: sn::Window )
            =
            {
# window_id -> xid;
# trace {. sprintf "window-old.pkg: show_window: Calling v2w::encode_map_window { window_id => %d }" (xt::xid_to_int xid); };
                x.windowsystem_to_xserver.xclient_to_sequencer.send_xrequest   (v2w::encode_map_window { window_id } );
#               sn::flush_out  xsession;
            };

        # Hide ("unmap") a window:
        #
        fun hide_window ({ window_id, screen =>  { xsession =>  (x: sn::Xsession), ... }: sn::Screen, ... }: sn::Window )
            =
            {   x.windowsystem_to_xserver.xclient_to_sequencer.send_xrequest    (v2w::encode_unmap_window { window_id } );

#               sn::flush_out  xsession;
            };

        # Withdraw (unmap and notify window manager) a top-level window 
        #
        stipulate 

            mask = xet::mask_of_xevent_list
                     [ xet::n::SUBSTRUCTURE_NOTIFY,
                       xet::n::SUBSTRUCTURE_REDIRECT
                     ];
        herein

            fun withdraw_window ({ window_id, screen =>  { screen_info => { xscreen, ... }: sn::Screen_Info, xsession => (x: sn::Xsession) }: sn::Screen, ... }: sn::Window )
                =
                {   xscreen ->  { root_window_id, ... }: dy::Xscreen;
                    #
                    x.windowsystem_to_xserver.xclient_to_sequencer.send_xrequest
                        #
                        (s2w::encode_send_unmapnotify_xevent
                          {
                            send_event_to  => xt::SEND_EVENT_TO_WINDOW root_window_id,
                            #
                            from_configure => FALSE,
                            propagate      => FALSE,
                            event_mask     => mask, 
                            #
                            event_window_id    =>  root_window_id,
                            unmapped_window_id =>  window_id
                          }
                        );

#                   sn::flush_out  xsession;
               };
        end;

        # Destroy a window.
        # We do this via draw_imp to avoid a race
        # with any pending draw requests on the window.
        #
        fun destroy_window ({ window_id, windowsystem_to_xserver, ... }: sn::Window )
            = 
            windowsystem_to_xserver.destroy_window  window_id;


        # Map a point in the window's coordinate
        # system to the screen's coordinate system
        #
        window_point_to_screen_point
            =
            sn::window_point_to_screen_point;


        # Set the window cursor:
        #
        fun set_cursor ({ window_id, screen, ... }: sn::Window ) c
            =
            {   screen ->  { xsession => (x: sn::Xsession), ... }: sn::Screen;

                cur =  case c
                           #                          
                           THE (cs::XCURSOR { id, ... } ) =>   xt::a::CURSOR id;
                           NULL                           =>   xt::a::CURSOR_NONE;
                       esac;

                change_window_attributes'  x.windowsystem_to_xserver  (window_id, [cur]);
            };


        # Set the background color attribute of the window.
        #
        # Note that this does not immediately affect
        # the window's contents, but if it is done
        # before the window is mapped the window will
        # come up with the right color.
        #
        fun set_background_color  ({ window_id, screen, ... }: sn::Window)   color
            =
            change_window_attributes'  x.windowsystem_to_xserver  (window_id, [color])
            where 
                screen ->   { xsession => (x: sn::Xsession), ... }: sn::Screen;
                #
                color =     case color
                                #                
                                THE c =>   xt::a::BACKGROUND_PIXEL (rgb8_of c);
                                NULL  =>   xt::a::BACKGROUND_PIXMAP_PARENT_RELATIVE;
                            esac;
            end;

        # Set various window attributes 
        #
        fun change_window_attributes ({ window_id, screen, ... }: sn::Window )
            =
            {   screen ->   { xsession => (x: sn::Xsession), ... }: sn::Screen;
                #
                change = change_window_attributes'  x.windowsystem_to_xserver;

                \\ attributes =  change (window_id,  map  user_window_attribute_to_internal_window_attribute  attributes);
            };

        fun screen_of_window  ({ screen, ... }: sn::Window )
            =
            screen;

        fun xsession_of_window ({ screen =>  { xsession, ... }: sn::Screen, ... }: sn::Window )
            =
            xsession;

        #  Added ddeboer Jan 2005 
        #  grabKeyboard: we would like a reply of xprottypes::GrabSuccess 
        #
        fun grab_keyboard ({ window_id, screen =>  { xsession, ... }: sn::Screen, ... }: sn::Window )
            =
            0;

#           # commented out, ddeboer, mar 2005 - this needs reworked.    XXX BUGGO FIXME
#           let ans = 
#               (w2v::decode_grab_keyboard_reply (block_until_mailop_fires (sn::dpy_pequest_peply xsession
#                           (v2w::encode_grab_keyboard { 
#                               window_id=id, * type xt::Xid *
#                               owner_events=FALSE, 
#                               ptr_mode=xt::AsynchronousGrab, 
#                               kbd_mode=xt::AsynchronousGrab, 
#                               time=xt::CURRENT_TIME } ))))
#                   except Xok::LOST_REPLY => raise exception (xgripe::XERROR "[reply lost]")
#                        | (Xok::ERROR_REPLY err) =>
#                           raise exception (xgripe::XERROR (e2s::xerror_to_string err))
#           in (case (ans) of
#               xt::GrabSuccess => 0
#             | xt::AlreadyGrabbed => 1
#             | xt::GrabInvalidTime => 2
#             | xt::GrabNotViewable => 3
#             | xt::GrabFrozen => 4)
#           end

        fun ungrab_keyboard ({ window_id, screen =>  { xsession => (x: sn::Xsession), ... }: sn::Screen, ... }: sn::Window )
            =
            {   ans = ( /* w2v::decode_grab_keyboard_reply */

                        (block_until_mailop_fires
#                        ========================       XXX SUCKO FIXME
                          (x.windowsystem_to_xserver.xclient_to_sequencer.send_xrequest_and_read_reply
                            (v2w::encode_ungrab_keyboard
                              { time=>xt::CURRENT_TIME }
                      ) ) ) );
#                     except
#                         xok::LOST_REPLY      => raise exception (xgripe::XERROR "[reply lost]");
#                         xok::ERROR_REPLY err => raise exception (xgripe::XERROR (e2s::xerror_to_string err));
#                     end ;

             #  TODO: figure out what type of reply comes from an ungrab request, and decode it         XXX BUGGO FIXME
                0;
            };
                                                # end added ddeboer 


        # Get size of window plus its location
        # relative to parent:
        #
        fun get_window_site
                ({ window_id, screen =>  { xsession as (x: sn::Xsession), ... }: sn::Screen, ... }: sn::Window)
            =
            x.windowsystem_to_xevent_router.get_window_site  window_id;
# {
# log::note_in_ramlog {. "get_window_site/AAA  -- window-old.pkg"; };
# result =
#           s2t::get_window_site (xsocket_to_hostwindow_router, window_id);
# log::note_in_ramlog {. "get_window_site/ZZZ  -- window-old.pkg"; };
# result;
# };

        # Convenience wrappers for the corresponding functions in
        #     src/lib/x-kit/xclient/src/window/xsession-old.api
        #
        fun send_fake_key_press_xevent            (arg as { window => ({ screen =>  { xsession, ... }: sn::Screen, ... }: sn::Window), ... }) =   sn::send_fake_key_press_xevent             xsession  arg;
        fun send_fake_key_release_xevent          (arg as { window => ({ screen =>  { xsession, ... }: sn::Screen, ... }: sn::Window), ... }) =   sn::send_fake_key_release_xevent           xsession  arg;
        fun send_fake_mousebutton_press_xevent    (arg as { window => ({ screen =>  { xsession, ... }: sn::Screen, ... }: sn::Window), ... }) =   sn::send_fake_mousebutton_press_xevent     xsession  arg;
        fun send_fake_mousebutton_release_xevent  (arg as { window => ({ screen =>  { xsession, ... }: sn::Screen, ... }: sn::Window), ... }) =   sn::send_fake_mousebutton_release_xevent   xsession  arg;
        fun send_fake_mouse_motion_xevent         (arg as { window => ({ screen =>  { xsession, ... }: sn::Screen, ... }: sn::Window), ... }) =   sn::send_fake_mouse_motion_xevent          xsession  arg;
        fun send_fake_''mouse_enter''_xevent      (arg as { window => ({ screen =>  { xsession, ... }: sn::Screen, ... }: sn::Window), ... }) =   sn::send_fake_''mouse_enter''_xevent       xsession  arg;
        fun send_fake_''mouse_leave''_xevent      (arg as { window => ({ screen =>  { xsession, ... }: sn::Screen, ... }: sn::Window), ... }) =   sn::send_fake_''mouse_leave''_xevent       xsession  arg;


        # This call is infrastructure.
        #
        # We often want to wait until a widget is fully
        # operational before sending pleas to it. 
        #
        # A practical definition of "operational" is
        # "has received its first EXPOSE X event".
        #
        # We maintain a oneshot in widgets which
        # clients may wait on for this purpose; see
        #     seen_first_redraw_oneshot_of
        # in
        #     src/lib/x-kit/widget/old/basic/widget.api
        #       
        # The oneshot in question originates at widget
        # creation time -- make_widget in
        #
        #     src/lib/x-kit/widget/old/basic/widget.pkg
        #
        # At realization time, which is when a widget
        # for the first time becomes associated with an
        # X window, it registers its oneshot with us
        # via this call:  See realize_widget in widget.pkg.
        # This ensures that we have the onehost on hand
        # when we receive a window's first EXPOSE event.
        #
#       fun note_''seen_first_expose''_oneshot
#               ({ window_id, screen =>  { xsession as  { xsocket_to_hostwindow_router, ... }: sn::Xsession, ... }: sn::Screen, ... }: sn::Window)
#               seen_first_redraw
#           =
#           s2t::note_window's_''seen_first_expose''_oneshot
#               #
#               (xsocket_to_hostwindow_router,  window_id,  seen_first_redraw);

        fun get_''seen_first_expose''_oneshot_of
                #
                ({ window_id, screen =>  { xsession as (x: sn::Xsession), ... }: sn::Screen, ... }: sn::Window)
            =
            x.windowsystem_to_xevent_router.get_''seen_first_expose''_oneshot_of   window_id;



        fun get_''gui_startup_complete''_oneshot_of
                #
                ({ window_id, screen =>  { xsession as (x: sn::Xsession), ... }: sn::Screen, ... }: sn::Window)
            =   
            x.windowsystem_to_xevent_router.get_''gui_startup_complete''_oneshot_of ();

    };                                          # Window 
end;                                            # stipulate


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext