suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

improved language portion of initial wizard

Browse Source 
svn: r1078
This commit is contained in:
Robby Findler 2005-10-14 02:18:43 +00:00
parent 2299baf597
commit e1529f3969
8 changed files with 199 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
collects/drscheme/info.ss
View File

@ -1,8 +1,23 @@
(module info (lib "infotab.ss" "setup")
(require (lib "string-constant.ss" "string-constants"))
;; added a comment, in windows ...
(define name "DrScheme")
(define tools (list "syncheck.ss"))
(define tool-names (list "Check Syntax"))
(define splash-questions
(list (list (string-constant use-with-htdp)
(string-constant teaching-languages)
(string-constant how-to-design-programs)
(string-constant beginning-student))
(list (string-constant use-seasoned)
(string-constant professional-languages)
"(module ...)")
(list (string-constant use-other)
(string-constant professional-languages)
(string-constant plt)
(string-constant pretty-big-scheme))))
(define mred-launcher-names (list "DrScheme"))
(define mred-launcher-libraries (list "drscheme.ss"))
(define mred-launcher-flags (list (list "-ZmvqL" "drscheme.ss" "drscheme"))))

185
collects/drscheme/private/app.ss
View File

@ -1,15 +1,17 @@
(module app mzscheme
(require (lib "string-constant.ss" "string-constants")
(lib "unitsig.ss")
(require (lib "unitsig.ss")
(lib "class.ss")
(lib "mred.ss" "mred")
(lib "external.ss" "browser")
"drsig.ss"
"../acks.ss"
(lib "framework.ss" "framework")
(lib "list.ss")
(lib "file.ss")
(lib "check-gui.ss" "version"))
(lib "string-constant.ss" "string-constants")
(lib "mred.ss" "mred")
(lib "framework.ss" "framework")
(lib "external.ss" "browser")
(lib "getinfo.ss" "setup")
(lib "check-gui.ss" "version")
"drsig.ss"
"../acks.ss")
(provide app@)
(define app@
@ -42,7 +44,9 @@
(let ([this-version (version)]
[last-version (preferences:get 'drscheme:last-version)]
[last-language (preferences:get 'drscheme:last-language)])
(when (or (not last-version)
(when (or (and (getenv "PLTDRWIZARD")
(printf "PLTDRWIZARD: showing wizard\n"))
(not last-version)
(not last-language)
(not (equal? last-version this-version))
(not (equal? last-language (this-language))))
@ -160,28 +164,28 @@
(case state
[(natural-language)
(when (okay-to-leave-nl-state?)
(set-state 'check-updates))]
[(check-updates)
(set-state 'programming-language)]
(set-state 'programming-language))]
[(programming-language)
(cond
[(get-selected-language)
(send dlg show #f)]
(set-state 'check-updates)]
[else
(message-box (string-constant drscheme)
(string-constant please-select-a-language))])]))
(string-constant please-select-a-language))])]
[(check-updates)
(send dlg show #f)]))
;; prev-state : -> void
;; pre: state != 'natural-language
(define (prev-state)
(case state
[(programming-language) (set-state 'check-updates)]
[(check-updates) (set-state 'natural-language)]
[else (error 'next-state "no next state from: ~s" state)]))
[(programming-language) (set-state 'natural-language)]
[(check-updates) (set-state 'programming-language)]
[else (error 'prev-state "no prev state from: ~s" state)]))
;; first-state?, last-state? : -> boolean
(define (first-state?) (eq? state 'natural-language))
(define (last-state?) (eq? state 'programming-language))
(define (last-state?) (eq? state 'check-updates))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;
@ -246,7 +250,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;
;; State 2 GUI ;;
;; State 3 GUI ;;
;; ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -286,27 +290,135 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;
;; State 3 GUI ;;
;; State 2 GUI ;;
;; ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; need to sort these somehow ...
(define question/answer-table
(let* ([get-qa
(λ (info-filename)
(let ([proc (get-info/full info-filename)])
(if proc
(let ([qs (proc 'splash-questions)])
(unless (list? qs)
(error 'splash-questions "expected a list, got ~e" qs))
(for-each
(lambda (pr)
(unless (and (pair? pr)
(pair? (cdr pr))
(andmap string? pr))
(error
'splash-questions
"expected a list of lists of strings, with each inner list being at least two elements long, got ~e"
pr)))
qs)
qs)
'())))]
[all-qas
(apply
append
(map get-qa (find-relevant-directories '(splash-questions))))]
[item->index
(lambda (x)
(let loop ([lst all-qas]
[i 0])
(cond
[(equal? (car lst) x) i]
[else (loop (cdr lst)
(+ i 1))])))]
[drs-qas (get-qa (collection-path "drscheme"))]
[in-order
(lambda (s1 s2)
(cond
[(equal? s1 (car drs-qas)) #t]
[(equal? s2 (car (last-pair drs-qas))) #t]
[else
(<= (item->index s1) (item->index s2))]))])
(quicksort all-qas in-order)))
(define programming-language-state-panel (instantiate vertical-panel% ()
(parent sp)
(alignment '(center center))))
(define pl-main-panel (instantiate vertical-panel% ()
(parent programming-language-state-panel)
(stretchable-width #t)
(stretchable-height #t)))
(define pl-outer-panel (new vertical-panel%
(parent programming-language-state-panel)))
(define pl-single-panel (new panel:single%
(parent pl-outer-panel)))
(define pl-button-panel (new horizontal-panel%
(parent pl-outer-panel)
(stretchable-height #f)))
(define pl-show-all-languages? #f)
(define pl-simple-lang-choice (cdr (car question/answer-table)))
(define pl-show-lang-btn
(new button%
(parent pl-button-panel)
(stretchable-width #t)
(label (string-constant show-all-languages))
(callback
(lambda (a b)
(set! pl-show-all-languages? (not pl-show-all-languages?))
(send pl-single-panel active-child
(if pl-show-all-languages?
pl-all-languages-panel
pl-questions-panel))
(send pl-show-lang-btn set-label
(if pl-show-all-languages?
(string-constant show-drscheme-usage-questions)
(string-constant show-all-languages)))))))
(define pl-questions-panel (new vertical-panel%
(parent pl-single-panel)))
(define pl-msg-rb-parent1
(new vertical-panel%
(parent pl-questions-panel)
(alignment '(center center))))
(define pl-msg-rb-parent2
(new vertical-panel%
(parent pl-msg-rb-parent1)
(alignment '(left center))))
(define pl-are-you-message
(new message%
(label (string-constant are-you...-kind-of-drscheme-user))
(parent pl-msg-rb-parent2)))
(define pl-radio-box
(new radio-box%
(label #f)
(choices (map car question/answer-table))
(parent pl-msg-rb-parent2)
(callback
(lambda (a b)
(let* ([i (send pl-radio-box get-selection)]
[q/a (list-ref question/answer-table i)])
(send pl-lang-message set-label
(format
(string-constant pl-lang-choice-format)
(car (last-pair q/a))))
(set! pl-simple-lang-choice (cdr q/a)))))))
(define pl-lang-message (new message%
(stretchable-width #t)
(label (format
(string-constant pl-lang-choice-format)
(car (last-pair (car question/answer-table)))))
(parent pl-questions-panel)))
(define pl-all-languages-panel
(instantiate vertical-panel% ()
(parent pl-single-panel)
(stretchable-width #t)
(stretchable-height #t)))
(define pl-choose-language-message
(instantiate message% ()
(parent pl-main-panel)
(parent pl-all-languages-panel)
(label (string-constant please-select-a-language))))
(define language-config-panel (make-object vertical-panel% pl-main-panel))
(define language-config-panel (make-object vertical-panel% pl-all-languages-panel))
(define language-config-button-panel (instantiate horizontal-panel% ()
(parent pl-main-panel)
(parent pl-all-languages-panel)
(stretchable-height #f)))
(define-values (get-selected-language get-selected-language-settings)
(define-values (get-all-lang-selected-language get-all-lang-selected-language-settings)
(drscheme:language-configuration:fill-language-dialog
language-config-panel
language-config-button-panel
@ -314,6 +426,23 @@
drscheme:language-configuration:settings-preferences-symbol)
dlg))
(define (get-selected-language)
(cond
[pl-show-all-languages? (get-all-lang-selected-language)]
[else
(let ([langs (drscheme:language-configuration:get-languages)])
(or (ormap (λ (lang)
(and (equal? pl-simple-lang-choice
(send lang get-language-position))
lang))
langs)
(car langs)))]))
(define (get-selected-language-settings)
(cond
[pl-show-all-languages? (get-all-lang-selected-language-settings)]
[else (send (get-selected-language) default-settings)]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;
;; GO ;;

2
collects/drscheme/private/drsig.ss
View File

@ -91,6 +91,7 @@
(define-signature drscheme:language-configuration^
(add-language
get-languages
(struct language-settings (language settings) -setters)
get-settings-preferences-symbol
language-dialog
@ -100,7 +101,6 @@
(add-info-specified-languages
get-default-language-settings
(open drscheme:language-configuration^)
get-languages
settings-preferences-symbol
add-built-in-languages

8
collects/drscheme/private/number-snip.ss
View File

@ -1,11 +1,3 @@
#|
This file is only here for backwards compatibility reasons.
Old, saved number snips expect to find this file to be
load-able in mred.
|#
(module number-snip mzscheme
(require (lib "mred.ss" "mred")
(lib "class.ss")

3
collects/drscheme/private/rep.ss
View File

@ -1095,7 +1095,8 @@ TODO
(parameterize ([current-eventspace (get-user-eventspace)])
(queue-callback
(λ ()
(thnk)
(parameterize ([current-error-port drscheme:init:original-output-port])
(thnk))
(semaphore-post wait))))
(semaphore-wait wait)))])

7
collects/drscheme/private/tool-contracts.ss
View File

@ -758,6 +758,13 @@
; ; ;
; ;;;;
(drscheme:language-configuration:get-languages
(-> (listof (is-a?/c drscheme:language:language<%>)))
()
"This can only be called after all of the tools initialization phases have completed."
""
"Returns the list of all of the langauges installed in DrScheme.")
(drscheme:language-configuration:add-language
((and/c (is-a?/c drscheme:language:language<%>) language-object)
. -> . void?)

5
collects/eopl/info.ss
View File

@ -1,7 +1,12 @@
(module info (lib "infotab.ss" "setup")
(require (lib "string-constant.ss" "string-constants"))
(define name "EoPL")
(define doc.txt "doc.txt")
(define tools (list "eopl-tool.ss"))
(define splash-questions
(list (list (string-constant use-eopl)
(string-constant teaching-languages)
"Essentials of Programming Languages (2nd ed.)")))
(define tool-icons (list "eopl-small.gif"))
(define tool-names (list "Essentials of Programming Languages"))
(define tool-urls (list "http://www.cs.indiana.edu/eopl/")))

14
collects/string-constants/english-string-constants.ss
View File

@ -945,9 +945,19 @@ please adhere to these guidelines:
(use-mixed-fractions "Mixed fractions")
(use-repeating-decimals "Repeating decimals")
(decimal-notation-for-rationals "Use decimal notation for rationals")
(please-select-a-language "Please select a language")
;; startup wizard screen language selection section
(please-select-a-language "Please select a language")
(show-all-languages "Show all languages")
(show-drscheme-usage-questions "Show DrScheme usage questions")
(are-you...-kind-of-drscheme-user "Are you...")
(use-with-htdp "... using DrScheme with How to Design Programs?")
(use-seasoned "... a seasoned PLT Schemer?")
(use-other "... using DrScheme for some other reason?")
(use-eopl "... using DrScheme with Essentials of Programming Languages?")
(pl-lang-choice-format "Initial language: ~a")
;;; languages
(beginning-student "Beginning Student")
(beginning-one-line-summary "define, cond, structs, constants, and primitives")