From 38b5393f4c44e157aacc1a87d6981f2a4f6bc2ff Mon Sep 17 00:00:00 2001
From: Jan Nieuwenhuizen <janneke@gnu.org>
Date: Wed, 10 Nov 2004 20:21:13 +0000
Subject: [PATCH] (item-event): Add support from TLA.  Support animated/opaque
 grob dragging tweaks.

---
 lily/lily-parser.cc     |  5 ++--
 scm/framework-gnome.scm | 52 ++++++++++++++++++++---------------------
 2 files changed, 28 insertions(+), 29 deletions(-)

diff --git a/lily/lily-parser.cc b/lily/lily-parser.cc
index 1700609a18..96ec79f0e3 100644
--- a/lily/lily-parser.cc
+++ b/lily/lily-parser.cc
@@ -101,8 +101,9 @@ Lily_parser::parse_file (String init, String name, String out_name)
   set_yydebug (0);
 
   lexer_->new_input (init, sources_);
-#ifdef TWEAK  
-  String s = global_path.find (name + ".t");
+#ifdef TWEAK
+  File_name f (name);
+  String s = global_path.find (f.base_ + ".twy");
   if (s == "")
     Grob_selector::set_tweaks (SCM_EOL);
   else
diff --git a/scm/framework-gnome.scm b/scm/framework-gnome.scm
index c889bd8d6b..59ee4a367c 100644
--- a/scm/framework-gnome.scm
+++ b/scm/framework-gnome.scm
@@ -294,23 +294,21 @@
 		     (cons (car extra-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))))
-    ))
+			 (cons
+			  'extra-offset
+			  (list
+			   (cons (+ (car origin) (car offset))
+				 (- 0 (+ (cdr origin) (cdr offset))))))))))
 
+;; FIXME: this only saves new tweaks, old tweaks are lost.
 (define-method (save-tweaks (go <gnome-outputter>))
-  (let ;;((file (current-error-port)))
-      ((file (open-file (string-append (name go) ".ly.t") "w")))
-    (format file ";;; TWEAKS \n")
-    (format file ";;(define grob-id-tweak-alist \n'(\n")
-    (hash-fold
-     (lambda (key value seed)
-       (format file "(~S extra-offset ~S)\n"
-	       (if (ly:grob? key) (ly:grob-id key) ";;unidentified grob")
-	       value))
-     #f (grob-tweaks go))
-    (format file ")\n;;)\n")))
+  (let ((tweaks (hash-fold
+		 (lambda (key value seed)
+		   (cons (cons (ly:grob-id key) value) seed))
+		 '() (grob-tweaks go))))
+    (if (not (null? tweaks))
+	(let ((file (open-file (string-append (name go) ".twy") "w")))
+	  (format file ";;; TWEAKS \n'~S\n" tweaks)))))
 
 ;;;(define (item-event go grob item event)
 (define (item-event go item event)
@@ -320,21 +318,19 @@
     ((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))
-			 (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)))
+			 (let ((x (gdk-event-motion:x event))
+			       (y (gdk-event-motion:y event))
+			       (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))
-				 (s output-scale)
-				 (o (drag-origin go))
-				 (r (drag-location go)))
+			  (let ((x (gdk-event-button:x event))
+				(y (gdk-event-button:y event))
+				(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)
@@ -374,7 +370,9 @@
 	    (debugf "GROB: ~S\n" grob)
 	    (debugf "PROPERTIES: ~S\n" properties)
 	    (debugf "BASIC PROPERTIES: ~S\n" basic-properties)
-	    
+
+	    ;; FIXME: dialog iso window?
+	    ;; http://www.gtk.org/tutorial/sec-textentries.html
 	    (let ((window (make <gtk-window>))
 		  (vbox (make <gtk-vbox>))
 		  (button (make <gtk-button> #:label "Ok")))
-- 
2.39.5