From c059161e3e07a30698c59b1116410ea228d0c44d Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Mon, 3 Dec 2001 18:23:14 +0000
Subject: [PATCH] ...

original commit: 33f6246a478286842ddcc056ae3f6d1d3d9cc0f4
---
 collects/framework/private/editor.ss | 23 +++++++++++++++++++----
 collects/framework/private/frame.ss  | 11 +++++------
 2 files changed, 24 insertions(+), 10 deletions(-)

diff --git a/collects/framework/private/editor.ss b/collects/framework/private/editor.ss
index 3877665a..ee3e3c20 100644
--- a/collects/framework/private/editor.ss
+++ b/collects/framework/private/editor.ss
@@ -37,12 +37,27 @@
 	  run-after-edit-sequence
 	  get-top-level-window
 	  on-close
-	  save-file-out-of-date?))
+	  save-file-out-of-date?
+          save-file/gui-error))
 
       (define basic-mixin
 	(mixin (editor<%>) (basic<%>)
-	  (inherit get-filename save-file
-		   refresh-delayed? 
+
+          (inherit get-filename save-file)
+          (define/public save-file/gui-error
+            (opt-lambda ([filename #f]
+                         [fmt 'same]
+                         [show-errors? #t])
+              (let ([result (save-file filename fmt #f)])
+                (unless result
+                  (when show-errors?
+                    (message-box
+                     (string-constant error-saving)
+                     (format (string-constant error-saving-file/name)
+                             (get-filename)))))
+                result)))
+
+	  (inherit refresh-delayed? 
 		   get-canvas
 		   get-max-width get-admin)
           
@@ -406,7 +421,7 @@
                 (let* ([orig-name (get-filename)]
                        [old-auto-name auto-saved-name]
                        [auto-name (path-utils:generate-autosave-name orig-name)]
-                       [success (save-file auto-name 'copy)])
+                       [success (save-file auto-name 'copy #f)])
                   (if success
                       (begin
                         (when old-auto-name
diff --git a/collects/framework/private/frame.ss b/collects/framework/private/frame.ss
index 42b48ebe..def4fba6 100644
--- a/collects/framework/private/frame.ss
+++ b/collects/framework/private/frame.ss
@@ -702,7 +702,7 @@
                      [file (parameterize ([finder:dialog-parent-parameter this])
                              (finder:put-file name))])
                 (when file
-                  (send (get-editor) save-file file format)))))
+                  (send (get-editor) save-file/gui-error file format)))))
           (inherit get-checkable-menu-item% get-menu-item%)
           (override file-menu:save-callback
                     file-menu:create-save? file-menu:save-as-callback file-menu:create-save-as? 
@@ -749,7 +749,7 @@
               #t))
           (define/override file-menu:create-revert? (lambda () #t))
           (define file-menu:save-callback (lambda (item control)
-                                            (send (get-editor) save-file)
+                                            (send (get-editor) save-file/gui-error)
                                             #t))
           
           (define file-menu:create-save? (lambda () #t))
@@ -1321,7 +1321,6 @@
                              (values embedded embedded-pos)))]
                       [else (next-loop)])))))])))
       
-      
       (define searching-frame #f)
       (define (set-searching-frame frame)
         (set! searching-frame frame))
@@ -1487,8 +1486,8 @@
                      [root (make-object % s-root)])
                 (set! super-root s-root)
                 root)))
-          (override on-activate)
-          (define on-activate
+
+          (define/override on-activate
             (lambda (on?)
               (unless hidden?
                 (if on?
@@ -1766,7 +1765,7 @@
                                  #t
                                  this)
                             [(continue) #t]
-                            [(save) (send edit save-file)]
+                            [(save) (send edit save-file/gui-error)]
                             [else #f]))])
                 (and user-allowed-or-not-modified
                      (super-can-close?))))]