diff --git a/collects/drscheme/private/drsig.ss b/collects/drscheme/private/drsig.ss index 2bc2fabbae..951dd0c352 100644 --- a/collects/drscheme/private/drsig.ss +++ b/collects/drscheme/private/drsig.ss @@ -174,6 +174,7 @@ current-language-settings current-value-port get-drs-bindings-keymap + error-delta text% text<%> context<%>)) diff --git a/collects/drscheme/private/language-configuration.ss b/collects/drscheme/private/language-configuration.ss index 6841f4f761..2feb46b0b8 100644 --- a/collects/drscheme/private/language-configuration.ss +++ b/collects/drscheme/private/language-configuration.ss @@ -4,6 +4,7 @@ (lib "hierlist.ss" "hierlist") (lib "class.ss") (lib "contract.ss") + (lib "kw.ss") "drsig.ss" (lib "string-constant.ss" "string-constants") (lib "mred.ss" "mred") @@ -12,6 +13,7 @@ (lib "etc.ss") (lib "file.ss") (lib "pconvert.ss") + (lib "bitmap-label.ss" "mrlib") (lib "getinfo.ss" "setup") (lib "toplevel.ss" "syntax")) @@ -43,7 +45,7 @@ ;; considered the default language (define default-language-position (list (string-constant initial-language-category) - (string-constant choose-a-language-language))) + (string-constant no-language-chosen))) ;; languages : (listof (instanceof language<%>)) ;; all of the languages supported in DrScheme @@ -135,16 +137,16 @@ (string-constant language-dialog-title))) (parent parent) (style '(resize-border)))) - (define welcome-before-panel (instantiate horizontal-panel% () + (define welcome-before-panel (instantiate horizontal-pane% () (parent dialog) (stretchable-height #f))) - (define language-dialog-meat-panel (make-object vertical-panel% dialog)) + (define language-dialog-meat-panel (make-object vertical-pane% dialog)) - (define welcome-after-panel (instantiate vertical-panel% () + (define welcome-after-panel (instantiate vertical-pane% () (parent dialog) (stretchable-height #f))) - (define button-panel (instantiate horizontal-panel% () + (define button-panel (instantiate horizontal-pane% () (parent dialog) (stretchable-height #f))) @@ -176,7 +178,7 @@ (define show-details-label (string-constant show-details-button-label)) (define hide-details-label (string-constant hide-details-button-label)) - (define button-gap (make-object horizontal-panel% button-panel)) + (define button-gap (make-object horizontal-pane% button-panel)) (define-values (ok-button cancel-button) (gui-utils:ok/cancel-buttons button-panel @@ -316,9 +318,9 @@ (send i toggle-open/closed))) (super-instantiate (parent)))) - (define outermost-panel (make-object horizontal-panel% parent)) + (define outermost-panel (make-object horizontal-pane% parent)) (define languages-hier-list (make-object selectable-hierlist% outermost-panel)) - (define details-outer-panel (make-object vertical-panel% outermost-panel)) + (define details-outer-panel (make-object vertical-pane% outermost-panel)) (define details/manual-parent-panel (make-object vertical-panel% details-outer-panel)) (define details-panel (make-object panel:single% details/manual-parent-panel)) (define manual-ordering-panel (new vertical-panel% (parent details/manual-parent-panel))) @@ -731,7 +733,7 @@ (λ (x y) (details-callback)))) - (define revert-to-defaults-outer-panel (make-object horizontal-panel% show-details-parent)) + (define revert-to-defaults-outer-panel (make-object horizontal-pane% show-details-parent)) (define revert-to-defaults-button (make-object button% (string-constant revert-to-language-defaults) revert-to-defaults-outer-panel @@ -1371,7 +1373,7 @@ (add-language (make-simple 'mzscheme (list (string-constant initial-language-category) - (string-constant choose-a-language-language)) + (string-constant no-language-chosen)) (list 10000 1000) #f "Helps the user choose an initial language" @@ -1379,39 +1381,130 @@ (define (not-a-language-extra-mixin %) (class % + (define/override (get-style-delta) drscheme:rep:error-delta) + (define/override (front-end/interaction input settings teachpack-cache) (not-a-language-message) (λ () eof)) (define/override (front-end/complete-program input settings teachpack-cache) (not-a-language-message) (λ () eof)) - (super-new))) + (super-new))) + + +; +; +; @@ +; @ @ +; @@:@@: $@$ @@@@@ $@$: @ $@$: @@:@@: $@-@@@@ @@ $@$: $@-@@ -@@$ +; @+ :@ $- -$ @ -@ @ -@ @+ :@ $* :@ @ @ -@ $* :@ $ -$ +; @ @ @ @ @ @@@@@ -$@$@ @@@@@ @ -$@$@ @ @ @ @ @ @ -$@$@ @ @ @@@@@ +; @ @ @ @ @ $* @ @ $* @ @ @ @ @ @ @ $* @ @ @ $ +; @ @ $- -$ @: :$ @- *@ @ @- *@ @ @ $* :@ @: +@ @- *@ $* :@ +: +; @@@ @@@ $@$ :@@$- -$$-@@ @@@@@ -$$-@@@@@ @@@ $@:@ :@$-@@ -$$-@@ $@:@ $@@+ +; -$ -$ +; -@@$ -@@$ +; +; + (define (not-a-language-message) (define (main) (o (string-constant must-choose-language)) (o "\n") + (let ([rep (drscheme:rep:current-rep)]) + (when rep + (parameterize ([current-eventspace drscheme:init:system-eventspace]) + (queue-callback + (λ () + (not-a-language-dialog rep))))))) + + (define o + (case-lambda + [(arg) + (cond + [(string? arg) + (fprintf (current-error-port) arg)] + [(is-a? arg snip%) + (write-special arg (current-error-port))])] + [args (apply fprintf (current-error-port) args)])) + + (main)) + + (define (not-a-language-dialog rep) + (define drs-frame (send (send rep get-canvas) get-top-level-window)) + (define dialog (new dialog% + (parent drs-frame) + (label (string-constant drscheme)))) + (define qa-panel (new vertical-pane% (parent dialog))) + (define button-panel (new horizontal-pane% + (parent dialog) + (stretchable-height #f) + (alignment '(right center)))) + + (define close (new button% + (parent button-panel) + (callback (lambda (x y) (send dialog show #f))) + (label (string-constant close)))) + + (define run (new button% + (parent button-panel) + (style '(border)) + (callback (λ (x y) (run-callback))) + (label (make-bitmap-label + (string-constant execute-button-label) + (build-path (collection-path "icons") "run.png"))))) + + (define language-chosen? #f) + + (define (main) + (insert-red-message) (insert-text-pls) (display-plt-schemer) (display-standard-schemer) - (display-future-choice)) + (display-future-choice) + (space-em-out) + (send dialog show #t)) + + (define (run-callback) + (cond + [language-chosen? + (send dialog show #f) + (send drs-frame execute-callback)] + [else + (message-box (string-constant drscheme) + (string-constant choose-new-language-before-running))])) + + (define (insert-red-message) + (new canvas-message% + (parent qa-panel) + (font (get-font #:style 'italic)) + (label (string-constant must-choose-language)) + (color (send the-color-database find-color "red")))) + + (define (space-em-out) + (send qa-panel change-children + (lambda (l) + (cond + [(null? l) l] + [else + (let loop ([x (car l)] + [r (cdr l)]) + (cond + [(null? r) (list x)] + [else (list* x + (new vertical-pane% + (parent qa-panel) + (min-height 5) + (stretchable-height #f)) + (loop (car r) + (cdr r)))]))])))) + (define (display-future-choice) - (let* ([txt (new text:standard-style-list%)] - [es (new editor-snip% - [with-border? #f] - [left-margin 0] - [top-margin 0] - [bottom-margin 0] - [right-margin 0] - [editor txt])]) - (send txt insert (string-constant use-language-menu-item-in-future)) - (send txt change-style - default-sd - 0 - (send txt last-position)) - (o es) - (o "\n"))) + (new message% + (label (string-constant use-language-menu-item-in-future)) + (parent qa-panel))) (define (insert-text-pls) (for-each @@ -1428,19 +1521,24 @@ (string<=? (cadr x) (cadr y))]))))) (define (display-plt-schemer) - (question/answer (string-constant seasoned-plt-schemer?) + (question/answer (lambda (parent) + (new canvas-message% + (parent parent) + (label (string-constant seasoned-plt-schemer?)))) (list (string-constant professional-languages) "(module ...)") - (list "PLT-206-small.png" "icons") - void)) + (list "PLT-206-small.png" + "icons"))) (define (display-standard-schemer) - (question/answer (string-constant looking-for-standard-scheme?) + (question/answer (lambda (parent) + (new canvas-message% + (parent parent) + (label (string-constant looking-for-standard-scheme?)))) (list (string-constant professional-languages) (string-constant plt) (string-constant pretty-big-scheme)) - (list "r5rs.png" "icons") - void)) + (list "r5rs.png" "icons"))) (define (display-text-pl lst) (let ([icon-lst (car lst)] @@ -1448,30 +1546,87 @@ [lang (cddr lst)] [using-before (string-constant using-a-textbook-before)] [using-after (string-constant using-a-textbook-after)]) - (question/answer (string-append using-before text-name using-after) + (question/answer (lambda (parent) + (new canvas-message% + (parent parent) + (label using-before)) + (new canvas-message% + (parent parent) + (font (get-font #:style 'italic)) + (label text-name)) + (new canvas-message% + (parent parent) + (label using-after))) lang - icon-lst - (λ (txt) - (send txt change-style - italic-sd - (string-length using-before) - (+ (string-length using-before) - (string-length text-name))))))) + icon-lst))) - (define (question/answer question lang icon-lst proc) + (define default-font (send the-font-list find-or-create-font + 12 + 'default + 'normal + 'normal)) + + (define/kw (get-font #:key + (point-size (send default-font get-point-size)) + (family (send default-font get-family)) + (style (send default-font get-style)) + (weight (send default-font get-weight)) + (underlined (send default-font get-underlined)) + (smoothing (send default-font get-smoothing))) + (send the-font-list find-or-create-font + point-size + family + style + weight + underlined + smoothing)) + + (define canvas-message% + (class canvas% + (init-field label + [font (get-font)] + [callback void] + [color (send the-color-database find-color "black")]) + + (define/override (on-event evt) + (cond + [(send evt button-up?) + (callback)] + [else + (super on-event evt)])) + + (define/override (on-paint) + (let* ([dc (get-dc)] + [old-font (send dc get-font)] + [old-tf (send dc get-text-foreground)]) + (send dc set-text-foreground color) + (send dc set-font font) + (send dc draw-text label 0 0 #t) + (send dc set-font old-font) + (send dc set-text-foreground old-tf))) + + (super-new [stretchable-width #f] + [stretchable-height #f] + [style '(transparent)]) + + (inherit min-width min-height get-dc) + (let-values ([(w h _1 _2) (send (get-dc) get-text-extent label font #t)]) + (min-width (inexact->exact (floor w))) + (min-height (inexact->exact (floor h)))))) + + (define (question/answer line1 lang icon-lst) (display-two-line-choice icon-lst - (λ (inner-txt) - (send inner-txt insert (format "~a\n~a" question (string-constant start-with-before))) - (send inner-txt change-style default-sd 0 (send inner-txt last-position)) - (lang-link-snip lang inner-txt) - (let ([before-pos (send inner-txt last-position)]) - (send inner-txt insert (string-constant start-with-after)) - (send inner-txt change-style - default-sd - before-pos - (send inner-txt last-position))) - (proc inner-txt)))) + (λ (panel1 panel2) + (line1 panel1) + (new canvas-message% (parent panel2) (label (string-constant start-with-before))) + (new canvas-message% + (parent panel2) + (label (car (last-pair lang))) + (color (send the-color-database find-color "blue")) + (callback + (λ () (change-current-lang-to lang))) + (font (get-font #:underlined #t)))))) ;; get-text-pls : path -> (listof (list* string string (listof string)) ;; gets the questions from an info.ss file. @@ -1500,128 +1655,27 @@ qs) '()))) - (define (lang-link-snip lang txt) - #; - (let ([before (send txt last-position)]) - (send txt insert (car (last-pair lang))) - (let ([after (send txt last-position)]) - (send txt change-style link-sd before after) - (send txt set-clickback before after - (λ (txt start end) - (change-current-lang-to lang txt))))) - - (send txt insert - (new link-snip% - [words (car (last-pair lang))] - [callback - (λ (snip) - (change-current-lang-to lang snip))]))) - - (define o - (case-lambda - [(arg) - (cond - [(string? arg) - (fprintf (current-error-port) arg)] - [(is-a? arg snip%) - (write-special arg (current-error-port))])] - [args (apply fprintf (current-error-port) args)])) - - (define arrow-cursor (make-object cursor% 'arrow)) - - (define link-snip% - (class editor-snip% - (init-field words callback) - - (define/override (adjust-cursor dc x y editorx editory event) arrow-cursor) - - (define/override (on-event dc x y editorx editory event) - (when (send event button-up?) - (callback this))) - - (define/override (copy) - (new link-snip% [words words] [callback callback])) - - (define txt (new text:standard-style-list%)) - - (super-new [editor txt] [with-border? #f] - [left-margin 0] - [right-margin 0] - [top-margin 0] - [bottom-margin 0]) - (inherit get-flags set-flags set-style) - (set-flags (cons 'handles-events (get-flags))) - - (send txt insert words) - (send txt change-style link-sd 0 (send txt last-position)))) - - #; - (define link-snip% - (class string-snip% - (init-field words callback) - - (define/override (adjust-cursor dc x y editorx editory event) arrow-cursor) - - (define/override (on-event dc x y editorx editory event) - (when (send event button-up?) - (callback this))) - - (define/override (copy) - (new link-snip% [words words] [callback callback])) - - (super-make-object words) - (inherit get-flags set-flags set-style) - (set-style link-style) - (set-flags (cons 'handles-events (remq 'is-text (get-flags)))))) - - (define italic-sd (make-object style-delta% 'change-style 'slant)) - - (define link-sd (make-object style-delta% 'change-underline #t)) - (define stupid-internal-define-syntax1 - (begin (send link-sd set-delta-foreground "blue") - (send link-sd set-family 'default))) - - (define default-sd (make-object style-delta% 'change-family 'default)) - - (define link-style - (send (editor:get-standard-style-list) - find-or-create-style - (send (editor:get-standard-style-list) find-named-style "Standard") - link-sd)) - (define (display-two-line-choice icon-lst proc) - (let* ([outer-txt (new text:standard-style-list%)] - [outer-es (new editor-snip% (editor outer-txt) (with-border? #f) - [left-margin 0] - [right-margin 0] - [top-margin 0] - [bottom-margin 0])] - [inner-txt (new text:standard-style-list%)] - [inner-es (new editor-snip% (editor inner-txt) (with-border? #f) - [top-margin 0] [bottom-margin 0])] - [icon-path - (build-path (apply collection-path (cdr icon-lst)) (car icon-lst))]) - (send outer-txt insert (make-object image-snip% icon-path)) - (send outer-txt insert inner-es) - (proc inner-txt) - (send outer-txt change-style - (make-object style-delta% 'change-alignment 'top) - 0 - (send outer-txt last-position)) - (send inner-txt lock #t) - (send outer-txt lock #t) - (o outer-es) - (o "\n"))) - - (define err-style-delta - (let ([err-sd (make-object style-delta% 'change-italic)]) - (send err-sd set-delta-foreground (make-object color% 255 0 0)) - err-sd)) - + (let* ([hp (new horizontal-pane% + (parent qa-panel) + (alignment '(center top)) + (stretchable-height #f))] + [icon (new message% + (label (make-object bitmap% + (build-path (apply collection-path (cdr icon-lst)) + (car icon-lst)) + 'unknown/mask)) + (parent hp))] + [vp (new vertical-pane% + (parent hp) + (alignment '(left top)) + (stretchable-height #f))]) + (proc (new horizontal-pane% (parent vp)) + (new horizontal-pane% (parent vp))))) + ;; change-current-lang-to : (listof string) -> void - (define (change-current-lang-to lang-strings snip) - (let ([parent (find-parent-from-snip snip)] - [lang (ormap + (define (change-current-lang-to lang-strings) + (let ([lang (ormap (λ (x) (and (equal? lang-strings (send x get-language-position)) x)) @@ -1633,11 +1687,11 @@ (language-dialog #f (make-language-settings lang (send lang default-settings)) - parent)]) + drs-frame)]) (when new-lang + (set! language-chosen? #t) (preferences:set settings-preferences-symbol new-lang) - (when (is-a? parent drscheme:unit:frame<%>) - (send (send parent get-definitions-text) set-next-settings new-lang)))))) + (send (send drs-frame get-definitions-text) set-next-settings new-lang))))) (main)) diff --git a/collects/drscheme/private/modes.ss b/collects/drscheme/private/modes.ss index 3229d5ff1e..0481346b2d 100644 --- a/collects/drscheme/private/modes.ss +++ b/collects/drscheme/private/modes.ss @@ -2,6 +2,7 @@ (require (lib "unitsig.ss") (lib "string-constant.ss" "string-constants") (lib "class.ss") + (lib "list.ss") (lib "framework.ss" "framework") "drsig.ss") @@ -24,6 +25,11 @@ (set! modes (cons new-mode modes)) new-mode)) + (define (not-a-language-language? l) + (and (not (null? l)) + (equal? (car (last-pair l)) + (string-constant no-language-chosen)))) + (define (add-initial-modes) ;; must be added first, to make it last in mode list, @@ -39,4 +45,6 @@ #f (λ (text prompt-position) #t) (λ (l) - (and l (ormap (λ (x) (regexp-match #rx"Algol" x)) l)))))))) + (and l + (or (not-a-language-language? l) + (ormap (λ (x) (regexp-match #rx"Algol" x)) l))))))))) diff --git a/collects/icons/r5rs.png b/collects/icons/r5rs.png index ab428f9947..4176d8eeb9 100644 Binary files a/collects/icons/r5rs.png and b/collects/icons/r5rs.png differ diff --git a/collects/mrlib/bitmap-label.ss b/collects/mrlib/bitmap-label.ss index 2ca2450e1b..7c36fbfbc7 100644 --- a/collects/mrlib/bitmap-label.ss +++ b/collects/mrlib/bitmap-label.ss @@ -1,94 +1,103 @@ (module bitmap-label mzscheme (require (lib "mred.ss" "mred") (lib "class.ss") - (lib "contract.ss")) + (lib "etc.ss") + (lib "contract.ss")) (provide/contract + [make-bitmap-label (opt-> + (string? + (union path-string? + (is-a?/c bitmap%))) + ((is-a?/c font%)) + (is-a?/c bitmap%))] [bitmap-label-maker (string? (union path-string? (is-a?/c bitmap%)) . -> . (any/c . -> . (is-a?/c bitmap%)))]) - (define bitmap-label-maker - (case-lambda - [(text filename-or-bitmap) + (define make-bitmap-label + (opt-lambda (text filename-or-bitmap [font normal-control-font]) + (let*-values ([(outside-margin) 2] + [(img-bitmap-dc img-bitmap img-width img-height) + (let ([mdc (make-object bitmap-dc%)] + [q (if (filename-or-bitmap . is-a? . bitmap%) + filename-or-bitmap + (make-object bitmap% filename-or-bitmap 'unknown/mask))]) + (if (send q ok?) + (begin (send mdc set-bitmap q) + (values mdc + q + (send q get-width) + (send q get-height))) + (let ([b (make-object bitmap% 1 1)]) + (send mdc set-bitmap b) + (send mdc clear) + (values mdc q 0 0))))] + [(width height descent leading) + (send img-bitmap-dc get-text-extent text font)] + [(middle-margin) (if (and (zero? img-width) + (zero? img-height)) + 0 + 3)] + [(new-width) (inexact->exact + (floor + (+ outside-margin + img-width + middle-margin + width + outside-margin)))] + [(new-height) (inexact->exact + (floor (+ outside-margin + (max img-height height) + outside-margin)))] + [(bitmap-dc) (make-object bitmap-dc%)] + [(new-bitmap) (make-object bitmap% new-width new-height)] + [(new-bitmap-mask) (make-object bitmap% new-width new-height)]) + (send new-bitmap set-loaded-mask new-bitmap-mask) + (send img-bitmap-dc set-bitmap #f) + (send bitmap-dc set-bitmap new-bitmap-mask) + + (send bitmap-dc set-font font) + (send bitmap-dc set-pen (send the-pen-list find-or-create-pen "black" 1 'solid)) + (send bitmap-dc set-brush (send the-brush-list find-or-create-brush "black" 'solid)) + + + (send bitmap-dc clear) + (send bitmap-dc draw-text text + (+ outside-margin img-width middle-margin) + (- (/ new-height 2) (/ height 2))) + + (cond + [(send img-bitmap get-loaded-mask) + (send bitmap-dc draw-bitmap + (send img-bitmap get-loaded-mask) + outside-margin + (- (/ new-height 2) (/ img-height 2)))] + [else + (send bitmap-dc draw-rectangle + outside-margin + (- (/ new-height 2) (/ img-height 2)) + img-width + img-height)]) + + (send bitmap-dc set-bitmap new-bitmap) + (send bitmap-dc clear) + (send bitmap-dc set-pen (send the-pen-list find-or-create-pen "black" 1 'solid)) + (send bitmap-dc set-brush (send the-brush-list find-or-create-brush "black" 'solid)) + (send bitmap-dc draw-rectangle + (+ outside-margin img-width middle-margin) + (- (/ new-height 2) (/ height 2)) + width height) + (send bitmap-dc draw-bitmap + img-bitmap + outside-margin + (- (/ new-height 2) (/ img-height 2))) + (send bitmap-dc set-bitmap #f) + new-bitmap))) + + (define (bitmap-label-maker text filename-or-bitmap) + (let ([bm (make-bitmap-label text filename-or-bitmap)]) (lambda (area-container-window) - (let*-values ([(outside-margin) 2] - [(font) normal-control-font] - [(img-bitmap-dc img-bitmap img-width img-height) - (let ([mdc (make-object bitmap-dc%)] - [q (if (filename-or-bitmap . is-a? . bitmap%) - filename-or-bitmap - (make-object bitmap% filename-or-bitmap 'unknown/mask))]) - (if (send q ok?) - (begin (send mdc set-bitmap q) - (values mdc - q - (send q get-width) - (send q get-height))) - (let ([b (make-object bitmap% 1 1)]) - (send mdc set-bitmap b) - (send mdc clear) - (values mdc q 0 0))))] - [(width height descent leading) - (send img-bitmap-dc get-text-extent text font)] - [(middle-margin) (if (and (zero? img-width) - (zero? img-height)) - 0 - 3)] - [(new-width) (inexact->exact - (floor - (+ outside-margin - img-width - middle-margin - width - outside-margin)))] - [(new-height) (inexact->exact - (floor (+ outside-margin - (max img-height height) - outside-margin)))] - [(bitmap-dc) (make-object bitmap-dc%)] - [(new-bitmap) (make-object bitmap% new-width new-height)] - [(new-bitmap-mask) (make-object bitmap% new-width new-height)]) - (send new-bitmap set-loaded-mask new-bitmap-mask) - (send img-bitmap-dc set-bitmap #f) - (send bitmap-dc set-bitmap new-bitmap-mask) - - (send bitmap-dc set-font font) - (send bitmap-dc set-pen (send the-pen-list find-or-create-pen "black" 1 'solid)) - (send bitmap-dc set-brush (send the-brush-list find-or-create-brush "black" 'solid)) - - - (send bitmap-dc clear) - (send bitmap-dc draw-text text - (+ outside-margin img-width middle-margin) - (- (/ new-height 2) (/ height 2))) - - (cond - [(send img-bitmap get-loaded-mask) - (send bitmap-dc draw-bitmap - (send img-bitmap get-loaded-mask) - outside-margin - (- (/ new-height 2) (/ img-height 2)))] - [else - (send bitmap-dc draw-rectangle - outside-margin - (- (/ new-height 2) (/ img-height 2)) - img-width - img-height)]) - - (send bitmap-dc set-bitmap new-bitmap) - (send bitmap-dc clear) - (send bitmap-dc set-pen (send the-pen-list find-or-create-pen "black" 1 'solid)) - (send bitmap-dc set-brush (send the-brush-list find-or-create-brush "black" 'solid)) - (send bitmap-dc draw-rectangle - (+ outside-margin img-width middle-margin) - (- (/ new-height 2) (/ height 2)) - width height) - (send bitmap-dc draw-bitmap - img-bitmap - outside-margin - (- (/ new-height 2) (/ img-height 2))) - (send bitmap-dc set-bitmap #f) - new-bitmap))]))) + bm)))) diff --git a/collects/plai/plai-icon.png b/collects/plai/plai-icon.png index 1b8839fffc..4820631d2c 100644 Binary files a/collects/plai/plai-icon.png and b/collects/plai/plai-icon.png differ diff --git a/collects/profj/htdch-icon.png b/collects/profj/htdch-icon.png new file mode 100644 index 0000000000..5e9b05bc4f Binary files /dev/null and b/collects/profj/htdch-icon.png differ diff --git a/collects/profj/info.ss b/collects/profj/info.ss index 32be57a2b7..282beae893 100644 --- a/collects/profj/info.ss +++ b/collects/profj/info.ss @@ -1,4 +1,6 @@ (module info (lib "infotab.ss" "setup") + (require (lib "string-constant.ss" "string-constants")) + (define name "ProfessorJ") (define doc.txt "doc.txt") (define tools (list (list "tool.ss"))) @@ -7,4 +9,10 @@ (define compile-subcollections (list (list "profj" "parsers") (list "profj" "libs" "java" "lang") (list "profj" "libs" "java" "io") - (list "profj" "libs" "java" "util")))) + (list "profj" "libs" "java" "util"))) + (define textbook-pls + (list (list '("htdch-icon.png" "profj") + "How to Design Class Hierarchies" + (string-constant experimental-languages) + "ProfessorJ" + "Beginner")))) diff --git a/collects/string-constants/english-string-constants.ss b/collects/string-constants/english-string-constants.ss index 59b0e76a96..2398aeeb59 100644 --- a/collects/string-constants/english-string-constants.ss +++ b/collects/string-constants/english-string-constants.ss @@ -962,6 +962,7 @@ please adhere to these guidelines: (use-other "... using DrScheme for some other reason?") (use-eopl "... using DrScheme with Essentials of Programming Languages?") (pl-lang-choice-format "Initial language: ~a") + (choose-new-language-before-running "Please choose a new language before running.") ;;; languages @@ -988,7 +989,7 @@ please adhere to these guidelines: (teaching-languages "Teaching Languages") (experimental-languages "Experimental Languages") (initial-language-category "Initial language") - (choose-a-language-language "Choose-a-language language") + (no-language-chosen "No language chosen") (module-language-one-line-summary "Run creates a REPL in the context of the module, including the module's declared language")