* scm/framework-gnome.scm (item-event): Add support from TLA. Support

	animated/opaque grob dragging tweaks.

	* buildscripts/guile-gnome.sh: Update.

diff --git a/ChangeLog b/ChangeLog
index 20874977f5120ce46f06e3d01e7c197650e948f8..101e0e3d1ebbf9a5a3bfa8ee113e7949c3dbbcbb 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2004-11-10  Jan Nieuwenhuizen  <janneke@gnu.org>
+
+       * scm/framework-gnome.scm (item-event): Add support from TLA.  Support
+       animated/opaque grob dragging tweaks.
+
+       * buildscripts/guile-gnome.sh: Update.
+
 2004-11-10  Mats Bengtsson  <mabe@drongo.s3.kth.se>
 
        * scm/define-grobs.scm (all-grob-descriptions): Added

diff --git a/buildscripts/guile-gnome.sh b/buildscripts/guile-gnome.sh
index 194dad2c27e649bccdaa49c6724e4b306c593efe..8633c952706930a1bf8b4e48d873921b8673d362 100644 (file)
--- a/buildscripts/guile-gnome.sh
+++ b/buildscripts/guile-gnome.sh
@@ -21,7 +21,7 @@ SLIB_PATH=`locate slib/require.scm | head -1 | sed -s 's/require.scm//g'`
 
 # What extra modules to pull (eg: EXTRA="libgnomecanvas libwnck")
 EXTRA=${EXTRA-libgnomecanvas}
-GGVERSION=2.7.91
+GGVERSION=2.7.94
 GWRAPVERSION=1.9.3
 
 download=$HOME/usr/src/releases
@@ -98,7 +98,7 @@ GUILE_LOAD_PATH=$OPT/g-wrap/share/guile/site:$GUILE_LOAD_PATH:$SLIB_PATH
 
 ## 4.  get g-wrap 2.0
 ## note that bleeding edge (2004-9-13) g-wrap breaks guile-gnome.
-if ! pkg-config --exact-version=1.9.1 g-wrap-2.0-guile; then
+if ! pkg-config --atleast-version=$GWRAPVERSION g-wrap-2.0-guile; then
     if [ -n "$BLOEDIGE_RAND" ]; then
        tla register-archive a.rottmann@gmx.at--2004-main \
            http://people.debian.org/~rotty/arch/a.rottmann@gmx.at/2004-main || true

