diff --git a/collects/framework/private/canvas.ss b/collects/framework/private/canvas.ss index 8ca5a3a9..cde23a5f 100644 --- a/collects/framework/private/canvas.ss +++ b/collects/framework/private/canvas.ss @@ -33,21 +33,18 @@ (define info-mixin (mixin (basic<%>) (info<%>) (inherit has-focus? get-top-level-window) - (override on-focus set-editor) - [define on-focus - (lambda (on?) - (super on-focus on?) - (send (get-top-level-window) set-info-canvas (and on? this)) - (when on? - (send (get-top-level-window) update-info)))] - [define set-editor - (lambda (m) - (super set-editor m) - (let ([tlw (get-top-level-window)]) - (when (eq? this (send tlw get-info-canvas)) - (send tlw update-info))))] - - (super-instantiate ()) + (define/override (on-focus on?) + (super on-focus on?) + (send (get-top-level-window) set-info-canvas (and on? this)) + (when on? + (send (get-top-level-window) update-info))) + (define/override (set-editor m) + (super set-editor m) + (let ([tlw (get-top-level-window)]) + (when (eq? this (send tlw get-info-canvas)) + (send tlw update-info)))) + + (super-new) (unless (is-a? (get-top-level-window) frame:info<%>) (error 'canvas:text-info-mixin @@ -167,12 +164,10 @@ (lambda (snip) (set! tall-snips (cons snip tall-snips)) ((update-snip-size #f) snip))] - (override on-size) - [define on-size - (lambda (width height) - (recalc-snips) - (super on-size width height))] - (super-instantiate ()))) + (define/override (on-size width height) + (recalc-snips) + (super on-size width height)) + (super-new))) (define basic% (basic-mixin editor-canvas%)) (define info% (info-mixin basic%)) diff --git a/collects/framework/private/frame.ss b/collects/framework/private/frame.ss index 4cc79a37..708cbb4e 100644 --- a/collects/framework/private/frame.ss +++ b/collects/framework/private/frame.ss @@ -469,16 +469,14 @@ (mixin (basic<%>) (info<%>) [define rest-panel 'uninitialized-root] [define super-root 'uninitialized-super-root] - (override make-root-area-container) - [define make-root-area-container - (lambda (% parent) - (let* ([s-root (super make-root-area-container - vertical-panel% - parent)] - [r-root (make-object % s-root)]) - (set! super-root s-root) - (set! rest-panel r-root) - r-root))] + (define/override (make-root-area-container % parent) + (let* ([s-root (super make-root-area-container + vertical-panel% + parent)] + [r-root (make-object % s-root)]) + (set! super-root s-root) + (set! rest-panel r-root) + r-root)) [define info-canvas #f] (public get-info-canvas set-info-canvas get-info-editor) @@ -836,8 +834,7 @@ (failed)])))] [else (failed)])))] - (override update-info) - [define update-info + [define/override update-info (lambda () (super update-info) (update-macro-recording-icon) @@ -976,9 +973,8 @@ (not (string=? s label-prefix))) (set! label-prefix s) (do-label)))] - (override get-label set-label) - [define get-label (lambda () label)] - [define set-label + [define/override get-label (lambda () label)] + [define/override set-label (lambda (t) (when (and (string? t) (not (string=? t label))) @@ -1036,10 +1032,7 @@ base)) (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? - file-menu:print-callback file-menu:create-print?) - + (define/override (file-menu:revert-on-demand item) (send item enable (not (send (get-editor) is-locked?)))) @@ -1084,23 +1077,23 @@ (send edit end-edit-sequence))))))) (define/override file-menu:create-revert? (lambda () #t)) - (define file-menu:save-callback (lambda (item control) - (save) - #t)) + (define/override file-menu:save-callback + (lambda (item control) + (save) + #t)) - (define file-menu:create-save? (lambda () #t)) - (define file-menu:save-as-callback (lambda (item control) (save-as) #t)) - (define file-menu:create-save-as? (lambda () #t)) - (define file-menu:print-callback (lambda (item control) + (define/override file-menu:create-save? (lambda () #t)) + (define/override file-menu:save-as-callback (lambda (item control) (save-as) #t)) + (define/override file-menu:create-save-as? (lambda () #t)) + (define/override file-menu:print-callback (lambda (item control) (send (get-editor) print #t #t (preferences:get 'framework:print-output-mode)) #t)) - (define file-menu:create-print? (lambda () #t)) + (define/override file-menu:create-print? (lambda () #t)) - (override edit-menu:between-select-all-and-find) - (define edit-menu:between-select-all-and-find + (define/override edit-menu:between-select-all-and-find (lambda (edit-menu) (let* ([c% (get-checkable-menu-item%)] [on-demand @@ -1126,18 +1119,17 @@ (make-object separator-menu-item% edit-menu))) - (override help-menu:about-callback help-menu:about-string help-menu:create-about?) - (define help-menu:about-callback + (define/override help-menu:about-callback (lambda (menu evt) (message-box (application:current-app-name) (format (string-constant welcome-to-something) (application:current-app-name)) #f '(ok app)))) - (define help-menu:about-string (lambda () (application:current-app-name))) - (define help-menu:create-about? (lambda () #t)) + (define/override help-menu:about-string (lambda () (application:current-app-name))) + (define/override help-menu:create-about? (lambda () #t)) - (super-instantiate () (label (get-entire-label))) + (super-new (label (get-entire-label))) (define canvas #f) (define editor #f) @@ -1295,18 +1287,16 @@ (define text<%> (interface (-editor<%>))) (define text-mixin (mixin (-editor<%>) (text<%>) - (override get-editor<%> get-editor%) - [define get-editor<%> (lambda () (class->interface text%))] - [define get-editor% (lambda () text:keymap%)] - (super-instantiate ()))) + [define/override get-editor<%> (lambda () (class->interface text%))] + [define/override get-editor% (lambda () text:keymap%)] + (super-new))) (define pasteboard<%> (interface (-editor<%>))) (define pasteboard-mixin (mixin (-editor<%>) (pasteboard<%>) - (override get-editor<%> get-editor%) - [define get-editor<%> (lambda () (class->interface pasteboard%))] - [define get-editor% (lambda () pasteboard:keymap%)] - (super-instantiate ()))) + [define/override get-editor<%> (lambda () (class->interface pasteboard%))] + [define/override get-editor% (lambda () pasteboard:keymap%)] + (super-new))) (define delegate<%> (interface (status-line<%> text<%>) @@ -1475,8 +1465,7 @@ [define rest-panel 'uninitialized-root] [define super-root 'uninitialized-super-root] - (override make-root-area-container) - [define make-root-area-container + [define/override make-root-area-container (lambda (% parent) (let* ([s-root (super make-root-area-container horizontal-panel% @@ -1949,20 +1938,15 @@ (mixin (standard-menus<%>) (searchable<%>) (init-find/replace-edits) (define super-root 'unitiaialized-super-root) - (override edit-menu:find-callback edit-menu:create-find? - edit-menu:find-again-callback edit-menu:create-find-again? - edit-menu:replace-and-find-again-callback edit-menu:replace-and-find-again-on-demand - edit-menu:create-replace-and-find-again?) - (define edit-menu:find-callback (lambda (menu evt) (move-to-search-or-search) #t)) - (define edit-menu:create-find? (lambda () #t)) - (define edit-menu:find-again-callback (lambda (menu evt) (search-again) #t)) - (define edit-menu:create-find-again? (lambda () #t)) - (define edit-menu:replace-and-find-again-callback (lambda (menu evt) (replace&search) #t)) - (define edit-menu:replace-and-find-again-on-demand + (define/override edit-menu:find-callback (lambda (menu evt) (move-to-search-or-search) #t)) + (define/override edit-menu:create-find? (lambda () #t)) + (define/override edit-menu:find-again-callback (lambda (menu evt) (search-again) #t)) + (define/override edit-menu:create-find-again? (lambda () #t)) + (define/override edit-menu:replace-and-find-again-callback (lambda (menu evt) (replace&search) #t)) + (define/override edit-menu:replace-and-find-again-on-demand (lambda (item) (send item enable (can-replace?)))) - (define edit-menu:create-replace-and-find-again? (lambda () #t)) - (override make-root-area-container) - (define make-root-area-container + (define/override edit-menu:create-replace-and-find-again? (lambda () #t)) + (define/override make-root-area-container (lambda (% parent) (let* ([s-root (super make-root-area-container vertical-panel% @@ -2272,12 +2256,10 @@ (define searchable-text-mixin (mixin (text<%> searchable<%>) (searchable-text<%>) (inherit get-editor) - (override get-text-to-search) - (define (get-text-to-search) + (define/override (get-text-to-search) (get-editor)) - (override get-editor<%> get-editor%) - (define (get-editor<%>) text:searching<%>) - (define (get-editor%) text:searching%) + (define/override (get-editor<%>) text:searching<%>) + (define/override (get-editor%) text:searching%) (super-instantiate ()))) (define memory-text% (class text% (super-new))) diff --git a/collects/framework/private/keymap.ss b/collects/framework/private/keymap.ss index 15c7d253..e82f86a2 100644 --- a/collects/framework/private/keymap.ss +++ b/collects/framework/private/keymap.ss @@ -76,8 +76,7 @@ [define function-table (make-hash-table)] (public get-function-table) [define get-function-table (lambda () function-table)] - (override map-function) - [define map-function + [define/override map-function (lambda (keyname fname) (super map-function (canonicalize-keybinding-string keyname) fname) (hash-table-put! function-table (string->symbol keyname) fname))] diff --git a/collects/framework/private/panel.ss b/collects/framework/private/panel.ss index a9e98739..e1b2a83c 100644 --- a/collects/framework/private/panel.ss +++ b/collects/framework/private/panel.ss @@ -96,8 +96,7 @@ (define single-window-mixin (mixin (single<%> window<%>) (single-window<%>) (inherit get-client-size get-size) - (override container-size) - [define container-size + [define/override container-size (lambda (l) (let-values ([(super-width super-height) (super container-size l)] [(client-width client-height) (get-client-size)] @@ -109,7 +108,7 @@ (values (calc-size super-width client-width window-width) (calc-size super-height client-height window-height))))] - (super-instantiate ()))) + (super-new))) (define multi-view<%> (interface (area-container<%>) diff --git a/collects/framework/private/text.ss b/collects/framework/private/text.ss index 8cb8a003..e7b3bb23 100644 --- a/collects/framework/private/text.ss +++ b/collects/framework/private/text.ss @@ -249,8 +249,7 @@ WARNING: printf is rebound in the body of the unit to always (cons (car r) (loop (cdr r))))]))) (recompute-range-rectangles) (invalidate-rectangles old-rectangles)))))) - (override on-paint) - (define (on-paint before dc left-margin top-margin right-margin bottom-margin dx dy draw-caret) + (define/override (on-paint before dc left-margin top-margin right-margin bottom-margin dx dy draw-caret) (super on-paint before dc left-margin top-margin right-margin bottom-margin dx dy draw-caret) (recompute-range-rectangles) (let ([b1 (box 0)] @@ -396,8 +395,7 @@ WARNING: printf is rebound in the body of the unit to always (define searching<%> (interface (editor:keymap<%> basic<%>))) (define searching-mixin (mixin (editor:keymap<%> basic<%>) (searching<%>) - (override get-keymaps) - (define (get-keymaps) + (define/override (get-keymaps) (cons (keymap:get-search) (super get-keymaps))) (super-instantiate ()))) @@ -405,8 +403,7 @@ WARNING: printf is rebound in the body of the unit to always (define return-mixin (mixin ((class->interface text%)) (return<%>) (init-field return) - (override on-local-char) - (define (on-local-char key) + (define/override (on-local-char key) (let ([cr-code #\return] [lf-code #\newline] [code (send key get-key-code)]) @@ -738,20 +735,17 @@ WARNING: printf is rebound in the body of the unit to always (when (is-a? frame frame:text-info<%>) (call-method frame)))))) - (override set-anchor set-overwrite-mode) - (augment after-set-position after-insert after-delete) - - (define (set-anchor x) + (define/override (set-anchor x) (super set-anchor x) (enqueue-for-frame (lambda (x) (send x anchor-status-changed)) 'framework:anchor-status-changed)) - (define (set-overwrite-mode x) + (define/override (set-overwrite-mode x) (super set-overwrite-mode x) (enqueue-for-frame (lambda (x) (send x overwrite-status-changed)) 'framework:overwrite-status-changed)) - (define (after-set-position) + (define/augment (after-set-position) (maybe-queue-editor-position-update) (inner (void) after-set-position)) @@ -771,13 +765,13 @@ WARNING: printf is rebound in the body of the unit to always #f))) 'framework:info-frame:update-editor-position)) - (define (after-insert start len) + (define/augment (after-insert start len) (maybe-queue-editor-position-update) (inner (void) after-insert start len)) - (define (after-delete start len) + (define/augment (after-delete start len) (maybe-queue-editor-position-update) (inner (void) after-delete start len)) - (super-instantiate ()))) + (super-new))) (define clever-file-format<%> (interface ((class->interface text%))))