From f04d1ee3ab15d062b892b1d7871be36efc93a7c3 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 3 Jun 2003 17:41:04 +0000 Subject: [PATCH] . original commit: e35ea5a24a9dc6cf1ae2402b6b36b68f88c32d2c --- collects/tests/mred/draw.ss | 24 +++++++++++++----------- 1 file changed, 13 insertions(+), 11 deletions(-) diff --git a/collects/tests/mred/draw.ss b/collects/tests/mred/draw.ss index dbd48141..019dd355 100644 --- a/collects/tests/mred/draw.ss +++ b/collects/tests/mred/draw.ss @@ -529,7 +529,7 @@ (send the-color-database find-color "BLACK") mred-icon)] [(mred~) - (send dc draw-bitmap (get-rotated) x y)] + (send dc draw-bitmap (get-rotated) x y 'opaque)] [(mred^mred~ opaque-mred^mred~ red-mred^mred~) (send dc draw-bitmap mred-icon x y (if (eq? mask-ex-mode 'opaque-mred^mred~) @@ -840,16 +840,18 @@ (lambda (b e) (unless use-bitmap? (error 'save-file "only available for pixmap/bitmap mode")) - (let ([f (get-file)]) - (let ([format - (cond - [(regexp-match "[.]xbm$" f) 'xbm] - [(regexp-match "[.]xpm$" f) 'xpm] - [(regexp-match "[.]jpg$" f) 'jpeg] - [else (error 'save-file "unknown suffix: ~e" f)])]) - (set! save-filename f) - (set! save-file-format format) - (send canvas on-paint))))) + (let ([f (put-file)]) + (when f + (let ([format + (cond + [(regexp-match "[.]xbm$" f) 'xbm] + [(regexp-match "[.]xpm$" f) 'xpm] + [(regexp-match "[.]jpe?g$" f) 'jpeg] + [(regexp-match "[.]png$" f) 'png] + [else (error 'save-file "unknown suffix: ~e" f)])]) + (set! save-filename f) + (set! save-file-format format) + (send canvas on-paint)))))) (make-object button% "PS" hp (lambda (self event) (send canvas on-paint #t)))