diff --git a/scm/framework-gnome.scm b/scm/framework-gnome.scm
index 976eacb02665eb5c1420b1e5cc20df7363a14b8d..c889bd8d6b8548d20c14c10b0e300175483785b2 100644 (file)
--- a/scm/framework-gnome.scm
+++ b/scm/framework-gnome.scm
@@ -18,6 +18,65 @@
  (gnome gtk gdk-event)
  (gnome gw canvas))
 
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Wrappers from guile-gnome TLA
+;;; guile-gnome-devel@gnu.org--2004
+;;; http://arch.gna.org/guile-gnome/archive-2004
+;;;
+;;; janneke@gnu.org--2004-gnome
+;;; http://lilypond.org/~janneke/{arch}/2004-gnome
+;;;
+(if (not (defined? 'gdk-event-motion:x))
+    (define (gdk-event-motion:x event)
+      (let ((vector (gdk-event->vector event)))
+       (case (gdk-event:type event)
+         ((motion-notify)
+          (vector-ref vector 4))
+         (else
+          (gruntime-error "Event not of the proper type: ~A" event))))))
+
+(if (not (defined? 'gdk-event-motion:y))
+    (define (gdk-event-motion:y event)
+      (let ((vector (gdk-event->vector event)))
+       (case (gdk-event:type event)
+         ((motion-notify)
+          (vector-ref vector 5))
+         (else
+          (gruntime-error "Event not of the proper type: ~A" event))))))
+
+; (if (not (defined? 'gdk-event-motion:x-root))
+;     (define (gdk-event-motion:x-root event)
+;       (let ((vector (gdk-event->vector event)))
+;      (case (gdk-event:type event)
+;        ((motion-notify)
+;         (vector-ref vector 9))
+;        (else
+;         (gruntime-error "Event not of the proper type: ~A" event))))))
+
+; (if (not (defined? 'gdk-event-motion:y-root))
+;     (define (gdk-event-motion:y-root event)
+;       (let ((vector (gdk-event->vector event)))
+;      (case (gdk-event:type event)
+;        ((motion-notify)
+;         (vector-ref vector 10))
+;        (else
+;         (gruntime-error "Event not of the proper type: ~A" event))))))
+
+(if (not (defined? 'gdk-event-button:modifiers))
+    (define (gdk-event-button:modifiers event)
+      (let ((vector (gdk-event->vector event)))
+       (case (gdk-event:type event)
+         ((button-press button-release)
+          ;; We have to do some hackery here, because there are bitmasks
+          ;; used by XKB that we don't know about.
+          (gflags->symbol-list
+           (make <gdk-modifier-type>
+             #:value (logand #x1fff (vector-ref vector 6)))))
+         (else
+          (gruntime-error "Event not of the proper type: ~A" event))))))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
 (define-public (output-framework outputter book scopes fields basename)
   (gnome-main book basename))
 
@@ -39,8 +98,12 @@
       
 (define-class <gnome-outputter> ()
   (name #:init-value "untitled" #:init-keyword #:name #:accessor name)
+
+  ;; FIXME
   (dragging #:init-value #f #:accessor dragging)
   (drag-origin #:init-value #f #:accessor drag-origin)
+  (drag-location #:init-value #f #:accessor drag-location)
+  
   (page-stencils ;;#:init-value '#()
    #:init-keyword #:page-stencils #:accessor page-stencils)
   (window #:init-value (make <gtk-window> #:type 'toplevel) #:accessor window)
@@ -229,11 +292,12 @@
         (extra-offset (ly:grob-property grob 'extra-offset))
         (origin (if (null? extra-offset) '(0 . 0)
                     (cons (car extra-offset)
-                                       (- 0 (cdr extra-offset))))))
-    (if grob
-       (hashq-set! (grob-tweaks go) grob (cons (+ (car origin) (car offset))
-                                               (+ (cdr origin) (cdr offset)))))
-    (move item (car offset) (cdr offset))))
+                          (- 0 (cdr extra-offset))))))
+    (if grob (hashq-set! (grob-tweaks go) grob
+                        (cons (+ (car origin) (car offset))
+                              (- 0 (+ (cdr origin) (cdr offset))))))
+    ;;;(move item (car offset) (cdr offset))))
+    ))
 
 (define-method (save-tweaks (go <gnome-outputter>))
   (let ;;((file (current-error-port)))
@@ -256,14 +320,24 @@
     ((enter-notify) (gobject-set-property item 'fill-color "red"))
     ((leave-notify) (gobject-set-property item 'fill-color "black"))
     ((motion-notify) (if (ly:grob? (dragging go))
-                        ;; FIXME: wrap gdk-event-motion:*
-                        ;;(stderr "MOVE TO: \n")))
-                        #t))
+                        (let* ((x (gdk-event-motion:x event))
+                               (y (gdk-event-motion:y event))
+                               ;;(s (pixels-per-unit go))
+                               (s output-scale)
+                               (r (drag-location go)))
+                          ;;(stderr "MOVED AT: ~S ~S\n" x y)
+                          (move item (/ (- x (car r)) s) (/ (- y (cdr r)) s))
+                          (set! (drag-location go) (cons x y)))))
     ((button-release) (if (ly:grob? (dragging go))
-                         (let ((x (gdk-event-button:x event))
-                               (y (gdk-event-button:y event))
-                               (s (pixels-per-unit go))
-                               (o (drag-origin go)))
+                         (let* ((x (gdk-event-button:x event))
+                                (y (gdk-event-button:y event))
+                                ;;(s (pixels-per-unit go))
+                                (s output-scale)
+                                (o (drag-origin go))
+                                (r (drag-location go)))
+                           (move item (/ (- x (car r)) s) (/ (- y (cdr r)) s))
+                           (set! (drag-location go) #f)
+                           (set! (drag-origin go) #f)
                            (stderr "RELEASE at: ~S ~S\n" x y)
                            (set! (dragging go) #f)
                            (tweak go item (cons (/ (- x (car o)) s)
@@ -272,18 +346,21 @@
      (let ((button (gdk-event-button:button event)))
        (cond
        ((= button 1)
-        ;; FIXME: wrap gdk-event-button:state (== modifiers)
-        ;;(if (null? (gdk-event-button:state event))
+        (if (null? (gdk-event-button:modifiers event))
             (let ((x (gdk-event-button:x event))
                   (y (gdk-event-button:y event)))
               (stderr "CLICK at: ~S ~S\n" x y)
               (set! (dragging go) (hashq-ref (item-grobs go) item #f))
-              (set! (drag-origin go) (cons x y))))
-       ((= button 3)
-            ;; some modifier, do jump to source
-            (and-let* ((grob (hashq-ref (item-grobs go) item #f))
-                       (location (get-location grob)))
-                      (location-callback location)))
+              (set! (drag-origin go) (cons x y))
+              (set! (drag-location go) (cons x y)))
+            (begin
+              (stderr "CLICK WITH MODIFIERS: ~S\n"
+                      (gdk-event-button:modifiers event))
+            
+              ;; some modifier, do jump to source
+              (and-let* ((grob (hashq-ref (item-grobs go) item #f))
+                         (location (get-location grob)))
+                        (location-callback location)))))
        ((= button 2)
         (and-let*
          ((grob (hashq-ref (item-grobs go) item #f)))