From 753cd127a6577931c0dc24d2232078088eba348e Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Mon, 19 Nov 2007 04:01:13 +0000 Subject: [PATCH] made the bottom line of the drscheme window be half as tall svn: r7762 --- collects/drscheme/private/auto-language.ss | 7 +- collects/drscheme/private/stick-figures.ss | 233 ++++++++---------- collects/drscheme/private/unit.ss | 189 +++++++------- collects/framework/private/frame.ss | 111 ++------- collects/framework/private/icon.ss | 4 +- collects/icons/b-run.png | Bin 0 -> 338 bytes collects/icons/b-wait.png | Bin 0 -> 304 bytes collects/icons/b-wait2.png | Bin 0 -> 315 bytes collects/icons/mrf.jpg | Bin 981 -> 0 bytes collects/icons/mrf.png | Bin 0 -> 4530 bytes collects/icons/recycle.gif | Bin 482 -> 0 bytes collects/icons/recycle.png | Bin 0 -> 1669 bytes collects/icons/run.png | Bin 399 -> 402 bytes collects/lang/htdp-langs.ss | 6 +- collects/mrlib/name-message.ss | 60 ++++- .../danish-string-constants.ss | 5 +- .../dutch-string-constants.ss | 5 +- .../english-string-constants.ss | 9 +- .../french-string-constants.ss | 7 +- .../german-string-constants.ss | 6 +- .../portuguese-string-constants.ss | 5 +- .../simplified-chinese-string-constants.ss | 6 +- .../spanish-string-constants.ss | 5 +- .../traditional-chinese-string-constants.ss | 6 +- 24 files changed, 291 insertions(+), 373 deletions(-) create mode 100644 collects/icons/b-run.png create mode 100644 collects/icons/b-wait.png create mode 100644 collects/icons/b-wait2.png delete mode 100644 collects/icons/mrf.jpg create mode 100644 collects/icons/mrf.png delete mode 100644 collects/icons/recycle.gif create mode 100644 collects/icons/recycle.png diff --git a/collects/drscheme/private/auto-language.ss b/collects/drscheme/private/auto-language.ss index 624a899c62..a79458ea2f 100644 --- a/collects/drscheme/private/auto-language.ss +++ b/collects/drscheme/private/auto-language.ss @@ -25,7 +25,12 @@ (when (equal? lang-spec spec-in-file) (set! found-language? lang) (set! settings (send lang metadata->settings str)) - (send text delete 0 (send text paragraph-start-position lines))))))))) + (let ([locked? (send text is-locked?)]) + (when locked? (send text lock #f)) + (printf "before ~s\n" (send text get-text 0 (send text last-position))) + (send text delete 0 (send text paragraph-start-position lines)) + (printf "after ~s\n" (send text get-text 0 (send text last-position))) + (when locked? (send text lock #t)))))))))) all-languages) ;; check to see if it looks like the module language. diff --git a/collects/drscheme/private/stick-figures.ss b/collects/drscheme/private/stick-figures.ss index 91d23e94ae..30111b5e44 100644 --- a/collects/drscheme/private/stick-figures.ss +++ b/collects/drscheme/private/stick-figures.ss @@ -3,15 +3,48 @@ (lib "pretty.ss") (lib "mred.ss" "mred")) - (provide running-canvas% - get-running-bitmap) - (define head-size 40) - (define running-factor 1/2) + (define small-bitmap-factor 1/2) (define small-factor 1/5) (define line-size 2) (define waiting-points + '((head 47 2) + (neck 46 15) + (shoulders 38 42) + (left-shoulder 18 39) + (right-shoulder 65 42) + (left-elbow 8 74) + (right-elbow 68 76) + (left-hand 24 79) + (right-hand 56 83) + (waist 37 87) + (left-knee 23 117) + (right-knee 57 117) + (left-ankle 21 149) + (right-ankle 59 148) + (left-toe 3 148) + (right-toe 79 145))) + + (define waiting-points/2 + '((head 47 2) + (neck 46 15) + (shoulders 38 42) + (left-shoulder 18 39) + (right-shoulder 65 42) + (left-elbow 8 74) + (right-elbow 68 76) + (left-hand 24 79) + (right-hand 56 83) + (waist 37 87) + (left-knee 23 117) + (right-knee 57 117) + (left-ankle 21 149) + (right-ankle 59 148) + (left-toe 3 148) + (right-toe 79 132))) + + (define waiting-points/old '((head 55 0) (neck 43 18) (shoulders 37 33) @@ -29,7 +62,7 @@ (left-toe 0 154) (right-toe 83 146))) - (define waiting-points/2 + (define waiting-points/2/old '((head 55 0) (neck 43 18) (shoulders 37 33) @@ -65,58 +98,6 @@ (left-toe 14 146) (right-toe 109 132))) - (define running-canvas% - (class canvas% - (inherit get-dc refresh get-client-size) - (define/public (set-running r?) - (unless (eq? r? is-running?) - (set! is-running? r?) - (refresh))) - (define is-running? #f) - (define toggle? #t) - (define timer #f) - (define inside? #f) - - (define/override (on-event evt) - (let-values ([(w h) (get-client-size)]) - (let ([new-inside? - (and (<= 0 (send evt get-x) w) - (<= 0 (send evt get-y) h))] - [old-inside? inside?]) - (set! inside? new-inside?) - (cond - [(and new-inside? (not old-inside?)) - (unless is-running? - (set! timer - (new timer% - [notify-callback - (λ () - (set! toggle? (not toggle?)) - (refresh))] - [interval 200])))] - [(and (not new-inside?) old-inside? timer) - (send timer stop) - (set! timer #f)])))) - - (define-values (w h running-dx running-dy waiting-dx waiting-dy) - (get-size-parameters)) - - (define/override (on-paint) - (if is-running? - (draw-callback (get-dc) small-factor #f - running-points - running-dx running-dy line-size) - (draw-callback (get-dc) small-factor #f - (if toggle? waiting-points waiting-points/2) - waiting-dx waiting-dy line-size))) - - (super-new [stretchable-width #f] - [stretchable-height #f] - [style '(transparent)]) - (inherit min-width min-height) - (min-width w) - (min-height h))) - (define (get-size-parameters) (let-values ([(min-rx min-ry) (get-max/min-x/y min running-points)] [(max-rx max-ry) (get-max/min-x/y max running-points)] @@ -134,59 +115,44 @@ [waiting-dy (+ 1 (- (/ h 2) (/ waiting-h 2)))]) (values w h running-dx running-dy waiting-dx waiting-dy)))) - (define running-bitmap #f) - (define (get-running-bitmap) - (unless running-bitmap - (let-values ([(min-rx min-ry) (get-max/min-x/y min running-points)] - [(max-rx max-ry) (get-max/min-x/y max running-points)]) - (let* ([margin 2] - [bw (+ margin margin (ceiling (* small-factor (- max-rx min-rx))))] - [bh (+ margin margin (ceiling (* small-factor (- max-ry min-ry))))] - [w (ceiling (* bw running-factor))] - [h (ceiling (* bh running-factor))] - [bm-big (make-object bitmap% bw bh)] - [bm-solid (make-object bitmap% w h)] - [bm-small (make-object bitmap% w h)] - [bdc-big (make-object bitmap-dc% bm-big)] - [bdc-solid (make-object bitmap-dc% bm-solid)] - [bdc-small (make-object bitmap-dc% bm-small)] - [green (make-object color% 30 100 30)]) - (send bdc-big clear) - (draw-callback bdc-big small-factor #f running-points - (+ margin (- (* small-factor min-rx))) - (+ margin (- (* small-factor min-ry))) - 3) - - (send bdc-small clear) - (send bdc-small set-scale running-factor running-factor) - (send bdc-small draw-bitmap bm-big 0 0) - (send bdc-small set-scale 1 1) - - (send bdc-solid set-brush green 'solid) - (send bdc-solid set-pen green 1 'solid) - (send bdc-solid draw-rectangle 0 0 w h) - - (send bdc-solid set-bitmap #f) - (send bdc-small set-bitmap #f) - (send bdc-big set-bitmap #f) - - (send bm-solid set-loaded-mask bm-small) - (set! running-bitmap bm-solid)))) - running-bitmap) - - (define (test-running-canvas) - (let* ([f (new frame% [label ""])] - [c (new running-canvas% [parent f])]) - (new button% [parent f] - [label "on"] - [callback - (λ (x y) (send c set-running #t))]) - (new button% [parent f] - [label "off"] - [callback - (λ (x y) (send c set-running #f))]) - (send f show #t))) + (define (get-bitmap points green) + (let-values ([(min-rx min-ry) (get-max/min-x/y min points)] + [(max-rx max-ry) (get-max/min-x/y max points)]) + (let* ([margin 2] + [bw (+ margin margin (ceiling (* small-factor (- max-rx min-rx))))] + [bh (+ margin margin (ceiling (* small-factor (- max-ry min-ry))))] + [w (ceiling (* bw small-bitmap-factor))] + [h (ceiling (* bh small-bitmap-factor))] + [bm-big (make-object bitmap% bw bh)] + [bm-solid (make-object bitmap% w h)] + [bm-small (make-object bitmap% w h)] + [bdc-big (make-object bitmap-dc% bm-big)] + [bdc-solid (make-object bitmap-dc% bm-solid)] + [bdc-small (make-object bitmap-dc% bm-small)]) + (send bdc-big clear) + (draw-callback bdc-big small-factor #f points + (+ margin (- (* small-factor min-rx))) + (+ margin #;(- (* small-factor min-ry))) + 3) + + (send bdc-small clear) + (send bdc-small set-scale small-bitmap-factor small-bitmap-factor) + (send bdc-small draw-bitmap bm-big 0 0) + (send bdc-small set-scale 1 1) + + (send bdc-solid set-brush green 'solid) + (send bdc-solid set-pen green 1 'solid) + (send bdc-solid draw-rectangle 0 0 w h) + + (send bdc-solid set-bitmap #f) + (send bdc-small set-bitmap #f) + (send bdc-big set-bitmap #f) + + (send bm-solid set-loaded-mask bm-small) + bm-solid))) + (define (get-running-bitmap) (get-bitmap running-points (make-object color% 30 100 30))) + (define (get-waiting-bitmap) (get-bitmap waiting-points (make-object color% 30 100 30))) (define (normalize points) (let-values ([(min-x min-y) (get-max/min-x/y min points)]) @@ -258,7 +224,7 @@ (+ dy (* factor (list-ref to-p 2))))))) ;; Use this thunk to edit the points. - ;; Click the 'show' button to print out the pionts and then + ;; Click the 'show' button to print out the points and then ;; copy and paste them back into this file. (define (edit-points points) (define c% @@ -325,6 +291,7 @@ (draw-callback dc small-factor #f waiting-points 30 0 line-size) (draw-callback dc small-factor #f points 30 50 line-size) (draw-callback dc small-factor #f points 0 50 line-size))])) + (define cbitmap (new message% [label (get-bitmap points (send the-color-database find-color "black"))] [parent cp])) (define bp (new horizontal-panel% [parent f] [stretchable-height #f])) (new button% [parent bp] @@ -339,30 +306,36 @@ (λ (x y) (set! show-dots? (not show-dots?)) (send cbig refresh))]) + (new button% + [parent bp] + [label "Bitmap"] + [callback + (λ (x y) + (send cbitmap set-label (get-bitmap points (send the-color-database find-color "black"))))]) (send f show #t)) - #; (let () (define f (new frame% [label ""])) - (define m (new message% [label (get-running-bitmap)] [parent f])) + (define hp (new horizontal-panel% [parent f])) + (define left-column (new vertical-panel% [parent hp])) + (define right-column (new vertical-panel% [parent hp])) + (define green-rb (get-running-bitmap)) + (define black (send the-color-database find-color "black")) + (define rb (get-bitmap running-points black)) + (define wb (get-bitmap waiting-points black)) + (define wb2 (get-bitmap waiting-points/2 black)) + (define rm (new message% [label rb] [parent left-column])) + (define grm (new message% [label green-rb] [parent right-column])) + (new message% [label wb] [parent left-column]) + (new message% [label wb2] [parent left-column]) + (new message% [label wb2] [parent right-column]) + (new message% [label wb] [parent right-column]) (new grow-box-spacer-pane% [parent f]) - (send (get-running-bitmap) save-file (build-path (collection-path "icons") "run.png") 'png) + (send green-rb save-file (build-path (collection-path "icons") "run.png") 'png) + (send rb save-file (build-path (collection-path "icons") "b-run.png") 'png) + (send wb save-file (build-path (collection-path "icons") "b-wait.png") 'png) + (send wb2 save-file (build-path (collection-path "icons") "b-wait2.png") 'png) (send f show #t)) - - #; - (let () - (define f (new frame% [label ""])) - (define c (new running-canvas% [parent f])) - (new button% - [label "Run"] - [parent f] - [callback (λ (x y) (send c set-running #t))]) - (new button% - [label "Wait"] - [parent f] - [callback (λ (x y) (send c set-running #f))]) - (send c set-running #t) - (send f show #t)) - - #;(edit-points waiting-points) + + #;(edit-points waiting-points/2) #;(edit-points running-points)) diff --git a/collects/drscheme/private/unit.ss b/collects/drscheme/private/unit.ss index 56369419ed..d010a5fe07 100644 --- a/collects/drscheme/private/unit.ss +++ b/collects/drscheme/private/unit.ss @@ -23,8 +23,7 @@ module browser threading seems wrong. (lib "framework.ss" "framework") (lib "name-message.ss" "mrlib") (lib "bitmap-label.ss" "mrlib") - - "stick-figures.ss" + (lib "include-bitmap.ss" "mrlib") "drsig.ss" "auto-language.ss" @@ -395,7 +394,7 @@ module browser threading seems wrong. (λ (x) x) text:info%)))))))))]) (class* definitions-super% (definitions-text<%>) - (inherit get-top-level-window) + (inherit get-top-level-window is-locked? lock) (define interactions-text #f) (define/public (set-interactions-text it) @@ -471,8 +470,11 @@ module browser threading seems wrong. (let ([metadata (send lang get-metadata (filename->modname filename) settings)]) (begin-edit-sequence) (begin-metadata-changes) - (set! save-file-metadata metadata) - (insert metadata 0 0))))) + (let ([locked? (is-locked?)]) + (when locked? (lock #f)) + (set! save-file-metadata metadata) + (insert metadata 0 0) + (when locked? (lock #t))))))) (define/private (filename->modname filename) (let-values ([(base name dir) (split-path filename)]) (string->symbol (regexp-replace #rx"\\.[^.]*$" @@ -489,8 +491,11 @@ module browser threading seems wrong. (let-values ([(creator type) (file-creator-and-type filename)]) (file-creator-and-type filename #"DrSc" type)))))) (when save-file-metadata - (let ([modified? (is-modified?)]) + (let ([modified? (is-modified?)] + [locked? (is-locked?)]) + (when locked? (lock #f)) (delete 0 (string-length save-file-metadata)) + (when locked? (lock #t)) (set! save-file-metadata #f) ;; restore modification status to where it was before the metadata is removed (set-modified modified?) @@ -3364,17 +3369,15 @@ module browser threading seems wrong. (define language-message (let* ([info-panel (get-info-panel)] - [vp (new vertical-panel% - [parent info-panel] - [alignment '(left center)] - [stretchable-width #t] - [stretchable-height #f])] - [l-m-label (new language-label-message% [parent vp] [frame this])] - [language-message (new language-message% [parent vp])]) + [p (new vertical-panel% + [parent info-panel] + [alignment '(left center)])] + [language-message (new language-label-message% [parent p] [frame this])]) (send info-panel change-children (λ (l) - (list* vp - (remq* (list vp) l)))) + (list* p + (remq* (list p) + l)))) language-message)) (update-save-message) @@ -3401,6 +3404,66 @@ module browser threading seems wrong. (set! newest-frame this) (send definitions-canvas focus))) + (define running-bitmap (include-bitmap (lib "b-run.png" "icons"))) + (define waiting-bitmap (include-bitmap (lib "b-wait.png" "icons"))) + (define waiting2-bitmap (include-bitmap (lib "b-wait2.png" "icons"))) + (define running/waiting-bitmaps (list running-bitmap waiting-bitmap waiting2-bitmap)) + (define running-canvas% + (class canvas% + (inherit get-dc refresh get-client-size) + (define/public (set-running r?) + (unless (eq? r? is-running?) + (set! is-running? r?) + (refresh))) + (define is-running? #f) + (define toggle? #t) + (define timer #f) + (define inside? #f) + + (define/override (on-event evt) + (let-values ([(w h) (get-client-size)]) + (let ([new-inside? + (and (<= 0 (send evt get-x) w) + (<= 0 (send evt get-y) h))] + [old-inside? inside?]) + (set! inside? new-inside?) + (cond + [(and new-inside? (not old-inside?)) + (unless is-running? + (set! timer + (new timer% + [notify-callback + (λ () + (set! toggle? (not toggle?)) + (refresh))] + [interval 200])))] + [(and (not new-inside?) old-inside? timer) + (send timer stop) + (set! timer #f)])))) + + (define/override (on-paint) + (let ([dc (get-dc)] + [bm + (if is-running? + running-bitmap + (if toggle? + waiting-bitmap + waiting2-bitmap))]) + (let-values ([(cw ch) (get-client-size)]) + (send dc draw-bitmap bm + (- (/ cw 2) (/ (send bm get-width) 2)) + (- (/ ch 2) (/ (send bm get-height) 2)) + 'solid + (send the-color-database find-color "black") + (send bm get-loaded-mask))))) + + (super-new [stretchable-width #f] + [stretchable-height #f] + [style '(transparent)]) + (inherit min-width min-height) + (min-width (apply max (map (λ (x) (send x get-width)) running/waiting-bitmaps))) + (min-height (apply max (map (λ (x) (send x get-height)) running/waiting-bitmaps))))) + ;; get-mbytes : top-level-window -> (union #f ;; cancel ;; integer[>=100] ;; a limit ;; #t) ;; no limit @@ -3530,86 +3593,21 @@ module browser threading seems wrong. (loop (cdr l)) (cons (car l) (loop (cdr l))))])))) - (define programming-language-label (string-constant programming-language-label)) - (define second-line-indent 6) - (define language-message% - (class canvas% - (inherit get-dc get-client-size refresh) - (define message "") - (define to-draw-message #f) - (define/public (set-lang l) - (unless (equal? l message) - (set! message l) - (compute-new-string) - (refresh))) - - (define yellow? #f) - - (define/public (set-yellow/lang y? l) - (unless (and (equal? y? yellow?) - (equal? l message)) - (set! yellow? y?) - (set! message l) - (compute-new-string) - (refresh))) - - (define/override (on-size w h) - (compute-new-string) - (refresh)) - - (define/private (compute-new-string) - (let-values ([(cw ch) (get-client-size)]) - (let ([width-to-use (- cw (get-left-side-padding))]) - (let loop ([c (string-length message)]) - (cond - [(= c 0) (set! to-draw-message "")] - [else - (let ([candidate (if (= c (string-length message)) - message - (string-append (substring message 0 c) "..."))]) - (let-values ([(tw th _1 _2) (send (get-dc) get-text-extent candidate small-control-font)]) - (cond - [(tw . <= . width-to-use) (set! to-draw-message candidate)] - [else - (loop (- c 1))])))]))))) - - (define/public (set-yellow y?) - (unless (equal? y? yellow?) - (set! yellow? y?) - (refresh))) - - (define last-time-width 0) - (define last-time-string "") - - (define/override (on-paint) - (unless to-draw-message - (compute-new-string)) - (let ([dc (get-dc)]) - (send dc set-font small-control-font) - (let*-values ([(tw th _1 _2) (send dc get-text-extent to-draw-message)] - [(w h) (values (+ tw (get-left-side-padding)) th)]) - (send dc set-pen (get-panel-background) 1 'transparent) - (send dc set-brush (get-panel-background) 'transparent) - (send dc draw-rectangle 0 0 w h) - (when yellow? - (send dc set-pen "black" 1 'transparent) - (send dc set-brush "yellow" 'solid) - (send dc draw-rectangle (get-left-side-padding) 0 tw th)) - (send dc draw-text to-draw-message (get-left-side-padding) 0)))) - - (super-new [style '(transparent)]) - (inherit stretchable-width stretchable-height) - (stretchable-width #t) - (stretchable-height #f) - - (inherit min-height) - (let ([dc (get-dc)]) - (let-values ([(w2 h2 _3 _4) (send dc get-text-extent "x" small-control-font)]) - (min-height (inexact->exact (floor h2))))))) - (define language-label-message% (class name-message% (init-field frame) + (inherit refresh) + + (inherit set-message) + (define yellow? #f) + (define/override (get-background-color) (and yellow? "yellow")) + (define/public (set-yellow y?) + (set! yellow? y?) + (refresh)) + (define/public (set-yellow/lang y? lang) + (set-message #f lang) + (set-yellow y?)) + (define/override (fill-popup menu reset) (let ([added-one? #f]) (send (new menu-item% @@ -3658,8 +3656,11 @@ module browser threading seems wrong. (λ (x y) (send frame choose-language-callback))])) - (super-new [label programming-language-label] - [font tiny-control-font]))) + (super-new [label ""] + [font small-control-font]) + + (inherit set-allow-shrinking) + (set-allow-shrinking 100))) (define -frame% (frame-mixin super-frame%)) diff --git a/collects/framework/private/frame.ss b/collects/framework/private/frame.ss index d19023cf70..3fd0da0548 100644 --- a/collects/framework/private/frame.ss +++ b/collects/framework/private/frame.ss @@ -254,10 +254,7 @@ (super-new) (send (group:get-the-frame-group) insert-frame this))) - (define locked-message-line1 (string-constant read-only-line1)) - (define locked-message-line2 (string-constant read-only-line2)) - (define unlocked-message-line1 (string-constant read/write-line1)) - (define unlocked-message-line2 (string-constant read/write-line2)) + (define locked-message (string-constant read-only)) (define lock-canvas% (class canvas% @@ -272,38 +269,26 @@ (define/override (on-paint) (let* ([dc (get-dc)] [draw - (λ (str1 str2 bg-color bg-style line-color line-style) + (λ (str bg-color bg-style line-color line-style) (send dc set-font small-control-font) (let-values ([(w h) (get-client-size)] - [(tw1 th1 _1 _2) (send dc get-text-extent str1)] - [(tw2 th2 _3 _4) (send dc get-text-extent str2)]) + [(tw th _1 _2) (send dc get-text-extent str)]) (send dc set-pen (send the-pen-list find-or-create-pen line-color 1 line-style)) (send dc set-brush (send the-brush-list find-or-create-brush bg-color bg-style)) (send dc draw-rectangle 0 0 w h) - (cond - [(string=? str2 "") - (send dc draw-text str1 - (- (/ w 2) (/ tw1 2)) - (- (* h 1/2) (/ th1 2)))] - [else - (send dc draw-text str1 - (- (/ w 2) (/ tw1 2)) - (- (* h 1/2) th1)) - (send dc draw-text str2 - (- (/ w 2) (/ tw2 2)) - (* h 1/2))])))]) + (send dc draw-text str + (- (/ w 2) (/ tw 2)) + (- (/ h 2) (/ th 2)))))]) (when locked? - (draw locked-message-line1 locked-message-line2 - "yellow" 'solid "black" 'solid)))) + (draw locked-message "yellow" 'solid "black" 'solid)))) (inherit get-parent min-width min-height stretchable-width stretchable-height) (define/private (setup-sizes) (let ([dc (get-dc)]) (if locked? - (let-values ([(wl1 hl1 _1 _2) (send dc get-text-extent locked-message-line1)] - [(wl2 hl2 _3 _4) (send dc get-text-extent locked-message-line2)]) - (min-width (inexact->exact (floor (+ 2 (max (+ wl1 2) (+ wl2 2)))))) - (min-height (inexact->exact (floor (+ 2 hl1 hl2))))) + (let-values ([(w h _1 _2) (send dc get-text-extent locked-message)]) + (min-width (inexact->exact (floor (+ w 4)))) + (min-height (inexact->exact (floor (+ h 2))))) (begin (min-width 0) (min-height 0))))) @@ -315,58 +300,6 @@ (stretchable-width #f) (stretchable-height #t))) - #; - (define lock-canvas% - (class canvas% - (field [locked? #f]) - (inherit refresh) - (define/public (set-locked l) - (set! locked? l) - (refresh)) - (inherit get-client-size get-dc) - (define/override (on-paint) - (let* ([dc (get-dc)] - [draw - (λ (str1 str2 bg-color bg-style line-color line-style) - (send dc set-font small-control-font) - (let-values ([(w h) (get-client-size)] - [(tw1 th1 _1 _2) (send dc get-text-extent str1)] - [(tw2 th2 _3 _4) (send dc get-text-extent str2)]) - (send dc set-pen (send the-pen-list find-or-create-pen line-color 1 line-style)) - (send dc set-brush (send the-brush-list find-or-create-brush bg-color bg-style)) - (send dc draw-rectangle 0 0 w h) - (cond - [(string=? str2 "") - (send dc draw-text str1 - (- (/ w 2) (/ tw1 2)) - (- (* h 1/2) (/ th1 2)))] - [else - (send dc draw-text str1 - (- (/ w 2) (/ tw1 2)) - (- (* h 1/2) th1)) - (send dc draw-text str2 - (- (/ w 2) (/ tw2 2)) - (* h 1/2))])))]) - (if locked? - (draw locked-message-line1 locked-message-line2 - "yellow" 'solid "black" 'solid) - (draw unlocked-message-line1 unlocked-message-line2 - (get-panel-background) 'transparent (get-panel-background) 'transparent)))) - (inherit get-parent min-width min-height stretchable-width stretchable-height) - - (super-new [style '(transparent)]) - - (let ([dc (get-dc)]) - (send dc set-font small-control-font) - (let-values ([(wl1 hl1 _1 _2) (send dc get-text-extent locked-message-line1)] - [(wl2 hl2 _3 _4) (send dc get-text-extent locked-message-line2)] - [(wu1 hu1 _5 _6) (send dc get-text-extent unlocked-message-line1)] - [(wu2 hu2 _7 _8) (send dc get-text-extent unlocked-message-line2)]) - (stretchable-width #f) - (stretchable-height #t) - (min-width (inexact->exact (floor (+ 2 (max (+ wl1 2) (+ wl2 2) wu1 wu2))))) - (min-height (inexact->exact (floor (+ 2 hu1 hu2)))))))) - (define status-line<%> (interface (basic<%>) open-status-line @@ -987,34 +920,26 @@ (define-values (anchor-message overwrite-message macro-recording-message) - (let* ([text-info-messages-parent - (new vertical-panel% - [parent (get-info-panel)] - [stretchable-width #f])] - [anchor-message + (let* ([anchor-message (new message% [font small-control-font] [label (string-constant auto-extend-selection)] - [parent text-info-messages-parent])] - [hp (new horizontal-panel% - [alignment '(left center)] - [parent text-info-messages-parent] - [stretchable-height #f])] + [parent (get-info-panel)])] [overwrite-message (new message% [font small-control-font] [label (string-constant overwrite)] - [parent hp])] + [parent (get-info-panel)])] [macro-recording-message (new message% [label "c-x;("] [font small-control-font] - [parent hp])]) + [parent (get-info-panel)])] + [msgs (list anchor-message + overwrite-message + macro-recording-message)]) (send (get-info-panel) change-children - (λ (l) - (cons - text-info-messages-parent - (remq text-info-messages-parent l)))) + (λ (l) (append msgs (remq* msgs l)))) (values anchor-message overwrite-message macro-recording-message))) diff --git a/collects/framework/private/icon.ss b/collects/framework/private/icon.ss index e9fb159dfb..718f8e5fce 100644 --- a/collects/framework/private/icon.ss +++ b/collects/framework/private/icon.ss @@ -44,8 +44,8 @@ (define get-up/down-cursor (make-get-cursor "up-down-cursor.xbm" "up-down-mask.xbm" 'size-n/s)) (define get-left/right-cursor (make-get-cursor "left-right-cursor.xbm" "left-right-mask.xbm" 'size-e/w)) - (define mrf-on-bitmap (delay (include-bitmap (lib "mrf.jpg" "icons")))) - (define gc-on-bitmap (delay (include-bitmap (lib "recycle.gif" "icons")))) + (define mrf-on-bitmap (delay (include-bitmap (lib "mrf.png" "icons")))) + (define gc-on-bitmap (delay (include-bitmap (lib "recycle.png" "icons")))) (define (make-off-bitmap onb) (let* ([bitmap (make-object bitmap% diff --git a/collects/icons/b-run.png b/collects/icons/b-run.png new file mode 100644 index 0000000000000000000000000000000000000000..7d2f35aea9e2ae5cce0cf3003c3cdd02e07b861a GIT binary patch literal 338 zcmV-Y0j>UtP)JQ?j#DvaqtUvQ)G6@(E;RkKH7t6xm2# z28;il@o#d?45x10m*<@4obHp+KJqAr{Q>U(B2d9+SQX^6ZHg4phw*SeMX{p^X$0%& zZL?V&J-CwCe!?DheMhOsi3wzIh!-pcf#*Ox!%A3rh{ajP6jo726@#M5@yl)8yO0zj@Q`4P%}~^j&X;19N{epmRc2< z!G~l%YM2fpbIr&FoCJYK{yWk+#P;-G>Y>52ETCiIFfn395sHuv~ kMHc6h0s0pPVjWt+7yH{qW$O&)Bme*a07*qoM6N<$g82%Q^#A|> literal 0 HcmV?d00001 diff --git a/collects/icons/b-wait.png b/collects/icons/b-wait.png new file mode 100644 index 0000000000000000000000000000000000000000..54018fa117022cdfcd1b0c1de83549dfdb79ff00 GIT binary patch literal 304 zcmV-00nh%4P)qP|&38HB-2 zz6R&kFx4ZqmQ4 zVHho(RH1sjYxuwcdhizeO;snI;Su+Vb&0KX;t*!BgYBr-aD|B!oJTLND=s&fObe@F z^M$*}$MJxdHq?c4>;}{qb_J#}Cv(ODJjKLjwV7%??3)2EbOPUT?B}ePcukx2B=5%s zK5>M>PGC-pSZ;&2u~Sa_*bw_{Vl*0u$=kxIIK(%d;5_fT4DLw)0000s5D4UG=wOQ zOF_g|?2#sT$`p-mr}hyu^HCMWqAW;U=-pu$n6NVG8S5i+Tm87)gmU=)_sUVH+*sS6zW-3Di6Xeg+!Z{AHBVXkcF0mlryDz$XL9mY@zlZ<; N002ovPDHLkV1moShGzf( literal 0 HcmV?d00001 diff --git a/collects/icons/mrf.jpg b/collects/icons/mrf.jpg deleted file mode 100644 index 460e305556cbdd89f782bc66821e707ed5f3fa6c..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 981 zcmex=^(PF6}rMnOeST|r4lSw=>~TvNxu(8R<c1}I=;VrF4wW9Q)H;sz?% zD!{d!pzFb!U9xX3zTPI5o8roG<0MW4oqZMDikqloVbuf*=gfJ(V&YTRE(2~ znmD<{#3dx9RMpfqG__1j&CD$#!<&DKKmNRY7Ax;nbAG$)V+S-1W@QVWOwiu}^AFeIdoBAl$?vrtQSBXk}MLJ8J zveGQ?SucFItU0-UOJqsE$oZxBjP`7>j9K__#|it6qlQw?qSwwYm}|hsu_j_~OCO$g-L{Q1`nb3;449d!1l)AJx3rzNUE-Q99 tS7!AqLq)rg2=%_~OLaUwufD&#vvK?R%Q_m1HnoVPtjX5gdGyZzn*f_^hGqZ& diff --git a/collects/icons/mrf.png b/collects/icons/mrf.png new file mode 100644 index 0000000000000000000000000000000000000000..58d03af45e3b0c194fd2f8b385086b79ba6d37dc GIT binary patch literal 4530 zcmV;j5l!xiP)4Tx0C=38S9v(p?bkow?~Jjpd8CMuwL+HcOBnk)_N8PQW60RXSW79CrIHp= zTF|1j*t4W0$-b6~D54O_60*(vhn}A6{k`w+`d#n)`QyGm=X0NP?sM+@kNY|RJomjq zLZ~PJ1P0M*b|waR7gskt^IKpCZr}wu(DEXMh3FHBmhf+}&<@`jEp&09>*F;NufU3IyOf3xKo-1_t{8 z@OT1%3@L<02jEEp00|dYH~dD)o{j)&S^&&P|ItEC0gA`~_}+gsNezI_hXC$%{G-j; z0RjMsKu4IbvJwCQARGn&OoI%@oD=}_Ie@iv24f|c!C1=!zK;FpZZ!?{JWZ^Yr*^Hb@ZM0pmj(g^U&AtEtcitb zhS`9Hh^4NTopp#!0x`?B)UM5b)M4F8z**jf;OgiWxbMjRH23TScRU_>R(L(}eoA`g z^Nd{MTS+PLEA)SKupl6xdMhwD=tl63kgK8BXnA3`=y$`5BB~=_M72lv$4nerjpaNd za#ShK;F!^I{dnyJ^+c5u3MXZgq?5%{L{bG$@t@{C!qv_t!t&7|)r@UBAh7OZ2wV9n*aGyJ7c|3v%vPJ?MToQHT}^ z6)TmPl+U3HQ#@byA3H#cm0#ns5(#L|p5 zueAJZ{n0kr{;gxU^Fvo#_w%0O*ST*__eQ++cxU{6M;}|?_x|<|1p~>0l#fQA#D|cf z;o%pbZ;ix`5=NK5z|C6;+nekUHyC0wA1wP5C0!CGxV9I z+34Bjx#+pY`SAI3jCUmO?3NXgqsmt(fTFe1dF3G$X;rFPnfj8ZhE}9@kM-Q^!Kv4|%cae=(XDP@&HhUF z(gU|Vl0B(j*512GT%<{#X7XL%lN7R_k-yAAwu6%a-PG#9yr8t;*pQ%5Z<*(s3+(W5{Lu1{K7#)?5+j0zZZ0h*C__~CLi5E{CI!R8lOjb@2Oj%7G zI@Nmm#hKc)sdbFTGHDu_UAN((}xwthbj(uPk0=zb1ZN_s0I5*xa1FrkiuO zh3^pZZSPv$Gb=E?Z}>p(q0S@CLbW2*Vzm;DQk^pWa^uI=70#93Re{y9PtMe2KP`Cn zq_*SvVBMz|ef95Nb~SXoYHMt1YHF@;X>4t3Yie)qc-`68^|5=rXZ{WJa=sOQC-+{z z&!OMrgUf*4;P#Km$B&Z4R`rv%o#nn~V^`qO(eF6LB z_m8?~9xy+!=27HH_7d{y_D&}0krsU(ktx2SzHcdMex`ow{v`(w28aZ7QxgN#0>^@~ zg3W@LLmq^B(gbL2VF`2{`eJxVL};W!N46dLdbBVu@)+Sb z$MN3y+=TE%qZ5KBrcTx;WhY0bIHjtd5GX5^&l4_4Uu3&DmC<#n zGP69Z@bbeecd~C?&AXO!{rZi|IoEQp=Uu;fbJjtx-e8y5sc%D%AvYzcFu_5c#K$A>!SW9IauHCBR zLT7)sbWh~##$M64k?-F0>GhWmC=Zr>G9LQ$`Ru6GSAntRiOI>uX^|Q4xyl8lrLL9B z>lzFOz{cMP0Dw~kxa0)jybfSL0+4D4AiWbnARmCp3E-ds=m!}<9by2v#P;X^-~k!f z3yyFQ;@|@0Lp5~3F#JSV5Ftb!(MKE*3UUZZL-LRcqzxHHmQZd~8r_S!pfvO}dJk|nHW9WkwkCEwdo+6wha$%rjwwzX&QdOEuIt?V+-W=+ma%?RX@(|_}uGtnQA|o;&nt>;Zaf-EUPZc+p z;F9Q)JSXKWy-j*p=Jt-DovJ(6cD^WeP-5S-f!{Ea>*KF!%Y;jm9$f~ z*Ksg%Bs#e`d%93vBi$1ArR~plFE~)`(dPNlYnH_BBS|LsMpG*N<`2pTgi=ca7lQYO zoDA&@+e-HdFOI}UIY#HlEFZRuy?bOmZr`!$c;STD#KDu=Nq16sQcs>*JrkL>m>zeY z`@;1MjZ6JmF;}){cVCOUp_KDAFZ&kp4ko|iUdsL34@Zi2mn4*Zsc^3vs!6ETdcoU( zY1-Us)N!(Vq}Tj?&w%F;`^d|&6O*n##OJ;*-d_n|FaSURl)wro5C@mwA-se>m`1RO zAR>$CBaX;H24LX3XW5h6~m{81BOa~T=)xkz# z%dzuJ%1mKQrA!MrE!;8OD`sA1H|Cqnvn={7XIX|=RajG4huE~(GT3I>iR^_O{2Wmn zgPbOurCiEfkGZwD>v?Q=-t$s;m-v!5iEJw6x8fiBD_%fM;Q3}BK~}*>Tb#F|TOSFz z3v&oR-8u6N`TIt%?bn=PX_9UnN=IJdhDx=y(*?`Lx7J|O6U_muM5Z7VmBQj9!-nuIlejGEg?H`_@q`+ zZVEOv^wirkd(-mM`Od|kAHV33QJ1NZb>Z@QHuY-Hb?qBBb2;+DZoa>*dne~E>%9~A zWgZMa$}RFQQ7L7VzpE&#I{zg0X<)5q-M)H{22vxfIkxp;dwyp__t=}Vcjx+p2Q7!x zM#R6eO<*Qhr{`yve$FqguktY%0I&myK!bBo2yHNipolP{idZ8QjYDsuE$C0oc8nwD45k&!jkU*K!G2*$lK4CyD5a<^e;&P7J-?~LxMe9nzz;q z)e2W^%N02(O2<>gytaFZQzXJAu(`V)civ}w*>t>>*ZM(gVL#vaybAv0v?fHIf z_eu{n&vNfQq$gw@-&cM%{>=ea)RrKV;QCN)S|MFL{9+_~RBZI@A@9QjN9>Na9J4y! znc$Sz_y2e+T0!pv^@mxHeigYCmzA=Xd6bt`uv9u%cel7oo-dp(&d2i5{*xxXK4yt|h{d8{V@o@j=_0cU~ zc7HV(vlzFXu>EE|X+EX#U22+h`sa_HnZntGIp=w?`H7!}3t@|U7N?eO|8ic&Etjsi zuB@--tr@M2F~k`RfQ@+x007ts!PHf1kk(031Qy);0jZ2LSb9 z5%xv^zykoizW&B$zxfv*FGC9e5C(vS7(aqF0B`^xe7-beyNy^xGyw@{-~~Z{D+&b);|i;P_6ZOSR0xKDA~se$kpArWgAWA%Pu;`+I4!W) zHzG4QTGPp|ee&_-pBx+gc>k%^0;oWSaG(Jhg8rq4|9%o|%+de=I39rPeEvI%8PCt-+n)GHoZaqrODk1SDwYSj z{PRetJRr&wZG}Lvn{Gl|)f*p4e2ncm_&)sC``?k4NX=Tz+kgH&)(1JMs%q|cJJ)m5 zG!DY(?Ba5nudqpGEdfbof^n$3+rR&8%33MShmrHyAi#Uxp1Qg@Z9jkc;m4bc#}`T= zP+}g2`PbLK>^8Ta<4PgD}%>&vB4aFk#`Q(UTX?_aC;+VXTUWrmAjU z-C%`@L6B4~A>Tc_TBk8{sFo9GrNM-6Uwr-M(`P+TfoJPnmr zO29Ad}p(1qe0qK_HCz$YaYs z481AUd77Kx3N3e=`?l?EOtr$`SQH}wFb|*Z&%eD{vk<(+=6>68t~6Sv%XJdBbv07zN)fa0e>vT4jJ#}o QsQ>@~07*qoM6N<$f*8unO#lD@ literal 0 HcmV?d00001 diff --git a/collects/icons/recycle.gif b/collects/icons/recycle.gif deleted file mode 100644 index 403673fd7ac0b4d9336ec46fc34decfc0c184553..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 482 zcmZ?wbh9u|RA5kK_`<-DexAXjLBJtgbJOMxpFVxMedl)k0fz9kOu3CwnpWaralT0z zF%=&e>i;vi#A*Hi|KA}?V$Qr-2~%_#hyywxWgxp4SpPjx?n}v>m*L6d^;)axf}3lV z*rkhaY$iCcF)J8sm@2{($1f!CiHT)##)9B?b&jeEpCoj;)R~krZCw-?vYnM0R1Pe2 za=05HB9N(lSm41TkrK8TW}y-WZcU368y$HS7DDBId7`8e0VwAx_2wncO`|Y4Geb}4Fo^E zu_$wHViNpRVe=)euf5q_ZG}(Elomz?j+;tfvI-OqYO~g5$e0-1R658%oy%aE_LUbR z4X*scmohJKoa->O<8ufW5@xcHV{@BZaG6Es)Wni|Jjq2N2X~h;=UZ?DY`tSO!HnZc vz~tbEeas2HD#Zu3=_-{9+~9I3@IS>lQTpwzsguLki?G!G<+2lGVz34PE}@>i diff --git a/collects/icons/recycle.png b/collects/icons/recycle.png new file mode 100644 index 0000000000000000000000000000000000000000..04842731ba67fde497b7cd84d57d6557305123fa GIT binary patch literal 1669 zcmV;027394P)4Tx0C=2@lubw!VHn5%vyBL$L1ZRE zF?28ql}Uq?z})q#P1%-l)f6FiXW!kOoSmI!X4e#n5Taw&F}he19V9x1hYp?c5FupN zMS_kNK_qwy*`Ar%j}f(cVRnA=eEgq}Sq7+h8P#>wCje>9GNk^1aBXZ{sQiEmRHF)X zqOz&`!{I@PDHeOq_9t-meXV(a|6fnFK?MPhIzUa*lFx57 z0F@7cod@~+?ns;c0)Ou=9# zGjc56g0z~I3-ylDRmHU7A-dCizT3>~EigA1kM__m(L($!&U$+7_elIaq4Wjq1=6*V zF#3jF=FTcsFygXrL{me91+LR#p{oT=Ubg~LQQyoB^%m_nqF2Ji^~BO-X26cArQEKW zRAkg;PMt}0hYI}B$VztI(-gC)tImI(dh@--7*sGQ(CAl#015pFpcy(0WRM__LJw5EsSo^Yz)rvS-e? zuE?wRf0C|Uxu{$47J72^Wvc5ZuZkpD)1{eAPp6*l654!yS;?-!?uE8JQ!-DbX2cw& zNvBfI@tO4N_f$J*dlb7e`?{`NYn@-7SgTr@-L1!IB!1VPx0sYAm7e+ zK;SR&U3@3sLr)j^!BWOBsVJColuSe^OT#pI^L36B010qNS#tmY3ljhU3ljkVnw%H_001I%MObuGZ)S9N zVRB^vQFUo!YgB1%Wgs^$Gax8UVPhaqQy^F=03&U|4gdfE2XskIMF-al69XDTx#_S}a>cD^m>7c1O(A#+n&zzO}3M(tZ4M4)>hHk62a!&;Sb~ zj{*@sf9tchI)|cUrc6(cO(lo}f};Wg2*k2}=vr7e3`VFZN51>o_|(^4+1yg|x)ZV) z?=Z{OmaLw=!O*z}Oppb@bmL`fU)U1YxVf|k!OJXddlIS|Il>dM3UE=0-@M3{2Use|QBwX&#iAvX|4sVqfBM#N7@ zPlXYNYPfUrvc{(^Nsh;FjbH3>iKQ#u1S)UBBjHD&S2s+-4AyQt;B9$Q+4g4V!lJVe zFF*M1LllE4)oyWXVZSBD6ENu3Kxy?!?8wIEEbN-o;j7p5!SGObAn@f^sH;EN^`f)p zu-AjFnWeWqmZeb!EyEcNRe}_YfN`Sg5(9KY=UGKSp>%!u=@T~|12M<$)prlJ^1E{3 z`6CdCkA|_%s-EtSo_0#9Wm$v}QB?NM&jTORG9W}zX6GFgl~?CRO}kmVyD+C9H1w0} zC>{RX+tK9f*uQLF{ilyD-};U$UquDV4VEi=L49NSysQjGz|o3BL)vg|#;jGdU3=+(n@4t4C*kFo#%@714G%Tcmd>KKE7*<1k zAO3?NIBHs}Yu>*-Ua-ebC?g}dQYMp8ymcPzFH`vM5x=QAsXWT|KfM0{QSB)>64_Xf P00000NkvXXu0mjfdKL>x literal 0 HcmV?d00001 diff --git a/collects/icons/run.png b/collects/icons/run.png index 841f1ba542b3a05aca7bb8243d2c72d55c781b11..875a07872c1c78f85792b817e6722fde88f95b3b 100644 GIT binary patch delta 375 zcmV--0f_#O1Cj%fB!5{+L_t(Ijh)j!Xj4%X$MH{^2kjQbrJ}r6uc|Kaei7{YrA>6z}~{LYu( zz31FqT#t5#ubbz($Q5r5ZkV3=r_lY->V$I-w& z{OEH4AJEK#vOPByWGH+YRX z+`|M?|ywCZb z=Y8K(Q9o4gp79vDxG&%$^B;gMJc;LbXuB^Y7Xj_@yn$Th9el#^jxp%1&! z#Sz|?5|@J1qHR~0&XUmJ?wC8j3sQ|CtO=c;y_IXmHNK`GE%DW#m=`|aq%gjJ(SZY; zr667C!3v%WP5n@$>q4XOPx8f(4CXL~Dts&TlF-;J{$jlp w 5) (> h 5)) - (draw-button-label dc label 0 0 w h mouse-over? mouse-grabbed? font))])))) + (draw-button-label dc to-draw-message 0 0 w h mouse-over? mouse-grabbed? font (get-background-color)))])))) + + (define/public (get-background-color) #f) + + (define to-draw-message #f) + (define/private (compute-new-string) + (let-values ([(cw ch) (get-client-size)]) + (let ([width-to-use (- cw (get-left-side-padding) triangle-width circle-spacer)]) + (let loop ([c (string-length label)]) + (cond + [(= c 0) (set! to-draw-message "")] + [else + (let ([candidate (if (= c (string-length label)) + label + (string-append (substring label 0 c) "..."))]) + (let-values ([(tw th _1 _2) (send (get-dc) get-text-extent candidate small-control-font)]) + (cond + [(tw . <= . width-to-use) (set! to-draw-message candidate)] + [else + (loop (- c 1))])))]))))) + + (define/override (on-size w h) + (compute-new-string) + (refresh)) (super-new [style '(transparent no-focus)]) (update-min-sizes) @@ -215,7 +259,13 @@ ans-w ans-h))) - (define (draw-button-label dc label dx dy w h mouse-over? grabbed? button-label-font) + (define (draw-button-label dc label dx dy w h mouse-over? grabbed? button-label-font bkg-color) + + (when bkg-color + (send dc set-pen bkg-color 1 'solid) + (send dc set-brush bkg-color 'solid) + (send dc draw-rectangle dx dy w h)) + (when (or mouse-over? grabbed?) (let ([color (if grabbed? mouse-grabbed-color diff --git a/collects/string-constants/danish-string-constants.ss b/collects/string-constants/danish-string-constants.ss index 264ea4fd3d..34c8484534 100644 --- a/collects/string-constants/danish-string-constants.ss +++ b/collects/string-constants/danish-string-constants.ss @@ -196,10 +196,7 @@ please adhere to these guidelines: ;;; info bar at botttom of drscheme frame (collect-button-label "GC") - (read-only-line1 "Skrivebeskyttet") - (read-only-line2 "") - (read/write-line1 "Læs/") - (read/write-line2 "Skriv") + (read-only "Skrivebeskyttet") (auto-extend-selection "Auto-udvid") (overwrite "Overskriv") (running "kører") diff --git a/collects/string-constants/dutch-string-constants.ss b/collects/string-constants/dutch-string-constants.ss index 4c489f3482..cc83ba061a 100644 --- a/collects/string-constants/dutch-string-constants.ss +++ b/collects/string-constants/dutch-string-constants.ss @@ -81,10 +81,7 @@ ;;; info bar at botttom of drscheme frame (collect-button-label "GC") - (read-only-line1 "Alleen") - (read-only-line2 "lezen") - (read/write-line1 "Lezen/") - (read/write-line2 "Schrijven") + (read-only "Alleen lezen") (auto-extend-selection "Auto-extend") ; <**> -- when does this appear? (overwrite "Vervang") (running "Bezig") diff --git a/collects/string-constants/english-string-constants.ss b/collects/string-constants/english-string-constants.ss index 780f987254..c50106b916 100644 --- a/collects/string-constants/english-string-constants.ss +++ b/collects/string-constants/english-string-constants.ss @@ -196,10 +196,7 @@ please adhere to these guidelines: ;;; info bar at botttom of drscheme frame (collect-button-label "GC") - (read-only-line1 "Read") - (read-only-line2 "only") - (read/write-line1 "Read/") - (read/write-line2 "Write") + (read-only "Read only") (auto-extend-selection "Auto-extend") (overwrite "Overwrite") (running "running") @@ -958,9 +955,7 @@ please adhere to these guidelines: (use-repeating-decimals "Repeating decimals") (decimal-notation-for-rationals "Use decimal notation for rationals") - ; used in the bottom left of the drscheme frame as the label - ; above the programming language's name - (programming-language-label "Programming language:") + ; used in the bottom left of the drscheme frame ; used the popup menu from the just above; greyed out and only ; visible when some languages are in the history (recent-languages "Recent languages:") diff --git a/collects/string-constants/french-string-constants.ss b/collects/string-constants/french-string-constants.ss index c89d9e0ee1..811ce355d5 100644 --- a/collects/string-constants/french-string-constants.ss +++ b/collects/string-constants/french-string-constants.ss @@ -196,10 +196,7 @@ ;;; info bar at botttom of drscheme frame (collect-button-label "Ramassage") ; de miettes - (read-only-line1 "Lecture") - (read-only-line2 "seulement") - (read/write-line1 "Lecture/") - (read/write-line2 "écriture") + (read-only "Lecture seulement") (auto-extend-selection "Autosélection") ; "Sélection auto-étendable" ? (overwrite "Correction") ; vs Insertion ? surimpression ? (running "en cours") @@ -959,8 +956,6 @@ (decimal-notation-for-rationals "Utiliser la notation décimale pour les nombres rationnels") ; used in the bottom left of the drscheme frame as the label - ; above the programming language's name - (programming-language-label "Langage de programmation :") ; used the popup menu from the just above; greyed out and only ; visible when some languages are in the history (recent-languages "Langages récents :") diff --git a/collects/string-constants/german-string-constants.ss b/collects/string-constants/german-string-constants.ss index 727ea0cd31..a299c7d4fc 100644 --- a/collects/string-constants/german-string-constants.ss +++ b/collects/string-constants/german-string-constants.ss @@ -98,10 +98,7 @@ ;;; info bar at botttom of drscheme frame (collect-button-label "GC") - (read-only-line1 "Lese-") - (read-only-line2 "Modus") - (read/write-line1 "Schreib-") - (read/write-line2 "Modus") + (read-only "Lese Modus") (auto-extend-selection "Automatisch erweitern") (overwrite "Überschreiben") (running "Programm läuft") @@ -854,7 +851,6 @@ ;; used in the bottom left of the drscheme frame as the label ;; above the programming language's name - (programming-language-label "Programmiersprache:") ;; used the popup menu from the just above; greyed out and only ;; visible when some languages are in the history (recent-languages "Kürzlich verwendete Sprachen:") diff --git a/collects/string-constants/portuguese-string-constants.ss b/collects/string-constants/portuguese-string-constants.ss index 8b0734e83f..060e2b946d 100644 --- a/collects/string-constants/portuguese-string-constants.ss +++ b/collects/string-constants/portuguese-string-constants.ss @@ -196,10 +196,7 @@ please adhere to these guidelines: ;;; info bar at botttom of drscheme frame (collect-button-label "GC") - (read-only-line1 "Apenas") - (read-only-line2 "Leitura") - (read/write-line1 "Leitura/") - (read/write-line2 "Escrita") + (read-only "Apenas Leitura") (auto-extend-selection "Auto-Extensível") (overwrite "Reescrever") (running "a executar") diff --git a/collects/string-constants/simplified-chinese-string-constants.ss b/collects/string-constants/simplified-chinese-string-constants.ss index ed7ee6f3ec..1f48c6a361 100644 --- a/collects/string-constants/simplified-chinese-string-constants.ss +++ b/collects/string-constants/simplified-chinese-string-constants.ss @@ -123,10 +123,7 @@ ;;; info bar at botttom of drscheme frame (collect-button-label "垃圾回收") - (read-only-line1 "只") - (read-only-line2 "读") - (read/write-line1 "读/") - (read/write-line2 "写") + (read-only "只读") (auto-extend-selection "自动扩展") (overwrite "覆盖") (running "运行中") @@ -886,7 +883,6 @@ ; used in the bottom left of the drscheme frame as the label ; above the programming language's name - (programming-language-label "编程语言：") ; used the popup menu from the just above; greyed out and only ; visible when some languages are in the history (recent-languages "最近使用的语言：") diff --git a/collects/string-constants/spanish-string-constants.ss b/collects/string-constants/spanish-string-constants.ss index c1fb74b6bc..e6db0bd06a 100644 --- a/collects/string-constants/spanish-string-constants.ss +++ b/collects/string-constants/spanish-string-constants.ss @@ -104,10 +104,7 @@ ;;; info bar at botttom of drscheme frame (collect-button-label "Recolectar") - (read-only-line1 "Sólo") - (read-only-line2 "lectura") - (read/write-line1 "Lectura/") - (read/write-line2 "Escritura") + (read-only "Sólo lectura") (auto-extend-selection "Selección Auto-Extendida") (overwrite "Sobreescribir") (running "ejecutando") diff --git a/collects/string-constants/traditional-chinese-string-constants.ss b/collects/string-constants/traditional-chinese-string-constants.ss index 4c725eaa6e..50ecc3886a 100644 --- a/collects/string-constants/traditional-chinese-string-constants.ss +++ b/collects/string-constants/traditional-chinese-string-constants.ss @@ -122,10 +122,7 @@ ;;; info bar at botttom of drscheme frame (collect-button-label "垃圾回收") - (read-only-line1 "只") - (read-only-line2 "讀") - (read/write-line1 "讀/") - (read/write-line2 "寫") + (read-only "只讀") (auto-extend-selection "自動擴展") (overwrite "覆蓋") (running "運行中") @@ -885,7 +882,6 @@ ; used in the bottom left of the drscheme frame as the label ; above the programming language's name - (programming-language-label "程式語言：") ; used the popup menu from the just above; greyed out and only ; visible when some languages are in the history (recent-languages "最近使用的語言：")