diff --git a/collects/framework/framework.ss b/collects/framework/framework.ss index d5980f17..70cc6b55 100644 --- a/collects/framework/framework.ss +++ b/collects/framework/framework.ss @@ -629,11 +629,13 @@ (frame:reorder-menus ((is-a?/c frame%) . -> . void?) (frame) - "Re-orders the menus in a frame. This is useful in conjunction with the " - "@link frame:standard-menus " - "class. After instantiating that class and adding menus, the menus will" - "be mis-ordered. This will put the File and Edit menus at the front of" - "the menubar and the Help menu at the end.") + "Re-orders the menus in a frame. It moves the ``File'' and ``Edit'' menus to" + "the front of the menubar and moves the ``Windows'' and ``Help'' menus" + "to the end of the menubar." + "" + "This is useful in conjunction with the " + "frame classes. After instantiating the class and adding ones own menus," + "the menus will be mis-ordered. This function fixes them up.") (group:get-the-frame-group (-> (is-a?/c group:%)) () diff --git a/collects/framework/private/editor.ss b/collects/framework/private/editor.ss index d612755d..4ee7c8c7 100644 --- a/collects/framework/private/editor.ss +++ b/collects/framework/private/editor.ss @@ -128,7 +128,7 @@ (string-constant cancel) (string-constant warning) #f - (get-top-level-focus-window)) + (get-top-level-window)) #t) #t) (super-can-save-file? filename format)))] @@ -521,14 +521,21 @@ (inherit get-top-level-window run-after-edit-sequence) (rename [super-lock lock]) (override lock) + (define callback-running? #f) [define lock (lambda (x) (super-lock x) (run-after-edit-sequence (rec send-frame-update-lock-icon (lambda () - (let ([frame (get-top-level-window)]) - (when (is-a? frame frame:info<%>) - (send frame lock-status-changed))))) + (unless callback-running? + (set! callback-running? #t) + (queue-callback + (lambda () + (let ([frame (get-top-level-window)]) + (when (is-a? frame frame:info<%>) + (send frame lock-status-changed))) + (set! callback-running? #f)) + #f)))) 'framework:update-lock-icon))] (super-instantiate ())))))) diff --git a/collects/framework/private/frame.ss b/collects/framework/private/frame.ss index fc0180ea..0aeb48fd 100644 --- a/collects/framework/private/frame.ss +++ b/collects/framework/private/frame.ss @@ -721,6 +721,7 @@ get-editor<%> make-editor + revert save save-as get-canvas @@ -834,29 +835,38 @@ (if (or (not filename) (unbox b)) (bell) - (let ([start - (if (is-a? edit text%) - (send edit get-start-position) - #f)]) - (when (gui-utils:get-choice - (string-constant are-you-sure-revert) - (string-constant yes) - (string-constant no) - (string-constant are-you-sure-revert-title) - #f - this) - (send edit begin-edit-sequence) - (let ([status (send edit load-file/gui-error - filename - 'same - #f)]) - (if status - (begin - (when (is-a? edit text%) - (send edit set-position start start)) - (send edit end-edit-sequence)) - (send edit end-edit-sequence))))))) + (when (gui-utils:get-choice + (string-constant are-you-sure-revert) + (string-constant yes) + (string-constant no) + (string-constant are-you-sure-revert-title) + #f + this) + (revert)))) #t)) + + (define/public (revert) + (let* ([edit (get-editor)] + [b (box #f)] + [filename (send edit get-filename b)]) + (when (and filename + (not (unbox b))) + (let ([start + (if (is-a? edit text%) + (send edit get-start-position) + #f)]) + (send edit begin-edit-sequence) + (let ([status (send edit load-file/gui-error + filename + 'same + #f)]) + (if status + (begin + (when (is-a? edit text%) + (send edit set-position start start)) + (send edit end-edit-sequence)) + (send edit end-edit-sequence))))))) + (define/override file-menu:create-revert? (lambda () #t)) (define file-menu:save-callback (lambda (item control) (save) diff --git a/collects/framework/private/main.ss b/collects/framework/private/main.ss index 16d9e38e..73324d59 100644 --- a/collects/framework/private/main.ss +++ b/collects/framework/private/main.ss @@ -88,9 +88,10 @@ (hash-table-put! hash-table x 'lambda)) '( cases - instantiate super-instantiate - lambda let let* letrec recur - match-lambda match-lambda* + instantiate super-instantiate + syntax/loc + lambda let let* letrec recur + match-lambda match-lambda* letrec-values with-syntax with-continuation-mark diff --git a/collects/framework/private/text.ss b/collects/framework/private/text.ss index 04e31ba2..4c126c87 100644 --- a/collects/framework/private/text.ss +++ b/collects/framework/private/text.ss @@ -11,7 +11,7 @@ (lib "list.ss") (lib "etc.ss")) (provide text@) - + (define text@ (unit/sig framework:text^ (import mred^ @@ -386,8 +386,8 @@ (define small-version-of-snip% (class snip% (init-field big-snip) - (field (width 0) - (height 0)) + (define width 0) + (define height 0) (define/override (get-extent dc x y wb hb db sb lb rb) (set/f! db 0) (set/f! sb 0) @@ -438,7 +438,7 @@ (set/f! lb 0) (set/f! rb 0)) - (field (cache-function #f)) + (define cache-function #f) (rename [super-insert insert]) (define/override (insert s len pos) @@ -529,7 +529,7 @@ (inherit split-snip find-snip get-snip-position find-first-snip get-style-list set-tabs) - (field (linked-snips #f)) + (define linked-snips #f) (define/private (copy snip) (let ([new-snip @@ -550,7 +550,7 @@ (send new-snip set-flags (send snip get-flags)) new-snip)) - (field (delegate #f)) + (define delegate #f) (inherit get-highlighted-ranges) (define/public (get-delegate) delegate) (define/public (set-delegate _d) @@ -672,8 +672,8 @@ (send delegate lock #f) (send delegate end-edit-sequence))) - (field (filename #f) - (format #f)) + (define filename #f) + (define format #f) (rename [super-on-load-file on-load-file] [super-after-load-file after-load-file]) (define/override (on-load-file _filename _format) @@ -738,17 +738,18 @@ ;; maybe-queue-editor-position-update : -> void ;; updates the editor-position in the frame, ;; but delays it until the next low-priority event occurs. - (field (callback-running? #f)) + (define callback-running? #f) (define/private (maybe-queue-editor-position-update) - (unless callback-running? - (set! callback-running? #t) - (queue-callback - (lambda () - (call-with-frame - (lambda (frame) - (send frame editor-position-changed))) - (set! callback-running? #f)) - #f))) + (enqueue-for-frame + (lambda (frame) + (unless callback-running? + (set! callback-running? #t) + (queue-callback + (lambda () + (send frame editor-position-changed) + (set! callback-running? #f)) + #f))) + 'framework:info-frame:update-editor-position)) (define (after-insert start len) (super-after-insert start len)