From b3ab01ce29fb3414891522217aacd9ce4112d835 Mon Sep 17 00:00:00 2001
From: fred <fred>
Date: Wed, 27 Mar 2002 02:04:07 +0000
Subject: [PATCH] lilypond-1.5.21

---
 CHANGES                            |  44 ++-
 Documentation/topdocs/INSTALL.texi |  27 +-
 input/bugs/clefsp.ly               |  20 ++
 input/test/sketch.ly               |   5 +-
 lily/global-ctor.cc                |   2 +-
 lily/include/paper-outputter.hh    |   9 +-
 lily/include/stream.hh             |  28 ++
 lily/lily-guile.cc                 |  13 +-
 lily/line-of-score.cc              |  12 +-
 lily/main.cc                       |  25 +-
 lily/midi-stream.cc                |   4 +-
 lily/paper-outputter.cc            | 124 ++-----
 lily/paper-score.cc                |   1 -
 lily/streams.cc                    |  53 +++
 make/lilypond-vars.make            |   7 +-
 scm/ascii-script.scm               | 407 +++++++++++------------
 scm/lily.scm                       |  51 ++-
 scm/output-lib.scm                 |  31 +-
 scm/ps.scm                         | 464 +++++++++++++-------------
 scm/pysk.scm                       |  98 ++++++
 scm/sketch.scm                     | 318 ------------------
 scm/tex.scm                        | 504 +++++++++++++++--------------
 22 files changed, 1051 insertions(+), 1196 deletions(-)
 create mode 100644 input/bugs/clefsp.ly
 create mode 100644 lily/include/stream.hh
 create mode 100644 lily/streams.cc
 create mode 100644 scm/pysk.scm

diff --git a/CHANGES b/CHANGES
index 1ef6a0d758..8ad23847a9 100644
--- a/CHANGES
+++ b/CHANGES
@@ -1,3 +1,42 @@
+1.5.20.jcn1
+===========
+
+* Fixed direct PostScript output, and changed default fonts.
+
+* Bugfix: automaticMelismata in refman (huh, or should lily be changed?)
+
+* pktrace:
+
+      cp mf/out/feta20.* $HOME/usr/src/sketch-0.7.8/Resources/Fontmetrics
+      echo 'TeX-feta20,feta20,Roman,-gnu-feta20-medium-r-normal,adobe-fontspec\ific,feta20' >> $HOME/usr/src/sketch-0.7.8/Resources/Fontmetrics/std.sfd
+
+
+1.5.3.lec1
+==========
+abc2ly fixes:
+
+      fix to Q: support
+      partial fix for tuplet parsing
+      fix for blank first T: line
+      escape "'s in header lines
+      fix for dotted breve in whole note duration
+      M:none no longer attempts to insert "\time none"
+
+
+1.5.20.uu1
+==========
+
+* etf2ly robustness fixes
+ 
+* Rewrote outputting backend. Now uses GUILE modules.
+
+* Line breaking bugfix.
+
+* Bugfix: Unfolded_repeat_iterator::add_repeat_command().
+
+1.5.20
+======
+
 1.5.19.jcn3
 ===========
 
@@ -13,14 +52,13 @@
    - textrace:
       wget http://www.inf.bme.hu/~pts/textrace-latest.tar.gz
       tar xzf textrace-latest.tar.gz
-@@ -15,18 +17,23 @@
       (cd autotrace-0.27ap; ./configure; make)
       ./traceall.sh feta20 feta20.pfb $HOME/usr/src/lilypond/mf/out
 
-  - copy mf/out/feta20.* to sketch/Resources/Fontmetrics
+  - copy mf/out/feta20.* to sketch/Resources/Fontmetrics:
 
    - append to sketch/Resources/Fontmetrics/std.sfd:
-      echo 'TeX-feta20,feta20,Roman,-gnu-feta20-medium-r-normal,adobe-fontspec\ific,feta20' > $HOME/usr/src/sketch/sketch/Resources/Fontmetrics/std.sfd
+      echo 'TeX-feta20,feta20,Roman,-gnu-feta20-medium-r-normal,adobe-fontspecific,feta20' >> $HOME/usr/src/sketch/sketch/Resources/Fontmetrics/std.sfd
 
    - Hmm, then find that
 
diff --git a/Documentation/topdocs/INSTALL.texi b/Documentation/topdocs/INSTALL.texi
index 24442f34b1..dd4b50599a 100644
--- a/Documentation/topdocs/INSTALL.texi
+++ b/Documentation/topdocs/INSTALL.texi
@@ -155,14 +155,6 @@ It is available at
 FTP directory for @code{geometry}}. This package is normally included
 with the @TeX{} distribution.
 
-@item MetaPost, needed for generating PostScript fonts. Please
-note that tetex-0.4pl8 (included with Red Hat 5.x) does not include
-@file{mfplain.mp}, which is needed for producing the scalable font
-files.
-
-If you don't have MetaPost and don't want to use PostScript output, then
-edit @file{mf/GNUmakefile}, removing the line saying @code{PFA_FILES=}.
-
 @item kpathsea, a library for searching (@TeX{}) files.  @code{kpathsea} is
 usually included with your installation of @TeX{}.  You may need to install
 a tetex-devel or tetex-dev package too.
@@ -177,6 +169,25 @@ configure something like:
 ./configure --without-kpathsea --enable-tfm-path=/usr/share/texmf/fonts/tfm/public/cm/:/usr/share/texmf/fonts/tfm/ams/symbols
 @end example
 
