improved the suggest-a-language dialog that you get in the there-is-no-language-picked-yet language

This commit is contained in:
Robby Findler 2010-04-29 12:21:10 -05:00
parent 66f51b9478
commit 9b2987d7fb
3 changed files with 50 additions and 28 deletions

View File

@ -1,4 +1,5 @@
#lang setup/infotab #lang setup/infotab
(require string-constants)
(define name "DeinProgramm") (define name "DeinProgramm")
@ -12,3 +13,10 @@
'("define-record-procedures.scm" '("define-record-procedures.scm"
"convert-explicit.scm" "convert-explicit.scm"
"line3d.scm")) "line3d.scm"))
(define textbook-pls
(list (list '("logo-small.png" "deinprogramm")
"DeinProgramm"
(string-constant teaching-languages)
"DeinProgramm"
"Die Macht der Abstraktion - Anfänger")))

View File

@ -1343,9 +1343,9 @@
(super-new) (super-new)
(define/augment (capability-value key) (define/augment (capability-value key)
(cond (cond
[(eq? key 'macro-stepper:enabled) #t] [(eq? key 'macro-stepper:enabled) #t]
[else (inner (drracket:language:get-capability-default key) [else (inner (drracket:language:get-capability-default key)
capability-value key)])))) capability-value key)]))))
(define (assume-mixin %) (define (assume-mixin %)
(class % (class %
@ -1517,7 +1517,7 @@
(lambda (%) (r5rs-mixin (macro-stepper-mixin (assume-mixin (add-errortrace-key-mixin %))))))) (lambda (%) (r5rs-mixin (macro-stepper-mixin (assume-mixin (add-errortrace-key-mixin %)))))))
(add-language (add-language
(make-simple 'mzscheme (make-simple 'racket/base
"plt:no-language-chosen" "plt:no-language-chosen"
(list (string-constant initial-language-category) (list (string-constant initial-language-category)
(string-constant no-language-chosen)) (string-constant no-language-chosen))
@ -1543,6 +1543,9 @@
(define/augment (capability-value v) (define/augment (capability-value v)
(case v (case v
[(drscheme:define-popup) #f]
[(gui-debugger:debug-button) #f]
[(macro-stepper:enabled) #f]
[(drscheme:check-syntax-button) #f] [(drscheme:check-syntax-button) #f]
[else (inner (drracket:language:get-capability-default v) [else (inner (drracket:language:get-capability-default v)
capability-value v)])) capability-value v)]))
@ -1724,8 +1727,14 @@
(question/answer (lambda (parent) (question/answer (lambda (parent)
(new canvas-message% (new canvas-message%
(parent parent) (parent parent)
(label (string-constant seasoned-plt-schemer?)))) (label (string-constant racketeer-or-r6?))))
(list "Module") (λ (panel2)
(new canvas-message%
(parent panel2)
(label "Use the language declared in the source code")
(color (send the-color-database find-color "blue"))
(callback (λ () (change-current-lang-to (λ (x) (is-a? x drracket:module-language:module-language<%>)))))
(font (get-font #:underlined #t))))
(list "PLT-206-small.png" (list "PLT-206-small.png"
"icons"))) "icons")))
@ -1734,8 +1743,10 @@
(new canvas-message% (new canvas-message%
(parent parent) (parent parent)
(label (string-constant looking-for-standard-scheme?)))) (label (string-constant looking-for-standard-scheme?))))
(list (string-constant legacy-languages) (default-line2
(string-constant pretty-big-scheme)) (string-constant pretty-big-scheme)
(list (string-constant legacy-languages)
(string-constant pretty-big-scheme)))
(list "r5rs.png" "icons"))) (list "r5rs.png" "icons")))
(define (display-text-pl lst) (define (display-text-pl lst)
@ -1755,7 +1766,7 @@
(new canvas-message% (new canvas-message%
(parent parent) (parent parent)
(label using-after))) (label using-after)))
lang (default-line2 (last lang) lang)
icon-lst))) icon-lst)))
(define default-font (send the-font-list find-or-create-font (define default-font (send the-font-list find-or-create-font
@ -1811,20 +1822,22 @@
(min-width (inexact->exact (floor w))) (min-width (inexact->exact (floor w)))
(min-height (inexact->exact (floor h)))))) (min-height (inexact->exact (floor h))))))
(define (question/answer line1 lang icon-lst) (define (question/answer line1 line2 icon-lst)
(display-two-line-choice (display-two-line-choice
icon-lst icon-lst
lang
(λ (panel1 panel2) (λ (panel1 panel2)
(line1 panel1) (line1 panel1)
(new canvas-message% (parent panel2) (label (string-constant start-with-before))) (line2 panel2))))
(new canvas-message%
(parent panel2) (define ((default-line2 lang-name lang) panel2)
(label (last lang)) (new canvas-message% (parent panel2) (label (string-constant start-with-before)))
(color (send the-color-database find-color "blue")) (new canvas-message%
(callback (λ () (change-current-lang-to lang))) (parent panel2)
(font (get-font #:underlined #t))) (label lang-name)
(new canvas-message% (parent panel2) (label (string-constant start-with-after)))))) (color (send the-color-database find-color "blue"))
(callback (λ () (change-current-lang-to lang)))
(font (get-font #:underlined #t)))
(new canvas-message% (parent panel2) (label (string-constant start-with-after))))
;; get-text-pls : path -> (listof (list* string string (listof string)) ;; get-text-pls : path -> (listof (list* string string (listof string))
;; gets the questions from an info.rkt file. ;; gets the questions from an info.rkt file.
@ -1859,7 +1872,7 @@
(for-each (λ (b) (send b min-width w)) (for-each (λ (b) (send b min-width w))
msgs))) msgs)))
(define (display-two-line-choice icon-lst lang proc) (define (display-two-line-choice icon-lst proc)
(let* ([hp (new horizontal-pane% (let* ([hp (new horizontal-pane%
(parent qa-panel) (parent qa-panel)
(alignment '(center top)) (alignment '(center top))
@ -1878,17 +1891,17 @@
(proc (new horizontal-pane% (parent vp)) (proc (new horizontal-pane% (parent vp))
(new horizontal-pane% (parent vp))))) (new horizontal-pane% (parent vp)))))
;; change-current-lang-to : (listof string) -> void ;; change-current-lang-to : (or/c (-> any/c boolean?) (listof string)) -> void
;; closed the guidance dialog and opens the language dialog ;; closed the guidance dialog and opens the language dialog
(define (change-current-lang-to lang-strings) (define (change-current-lang-to lang-strings/predicate)
(send dialog show #f) (send dialog show #f)
(let ([lang (ormap (let* ([predicate (if (procedure? lang-strings/predicate)
(λ (x) lang-strings/predicate
(and (equal? lang-strings (send x get-language-position)) (λ (x) (equal? lang-strings/predicate (send x get-language-position))))]
x)) [lang (ormap (λ (x) (and (predicate x) x))
(get-languages))]) (get-languages))])
(unless lang (unless lang
(error 'change-current-lang-to "unknown language! ~s" lang-strings)) (error 'change-current-lang-to "unknown language! ~s" lang-strings/predicate))
(let ([new-lang (let ([new-lang
(language-dialog #f (language-dialog #f

View File

@ -1072,6 +1072,7 @@ please adhere to these guidelines:
(start-with-after "") (start-with-after "")
(seasoned-plt-schemer? "Seasoned PLT Schemer?") (seasoned-plt-schemer? "Seasoned PLT Schemer?")
(racketeer-or-r6? "Racketeer or want to use R6RS?")
(looking-for-standard-scheme? "Looking for standard Scheme?") (looking-for-standard-scheme? "Looking for standard Scheme?")
; the three string constants are concatenated together and the middle ; the three string constants are concatenated together and the middle