Index: Backends/PostScript/class.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/Backends/PostScript/class.lisp,v
retrieving revision 1.6
diff -u -r1.6 class.lisp
--- Backends/PostScript/class.lisp	4 Jul 2002 06:57:43 -0000	1.6
+++ Backends/PostScript/class.lisp	31 Aug 2005 20:24:31 -0000
@@ -84,7 +84,9 @@
                    *default-postscript-title*))
         (for (or (getf header-comments :for)
                  *default-postscript-for*))
-        (region (paper-region device-type orientation))
+        (region (case device-type
+                  ((:eps) +everywhere+)
+                  (t (paper-region device-type orientation))))
         (transform (make-postscript-transformation device-type orientation)))
     (make-instance 'postscript-stream
                    :file-stream file-stream
Index: Backends/PostScript/graphics.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/Backends/PostScript/graphics.lisp,v
retrieving revision 1.13
diff -u -r1.13 graphics.lisp
--- Backends/PostScript/graphics.lisp	1 Aug 2005 16:50:43 -0000	1.13
+++ Backends/PostScript/graphics.lisp	31 Aug 2005 20:24:31 -0000
@@ -169,23 +169,25 @@
   "Native transformation")
 
 ;;; Postscript output utilities
-(defmacro with-graphics-state ((medium) &body body)
-  `(invoke-with-graphics-state ,medium
+(defmacro with-graphics-state ((stream) &body body)
+  `(invoke-with-graphics-state ,stream
     (lambda () ,@body)))
 
