]> git.donarmstrong.com Git - lilypond.git/commitdiff
* buildscripts/guile-gnome.sh: New file.
authorjanneke <janneke>
Sun, 13 Jun 2004 21:39:03 +0000 (21:39 +0000)
committerjanneke <janneke>
Sun, 13 Jun 2004 21:39:03 +0000 (21:39 +0000)
* scm/output-gnome.scm: White background, better window size, sane
canvas size.  Cleanups.

ChangeLog
buildscripts/guile-gnome.sh [new file with mode: 0644]
lily/accidental.cc
scm/output-gnome.scm

index 350a9c7e426fd59c4c232148100d74581d69aa50..97d27adb7d80d994a2d0685de2e90fbf40ed64a3 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,7 +1,9 @@
 2004-06-13  Jan Nieuwenhuizen  <janneke@gnu.org>
 
+       * buildscripts/guile-gnome.sh: New file.
+
        * scm/output-gnome.scm: White background, better window size, sane
-       canvas size.
+       canvas size.  Cleanups.
 
 2004-06-13  Han-Wen Nienhuys   <hanwen@xs4all.nl>
 
diff --git a/buildscripts/guile-gnome.sh b/buildscripts/guile-gnome.sh
new file mode 100644 (file)
index 0000000..aa7e9fe
--- /dev/null
@@ -0,0 +1,94 @@
+#!@BASH@
+# guile-gnome.sh -- download, compile, install guile-gnome
+
+# LilyPond has an experimental gnome canvas output backend -- hackers
+# only.  This depends on unreleased version of guile-gnome, which
+# depends on an unreleased, forked version of g-wrap.
+
+# Note: this install information is volatile, you'll probably want to
+# pull all from from guile-gnome-devel@gnu.org--2004 soon.
+
+set -ex
+
+if  [ -d $HOME/usr/pkg/libffi/ ]; then
+    export LDFLAGS=-L$HOME/usr/pkg/libffi/lib
+    export CPPFLAGS=-I$HOME/usr/pkg/libffi/include
+fi 
+
+export AUTOMAKE=automake-1.8
+export AUTOCONF=autoconf2.50 
+
+# test: the name of our download and build directory
+rm -rf test
+mkdir test
+cd test
+
+## 1.  install gnome-devel
+##     - Debian/unstable: apt-get install gnome-devel
+##     - ...
+
+
+## 2.  *** NOTE: use guile-1.6 for g-wrap and guile-gnome ***
+## using GUILE CVS g-wrap/guile-gnome is experimental (read: segfaults)
+## Assuming that system has guile-1.6 installed in /usr/bin 
+PATH=/usr/bin:$PATH
+
+## 3.  get g-wrap 2.0
+tla register-archive a.rottmann@gmx.at--2004-main \
+    http://people.debian.org/~rotty/arch/a.rottmann@gmx.at/2004-main || true
+
+rm -rf g-wrap
+## tla get a.rottmann@gmx.at--2004-main/g-wrap--tng g-wrap
+## pull latest g-wrap from janneke -- this step is probably no longer
+## necessary when you read this
+tla register-archive janneke@gnu.org--2004-gnome http://lilypond.org/~janneke/{arch}/2004-gnome || true
+tla get janneke@gnu.org--2004-gnome/g-wrap--janneke g-wrap
+cd g-wrap
+
+rm -rf $HOME/usr/pkg/g-wrap
+sh autogen.sh --noconfigure
+mkdir =build
+cd =build
+../configure --prefix=$HOME/usr/pkg/g-wrap
+make install
+
+# cp srfi-34.scm from CVS head ?  --hwn
+(cd $HOME/usr/pkg/g-wrap/share/guile/site
+ mv srfi-34.scm srfi-34.scm-g-wrap
+ cp $HOME/usr/pkg/guile/share/guile-1.7/srfi/srfi-34.scm .)
+
+cd ../..
+
+## 4.  get guile-gnome
+tla register-archive guile-gnome-devel@gnu.org--2004 http://people.debian.org/~rotty/arch/guile-gnome-devel@gnu.org/2004/ || true
+rm -rf guile-gnome
+tla get guile-gnome-devel@gnu.org--2004/dists--dev guile-gnome
+cd guile-gnome
+tla build-config -r configs/gnu.org/dev
+cd src
+
+## 5.  get the gnome canvas module
+tla get guile-gnome-devel@gnu.org--2004/libgnomecanvas--dev libgnomecanvas
+
+rm -rf $HOME/usr/pkg/guile-gnome
+sh autogen.sh --noconfigure
+mkdir ../=build
+cd ../=build
+
+export GUILE_LOAD_PATH=$HOME/usr/pkg/g-wrap/share/guile/site:$GUILE_LOAD_PATH
+export LD_LIBRARY_PATH=$HOME/usr/pkg/g-wrap/lib:$LD_LIBRARY_PATH
+export PKG_CONFIG_PATH=$HOME/usr/pkg/g-wrap/lib/pkgconfig:$PKG_CONFIG_PATH
+
+../src/configure --prefix=$HOME/usr/pkg/guile-gnome
+
+# requires 800mb RAM with -O2
+# using gcc-3.4 may help here -- jcn
+(cd libgnomecanvas/gnome/gw; perl -i~ -pe 's/-O2//g' Makefile)
+
+G_WRAP_MODULE_DIR=$HOME/usr/pkg/g-wrap/share/guile/site make install
+
+export GUILE_LOAD_PATH=$HOME/usr/pkg/guile-gnome/share/guile:$GUILE_LOAD_PATH
+export LD_LIBRARY_PATH=$HOME/usr/pkg/guile-gnome/lib:$LD_LIBRARY_PATH
+
+# simple test
+guile -s ../src/libgnomecanvas/examples/canvas.scm
index 0958dbae8ed7dfcd954de933a6ae7e3b4778e07b..e89306f41bd24574a9259a9cb175d1077f5489c8 100644 (file)
@@ -1,9 +1,10 @@
 /*
   accidental.cc -- implement Accidental_interface
 
-  (c) 2001--2004 Han-Wen Nienhuys
+  source file of the GNU LilyPond music typesetter
   
- */
+  (c) 2001--2004 Han-Wen Nienhuys <hanwen@cs.uu.nl>
+*/
 #include "font-interface.hh"
 #include "item.hh"
 #include "stencil.hh"
