PreviousUpNext

15.4.1489  src/lib/x-kit/xclient/pkg/window/xsocket-to-topwindow-router.pkg

## xsocket-to-topwindow-router.pkg
#
# Primary functionality
# =====================
#
# For the big picture, see the dataflow diagram in:
#
#     src/lib/x-kit/xclient/pkg/window/xsession.pkg
#
# We receive X events from the xsession xbuf_imp
# and decide what action to take for them.  The
# xbuf_imp just breaks the X event bytestream up
# into individual messages;  we are the first link
# in the chain which actually responds to X events
# on a semantic level.
#
# Typically we route an X event to the toplevel
# window containing the relevant widget.  More
# precisely, to the topwindow_to_widget_router
# instance for that topwindow -- see
#
#     src/lib/x-kit/xclient/pkg/window/topwindow-to-widget-router.pkg

# To do this we maintain a
#
#     window_id_to_window_info_map
#
# which tracks all windows created by the application,
# keyed by their associated X-server IDs (xids), so that
# we can translate the xid in the event to the proper
# topwindow_to_widget_router input slot for delivery.
#
# In particular we track, for each window, the route
# needed to reach it down the window hierarchy, and
# deliver X events down that route, thus giving each
# ancestor of the target widget a chance to rewrite
# the event. 
#
# We find out about newly created toplevel windows via our
#
#     note_new_topwindow
#
# fn, which is called by the topwindow-creation functions
#
#     make_simple_top_window
#     make_simple_popup_window
#     make_transient_window
# in
#     src/lib/x-kit/xclient/pkg/window/window.pkg
#      
# We find out about newly created subwindows via
#     CREATE_NOTIFY
# xevents from the X server, and about destroyed
# windows (toplevel and subwindow both) via
#     DESTROY_NOTIFY
# xevents from the X server.
#
# There are also a few X events which we divert to
# specialized imps for processing:
#
#  o  The following three X events get redirected
#     to our selection imp:
#         SELECTION_CLEAR
#         SELECTION_REQUEST
#         SELECTION_NOTIFY
#
#  o  The following X events get redirected
#     to our property imp:
#         PROPERTY_NOTIFY
#
#
# Secondary functionality
# =======================
#
# This file also implements a facility to
# freeze selected windows, with draw commands
# to them queueing up until they are unlocked:
# See make_overlay_buffer in
#     src/lib/x-kit/xclient/pkg/window/draw-imp.pkg  
#
# The idea might have been to allow XOR-implemented
# rubber-banding selection to work without anomalies
# due to the window contents changing between draw
# and undraw calls.
#
# The lock_window_tree entrypoint is called
# nowhere in the codebase, so this is apparently
# code that was just being phased in when
# development ceased.
#

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



# TODO                  XXX BUGGO FIXME
#   - refresh the keymap on ModifierMappingNotifyXEvt and KeyboardMappingNotifyXEvt
#     events.
#   - think about the relation of locks and changes in the tree structure
#     also locking already locked windows.


stipulate
    include threadkit;                                  # threadkit             is from   src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit.pkg
    #
    package xt  =  xtypes;                              # xtypes                is from   src/lib/x-kit/xclient/pkg/wire/xtypes.pkg
    package et  =  event_types;                         # event_types           is from   src/lib/x-kit/xclient/pkg/wire/event-types.pkg
    package dy  =  display;                             # display               is from   src/lib/x-kit/xclient/pkg/wire/display.pkg
    package xok =  xsocket;                             # xsocket               is from   src/lib/x-kit/xclient/pkg/wire/xsocket.pkg
    package xg  =  xgeometry;                           # xgeometry             is from   src/lib/std/2d/xgeometry.pkg
    package xtr =  xlogger;                             # xlogger               is from   src/lib/x-kit/xclient/pkg/stuff/xlogger.pkg
