diff --git a/collects/mred/mred.rkt b/collects/mred/mred.rkt index bd725f9d..36b12fdc 100644 --- a/collects/mred/mred.rkt +++ b/collects/mred/mred.rkt @@ -1,281 +1,4 @@ -(module mred mzscheme - (require (only racket/base - define-namespace-anchor - namespace-anchor->empty-namespace - make-base-empty-namespace) - scheme/class - racket/draw racket/snip - mzlib/etc - (prefix wx: "private/kernel.ss") - (prefix wx: "private/wxme/editor.ss") - (prefix wx: "private/wxme/text.ss") - (prefix wx: "private/wxme/pasteboard.ss") - (prefix wx: "private/wxme/keymap.ss") - (prefix wx: "private/wxme/editor-admin.ss") - (prefix wx: "private/wxme/editor-data.ss") - (prefix wx: "private/wxme/editor-snip.ss") - (prefix wx: "private/wxme/stream.ss") - (prefix wx: "private/wxme/wordbreak.ss") - "private/wxtop.ss" - "private/app.ss" - "private/misc.ss" - "private/mrwindow.ss" - "private/mrcontainer.ss" - "private/mrtop.ss" - "private/mrpanel.ss" - "private/mrcanvas.ss" - "private/mritem.ss" - "private/mrtextfield.ss" - "private/mrmenuintf.ss" - "private/mrmenu.ss" - "private/mrpopup.ss" - "private/editor.ss" - "private/messagebox.ss" - "private/filedialog.ss" - "private/fontdialog.ss" - "private/moredialogs.ss" - "private/gdi.ss" - "private/snipfile.ss" - "private/repl.ss" - "private/helper.ss" - "private/dynamic.ss" - "private/check.ss") +#lang racket/base - ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - ;; These functions are re-implemented in scheme/gui/base - ;; and racket/gui/base to attach those names, instead of - ;; just 'mred. - - (define-namespace-anchor anchor) - - (define (make-gui-empty-namespace) - (let ([ns (make-base-empty-namespace)]) - (namespace-attach-module (namespace-anchor->empty-namespace anchor) - 'mred - ns) - ns)) - - (define (make-gui-namespace) - (let ([ns (make-gui-empty-namespace)]) - (parameterize ([current-namespace ns]) - (namespace-require 'scheme/base) - (namespace-require 'mred) - (namespace-require 'scheme/class)) - ns)) - - ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - - (define (make-eventspace) - (parameterize ([the-snip-class-list (make-the-snip-class-list)] - [wx:the-editor-data-class-list (wx:make-the-editor-data-class-list)]) - (wx:make-eventspace))) - - ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - - (define-syntax propagate - (lambda (stx) - (syntax-case stx () - [(_ n ...) - (let ([ns (syntax->list (syntax (n ...)))]) - (with-syntax ([(k:n ...) - (map - (lambda (n) - (datum->syntax-object - n - (string->symbol - (format - "wx:~a" - (syntax-e n))) - #f)) - ns)]) - (syntax (begin - ;; We can't just re-export, because kernel.ss's - ;; exports are protected. - (define n k:n) ... - (provide n ...)))))]))) - - (propagate add-editor-keymap-functions - add-text-keymap-functions - add-pasteboard-keymap-functions - begin-busy-cursor - bell - editor-data% - editor-data-class% - editor-data-class-list<%> - check-for-break - clipboard<%> - clipboard-client% - control-event% - current-eventspace - cursor% - get-display-depth - end-busy-cursor - event% - event-dispatch-handler - eventspace? - flush-display - get-highlight-background-color - get-highlight-text-color - get-the-editor-data-class-list - is-busy? - is-color-display? - key-event% - keymap% - editor-admin% - editor-set-x-selection-mode - editor-snip-editor-admin<%> - editor-stream-in% - editor-stream-in-base% - editor-stream-in-bytes-base% - editor-stream-out% - editor-stream-out-base% - editor-stream-out-bytes-base% - editor-wordbreak-map% - mouse-event% - read-editor-global-footer - read-editor-global-header - read-editor-version - scroll-event% - special-control-key - special-option-key - map-command-as-meta-key - label->plain-label - write-editor-global-footer - write-editor-global-header - write-editor-version - queue-callback - yield - eventspace-shutdown? - get-panel-background - - the-editor-wordbreak-map - make-screen-bitmap - make-gl-bitmap) - - (define the-clipboard (wx:get-the-clipboard)) - (define the-x-selection-clipboard (wx:get-the-x-selection)) - - (define (find-graphical-system-path what) - (unless (memq what '(init-file x-display)) - (raise-type-error 'find-graphical-system-path "'init-file or 'x-display" what)) - (or (wx:find-graphical-system-path what) - (case what - [(init-file) - (build-path (find-system-path 'init-dir) - (case (system-type) - [(windows) "gracketrc.rktl"] - [else ".gracketrc"]))] - [else #f]))) - - (provide (all-from racket/draw) - (all-from racket/snip)) - - (provide button% - canvas% - check-box% - choice% - dialog% - frame% - gauge% - tab-panel% - group-box-panel% - list-box% - editor-canvas% - message% - pane% - horizontal-pane% - vertical-pane% - grow-box-spacer-pane% - panel% - horizontal-panel% - vertical-panel% - radio-box% - slider% - text-field% - combo-field% - window<%> - area<%> - top-level-window<%> - subarea<%> - subwindow<%> - area-container<%> - area-container-window<%> - canvas<%> - control<%> - list-control<%> - menu-item<%> - separator-menu-item% - selectable-menu-item<%> - labelled-menu-item<%> - menu-item% - checkable-menu-item% - get-default-shortcut-prefix - menu-item-container<%> - menu% - menu-bar% - popup-menu% - get-top-level-windows - editor-snip% - editor<%> - text% - pasteboard% - graphical-read-eval-print-loop - textual-read-eval-print-loop - message-box - message+check-box - message-box/custom - message+check-box/custom - get-face-list - get-file - get-file-list - put-file - get-directory - get-choices-from-user - get-text-from-user - get-ps-setup-from-user - get-page-setup-from-user - can-get-page-setup-from-user? - play-sound - get-display-size - get-display-left-top-inset - get-color-from-user - get-font-from-user - append-editor-operation-menu-items - append-editor-font-menu-items - get-top-level-focus-window - get-top-level-edit-target-window - register-collecting-blit - unregister-collecting-blit - printer-dc% - current-text-keymap-initializer - sleep/yield - get-window-text-extent - send-message-to-window - the-clipboard - the-x-selection-clipboard - normal-control-font - small-control-font - tiny-control-font - view-control-font - menu-control-font - timer% - open-input-text-editor - open-input-graphical-file - open-output-text-editor - text-editor-load-handler - application-about-handler - application-preferences-handler - application-quit-handler - application-file-handler - current-eventspace-has-standard-menus? - current-eventspace-has-menu-root? - eventspace-handler-thread - make-eventspace - make-gui-namespace - make-gui-empty-namespace - file-creator-and-type - hide-cursor-until-moved - system-position-ok-before-cancel? - label-string? - key-code-symbol? - find-graphical-system-path)) +(require "private/mred.rkt") +(provide (all-from-out "private/mred.rkt")) diff --git a/collects/mred/private/mred.rkt b/collects/mred/private/mred.rkt new file mode 100644 index 00000000..ee2c4b95 --- /dev/null +++ b/collects/mred/private/mred.rkt @@ -0,0 +1,281 @@ +(module mred mzscheme + (require (only racket/base + define-namespace-anchor + namespace-anchor->empty-namespace + make-base-empty-namespace) + scheme/class + racket/draw racket/snip + mzlib/etc + (prefix wx: "kernel.ss") + (prefix wx: "wxme/editor.ss") + (prefix wx: "wxme/text.ss") + (prefix wx: "wxme/pasteboard.ss") + (prefix wx: "wxme/keymap.ss") + (prefix wx: "wxme/editor-admin.ss") + (prefix wx: "wxme/editor-data.ss") + (prefix wx: "wxme/editor-snip.ss") + (prefix wx: "wxme/stream.ss") + (prefix wx: "wxme/wordbreak.ss") + "wxtop.ss" + "app.ss" + "misc.ss" + "mrwindow.ss" + "mrcontainer.ss" + "mrtop.ss" + "mrpanel.ss" + "mrcanvas.ss" + "mritem.ss" + "mrtextfield.ss" + "mrmenuintf.ss" + "mrmenu.ss" + "mrpopup.ss" + "editor.ss" + "messagebox.ss" + "filedialog.ss" + "fontdialog.ss" + "moredialogs.ss" + "gdi.ss" + "snipfile.ss" + "repl.ss" + "helper.ss" + "dynamic.ss" + "check.ss") + + ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; These functions are re-implemented in scheme/gui/base + ;; and racket/gui/base to attach those names, instead of + ;; just 'mred. + + (define-namespace-anchor anchor) + + (define (make-gui-empty-namespace) + (let ([ns (make-base-empty-namespace)]) + (namespace-attach-module (namespace-anchor->empty-namespace anchor) + 'mred + ns) + ns)) + + (define (make-gui-namespace) + (let ([ns (make-gui-empty-namespace)]) + (parameterize ([current-namespace ns]) + (namespace-require 'scheme/base) + (namespace-require 'mred) + (namespace-require 'scheme/class)) + ns)) + + ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + (define (make-eventspace) + (parameterize ([the-snip-class-list (make-the-snip-class-list)] + [wx:the-editor-data-class-list (wx:make-the-editor-data-class-list)]) + (wx:make-eventspace))) + + ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + (define-syntax propagate + (lambda (stx) + (syntax-case stx () + [(_ n ...) + (let ([ns (syntax->list (syntax (n ...)))]) + (with-syntax ([(k:n ...) + (map + (lambda (n) + (datum->syntax-object + n + (string->symbol + (format + "wx:~a" + (syntax-e n))) + #f)) + ns)]) + (syntax (begin + ;; We can't just re-export, because kernel.ss's + ;; exports are protected. + (define n k:n) ... + (provide n ...)))))]))) + + (propagate add-editor-keymap-functions + add-text-keymap-functions + add-pasteboard-keymap-functions + begin-busy-cursor + bell + editor-data% + editor-data-class% + editor-data-class-list<%> + check-for-break + clipboard<%> + clipboard-client% + control-event% + current-eventspace + cursor% + get-display-depth + end-busy-cursor + event% + event-dispatch-handler + eventspace? + flush-display + get-highlight-background-color + get-highlight-text-color + get-the-editor-data-class-list + is-busy? + is-color-display? + key-event% + keymap% + editor-admin% + editor-set-x-selection-mode + editor-snip-editor-admin<%> + editor-stream-in% + editor-stream-in-base% + editor-stream-in-bytes-base% + editor-stream-out% + editor-stream-out-base% + editor-stream-out-bytes-base% + editor-wordbreak-map% + mouse-event% + read-editor-global-footer + read-editor-global-header + read-editor-version + scroll-event% + special-control-key + special-option-key + map-command-as-meta-key + label->plain-label + write-editor-global-footer + write-editor-global-header + write-editor-version + queue-callback + yield + eventspace-shutdown? + get-panel-background + + the-editor-wordbreak-map + make-screen-bitmap + make-gl-bitmap) + + (define the-clipboard (wx:get-the-clipboard)) + (define the-x-selection-clipboard (wx:get-the-x-selection)) + + (define (find-graphical-system-path what) + (unless (memq what '(init-file x-display)) + (raise-type-error 'find-graphical-system-path "'init-file or 'x-display" what)) + (or (wx:find-graphical-system-path what) + (case what + [(init-file) + (build-path (find-system-path 'init-dir) + (case (system-type) + [(windows) "gracketrc.rktl"] + [else ".gracketrc"]))] + [else #f]))) + + (provide (all-from racket/draw) + (all-from racket/snip)) + + (provide button% + canvas% + check-box% + choice% + dialog% + frame% + gauge% + tab-panel% + group-box-panel% + list-box% + editor-canvas% + message% + pane% + horizontal-pane% + vertical-pane% + grow-box-spacer-pane% + panel% + horizontal-panel% + vertical-panel% + radio-box% + slider% + text-field% + combo-field% + window<%> + area<%> + top-level-window<%> + subarea<%> + subwindow<%> + area-container<%> + area-container-window<%> + canvas<%> + control<%> + list-control<%> + menu-item<%> + separator-menu-item% + selectable-menu-item<%> + labelled-menu-item<%> + menu-item% + checkable-menu-item% + get-default-shortcut-prefix + menu-item-container<%> + menu% + menu-bar% + popup-menu% + get-top-level-windows + editor-snip% + editor<%> + text% + pasteboard% + graphical-read-eval-print-loop + textual-read-eval-print-loop + message-box + message+check-box + message-box/custom + message+check-box/custom + get-face-list + get-file + get-file-list + put-file + get-directory + get-choices-from-user + get-text-from-user + get-ps-setup-from-user + get-page-setup-from-user + can-get-page-setup-from-user? + play-sound + get-display-size + get-display-left-top-inset + get-color-from-user + get-font-from-user + append-editor-operation-menu-items + append-editor-font-menu-items + get-top-level-focus-window + get-top-level-edit-target-window + register-collecting-blit + unregister-collecting-blit + printer-dc% + current-text-keymap-initializer + sleep/yield + get-window-text-extent + send-message-to-window + the-clipboard + the-x-selection-clipboard + normal-control-font + small-control-font + tiny-control-font + view-control-font + menu-control-font + timer% + open-input-text-editor + open-input-graphical-file + open-output-text-editor + text-editor-load-handler + application-about-handler + application-preferences-handler + application-quit-handler + application-file-handler + current-eventspace-has-standard-menus? + current-eventspace-has-menu-root? + eventspace-handler-thread + make-eventspace + make-gui-namespace + make-gui-empty-namespace + file-creator-and-type + hide-cursor-until-moved + system-position-ok-before-cancel? + label-string? + key-code-symbol? + find-graphical-system-path))