From 97870282c2b70f23dfaea9969106454f6b718166 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sat, 19 Feb 2011 19:42:20 -0700 Subject: [PATCH] gtk: keep popup menus on the screen Closes PR 11414 --- collects/mred/private/wx/gtk/menu.rkt | 20 ++++++++++++++++++-- 1 file changed, 18 insertions(+), 2 deletions(-) diff --git a/collects/mred/private/wx/gtk/menu.rkt b/collects/mred/private/wx/gtk/menu.rkt index 3536dad568..bd0481f2fc 100644 --- a/collects/mred/private/wx/gtk/menu.rkt +++ b/collects/mred/private/wx/gtk/menu.rkt @@ -33,6 +33,10 @@ _pointer _uint _uint32 -> _void)) +(define-gtk gtk_widget_get_screen (_fun _GtkWidget -> _GdkScreen)) +(define-gdk gdk_screen_get_width (_fun _GdkScreen -> _int)) +(define-gdk gdk_screen_get_height (_fun _GdkScreen -> _int)) + (define-signal-handler connect-menu-item-activate "activate" (_fun _GtkWidget -> _void) (lambda (gtk) @@ -122,8 +126,20 @@ #f #f (lambda (menu _x _y _push) - (ptr-set! _x _int x) - (ptr-set! _y _int y) + (let ([r (make-GtkRequisition 0 0)]) + (gtk_widget_size_request menu r) + ;; Try to keep the menu on the screen: + (let* ([s (gtk_widget_get_screen menu)] + [sw (gdk_screen_get_width s)] + [sh (gdk_screen_get_height s)]) + (ptr-set! _x _int (min x + (max 0 + (- sw + (GtkRequisition-width r))))) + (ptr-set! _y _int (min y + (max 0 + (- sh + (GtkRequisition-height r))))))) (ptr-set! _push _gboolean #t)) #f 0