Added <fix-resizer>: draw a resize handle in an h/vbox.
authorMatt Birkholz <matt@birkholz.chandler.az.us>
Thu, 22 Sep 2011 18:21:49 +0000 (11:21 -0700)
committerMatt Birkholz <matt@birkholz.chandler.az.us>
Thu, 22 Sep 2011 18:21:49 +0000 (11:21 -0700)
src/gtk/Includes/gtkstyle.cdecl
src/gtk/fix-demo.scm
src/gtk/fix-layout.scm
src/gtk/gtk.pkg

index ba8a20d03f8bc288316500b7abc9ba0c0e3282a3..cd8544669208af58098fd6b4bbfb448b87827f0a 100644 (file)
@@ -113,6 +113,18 @@ gtk-2.0/gtk/gtkstyle.h |#
        (x gint) (y gint)
        (width gint) (height gint))
 
+(extern void gtk_paint_handle
+       (style (* GtkStyle))
+       (window (* GdkWindow))
+       (state_type GtkStateType)
+       (shadow_type GtkShadowType)
+       (area (* (const GdkRectangle)))
+       (widget (* GtkWidget))
+       (detail (* (const gchar)))
+       (x gint) (y gint)
+       (width gint) (height gint)
+       (orientation GtkOrientation))
+
 (extern void gtk_paint_layout
        (style (* GtkStyle))
        (window (* GdkWindow))
index 541b79bac352a998dd3e38bbeb0ef25fb5f60b8c..5ed1e78ee3fc9e580c29c853bd3d1e4f30641f92 100644 (file)
@@ -29,21 +29,23 @@ USA.
 
 (define (make-fix-layout-demo)
   (let* ((window (gtk-window-new 'toplevel))
-        (vbox (gtk-vbox-new #t 0))
+        (vbox (gtk-vbox-new #f 0))
         (scroller1 (gtk-scrolled-window-new))
         (scroller2 (gtk-scrolled-window-new))
         (layout1 (make-demo-layout 200 200))
-        (layout2 (make-demo-layout 200 200)))
+        (layout2 (make-demo-layout 200 200))
+        (resizer (make-fix-resizer -1 10)))
     (gtk-window-set-opacity window 0.90)
     (gtk-window-set-title window "fix-layout-demo")
-    (gtk-window-set-default-size window 200 400)
+    ;;(gtk-window-set-default-size window 200 400)
     (set-gtk-window-delete-event-callback!
      window (lambda (w) (%trace ";closed "w"\n") 0))
     (gtk-container-set-border-width window 10)
     (gtk-container-add scroller1 layout1)
-    (gtk-container-add vbox scroller1)
+    (gtk-box-pack-start vbox scroller1 #t #t 0)
+    (gtk-box-pack-start vbox resizer #f #f 0)
     (gtk-container-add scroller2 layout2)
-    (gtk-container-add vbox scroller2)
+    (gtk-box-pack-start vbox scroller2 #t #t 0)
     (gtk-container-add window vbox)
     (gtk-widget-show-all window)
 
index ec5fe84112c91e67c0e444919a35cef71f413aa6..043044dcfb9816c4f789da3625e821b96dc8b6d4 100644 (file)
@@ -650,6 +650,55 @@ USA.
        ((= type (C-enum "GDK_3BUTTON_PRESS")) 'TRIPLE-PRESS)
        (else 'BOGUS)))
 \f
+;;; This is a simple <fix-widget> that handles expose events by
+;;; calling gtk_paint_handle().
+
+(define-class (<fix-resizer> (constructor () (width height)))
+    (<fix-widget>))
+
+(define-method initialize-instance ((widget <fix-resizer>) width height)
+  (call-next-method widget width height)
+  (set-gtk-widget-event-callback! widget resizer-event-callback))
+
+(define (resizer-event-callback resizer GdkEvent)
+  (%trace2 ";event "resizer" "GdkEvent)
+
+  (let ((type (C-> GdkEvent "GdkEvent any type")))
+    (%trace2 " "(C-enum "GdkEventType" type)"\n")
+    (if (int:= type (C-enum "GDK_EXPOSE"))
+       (let ((alien (gobject-alien resizer))
+             (event-window (C-> GdkEvent "GdkEvent any window"))
+             ;;(x (C-> GdkEvent "GdkEventExpose area x"))
+             ;;(y (C-> GdkEvent "GdkEventExpose area y"))
+             ;;(width (C-> GdkEvent "GdkEventExpose area width"))
+             ;;(height (C-> GdkEvent "GdkEventExpose area height"))
+             ;;(count (C-> GdkEvent "GdkEventExpose count"))
+             (widget-window (fix-widget-window resizer)))
+         (if (not (alien=? event-window widget-window))
+             (warn "Expose event on strange window:" event-window widget-window))
+         (let ((style (C-> alien "GtkWidget style"))
+               (state (C-> alien "GtkWidget state"))
+               (clip 0)
+               (widget 0)
+               (detail 0)
+               (geom (fix-widget-geometry resizer)))
+           (let ((orientation (if (fix:< (fix-rect-width geom)
+                                         (fix-rect-height geom))
+                                  (C-enum "GTK_ORIENTATION_VERTICAL")
+                                  (C-enum "GTK_ORIENTATION_HORIZONTAL"))))
+             (C-call "gtk_paint_handle"
+                     style widget-window state (C-enum "GTK_SHADOW_NONE")
+                     clip widget detail
+                     (or (fix-rect-x geom) 0) (or (fix-rect-y geom) 0)
+                     (fix-rect-width geom) (fix-rect-height geom)
+                     orientation)))
+         1 ;;TRUE -- "handled" -- done.
+         )
+       (begin
+         (warn "Unexpected event on resizer window:" (C-enum "GdkEventType" type))
+         0 ;; Unhandled.
+         ))))
+\f
 (define-class (<fix-drawing> (constructor () no-init))
     ()
   (extent define accessor initializer (lambda () (make-fix-rect 0 0 0 0)))
index 04e437c3002708e13b80f975dec34eb96a3e252c..6c73909ccff1c76af5dc7ffadeb8ec1692d14242 100644 (file)
@@ -234,6 +234,9 @@ USA.
          set-fix-layout-motion-handler!
          set-fix-layout-button-handler!
 
+         <fix-resizer>
+         make-fix-resizer
+
          <fix-drawing> guarantee-fix-drawing
          make-fix-drawing fix-drawing-widgets
          set-fix-drawing-size! fix-drawing-pick-list