diff --git a/collects/mred/mred.ss b/collects/mred/mred.ss
index 4d5d74e58f..1adbd086b5 100644
--- a/collects/mred/mred.ss
+++ b/collects/mred/mred.ss
@@ -35,7 +35,9 @@
    afm-draw-text
    afm-get-text-extent
    afm-expand-name
-   afm-glyph-exists?)
+   afm-glyph-exists?
+   afm-record-font
+   afm-fonts-string)
   
   ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
diff --git a/collects/mred/private/afm.ss b/collects/mred/private/afm.ss
index 47a1eaaba8..2028981a3d 100644
--- a/collects/mred/private/afm.ss
+++ b/collects/mred/private/afm.ss
@@ -5,7 +5,9 @@
   (provide (protect afm-draw-text
 		    afm-get-text-extent
 		    afm-expand-name
-		    afm-glyph-exists?)
+		    afm-glyph-exists?
+                    afm-record-font
+                    afm-fonts-string)
 	   current-ps-afm-file-paths
 	   current-ps-cmap-file-paths)
 
@@ -498,16 +500,19 @@
 	      (* scale (font-internal-leading font)))))
 
   ;; pen is positioned at text top-left:
-  (define (afm-draw-text font-name size string out kern? sym-map?)
+  (define (afm-draw-text font-name size string out kern? sym-map? used-fonts)
     (let* ([l (map-symbols sym-map? (string->list string))]
+           [used-fonts (or used-fonts (make-hash-table 'equal))]
 	   [font (or (get-font font-name)
 		     (make-font 0 0 0 0 #hash() #f #f))]
 	   [show-simples (lambda (simples special-font-name special-font)
 			   (unless (null? simples)
 			     (when special-font
-			       (fprintf out "currentfont~n/~a findfont~n~a scalefont setfont~n"
-					(afm-expand-name special-font-name)
-					size))
+                               (let ([name (afm-expand-name special-font-name)])
+                                 (hash-table-put! used-fonts name #t)
+                                 (fprintf out "currentfont~n/~a findfont~n~a scalefont setfont~n"
+                                          name
+                                          size)))
 			     (if (font-is-cid? (or special-font font))
 				 (fprintf out "<~a> show\n"
 					  (apply
@@ -626,7 +631,8 @@
 	     (show-simples simples special-font-name special-font)
 	     ;; Future work: a box. For now, we just skip some space.
 	     (fprintf out "~a 0 rmoveto\n" (/ size 2))
-	     (loop (cdr l) null #f #f)))]))))
+	     (loop (cdr l) null #f #f)))])))
+    used-fonts)
 
   ;; ----------------------------------------
   ;; Name expansion
@@ -638,6 +644,31 @@
 	  (string-append font-name "-" (bytes->string/latin-1 (font-char-set-name f)))
 	  font-name)))
 
+
+  (define (afm-record-font name used-fonts)
+    (let ([used-fonts (or used-fonts (make-hash-table 'equal))])
+      (hash-table-put! used-fonts name #t)
+      used-fonts))
+
+  (define (afm-fonts-string used-fonts)
+    (if (hash-table? used-fonts)
+        (let ([s (open-output-string)]
+              [pos 0])
+          (hash-table-for-each
+           used-fonts
+           (lambda (k v)
+             (let ([len (string-length k)])
+               (when ((+ len pos) . > . 50)
+                 (fprintf s "\n%%+ ")
+                 (set! pos 0))
+               (unless (zero? pos)
+                 (display " " s)
+                 (set! pos (add1 pos)))
+               (display k s)
+               (set! pos (+ pos len)))))
+          (get-output-string s))
+        ""))
+
   ;; ----------------------------------------
   ;; Font substitution
 
diff --git a/src/mred/mred.cxx b/src/mred/mred.cxx
index b3195bbf9b..c8a4781dd5 100644
--- a/src/mred/mred.cxx
+++ b/src/mred/mred.cxx
@@ -2474,8 +2474,8 @@ static void MrEdSchemeMessages(char *msg, ...)
 {
   GC_CAN_IGNORE va_list args;
 #if WINDOW_STDIO
-  char *arg_s;
-  long arg_d, arg_l;
+  char *arg_s = NULL;
+  long arg_d = 0, arg_l = 0;
 # define VSP_BUFFER_SIZE 4096
   char arg_buffer[VSP_BUFFER_SIZE];
 #endif
diff --git a/src/mred/wxs/wxscheme.cxx b/src/mred/wxs/wxscheme.cxx
index d3d8d37ed0..125f23054f 100644
--- a/src/mred/wxs/wxscheme.cxx
+++ b/src/mred/wxs/wxscheme.cxx
@@ -1333,6 +1333,7 @@ static Scheme_Object *wxSchemeGetFontList(int argc, Scheme_Object **argv)
 /***********************************************************************/
 
 static Scheme_Object *ps_draw_text, *ps_get_text_extent, *ps_expand_name, *ps_glyph_exists;
+static Scheme_Object *ps_record_font, *ps_fonts_string;
 
 static Scheme_Object *SetPSProcs(int, Scheme_Object *a[])
 {
@@ -1344,15 +1345,17 @@ static Scheme_Object *SetPSProcs(int, Scheme_Object *a[])
   ps_get_text_extent = a[1];
   ps_expand_name = a[2];
   ps_glyph_exists = a[3];
+  ps_record_font = a[4];
+  ps_fonts_string = a[5];
   return scheme_void;
 }
 
-void wxPostScriptDrawText(Scheme_Object *f, const char *fontname,
-			  const char *text, int dt, Bool combine, int use16, 
-			  double font_size, int sym_map)
+void *wxPostScriptDrawText(Scheme_Object *f, const char *fontname,
+                           const char *text, int dt, Bool combine, int use16, 
+                           double font_size, int sym_map, void *used_fonts)
 {
   if (ps_draw_text) {
-    Scheme_Object *a[6], *v;
+    Scheme_Object *a[7], *v;
 
     v = scheme_make_utf8_string(fontname);
     a[0] = v;
@@ -1365,8 +1368,9 @@ void wxPostScriptDrawText(Scheme_Object *f, const char *fontname,
     a[3] = f;
     a[4] = (combine ? scheme_true : scheme_false);
     a[5] = (sym_map ? scheme_true : scheme_false);
+    a[6] = (used_fonts ? (Scheme_Object *)used_fonts : scheme_false);
 
-    scheme_apply(ps_draw_text, 6, a);
+    return scheme_apply(ps_draw_text, 7, a);
   }
 }
 
@@ -1442,6 +1446,32 @@ Bool wxPostScriptGlyphExists(const char *fontname, int c, int sym_map)
   return TRUE;
 }
 
+extern void *wxPostScriptRecordFont(const char *fontname, void *used_fonts)
+{
+  if (ps_record_font) {
+    Scheme_Object *a[2], *v;
+    v = scheme_make_sized_offset_utf8_string((char *)fontname, 0, -1);
+    a[0] = v;
+    a[1] = (used_fonts ? (Scheme_Object *)used_fonts : scheme_false);
+    return scheme_apply(ps_record_font, 2, a);
+  }
+  return scheme_null;
+}
+
+extern char *wxPostScriptFontsToString(void *used_fonts)
+{
+  if (ps_fonts_string && used_fonts) {
+    Scheme_Object *a[1], *s;
+    a[0] = (Scheme_Object *)used_fonts;
+    s = scheme_apply(ps_fonts_string, 1, a);
+    if (SCHEME_CHAR_STRINGP(s)) {
+      s = scheme_char_string_to_byte_string(s);
+      return SCHEME_BYTE_STR_VAL(s);
+    }
+  }
+  return "";
+}
+
 /***********************************************************************/
 /*                           panel color                               */
 /***********************************************************************/
@@ -3269,7 +3299,7 @@ static void wxScheme_Install(Scheme_Env *global_env)
   scheme_install_xc_global("set-ps-procs",
 			   scheme_make_prim_w_arity(CAST_SP SetPSProcs,
 						    "set-ps-procs",
-						    4, 4),
+						    6, 6),
 			   global_env);
 
 
diff --git a/src/mzscheme/include/mzscheme.exp b/src/mzscheme/include/mzscheme.exp
index ac4619a0f9..83143a1f62 100644
--- a/src/mzscheme/include/mzscheme.exp
+++ b/src/mzscheme/include/mzscheme.exp
@@ -397,6 +397,7 @@ scheme_write_evt_via_write
 scheme_write_special_evt_via_write_special
 scheme_open_input_file
 scheme_open_output_file
+scheme_open_input_output_file
 scheme_open_output_file_with_mode
 scheme_make_file_input_port
 scheme_make_named_file_input_port
diff --git a/src/mzscheme/include/mzscheme3m.exp b/src/mzscheme/include/mzscheme3m.exp
index 4356c177b7..d1a36df235 100644
--- a/src/mzscheme/include/mzscheme3m.exp
+++ b/src/mzscheme/include/mzscheme3m.exp
@@ -407,6 +407,7 @@ scheme_write_evt_via_write
 scheme_write_special_evt_via_write_special
 scheme_open_input_file
 scheme_open_output_file
+scheme_open_input_output_file
 scheme_open_output_file_with_mode
 scheme_make_file_input_port
 scheme_make_named_file_input_port
diff --git a/src/mzscheme/include/mzwin.def b/src/mzscheme/include/mzwin.def
index 38e4997f66..36296225bc 100644
--- a/src/mzscheme/include/mzwin.def
+++ b/src/mzscheme/include/mzwin.def
@@ -385,6 +385,7 @@ EXPORTS
  scheme_write_special_evt_via_write_special
  scheme_open_input_file
  scheme_open_output_file
+ scheme_open_input_output_file
  scheme_open_output_file_with_mode
  scheme_make_file_input_port
  scheme_make_named_file_input_port
diff --git a/src/mzscheme/include/mzwin3m.def b/src/mzscheme/include/mzwin3m.def
index d0c45119dd..e54eb7f36a 100644
--- a/src/mzscheme/include/mzwin3m.def
+++ b/src/mzscheme/include/mzwin3m.def
@@ -399,6 +399,7 @@ EXPORTS
  scheme_write_special_evt_via_write_special
  scheme_open_input_file
  scheme_open_output_file
+ scheme_open_input_output_file
  scheme_open_output_file_with_mode
  scheme_make_file_input_port
  scheme_make_named_file_input_port
diff --git a/src/mzscheme/src/port.c b/src/mzscheme/src/port.c
index 113318a571..4a15be91c9 100644
--- a/src/mzscheme/src/port.c
+++ b/src/mzscheme/src/port.c
@@ -4022,6 +4022,17 @@ Scheme_Object *scheme_open_output_file(const char *name, const char *who)
   return scheme_do_open_output_file((char *)who, 0, 2, a, 0);
 }
 
+Scheme_Object *scheme_open_input_output_file(const char *name, const char *who, Scheme_Object **oport)
+{
+  Scheme_Object *a[2];
+
+  a[0]= scheme_make_path(name);
+  a[1] = truncate_replace_symbol;
+  scheme_do_open_output_file((char *)who, 0, 2, a, 1);
+  *oport = scheme_multiple_array[1];
+  return scheme_multiple_array[0];
+}
+
 Scheme_Object *scheme_open_output_file_with_mode(const char *name, const char *who, int text)
 {
   Scheme_Object *a[3];
diff --git a/src/mzscheme/src/schemef.h b/src/mzscheme/src/schemef.h
index 9c205eac42..0ff22b1279 100644
--- a/src/mzscheme/src/schemef.h
+++ b/src/mzscheme/src/schemef.h
@@ -791,6 +791,7 @@ MZ_EXTERN Scheme_Object *scheme_write_special_evt_via_write_special(Scheme_Outpu
 
 MZ_EXTERN Scheme_Object *scheme_open_input_file(const char *name, const char *who);
 MZ_EXTERN Scheme_Object *scheme_open_output_file(const char *name, const char *who);
+MZ_EXTERN Scheme_Object *scheme_open_input_output_file(const char *name, const char *who, Scheme_Object **oport);
 MZ_EXTERN Scheme_Object *scheme_open_output_file_with_mode(const char *name, const char *who, int text);
 
 MZ_EXTERN Scheme_Object *scheme_make_file_input_port(FILE *fp);
diff --git a/src/mzscheme/src/schemex.h b/src/mzscheme/src/schemex.h
index a0a3def468..52f2c4cc8f 100644
--- a/src/mzscheme/src/schemex.h
+++ b/src/mzscheme/src/schemex.h
@@ -667,6 +667,7 @@ Scheme_Object *(*scheme_write_special_evt_via_write_special)(Scheme_Output_Port
 								    Scheme_Object *special);
 Scheme_Object *(*scheme_open_input_file)(const char *name, const char *who);
 Scheme_Object *(*scheme_open_output_file)(const char *name, const char *who);
+Scheme_Object *(*scheme_open_input_output_file)(const char *name, const char *who, Scheme_Object **oport);
 Scheme_Object *(*scheme_open_output_file_with_mode)(const char *name, const char *who, int text);
 Scheme_Object *(*scheme_make_file_input_port)(FILE *fp);
 Scheme_Object *(*scheme_make_named_file_input_port)(FILE *fp, Scheme_Object *name);
diff --git a/src/mzscheme/src/schemex.inc b/src/mzscheme/src/schemex.inc
index 042421041b..23bcb5a049 100644
--- a/src/mzscheme/src/schemex.inc
+++ b/src/mzscheme/src/schemex.inc
@@ -445,6 +445,7 @@
   scheme_extension_table->scheme_write_special_evt_via_write_special = scheme_write_special_evt_via_write_special;
   scheme_extension_table->scheme_open_input_file = scheme_open_input_file;
   scheme_extension_table->scheme_open_output_file = scheme_open_output_file;
+  scheme_extension_table->scheme_open_input_output_file = scheme_open_input_output_file;
   scheme_extension_table->scheme_open_output_file_with_mode = scheme_open_output_file_with_mode;
   scheme_extension_table->scheme_make_file_input_port = scheme_make_file_input_port;
   scheme_extension_table->scheme_make_named_file_input_port = scheme_make_named_file_input_port;
diff --git a/src/mzscheme/src/schemexm.h b/src/mzscheme/src/schemexm.h
index 24be57000d..bb9b36d826 100644
--- a/src/mzscheme/src/schemexm.h
+++ b/src/mzscheme/src/schemexm.h
@@ -445,6 +445,7 @@
 #define scheme_write_special_evt_via_write_special (scheme_extension_table->scheme_write_special_evt_via_write_special)
 #define scheme_open_input_file (scheme_extension_table->scheme_open_input_file)
 #define scheme_open_output_file (scheme_extension_table->scheme_open_output_file)
+#define scheme_open_input_output_file (scheme_extension_table->scheme_open_input_output_file)
 #define scheme_open_output_file_with_mode (scheme_extension_table->scheme_open_output_file_with_mode)
 #define scheme_make_file_input_port (scheme_extension_table->scheme_make_file_input_port)
 #define scheme_make_named_file_input_port (scheme_extension_table->scheme_make_named_file_input_port)
diff --git a/src/mzscheme/src/syntax.c b/src/mzscheme/src/syntax.c
index 7b1906fb30..05d05e0db7 100644
--- a/src/mzscheme/src/syntax.c
+++ b/src/mzscheme/src/syntax.c
@@ -5431,8 +5431,6 @@ define_for_syntaxes_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Exp
 
 Scheme_Object *scheme_make_environment_dummy(Scheme_Comp_Env *env)
 { 
-  Scheme_Object *dummy;
- 
   /* Get a prefixed-based accessor for a dummy top-level bucket. It's
      used to "link" to the right environment at run time. The `begin'
      symbol is arbitrary; the top-level/prefix support handles a symbol
diff --git a/src/mzscheme/src/thread.c b/src/mzscheme/src/thread.c
index 6af0ce9461..3dd4ead17d 100644
--- a/src/mzscheme/src/thread.c
+++ b/src/mzscheme/src/thread.c
@@ -6685,7 +6685,7 @@ Scheme_Object *scheme_make_namespace(int argc, Scheme_Object *argv[])
     env = env->exp_env;
   }
 
-  return env;
+  return (Scheme_Object *)env;
 }
 
 static Scheme_Object *namespace_p(int argc, Scheme_Object **argv)
diff --git a/src/wxcommon/PSDC.cxx b/src/wxcommon/PSDC.cxx
index e7aad3c764..b947edcb40 100644
--- a/src/wxcommon/PSDC.cxx
+++ b/src/wxcommon/PSDC.cxx
@@ -67,9 +67,9 @@
 #include "wx_rgn.h"
 #include "../mzscheme/include/scheme.h"
 
-extern void wxPostScriptDrawText(Scheme_Object *f, const char *fontname, 
-				 const char *text, int dt, Bool combine, int use16, 
-				 double font_size, int symbol_map);
+extern void *wxPostScriptDrawText(Scheme_Object *f, const char *fontname, 
+                                  const char *text, int dt, Bool combine, int use16, 
+                                  double font_size, int symbol_map, void *used_fonts);
 extern void wxPostScriptGetTextExtent(const char *fontname, 
 				      const char *text, int dt, int len, Bool combine, int use16, 
 				      double font_size,
@@ -77,6 +77,8 @@ extern void wxPostScriptGetTextExtent(const char *fontname,
 				      int symbol_map);
 extern char *wxPostScriptFixupFontName(const char *fontname);
 extern Bool wxPostScriptGlyphExists(const char *fontname, int c, int symbol_map);
+extern void *wxPostScriptRecordFont(const char *fontname, void *used_fonts);
+extern char *wxPostScriptFontsToString(void *used_fonts);
 
 # define YSCALE(y) ((paper_h) - ((y) * user_scale_y + device_origin_y))
 # define XSCALE(x) ((x) * user_scale_x + device_origin_x)
@@ -137,12 +139,21 @@ wxPrintPaperDatabase *wxThePrintPaperDatabase;
 /**************************************************/
 
 wxPSStream::wxPSStream(char *file) {
-  f = scheme_open_output_file(file, "post-script-dc%");
+  Scheme_Object *o;
+  f_in = scheme_open_input_output_file(file, "post-script-dc%", &o);
+  f = o;
   int_width = 0;
 }
  
 wxPSStream::~wxPSStream(void) {
-  if (f) scheme_close_output_port((Scheme_Object *)f);
+  if (f_in) {
+    scheme_close_input_port((Scheme_Object *)f_in);
+    f_in = NULL;
+  }
+  if (f) {
+    scheme_close_output_port((Scheme_Object *)f);
+    f = NULL;
+  }
 }
 
 int wxPSStream::good(void) {
@@ -202,6 +213,14 @@ void wxPSStream::width(int w) {
   int_width = w;
 }
 
+long wxPSStream::read_at(long pos, char *buf, long amt) {
+  scheme_set_file_position((Scheme_Object *)f_in, pos);
+  return scheme_get_byte_string("post-script%", (Scheme_Object *)f_in,
+                                buf, 0, amt,
+                                0, 0, NULL);
+}
+
+
 /**************************************************/
 
 
@@ -1362,8 +1381,11 @@ void wxPostScriptDC::DrawText(DRAW_TEXT_CONST char *text, double x, double y,
     if (!current_font_name
 	|| (next_font_size != current_font_size)
 	|| strcmp(next_font_name, current_font_name)) {
-      pstream->Out("/"); pstream->Out(wxPostScriptFixupFontName(next_font_name)); pstream->Out(" findfont\n");
+      char *fn;
+      pstream->Out("/"); fn = wxPostScriptFixupFontName(next_font_name); pstream->Out(fn); pstream->Out(" findfont\n");
       pstream->Out(next_font_size); pstream->Out(" scalefont setfont\n");
+      
+      used_fonts = wxPostScriptRecordFont(fn, used_fonts);
 
       current_font_size = next_font_size;
       current_font_name = next_font_name;
@@ -1409,8 +1431,8 @@ void wxPostScriptDC::DrawText(DRAW_TEXT_CONST char *text, double x, double y,
   }
 
   sym_map = current_font->GetFamily() == wxSYMBOL;
-  wxPostScriptDrawText((Scheme_Object *)pstream->f, name, text, dt, combine, use16, current_font_size,
-		       sym_map);
+  used_fonts = wxPostScriptDrawText((Scheme_Object *)pstream->f, name, text, dt, combine, use16, current_font_size,
+                                    sym_map, used_fonts);
 
   if ((angle != 0.0) || (user_scale_x != 1) || (user_scale_y != 1)) {
     pstream->Out("grestore\n"); 
@@ -1542,11 +1564,22 @@ Bool wxPostScriptDC::StartDoc (char *message)
   }
 
   boundingboxpos = pstream->tellp();
-
   pstream->Out("%%BoundingBox: -00000 -00000 -00000 -00000\n");
   pstream->Out("%%Pages: -00000\n");
+
   if (landscape)
     pstream->Out("%%Orientation: Landscape\n");
+
+  {
+    int i;
+    pstream->Out("%%DocumentFonts: ");  
+    fontlistpos = pstream->tellp();
+    for (i = 0; i < 5; i++) {
+      pstream->Out("          ");  
+    }
+    pstream->Out("\n");  
+  }
+
   pstream->Out("%%EndComments\n\n");
 
   pstream->Out(wxPostScriptHeaderEllipse);
@@ -1570,6 +1603,7 @@ void wxPostScriptDC::EndDoc (void)
 {
   double llx, lly, urx, ury;
   double minx, miny, maxx, maxy;
+  long last_pos;
 
   if (!pstream)
     return;
@@ -1611,6 +1645,8 @@ void wxPostScriptDC::EndDoc (void)
   if (ury <= lly)
     ury = lly + 1;
 
+  last_pos = pstream->tellp();
+
   // The Adobe specifications call for integers; we round as to make
   // the bounding larger.
   pstream->seekp(boundingboxpos);
@@ -1627,6 +1663,33 @@ void wxPostScriptDC::EndDoc (void)
   pstream->width(5);
   pstream->Out((page_number - 1)); pstream->Out("\n");
 
+  {
+    char *fnts;
+    long len;
+    fnts = wxPostScriptFontsToString(used_fonts);
+    pstream->seekp(fontlistpos);
+    len = strlen(fnts);
+    if (len <= 50) {
+      pstream->Out(fnts);
+    } else {
+      long a, bot, delta = len - 50;
+      char *buf;
+      buf = new WXGC_ATOMIC char[4096];
+      for (a = last_pos; a > fontlistpos; ) {
+        bot = a - 4095;
+        if (bot < fontlistpos)
+          bot = fontlistpos;
+        pstream->read_at(bot, buf, a - bot);
+        buf[a - bot] = 0;
+        pstream->seekp(bot + delta);
+        pstream->Out(buf);
+        a = bot;
+      }
+      pstream->seekp(fontlistpos);
+      pstream->Out(fnts);
+    }
+  }
+
   DELETE_OBJ pstream;
   pstream = NULL;
 
diff --git a/src/wxcommon/PSDC.h b/src/wxcommon/PSDC.h
index 59e1872bd8..470004d081 100644
--- a/src/wxcommon/PSDC.h
+++ b/src/wxcommon/PSDC.h
@@ -59,7 +59,7 @@ class wxPostScriptDC: public wxDC
   int page_number;
   wxPSStream *pstream;    // PostScript output stream
   char *filename;
-  long boundingboxpos;
+  long boundingboxpos, fontlistpos;
   unsigned char currentRed;
   unsigned char currentGreen;
   unsigned char currentBlue;
@@ -78,6 +78,8 @@ class wxPostScriptDC: public wxDC
   int mode, use_paper_bbox, as_eps;
   char *preview_cmd, *print_cmd, *print_opts;
 
+  void *used_fonts;
+
   // Create a printer DC
   wxPostScriptDC(Bool interactive = TRUE, wxWindow *parent = NULL, Bool usePaperBBox = FALSE, Bool asEPS = TRUE);
 
diff --git a/src/wxcommon/Region.h b/src/wxcommon/Region.h
index 66bbf4b1f1..2a1a3eee62 100644
--- a/src/wxcommon/Region.h
+++ b/src/wxcommon/Region.h
@@ -11,7 +11,7 @@
 
 class wxPSStream : public wxObject {
  public:
-  void *f;
+  void *f, *f_in;
   int int_width;
   wxPSStream(char *file);
   ~wxPSStream(void);
@@ -27,6 +27,8 @@ class wxPSStream : public wxObject {
   void seekp(long pos);
 
   void width(int w);
+
+  long read_at(long pos, char *buf, long amt);
 };
 
 class wxPostScriptDC;