+
+@item pktrace, [OPTIONAL], needed for generating PostScript Type1
+fonts. Get it from
+ @uref{http://www.cs.uu.nl/~hanwen/public/software/pktrace-0.1.tar.gz}
+
+@item autotrace-0.27a, [OPTIONAL], needed for generating PostScript Type1
+fonts. You must apply the patch included pktrace-0.1 first.
+@uref{http://autotrace.sourceforge.net}.
+ 
+@item MetaPost [OPTIONAL] needed for generating PostScript Type3 fonts. Please
+note that tetex-0.4pl8 (included with Red Hat 5.x) does not include
+@file{mfplain.mp}, which is needed for producing the scalable font
+files.
+
+If you don't have MetaPost and don't want to use PostScript output, then
+edit @file{mf/GNUmakefile}, removing the line saying @code{PFA_FILES=}.
+
+
+
 @end itemize
 
 @subsection Running requirements
diff --git a/input/bugs/clefsp.ly b/input/bugs/clefsp.ly
new file mode 100644
index 0000000000..91f8fe49f6
--- /dev/null
+++ b/input/bugs/clefsp.ly
@@ -0,0 +1,20 @@
+
+
+
+\score{<
+  \notes \relative c'' \context Staff=violin{
+    \time 3/4
+s2.
+    \grace a b4 
+  }
+  \notes \relative c'' \context Staff=violoncello{
+    \time 3/4
+    \clef tenor
+s2.    \clef bass b4
+  }
+>
+\paper{
+  linewidth=-1
+}
+}
+
diff --git a/input/test/sketch.ly b/input/test/sketch.ly
index 22594c583e..fefc6d0f34 100644
--- a/input/test/sketch.ly
+++ b/input/test/sketch.ly
@@ -3,10 +3,11 @@ texidoc="sketch output supported features"
 }
 \score {
   \notes\relative c''' {
-    a4( a a a )a
+
+  \time 3/4    a4( a a a )a
     \stemDown
     a,8( b c )d
     \stemUp
     \slurDown d16( c b )a
   }
-}
\ No newline at end of file
+}
diff --git a/lily/global-ctor.cc b/lily/global-ctor.cc
index 5fa1db034d..27ab068d09 100644
--- a/lily/global-ctor.cc
+++ b/lily/global-ctor.cc
@@ -23,5 +23,5 @@ void
 call_constructors ()
 {
   for (int i=0; i < ctor_global_static_arr_p_->size (); i++)
- (ctor_global_static_arr_p_->elem (i)) ();
+    (ctor_global_static_arr_p_->elem (i)) ();
 }
diff --git a/lily/include/paper-outputter.hh b/lily/include/paper-outputter.hh
index 48d78a529a..97f8fc2cab 100644
--- a/lily/include/paper-outputter.hh
+++ b/lily/include/paper-outputter.hh
@@ -27,8 +27,13 @@
 class Paper_outputter
 {
   bool verbatim_scheme_b_;
-  Paper_stream * stream_p_;
+
+  
 public:
+
+  SCM output_func_ ;
+  Protected_scm file_;
+  
   String basename_;
   Paper_outputter (String nm);
   ~Paper_outputter ();
@@ -47,7 +52,7 @@ public:
   void output_string (SCM s);
   void output_scheme (SCM scm);
 
-  static void write_header_field_to_file (String filename, String key, String value);
+  void write_header_field_to_file (String filename, SCM, SCM);
   void write_header_fields_to_file (Scope *);
 };
 
diff --git a/lily/include/stream.hh b/lily/include/stream.hh
new file mode 100644
index 0000000000..ad747a0760
--- /dev/null
+++ b/lily/include/stream.hh
@@ -0,0 +1,28 @@
+/*   
+stream.hh -- declare compatibility glue for gcc 3.
+
+source file of the GNU LilyPond music typesetter
+
+(c) 2001 Han-Wen Nienhuys <hanwen@cs.uu.nl>
+
+ */
+
+#ifndef STREAM_HH
+#define STREAM_HH
+#include "string.hh"
+
+
+#include <iostream.h> /* gcc 3.0 */
+#if __GNUC__ > 2
+ostream *open_file_stream (String filename,
+			   std::ios_base::openmode mode=std::ios::out);
+#else
+ostream *open_file_stream (String filename, int mode=ios::out);
+#endif
+void close_file_stream (ostream *os);
+
+
+
+
+#endif /* STREAM_HH */
+
diff --git a/lily/lily-guile.cc b/lily/lily-guile.cc
index ccca4cee06..4446fdda1d 100644
--- a/lily/lily-guile.cc
+++ b/lily/lily-guile.cc
@@ -245,14 +245,23 @@ void add_scm_init_func (void (*f) ())
 
   scm_init_funcs_->push (f);
 }
+
 extern  void init_cxx_function_smobs ();
 
 void
 init_lily_guile ()
 {
+  SCM last_mod = scm_current_module ();
+  scm_set_current_module (scm_c_resolve_module ("guile"));
+
   init_cxx_function_smobs ();
   for (int i=scm_init_funcs_->size () ; i--;)
- (scm_init_funcs_->elem (i)) ();
+    (scm_init_funcs_->elem (i)) ();
+
+  if (verbose_global_b)
+    progress_indication ("\n");
+  read_lily_scm_file ("lily.scm");
+  scm_set_current_module (last_mod);
 }
 
 unsigned int ly_scm_hash (SCM s)
@@ -545,5 +554,5 @@ ly_truncate_list (int k, SCM l )
 
 SCM my_gh_symbol2scm (const char* x)
 {
-  return gh_symbol2scm (x);
+  return gh_symbol2scm ((char*)x);
 }
diff --git a/lily/line-of-score.cc b/lily/line-of-score.cc
index e82b544481..464cd4e6ab 100644
--- a/lily/line-of-score.cc
+++ b/lily/line-of-score.cc
@@ -114,10 +114,14 @@ Line_of_score::output_lines ()
 	{
 	  SCM lastcol =  ly_car (line_l->get_grob_property ("columns"));
 	  Grob*  e = unsmob_grob (lastcol);
-	  SCM inter = e->get_grob_property ("between-system-string");
+
+	  SCM between = ly_symbol2scm ("between-system-string");
+	  SCM inter = e->internal_get_grob_property (between);
 	  if (gh_string_p (inter))
 	    {
-	      pscore_l_->outputter_l_->output_string (inter);	      
+	      pscore_l_->outputter_l_
+		->output_scheme (scm_list_n (between, 
+					     inter, SCM_UNDEFINED));	      
 	    }
 	}
     }
@@ -371,8 +375,8 @@ Line_of_score::post_processing (bool last_line)
    */
   SCM font_names = ly_quote_scm (paper_l ()->font_descriptions ());  
   output_scheme (scm_list_n (ly_symbol2scm ("define-fonts"),
-					font_names,
-					SCM_UNDEFINED));
+			     font_names,
+			     SCM_UNDEFINED));
 
   /*
     line preamble.
diff --git a/lily/main.cc b/lily/main.cc
index 50725df2cb..f4ccf040d0 100644
--- a/lily/main.cc
+++ b/lily/main.cc
@@ -10,6 +10,7 @@
 #include <iostream.h>
 #include <assert.h>
 #include <locale.h>
+#include <stdio.h>
 
 #include "config.h"
 
@@ -211,12 +212,14 @@ notice ()
 	     "USA.\n");
 }
 
+String prefix_directory;
+
 void
 setup_paths ()
 {
   // facilitate binary distributions
   char const *env_lily = getenv ("LILYPONDPREFIX");
-  String prefix_directory;
+
   if (env_lily)
     prefix_directory = env_lily;
 
@@ -266,6 +269,21 @@ setup_paths ()
 	i++;
 #endif
     }
+
+  char const * glp = getenv ("GUILE_LOAD_PATH");
+  
+  String new_glp (glp? glp : "") ;
+  if (glp)
+    new_glp = ":" + new_glp;
+  new_glp = prefix_directory + new_glp;
+
+  /*
+    Yes , so setenv is not posix.
+
+    I say, fuckem'all.
+   */
+
+  setenv ("GUILE_LOAD_PATH", new_glp.ch_C(), 1);
 }
 
 /**
@@ -309,15 +327,12 @@ format_to_ext (String format)
 }
 
 void
-main_prog (void * closure, int, char**)
+main_prog (void * , int, char**)
 {
   /*
     need to do this first. Engravers use lily.scm contents.
    */
   init_lily_guile ();
-  if (verbose_global_b)
-    progress_indication ("\n");
-  read_lily_scm_file ("lily.scm");
   cout << endl;
 
   call_constructors ();
diff --git a/lily/midi-stream.cc b/lily/midi-stream.cc
index b353f92dc7..9b3365753c 100644
--- a/lily/midi-stream.cc
+++ b/lily/midi-stream.cc
@@ -6,8 +6,8 @@
   (c)  1997--2001 Jan Nieuwenhuizen <janneke@gnu.org>
 */
 
-#include <fstream.h>
-#include "paper-stream.hh"
+
+#include "stream.hh"
 #include "string.hh"
 #include "string-convert.hh"
 #include "main.hh"
diff --git a/lily/paper-outputter.cc b/lily/paper-outputter.cc
index 4c1f865fd2..abfed82563 100644
--- a/lily/paper-outputter.cc
+++ b/lily/paper-outputter.cc
@@ -8,14 +8,13 @@
 */
 
 #include <time.h>
-#include <fstream.h>
+
 #include <math.h>
-#include <iostream.h>
+
 
 #include "dimensions.hh"
 #include "virtual-methods.hh"
 #include "paper-outputter.hh"
-#include "paper-stream.hh"
 #include "molecule.hh"
 #include "array.hh"
 #include "string-convert.hh"
@@ -32,56 +31,32 @@
 /*
   Ugh, this is messy.
  */
-
 Paper_outputter::Paper_outputter (String name)
 {
-  stream_p_ =  new Paper_stream (name);
-
- /*
-   lilypond -f scm x.ly
-   guile -s x.scm
-  */
-  verbatim_scheme_b_ = output_format_global == "scm";
-
-  if (verbatim_scheme_b_)
+  if (safe_global_b)
     {
-	*stream_p_ << ""
-	  ";;; Usage: guile -s x.scm > x.tex\n"
-	  " (primitive-load-path 'standalone.scm)\n"
-	  "; (scm-tex-output)\n"
-	  " (scm-ps-output)\n"
-	  " (map (lambda (x) (display (ly-eval x))) ' (\n"
-	;
+      gh_define ("security-paranoia", SCM_BOOL_T);      
     }
+  
+  file_ = scm_open_file (ly_str02scm (name.ch_C()),
+			    ly_str02scm ("w"));
+  
+  SCM exp = scm_list_n (ly_symbol2scm ("find-dumper"),
+			ly_str02scm (output_format_global.ch_C()),
+			SCM_UNDEFINED);
 
+  output_func_  = scm_primitive_eval (exp);
 }
 
 Paper_outputter::~Paper_outputter ()
 {
-  if (verbatim_scheme_b_)
-    {
-      *stream_p_ << "))";
-    }
-  delete stream_p_;
+  
 }
 
 
 void
 Paper_outputter::output_header ()
 {
-  if (safe_global_b)
-    {
-      gh_define ("security-paranoia", SCM_BOOL_T);      
-    }
-
-  SCM exp = scm_list_n (ly_symbol2scm ((output_format_global + "-scm").ch_C ()),
-		     ly_quote_scm (ly_symbol2scm ("all-definitions")),
-		     SCM_UNDEFINED);
-  exp = scm_primitive_eval (exp);
-  scm_primitive_eval (exp);
-  
-  String creator = gnu_lilypond_version_str ();
-  
   String       generate = _ (", at ");
   time_t t (time (0));
   generate += ctime (&t);
@@ -91,13 +66,14 @@ Paper_outputter::output_header ()
     Make fixed length time stamps
    */
   generate = generate + to_str (' ' * (120 - generate.length_i ())>? 0)  ;
+  String creator = "lelie";
   
-  SCM args_scm = 
-    scm_list_n (ly_str02scm (creator.ch_l ()),
-	     ly_str02scm (generate.ch_l ()), SCM_UNDEFINED);
+  SCM args_scm = scm_list_n (ly_str02scm (creator.ch_C ()),
+			     ly_str02scm (generate.ch_C ()), SCM_UNDEFINED);
 
 
   SCM scm = gh_cons (ly_symbol2scm ("header"), args_scm);
+
   output_scheme (scm);
 }
 
@@ -112,49 +88,10 @@ Paper_outputter::output_comment (String str)
 		 );
 }
 
-
 void
 Paper_outputter::output_scheme (SCM scm)
 {
-  /*
-    we don't rename dump_scheme, because we might in the future want
-    to remember Scheme. We don't now, because it sucks up a lot of memory.
-  */
-  dump_scheme (scm);
-}
-
-void flatten_write (SCM x, Paper_stream*ps)
-{
-  if (ly_pair_p (x))
-    {
-      flatten_write (ly_car (x),ps);
-      flatten_write (ly_cdr (x),ps);
-    }
-  else if (gh_string_p (x))
-    {
-      *ps  << String ( SCM_STRING_CHARS(x)) ;
-    }
-}
-
-
-/*
-  UGH.
-
-  Should probably change interface to do less eval (symbol), and more
-  apply (procedure, args)
- */
-void
-Paper_outputter::dump_scheme (SCM s)
-{
-  if (verbatim_scheme_b_)
-    {
-      *stream_p_ << ly_scm2string (ly_write2scm (s));
-    }
-  else
-    {
-      SCM result = scm_primitive_eval (s);
-      flatten_write (result, stream_p_);
-    }
+  scm_apply_2 (output_func_, scm, file_, SCM_EOL);
 }
 
 void
@@ -166,7 +103,6 @@ Paper_outputter::output_scope (Scope *scope, String prefix)
       SCM k = ly_caar (s);
       SCM v = ly_cdar (s);
       String s = ly_symbol2string (k);
-
       
       if (gh_string_p (v))
 	{
@@ -229,24 +165,12 @@ Paper_outputter::output_int_def (String k, int v)
 }
 
 void
-Paper_outputter::output_string (SCM str)
-{
-  *stream_p_ <<  ly_scm2string (str);
-}
-
-void
-Paper_outputter::write_header_field_to_file (String filename, String key, String value)
+Paper_outputter::write_header_field_to_file (String filename, SCM key, SCM value)
 {
-  if (filename != "-")
-    filename += String (".") + key;
-  progress_indication (_f ("writing header field `%s' to `%s'...",
-			   key,
-			   filename == "-" ? String ("<stdout>") : filename));
-  
-  ostream *os = open_file_stream (filename);
-  *os << value;
-  close_file_stream (os);
-  progress_indication ("\n");
+  output_scheme (scm_list_n (ly_symbol2scm ("header-to-file"),
+			     ly_str02scm (filename.ch_C()),
+			     ly_quote_scm (key), value,
+			     SCM_UNDEFINED));
 }
 
 void
@@ -265,7 +189,7 @@ Paper_outputter::write_header_fields_to_file (Scope * header)
 	    {
 	      s = ly_scm2string (ly_cdr (val));
 	      /* Always write header field file, even if string is empty ... */
-	      write_header_field_to_file (basename_, key, s);
+	      write_header_field_to_file (basename_ , ly_car (val), ly_cdr (val));
 	    }
 	}
     }
diff --git a/lily/paper-score.cc b/lily/paper-score.cc
index 5605668c1c..73a3c2ee16 100644
--- a/lily/paper-score.cc
+++ b/lily/paper-score.cc
@@ -17,7 +17,6 @@
 #include "paper-column.hh"
 #include "scope.hh"
 #include "gourlay-breaking.hh"
-#include "paper-stream.hh"
 #include "paper-outputter.hh"
 #include "file-results.hh"
 #include "misc.hh"
diff --git a/lily/streams.cc b/lily/streams.cc
new file mode 100644
index 0000000000..06a74a23cb
--- /dev/null
+++ b/lily/streams.cc
@@ -0,0 +1,53 @@
+#include "config.h"
+
+#include <stdlib.h>
+#include <errno.h>
+#include <sys/types.h>
+#if HAVE_SYS_STAT_H 
+#include <sys/stat.h>
+#endif
+#include <iostream.h>
+#include <fstream.h>
+
+#include "stream.hh"
+#include "file-path.hh"
+#include "warn.hh"
+#include "main.hh"
+
+#if __GNUC__ > 2
+ostream *
+open_file_stream (String filename, std::ios_base::openmode mode)
+#else
+ostream *
+open_file_stream (String filename, int mode)
+#endif
+{
+  ostream *os;
+  if ((filename == "-"))
+    os = &cout;
+  else
+    {
+      Path p = split_path (filename);
+      if (!p.dir.empty_b ())
+        if (mkdir (p.dir.ch_C (), 0777) == -1 && errno != EEXIST)
+          error (_f ("can't create directory: `%s'", p.dir));
+      os = new ofstream (filename.ch_C (), mode);
+    }
+  if (!*os)
+    error (_f ("can't open file: `%s'", filename));
+  return os;
+}
+
+void
+close_file_stream (ostream *os)
+{
+  *os << flush;
+  if (!*os)
+    {
+      warning (_ ("Error syncing file (disk full?)"));
+      exit_status_global = 1;
+    }
+  if (os != &cout)
+    delete os;
+  os = 0;
+}  
diff --git a/make/lilypond-vars.make b/make/lilypond-vars.make
index be760f25ae..0eff08a3db 100644
--- a/make/lilypond-vars.make
+++ b/make/lilypond-vars.make
@@ -15,7 +15,12 @@ export MT_DESTROOT := $(topdir)/mf/out
 export DVIPSMAKEPK := mktexpk --destdir $(topdir)/mf/out
 endif
 
-export LILYPONDPREFIX:=$(depth)/
+# don't change to "depth". It makes the GUILE barf.
+#
+# LilyPond is often run from within $(outdir), making a relative
+# PREFIX incorrect.
+export LILYPONDPREFIX:=$(shell cd $(depth)/ ; pwd)
+
 export PYTHONPATH:=$(topdir)/python:$(PYTHONPATH)
 
 # guile load path?
diff --git a/scm/ascii-script.scm b/scm/ascii-script.scm
index b899092088..b3138812f3 100644
--- a/scm/ascii-script.scm
+++ b/scm/ascii-script.scm
@@ -1,26 +1,40 @@
-(debug-enable 'backtrace)
+(define-module (scm ascii-script)
+  :export (as-output-expression)
+  :no-backtrace
+  )
+
+(define this-module (current-module))
+
+(define (as-output-expression expr port)
+  (display (eval expr this-module) port)
+  )
 
-; (define cmr-alist
-;   '(("bold" . "as-dummy") 
-;     ("brace" . "as-braces")
-;     ("dynamic" . "as-dummy") 
-;     ("default" . "as-dummy") 
-;     ("feta" . "feta") 
-;     ("feta-1" . "feta") 
-;     ("feta-2" . "feta") 
-;     ("finger" . "as-number") 
-;     ("typewriter" . "as-dummy") 
-;     ("italic" . "as-dummy") 
-;     ("roman" . "as-dummy") 
-;     ("script" . "as-dummy") 
-;     ("large" . "as-dummy") 
-;     ("Large" . "as-dummy") 
-;     ("mark" . "as-number") 
-;     ("number" . "as-number") 
-;     ("timesig" . "as-number")
-;     ("volta" . "as-number"))
-; )
 
+(debug-enable 'backtrace)
+(define (tex-encoded-fontswitch name-mag)
+  (let* ((iname-mag (car name-mag))
+	 (ename-mag (cdr name-mag)))
+    (cons iname-mag
+	  (cons ename-mag
+		(string-append  "magfont"
+			  (string-encode-integer
+			   (hashq (car ename-mag) 1000000))
+			  "m"
+			  (string-encode-integer
+			   (inexact->exact (* 1000 (cdr ename-mag)))))))))
+
+(define (fontify name-mag-pair exp)
+  (string-append (select-font name-mag-pair)
+		 exp))
+
+
+(define (define-fonts internal-external-name-mag-pairs)
+  (set! font-name-alist (map tex-encoded-fontswitch
+			     internal-external-name-mag-pairs))
+  (apply string-append
+	 (map (lambda (x)
+		(font-load-command (car x) (cdr x)))
+	      (map cdr font-name-alist))))
 
 (define as-font-alist-alist
   '(
@@ -46,8 +60,8 @@
 	  (cmr8 . as-dummy)
 	  (cmr10 . as-dummy)
 	  (cmr12 . as-dummy)
-	 ))
-  ))
+	  ))
+    ))
 
 (define (as-properties-to-font-name size fonts properties-alist-list)
   (let* ((feta-name (properties-to-font-name fonts properties-alist-list))
@@ -71,202 +85,153 @@
 		(lambda (x y) (as-properties-to-font-name size x y)))
     sheet))
 
-;;;; AsciiScript as  -- ascii art output
-(define (as-scm action-name)
-
-  (define (beam width slope thick)
-	  (string-append
-	   (func "set-line-char" "#")
-	   (func "rline-to" width (* width slope))
-	   ))
-
-  ; simple flat slurs
-  (define (bezier-sandwich l thick)
-	  (let (
-		(c0 (cadddr l))
-		(c1 (cadr l))
-		(c3 (caddr l)))
-	       (let* ((x (car c0))
-		      (dx (- (car c3) x))
-		      (dy (- (cdr c3) (cdr c0)))
-		      (rc (/ dy dx))
-		      (c1-dx (- (car c1) x))
-		      (c1-line-y (+ (cdr c0) (* c1-dx rc)))
-		      (dir (if (< c1-line-y (cdr c1)) 1 -1))
-		      (y (+ -1 (* dir (max (* dir (cdr c0)) (* dir (cdr c3)))))))
-		     (string-append
-		      (func "rmove-to" x y)
-		      (func "put" (if (< 0 dir) "/" "\\\\"))
-		      (func "rmove-to" 1 (if (< 0 dir) 1 0))
-		      (func "set-line-char" "_")
-		      (func "h-line" (- dx 1))
-		      (func "rmove-to" (- dx 1) (if (< 0 dir) -1 0))
-		      (func "put" (if (< 0 dir) "\\\\" "/"))))))
-
-
-  (define (bracket arch_angle arch_width arch_height height arch_thick thick)
-    ;; width now fixed?
-    (let ((width 1))
-	  (string-append
-	   (func "rmove-to" (+ width 1) (- (/ height -2) 1))
-	   (func "put" "\\\\")
-	   (func "set-line-char" "|")
-	   (func "rmove-to" 0 1)
-	   (func "v-line" (+ height 1))
-	   (func "rmove-to" 0 (+ height 1))
-	   (func "put" "/")
-	   )))
-
-  (define (char i)
-    (func "char" i))
-
-  (define (define-origin a b c ) "")
-
-  (define (end-output) 
-    (func "end-output"))
-  
-  (define (experimental-on)
-	  "")
-
-  (define (filledbox breapth width depth height)
-	  (let ((dx (+ width breapth))
-		(dy (+ depth height)))
-	       (string-append 
-		(func "rmove-to" (* -1 breapth) (* -1 depth))
-		(if (< dx dy)
-		    (string-append
-		     (func "set-line-char" 
-			   (if (<= dx 1) "|" "#"))
-		     (func "v-line" dy))
-		    (string-append
-		     (func "set-line-char" 
-			   (if (<= dy 1) "-" "="))
-		    (func "h-line" dx))))))
-
-  (define (font-load-command name-mag command)
-   ;; (display "name-mag: ")
-   ;; (write name-mag)
-   ;; (display "command: ")
-   ;; (write command)
-    (func "load-font" (car name-mag) (cdr name-mag)))
-
-  (define (header creator generate) 
-    (func "header" creator generate))
-
-  (define (header-end) 
-    (func "header-end"))
-
-  ;; urg: this is good for half of as2text's execution time
-  (define (xlily-def key val)
-	  (string-append "(define " key " " (arg->string val) ")\n"))
-
-  (define (lily-def key val)
-    (if
-     ;; let's not have all bloody definitions
-     (or (equal? key "lilypondpaperlinewidth")
-	 (equal? key "lilypondpaperstaffheight")
-	 (equal? key "lilypondpaperoutputscale"))
-     (string-append "(define " key " " (arg->string val) ")\n")
-     ""))
-
-  (define (no-origin) "")
-  
-  (define (placebox x y s) 
-    (let ((ey (inexact->exact y)))
-	  (string-append "(move-to " (number->string (inexact->exact x)) " "
-			 (if (= 0.5 (- (abs y) (abs ey)))
-			     (number->string y)
-			     (number->string ey))
-			 ")\n" s)))
-		       
-  (define (select-font name-mag-pair)
-    (let* ((c (assoc name-mag-pair font-name-alist)))
-      (if (eq? c #f)
-	  (begin
-	    (ly-warn 
-	     (string-append 
-	      "Programming error: No such font known " 
-	      (car name-mag-pair))))
-	    "")				; issue no command
-	  (func "select-font" (car name-mag-pair))))
-
-  (define (start-line height)
-	  (func "start-line" height))
-
-  (define (stop-line)
-	  (func "stop-line"))
-
-  (define (text s)
-	  (func "text" s))
-
-  (define (tuplet ht gap dx dy thick dir) "")
-
-  (define (volta h w thick vert-start vert-end)
-	  ;; urg
-	  (string-append
-	   (func "set-line-char" "|")
-	   (func "rmove-to" 0 -4)
-	   ;; definition strange-way around
-	   (if (= 0 vert-start)
-	      (func "v-line" h)
-	       "")
-	   (func "rmove-to" 1 h)
-	   (func "set-line-char" "_")
-	   (func "h-line" (- w 1))
-	   (func "set-line-char" "|")
-	   (if (= 0 vert-end)
-	       (string-append
-		(func "rmove-to" (- w 1) (* -1 h))
-		(func "v-line" (* -1 h)))
-	       "")))
-
-(cond ((eq? action-name 'all-definitions)
-	 `(begin
-	    (define beam ,beam)
-	    (define bracket ,bracket)
-	    (define char ,char)
-	    (define define-origin ,define-origin)
-	    ;;(define crescendo ,crescendo)
-	    (define bezier-sandwich ,bezier-sandwich)
-	    ;;(define dashed-slur ,dashed-slur) 
-	    ;;(define decrescendo ,decrescendo) 
-	    (define end-output ,end-output)
-	    (define experimental-on ,experimental-on)
-	    (define filledbox ,filledbox)
-	    ;;(define font-def ,font-def)
-	    (define font-load-command ,font-load-command)
-	    ;;(define font-switch ,font-switch)
-	    (define header ,header) 
-	    (define header-end ,header-end)
-	    (define lily-def ,lily-def)
-	    ;;(define invoke-char ,invoke-char) 
-	    ;;(define invoke-dim1 ,invoke-dim1)
-	    (define no-origin ,no-origin)
-	    (define placebox ,placebox)
-	    (define select-font ,select-font)
-	    (define start-line ,start-line)
-	    ;;(define stem ,stem)
-	    (define stop-line ,stop-line)
-	    (define stop-last-line ,stop-line)
-	    (define text ,text)
-	    (define tuplet ,tuplet)
-	    (define volta ,volta)
-	    ))
-	((eq? action-name 'tuplet) tuplet)
-	;;((eq? action-name 'beam) beam)
-	;;((eq? action-name 'bezier-sandwich) bezier-sandwich)
-	;;((eq? action-name 'bracket) bracket)
-	((eq? action-name 'char) char)
-	;;((eq? action-name 'crescendo) crescendo)
-	;;((eq? action-name 'dashed-slur) dashed-slur) 
-	;;((eq? action-name 'decrescendo) decrescendo)
-	;;((eq? action-name 'experimental-on) experimental-on)
-	((eq? action-name 'filledbox) filledbox)
-	((eq? action-name 'select-font) select-font)
-	;;((eq? action-name 'volta) volta)
-	(else (error "unknown tag -- MUSA-SCM " action-name))
-	)
-  )
 
-(define (scm-as-output)
-  (primitive-eval (as-scm 'all-definitions)))
+(define (beam width slope thick)
+  (string-append
+   (func "set-line-char" "#")
+   (func "rline-to" width (* width slope))
+   ))
+
+					; simple flat slurs
+(define (bezier-sandwich l thick)
+  (let (
+	(c0 (cadddr l))
+	(c1 (cadr l))
+	(c3 (caddr l)))
+    (let* ((x (car c0))
+	   (dx (- (car c3) x))
+	   (dy (- (cdr c3) (cdr c0)))
+	   (rc (/ dy dx))
+	   (c1-dx (- (car c1) x))
+	   (c1-line-y (+ (cdr c0) (* c1-dx rc)))
+	   (dir (if (< c1-line-y (cdr c1)) 1 -1))
+	   (y (+ -1 (* dir (max (* dir (cdr c0)) (* dir (cdr c3)))))))
+      (string-append
+       (func "rmove-to" x y)
+       (func "put" (if (< 0 dir) "/" "\\\\"))
+       (func "rmove-to" 1 (if (< 0 dir) 1 0))
+       (func "set-line-char" "_")
+       (func "h-line" (- dx 1))
+       (func "rmove-to" (- dx 1) (if (< 0 dir) -1 0))
+       (func "put" (if (< 0 dir) "\\\\" "/"))))))
+
+
+(define (bracket arch_angle arch_width arch_height height arch_thick thick)
+  ;; width now fixed?
+  (let ((width 1))
+    (string-append
+     (func "rmove-to" (+ width 1) (- (/ height -2) 1))
+     (func "put" "\\\\")
+     (func "set-line-char" "|")
+     (func "rmove-to" 0 1)
+     (func "v-line" (+ height 1))
+     (func "rmove-to" 0 (+ height 1))
+     (func "put" "/")
+     )))
+
+(define (char i)
+  (func "char" i))
+
+(define (define-origin a b c ) "")
+
+(define (end-output) 
+  (func "end-output"))
+
+(define (experimental-on)
+  "")
+
+(define (filledbox breapth width depth height)
+  (let ((dx (+ width breapth))
+	(dy (+ depth height)))
+    (string-append 
+     (func "rmove-to" (* -1 breapth) (* -1 depth))
+     (if (< dx dy)
+	 (string-append
+	  (func "set-line-char" 
+		(if (<= dx 1) "|" "#"))
+	  (func "v-line" dy))
+	 (string-append
+	  (func "set-line-char" 
+		(if (<= dy 1) "-" "="))
+	  (func "h-line" dx))))))
+
+(define (font-load-command name-mag command)
+  ;; (display "name-mag: ")
+  ;; (write name-mag)
+  ;; (display "command: ")
+  ;; (write command)
+  (func "load-font" (car name-mag) (cdr name-mag)))
+
+(define (header creator generate) 
+  (func "header" creator generate))
+
+(define (header-end) 
+  (func "header-end"))
+
+;; urg: this is good for half of as2text's execution time
+(define (xlily-def key val)
+  (string-append "(define " key " " (arg->string val) ")\n"))
+
+(define (lily-def key val)
+  (if
+   ;; let's not have all bloody definitions
+   (or (equal? key "lilypondpaperlinewidth")
+       (equal? key "lilypondpaperstaffheight")
+       (equal? key "lilypondpaperoutputscale"))
+   (string-append "(define " key " " (arg->string val) ")\n")
+   ""))
+
+(define (no-origin) "")
+
+(define (placebox x y s) 
+  (let ((ey (inexact->exact y)))
+    (string-append "(move-to " (number->string (inexact->exact x)) " "
+		   (if (= 0.5 (- (abs y) (abs ey)))
+		       (number->string y)
+		       (number->string ey))
+		   ")\n" s)))
+
+(define (select-font name-mag-pair)
+  (let* ((c (assoc name-mag-pair font-name-alist)))
+    (if (eq? c #f)
+	(begin
+	  (ly-warn 
+	   (string-append 
+	    "Programming error: No such font known " 
+	    (car name-mag-pair))))
+	"")				; issue no command
+    (func "select-font" (car name-mag-pair))))
+
+(define (start-line height)
+  (func "start-line" height))
+
+(define (stop-line)
+  (func "stop-line"))
+
+(define (stop-last-line)
+  (func "stop-line"))
+
+
+(define (text s)
+  (func "text" s))
+
+(define (tuplet ht gap dx dy thick dir) "")
+
+(define (volta h w thick vert-start vert-end)
+  ;; urg
+  (string-append
+   (func "set-line-char" "|")
+   (func "rmove-to" 0 -4)
+   ;; definition strange-way around
+   (if (= 0 vert-start)
+       (func "v-line" h)
+       "")
+   (func "rmove-to" 1 h)
+   (func "set-line-char" "_")
+   (func "h-line" (- w 1))
+   (func "set-line-char" "|")
+   (if (= 0 vert-end)
+       (string-append
+	(func "rmove-to" (- w 1) (* -1 h))
+	(func "v-line" (* -1 h)))
+       "")))
diff --git a/scm/lily.scm b/scm/lily.scm
index c3ae34acf2..8679e958cc 100644
--- a/scm/lily.scm
+++ b/scm/lily.scm
@@ -13,6 +13,9 @@
 
 ;;; General settings
 
+
+
+
 (debug-enable 'backtrace)
 
 
@@ -110,25 +113,49 @@
 	    (symbol->string (car y))))
 
 
-(map (lambda (x) (eval-string (ly-gulp-file x)))
-     '("output-lib.scm"
-       "tex.scm"
-       "ps.scm"
-       "sketch.scm"
-       "pdf.scm"
-       "pdftex.scm"
-       "ascii-script.scm"
-       ))
+(define (ly-load x) (eval-string (ly-gulp-file x)))
 
-(define ctor list)
+(ly-load "output-lib.scm")
 
 
-(define (ly-load x) (eval-string (ly-gulp-file x)))
+
+(use-modules (scm tex)
+	     (scm ps)
+	     (scm pysk)
+	     (scm ascii-script)
+	     )
+
+(define output-alist
+  `(
+    ("tex" . ,tex-output-expression)
+    ("ps" . ,ps-output-expression)
+    ("scm" . ,write)
+    ("as" . ,as-output-expression)
+    ("pysk" . ,pysk-output-expression)
+))
+
+
+
+
+(define (find-dumper format )
+  (let*
+      ((d (assoc format output-alist)))
+    
+    (if (pair?  d)
+		(cdr d)
+	     scm-output-expression)
+	    ))
+
 
 (if (not standalone)
     (map ly-load
 					; load-from-path
-	 '("c++.scm"
+	 '("output-lib.scm"
+	   "sketch.scm"
+	   "pdf.scm"
+	   "pdftex.scm"
+	   "ascii-script.scm"
+      	   "c++.scm"
 	   "grob-property-description.scm"
 	   "translator-property-description.scm"
 	   "context-description.scm"
diff --git a/scm/output-lib.scm b/scm/output-lib.scm
index 039121f527..d9123c436e 100644
--- a/scm/output-lib.scm
+++ b/scm/output-lib.scm
@@ -101,31 +101,6 @@ centered, X==1 is at the right, X == -1 is at the left."
 	  (string-encode-integer (quotient i 26))))))
 
 
-(define (tex-encoded-fontswitch name-mag)
-  (let* ((iname-mag (car name-mag))
-	 (ename-mag (cdr name-mag)))
-    (cons iname-mag
-	  (cons ename-mag
-		(string-append  "magfont"
-			  (string-encode-integer
-			   (hashq (car ename-mag) 1000000))
-			  "m"
-			  (string-encode-integer
-			   (inexact->exact (* 1000 (cdr ename-mag)))))))))
-
-(define (define-fonts internal-external-name-mag-pairs)
-  (set! font-name-alist (map tex-encoded-fontswitch
-			     internal-external-name-mag-pairs))
-  (apply string-append
-	 (map (lambda (x)
-		(font-load-command (car x) (cdr x)))
-	      (map cdr font-name-alist))))
-
-;; urg, how can exp be #unspecified?  -- in sketch output
-(define (xfontify name-mag-pair exp)
-  (string-append (select-font name-mag-pair)
-		 exp))
-
-(define (fontify name-mag-pair exp)
-  (string-append (select-font name-mag-pair)
-		 (if (string? exp) exp "")))
+
+
+
diff --git a/scm/ps.scm b/scm/ps.scm
index ac32281bb2..f469ec7ac9 100644
--- a/scm/ps.scm
+++ b/scm/ps.scm
@@ -7,256 +7,244 @@
 
 
 
-(define (ps-scm action-name)
+(define-module (scm ps)
+  :export (ps-output-expression)
+  :no-backtrace
+  )
 
-  ;; alist containing fontname -> fontcommand assoc (both strings)
-  (define font-alist '())
-  (define font-count 0)
-  (define current-font "")
+(define this-module (current-module))
 
-  
-  (define (cached-fontname i)
-    (string-append
-     "lilyfont"
-     (make-string 1 (integer->char (+ 65 i)))))
-    
-
-  (define (select-font name-mag-pair)
-    (let*
-	(
-	 (c (assoc name-mag-pair font-name-alist))
-	 )
-
-      (if (eq? c #f)
-	  (begin
-	    (display "FAILED\n")
-	    (display (object-type (car name-mag-pair)))
-	    (display (object-type (caaar font-name-alist)))
-
-	    (ly-warn (string-append
-		      "Programming error: No such font known "
-		      (car name-mag-pair) " "
-		      (ly-number->string (cdr name-mag-pair))
-		      ))
-	    
-	    "") ; issue no command	  
-	  (string-append " " (cddr c) " "))
-      ))
-
-    (define (font-load-command name-mag command)
-      (string-append
-       "/" command
-       " { /"
-       (car name-mag)
-       " findfont "
-       "12 " (ly-number->string (cdr name-mag)) " mul "
-       "lilypondpaperoutputscale div scalefont setfont } bind def "
-       "\n"))
-
-  (define (beam width slope thick)
-    (string-append
-     (numbers->string (list slope width thick)) " draw_beam" ))
-
-  (define (comment s)
-    (string-append "% " s))
-
-  (define (bracket arch_angle arch_width arch_height  height arch_thick thick)
-    (string-append
-     (numbers->string (list arch_angle arch_width arch_height height arch_thick thick)) " draw_bracket" ))
-
-  (define (char i)
-    (invoke-char " show" i))
-
-
-  (define (hairpin thick width starth endh )
-    (string-append 
-     (numbers->string (list width starth endh thick))
-     " draw_hairpin"))
-  
-  ;; what the heck is this interface ?
-  (define (dashed-slur thick dash l)
-    (string-append 
-     (apply string-append (map control->string l)) 
-     (ly-number->string thick) 
-     " [ "
-     (ly-number->string dash)
-     " "
-     (ly-number->string (* 10 thick))	;UGH.  10 ?
-     " ] 0 draw_dashed_slur"))
-
-  (define (dashed-line thick on off dx dy)
-    (string-append 
-     (ly-number->string dx)
-     " "
-     (ly-number->string dy)
-     " "
-     (ly-number->string thick) 
-     " [ "
-     (ly-number->string on)
-     " "
-     (ly-number->string off)
-     " ] 0 draw_dashed_line"))
-  
-  (define (repeat-slash wid slope thick)
-   (string-append (numbers->string (list wid slope thick))
-    " draw_repeat_slash"))
-  
-  (define (end-output)
-    "\nend-lilypond-output\n")
-  
-  (define (experimental-on) "")
-  
-  (define (filledbox breapth width depth height) 
-    (string-append (numbers->string (list breapth width depth height))
-		   " draw_box" ))
-
-  ;; obsolete?
-  (define (font-def i s)
-    (string-append
-     "\n/" (font i) " {/" 
-     (substring s 0 (- (string-length s) 4))
-     " findfont 12 scalefont setfont} bind def \n"))
-
-  (define (font-switch i)
-    (string-append (font i) " "))
-
-  (define (header-end)
-    (string-append
-     ;; URG: now we can't use scm output without Lily
-     (ly-gulp-file "lilyponddefs.ps")
-     " {exch pop //systemdict /run get exec} "
-     (ly-gulp-file "music-drawing-routines.ps")
-     "{ exch pop //systemdict /run get exec } "
-     (if (defined? 'ps-testing) "\n /testing true def" "")
+(define (ps-output-expression expr port)
+  (display (eval expr this-module) port)
+  )
+
+ 
+(use-modules
+ (guile)
+ (guile-user))
+
+
+
+;;;;;;;;
+;;;;;;;; DOCUMENT ME!
+;;;;;;;; 
+(define (tex-encoded-fontswitch name-mag)
+  (let* ((iname-mag (car name-mag))
+	 (ename-mag (cdr name-mag)))
+    (cons iname-mag
+	  (cons ename-mag
+		(string-append  "magfont"
+			  (string-encode-integer
+			   (hashq (car ename-mag) 1000000))
+			  "m"
+			  (string-encode-integer
+			   (inexact->exact (* 1000 (cdr ename-mag)))))))))
+
+(define (fontify name-mag-pair exp)
+  (string-append (select-font name-mag-pair)
+		 exp))
+
+
+(define (define-fonts internal-external-name-mag-pairs)
+  (set! font-name-alist (map tex-encoded-fontswitch
+			     internal-external-name-mag-pairs))
+  (apply string-append
+	 (map (lambda (x)
+		(font-load-command (car x) (cdr x)))
+	      (map cdr font-name-alist))))
+
+
+
+;; alist containing fontname -> fontcommand assoc (both strings)
+(define font-alist '())
+(define font-count 0)
+(define current-font "")
+
+(define (select-font name-mag-pair)
+  (let*
+      (
+       (c (assoc name-mag-pair font-name-alist))
+       )
+
+    (if (eq? c #f)
+	(begin
+	  (display "FAILED\n")
+	  (display (object-type (car name-mag-pair)))
+	  (display (object-type (caaar font-name-alist)))
+
+	  (ly-warn (string-append
+		    "Programming error: No such font known "
+		    (car name-mag-pair) " "
+		    (ly-number->string (cdr name-mag-pair))
+		    ))
+	  
+	  "") ; issue no command	  
+	(string-append " " (cddr c) " "))
     ))
-  
-  (define (lily-def key val)
-
-     (if (string=? (substring key 0 (min (string-length "lilypondpaper") (string-length key))) "lilypondpaper")
-	 (string-append "/" key " {" val "} bind def\n")
-	 (string-append "/" key " (" val ") def\n")
-	 )
-     )
-
-  (define (header creator generate) 
-    (string-append
-     "%!PS-Adobe-3.0\n"
-     "%%Creator: " creator generate "\n"))
-  
-  (define (invoke-char s i)
-    (string-append 
-     "(\\" (inexact->string i 8) ") " s " " ))
-  
-  (define (invoke-dim1 s d) 
-    (string-append
-     (ly-number->string (* d  (/ 72.27 72))) " " s ))
-
-  (define (placebox x y s) 
-    (string-append 
-     (ly-number->string x) " " (ly-number->string y) " {" s "} place-box\n"))
-
-  (define (bezier-sandwich l thick)
-    (string-append 
-     (apply string-append (map control->string l))
-     (ly-number->string  thick)
-     " draw_bezier_sandwich"))
-
-; TODO: use HEIGHT argument
-  (define (start-line height)
-    (string-append
-     "\n"
-     (ly-number->string height)
-     " start-line {
+
+(define (font-load-command name-mag command)
+  (string-append
+   "/" command
+   " { /"
+   (car name-mag)
+   " findfont "
+   "12 " (ly-number->string (cdr name-mag)) " mul "
+   "lilypondpaperoutputscale div scalefont setfont } bind def "
+   "\n"))
+
+(define (beam width slope thick)
+  (string-append
+   (numbers->string (list slope width thick)) " draw_beam" ))
+
+(define (comment s)
+  (string-append "% " s "\n"))
+
+(define (bracket arch_angle arch_width arch_height  height arch_thick thick)
+  (string-append
+   (numbers->string (list arch_angle arch_width arch_height height arch_thick thick)) " draw_bracket" ))
+
+(define (char i)
+  (invoke-char " show" i))
+
+
+(define (hairpin thick width starth endh )
+  (string-append 
+   (numbers->string (list width starth endh thick))
+   " draw_hairpin"))
+
+;; what the heck is this interface ?
+(define (dashed-slur thick dash l)
+  (string-append 
+   (apply string-append (map control->string l)) 
+   (ly-number->string thick) 
+   " [ "
+   (ly-number->string dash)
+   " "
+   (ly-number->string (* 10 thick))	;UGH.  10 ?
+   " ] 0 draw_dashed_slur"))
+
+(define (dashed-line thick on off dx dy)
+  (string-append 
+   (ly-number->string dx)
+   " "
+   (ly-number->string dy)
+   " "
+   (ly-number->string thick) 
+   " [ "
+   (ly-number->string on)
+   " "
+   (ly-number->string off)
+   " ] 0 draw_dashed_line"))
+
+(define (repeat-slash wid slope thick)
+  (string-append (numbers->string (list wid slope thick))
+		 " draw_repeat_slash"))
+
+(define (end-output)
+  "\nend-lilypond-output\n")
+
+(define (experimental-on) "")
+
+(define (filledbox breapth width depth height) 
+  (string-append (numbers->string (list breapth width depth height))
+		 " draw_box" ))
+
+;; obsolete?
+(define (font-def i s)
+  (string-append
+   "\n/" (font i) " {/" 
+   (substring s 0 (- (string-length s) 4))
+   " findfont 12 scalefont setfont} bind def \n"))
+
+(define (font-switch i)
+  (string-append (font i) " "))
+
+(define (header-end)
+  (string-append
+   ;; URG: now we can't use scm output without Lily
+   (ly-gulp-file "lilyponddefs.ps")
+   " {exch pop //systemdict /run get exec} "
+   (ly-gulp-file "music-drawing-routines.ps")
+   "{ exch pop //systemdict /run get exec } "
+   (if (defined? 'ps-testing) "\n /testing true def" "")
+   ))
+
+(define (lily-def key val)
+
+  (if (string=? (substring key 0 (min (string-length "lilypondpaper") (string-length key))) "lilypondpaper")
+      (string-append "/" key " {" val "} bind def\n")
+      (string-append "/" key " (" val ") def\n")
+      )
+  )
+
+(define (header creator generate) 
+  (string-append
+   "%!PS-Adobe-3.0\n"
+   "%%Creator: " creator generate "\n"))
+
+(define (invoke-char s i)
+  (string-append 
+   "(\\" (inexact->string i 8) ") " s " " ))
+
+(define (invoke-dim1 s d) 
+  (string-append
+   (ly-number->string (* d  (/ 72.27 72))) " " s ))
+
+(define (placebox x y s) 
+  (string-append 
+   (ly-number->string x) " " (ly-number->string y) " {" s "} place-box\n"))
+
+(define (bezier-sandwich l thick)
+  (string-append 
+   (apply string-append (map control->string l))
+   (ly-number->string  thick)
+   " draw_bezier_sandwich"))
+
+					; TODO: use HEIGHT argument
+(define (start-line height)
+  (string-append
+   "\n"
+   (ly-number->string height)
+   " start-line {
 lilypondpaperoutputscale lilypondpaperoutputscale scale
 "))
-  
-  (define (stem breapth width depth height) 
-    (string-append (numbers->string (list breapth width depth height))
-		   " draw_box" ))
 
-  (define (stop-line)
-      "}\nstop-line\n")
+(define (stem breapth width depth height) 
+  (string-append (numbers->string (list breapth width depth height))
+		 " draw_box" ))
 
-  (define (text s)
-    (string-append "(" s ") show  "))
+(define (stop-line)
+  "}\nstop-line\n")
 
+(define (stop-last-line)
+  "}\nstop-line\n")
 
-  (define (volta h w thick vert_start vert_end)
-    (string-append 
-     (numbers->string (list h w thick (inexact->exact vert_start) (inexact->exact vert_end)))
-     " draw_volta"))
+(define (text s)
+  (string-append "(" s ") show  "))
 
-  (define (tuplet ht gap dx dy thick dir)
-    (string-append 
-     (numbers->string (list ht gap dx dy thick (inexact->exact dir)))
-     " draw_tuplet"))
 
+(define (volta h w thick vert_start vert_end)
+  (string-append 
+   (numbers->string (list h w thick (inexact->exact vert_start) (inexact->exact vert_end)))
+   " draw_volta"))
 
-  (define (unknown) 
-    "\n unknown\n")
+(define (tuplet ht gap dx dy thick dir)
+  (string-append 
+   (numbers->string (list ht gap dx dy thick (inexact->exact dir)))
+   " draw_tuplet"))
 
-  (define (ez-ball ch letter-col ball-col)
-    (string-append
-     " (" ch ") "
-     (numbers->string (list letter-col ball-col))
-     " /Helvetica-Bold " ;; ugh
-     " draw_ez_ball"))
 
-  (define (define-origin a b c ) "")
-  (define (no-origin) "")
-  
-  ;; PS
-  (cond ((eq? action-name 'all-definitions)
-	 `(begin
-	    (define beam ,beam)
-	    (define tuplet ,tuplet)
-	    (define bracket ,bracket)
-	    (define char ,char)
-	    (define hairpin ,hairpin)
-	    (define volta ,volta)
-	    (define bezier-sandwich ,bezier-sandwich)
-	    (define dashed-line ,dashed-line) 
-	    (define dashed-slur ,dashed-slur) 
-	    (define end-output ,end-output)
-	    (define experimental-on ,experimental-on)
-	    (define filledbox ,filledbox)
-	    (define font-def ,font-def)
-	    (define font-switch ,font-switch)
-	    (define header-end ,header-end)
-	    (define lily-def ,lily-def)
-	    (define font-load-command ,font-load-command)
-	    (define header ,header) 
-	    (define invoke-char ,invoke-char) 
-	    (define invoke-dim1 ,invoke-dim1)
-	    (define placebox ,placebox)
-	    (define select-font ,select-font)
-	    (define start-line ,start-line)
-	    (define stem ,stem)
-	    (define stop-line ,stop-line)
-	    (define stop-last-line ,stop-line)
-	    (define repeat-slash ,repeat-slash)
-	    (define text ,text)
-	    (define no-origin ,no-origin)
-	    (define define-origin ,define-origin)
-	    (define ez-ball ,ez-ball)
-	    ))
-	((eq? action-name 'repeat-slash) repeat-slash)
-	((eq? action-name 'tuplet) tuplet)
-	((eq? action-name 'beam) beam)
-	((eq? action-name 'bezier-sandwich) bezier-sandwich)
-	((eq? action-name 'bracket) bracket)
-	((eq? action-name 'char) char)
-	((eq? action-name 'dashed-line) dashed-line) 
-	((eq? action-name 'dashed-slur) dashed-slur) 
-	((eq? action-name 'hairpin) hairpin)
-	((eq? action-name 'experimental-on) experimental-on)
-	((eq? action-name 'filledbox) filledbox)
-	((eq? action-name 'ez-ball) ez-ball)	
-	((eq? action-name 'select-font) select-font)
-	((eq? action-name 'volta) volta)
-	(else (error "unknown tag -- PS-SCM " action-name))
-	)
-  )
+(define (unknown) 
+  "\n unknown\n")
+
+(define (ez-ball ch letter-col ball-col)
+  (string-append
+   " (" ch ") "
+   (numbers->string (list letter-col ball-col))
+   " /Helvetica-Bold " ;; ugh
+   " draw_ez_ball"))
 
-(define (scm-ps-output)
-  (primitive-eval (ps-scm 'all-definitions)))
+(define (define-origin a b c ) "")
+(define (no-origin) "")
+  
+  
diff --git a/scm/pysk.scm b/scm/pysk.scm
new file mode 100644
index 0000000000..e999e00d25
--- /dev/null
+++ b/scm/pysk.scm
@@ -0,0 +1,98 @@
+;;; pysk.scm -- implement Python  output routines (for Sketch)
+;;;
+;;;  source file of the GNU LilyPond music typesetter
+;;; 
+;;; (c) 1998--2001 Jan Nieuwenhuizen <janneke@gnu.org>
+;;; Han-Wen Nienhuys <hanwen@cs.uu.nl>
+
+
+
+(define-module (scm pysk)
+  :export (pysk-output-expression)
+  :no-backtrace
+  )
+
+(use-modules (scm ps)
+	     (ice-9 regex)
+	     (ice-9 string-fun)
+	     (guile-user)
+	     (guile)
+	     )
+
+(define this-module (current-module))
+(define (pysk-output-expression expr port)
+  (display (pythonify expr) port )
+  )
+
+(define (ly-warn s) (display s))
+
+(define (pythonify q)
+  (cond
+   ((string? q) (py-str q))
+   ((symbol? q) (py-str (symbol->string q)))
+   ((and (pair?  q)
+	 (not (pair? (cdr q)))
+	 (not (eq? '() (cdr q)))
+	 ) (py-tuple q))
+   ((pair? q) (py-listify q))
+   ((number? q) (number->string q))
+   ((eq? q '()) '())
+   (else (begin
+	   (ly-warn "Unknown object to pythonify:")
+	   (write q)
+	   (newline)
+	   )
+  )))
+
+(define (py-str s)
+  (string-append "'" s "'")
+  )
+
+(define (py-tuple q)
+  (string-append "(" (pythonify (car  q)) "," (pythonify (cdr q)) ")")
+  )
+
+(define (reduce-list list between)
+  "Create new list, inserting BETWEEN between elements of LIST"
+  (if (null? list)
+      '()
+      (if (null? (cdr list))
+	  list
+	  (cons (car list)
+		(cons between (reduce-list (cdr list) between)))
+  
+  )))
+
+(define (string-join str-list sep)
+  (apply string-append (reduce-list str-list sep))
+  )
+
+(define (my-map f l)
+  (if (null? l)
+      '()
+      (if (pair? (cdr l))
+	  (cons (f (car l)) (my-map f (cdr l)))
+	  (cons (f (car l)) (f (cdr l)))
+	  )
+  ))
+
+(define (tuplify-list lst)
+  (if (null? lst)
+      '()
+      (if (pair? (cdr lst))
+	  (cons (car lst) (tuplify-list (cdr lst)))
+	  (if (eq? '() (cdr lst))
+	      lst
+	      (list (string-append "(" (car lst) ", " (cdr lst) ")" ))
+	      ))
+	  ))
+
+(define (py-listify q)
+  (string-append
+   "["
+   (string-join
+    (tuplify-list (my-map pythonify q))   ",")
+   "]\n"
+   ))
+
+
diff --git a/scm/sketch.scm b/scm/sketch.scm
index 58fe938749..8b13789179 100644
--- a/scm/sketch.scm
+++ b/scm/sketch.scm
@@ -1,319 +1 @@
 
-
-
-(use-modules (ice-9 format))
-
-(define (ascii->string i) (make-string 1 (integer->char i)))
-
-(define (control->list c)
-  (list (+ global-x (car c)) (+ global-y (cdr c))))
-
-(define (control-flip-y c)
-  (cons (car c) (* -1 (cdr c))))
-
-;;; urg.
-(define (sk-numbers->string l)
-  (string-append
-   (number->string (car l))
-   (if (null? (cdr l))
-       ""
-       (string-append ","  (sk-numbers->string (cdr l))))))
-
-(define global-x 0.0)
-(define global-y 0.0)
-(define global-list '())
-(define global-font "")
-(define global-s "")
-(define global-scale 1.0)
-(define (global-mul-scale  x) (* global-scale x))
-
-;; hmm, global is global
-(define (global-filledbox width dy dx height x y)
-  (string-append
-   "fp((0,0,0))\n"
-   "lw(0.1)\n"
-   "r("
-   (sk-numbers->string
-    (map global-mul-scale (list width dy dx height x y)))
-   ")\n"))
-
-(define (global-bezier l)
-  (let* ((c0 (car (list-tail l 3)))
-	 (c123 (list-head l 3))
-	 (start (control->list c0))
-	 (control (apply append (map control->list c123))))
-    (string-append
-     "bs(" (sk-numbers->string (map global-mul-scale start)) ",0)\n"
-     "bc(" (sk-numbers->string (map global-mul-scale control)) ",2)\n")))
-  
-
-(define (global-beziers l thick)
-  (let* (;;(burp (set! global-y (+ global-y (* 2 (cdar l)))))
-	 (first
-	  (list-tail l 4))
-	 (second
-	  (list-head l 4))
-		 )
-    (string-append
-     "fp((0,0,0))\n"
-     "lw(0.1)\n"
-     "b()\n"
-     (global-bezier first)
-     (global-bezier second)
-     ;;"b_()\n"
-     )))
-	 
-		 
-(define (sketch-scm action-name)
-  
-  ;; alist containing fontname -> fontcommand assoc (both strings)
-  (define font-alist '())
-  (define font-count 0)
-  (define current-font "")
-
-  (define (font-def x)
-  "")
-
-  (define (cached-fontname i)
-    "")
-  
-  (define (select-font name-mag-pair)
-    (set! global-font (car name-mag-pair))
-    "")
-  
-  (define (font-load-command name-mag command)
-    "")
-    
-  (define (beam width slope thick)
-    (let ((s (list
-	      'global-filledbox
-	      width
-	      (* slope width)
-	      0
-	      thick
-	      'global-x
-	      'global-y)))
-      (set! global-s s))
-    "\n")
-
-  (define (comment s)
-    (string-append "% " s))
-
-  (define (bracket arch_angle arch_width arch_height  height arch_thick thick)
-    (string-append
-     (numbers->string (list arch_angle arch_width arch_height height arch_thick thick)) " draw_bracket" ))
-
-  (define (char i)
-    (set! global-s
-;;	  `(string-append "txt(" ,(number->string i) ",("
-;;			  (sk-numbers->string (list global-x global-y))
-	  `(string-append
-	    "fp((0,0,0))\n"
-	    "le()\n"
-	    "lw(0.1)\n"
-;;	    "Fn('" global-font "')\n"
-;;	    "Fn('Times-Roman')\n"
-	    "Fn('TeX-feta20')\n"
-	    "Fs(20)\n"
-	    ;; chars > 128 don't work yet
-	    "txt('" ,(ascii->string (modulo i 128)) "',("
-;;	    "char(" ,(number->string i)  ",("
-	    (sk-numbers->string (list (* global-scale global-x)
-				      (* global-scale global-y)))
-	    "))\n")))
-
-  (define (hairpin thick width starth endh )
-    (string-append 
-     (numbers->string (list width starth endh thick))
-     " draw_hairpin"))
-  
-  ;; what the heck is this interface ?
-  (define (dashed-slur thick dash l)
-    (string-append 
-     (apply string-append (map control->string l)) 
-     (ly-number->string thick) 
-     " [ "
-     (ly-number->string dash)
-     " "
-     (ly-number->string (* 10 thick))	;UGH.  10 ?
-     " ] 0 draw_dashed_slur"))
-
-  (define (dashed-line thick on off dx dy)
-    (string-append 
-     (ly-number->string dx)
-     " "
-     (ly-number->string dy)
-     " "
-     (ly-number->string thick) 
-     " [ "
-     (ly-number->string on)
-     " "
-     (ly-number->string off)
-     " ] 0 draw_dashed_line"))
-  
-  (define (repeat-slash wid slope thick)
-   (string-append (numbers->string (list wid slope thick))
-    " draw_repeat_slash"))
-  
-  (define (end-output)
-    "guidelayer('Guide Lines',1,0,0,1,(0,0,1))
-grid((0,0,20,20),0,(0,0,1),'Grid')\n")
-  
-  (define (experimental-on) "")
-  
-  (define (font-switch i)
-    "")
-
-  (define (header-end)
-    "")
-    
-  (define (lily-def key val)
-    (if (equal? key "lilypondpaperoutputscale")
-	(set! global-scale (string->number val)))
-    "")
-  
-
-  (define (header creator generate)
-    (string-append
-     "##Sketch 1 2
-document()
-layout('A4',0)
-layer('Layer 1',1,1,0,0,(0,0,0))
-"))
-  
-  (define (invoke-char s i)
-    "")
-  
-  (define (invoke-dim1 s d) 
-    (string-append
-     (ly-number->string (* d  (/ 72.27 72))) " " s ))
-
-  ;;  urg
-  (define (placebox x y s)
-;;    (format (current-error-port) "placebox: ~S, ~S, ~S\n" x y s)
-    (set! global-x (+ x 0))
-    (set! global-y (+ y 100))
-    (let ((s (primitive-eval global-s)))
-      (set! global-s "\n")
-      s))
-
-  (define (bezier-sandwich l thick)
-    (let ((s (list
-	      'global-beziers
-	      'global-list
-	      thick)))
-      (set! global-s s)
-      (set! global-list l))
-    "\n")
-
-; TODO: use HEIGHT argument
-  (define (start-line height)
-     "G()\n"
-     )
-  
-  ;;  r((520.305,0,0,98.0075,51.8863,10.089))
-  ;;  width, 0, 0, height, x, y
-  (define (filledbox breapth width depth height)
-    (let ((s (list
-	      'global-filledbox
-	      (+ breapth width)
-	      0 0
-	      (+ depth height)
-	      `(- global-x ,breapth)
-	      `(- global-y ,depth))))
-;;      (format (current-error-port) "filledbox: ~S\n" s)
-      (set! global-s s))
-    "\n")
-  
-  (define (stem x y z w) (filledbox x y z w))
-
-  
-  (define (stop-line)
-      "G_()\n")
-
-  (define (text s)
-    (set! global-s
-	  `(string-append "txt('" ,s "',("
-			  (sk-numbers->string (list global-x global-y))
-			  "))\n")))
-
-
-  (define (volta h w thick vert_start vert_end)
-    (string-append 
-     (numbers->string (list h w thick (inexact->exact vert_start) (inexact->exact vert_end)))
-     " draw_volta"))
-
-  (define (tuplet ht gap dx dy thick dir)
-    (string-append 
-     (numbers->string (list ht gap dx dy thick (inexact->exact dir)))
-     " draw_tuplet"))
-
-
-  (define (unknown) 
-    "\n unknown\n")
-
-  (define (ez-ball ch letter-col ball-col)
-    (string-append
-     " (" ch ") "
-     (numbers->string (list letter-col ball-col))
-     " /Helvetica-Bold " ;; ugh
-     " draw_ez_ball"))
-
-  (define (define-origin a b c ) "")
-  (define (no-origin) "")
-  
-  ;; PS
-  (cond ((eq? action-name 'all-definitions)
-	 `(begin
-	    (define beam ,beam)
-	    (define tuplet ,tuplet)
-	    (define bracket ,bracket)
-	    (define char ,char)
-	    (define hairpin ,hairpin)
-	    (define volta ,volta)
-	    (define bezier-sandwich ,bezier-sandwich)
-	    (define dashed-line ,dashed-line) 
-	    (define dashed-slur ,dashed-slur) 
-	    (define end-output ,end-output)
-	    (define experimental-on ,experimental-on)
-	    (define filledbox ,filledbox)
-	    (define stem ,stem)	    
-	    (define font-def ,font-def)
-	    (define font-switch ,font-switch)
-	    (define header-end ,header-end)
-	    (define lily-def ,lily-def)
-	    (define font-load-command ,font-load-command)
-	    (define header ,header) 
-	    (define invoke-char ,invoke-char) 
-	    (define invoke-dim1 ,invoke-dim1)
-	    (define placebox ,placebox)
-	    (define select-font ,select-font)
-	    (define start-line ,start-line)
-	    (define stem ,stem)
-	    (define stop-line ,stop-line)
-	    (define stop-last-line ,stop-line)
-	    (define repeat-slash ,repeat-slash)
-	    (define text ,text)
-	    (define no-origin ,no-origin)
-	    (define define-origin ,define-origin)
-	    (define ez-ball ,ez-ball)
-	    ))
-	((eq? action-name 'repeat-slash) repeat-slash)
-	((eq? action-name 'tuplet) tuplet)
-	((eq? action-name 'beam) beam)
-	((eq? action-name 'bezier-sandwich) bezier-sandwich)
-	((eq? action-name 'bracket) bracket)
-	((eq? action-name 'char) char)
-	((eq? action-name 'dashed-line) dashed-line) 
-	((eq? action-name 'dashed-slur) dashed-slur) 
-	((eq? action-name 'hairpin) hairpin)
-	((eq? action-name 'experimental-on) experimental-on)
-	((eq? action-name 'filledbox) filledbox)
-	((eq? action-name 'ez-ball) ez-ball)	
-	((eq? action-name 'select-font) select-font)
-	((eq? action-name 'volta) volta)
-	(else (error "unknown tag -- SKETCH-SCM " action-name))
-	)
-  )
-
-
diff --git a/scm/tex.scm b/scm/tex.scm
index 1a1ec47cf6..01880f90f6 100644
--- a/scm/tex.scm
+++ b/scm/tex.scm
@@ -6,259 +6,267 @@
 ;;; Han-Wen Nienhuys <hanwen@cs.uu.nl>
 
 
+(define-module (scm tex)
+  :export (tex-output-expression)
+  :no-backtrace
+  )
+
+(use-modules (scm ps)
+	     (ice-9 regex)
+	     (ice-9 string-fun)
+	     (ice-9 format)
+	     (guile-user)
+	     (guile)
+	     )
+
+(define this-module (current-module))
+
+;;;;;;;;
+;;;;;;;; DOCUMENT ME!
+;;;;;;;; 
+(define (tex-encoded-fontswitch name-mag)
+  (let* ((iname-mag (car name-mag))
+	 (ename-mag (cdr name-mag)))
+    (cons iname-mag
+	  (cons ename-mag
+		(string-append  "magfont"
+			  (string-encode-integer
+			   (hashq (car ename-mag) 1000000))
+			  "m"
+			  (string-encode-integer
+			   (inexact->exact (* 1000 (cdr ename-mag)))))))))
+
+(define (define-fonts internal-external-name-mag-pairs)
+  (set! font-name-alist (map tex-encoded-fontswitch
+			     internal-external-name-mag-pairs))
+  (apply string-append
+	 (map (lambda (x)
+		(font-load-command (car x) (cdr x)))
+	      (map cdr font-name-alist))))
+
+
 
+;; urg, how can exp be #unspecified?  -- in sketch output
 ;;
-;; todo: this dispatch is totally LAME
- 
-(define (tex-scm action-name)
-  (define (unknown) 
-    "%\n\\unknown%\n")
-
-
-  (define (select-font name-mag-pair)
-    (let*
-	(
-	 (c (assoc name-mag-pair font-name-alist))
-	 )
-
-      (if (eq? c #f)
-	  (begin
-	    (display "FAILED\n")
-	    (display (object-type (car name-mag-pair)))
-	    (display (object-type (caaar font-name-alist)))
-
-	    (ly-warn (string-append
-		      "Programming error: No such font known "
-		      (car name-mag-pair) " "
-		      (ly-number->string (cdr name-mag-pair))
-		      ))
-	    "") ; issue no command
-	  (string-append "\\" (cddr c)))
-      
-      
-      ))
-  
-  (define (beam width slope thick)
-    (embedded-ps ((ps-scm 'beam) width slope thick)))
-
-  (define (bracket arch_angle arch_width arch_height height arch_thick thick)
-    (embedded-ps ((ps-scm 'bracket) arch_angle arch_width arch_height height arch_thick thick)))
-
-  (define (dashed-slur thick dash l)
-    (embedded-ps ((ps-scm 'dashed-slur)  thick dash l)))
-
-  (define (hairpin thick w sh eh)
-    (embedded-ps ((ps-scm 'hairpin) thick w sh eh)))
-
-  (define (char i)
-    (string-append "\\char" (inexact->string i 10) " "))
-  
-  (define (dashed-line thick on off dx dy)
-    (embedded-ps ((ps-scm 'dashed-line) thick on off dx dy)))
-
-  (define (font-load-command name-mag command)
-    (string-append
-     "\\font\\" command "="
-     (car name-mag)
-     " scaled "
-     (ly-number->string (inexact->exact (* 1000  (cdr name-mag))))
-     "\n"))
-
-  (define (ez-ball c l b)
-    (embedded-ps ((ps-scm 'ez-ball) c  l b)))
-  (define (embedded-ps s)
-    (string-append "\\embeddedps{" s "}"))
-
-  (define (comment s)
-    (string-append "% " s))
-  
-  (define (end-output) 
+;; set! returns #<unspecified>  --hwn
+(define (fontify name-mag-pair exp)
+  (string-append (select-font name-mag-pair)
+		 exp))
+
+
+(define (unknown) 
+  "%\n\\unknown%\n")
+
+(define (select-font name-mag-pair)
+  (let*
+      (
+       (c (assoc name-mag-pair font-name-alist))
+       )
+
+    (if (eq? c #f)
 	(begin
-; uncomment for some stats about lily memory	  
-;		(display (gc-stats))
+	  (display "FAILED\n")
+	  (display (object-type (car name-mag-pair)))
+	  (display (object-type (caaar font-name-alist)))
+
+	  (ly-warn (string-append
+		    "Programming error: No such font known "
+		    (car name-mag-pair) " "
+		    (ly-number->string (cdr name-mag-pair))
+		    ))
+	  "") ; issue no command
+	(string-append "\\" (cddr c)))
+    
+    
+    ))
+
+(define (beam width slope thick)
+  (embedded-ps (list 'beam  width slope thick)))
+
+(define (bracket arch_angle arch_width arch_height height arch_thick thick)
+  (embedded-ps (list 'bracket  arch_angle arch_width arch_height height arch_thick thick)))
+
+(define (dashed-slur thick dash l)
+  (embedded-ps (list 'dashed-slur   thick dash l)))
+
+(define (hairpin thick w sh eh)
+  (embedded-ps (list 'hairpin thick w sh eh))
+)
+
+(define (char i)
+  (string-append "\\char" (inexact->string i 10) " "))
+
+(define (dashed-line thick on off dx dy)
+  (embedded-ps (list 'dashed-line  thick on off dx dy)))
+
+(define (font-load-command name-mag command)
+  (string-append
+   "\\font\\" command "="
+   (car name-mag)
+   " scaled "
+   (ly-number->string (inexact->exact (* 1000  (cdr name-mag))))
+   "\n"))
+
+(define (ez-ball c l b)
+  (embedded-ps (list 'ez-ball  c  l b)))
+
+(define (header-to-file fn key val)
+  (set! key (symbol->string key))
+  (if (not (equal? "-" fn))
+      (set! fn (string-append fn "." key))
+      )
+  (display
+   (format "writing header field `~a' to `~a'..."
+	   key
+	   (if (equal? "-" fn) "<stdout>" fn)
+	   )
+   (current-error-port))
+  (if (equal? fn "-")
+      (display val)
+      (display val (open-file fn "w"))
+  )
+  (display "\n" (current-error-port))
+  ""
+  )
+
+
+(define (embedded-ps expr)
+  (let
+      ((os (open-output-string)))
+    (ps-output-expression expr os)
+    (string-append "\\embeddedps{" (get-output-string os) "}")
+  ))
+
+(define (comment s)
+  (string-append "% " s "\n"))
+
+(define (end-output) 
+  (begin
+					; uncomment for some stats about lily memory	  
+					;		(display (gc-stats))
     (string-append "\n\\EndLilyPondOutput"
-		   ; Put GC stats here.
+					; Put GC stats here.
 		   )))
-  
-  (define (experimental-on)
-    "")
-
-  (define (repeat-slash w a t)
-    (embedded-ps ((ps-scm 'repeat-slash) w a t)))
-  
-  (define (font-switch i)
-    (string-append
-     "\\" (font i) "\n"))
-
-  (define (font-def i s)
-    (string-append
-     "\\font" (font-switch i) "=" s "\n"))
-
-  (define (header-end)
-    (string-append
-     "\\special{\\string! "
-     
-     ;; URG: ly-gulp-file: now we can't use scm output without Lily
-     (if use-regex
-	 ;; fixed in 1.3.4 for powerpc -- broken on Windows
-	 (regexp-substitute/global #f "\n"
-				   (ly-gulp-file "music-drawing-routines.ps") 'pre " %\n" 'post)
-	 (ly-gulp-file "music-drawing-routines.ps"))
-     (if (defined? 'ps-testing) "/testing true def%\n" "")
-     "}"
-     "\\input lilyponddefs \\outputscale=\\lilypondpaperoutputscale pt\\turnOnPostScript"))
-
-  ;; Note: this string must match the string in ly2dvi.py!!!
-  (define (header creator generate) 
-    (string-append
-     "% Generated automatically by: " creator generate "\n"))
-
-  (define (invoke-char s i)
-    (string-append 
-     "\n\\" s "{" (inexact->string i 10) "}" ))
-
-  (define (invoke-dim1 s d)
-    (string-append
-     "\n\\" s "{" (number->dim d) "}"))
-  (define (pt->sp x)
-    (* 65536 x))
-  
-  ;;
-  ;; need to do something to make this really safe.
-  ;;
-  (define (output-tex-string s)
-      (if security-paranoia
-	  (if use-regex
-	      (regexp-substitute/global #f "\\\\" s 'pre "$\\backslash$" 'post)
-	      (begin (display "warning: not paranoid") (newline) s))
-	  s))
-      
-  (define (lily-def key val)
-    (let ((tex-key
-	   (if use-regex
-	       ;; fixed in 1.3.4 for powerpc -- broken on Windows
-	       (regexp-substitute/global
-		#f "_" (output-tex-string key) 'pre "X" 'post)
-	       (output-tex-string key)))
-	  (tex-val (output-tex-string val)))
-      (if (equal? (sans-surrounding-whitespace tex-val) "")
-	  (string-append "\\let\\" tex-key "\\undefined\n")
-	  (string-append "\\def\\" tex-key "{" tex-val "}\n"))))
-		
-  (define (number->dim x)
-    (string-append
-     ;;ugh ly-* in backend needs compatibility func for standalone output
-     (ly-number->string x) " \\outputscale "))
-
-  (define (placebox x y s) 
-    (string-append 
-     "\\placebox{"
-     (number->dim y) "}{" (number->dim x) "}{" s "}\n"))
-
-  (define (bezier-sandwich l thick)
-    (embedded-ps ((ps-scm 'bezier-sandwich) l thick)))
-
-  (define (start-line ht)
-      (string-append"\\vbox to " (number->dim ht) "{\\hbox{%\n"))
-
-  (define (stop-line) 
-    "}\\vss}\\interscoreline\n")
-  (define (stop-last-line)
-    "}\\vss}")
-  
-  (define (filledbox breapth width depth height)
-    (if (defined? 'ps-testing)
-	(embedded-ps
-	 (string-append (numbers->string (list breapth width depth height))
-			" draw_box" ))
-	(string-append 
-	 "\\kern" (number->dim (- breapth))
-	 "\\vrule width " (number->dim (+ breapth width))
-	 "depth " (number->dim depth)
-	 "height " (number->dim height) " ")))
-
-  (define (text s)
-    (string-append "\\hbox{" (output-tex-string s) "}"))
-  
-  (define (tuplet ht gapx dx dy thick dir)
-    (embedded-ps ((ps-scm 'tuplet) ht gapx dx dy thick dir)))
-
-  (define (volta h w thick vert_start vert_end)
-    (embedded-ps ((ps-scm 'volta) h w thick vert_start vert_end)))
-
-  (define (define-origin file line col)
-    (if (procedure? point-and-click)
-	(string-append "\\special{src\\string:"
-		       (point-and-click line col file)
-		       "}" )
-	"")
-  )
 
-  ; no-origin not yet supported by Xdvi
-  (define (no-origin) "")
-  
-  ;; TeX
-  ;; The procedures listed below form the public interface of TeX-scm.
-  ;; (should merge the 2 lists)
-  (cond ((eq? action-name 'all-definitions)
-	 `(begin
-	    (define font-load-command ,font-load-command)
-	    (define beam ,beam)
-	    (define bezier-sandwich ,bezier-sandwich)
-	    (define bracket ,bracket)
-	    (define char ,char)
-	    (define dashed-line ,dashed-line) 
-	    (define dashed-slur ,dashed-slur) 
-	    (define hairpin ,hairpin) 
-	    (define end-output ,end-output)
-	    (define experimental-on ,experimental-on)
-	    (define filledbox ,filledbox)
-	    (define font-def ,font-def)
-	    (define font-switch ,font-switch)
-	    (define header-end ,header-end)
-	    (define lily-def ,lily-def)
-	    (define ez-ball ,ez-ball)
-	    (define header ,header) 
-	    (define invoke-char ,invoke-char) 
-	    (define invoke-dim1 ,invoke-dim1)
-	    (define placebox ,placebox)
-	    (define select-font ,select-font)
-	    (define start-line ,start-line)
-	    (define stop-line ,stop-line)
-	    (define stop-last-line ,stop-last-line)
-	    (define text ,text)
-	    (define tuplet ,tuplet)
-	    (define volta ,volta)
-	    (define define-origin ,define-origin)
-	    (define no-origin ,no-origin)
-	    (define repeat-slash ,repeat-slash)
-	    ))
-
-	((eq? action-name 'beam) beam)
-	((eq? action-name 'tuplet) tuplet)
-	((eq? action-name 'bracket) bracket)
-	((eq? action-name 'hairpin) hairpin)
-	((eq? action-name 'dashed-line) dashed-line) 
-	((eq? action-name 'dashed-slur) dashed-slur) 
-	((eq? action-name 'end-output) end-output)
-	((eq? action-name 'experimental-on) experimental-on)
-	((eq? action-name 'font-def) font-def)
-	((eq? action-name 'font-switch) font-switch)
-	((eq? action-name 'header-end) header-end)
-	((eq? action-name 'lily-def) lily-def)
-	((eq? action-name 'header) header) 
-	((eq? action-name 'invoke-char) invoke-char) 
-	((eq? action-name 'invoke-dim1) invoke-dim1)
-	((eq? action-name 'placebox) placebox)
-	((eq? action-name 'bezier-sandwich) bezier-sandwich)
-	((eq? action-name 'start-line) start-line)
-	((eq? action-name 'stem) stem)
-	((eq? action-name 'stop-line) stop-line)
-	((eq? action-name 'stop-last-line) stop-last-line)
-	((eq? action-name 'volta) volta)
-	(else (error "unknown tag -- PS-TEX " action-name))
-	)
+(define (experimental-on)
+  "")
+
+(define (repeat-slash w a t)
+  (embedded-ps (list 'repeat-slash  w a t)))
+
+(define (font-switch i)
+  (string-append
+   "\\" (font i) "\n"))
+
+(define (font-def i s)
+  (string-append
+   "\\font" (font-switch i) "=" s "\n"))
+
+(define (header-end)
+  (string-append
+   "\\special{\\string! "
+   
+   ;; URG: ly-gulp-file: now we can't use scm output without Lily
+   (if use-regex
+       ;; fixed in 1.3.4 for powerpc -- broken on Windows
+       (regexp-substitute/global #f "\n"
+				 (ly-gulp-file "music-drawing-routines.ps") 'pre " %\n" 'post)
+       (ly-gulp-file "music-drawing-routines.ps"))
+   (if (defined? 'ps-testing) "/testing true def%\n" "")
+   "}"
+   "\\input lilyponddefs \\outputscale=\\lilypondpaperoutputscale pt\\turnOnPostScript"))
+
+;; Note: this string must match the string in ly2dvi.py!!!
+(define (header creator generate) 
+  (string-append
+   "% Generated automatically by: " creator generate "\n"))
+
+(define (invoke-char s i)
+  (string-append 
+   "\n\\" s "{" (inexact->string i 10) "}" ))
+
+(define (invoke-dim1 s d)
+  (string-append
+   "\n\\" s "{" (number->dim d) "}"))
+(define (pt->sp x)
+  (* 65536 x))
+
+;;
+;; need to do something to make this really safe.
+;;
+(define (output-tex-string s)
+  (if security-paranoia
+      (if use-regex
+	  (regexp-substitute/global #f "\\\\" s 'pre "$\\backslash$" 'post)
+	  (begin (display "warning: not paranoid") (newline) s))
+      s))
+
+(define (lily-def key val)
+  (let ((tex-key
+	 (if use-regex
+	     ;; fixed in 1.3.4 for powerpc -- broken on Windows
+	     (regexp-substitute/global
+	      #f "_" (output-tex-string key) 'pre "X" 'post)
+	     (output-tex-string key)))
+	(tex-val (output-tex-string val)))
+    (if (equal? (sans-surrounding-whitespace tex-val) "")
+	(string-append "\\let\\" tex-key "\\undefined\n")
+	(string-append "\\def\\" tex-key "{" tex-val "}\n"))))
+
+(define (number->dim x)
+  (string-append
+   ;;ugh ly-* in backend needs compatibility func for standalone output
+   (ly-number->string x) " \\outputscale "))
+
+(define (placebox x y s) 
+  (string-append 
+   "\\placebox{"
+   (number->dim y) "}{" (number->dim x) "}{" s "}%\n"))
+
+(define (bezier-sandwich l thick)
+  (embedded-ps (list 'bezier-sandwich  `(quote ,l) thick)))
+
+(define (start-line ht)
+  (string-append"\\vbox to " (number->dim ht) "{\\hbox{%\n"))
+
+(define (stop-line) 
+  "}\\vss}\\interscoreline\n")
+(define (stop-last-line)
+  "}\\vss}")
+
+(define (filledbox breapth width depth height)
+  (if (defined? 'ps-testing)
+      (embedded-ps
+       (string-append (numbers->string (list breapth width depth height))
+		      " draw_box" ))
+      (string-append 
+       "\\kern" (number->dim (- breapth))
+       "\\vrule width " (number->dim (+ breapth width))
+       "depth " (number->dim depth)
+       "height " (number->dim height) " ")))
+
+(define (text s)
+  (string-append "\\hbox{" (output-tex-string s) "}"))
+
+(define (tuplet ht gapx dx dy thick dir)
+  (embedded-ps (list 'tuplet  ht gapx dx dy thick dir)))
+
+(define (volta h w thick vert_start vert_end)
+  (embedded-ps (list 'volta  h w thick vert_start vert_end)))
+(define (between-system-string string)
+  string
   )
+(define (define-origin file line col)
+  (if (procedure? point-and-click)
+      (string-append "\\special{src\\string:"
+		     (point-and-click line col file)
+		     "}" )
+      "")
+  )
+
+					; no-origin not yet supported by Xdvi
+(define (no-origin) "")
 
-(define (scm-tex-output)
-  (primitive-eval (tex-scm 'all-definitions)))
+(define (tex-output-expression expr port)
+  (display (eval expr this-module) port )
+  )
-- 
2.39.5