herein


    package   xsocket_to_topwindow_router
    : (weak)  Xsocket_To_Topwindow_Router               # Xsocket_To_Topwindow_Router   is from   src/lib/x-kit/xclient/pkg/window/xsocket-to-topwindow-router.api
    {

        trace =  xtr::log_if  xtr::xsocket_to_topwindow_router_tracing;         # Conditionally write strings to tracing.log or whatever.

        Envelope_Route
          = ENVELOPE_ROUTE_END  xt::Window_Id
          | ENVELOPE_ROUTE     (xt::Window_Id, Envelope_Route)
          ;

        stipulate

            package plea {
                #
                Mail
                  = NOTE_NEW_TOPWINDOW             (xt::Window_Id, xg::Window_Site)
                  | GET_WINDOW_SITE                (xt::Window_Id,     /* reply_oneshot: */ Oneshot_Maildrop(xg::Box))
                  #
                  | LOCK_WINDOW                     xt::Window_Id
                  | UNLOCK_WINDOW                   xt::Window_Id
                  | IS_WINDOW_LOCKED                xt::Window_Id
                  #
                  | GET_''SEEN_FIRST_EXPOSE''_ONESHOT  (xt::Window_Id, /* reply_oneshot: */ Oneshot_Maildrop( Null_Or(Oneshot_Maildrop(Void))) )
                  | NOTE_''SEEN_FIRST_EXPOSE''_ONESHOT (xt::Window_Id, /* reply_oneshot: */ Oneshot_Maildrop( Void ))
                  #
                  | GET_''GUI_STARTUP_COMPLETE''_ONESHOT               /* reply_oneshot: */ Oneshot_Maildrop( Oneshot_Maildrop(Void) )
                  ;
            };

            Window_Info
                =
                WINDOW_INFO
                  {
                    window_id:    xt::Window_Id,                                        # 29-bit X id for this particular window.
                    route:        Envelope_Route,                                       # Path needed to reach this window, starting at its topwindow.
                    parent_info:  Null_Or( Window_Info ),
                    #
                    children:     Ref( List(Window_Info) ),
                    lock:         Ref( Bool ),
                    site:         Ref( xg::Box ),
                    #
                    to_topwindow_slot:   Mailslot( (Envelope_Route, et::x::Event) ),    # Where to send events headed for this window.
                    #
                    seen_first_expose:          Ref( Bool ),                            # We set this TRUE on first EXPOSE event.
                    seen_first_expose_oneshot:  Ref( Null_Or(Oneshot_Maildrop(Void)) )  # We set this      on first EXPOSE event.
                  };
                    # The seen_first_expose* stuff is part of the
                    # infrastructure allowing a widget client to wait
                    # until the widget is fully operational before
                    # submitting requests to it.  We presume that a
                    # widget is operational when we see an EXPOSE
                    # x event for it -- it had better be!
                    #
                    # See also   seen_first_redraw_slot_of   in
                    #     src/lib/x-kit/widget/basic/widget.api

            # The various things we can
            # do with a given X event:
            #
            Xevent_Action
              # 
              = SEND_TO_WINDOW                        xt::Window_Id                     # Forward event to given window via all of its ancestors from topwindow down.
              | NOTE_SITE_CHANGE_AND_SEND_TO_WINDOW  (xt::Window_Id, xg::Box)           # Note new size+position of window, then forward event normally.
              | NOTE_EXPOSE_AND_SEND_TO_WINDOW        xt::Window_Id                     # Note EXPOSE (if first for window) then forward event normally.
              | NOTE_WINDOW_DESTRUCTION               xt::Window_Id
              | SEND_TO_KEYMAP_IMP                                                      # This appears to be unused at present.
              | SEND_TO_WINDOW_PROPERTY_IMP
              | SEND_TO_SELECTION_IMP
              | SEND_TO_ALL_WINDOWS                                                     # So everyone hears about changes in modifier key, keyboard and pointer mappings.
              | IGNORE
              | NOTE_NEW_WINDOW
                  { parent_window_id:   xt::Window_Id,
                    created_window_id:  xt::Window_Id,
                    box:                xg::Box 
                  }
              ;


            # Discard instances of an X-event that
            # are the product of SubstructureNotify,
            # instead of StructureNotify.
            #
            fun ignore_substructure_notify_xevents (window_id1, window_id2)
                =
                if (window_id1 == window_id2)  SEND_TO_WINDOW window_id1;
                else                           IGNORE;
                fi;

            # Decide what action to take for given X event.  Here
            #
            #     event_window_id
            #
            # is the window corresponding to the widget which
            # should actually handle the event, as determined
            # by the X server;  the X server algorithm is
            # described on pages 76-77 of
            #
            #     http://mythryl.org/pub/exene/X-protocol-R6.pdf
            #
            fun pick_xevent_action (et::x::KEY_PRESS      { event_window_id, ... } ) =>  SEND_TO_WINDOW event_window_id;
                pick_xevent_action (et::x::KEY_RELEASE    { event_window_id, ... } ) =>  SEND_TO_WINDOW event_window_id;
#               pick_xevent_action (et::x::BUTTON_PRESS   { event_window_id, ... } ) =>  SEND_TO_WINDOW event_window_id;
#               pick_xevent_action (et::x::BUTTON_RELEASE { event_window_id, ... } ) =>  SEND_TO_WINDOW event_window_id;
                pick_xevent_action (et::x::BUTTON_PRESS   { event_window_id, ... } ) => { trace .{ sprintf "pick_xevent_action/BUTTON_PRESS: event_window_id s=%s" (xtype_to_string::xid_to_string  event_window_id); };
                                                                                         SEND_TO_WINDOW event_window_id; };
                pick_xevent_action (et::x::BUTTON_RELEASE { event_window_id, ... } ) => { trace .{ sprintf "pick_xevent_action/BUTTON_RELEASE: event_window_id s=%s" (xtype_to_string::xid_to_string  event_window_id); };
                                                                                         SEND_TO_WINDOW event_window_id; };
                pick_xevent_action (et::x::MOTION_NOTIFY  { event_window_id, ... } ) =>  SEND_TO_WINDOW event_window_id;
                pick_xevent_action (et::x::ENTER_NOTIFY   { event_window_id, ... } ) =>  SEND_TO_WINDOW event_window_id;
                pick_xevent_action (et::x::LEAVE_NOTIFY   { event_window_id, ... } ) =>  SEND_TO_WINDOW event_window_id;
                pick_xevent_action (et::x::FOCUS_IN       { event_window_id, ... } ) =>  SEND_TO_WINDOW event_window_id;
                pick_xevent_action (et::x::FOCUS_OUT      { event_window_id, ... } ) =>  SEND_TO_WINDOW event_window_id;

#               pick_xevent_action (et::x::KeymapNotify {, ... } ) = 
#               pick_xevent_action (et::x::GraphicsExpose ?? 
#               pick_xevent_action (et::x::NoExpose {, ... } ) =
#               pick_xevent_action (et::x::MapRequest {, ... } ) =
#               pick_xevent_action (et::x::ConfigureRequest {, ... } ) =
#               pick_xevent_action (et::x::ResizeRequest {, ... } ) =
#               pick_xevent_action (et::x::CirculateRequest {, ... } ) =

                pick_xevent_action (et::x::EXPOSE { exposed_window_id, ... } ) =>  NOTE_EXPOSE_AND_SEND_TO_WINDOW  exposed_window_id;


                pick_xevent_action (et::x::VISIBILITY_NOTIFY { changed_window_id, ... } ) =>  SEND_TO_WINDOW  changed_window_id;

                pick_xevent_action (et::x::CREATE_NOTIFY { parent_window_id, created_window_id, box, ... } )
                    =>
                    {
trace .{ sprintf "pick_xevent_action/CREATE_NOTIFY: parent_window_id s=%s created_window_id x=%s" (xtype_to_string::xid_to_string  parent_window_id) (xtype_to_string::xid_to_string  created_window_id); };
                        NOTE_NEW_WINDOW { parent_window_id, created_window_id, box };
                    };

                pick_xevent_action (et::x::DESTROY_NOTIFY { event_window_id, destroyed_window_id, ... } )
                    =>
                    event_window_id == destroyed_window_id
                        ##
                        ??  NOTE_WINDOW_DESTRUCTION  event_window_id    # Remove window from registry. 
                        ::  SEND_TO_WINDOW           event_window_id;   # Report to parent that child is dead. 

                pick_xevent_action (et::x::UNMAP_NOTIFY { event_window_id, unmapped_window_id, ... } )
                    =>
                    ignore_substructure_notify_xevents (event_window_id, unmapped_window_id);

                pick_xevent_action (et::x::MAP_NOTIFY { event_window_id, mapped_window_id, ... } )
                    =>
                    ignore_substructure_notify_xevents (event_window_id, mapped_window_id);


                pick_xevent_action (et::x::REPARENT_NOTIFY _)
                    =>
                    IGNORE;

                pick_xevent_action (et::x::CONFIGURE_NOTIFY { event_window_id, configured_window_id, box, ... } )
                    =>
                    case (ignore_substructure_notify_xevents (event_window_id, configured_window_id))
                        #
                        SEND_TO_WINDOW _ =>  NOTE_SITE_CHANGE_AND_SEND_TO_WINDOW (configured_window_id, box);
                        _                =>  IGNORE;
                    esac;


                pick_xevent_action (et::x::GRAVITY_NOTIFY { event_window_id, moved_window_id, ... } )
                    =>
                    ignore_substructure_notify_xevents (event_window_id, moved_window_id);


                pick_xevent_action (et::x::CIRCULATE_NOTIFY { event_window_id, circulated_window_id, ... } )
                    =>
                    ignore_substructure_notify_xevents (event_window_id, circulated_window_id);


                pick_xevent_action (et::x::PROPERTY_NOTIFY   _) => SEND_TO_WINDOW_PROPERTY_IMP;    # We may have other uses of PropertyNotify someday.
                pick_xevent_action (et::x::SELECTION_CLEAR   _) => SEND_TO_SELECTION_IMP;
                pick_xevent_action (et::x::SELECTION_REQUEST _) => SEND_TO_SELECTION_IMP;
                pick_xevent_action (et::x::SELECTION_NOTIFY  _) => SEND_TO_SELECTION_IMP;

                pick_xevent_action (et::x::COLORMAP_NOTIFY { window_id, ... } ) => SEND_TO_WINDOW window_id;
                pick_xevent_action (et::x::CLIENT_MESSAGE  { window_id, ... } ) => SEND_TO_WINDOW window_id;

                pick_xevent_action  et::x::MODIFIER_MAPPING_NOTIFY     => SEND_TO_ALL_WINDOWS;
                pick_xevent_action (et::x::KEYBOARD_MAPPING_NOTIFY _)  => SEND_TO_ALL_WINDOWS;
                pick_xevent_action  et::x::POINTER_MAPPING_NOTIFY      => SEND_TO_ALL_WINDOWS;

                pick_xevent_action e => {
                   xgripe::warning (string::cat [
                     "[xsocket-to-topwin: unexpected ", xevent_to_string::xevent_name e, " event]\n"]);
                   IGNORE;};
              end;
    #  +DEBUG 

        # Define a tracelogging version of
        #
        #     pick_xevent_action
        #
        stipulate

            xid_to_string = xtype_to_string::xid_to_string;

            fun xevent_action_to_string (SEND_TO_WINDOW w)
                    =>
                    ("SEND_TO_WINDOW(" + xid_to_string w + ")");

                xevent_action_to_string (NOTE_EXPOSE_AND_SEND_TO_WINDOW w)
                    =>
                    ("NOTE_EXPOSE_AND_SEND_TO_WINDOW(" + xid_to_string w + ")");

                xevent_action_to_string (NOTE_SITE_CHANGE_AND_SEND_TO_WINDOW (w,_))
                    =>
                    ("NOTE_SITE_CHANGE_AND_SEND_TO_WINDOW(" + xid_to_string w + ")");

                xevent_action_to_string (NOTE_NEW_WINDOW { parent_window_id, created_window_id, box } )
                    =>
                    string::cat
                      [
                        "NOTE_NEW_WINDOW { parent=",  xid_to_string  parent_window_id,
                              ", new_window=",  xid_to_string created_window_id,
                        "}"
                      ];

                xevent_action_to_string (NOTE_WINDOW_DESTRUCTION w) => ("NOTE_WINDOW_DESTRUCTION(" + xid_to_string w + ")");
                xevent_action_to_string SEND_TO_KEYMAP_IMP          => "SEND_TO_KEYMAP_IMP";
                xevent_action_to_string SEND_TO_WINDOW_PROPERTY_IMP => "SEND_TO_WINDOW_PROPERTY_IMP";
                xevent_action_to_string SEND_TO_SELECTION_IMP       => "SEND_TO_SELECTION_IMP";
                xevent_action_to_string SEND_TO_ALL_WINDOWS         => "SEND_TO_ALL_WINDOWS";
                xevent_action_to_string IGNORE                      => "IGNORE";
            end;

        herein

            pick_xevent_action
                =
                fn xevent
                    =
                    {   xevent_action =  pick_xevent_action  xevent;

                        trace .{
                            #
                            cat [ "xsocket_to_topwindow_router: ", xevent_to_string::xevent_name  xevent,
                                  " => ", xevent_action_to_string xevent_action
                                ];
                        };

                        xevent_action;
                    };
        end;
    #  -DEBUG 

        herein

            Xsocket_To_Topwindow_Router
                =
                XSOCKET_TO_TOPWINDOW_ROUTER 
                  {
                    plea_slot:    Mailslot( plea::Mail ),
                    reply_slot:   Mailslot( Mailop( (Envelope_Route, et::x::Event) ) ),
                    lock_slot:    Mailslot( Bool )
                  };



            stipulate

                fun set_window_subtree_locks_to
                        (bool: Bool)    
                    =
                    set
                    where
                        fun set (WINDOW_INFO { lock, children, ... } )
                            =
                            {   lock := bool;
                                set_list *children;
                            }

                        also
                        fun set_list (wd ! r)
                                =>
                                {   set wd;
                                    set_list r;
                                };

                            set_list []
                                =>
                                ();
                        end;
                    end;
            herein

                lock_tree   =  set_window_subtree_locks_to   TRUE;
                unlock_tree =  set_window_subtree_locks_to   FALSE;

            end;

            # This is called exactly one place, in
            #     src/lib/x-kit/xclient/pkg/window/xsession.pkg
            #
            fun make_xsocket_to_topwindow_router
                {
                  xdisplay => dy::XDISPLAY { xsocket, ... },
                  keymap_imp,
                  to_window_property_imp_slot,
                  to_selection_imp_slot
                }
                =
                {
                    xevent_in'
                        =
                        xok::wait_for_xevent  xsocket;

                    plea_slot  =   make_mailslot ();
                    reply_slot =   make_mailslot ();
                    lock_slot  =   make_mailslot ();

                    plea_in'   =   take'  plea_slot;


                                                                    # hash_xid  is from   src/lib/x-kit/xclient/pkg/stuff/hash-xid.pkg

                    my window_id_to_window_info_map:   hash_xid::Xid_Map( Window_Info )
                        =
                        hash_xid::make_map ();
                    #
                    get_info  =  hash_xid::get     window_id_to_window_info_map;
                    set_info  =  hash_xid::set     window_id_to_window_info_map;
                    drop_info =  hash_xid::remove  window_id_to_window_info_map;
                        #
                        # This is our primary state, mapping
                        # Window_Id to Window_Info values.



                    my window_id_to_oneshot_map:       hash_xid::Xid_Map( Oneshot_Maildrop(Void) )
                        =
                        hash_xid::make_map ();
                    #
                    get_oneshot  =  hash_xid::get     window_id_to_oneshot_map;
                    set_oneshot  =  hash_xid::set     window_id_to_oneshot_map;
                    drop_oneshot =  hash_xid::remove  window_id_to_oneshot_map;
                        #
                        # There is an unfortunate race condition in which
                        #         NOTE_''SEEN_FIRST_EXPOSE''_ONESHOT
                        # requests on a window_id may arrive from a client
                        # thread before we have seen the
                        #     NOTE_NEW_WINDOW
                        # from the X server which creates the
                        #     window_id_to_window_info_map
                        # entry for that window_id.  We use the above map
                        # to hold such "prematurely registered" requests
                        # pending arrival of the corresponding NOTE_NEW_WINDOW.

                    
                    my  gui_startup_complete_oneshot:  Oneshot_Maildrop( Void )
                        =       
                        make_oneshot_maildrop ();
                            #
                            # This maildrop exists to give application threads
                            # something to wait on before presuming that the
                            # GUI widgettree windows, threads etc are ready for action.
                            #
                            # Currently we set this when we first
                            # get an EXPOSE X event from the X server.          
                            #
                    seen_first_expose_xevent_of_session
                        =
                        REF FALSE;

                    fun do_plea (plea::NOTE_NEW_TOPWINDOW  (window_id, window_site))
                            =>
                            {   # Log a new top-level window:

                                to_topwindow_slot = make_mailslot ();

                                # Handle any prematurely-registered oneshot.
                                # I'm not sure a topwindow will ever get an
                                # EXPOSE event, so this may be pointless:
                                #
                                oneshot =   {   oneshot =  get_oneshot  window_id;
                                                drop_oneshot  window_id;
                                                THE oneshot;
                                            }   
                                            except
                                                hash_xid::XID_NOT_FOUND
                                                    =
                                                    NULL;

                                set_info
                                  ( window_id,
                                    WINDOW_INFO
                                      {
                                        window_id,
                                        to_topwindow_slot,
                                        route       =>  ENVELOPE_ROUTE_END  window_id,
                                        parent_info =>  NULL,
                                        children    =>  REF [],
                                        lock        =>  REF FALSE,
                                        site        =>  REF (xg::site_to_box window_site),
                                        #
                                        seen_first_expose         => REF( FALSE ),
                                        seen_first_expose_oneshot => REF( oneshot )
                                      }
                                  );

                                give  (reply_slot,  take'  to_topwindow_slot);
                            }
                            except hash_xid::XID_NOT_FOUND = ();

                        do_plea (plea::NOTE_''SEEN_FIRST_EXPOSE''_ONESHOT  (window_id, oneshot))
                            =>
                            {   # Note the oneshot used to signal receipt
                                # of the first EXPOSE event on a window:
trace .{ sprintf "NOTE_''SEEN_FIRST_EXPOSE''_ONESHOT/TOP: window_id s=%s" (xtype_to_string::xid_to_string window_id); };

                                {   (get_info  window_id)
                                        ->
                                        WINDOW_INFO { 
                                            seen_first_expose   => REF( seen_first_expose ),
                                            seen_first_expose_oneshot,
                                            ...
                                        };

trace .{ sprintf "NOTE_''SEEN_FIRST_EXPOSE''_ONESHOT/MID: window_id s=%s, first_expose b=%s" (xtype_to_string::xid_to_string window_id) case seen_first_expose TRUE => "TRUE"; _ => "FALSE"; esac; };
                                    seen_first_expose_oneshot :=   THE oneshot;

                                    if seen_first_expose
                                        #
                                        set (oneshot, ());                              # This shouldn't happen.
                                    fi;
                                }
                                except hash_xid::XID_NOT_FOUND
                                    =
                                    {
trace .{ sprintf "NOTE_''SEEN_FIRST_EXPOSE''_ONESHOT/MUD: window_id s=%s: WINDOW_INFO record does not exist yet, parking the oneshot" (xtype_to_string::xid_to_string window_id); };
                                        set_oneshot (window_id, oneshot);               # WINDOW_INFO record doesn't exist yet, so park oneshot for now.
                                    };
                                        
trace .{ sprintf "NOTE_''SEEN_FIRST_EXPOSE''_ONESHOT/BOT: window_id s=%s" (xtype_to_string::xid_to_string window_id); };
                            };
                            

                        do_plea (plea::LOCK_WINDOW   window_id) =>   lock_tree (get_info  window_id)  except hash_xid::XID_NOT_FOUND = ();
                        do_plea (plea::UNLOCK_WINDOW window_id) => unlock_tree (get_info  window_id)  except hash_xid::XID_NOT_FOUND = ();

                        do_plea (plea::IS_WINDOW_LOCKED window_id)
                            =>
                            {   (get_info  window_id)
                                    ->
                                    WINDOW_INFO { lock, ... };

                                give  (lock_slot,  *lock);
                            }
                            except
                                hash_xid::XID_NOT_FOUND
                                    =
                                    {   trace .{ sprintf "ERROR!!  IS_WINDOW_LOCKED: window_id %s not yet registered" (xtype_to_string::xid_to_string window_id); };
                                        ();                                             # We probably should be either returning NULL or generating an exception in client thread here.  XXX BUGGO FIXME
# XXX BUGGO FIXME I think maybe we should be registering window ids here before putting
# them into circulation, so as to basically eliminate the possibility of this error.
                                    };

                        do_plea (plea::GET_WINDOW_SITE (window_id, reply_oneshot))
                            =>
                            {   (get_info  window_id)
                                    ->
                                    WINDOW_INFO { site, ... };

                                set (reply_oneshot,  *site);
                            }
                            except
                                hash_xid::XID_NOT_FOUND
                                    =
                                    {   trace .{ sprintf "ERROR!!  GET_WINDOW_SITE: window_id %s not yet registered" (xtype_to_string::xid_to_string window_id); };
                                        ();                                             # We probably should be either returning NULL or generating an exception in client thread here.  XXX BUGGO FIXME
# XXX BUGGO FIXME I think maybe we should be registering window ids here before putting
# them into circulation, so as to basically eliminate the possibility of this error.
                                    };

                        do_plea (plea::GET_''SEEN_FIRST_EXPOSE''_ONESHOT (window_id, reply_oneshot))
                            =>
                            {   (get_info  window_id)
                                    ->
                                    WINDOW_INFO { seen_first_expose_oneshot, ... };

                                set (reply_oneshot,  *seen_first_expose_oneshot);
                            }
                            except hash_xid::XID_NOT_FOUND
                                =
                                {   set (reply_oneshot,  THE (get_oneshot  window_id))
                                    except
                                        hash_xid::XID_NOT_FOUND
                                            =
                                            {   trace .{ sprintf "ERROR!!  GET_''SEEN_FIRST_EXPOSE''_ONESHOT: window_id %s not yet registered" (xtype_to_string::xid_to_string window_id); };
                                                set (reply_oneshot,  NULL);             # We probably should be generating an exception in client thread here.  XXX BUGGO FIXME
# XXX BUGGO FIXME I think maybe we should be registering window ids here before putting
# them into circulation, so as to basically eliminate the possibility of this error.
                                            };
                                };

                        do_plea (plea::GET_''GUI_STARTUP_COMPLETE''_ONESHOT reply_oneshot)
                            =>
                            set (reply_oneshot, gui_startup_complete_oneshot);
                    end;

                    fun note_new_subwindow (parent_window_id, child_window_id, box)
                        =
                        {
                            (get_info  parent_window_id)
                                -> 
                                parent_info as WINDOW_INFO { route, to_topwindow_slot, children, lock, ... };

                            fun extend_route (ENVELOPE_ROUTE_END window_id)      =>  ENVELOPE_ROUTE (window_id, ENVELOPE_ROUTE_END child_window_id);
                                extend_route (ENVELOPE_ROUTE (window_id, route)) =>  ENVELOPE_ROUTE (window_id, extend_route route);
                            end;

                            child_route = extend_route route;

                            # Handle any prematurely-registered oneshot:
                            #
                            oneshot =   {   oneshot =  get_oneshot  child_window_id;
                                            drop_oneshot            child_window_id;
trace .{ sprintf "note_new_subwindow: window_id s=%s PICKING UP PREMATURELY REGISTERED ONESHOT" (xtype_to_string::xid_to_string child_window_id); };
                                            THE oneshot;
                                        }       
                                        except
                                            hash_xid::XID_NOT_FOUND
                                                =
                                                NULL;

                            child_info
                                =
                                WINDOW_INFO
                                  {
                                    window_id   =>  child_window_id,
                                    route       =>  child_route,
                                    site        =>  REF box,
                                    parent_info =>  THE parent_info,
                                    children    =>  REF [],
                                    lock        =>  REF *lock,
                                    #
                                    to_topwindow_slot,
                                    #
                                    seen_first_expose         =>  REF( FALSE ),
                                    seen_first_expose_oneshot =>  REF( oneshot )
                                  };

                            children := child_info ! *children;

                            set_info (child_window_id, child_info);
                        };


                    fun note_site_change (window_id, box)
                        =
                        {   (get_info window_id) ->  WINDOW_INFO { site, ... };

                            site := box;
                        }
                        except
                            hash_xid::XID_NOT_FOUND = ();


                    fun maybe_note_first_expose_event  window_id
                        =
                        {
                            # If this is the first EXPOSE event seen for
                            # this X session, broadcast that fact for
                            # anyone waiting:
                            #
                            if (not *seen_first_expose_xevent_of_session)
                                #
                                seen_first_expose_xevent_of_session :=  TRUE;
                                #
                                set (gui_startup_complete_oneshot, ());
                            fi; 

                            # If this is the first EXPOSE event for window,
                            # remember that we've seen it and set the
                            # condition variable   seen_first_expose_oneshot
                            # to notify any threads waiting for the
                            # EXPOSE -- see   seen_first_redraw_oneshot_of   in
                            #     src/lib/x-kit/widget/basic/widget.api
                            # 
                            (get_info  window_id)
                                ->
                                WINDOW_INFO
                                  { seen_first_expose         =>      seen_first_expose,
                                    seen_first_expose_oneshot =>  REF seen_first_expose_oneshot,
                                    ...
                                  };

trace .{ sprintf "maybe_note_first_expose_event: window_id s=%s, first_expose b=%s" (xtype_to_string::xid_to_string window_id) case seen_first_expose REF TRUE => "TRUE"; _ => "FALSE"; esac; };
                            case seen_first_expose
                                #
                                REF TRUE  => ();                        # Nothing to do.

                                REF FALSE =>
                                    {
                                        seen_first_expose :=  TRUE;
trace .{ sprintf "maybe_note_first_expose_event: window_id s=%s, first_expose b=%s FIRST EXPOSE NOTED" (xtype_to_string::xid_to_string window_id) case seen_first_expose REF TRUE => "TRUE"; _ => "FALSE"; esac; };

                                        case seen_first_expose_oneshot
                                            #
                                            THE oneshot =>  set (oneshot, ());          # Tell all waiting threads this widget is GO for action. :-)
                                            NULL        =>  ();                         # Oneshot not yet registered -- shouldn't really happen,
                                        esac;                                           # but no big deal, we'll set it when it arrives.
                                    };
                            esac;
                        }
                        except
                            hash_xid::XID_NOT_FOUND = ();


                    fun route_xevent_per_window_info (e, WINDOW_INFO { route, to_topwindow_slot, ... } )
                        = 
                        give  (to_topwindow_slot, (route, e));


                    fun route_xevent_to_window_id (xevent, window_id)
                        =
                        route_xevent_per_window_info (xevent, get_info window_id)
                        except
                            hash_xid::XID_NOT_FOUND = ();

                    fun do_xevent xevent
                        =
                        case (pick_xevent_action xevent)
                            #
                            SEND_TO_WINDOW  window_id
                                =>
                                route_xevent_to_window_id (xevent, window_id);

                            NOTE_EXPOSE_AND_SEND_TO_WINDOW  window_id
                                =>
                                {
                                    maybe_note_first_expose_event window_id;

                                    route_xevent_to_window_id (xevent, window_id);
                                };

                            NOTE_SITE_CHANGE_AND_SEND_TO_WINDOW (window_id, box)
                                =>
                                {   note_site_change (window_id, box);                  # Window has changed size and/or position.
                                    route_xevent_to_window_id (xevent, window_id);
                                };

                            NOTE_NEW_WINDOW { parent_window_id, created_window_id, box }
                                =>
                                {   note_new_subwindow (parent_window_id, created_window_id, box);
                                    #
                                    route_xevent_to_window_id (xevent, parent_window_id);
                                };

                            NOTE_WINDOW_DESTRUCTION  window_id
                                =>
                                case (drop_info  window_id)
                                    #
                                    (window_info as WINDOW_INFO { parent_info => THE (WINDOW_INFO { children, ... } ), ... } )
                                        =>
                                        {   fun remove_child ((window_info' as WINDOW_INFO { window_id => window_id', ... } ) ! rest)
                                                    =>
                                                    if (window_id' == window_id)  rest;
                                                    else                          (window_info' ! (remove_child rest));
                                                    fi;

                                                remove_child []
                                                    =>
                                                    {   xgripe::warning "[xsocket-to-topwin: missing child]";
                                                        [];
                                                    };
                                            end;

                                            children
                                                :=
                                                remove_child *children;

                                            route_xevent_per_window_info (xevent, window_info);
                                        };

                                    window_info
                                        =>
                                        route_xevent_per_window_info (xevent, window_info);
                                esac;

                            SEND_TO_KEYMAP_IMP
                                =>
                                {   xgripe::warning "[xsocket-to-topwin: unexpected SEND_TO_KEYMAP_IMP]";
                                    ();
                                };

                            SEND_TO_WINDOW_PROPERTY_IMP  =>  give  (to_window_property_imp_slot, xevent);
                            SEND_TO_SELECTION_IMP        =>  give  (to_selection_imp_slot,       xevent);

                            IGNORE => ();

                            SEND_TO_ALL_WINDOWS
                                =>
                                apply (fn (_, window_info) = route_xevent_per_window_info (xevent, window_info))
                                      (hash_xid::list  window_id_to_window_info_map);
                        esac;

                    mailop =  choose [
                                  plea_in'   ==>  do_plea,
                                  xevent_in' ==>  do_xevent
                              ];

                    # fun loop () = {   do_mailop mailop; loop(); };
          /* DEBUG */ fun loop () = {   trace .{ "xsocket_to_topwindow_router: loop: Top."; };
                                        do_mailop mailop;
                                        loop();
                                    };

                    xtr::make_thread  "xsocket-to-topwin"  loop;

                    XSOCKET_TO_TOPWINDOW_ROUTER { plea_slot, reply_slot, lock_slot };
                };                                                                              # fun make_xsocket_to_topwindow_router


            # Add 'topwindow' to    window_id_to_window_info_map
            # and return the event slot through which we will feed
            # X events to that window and its subwindows.
            #
            # This function is called (only) from    make_topwindow_to_widget_router   in
            #
            #     src/lib/x-kit/xclient/pkg/window/topwindow-to-widget-router.pkg
            #
            fun note_new_topwindow
                  ( XSOCKET_TO_TOPWINDOW_ROUTER { plea_slot, reply_slot, ... },
                    topwindow_id,
                    site
                  )
                =
                {   give  (plea_slot,  plea::NOTE_NEW_TOPWINDOW (topwindow_id, site));
                    #
                    take   reply_slot;
                };

            # This is nowhere called:
            #
            fun lock_window_tree (XSOCKET_TO_TOPWINDOW_ROUTER { plea_slot, reply_slot, ... }, window_id)
                =
                {   give (plea_slot, plea::LOCK_WINDOW window_id);

                    .{  give (plea_slot, plea::UNLOCK_WINDOW window_id);  };
                };

            # This gets called exactly one place, in
            #
            #     src/lib/x-kit/xclient/pkg/window/draw-imp.pkg
            #
            fun window_is_locked (XSOCKET_TO_TOPWINDOW_ROUTER { plea_slot, lock_slot, ... }, window_id)
                =
                {   give (plea_slot, plea::IS_WINDOW_LOCKED window_id);
                    #
                    take lock_slot;
                };

            fun get_window_site (XSOCKET_TO_TOPWINDOW_ROUTER { plea_slot, ... }, window_id)
                =
                {   reply_oneshot = make_oneshot_maildrop ();

                    give (plea_slot, plea::GET_WINDOW_SITE (window_id, reply_oneshot));
                    #
                    get reply_oneshot;
                };


            # 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/basic/widget.api
            #   
            # The oneshot in question originates at widget
            # creation time -- make_widget in
            #
            #     src/lib/x-kit/widget/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_fn in widget.pkg.
            # This ensures that we have the onehost on hand
            # when we recieve a window's first EXPOSE event.
            #
            fun note_window's_''seen_first_expose''_oneshot
                    (XSOCKET_TO_TOPWINDOW_ROUTER { plea_slot, ... }, window_id, oneshot)
                =
                {
trace .{ sprintf "note_window's_seen_first_expose_oneshot/TOP: window_id s=%s" (xtype_to_string::xid_to_string window_id); };
                    give (plea_slot, plea::NOTE_''SEEN_FIRST_EXPOSE''_ONESHOT (window_id, oneshot));
trace .{ sprintf "note_window's_seen_first_expose_oneshot/BOT: window_id s=%s" (xtype_to_string::xid_to_string window_id); };
                };


            fun get_''seen_first_expose''_oneshot_of (XSOCKET_TO_TOPWINDOW_ROUTER { plea_slot, ... }, window_id)
                =
                {   reply_oneshot = make_oneshot_maildrop ();

                    give (plea_slot, plea::GET_''SEEN_FIRST_EXPOSE''_ONESHOT (window_id, reply_oneshot));
                    #
                    get reply_oneshot;
                };

            fun get_''gui_startup_complete''_oneshot_of (XSOCKET_TO_TOPWINDOW_ROUTER { plea_slot, ... })
                =
                {   reply_oneshot = make_oneshot_maildrop ();

                    give (plea_slot, plea::GET_''GUI_STARTUP_COMPLETE''_ONESHOT reply_oneshot);
                    #
                    get reply_oneshot;
                };

        end;                                    # stipulate
    };                                          # package xsocket_to_topwindow_router
end;


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext