PreviousUpNext

15.4.1484  src/lib/x-kit/xclient/pkg/window/topwindow-to-widget-router.pkg

## topwindow-to-widget-router.pkg
#
# For each toplevel window, which is to say
# at the root of each widget tree, we need
# a thread which accepts xevents from
#
#     src/lib/x-kit/xclient/pkg/window/xsocket-to-topwindow-router.pkg
#
# and passes them them on down the widgettree.
#
# That's our job here.
#
# For the big picture see the diagram in
#     src/lib/x-kit/xclient/pkg/window/xsession.pkg

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


stipulate
    include threadkit;                                  # threadkit                     is from   src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit.pkg
    #
    package dy  =  display;                             # display                       is from   src/lib/x-kit/xclient/pkg/wire/display.pkg
    package di  =  draw_imp;                            # draw_imp                      is from   src/lib/x-kit/xclient/pkg/window/draw-imp.pkg
    package dt  =  draw_types;                          # draw_types                    is from   src/lib/x-kit/xclient/pkg/window/draw-types.pkg
    package et  =  event_types;                         # event_types                   is from   src/lib/x-kit/xclient/pkg/wire/event-types.pkg
    package kb  =  keys_and_buttons;                    # keys_and_buttons              is from   src/lib/x-kit/xclient/pkg/wire/keys-and-buttons.pkg
    package ki  =  keymap_imp;                          # keymap_imp                    is from   src/lib/x-kit/xclient/pkg/window/keymap-imp.pkg
    package sn  =  xsession;                            # xsession                      is from   src/lib/x-kit/xclient/pkg/window/xsession.pkg
    package s2t =  xsocket_to_topwindow_router;         # xsocket_to_topwindow_router   is from   src/lib/x-kit/xclient/pkg/window/xsocket-to-topwindow-router.pkg
    package wc  =  widget_cable;                        # widget_cable                  is from   src/lib/x-kit/xclient/pkg/window/widget-cable.pkg
    package xtr =  xlogger;                             # xlogger                       is from   src/lib/x-kit/xclient/pkg/stuff/xlogger.pkg
