From 729b587b6ce969fbff6ffda3ca5720e8a9e006f7 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Fri, 7 Sep 2001 04:52:49 +0000 Subject: [PATCH] ... original commit: 2b3ae05e3c7e4c9a448ec98c15236f1c2f82259e --- collects/framework/private/editor.ss | 20 +-- collects/framework/private/exit.ss | 14 +- collects/framework/private/finder.ss | 99 ++++++------ collects/framework/private/frame.ss | 76 +++++---- collects/framework/private/group.ss | 7 +- collects/framework/private/keymap.ss | 24 +-- collects/framework/private/main.ss | 10 +- collects/framework/private/preferences.ss | 152 +++++++++-------- collects/framework/private/scheme.ss | 27 ++-- .../framework/private/standard-menus-items.ss | 153 ++++++++++++------ collects/framework/private/text.ss | 11 +- 11 files changed, 336 insertions(+), 257 deletions(-) diff --git a/collects/framework/private/editor.ss b/collects/framework/private/editor.ss index 853f19ee..9b6e8e15 100644 --- a/collects/framework/private/editor.ss +++ b/collects/framework/private/editor.ss @@ -2,6 +2,7 @@ (require (lib "unitsig.ss") (lib "class.ss") (lib "class100.ss") + (lib "string-constant.ss" "string-constants") "sig.ss" "../gui-utils-sig.ss" "../macro.ss" @@ -51,10 +52,10 @@ (and (if (equal? filename (get-filename)) (if (save-file-out-of-date?) (gui-utils:get-choice - "The file has beeen modified since it was last saved. Overwrite the modifications?" - "Overwrite" - "Cancel" - "Warning" + (string-constant file-has-been-modified) + (string-constant overwrite-file-button-label) + (string-constant cancel) + (string-constant warning) #f (get-top-level-focus-window)) #t) @@ -403,11 +404,12 @@ (set! auto-save-out-of-date? #f)) (begin (message-box - "Warning" - (format "Error autosaving ~s.~n~a~n~a" - (or orig-name "Untitled") - "Autosaving is turned off" - "until the file is saved.")) + (string-constant warning) + (string-append + (format (string-constant error-autosaving) + (or orig-name (string-constant untitled))) + "\n" + (string-constant autosaving-turned-off))) (set! auto-save-error? #t))))))] [define remove-autosave (lambda () diff --git a/collects/framework/private/exit.ss b/collects/framework/private/exit.ss index f9b3764f..6f048566 100644 --- a/collects/framework/private/exit.ss +++ b/collects/framework/private/exit.ss @@ -1,5 +1,6 @@ (module exit mzscheme (require (lib "unitsig.ss") + (lib "string-constant.ss" "string-constants") (lib "class.ss") "sig.ss" "../gui-utils-sig.ss" @@ -52,13 +53,14 @@ (if (preferences:get 'framework:verify-exit) (let*-values ([(w capw) (if (eq? (system-type) 'windows) - (values "exit" "Exit") - (values "quit" "Quit"))] + (values (string-constant exit-lc) (string-constant exit-cap)) + (values (string-constant quit-lc) (string-constant quit-cap)))] [(message) - (string-append "Are you sure you want to " - w - "?")] - [(user-says) (gui-utils:get-choice message capw "Cancel" "Warning" #f + (format (string-constant are-you-sure-format) w)] + [(user-says) (gui-utils:get-choice message capw + (string-constant cancel) + (string-constant warning) + #f (frame-exiting))]) user-says) #t)) diff --git a/collects/framework/private/finder.ss b/collects/framework/private/finder.ss index c4f348bf..640b3263 100644 --- a/collects/framework/private/finder.ss +++ b/collects/framework/private/finder.ss @@ -1,6 +1,7 @@ (module finder mzscheme - (require (lib "unitsig.ss") + (require (lib "string-constant.ss" "string-constants") + (lib "unitsig.ss") "sig.ss" "../gui-utils-sig.ss" (lib "class100.ss") @@ -31,7 +32,7 @@ (if (regexp-match-exact? filter name) #t (begin - (message-box "Error" msg) + (message-box (string-constant error) msg) #f))))) (define last-directory #f) @@ -216,14 +217,14 @@ (if (directory-exists? file) (set-directory (normal-case-path (normalize-path file))) (message-box - "Error" - "You must specify a file name")))] + (string-constant error) + (string-constant must-specify-a-filename))))] [(and save-mode? non-empty? file-filter (not (regexp-match-exact? file-filter name))) - (message-box "Error" file-filter-msg)] + (message-box (string-constant error) file-filter-msg)] [else @@ -248,10 +249,8 @@ (if (and (not save-mode?) (not file-in-edit)) (message-box - "Error" - (string-append "The file \"" - dir-name - "\" does not exist.")) + (string-constant error) + (format (string-constant file-does-not-exist) dir-name)) ; saving a file, which may exist, or ; opening an existing file @@ -259,25 +258,23 @@ (if (or (not save-mode?) (not (file-exists? file)) replace-ok? - (eq? (message-box "Warning" - (string-append - "The file " - file - " already exists. " - "Replace it?") - #f - '(yes-no)) + (eq? (message-box + (string-constant warning) + (format + (string-constant ask-because-file-exists) + file) + #f + '(yes-no)) 'yes)) (let ([normal-path (with-handlers ([(lambda (_) #t) (lambda (_) (message-box - "Warning" - (string-append - "The file " - file - " contains nonexistent directory or cycle.")) + (string-constant warning) + (format + (string-constant dne-or-cycle) + file)) #f)]) (normal-case-path (normalize-path file)))]) @@ -329,7 +326,9 @@ [on-close (lambda () #f)]) (sequence - (super-init (if save-mode? "Put file" "Get file") + (super-init (if save-mode? + (string-constant put-file) + (string-constant get-file)) parent-win default-width default-height @@ -484,7 +483,7 @@ (keymap:call/text-keymap-initializer (lambda () (make-object text-field% - "Full pathname" + (string-constant full-pathname) directory-panel (lambda (txt evt) (when (eq? (send evt get-event-type) 'text-field-enter) @@ -527,7 +526,7 @@ (when (eq? (system-type) 'unix) (let ([dot-cb (make-object check-box% - "Show files and directories that begin with a dot" + (string-constant show-dot-files) dot-panel (lambda (x y) (do-period-in/exclusion x y)))]) (send dot-panel stretchable-height #f) @@ -542,7 +541,7 @@ (send result-list stretchable-width #t)) (make-object button% - "Up directory" + (string-constant up-directory-button-label) top-panel (lambda (button evt) (do-updir))) @@ -559,29 +558,35 @@ [add-button (when multi-mode? (make-object horizontal-panel% add-panel) (make-object button% - "Add" + (string-constant add-button-label) add-panel (lambda (x y) (do-add))))] [add-all-button (when multi-mode? (begin0 (make-object button% - "Add all" + (string-constant add-all-button-label) add-panel (lambda (x y) (do-add-all))) (make-object horizontal-panel% add-panel)))] [remove-button (when multi-mode? (make-object horizontal-panel% remove-panel) (begin0 - (make-object button% "Remove" remove-panel (lambda (x y) (do-remove))) + (make-object button% + (string-constant remove-button-label) + remove-panel + (lambda (x y) (do-remove))) (make-object horizontal-panel% remove-panel)))]) (sequence (make-object vertical-panel% bottom-panel)) (private-field [ok-button - (make-object button% "OK" bottom-panel + (make-object button% (string-constant ok) bottom-panel (lambda (x y) (do-ok)) (if multi-mode? '() '(border)))] - [cancel-button (make-object button% "Cancel" bottom-panel (lambda (x y) (do-cancel)))]) + [cancel-button (make-object button% + (string-constant cancel) + bottom-panel + (lambda (x y) (do-cancel)))]) (sequence (make-object grow-box-spacer-pane% bottom-panel) @@ -617,9 +622,9 @@ [name #f] [in-directory #f] [replace? #f] - [prompt "Select file"] + [prompt (string-constant select-file)] [filter #f] - [filter-msg "Invalid form"] + [filter-msg (string-constant file-wrong-form)] [parent-win (dialog-parent-parameter)]) (let* ([directory (if (and (not in-directory) (string? name)) @@ -647,9 +652,9 @@ (opt-lambda (result-box [directory #f] - [prompt "Select file"] + [prompt (string-constant select-file)] [filter #f] - [filter-msg "Bad name"] + [filter-msg (string-constant file-wrong-form)] [parent-win (dialog-parent-parameter)]) (let ([saved-directory last-directory]) (make-object finder-dialog% @@ -669,9 +674,9 @@ (make-common (opt-lambda (result-box [directory #f] - [prompt "Select files"] + [prompt (string-constant select-files)] [filter #f] - [filter-msg "Bad name"] + [filter-msg (string-constant file-wrong-form)] [parent-win (dialog-parent-parameter)]) (make-object finder-dialog% @@ -694,9 +699,9 @@ (opt-lambda ([name #f] [directory #f] [replace? #f] - [prompt "Select file"] + [prompt (string-constant select-file)] [filter #f] - [filter-msg "That filename does not have the right form."] + [filter-msg (string-constant file-wrong-form)] [parent-win (dialog-parent-parameter)]) (let* ([directory (if (and (not directory) (string? name)) @@ -723,18 +728,20 @@ [name (file-name-from-path f)]) (cond [(not (and (string? dir) (directory-exists? dir))) - (message-box "Error" "That directory does not exist.") + (message-box (string-constant error) + (string-constant dir-dne)) #f] [(or (not name) (equal? name "")) - (message-box "Error" "Empty filename.") + (message-box (string-constant error) + (string-constant empty-filename)) #f] [else f])))))) (define std-get-file (opt-lambda ([directory #f] - [prompt "Select file"] + [prompt (string-constant select-file)] [filter #f] - [filter-msg "That filename does not have the right form."] + [filter-msg (string-constant file-wrong-form)] [parent-win (dialog-parent-parameter)]) (let ([f (get-file prompt @@ -746,10 +753,12 @@ (let ([f (normalize-path f)]) (cond [(directory-exists? f) - (message-box "Error" "That is a directory name.") + (message-box (string-constant error) + (string-constant that-is-dir-name)) #f] [(not (file-exists? f)) - (message-box "Error" "File does not exist.") + (message-box (string-constant error) + (string-constant file-dne)) #f] [else f])) #f) diff --git a/collects/framework/private/frame.ss b/collects/framework/private/frame.ss index 5a29c36e..acc0727e 100644 --- a/collects/framework/private/frame.ss +++ b/collects/framework/private/frame.ss @@ -1,6 +1,7 @@ (module frame mzscheme - (require (lib "unitsig.ss") + (require (lib "string-constant.ss" "string-constants") + (lib "unitsig.ss") (lib "class.ss") (lib "class100.ss") (lib "include.ss") @@ -55,11 +56,11 @@ (reverse (move-to-back name (reverse items))))] [re-ordered (move-to-front - "File" + (string-constant file-menu) (move-to-front - "Edit" + (string-constant edit-menu) (move-to-back - "Help" + (string-constant help-menu) items)))]) (for-each (lambda (item) (send item delete)) items) (for-each (lambda (item) (send item restore)) re-ordered))) @@ -151,7 +152,8 @@ (super-instantiate ()) (accept-drop-files #t) - (make-object menu% "&Windows" (make-object (get-menu-bar%) this)) + (make-object menu% (string-constant windows-menu-label) + (make-object (get-menu-bar%) this)) (reorder-menus this) (send (group:get-the-frame-group) insert-frame this) [define panel (make-root-area-container (get-area-container%) this)] @@ -159,8 +161,8 @@ [define get-area-container (lambda () panel)] (set! after-init? #t))) - (define locked-message "Read only") - (define unlocked-message "Read/Write") + (define locked-message (string-constant read-only)) + (define unlocked-message (string-constant read/write)) (define lock-canvas% (class100 canvas% (parent . args) @@ -331,7 +333,7 @@ ; only for CVSers (when show-memory-text? (let* ([panel (make-object horizontal-panel% (get-info-panel) '(border))] - [button (make-object button% "Collect" panel + [button (make-object button% (string-constant collect-button-label) panel (lambda x (collect-garbage) (update-memory-text)))] @@ -529,11 +531,11 @@ (let ([b (icon:get-anchor-bitmap)]) (if (and #f (send b ok?)) b - "Auto-extend Selection")) + (string-constant auto-extend-selection))) (get-info-panel))] [define overwrite-message (make-object message% - "Overwrite" + (string-constant overwrite) (get-info-panel))] [define position-canvas (make-object editor-canvas% (get-info-panel) #f '(no-hscroll no-vscroll))] [define position-edit (make-object text%)] @@ -703,8 +705,8 @@ (begin (send edit end-edit-sequence) (message-box - "Error Reverting" - (format "could not read ~a" filename))))))) + (string-constant error-reverting) + (format (string-constant could-not-read) filename))))))) #t))] [define file-menu:create-revert? (lambda () #t)] [define file-menu:save-callback (lambda (item control) @@ -739,9 +741,12 @@ (let ([edit (get-edit-target-object)]) (send menu-item enable (and edit (is-a? edit editor<%>)))))]) - (make-object c% "Insert Text Box" edit-menu (edit-menu:do 'insert-text-box) #f #f on-demand) - (make-object c% "Insert Pasteboard Box" edit-menu (edit-menu:do 'insert-pasteboard-box) #f #f on-demand) - (make-object c% "Insert Image..." edit-menu (edit-menu:do 'insert-image) #f #f on-demand)))] + (make-object c% (string-constant insert-text-box-item) + edit-menu (edit-menu:do 'insert-text-box) #f #f on-demand) + (make-object c% (string-constant insert-pb-box-item) + edit-menu (edit-menu:do 'insert-pasteboard-box) #f #f on-demand) + (make-object c% (string-constant insert-image-item) + edit-menu (edit-menu:do 'insert-image) #f #f on-demand)))] (override edit-menu:between-select-all-and-find) @@ -768,7 +773,8 @@ (when (and edit (is-a? edit editor<%>)) (send edit auto-wrap (not (send edit auto-wrap))))))]) - (make-object c% "Wrap Text" edit-menu callback #f #f on-demand)) + (make-object c% (string-constant wrap-text-item) + edit-menu callback #f #f on-demand)) (make-object separator-menu-item% edit-menu))] @@ -776,7 +782,8 @@ [define help-menu:about-callback (lambda (menu evt) (message-box (application:current-app-name) - (format "Welcome to ~a" (application:current-app-name))))] + (format (string-constant welcome-to-something) + (application:current-app-name))))] [define help-menu:about-string (lambda () (application:current-app-name))] [define help-menu:create-about? (lambda () #t)] @@ -836,7 +843,7 @@ (let* ([to-be-searched-text (send frame get-text-to-search)] [to-be-searched-canvas (send to-be-searched-text get-canvas)] - [dialog (make-object dialog% "Find and Replace" frame)] + [dialog (make-object dialog% (string-constant find-and-replace) frame)] [copy-text (lambda (from to) @@ -862,20 +869,20 @@ [find-panel (make-object horizontal-panel% dialog)] - [find-message (make-object message% "Find" find-panel)] + [find-message (make-object message% (string-constant find) find-panel)] [f-text (make-object text-keymap/editor%)] [find-canvas (make-object editor-canvas% find-panel f-text '(hide-hscroll hide-vscroll))] [replace-panel (make-object horizontal-panel% dialog)] - [replace-message (make-object message% "Replace" replace-panel)] + [replace-message (make-object message% (string-constant replace) replace-panel)] [r-text (make-object text-keymap/editor%)] [replace-canvas (make-object editor-canvas% replace-panel r-text '(hide-hscroll hide-vscroll))] [button-panel (make-object horizontal-panel% dialog)] [pref-check (make-object check-box% - "Use separate dialog for searching" + (string-constant use-separate-dialog-for-searching) dialog (lambda (pref-check evt) (preferences:set @@ -889,24 +896,25 @@ (send find-edit start-searching) (copy-text r-text replace-edit))] - [find-button (make-object button% "Find" button-panel + [find-button (make-object button% (string-constant find) button-panel (lambda x (update-texts) (send frame search-again)) '(border))] - [replace-button (make-object button% "Replace" button-panel + [replace-button (make-object button% (string-constant replace) button-panel (lambda x (update-texts) (send frame replace)))] - [replace-button (make-object button% "Replace && Find Again" button-panel + [replace-button (make-object button% (string-constant replace&find-again) + button-panel (lambda x (update-texts) (send frame replace&search)))] - [replace-button (make-object button% "Replace to End" button-panel + [replace-button (make-object button% (string-constant replace-to-end) button-panel (lambda x (update-texts) (send frame replace-all)))] - [close-button (make-object button% "Close" button-panel + [close-button (make-object button% (string-constant close) button-panel (lambda x (send to-be-searched-canvas force-display-focus #f) (send dialog show #f)))]) @@ -1393,23 +1401,25 @@ [define middle-right-panel (make-object vertical-pane% search-panel)] [define search-button (make-object button% - "Search" + (string-constant find) middle-left-panel (lambda args (search-again)))] [define replace&search-button (make-object button% - "Replace && Search" + (string-constant replace&find-again) middle-middle-panel (lambda x (replace&search)))] - [define replace-button (make-object button% "Replace" middle-left-panel (lambda x (replace)))] + [define replace-button (make-object button% (string-constant replace) + middle-left-panel (lambda x (replace)))] [define replace-all-button (make-object button% - "Replace To End" + (string-constant replace-to-end) middle-middle-panel (lambda x (replace-all)))] [define dir-radio (make-object radio-box% #f - (list "Forward" "Backward") + (list (string-constant forward) + (string-constant backward)) middle-right-panel (lambda (dir-radio evt) (let ([forward (if (= (send dir-radio get-selection) 0) @@ -1417,7 +1427,7 @@ 'backward)]) (set-search-direction forward) (reset-search-anchor (get-text-to-search)))))] - [define close-button (make-object button% "Hide" + [define close-button (make-object button% (string-constant hide) middle-right-panel (lambda args (hide-search)))] [define hidden? #f] @@ -1476,7 +1486,7 @@ (if (string? fn) fn (get-label))) - "Close" + (string-constant close) #t this) [(continue) #t] diff --git a/collects/framework/private/group.ss b/collects/framework/private/group.ss index f29c7d46..fa49abfa 100644 --- a/collects/framework/private/group.ss +++ b/collects/framework/private/group.ss @@ -1,6 +1,7 @@ (module group mzscheme - (require (lib "unitsig.ss") + (require (lib "string-constant.ss" "string-constants") + (lib "unitsig.ss") (lib "class.ss") "sig.ss" (lib "mred-sig.ss" "mred") @@ -38,7 +39,7 @@ (and menu-bar (let ([menus (send menu-bar get-items)]) (ormap (lambda (x) - (if (string=? "&Windows" (send x get-label)) + (if (string=? (string-constant windows-menu-label) (send x get-label)) x #f)) menus)))))] @@ -58,7 +59,7 @@ [define (update-windows-menus) (let* ([windows (length windows-menus)] - [default-name "Untitled"] + [default-name (string-constant untitled)] [get-name (lambda (frame) (let ([label (send frame get-label)]) diff --git a/collects/framework/private/keymap.ss b/collects/framework/private/keymap.ss index 27b4122f..4d63c449 100644 --- a/collects/framework/private/keymap.ss +++ b/collects/framework/private/keymap.ss @@ -1,5 +1,6 @@ (module keymap mzscheme - (require (lib "unitsig.ss") + (require (lib "string-constant.ss" "string-constants") + (lib "unitsig.ss") "sig.ss" "../macro.ss" (lib "class.ss") @@ -597,8 +598,8 @@ (call/text-keymap-initializer (lambda () (get-text-from-user - "Goto Line" - "Goto Line:")))]) + (string-constant goto-line) + (string-constant goto-line))))]) (when (string? num-str) (let ([line-num (inexact->exact (string->number num-str))]) (cond @@ -610,10 +611,11 @@ (send edit set-position pos))] [else (message-box - "Goto Line" - (format "~a is not a valid line number. It must be an integer between 1 and ~a" - num-str - (+ (send edit last-line) 1)))])))) + (string-constant goto-line) + (format + (string-constant goto-line-invalid-number) + num-str + (+ (send edit last-line) 1)))])))) #t)] [goto-position @@ -622,12 +624,12 @@ (call/text-keymap-initializer (lambda () (get-text-from-user - "Goto Position" - "Goto Position:")))]) + (string-constant goto-position) + (string-constant goto-position))))]) (if (string? num-str) (let ([pos (string->number num-str)]) - (if pos - (send edit set-position (sub1 pos)))))) + (when pos + (send edit set-position (sub1 pos)))))) #t)] [repeater (lambda (n edit) diff --git a/collects/framework/private/main.ss b/collects/framework/private/main.ss index b3f69944..26988f38 100644 --- a/collects/framework/private/main.ss +++ b/collects/framework/private/main.ss @@ -158,16 +158,8 @@ (exit:insert-on-callback (lambda () - (with-handlers ([(lambda (x) (void)) - (lambda (exn) - (message-box - "Saving Prefs" - (format "Error saving preferences: ~a" - (exn-message exn))))]) - (preferences:save)))) + (preferences:save))) - ;(wx:application-file-handler edit-file) ;; how to handle drag and drop? - (preferences:read) ;; reset these -- they are only for the test suite. diff --git a/collects/framework/private/preferences.ss b/collects/framework/private/preferences.ss index 44276f91..3784c52f 100644 --- a/collects/framework/private/preferences.ss +++ b/collects/framework/private/preferences.ss @@ -1,8 +1,9 @@ (module preferences mzscheme - (require (lib "unitsig.ss") + (require (lib "string-constant.ss" "string-constants") + (lib "unitsig.ss") (lib "class.ss") (lib "class100.ss") - "sig" + "sig.ss" "../prefs-file-sig.ss" (lib "mred-sig.ss" "mred") (lib "pretty.ss") @@ -63,7 +64,7 @@ p (lambda () (raise exn))) - (message-box (format "Error unmarshalling ~a preference" p) + (message-box (format (string-constant error-unmarshalling) p) (if (exn? exn) (exn-message exn) (format "~s" exn))))))))) @@ -166,11 +167,7 @@ [unmarshalled (if (checker unmarsh) unmarsh - (begin - '(printf - "WARNING: rejected saved default ~s for ~s; using ~s instead" - unmarsh p in-default-value) - in-default-value))] + in-default-value)] [pref (if (check-callbacks p unmarshalled) unmarshalled in-default-value)]) @@ -210,7 +207,7 @@ (with-handlers ([(lambda (x) #t) (lambda (exn) (message-box - "Error saving preferences" + (string-constant error-saving-preferences) (exn-message exn)))]) (call-with-output-file (prefs-file:get-preferences-filename) (lambda (p) @@ -222,25 +219,31 @@ (let/ec k (let ([err (lambda (input msg) - (message-box "Preferences" - (let* ([max-len 150] - [s1 (format "~s" input)] - [ell "..."] - [s2 (if (<= (string-length s1) max-len) - s1 - (string-append - (substring s1 0 (- max-len - (string-length ell))) - ell))]) - (format "found bad pref in ~a: ~a~n~a" - preferences-filename msg s2))))]) + (message-box + (string-constant preferences) + (let* ([max-len 150] + [s1 (format "~s" input)] + [ell "..."] + [s2 (if (<= (string-length s1) max-len) + s1 + (string-append + (substring s1 0 (- max-len + (string-length ell))) + ell))]) + (string-append + (format (string-constant found-bad-pref) preferences-filename) + "\n" + msg + s2))) + (k #f))]) (let ([input (with-handlers - ([(lambda (exn) #t) + ([not-break-exn? (lambda (exn) (message-box - "Error reading preferences" - (format "Error reading preferences~n~a" - (exn-message exn))) + (string-constant error-reading-preferences) + (string-append + (string-constant error-reading-preferences) + (format "\n~a" (exn-message exn)))) (k #f))]) (call-with-input-file preferences-filename read @@ -248,28 +251,14 @@ (if (eof-object? input) (void) (let loop ([input input]) - (cond - [(pair? input) - (let ([err-msg - (let/ec k - (let ([first (car input)]) - (unless (pair? first) - (k "expected pair of pair")) - (let ([arg1 (car first)] - [t1 (cdr first)]) - (unless (pair? t1) - (k "expected pair of two pairs")) - (let ([arg2 (car t1)] - [t2 (cdr t1)]) - (unless (null? t2) - (k "expected null after two pairs")) - (parse-pref arg1 arg2) - (k #f)))))]) - (when err-msg - (err input err-msg))) - (loop (cdr input))] - [(null? input) (void)] - [else (err input "expected a pair")]))))))) + (when (pair? input) + (let ([pre-pref (car input)]) + (if (and (list? pre-pref) + (= 2 (length pre-pref))) + (parse-pref (car pre-pref) (cadr pre-pref)) + (err input (string-constant expected-list-of-length2)))) + (loop (cdr input))))))))) + ;; read-from-file-to-ht : string hash-table -> void (define (read-from-file-to-ht filename ht) @@ -320,7 +309,7 @@ (define (local-add-general-panel) (add-panel - "General" + (string-constant general-prefs-panel-label) (lambda (parent) (let* ([main (make-object vertical-panel% parent)] [make-check @@ -337,36 +326,39 @@ (send c set-value (pref->bool v))))))] [id (lambda (x) x)]) (send main set-alignment 'left 'center) - (make-check 'framework:highlight-parens "Highlight between matching parens" id id) - (make-check 'framework:fixup-parens "Correct parens" id id) - (make-check 'framework:paren-match "Flash paren match" id id) - (make-check 'framework:autosaving-on? "Auto-save files" id id) - (make-check 'framework:delete-forward? "Map delete to backspace" not not) + (make-check 'framework:highlight-parens (string-constant highlight-parens) id id) + (make-check 'framework:fixup-parens (string-constant fixup-parens) id id) + (make-check 'framework:paren-match (string-constant flash-paren-match) id id) + (make-check 'framework:autosaving-on? (string-constant auto-save-files) id id) + (make-check 'framework:delete-forward? (string-constant map-delete-to-backspace) + not not) - ;; not exposed to the user anymore. Only left in for automated testing. - ;(make-check 'framework:file-dialogs "Use platform-specific file dialogs" - ;(lambda (x) (if x 'std 'common)) - ;(lambda (x) (eq? x 'std))) + (make-check 'framework:verify-exit (string-constant verify-exit) id id) + (make-check 'framework:verify-change-format + (string-constant ask-before-changing-format) + id id) + (make-check 'framework:auto-set-wrap? (string-constant wrap-words-in-editor-buffers) + id id) - (make-check 'framework:verify-exit "Verify exit" id id) - (make-check 'framework:verify-change-format "Ask before changing save format" id id) - (make-check 'framework:auto-set-wrap? "Wrap words in editor buffers" id id) - - (make-check 'framework:show-status-line "Show status-line" id id) - (make-check 'framework:line-offsets "Count line and column numbers from one" id id) - (make-check 'framework:display-line-numbers "Display line numbers in buffer; not character offsets" id id) - (make-check 'framework:menu-bindings "Enable keybindings in menus" id id) + (make-check 'framework:show-status-line (string-constant show-status-line) id id) + (make-check 'framework:line-offsets (string-constant count-from-one) id id) + (make-check 'framework:display-line-numbers + (string-constant display-line-numbers) + id id) + (make-check 'framework:menu-bindings (string-constant enable-keybindings-in-menus) + id id) (unless (eq? (system-type) 'unix) - (make-check 'framework:print-output-mode "Automatically print to postscript file" + (make-check 'framework:print-output-mode + (string-constant automatically-to-ps) (lambda (b) (if b 'postscript 'standard)) (lambda (n) (eq? 'postscript n)))) '(when (eq? (system-type) 'windows) - (make-check 'framework:windows-mdi "Use MDI Windows" id id)) + (make-check 'framework:windows-mdi (string-constant use-mdi) id id)) (make-check 'framework:search-using-dialog? - "Use separate dialog for searching" + (string-constant separate-dialog-for-searching) id id) main))) @@ -427,10 +419,10 @@ number?) font-size-entry) (add-panel - "Default Fonts" + (string-constant default-fonts) (lambda (parent) (letrec ([font-size-pref-sym (build-font-preference-symbol font-size-entry)] - [ex-string "The quick brown fox jumped over the lazy dogs."] + [ex-string (string-constant font-example-string)] [main (make-object vertical-panel% parent)] [fonts (cons font-default-string (get-face-list))] [make-family-panel @@ -467,13 +459,13 @@ horiz)] [button (make-object button% - "Change" + (string-constant change-font-button-label) horiz (lambda (button evt) (let ([new-value (get-choices-from-user - "Fonts" - (format "Please choose a new ~a font" + (string-constant fonts) + (format (string-constant choose-a-new-font) name) fonts)]) (when new-value @@ -527,7 +519,7 @@ font-default-size))] [size-slider (make-object slider% - "Size" + (string-constant font-size-slider-label) 1 127 size-panel (lambda (slider evt) @@ -543,7 +535,7 @@ (send size-slider set-value value)) #t)) (for-each (lambda (f) (f initial-font-size)) set-edit-fonts) - (make-object message% "Restart to see font changes" main) + (make-object message% (string-constant restart-to-see-font-changes) main) main)))) (set! local-add-font-panel void)) @@ -589,7 +581,7 @@ (sub1 (length ppanels))))))))]) (sequence (apply super-init args))) - "Preferences")] + (string-constant preferences))] [panel (make-object vertical-panel% frame)] [popup-callback (lambda (choice command-event) @@ -598,7 +590,7 @@ (ppanel-panel (list-ref ppanels (send choice get-selection))))))] [make-popup-menu (lambda () - (let ([menu (make-object choice% "Category" + (let ([menu (make-object choice% (string-constant preferences-category) (map ppanel-title ppanels) panel popup-callback)]) (send menu stretchable-width #f) @@ -636,11 +628,13 @@ [ok-callback (lambda args (save) (hide-dialog))] - [ok-button (make-object button% "OK" bottom-panel ok-callback '(border))] + [ok-button (make-object button% (string-constant ok) + bottom-panel ok-callback '(border))] [cancel-callback (lambda args (hide-dialog) (-read))] - [cancel-button (make-object button% "Cancel" bottom-panel cancel-callback)] + [cancel-button (make-object button% (string-constant cancel) + bottom-panel cancel-callback)] [grow-box-space (make-object grow-box-spacer-pane% bottom-panel)]) (send ok-button min-width (send cancel-button get-width)) (send* bottom-panel diff --git a/collects/framework/private/scheme.ss b/collects/framework/private/scheme.ss index 064423a7..ac15088a 100644 --- a/collects/framework/private/scheme.ss +++ b/collects/framework/private/scheme.ss @@ -2,7 +2,8 @@ ;; 6/30/95 (module scheme mzscheme - (require (lib "unitsig.ss") + (require (lib "string-constant.ss" "string-constants") + (lib "unitsig.ss") (lib "class.ss") (lib "class100.ss") "sig" @@ -505,7 +506,7 @@ (cond [(let ([real-start (cdr (find-offset end))]) (and (<= (+ 3 real-start) (last-position)) - (string=? ";;" + (string=? ";;;" (get-text real-start (+ 2 real-start))))) (void)] @@ -970,7 +971,7 @@ (define (add-preferences-panel) (preferences:add-panel - "Indenting" + (string-constant indenting-prefs-panel-label) (lambda (p) (let*-values ([(get-keywords) @@ -994,8 +995,8 @@ (keymap:call/text-keymap-initializer (lambda () (get-text-from-user - (string-append "Enter new " keyword-type "-like keyword:") - (string-append keyword-type " Keyword"))))]) + (format (string-constant enter-new-keyword) keyword-type) + (format (string-constant x-keyword) keyword-type))))]) (when new-one (let ([parsed (with-handlers ((exn:read? (lambda (x) #f))) (read (open-input-string new-one)))]) @@ -1004,13 +1005,15 @@ (hash-table-get (preferences:get 'framework:tabify) parsed (lambda () #f))) - (message-box "Error" - (format "\"~a\" is already a specially indented keyword" parsed))] + (message-box (string-constant error) + (format (string-constant already-used-keyword) parsed))] [(symbol? parsed) (hash-table-put! (preferences:get 'framework:tabify) parsed keyword-symbol) (send list-box append (symbol->string parsed))] - [else (message-box "Error" (format "expected a symbol, found: ~a" new-one))]))))))] + [else (message-box + (string-constant error) + (format (string-constant expected-a-symbol) new-one))]))))))] [delete-callback (lambda (list-box) (lambda (button command) @@ -1023,11 +1026,13 @@ [make-column (lambda (string symbol keywords) (let* ([vert (make-object vertical-panel% main-panel)] - [_ (make-object message% (string-append string "-like Keywords") vert)] + [_ (make-object message% (format (string-constant x-like-keywords) string) vert)] [box (make-object list-box% #f keywords vert void '(multiple))] [button-panel (make-object horizontal-panel% vert)] - [add-button (make-object button% "Add" button-panel (add-callback string symbol box))] - [delete-button (make-object button% "Remove" button-panel (delete-callback box))]) + [add-button (make-object button% (string-constant add-keyword) + button-panel (add-callback string symbol box))] + [delete-button (make-object button% (string-constant remove-keyword) + button-panel (delete-callback box))]) (send* button-panel (set-alignment 'center 'center) (stretchable-height #f)) diff --git a/collects/framework/private/standard-menus-items.ss b/collects/framework/private/standard-menus-items.ss index 79e0f668..7751886f 100644 --- a/collects/framework/private/standard-menus-items.ss +++ b/collects/framework/private/standard-menus-items.ss @@ -1,4 +1,5 @@ (module standard-menus-items mzscheme + (provide (struct generic (name initializer)) @@ -179,7 +180,8 @@ 'file-menu '(make-object (get-menu%) (if (eq? (system-type) 'windows) - "&File" "F&ile") + (string-constant file-menu-label-windows) + (string-constant file-menu-label-other)) (get-menu-bar))) (make-generic-method 'get-edit-menu @@ -190,7 +192,9 @@ "@ilink frame:standard-menus get-menu\\%" "" "@return : (instance (derived-from \\iscmclass{menu}))")) - (make-generic-private-field 'edit-menu '(make-object (get-menu%) "&Edit" (get-menu-bar))) + (make-generic-private-field + 'edit-menu + '(make-object (get-menu%) (string-constant edit-menu-label) (get-menu-bar))) (make-generic-method 'get-help-menu '(lambda () help-menu) @@ -202,112 +206,165 @@ "@return : (instance (derived-from \\iscmclass{menu}))")) (make-generic-private-field 'help-menu - '(make-object (get-menu%) "&Help" (get-menu-bar))) + '(make-object (get-menu%) (string-constant help-menu-label) (get-menu-bar))) - (make-an-item 'file-menu 'new "Open a new file" + (make-an-item 'file-menu 'new + '(string-constant new-info) '(lambda (item control) (handler:edit-file #f) #t) - #\n "&New" "" + #\n + '(string-constant new-menu-item-before) + '(string-constant new-menu-item-after) on-demand-do-nothing) (make-between 'file-menu 'new 'open 'nothing) - (make-an-item 'file-menu 'open "Open a file from disk" + (make-an-item 'file-menu 'open '(string-constant open-info) '(lambda (item control) (handler:open-file) #t) - #\o "&Open" "..." + #\o + '(string-constant open-menu-item-before) + '(string-constant open-menu-item-after) on-demand-do-nothing) (make-between 'file-menu 'open 'revert 'nothing) (make-an-item 'file-menu 'revert - "Revert this file to the copy on disk" - #f #f "&Revert" "" + '(string-constant revert-info) + #f #f + '(string-constant revert-menu-item-before) + '(string-constant revert-menu-item-after) on-demand-do-nothing) (make-between 'file-menu 'revert 'save 'nothing) (make-an-item 'file-menu 'save - "Save this file to disk" - #f #\s "&Save" "" + '(string-constant save-info) + #f #\s + '(string-constant save-menu-item-before) + '(string-constant save-menu-item-after) on-demand-do-nothing) (make-an-item 'file-menu 'save-as - "Prompt for a filename and save this file to disk" - #f #f "Save" " &As..." + '(string-constant save-as-info) + #f #f + '(string-constant save-as-menu-item-before) + '(string-constant save-as-menu-item-after) on-demand-do-nothing) (make-between 'file-menu 'save-as 'print 'separator) (make-an-item 'file-menu 'print - "Print this file" - #f #\p "&Print" "..." + '(string-constant print-info) + #f #\p + '(string-constant print-menu-item-before) + '(string-constant print-menu-item-after) on-demand-do-nothing) (make-between 'file-menu 'print 'close 'separator) (make-an-item 'file-menu 'close - "Close this file" + '(string-constant close-info) '(lambda (item control) (when (can-close?) (on-close) (show #f)) #t) - #\w "&Close" "" + #\w + '(string-constant close-menu-item-before) + '(string-constant close-menu-item-after) on-demand-do-nothing) (make-between 'file-menu 'close 'quit 'nothing) (make-an-item 'file-menu 'quit - "Quit" - '(lambda (item control) (parameterize ([exit:frame-exiting this]) (exit:exit))) + '(string-constant quit-info) + '(lambda (item control) + (parameterize ([exit:frame-exiting this]) + (exit:exit))) #\q - '(if (eq? (system-type) 'windows) "E&xit" "Quit") - "" + '(if (eq? (system-type) 'windows) + (string-constant quit-menu-item-before-windows) + (string-constant quit-menu-item-before-others)) + '(string-constant quit-menu-item-after) on-demand-do-nothing) (make-after 'file-menu 'quit 'nothing) - (make-an-item 'edit-menu 'undo "Undo the most recent action" + (make-an-item 'edit-menu 'undo + '(string-constant undo-info) (edit-menu:do 'undo) - #\z "&Undo" "" + #\z + '(string-constant undo-menu-item) + "" (edit-menu:can-do-on-demand 'undo)) - (make-an-item 'edit-menu 'redo "Redo the most recent undo" + (make-an-item 'edit-menu 'redo + '(string-constant redo-info) (edit-menu:do 'redo) - #\y "&Redo" "" + #\y + '(string-constant redo-menu-item) + "" (edit-menu:can-do-on-demand 'redo)) (make-between 'edit-menu 'redo 'cut 'separator) - (make-an-item 'edit-menu 'cut "Cut the selection" + (make-an-item 'edit-menu 'cut '(string-constant cut-info) (edit-menu:do 'cut) - #\x "Cu&t" "" + #\x + '(string-constant cut-menu-item) + "" (edit-menu:can-do-on-demand 'cut)) (make-between 'edit-menu 'cut 'copy 'nothing) - (make-an-item 'edit-menu 'copy "Copy the selection" + (make-an-item 'edit-menu 'copy + '(string-constant copy-info) (edit-menu:do 'copy) - #\c "&Copy" "" + #\c + '(string-constant copy-menu-item) + "" (edit-menu:can-do-on-demand 'copy)) (make-between 'edit-menu 'copy 'paste 'nothing) - (make-an-item 'edit-menu 'paste "Paste the most recent copy or cut over the selection" + (make-an-item 'edit-menu 'paste + '(string-constant paste-info) (edit-menu:do 'paste) - #\v "&Paste" "" + #\v + '(string-constant paste-menu-item) + "" (edit-menu:can-do-on-demand 'paste)) (make-between 'edit-menu 'paste 'clear 'nothing) - (make-an-item 'edit-menu 'clear "Clear the selection without affecting paste" + (make-an-item 'edit-menu 'clear + '(string-constant clear-info) (edit-menu:do 'clear) #f - '(if (eq? (system-type) 'macos) - "Clear" - "&Delete") + '(if (eq? (system-type) 'windows) + (string-constant clear-menu-item-windows) + (string-constant clear-menu-item-windows)) "" (edit-menu:can-do-on-demand 'clear)) (make-between 'edit-menu 'clear 'select-all 'nothing) - (make-an-item 'edit-menu 'select-all "Select the entire document" + (make-an-item 'edit-menu 'select-all + '(string-constant select-all-info) (edit-menu:do 'select-all) - #\a "Select A&ll" "" + #\a + '(string-constant select-all-menu-item) + "" (edit-menu:can-do-on-demand 'select-all)) (make-between 'edit-menu 'select-all 'find 'separator) - (make-an-item 'edit-menu 'find "Search for a string in the window" #f - #\f "Find" "..." + + (make-an-item 'edit-menu 'find + '(string-constant find-info) + #f + #\f + '(string-constant find-menu-item-before) + '(string-constant find-menu-item-after) edit-menu:edit-target-on-demand) - (make-an-item 'edit-menu 'find-again "Search for the same string as before" #f - #\g "Find Again" "" + (make-an-item 'edit-menu 'find-again + '(string-constant find-again-info) + #f + #\g + '(string-constant find-menu-item-before) + '(string-constant find-menu-item-after) edit-menu:edit-target-on-demand) (make-an-item 'edit-menu 'replace-and-find-again - "Replace the current text and search for the same string as before" - #f #\h "Replace && Find Again" "" + '(string-constant replace-and-find-again-info) + #f #\h + '(string-constant replace-and-find-again-menu-item-before) + '(string-constant replace-and-find-again-menu-item-after) edit-menu:edit-target-on-demand) (make-between 'edit-menu 'find 'preferences 'separator) - (make-an-item 'edit-menu 'preferences "Configure the preferences" + (make-an-item 'edit-menu 'preferences + '(string-constant preferences-info) '(lambda (item control) (preferences:show-dialog) #t) - #\; "Preferences..." "" + #\; + '(string-constant preferences-menu-item-before) + '(string-constant preferences-menu-item-after) on-demand-do-nothing) (make-after 'edit-menu 'preferences 'nothing) (make-before 'help-menu 'about 'nothing) - (make-an-item 'help-menu 'about "Credits and details for this application" + (make-an-item 'help-menu 'about + '(string-constant about-info) #f #f - "About " - "..." + '(string-constant about-menu-item-before) + '(string-constant about-menu-item-after) + on-demand-do-nothing) (make-after 'help-menu 'about 'nothing)))) diff --git a/collects/framework/private/text.ss b/collects/framework/private/text.ss index 3857eeea..5e4126ef 100644 --- a/collects/framework/private/text.ss +++ b/collects/framework/private/text.ss @@ -1,5 +1,6 @@ (module text mzscheme - (require (lib "unitsig.ss") + (require (lib "string-constant.ss" "string-constants") + (lib "unitsig.ss") (lib "class.ss") (lib "class100.ss") "sig.ss" @@ -446,14 +447,18 @@ (eq? 'standard (get-file-format)) (or (not (preferences:get 'framework:verify-change-format)) (gui-utils:get-choice - "Save this file as plain text?" "Yes" "No"))) + (string-constant save-as-plain-text) + (string-constant yes) + (string-constant no)))) (set-file-format 'text)] [(and (not all-strings?) (or (eq? format 'same) (eq? format 'copy)) (eq? 'text (get-file-format)) (or (not (preferences:get 'framework:verify-change-format)) (gui-utils:get-choice - "Save this file in drscheme-specific non-text format?" "Yes" "No"))) + (string-constant save-in-drs-format) + (string-constant yes) + (string-constant no)))) (set-file-format 'standard)] [else (void)])) (super-on-save-file name format))