index 16564c6fb5a4e76e6b8c40a95262260298400da1..7980d184a7c7d9634d4f4850809f0de42d6962c8 100644 (file)
@@ -4,48 +4,43 @@
 ;;;; 
 ;;;; (c)  2004 Jan Nieuwenhuizen <janneke@gnu.org>
 
-
 ;;; HIP -- hack in progress
 ;;;
 ;;; You need:
 ;;;
 ;;;   * guile-1.6.4 (NOT CVS)
 ;;;   * Rotty's g-wrap--tng, possibly Janneke's if you have libffi-3.4.
-;;;   * lilypond branch: lilypond_2_3_2b; the framework-* backend
-;;;     loads output-gnome.scm at startup, which seems to break g-wrapped
-;;;     goops.
 ;;;
 ;;; see also: guile-gtk-general@gnu.org
 ;;;
 ;;; Try it
 ;;;
-;;;   * Install g-wrap, guile-gnome (see script below)
+;;;   * Install gnome/gtk development stuff and g-wrap, guile-gnome
+;;;     see buildscripts/guile-gnome.sh
 ;;;  
 ;;;   * Use latin1 encoding for gnome backend, do
-;;;       make -C mf clean
-;;;       make -C mf ENCODING_FILE=$(kpsewhich cork.enc)
-;;;       (cd mf/out && mkfontdir)
-;;;       xset +fp $(pwd)/mf/out
+"
+       make -C mf clean
+       make -C mf ENCODING_FILE=$(kpsewhich cork.enc)
+       (cd mf/out && mkfontdir)
+       xset +fp $(pwd)/mf/out
+"
 ;;;