herein


    package   topwindow_to_widget_router
    : (weak)  Topwindow_To_Widget_Router                # Topwindow_To_Widget_Router    is from   src/lib/x-kit/xclient/pkg/window/topwindow-to-widget-router.api
    {
        trace =  xtr::log_if  xtr::topwindow_to_widget_router_tracing;  # Conditionally write strings to tracing.log or whatever.

        # The top-level window (usually a shell widget)
        # should never pass on CO message                                       # "CO" == "command out"
        #
        fun make_co_thread  co_event
            =
            make_thread "widget-cable root-end CO eater" .{

                do_mailop co_event;

                xgripe::impossible("[widgetcable-rootend: unexpected CO message]");
            };

        fun make_router
              ( sn::XSESSION { keymap_imp, ... },
                xevent_in',
                drawimp_mappedstate_slot,
                top_window
              )
            =
            {   make_descendant_window
                    =
                    {   top_window ->  dt::WINDOW { screen, screen_pen_and_draw_imps, to_topwindow_drawimp, ... };

                        fn window_id
                            =
                            dt::WINDOW { window_id, screen, screen_pen_and_draw_imps, to_topwindow_drawimp };
                    };

                my { kidplug, momplug }
                    =
                    widget_cable::make_widget_cable ();

                my (route_other_envelope', route_keyboard_envelope', route_mouse_envelope')
                    =
                    {   momplug ->  wc::MOMPLUG { other_sink, keyboard_sink, mouse_sink, from_kid' };

                        make_co_thread from_kid';

                        (other_sink, keyboard_sink, mouse_sink);
                    };

                lookup_key =  ki::look_up_keysym  keymap_imp;

                stipulate

                    seqn = REF 0;

                herein

                    fun stuff_envelope (route, contents)
                        =
                        {   n = *seqn;

                            seqn := n+1;

                            wc::ENVELOPE { route, seqn=>n, contents };
                        };
                end;

                # Create mailslot to pass client messages
                # to the application.
                #
                # This appears is a 2005 dusty deboer hack described
                # in the "Library: Deletion Events" section of
                #
                #     http://people.cis.ksu.edu/~ddeboer/eXene.html
                #
                # Receipt of (any) CLIENT_MESSAGE X event is signaled
                # (see fun route_xevent below) via this slot
                # and can be waited on via TOPWINDOW.delete_slot
                # -- see delete_mailop in   src/lib/x-kit/widget/basic/topwindow.api
                #
                # We never send a CLIENT_MESSAGE, nor does any existing
                # code reference the delete_mailop.  However, the window
                # manager 
                #
                wm_window_delete_slot =   make_mailslot ();


                fun do_key (make_msg, key_event)
                    =
                    route_keyboard_envelope' (make_msg (lookup_key key_event));


                fun do_button_press (path, info:  et::Button_Xevtinfo)
                    =
                    {   info ->  { mouse_button, event_point, root_point, timestamp, mousebuttons_state, ... };

                        mail =  if (kb::no_mousebuttons_set  mousebuttons_state)
                                    #
                                    wc::MOUSE_FIRST_DOWN
                                      {
                                        mouse_button,
                                        window_point => event_point,
                                        screen_point => root_point,
                                        timestamp
                                      };
                                else
                                    wc::MOUSE_DOWN
                                      {
                                        mouse_button,
                                        window_point => event_point,
                                        screen_point => root_point,
                                          #  invert button so that the state is post-transition 
                                        state => kb::invert_button_in_mousebutton_state (mousebuttons_state, mouse_button),
                                        timestamp
                                      };
                                fi;

                          route_mouse_envelope' (stuff_envelope (path, mail));
                    };

                fun do_button_release (path, info:  et::Button_Xevtinfo)
                    =
                    route_mouse_envelope' (stuff_envelope (path, msg))
                    where 
                        info ->   { mouse_button, event_point, root_point, timestamp, mousebuttons_state, ... };

                        state =  kb::invert_button_in_mousebutton_state (mousebuttons_state, mouse_button);

                        msg = if (kb::no_mousebuttons_set  state)
                                  #
                                  wc::MOUSE_LAST_UP
                                      {
                                        mouse_button,
                                        window_point => event_point,
                                        screen_point => root_point,
                                        timestamp
                                      };
                              else
                                  wc::MOUSE_UP
                                      {
                                        mouse_button,
                                        window_point => event_point,
                                        screen_point => root_point,
                                        state,
                                        timestamp
                                      };
                              fi;
                    end;


                # An always-ready mailop producing void:
                #
                always_void
                    =
                    always_mailop ();


                fun do_config_sync (path, config_msg)
                    =
                    always_void
                        ==>
                       .{   do_mailop (route_mouse_envelope'     (stuff_envelope (path, wc::MOUSE_CONFIG_SYNC)));
                            do_mailop (route_keyboard_envelope'  (stuff_envelope (path, wc::KEY_CONFIG_SYNC)));
                            do_mailop (route_other_envelope'     (stuff_envelope (path, config_msg)));
                        };

                fun route_xevent (path, et::x::KEY_PRESS arg)
                        =>
                        {
                            do_key (fn x = stuff_envelope (path, wc::KEY_PRESS x), arg);
                        };

                    route_xevent (path, et::x::KEY_RELEASE arg)
                        =>
                        {
                            do_key (fn x = stuff_envelope (path, wc::KEY_RELEASE x), arg);
                        };

                    route_xevent (path, et::x::BUTTON_PRESS   arg)
                        =>
                        {
                            do_button_press    (path, arg);
                        };

                    route_xevent (path, et::x::BUTTON_RELEASE arg)
                        =>
                        {
                            do_button_release  (path, arg);
                        };

                    route_xevent (path, et::x::MOTION_NOTIFY { event_point, root_point, timestamp, ... } )
                        =>
                        route_mouse_envelope' (stuff_envelope (path, wc::MOUSE_MOTION { window_point=>event_point, screen_point=>root_point, timestamp } ));

                    route_xevent (path, et::x::ENTER_NOTIFY { event_point, root_point, timestamp, ... } )
                        =>
                        route_mouse_envelope' (stuff_envelope (path, wc::MOUSE_ENTER { window_point=>event_point, screen_point=>root_point, timestamp } ));

                    route_xevent (path, et::x::LEAVE_NOTIFY { event_point, root_point, timestamp, ... } )
                        =>
                        route_mouse_envelope' (stuff_envelope (path, wc::MOUSE_LEAVE { window_point=>event_point, screen_point=>root_point, timestamp } ));

          /*******
                  | route_xevent (_, et::x::FOCUS_IN {... } ) = ()
                  | route_xevent (_, et::x::FOCUS_OUT {... } ) = ()
                  | route_xevent (_, et::x::KEYMAP_NOTIFY {... } ) = ()
          ******/

                    route_xevent (path, et::x::EXPOSE { boxes, ... } )
                        =>
                        {
trace .{ "route_xevent:  Handling EXPOSE"; };
                            route_other_envelope' (stuff_envelope (path, wc::ETC_REDRAW boxes));
                        };

          /*******
                  | route_xevent (_, et::x::GRAPHICS_EXPOSE {... } ) = ()
                  | route_xevent (_, et::x::NO_EXPOSE {... } ) = ()
                  | route_xevent (_, et::x::VISIBILITY_NOTIFY _) = ()
          ******/

                    route_xevent (path, et::x::CREATE_NOTIFY { parent_window_id, created_window_id, ... } )
                        =>
                        {
trace .{ "route_xevent:  Handling CREATE_NOTIFY"; };
                            do_config_sync (path, wc::ETC_CHILD_BIRTH (make_descendant_window  created_window_id));
                        };

                    route_xevent (path, et::x::DESTROY_NOTIFY { destroyed_window_id, event_window_id, ... } )
                        =>
                        destroyed_window_id == event_window_id
                            ##
                            ??   route_other_envelope' (stuff_envelope (path, wc::ETC_OWN_DEATH))
                            ::   do_config_sync (path, wc::ETC_CHILD_DEATH (make_descendant_window  destroyed_window_id));

                    route_xevent (s2t::ENVELOPE_ROUTE_END _, et::x::UNMAP_NOTIFY _)
                        =>
                        always_void
                            ==> 
                            .{  give (drawimp_mappedstate_slot, di::s::TOPWINDOW_IS_NOW_UNMAPPED);  };

                    route_xevent (_, et::x::UNMAP_NOTIFY _)
                        =>
                        always_void;

                    route_xevent (s2t::ENVELOPE_ROUTE_END _, et::x::MAP_NOTIFY _)
                        =>
                        always_void
                            ==>
                            .{   give  (drawimp_mappedstate_slot,  di::s::TOPWINDOW_IS_NOW_MAPPED);   };

                    route_xevent (_, et::x::MAP_NOTIFY _)
                        =>
                        {
trace .{ "route_xevent:  'Handling' MAP_NOTIFY via always_void"; };
                            always_void;
                        };

          /*******
                  | route_xevent (_, et::x::MAP_REQUEST {... } ) = ()
                  | route_xevent (_, et::x::REPARENT_NOTIFY {... } ) = ()
          ******/

                  route_xevent (path, et::x::CONFIGURE_NOTIFY { box, ... } )
                      =>
                      route_other_envelope' (stuff_envelope (path, wc::ETC_RESIZE box));

          /*******
                  | route_xevent (_, et::x::ConfigureRequest {... } ) = ()
                  | route_xevent (_, et::x::GravityNotify {... } ) = ()
                  | route_xevent (_, et::x::ResizeRequest {... } ) = ()
                  | route_xevent (_, et::x::CirculateNotify {... } ) = ()
                  | route_xevent (_, et::x::CirculateRequest {... } ) = ()
                  | route_xevent (_, et::x::PropertyNotify {... } ) = ()
                  | route_xevent (_, et::x::SelectionClear {... } ) = ()
                  | route_xevent (_, et::x::SelectionRequest {... } ) = ()
                  | route_xevent (_, et::x::SelectionNotify {... } ) = ()
                  | route_xevent (_, et::x::ColormapNotify {... } ) = ()
          ******/
          /****** modification, ddeboer, Jul 2004: route this event when delete. 
          from ..protocol/event-types.pkg:
          ... CLIENT_MESSAGE_XEVENT of {
                  window:  window_id,        
                  type:  atom,         the type of the message
                  value:  raw_data        the message value
                }
          */

                   route_xevent (_, et::x::CLIENT_MESSAGE { window_id, type, ... } )
                       => 
                       always_void
                           ==>
                          .{   give (wm_window_delete_slot, ());   };
                                #
                                # In principle we might here have received
                                # any of the following window manager messages:
                                #
                                #     WM_ACCEPT_FOCUS  -- See p33            of http://mythryl.org/pub/exene/icccm.pdf
                                #     WM_DELETE_WINDOW -- See p43 (S4.2.8.1) of http://mythryl.org/pub/exene/icccm.pdf
                                #     WM_SAVE_YOURSELF -- See p61            of http://mythryl.org/pub/exene/icccm.pdf (Obsolete -- use newer session management support.)
                                #
                                # However, we have only registered support for
                                # WM_DELETE_WINDOW so at present we presume
                                # that is what we have, without even checking.
                                # 
                                # This is a 2005 dusty deboer hack described in
                                #
                                #     http://people.cis.ksu.edu/~ddeboer/eXene.html
                                #
                                # When the user clicks on our windowframe close button,
                                # the window manager sends us a WM_DELETE_WINDOW X ClientEvent.
                                #
                                # It does this because we advertised support for the WM_DELETE_WINDOW
                                # ICCCM protocol in the set_protocols() fn in
                                #
                                #     src/lib/x-kit/widget/basic/topwindow.pkg
                                #
                                # -- otherwise it would just summarily kill our X window
                                # and X socket connection.
                                #
                                # The window manager sends us WM_DELETE_WINDOW messages
                                # when the user clicks on the windowframe close button.
                                #
                                # WM_DELETE_WINDOW messages from the window manager via the
                                #     delete_mailop
                                # in
                                #     src/lib/x-kit/widget/basic/topwindow.api
                                #
                                # No existing code sends a CLIENT_MESSAGE,
                                # nor does any existing code reference delete_mailop.

          # * end mod ***

                   route_xevent (_, event)
                       =>
                       always_void
                           ==>  
                          .{   trace .{ cat [ "[topwindow_to_widget_router::route_xevent: unexpected event ", xevent_to_string::xevent_name event, "]" ];  };
                           };

                end;                    # fun route_xevent

          #  +DEBUG 
                fun debug_router (result as (_, xevent))
                    = 
                    {   trace  .{ cat [ "topwin2widget: get ", xevent_to_string::xevent_name xevent ];  };

                        result;
                    };
          #  -DEBUG 
                fun router ([], [])
                        =>
                        router ([debug_router (do_mailop xevent_in')], []);

                    router ([], l)
                        =>
                        router (reverse l, []);

                    router (front as (msg_out ! r), rear)
                        =>
                        select [
                            xevent_in'
                                ==>
                                (fn result
                                    =
                                    router (front, (debug_router result) ! rear)),

                            route_xevent msg_out
                                ==>
                               .{  router (r, rear);  }
                        ];
                end;

                ( kidplug,
                  (fn pending = router (pending, [])),
                  wm_window_delete_slot
                );
          };                                                    # fun make_router 


        # Create the X-event-router imp and draw_imp
        # for a top-level window, returning the
        # kidplug and topwindow.
        #
        # This function is called (only) from
        #
        #     make_simple_top_window
        #     make_simple_popup_window
        #     make_transient_window
        # in
        #     src/lib/x-kit/xclient/pkg/window/window.pkg
        #
        fun make_topwindow_to_widget_router
            (
              screen                    as  sn::SCREEN { xsession, ... },
              screen_pen_and_draw_imps  as  sn::SCREEN_PEN_AND_DRAW_IMPS  { pen_imp, ... },
              window_id,
              site
            )
            =
            {   xsession ->  sn::XSESSION { xdisplay as dy::XDISPLAY { xsocket, ... }, xsocket_to_topwindow_router, ... };

                drawimp_mappedstate_slot
                    =
                    make_mailslot ();

trace .{ "XYZZY make_topwindow_to_widget_router: Doing make_draw_imp"; };
                to_topwindow_drawimp
                    =
                    di::make_draw_imp
                          (
                            take'  drawimp_mappedstate_slot,
                            pen_imp,
                            xsocket_to_topwindow_router,
                            xsocket
                          );
trace .{ "XYZZY make_topwindow_to_widget_router: Done  make_draw_imp"; };

                xevent_in'                              # We receive X events via this mailop.
                    =
                    s2t::note_new_topwindow
                      (
                        xsocket_to_topwindow_router,
                        window_id,
                        site
                      );

                top_window
                    =
                    dt::WINDOW { window_id, screen, screen_pen_and_draw_imps, to_topwindow_drawimp };

                my (kidplug, router, wm_window_delete_slot)
                    =
                    make_router (xsession, xevent_in', drawimp_mappedstate_slot, top_window);

                fun init_router ()
                    =
                    {
                        fun loop buf
                            =
                            case (do_mailop xevent_in')
                                #
                                arg as (_, et::x::EXPOSE _)
                                    =>
                                    {
                                                                                            /* DEBUG */ trace .{ "init_router: ExposeEvt"; };
                                        give  (drawimp_mappedstate_slot,  di::s::FIRST_EXPOSE);
                                                                                            /* DEBUG */ trace .{ "init_router: DM_FirstExpose sent"; };
                                        (arg ! buf);
                                    };

                                arg => loop (arg ! buf);
                            esac;

                                                                                            /* DEBUG */ trace .{ cat ["init_router: window_id = ", xtype_to_string::xid_to_string window_id]; };
                          router (reverse (loop []));
                                                                                            /* DEBUG */ trace .{ "init_router: go"; };
                  };

                  xtr::make_thread  "topwin_to_widget"  init_router;


                  (kidplug, top_window, wm_window_delete_slot);
            };                                                                          # fun make_topwindow_to_widget_router

    };                                                                                  # package toplevel_window

end;


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext