Fix some bugs in the dynamic engraver and PostScript backend

[lilypond.git] / scm / framework-gnome.scm

diff --git a/scm/framework-gnome.scm b/scm/framework-gnome.scm
index 17d95d8819d354d81b06875c5ffc3cf23cd6e7b3..7243ccebbcf9c678cd2ff039fbc766e4af9b55ca 100644 (file)
--- a/scm/framework-gnome.scm
+++ b/scm/framework-gnome.scm
@@ -2,14 +2,18 @@
 ;;;;
 ;;;;  source file of the GNU LilyPond music typesetter
 ;;;; 
-;;;; (c) 2004--2005 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; (c) 2004--2006 Jan Nieuwenhuizen <janneke@gnu.org>
 
 ;;;; See output-gnome.scm for usage information.
 
 
 (define-module (scm framework-gnome))
 
-(use-modules (guile) (oop goops) (lily))
+(use-modules (guile)
+            (oop goops)
+            (scm page)
+            (scm paper-system)
+            (lily))
 
 (use-modules
  (srfi srfi-2)
@@ -30,10 +34,6 @@
 (define OUTPUT-SCALE (* 2.5 PIXELS-PER-UNIT))
 (define-public output-scale OUTPUT-SCALE)
 
-(define (stderr string . rest)
-  (apply format (cons (current-error-port) (cons string rest)))
-  (force-output (current-error-port)))
-
 (define (debugf string . rest)
   (if #f
       (apply stderr (cons string rest))))
@@ -111,12 +111,12 @@
 
 (define (gnome-main book name)
   (let* ((paper (ly:paper-book-paper book))
-        (hsize (ly:output-def-lookup paper 'hsize))
-        (vsize (ly:output-def-lookup paper 'vsize))
-        (page-width (inexact->exact (ceiling (* OUTPUT-SCALE hsize))))
-        (page-height (inexact->exact (ceiling (* OUTPUT-SCALE vsize))))
-        ;;(page-width (inexact->exact (ceiling hsize)))
-        ;;(page-height (inexact->exact (ceiling vsize)))
+        (paper-width (ly:output-def-lookup paper 'paper-width))
+        (paper-height (ly:output-def-lookup paper 'paper-height))
+        (page-width (inexact->exact (ceiling (* OUTPUT-SCALE paper-width))))
+        (page-height (inexact->exact (ceiling (* OUTPUT-SCALE paper-height))))
+        ;;(page-width (inexact->exact (ceiling paper-width)))
+        ;;(page-height (inexact->exact (ceiling paper-height)))
 
         (screen-width (gdk-screen-width))
         (screen-height (gdk-screen-height))
@@ -124,7 +124,7 @@
 
         (go (make <gnome-outputter>
               #:name name
-              #:page-stencils (list->vector (ly:paper-book-pages book))
+              #:page-stencils (list->vector (map page-stencil (ly:paper-book-pages book)))
               #:canvas-width page-width
               #:canvas-height page-height
               #:window-width
@@ -170,12 +170,6 @@
        (add (scrolled go) (canvas go))
        (show (canvas go)))))
 
-(define x-editor #f)
-(define (get-x-editor)
-  (if (not x-editor)
-      (set! x-editor (getenv "XEDITOR")))
-  x-editor)
-
 (define ifs #f)
 (define (get-ifs)
   (if (not ifs)
@@ -187,20 +181,9 @@
 (define (spawn-editor location)
   (let* ((file-name (car location))
         (line (cadr location))
-        (column (caddr location))
-        (template (substring (get-x-editor) 0))
-        
-        ;; Adhere to %l %c %f?
-        (command
-         (regexp-substitute/global
-          #f "%l" (regexp-substitute/global
-                   #f "%c"
-                   (regexp-substitute/global
-                    #f "%f" template 'pre file-name 'post)
-                   'pre (number->string column)
-                   'post)
-          'pre (number->string line) 'post)))
-    
+        (char (caddr location))
+        (column (cadddr location))
+        (command (get-editor-command file line char column)))
     (debugf "spawning: ~s\n" command)
     (if (= (primitive-fork) 0)
        (let ((command-list (string-split command #\ )));; (get-ifs))))
@@ -222,15 +205,19 @@
                (ly:input-location music-origin)
                #f)))
 
+;; todo: how to integrate nicely?
+;(define-public (tweak-grob-property grob sym val)
+;  (set! (ly:grob-property grob sym) val))
+
 
 (define-method (tweak (go <gnome-outputter>) item offset)
   (let* ((grob (hashq-ref (item-grobs go) item #f))
         (extra-offset (ly:grob-property grob 'extra-offset))
         (origin (if (null? extra-offset) '(0 . 0)
-                    (offset-flip-y extra-offset))))
-    
+                    (offset-flip-y extra-offset))))
+
     (if grob
-       (ly:insert-tweak
+       (ly:grob-replace-tweak
         grob (list tweak-grob-property
                    'extra-offset
                    (offset-flip-y (offset-add origin offset)))))))
@@ -238,14 +225,13 @@
 (define-method (save-tweaks (go <gnome-outputter>))
   (let* ((dumper (ly:make-dumper))
         (tweaks (ly:all-tweaks))
-        (serialized-tweaks (map
-                            (lambda (tweak)
-                              (append 
-                               (list
-                                (ly:dumper-key-serial dumper (car tweak))
-                                (list 'unquote (procedure-name (cadr tweak))))
-                               (cddr tweak)))
-                            tweaks)))
+        (serialized-tweaks
+         (map
+          (lambda (tweak) (append 
+                           (list (ly:dumper-key-serial dumper (car tweak))
+                                 (list 'unquote (procedure-name (cadr tweak))))
+                           (cddr tweak)))
+          tweaks)))
 
     (if (not (null? serialized-tweaks))
        (let ((file (open-file (string-append (name go) ".twy") "w")))
@@ -381,6 +367,9 @@
                    (eq? keyval gdk:w))
                (equal? mods '(control-mask modifier-mask)))
           (gtk-main-quit))
+         ((and (eq? keyval gdk:s)
+               (equal? mods '(control-mask modifier-mask)))
+               (save-tweaks go))
          ((and #t ;;(null? mods)
                (eq? keyval gdk:plus))
           (scale-canvas go 2))