-;;;   * Setup PATHs:
-
+;;;   * Setup environment
 "
-# do not use guile CVS:
-export PATH=/usr/bin/:$PATH
-# use g-wrap and guile-gnome from usr/pkg
 export GUILE_LOAD_PATH=$HOME/usr/pkg/g-wrap/share/guile/site:$HOME/usr/pkg/g-wrap/share/guile/site/g-wrap:$HOME/usr/pkg/guile-gnome/share/guile
 export LD_LIBRARY_PATH=$HOME/usr/pkg/g-wrap/lib:$HOME/usr/pkg/guile-gnome/lib
+export XEDITOR='/usr/bin/emacsclient --no-wait +%l:%c %f'
 "
-
-;;;  * Set XEDITOR and add
+;;;  * For GNOME point-and-click, add
 ;;;     #(ly:set-point-and-click 'line-column)
-;;;    to your .ly to get point-and-click
-;;;
-;;;  * Run lily: lilypond-bin -fgnome input/simple-song.ly
+;;;    to your .ly; just click an object on the canvas.
 ;;;
-;;;
-;;;      todo: hmm --output-base broken?
-;;;   ### cd mf && mftrace --encoding=$(kpsewhich cork.enc) --autotrace --output-base=feta-cork-20 feta20.mf && mv feta20.pfa out
+;;;  * Run lily:
+"
+lilypond-bin -fgnome input/simple-song.ly
+"
+
 
 ;;; TODO:
 ;;;  * pango+feta font (see archives gtk-i18n-list@gnome.org and
@@ -60,106 +55,7 @@ export LD_LIBRARY_PATH=$HOME/usr/pkg/g-wrap/lib:$HOME/usr/pkg/guile-gnome/lib
 ;;;  * cleanups: (too many) global vars
 ;;;  * papersize, outputscale from book
 
-;;; Note: this install information is volatile
-;;;       you'll probably want to pull all from
-;;;       from guile-gnome-devel@gnu.org--2004 soon
-;;;   
-
-"
-#!/bin/bash
-
-set -ex
-
-# no CVS guile.
-export PATH=/usr/bin/:$PATH
-
-if  [ -d $HOME/usr/pkg/libffi/ ] ; then
- export LDFLAGS=-L$HOME/usr/pkg/libffi/lib/
- export CPPFLAGS=-I$HOME/usr/pkg/libffi/include
-fi 
-
-export AUTOMAKE=automake-1.8
-export AUTOCONF=autoconf2.50 
-
-rm -rf test
-mkdir test
-cd test
-
-## 1.  install gnome-devel (Debian/unstable: apt-get install gnome-devel)
-
-## 2.  *** NOTE: use guile-1.6 for g-wrap and guile-gnome ***
-##### using GUILE CVS g-wrap/guile-gnome is experimental (read: segfaults)
-PATH=/usr/bin:$PATH
-
-
-## 3.  get g-wrap 2.0
-tla register-archive a.rottmann@gmx.at--2004-main http://people.debian.org/~rotty/arch/a.rottmann@gmx.at/2004-main || true
-
-rm -rf g-wrap
-## tla get a.rottmann@gmx.at--2004-main/g-wrap--tng g-wrap
-## pull latest g-wrap from janneke -- this step is probably no longer
-## necessary when you read this
-tla register-archive janneke@gnu.org--2004-gnome http://lilypond.org/~janneke/{arch}/2004-gnome || true
-tla get janneke@gnu.org--2004-gnome/g-wrap--janneke g-wrap
-cd g-wrap
-
-rm -rf $HOME/usr/pkg/g-wrap
-sh autogen.sh --noconfigure
-mkdir =build
-cd =build
-../configure --prefix=$HOME/usr/pkg/g-wrap
-make install
-
-# cp srfi-34.scm from CVS head ?  --hwn
-(cd $HOME/usr/pkg/g-wrap/share/guile/site
- mv srfi-34.scm srfi-34.scm-g-wrap
- cp $HOME/usr/pkg/guile/share/guile-1.7/srfi/srfi-34.scm .)
-
-cd ../..
-
-## 4.  get guile-gnome
-tla register-archive guile-gnome-devel@gnu.org--2004 http://people.debian.org/~rotty/arch/guile-gnome-devel@gnu.org/2004/ || true
-rm -rf guile-gnome
-tla get guile-gnome-devel@gnu.org--2004/dists--dev guile-gnome
-cd guile-gnome
-tla build-config -r configs/gnu.org/dev
-cd src
-
-## 5.  get the gnome canvas module
-tla get guile-gnome-devel@gnu.org--2004/libgnomecanvas--dev libgnomecanvas
-
-## pull latest defs from janneke -- this step is probably no longer
-## necessary when you read this
-## tla register-archive janneke@gnu.org--2004-gnome http://lilypond.org/~janneke/{arch}/2004-gnome || true
-## rm -rf defs
-## tla get janneke@gnu.org--2004-gnome/defs--janneke defs
-
-rm -rf $HOME/usr/pkg/guile-gnome
-sh autogen.sh --noconfigure
-mkdir ../=build
-cd ../=build
-
-export GUILE_LOAD_PATH=$HOME/usr/pkg/g-wrap/share/guile/site:$GUILE_LOAD_PATH
-export LD_LIBRARY_PATH=$HOME/usr/pkg/g-wrap/lib:$LD_LIBRARY_PATH
-export PKG_CONFIG_PATH=$HOME/usr/pkg/g-wrap/lib/pkgconfig:$PKG_CONFIG_PATH
-
-../src/configure --prefix=$HOME/usr/pkg/guile-gnome
-
 
-# requires 800mb RAM with -O2
-(cd libgnomecanvas/gnome/gw; perl  -i~  -pe 's/-O2//g' Makefile)
-
-G_WRAP_MODULE_DIR=$HOME/usr/pkg/g-wrap/share/guile/site make install
-
-export GUILE_LOAD_PATH=$HOME/usr/pkg/guile-gnome/share/guile:$GUILE_LOAD_PATH
-export LD_LIBRARY_PATH=$HOME/usr/pkg/guile-gnome/lib:$LD_LIBRARY_PATH
-guile -s ../src/libgnomecanvas/examples/canvas.scm
-
-
-# simple test
-guile -s ../src/libgnomecanvas/examples/canvas.scm
-
-"
 
 (debug-enable 'backtrace)
 
@@ -173,12 +69,35 @@ guile -s ../src/libgnomecanvas/examples/canvas.scm
  (srfi srfi-13)
  (lily)
  (gnome gtk)
- (gnome gtk gdk-event)
- ;; the name of the module will change to canvas rsn
- ;;(gnome gw libgnomecanvas))
- (gnome gw canvas))
+ (gnome gtk gdk-event))
+
+;; the name of the module will change to canvas rsn
+(if (resolve-module '(gnome gw canvas))
+    (use-modules (gnome gw canvas))
+    (use-modules (gnome gw libgnomecanvas)))
+
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; module entry
+(define-public (gnome-output-expression expr port)
+  (display (dispatch expr) port))
+
+(define (dispatch expr)
+  (if (pair? expr)
+      (let ((keyword (car expr)))
+       (cond
+        ((eq? keyword 'some-func) "")
+        ;;((eq? keyword 'placebox) (dispatch (cadddr expr)))
+        (else
+         (if (module-defined? this-module keyword)
+             (apply (eval keyword this-module) (cdr expr))
+             (begin
+               (display
+                (string-append "undefined: " (symbol->string keyword) "\n"))
+               "")))))
+      expr))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Lily output interface --- fix silly names and docme
 
 "
@@ -190,11 +109,12 @@ guile -s ../src/libgnomecanvas/examples/canvas.scm
  beam
  bezier-sandwich
  bracket
+ char
+ filledbox
+ text
  ...
 
  Commands:
- define-fonts
- header
  placebox
  ...
 
@@ -215,38 +135,14 @@ guile -s ../src/libgnomecanvas/examples/canvas.scm
 ;; minimal intercept list:
 (define output-interface-intercept
   '(comment
-    define-fonts
-    end-output
-    header
-    header-end
-    lily-def
-    no-origin
-    output-scopes
-    start-page
-    stop-page
-    start-system
-    stop-system))
+    define-origin
+    no-origin))
 
 (map (lambda (x) (module-define! this-module x dummy))
      output-interface-intercept)
 
-(define-public (gnome-output-expression expr port)
-  (display (dispatch expr) port))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(define (dispatch expr)
-  (if (pair? expr)
-      (let ((keyword (car expr)))
-       (cond
-        ((eq? keyword 'some-func) "")
-        ;;((eq? keyword 'placebox) (dispatch (cadddr expr)))
-        (else
-         (if (module-defined? this-module keyword)
-             (apply (eval keyword this-module) (cdr expr))
-             (begin
-               (display
-                (string-append "undefined: " (symbol->string keyword) "\n"))
-               "")))))
-      expr))
 
 ;;; Global vars
 (define main-window #f)
@@ -273,15 +169,9 @@ guile -s ../src/libgnomecanvas/examples/canvas.scm
 
 (define font-paper #f)
 
-;;(define pixels-per-unit 1.0)
 (define pixels-per-unit 2.0)
-
-;; TODO: use canvas scaling, use output-scale for paper/canvas dimensions?
-;;(define output-scale (* 2 2.83464566929134))
-;;(define output-scale 2.83464566929134)
 (define OUTPUT-SCALE 2.83464566929134)
 (define output-scale (* OUTPUT-SCALE pixels-per-unit))
-;;(define output-scale 1)
 
 ;; helper functions -- sort this out
 (define (stderr string . rest)
@@ -313,90 +203,16 @@ guile -s ../src/libgnomecanvas/examples/canvas.scm
       (utf8 i)
       (utf8 (+ #xee00 i))))
 
-(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)
-      (set! ifs (getenv "IFS")))
-  (if (not ifs)
-      (set! ifs "      "))
-  ifs)
-      
-(define (spawn-editor location)
-  (let* ((line (car location))
-        (column (cadr location))
-        (file-name (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)))
-    
-    (stderr "spawning: ~s\n" command)
-    (if (= (primitive-fork) 0)
-       (let ((command-list (string-split command #\ )));; (get-ifs))))
-         (apply execlp command-list)
-         (primitive-exit)))))
-         
-(define location-callback spawn-editor)
-
-(define (item-event item event . data)
-  (case (gdk-event:type event)
-    ((enter-notify) (gobject-set-property item 'fill-color "red"))
-    ((leave-notify) (gobject-set-property item 'fill-color "black"))
-    ((button-press)
-     (let ((location (hashq-ref item-locations item #f)))
-       (if location
-          (location-callback location)
-          (stderr "no location\n"))))
-    ((2button-press) (gobject-set-property item 'fill-color "red")))
-  #t)
+;;; hmm?
+(define (draw-rectangle x1 y1 x2 y2 color width-units)
+  (make <gnome-canvas-rect>
+    #:parent (root main-canvas) #:x1 x1 #:y1 y1 #:x2 x2 #:y2 y2
+    #:fill-color color #:width-units width-units))
 
-;; TODO: one list per-page
-(define text-items '())
-(define (scale-canvas factor)
-  (set! pixels-per-unit (* pixels-per-unit factor))
-  (set-pixels-per-unit main-canvas pixels-per-unit)
-  (for-each
-   (lambda (x)
-     (let ((scale (gobject-get-property x 'scale))
-          (points (gobject-get-property x 'size-points)))
-       ;;(gobject-set-property x 'scale pixels-per-unit)
-       (gobject-set-property x 'size-points (* points factor))))
-     text-items))
 
-(define (key-press-event item event . data)
-  (let ((keyval (gdk-event-key:keyval event))
-       (mods (gdk-event-key:modifiers event)))
-    (cond ((and (or (eq? keyval gdk:q)
-                   (eq? keyval gdk:w))
-               (equal? mods '(control-mask modifier-mask)))
-          (gtk-main-quit))
-         ((and #t ;;(null? mods)
-               (eq? keyval gdk:plus))
-          (scale-canvas 2))
-         ((and #t ;; (null? mods)
-               (eq? keyval gdk:minus))
-          (scale-canvas 0.5))
-         ((or (eq? keyval gdk:Page-Up)
-              (eq? keyval gdk:BackSpace))
-          (dump-page (1- page-number)))
-         ((or (eq? keyval gdk:Page-Down)
-              (eq? keyval gdk:space))
-          (dump-page (1+ page-number))))
-    #f))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; stencil outputters
+;;;;
 
 (define (char font i)
   (text font (utf8 i)))
@@ -429,7 +245,7 @@ guile -s ../src/libgnomecanvas/examples/canvas.scm
    ((equal? (ly:font-name font) "GNU-LilyPond-feta-20")
     "lilypond-feta, regular 32")
    (else
-    (ly:font-filename font))))
+    (ly:font-name font))))
 
 (define (pango-font-size font)
   (let* ((designsize (ly:font-design-size font))
@@ -454,11 +270,8 @@ guile -s ../src/libgnomecanvas/examples/canvas.scm
     (make <gnome-canvas-text>
       #:parent (root main-canvas)
       #:x 0 #:y 0
-      ;;    #:font "new century schoolbook, i bold 20"
       #:font (pango-font-name font)
-      ;; #:size-points 12
       #:size-points (pango-font-size font)
-      ;;#:size (pango-font-size font)
       #:size-set #t
 
       ;;apparently no effect :-(
@@ -479,9 +292,6 @@ guile -s ../src/libgnomecanvas/examples/canvas.scm
   ;;(let ((thickness 2))
   (filledbox (- x1) (- x2 x1) (* .5 thickness) (* .5 thickness)))
 
-(define (start-system origin . rest)
-  (set! system-origin origin))
-
 ;; origin -- bad name
 (define (define-origin file line col)
   ;; ughr, why is this not passed as [part of] stencil object
@@ -492,9 +302,9 @@ guile -s ../src/libgnomecanvas/examples/canvas.scm
                     #f)))
 
 
-;;;;;;;;;;;;;;;; 
-;;;;;;;;;;;;;;;; gnome stuff
-;;;;;;;;;;;;;;;; 
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; gnome stuff  --- move to framework-gnome
 (define (dump-page number)
   (if (or (not page-stencils)
          (< number 0)
@@ -517,24 +327,114 @@ guile -s ../src/libgnomecanvas/examples/canvas.scm
        
        (if old-canvas (destroy old-canvas))
        (add main-scrolled canvas)
-       (show canvas)
-       )))
+       (show canvas))))
 
+(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)
+      (set! ifs (getenv "IFS")))
+  (if (not ifs)
+      (set! ifs "      "))
+  ifs)
+      
+(define (spawn-editor location)
+  (let* ((line (car location))
+        (column (cadr location))
+        (file-name (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)))
+    
+    (stderr "spawning: ~s\n" command)
+    (if (= (primitive-fork) 0)
+       (let ((command-list (string-split command #\ )));; (get-ifs))))
+         (apply execlp command-list)
+         (primitive-exit)))))
+         
+(define location-callback spawn-editor)
+
+(define (item-event item event . data)
+  (case (gdk-event:type event)
+    ((enter-notify) (gobject-set-property item 'fill-color "red"))
+    ((leave-notify) (gobject-set-property item 'fill-color "black"))
+    ((button-press)
+     (let ((location (hashq-ref item-locations item #f)))
+       (if location
+          (location-callback location)
+          (stderr "no location\n"))))
+    ((2button-press) (gobject-set-property item 'fill-color "red")))
+  #t)
+
+;; TODO: one list per-page
+(define text-items '())
+(define (scale-canvas factor)
+  (set! pixels-per-unit (* pixels-per-unit factor))
+  (set-pixels-per-unit main-canvas pixels-per-unit)
+  (for-each
+   (lambda (x)
+     (let ((scale (gobject-get-property x 'scale))
+          (points (gobject-get-property x 'size-points)))
+       ;;(gobject-set-property x 'scale pixels-per-unit)
+       (gobject-set-property x 'size-points (* points factor))))
+     text-items))
+
+(define (key-press-event item event . data)
+  (let ((keyval (gdk-event-key:keyval event))
+       (mods (gdk-event-key:modifiers event)))
+    (cond ((and (or (eq? keyval gdk:q)
+                   (eq? keyval gdk:w))
+               (equal? mods '(control-mask modifier-mask)))
+          (gtk-main-quit))
+         ((and #t ;;(null? mods)
+               (eq? keyval gdk:plus))
+          (scale-canvas 2))
+         ((and #t ;; (null? mods)
+               (eq? keyval gdk:minus))
+          (scale-canvas 0.5))
+         ((or (eq? keyval gdk:Page-Up)
+              (eq? keyval gdk:BackSpace))
+          (dump-page (1- page-number)))
+         ((or (eq? keyval gdk:Page-Down)
+              (eq? keyval gdk:space))
+          (dump-page (1+ page-number))))
+    #f))
 
 (define (papersize window paper)
   (let* ((hsize (ly:output-def-lookup paper 'hsize))
         (vsize (ly:output-def-lookup paper 'vsize))
-        ;; 2?
-        (width (inexact->exact (ceiling (* output-scale 2 hsize))))
-        (height (inexact->exact (ceiling (* output-scale 2 vsize))))
+        (width (inexact->exact (ceiling (* output-scale hsize))))
+        (height (inexact->exact (ceiling (* output-scale vsize))))
         (max-width (gdk-screen-width))
-        (max-height (gdk-screen-height)))
+        (max-height (gdk-screen-height))
+        (scrollbar-size 20))
 
     ;; ughr: panels?
     (set! max-height (- max-height 80))
+
+    ;; hmm?
+    ;;(set! OUTPUT-SCALE (ly:bookpaper-outputscale paper))
+    ;;(set! output-scale (* OUTPUT-SCALE pixels-per-unit))
+
+    ;; huh, *2?
     
-    (set! window-width (min width max-width))
-    (set! window-height (min height max-height))
+    (set! window-width (min (+ scrollbar-size (* width 2)) max-width))
+    (set! window-height (min (+ button-height scrollbar-size (* height 2))
+                            max-height))
     
     (set! canvas-width width)
     (set! canvas-height height)))
@@ -554,11 +454,6 @@ guile -s ../src/libgnomecanvas/examples/canvas.scm
     
     canvas))
 
-(define (draw-rectangle x1 y1 x2 y2 color width-units)
-  (make <gnome-canvas-rect>
-    #:parent (root main-canvas) #:x1 x1 #:y1 y1 #:x2 x2 #:y2 y2
-    #:fill-color color #:width-units width-units))
-
 (define (main outputter bookpaper pages)
   (let* ((window (make <gtk-window> #:type 'toplevel))
         (button (make <gtk-button> #:label "Exit"))
@@ -571,7 +466,6 @@ guile -s ../src/libgnomecanvas/examples/canvas.scm
 
     (papersize window bookpaper)
     (set-size-request window window-width window-height)
-    ;;; (ly:bookpaper-outputscale bookpaper))))
     
     (add window vbox)
     (add vbox scrolled)