-(defun postscript-save-graphics-state (medium)
-  (push (copy-list (postscript-medium-graphics-state medium))
-        (slot-value (medium-sheet medium) 'graphics-state-stack))
-  (format (postscript-medium-file-stream medium) "gsave~%"))
-
-(defun postscript-restore-graphics-state (medium)
-  (pop (slot-value (medium-sheet medium) 'graphics-state-stack))
-  (format (postscript-medium-file-stream medium) "grestore~%"))
+(defun postscript-save-graphics-state (stream)
+  (push (copy-list (first (slot-value stream 'graphics-state-stack)))
+        (slot-value stream 'graphics-state-stack))
+  (when (stream-drawing-p stream)
+    (format (postscript-stream-file-stream stream) "gsave~%")))
+
+(defun postscript-restore-graphics-state (stream)
+  (pop (slot-value stream 'graphics-state-stack))
+  (when (stream-drawing-p stream)
+    (format (postscript-stream-file-stream stream) "grestore~%")))
 
-(defun invoke-with-graphics-state (medium continuation)
-  (postscript-save-graphics-state medium)
+(defun invoke-with-graphics-state (stream continuation)
+  (postscript-save-graphics-state stream)
   (funcall continuation)
-  (postscript-restore-graphics-state medium))
+  (postscript-restore-graphics-state stream))
 
 
 ;;; Postscript path functions
@@ -346,8 +348,8 @@
   ;; does only one level of saving graphics state, so we can restore
   ;; and save again GS to obtain an initial CP. It is ugly, but I see
   ;; no other way now. -- APD, 2002-02-11
-  (postscript-restore-graphics-state medium)
-  (postscript-save-graphics-state medium)
+  (postscript-restore-graphics-state (medium-sheet medium))
+  (postscript-save-graphics-state (medium-sheet medium))
   (postscript-set-clipping-region stream
                                   (medium-clipping-region medium)))
 
@@ -494,7 +496,7 @@
   (let ((*transformation* (sheet-native-transformation (medium-sheet medium))))
     (let ((file-stream (postscript-medium-file-stream medium)))
       (postscript-actualize-graphics-state file-stream medium :color :text-style)
-      (with-graphics-state (medium)
+      (with-graphics-state ((medium-sheet medium))
         #+ignore
         (when transform-glyphs
           ;;
Index: Backends/PostScript/paper.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/Backends/PostScript/paper.lisp,v
retrieving revision 1.2
diff -u -r1.2 paper.lisp
--- Backends/PostScript/paper.lisp	31 May 2002 02:32:10 -0000	1.2
+++ Backends/PostScript/paper.lisp	31 Aug 2005 20:24:31 -0000
@@ -55,6 +55,9 @@
     (make-rectangle* 0 0 width height)))
 
 (defun make-postscript-transformation (paper-size-name orientation)
+  (when (eq paper-size-name :eps)
+    (return-from make-postscript-transformation
+      (make-reflection-transformation* 0 0 1 0)))
   (multiple-value-bind (width height) (paper-size paper-size-name)
     (case orientation
         (:portrait (make-3-point-transformation*
@@ -63,4 +66,4 @@
         (:landscape (make-3-point-transformation*
                      0 0  0 width  height 0
                      width height  0 height  width 0))
-        (t (error "Unknown orientation")))))
\ No newline at end of file
+        (t (error "Unknown orientation")))))
Index: Backends/PostScript/sheet.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/Backends/PostScript/sheet.lisp,v
retrieving revision 1.9
diff -u -r1.9 sheet.lisp
--- Backends/PostScript/sheet.lisp	1 Apr 2004 04:26:46 -0000	1.9
+++ Backends/PostScript/sheet.lisp	31 Aug 2005 20:24:31 -0000
@@ -58,29 +58,43 @@
                                          orientation header-comments)))
     (unwind-protect
          (progn
+           (with-output-recording-options (stream :record t :draw nil)
+             (with-graphics-state (stream)
+               ;; we need at least one level of saving -- APD, 2002-02-11
+               (funcall continuation stream)))
            (with-slots (file-stream title for orientation paper) stream
-             (format file-stream "%!PS-Adobe-3.0~%")
+             (format file-stream "%!PS-Adobe-3.0~@[ EPSF-3.0~*~]~%"
+                     (eq device-type :eps))
              (format file-stream "%%Creator: McCLIM~%")
              (format file-stream "%%Title: ~A~%" title)
              (format file-stream "%%For: ~A~%" for)
              (format file-stream "%%LanguageLevel: 2~%")
-	     (multiple-value-bind (width height)
-		 (paper-size paper)
-	       (format file-stream "%%BoundingBox: 0 0 ~A ~A~%" width height)
-	       (format file-stream "%%DocumentMedia: ~A ~A ~A 0 () ()~%"
-		       paper width height))
-             (format file-stream "%%Orientation: ~A~%"
-                     (ecase orientation
-                       (:portrait "Portrait")
-                       (:landscape "Landscape")))
-             (format file-stream "%%Pages: (atend)~%")
+             (case paper
+               ((:eps)
+                (let ((record (stream-output-history stream)))
+                  (multiple-value-bind (lx ly ux uy) (bounding-rectangle* record)
+                    (format file-stream "%%BoundingBox: ~A ~A ~A ~A~%" 
+                            (floor lx) (floor (- uy))
+                            (ceiling ux) (ceiling (- ly))))))
+               (t
+                (multiple-value-bind (width height)
+                    (paper-size paper)
+                  (format file-stream "%%BoundingBox: 0 0 ~A ~A~%" width height)
+                  (format file-stream "%%DocumentMedia: ~A ~A ~A 0 () ()~%"
+                          paper width height))
+                (format file-stream "%%Orientation: ~A~%"
+                        (ecase orientation
+                          (:portrait "Portrait")
+                          (:landscape "Landscape")))
+                (format file-stream "%%Pages: (atend)~%")))
              (format file-stream "%%DocumentNeededResources: (atend)~%")
              (format file-stream "%%EndComments~%~%")
              (write-postcript-dictionary file-stream)
-             (start-page stream))
-           (with-graphics-state ((sheet-medium stream))
-             ;; we need at least one level of saving -- APD, 2002-02-11
-             (funcall continuation stream)))
+             (start-page stream)
+             (let ((record (stream-output-history stream)))
+               (with-output-recording-options (stream :draw t :record nil)
+                 (with-graphics-state (stream)
+                   (replay record stream))))))
       (with-slots (file-stream current-page) stream
         (format file-stream "end~%showpage~%~%")
         (format file-stream "%%Trailer~%")
