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

Rackety (mostly to bring down below 102 columns)

Browse Source
This commit is contained in:
Robby Findler 2014-04-22 07:55:20 -05:00
parent 14bbd662e9
commit 8d46df4ba1
1 changed files with 295 additions and 206 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

501
pkgs/drracket-pkgs/drracket/drracket/private/language-configuration.rkt
View File

@ -1,6 +1,5 @@
#lang racket/base #lang racket/base
(require (prefix-in : mred/mred) ;; ensure that this module is always loaded since it is shared below for pretty big (require racket/unit
racket/unit
mrlib/hierlist mrlib/hierlist
racket/class racket/class
racket/contract racket/contract
@ -19,12 +18,18 @@
net/url net/url
syntax/toplevel syntax/toplevel
browser/external browser/external
(only-in mzlib/struct make-->vector)) (only-in mzlib/struct make-->vector)
;; ensure that this module is always loaded since it is shared below for pretty big
(prefix-in : mred/mred))
(define original-output (current-output-port)) (define original-output (current-output-port))
(define (oprintf . args) (apply fprintf original-output args)) (define (oprintf . args) (apply fprintf original-output args))
(define-values (sc-use-language-in-source sc-use-teaching-language sc-choose-a-language mouse-event-uses-shortcut-prefix?) (define-values (sc-use-language-in-source
sc-use-teaching-language
sc-choose-a-language
mouse-event-uses-shortcut-prefix?)
(let* ([shortcut-prefix (get-default-shortcut-prefix)] (let* ([shortcut-prefix (get-default-shortcut-prefix)]
[menukey-string [menukey-string
(apply string-append (apply string-append
@ -102,14 +107,17 @@
;; add-language : (instanceof language%) -> void ;; add-language : (instanceof language%) -> void
;; only allows addition on phase2 ;; only allows addition on phase2
;; effect: updates `languages' ;; effect: updates `languages'
(define (add-language language [front? #f] #:allow-executable-creation? [allow-executable-creation? #f]) (define (add-language language [front? #f]
#:allow-executable-creation? [allow-executable-creation? #f])
(drracket:tools:only-in-phase 'drracket:language:add-language 'phase2) (drracket:tools:only-in-phase 'drracket:language:add-language 'phase2)
(for-each (for-each
(λ (i<%>) (λ (i<%>)
(unless (is-a? language i<%>) (unless (is-a? language i<%>)
(error 'drracket:language:add-language (error 'drracket:language:add-language
"expected language ~e to implement ~e, forgot to use `drracket:language:get-default-mixin'?" (string-append
"expected language ~e to implement ~e,"
" forgot to use `drracket:language:get-default-mixin'?")
language i<%>))) language i<%>)))
(drracket:language:get-language-extensions)) (drracket:language:get-language-extensions))
@ -158,22 +166,41 @@
;
; ;
; ;
; ; ; ; ; ;
; ; ; ; ;
; ; ; ; ; ;;;
; ; ;;; ; ;; ;; ; ; ; ;;; ;; ; ;;; ;; ; ; ;;; ; ;;; ;; ; ; ;;;
; ; ; ; ;; ; ; ;; ; ; ; ; ; ;; ; ; ; ;; ; ; ; ; ; ; ; ;; ; ;;; ;;;;; ;;; ;; ;; ;;; ;;; ;;; ;;;;; ;; ;;; ;;;;
; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;;; ;;;;;;; ;;;;;;; ;;;;;;; ;;; ;;; ;;;;;;; ;;;;;;; ;; ;;;
; ; ;;;; ; ; ; ; ; ; ;;;; ; ; ;;;;;; ; ; ; ;;;; ; ; ; ; ; ; ;;; ;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;; ;;; ;;; ;;; ;;; ;;;
; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;;; ;;;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;;;; ;;; ;;; ;;;;;;;
; ; ; ; ; ; ; ;; ; ;; ; ; ; ;; ; ; ;; ; ; ; ; ; ; ; ;; ; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;;
; ; ;;;;; ; ; ;; ; ;; ; ;;;;; ;; ; ;;;; ;; ; ; ;;;;; ; ;;; ;; ; ; ;;; ;;; ;;; ;;; ;;; ;;;;;;; ;;;;;;; ;;; ;;; ;;;;;;; ;;;;;;
; ; ; ; ; ;;; ;;;;;; ;;; ;;; ;; ;;; ;; ;;; ;;;;;; ;; ;;; ;;;;
; ; ; ; ; ; ; ; ;;; ;;;
; ;;;; ;;;; ;;;; ; ;;;;;; ;;;;;;
;
;
;
;
;
;
; ;;; ;;; ;;;
; ;;; ;;;
; ;; ;;; ;;; ;;;;; ;;; ;;; ;; ;;;
; ;;;;;;; ;;; ;;;;;;; ;;; ;;;;; ;;;;;;;
; ;;; ;;; ;;; ;; ;;; ;;; ;;; ;;; ;;; ;;;
; ;;; ;;; ;;; ;;;;; ;;; ;;; ;;; ;;; ;;;
; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;;
; ;;;;;;; ;;; ;;; ;;; ;;; ;;;;; ;;;;;;;
; ;; ;;; ;;; ;;;;;; ;;; ;;; ;; ;;;
; ;;;
; ;;;;;;
;
;
;; language-dialog : (boolean language-setting -> (union #f language-setting)) ;; language-dialog : (boolean language-setting -> (union #f language-setting))
@ -294,9 +321,10 @@
(get-selected-language) (get-selected-language)
(get-selected-language-settings))))) (get-selected-language-settings)))))
;; fill-language-dialog : (vertical-panel panel language-setting -> language-setting) ;; fill-language-dialog :
;; (union dialog #f) [...more stuff...] ;; (vertical-panel panel language-setting -> language-setting)
;; -> (-> (union #f language<%>)) (-> settings[corresponding to fst thnk result]) ;; (union dialog #f) [...more stuff...]
;; -> (-> (union #f language<%>)) (-> settings[corresponding to fst thnk result])
;; allows the user to configure their language. The input language-setting is used ;; allows the user to configure their language. The input language-setting is used
;; as the defaults in the dialog and the output language setting is the user's choice ;; as the defaults in the dialog and the output language setting is the user's choice
;; if re-center is a dialog, when the show details button is clicked, the dialog is recenterd. ;; if re-center is a dialog, when the show details button is clicked, the dialog is recenterd.
@ -563,7 +591,9 @@
[stretchable-width #f] [stretchable-width #f]
[min-width 32])) [min-width 32]))
(define in-source-discussion-editor-canvas (define in-source-discussion-editor-canvas
(add-discussion in-source-discussion-panel definitions-text use-language-in-source-rb-callback)) (add-discussion in-source-discussion-panel
definitions-text
use-language-in-source-rb-callback))
(define most-recent-languages-hier-list-selection (define most-recent-languages-hier-list-selection
(preferences:get 'drracket:language-dialog:hierlist-default)) (preferences:get 'drracket:language-dialog:hierlist-default))
(define most-recent-teaching-languages-hier-list-selection (define most-recent-teaching-languages-hier-list-selection
@ -630,33 +660,35 @@
[parent languages-hier-list-panel] [parent languages-hier-list-panel]
[stretchable-width #f] [stretchable-width #f]
[min-width 32])) [min-width 32]))
(define ellipsis-message (new (class canvas% (define ellipsis-message
(define/override (on-paint) (new (class canvas%
(define dc (get-dc)) (define/override (on-paint)
(send dc set-font normal-control-font) (define dc (get-dc))
(send dc draw-text "..." 0 0)) (send dc set-font normal-control-font)
(define/override (on-event evt) (send dc draw-text "..." 0 0))
(when (send evt button-up?) (define/override (on-event evt)
(show-other-languages))) (when (send evt button-up?)
(inherit get-dc min-width min-height) (show-other-languages)))
(super-new [style '(transparent)] (inherit get-dc min-width min-height)
[parent languages-hier-list-panel] (super-new [style '(transparent)]
[stretchable-width #f] [parent languages-hier-list-panel]
[stretchable-height #t]) [stretchable-width #f]
(let () [stretchable-height #t])
(define dc (get-dc)) (let ()
(define-values (w h _1 _2) (send dc get-text-extent "..." normal-control-font)) (define dc (get-dc))
(min-width (inexact->exact (ceiling w))) (define-values (w h _1 _2) (send dc get-text-extent "..." normal-control-font))
(min-height (inexact->exact (ceiling h))))))) (min-width (inexact->exact (ceiling w)))
(min-height (inexact->exact (ceiling h)))))))
(define languages-hier-list-spacer (new horizontal-panel% (define languages-hier-list-spacer (new horizontal-panel%
[parent languages-hier-list-panel] [parent languages-hier-list-panel]
[stretchable-width #f] [stretchable-width #f]
[min-width 16])) [min-width 16]))
(define other-languages-hier-list (new selectable-hierlist% (define other-languages-hier-list
[parent languages-hier-list-panel] (new selectable-hierlist%
[style '(no-border no-hscroll auto-vscroll transparent)])) [parent languages-hier-list-panel]
[style '(no-border no-hscroll auto-vscroll transparent)]))
(define details-outer-panel (make-object vertical-pane% 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/manual-parent-panel (make-object vertical-panel% details-outer-panel))
(define details-panel (make-object panel:single% details/manual-parent-panel)) (define details-panel (make-object panel:single% details/manual-parent-panel))
@ -688,10 +720,14 @@
(init-rest args) (init-rest args)
(define/public (get-language) language) (define/public (get-language) language)
(define/public (selected) (define/public (selected)
(update-gui-based-on-selected-language language get-language-details-panel get/set-settings)) (update-gui-based-on-selected-language language
get-language-details-panel
get/set-settings))
(apply super-make-object args)))) (apply super-make-object args))))
(define (update-gui-based-on-selected-language language get-language-details-panel get/set-settings) (define (update-gui-based-on-selected-language language
get-language-details-panel
get/set-settings)
(let ([ldp (get-language-details-panel)]) (let ([ldp (get-language-details-panel)])
(when ldp (when ldp
(send details-panel active-child ldp))) (send details-panel active-child ldp)))
@ -793,7 +829,9 @@
(when (null? (cdr positions)) (when (null? (cdr positions))
(unless (equal? positions (list (string-constant module-language-name))) (unless (equal? positions (list (string-constant module-language-name)))
(error 'drracket:language (error 'drracket:language
"Only the module language may be at the top level. Other languages must have at least two levels"))) (string-append
"Only the module language may be at the top level."
" Other languages must have at least two levels"))))
(send other-languages-hier-list clear-fringe-cache) (send other-languages-hier-list clear-fringe-cache)
(send teaching-languages-hier-list clear-fringe-cache) (send teaching-languages-hier-list clear-fringe-cache)
@ -817,7 +855,10 @@
(cdr numbers) (cdr numbers)
numbers)] numbers)]
[first? #t] [first? #t]
[second-number #f]) ;; only non-#f during the second iteration in which case it is the first iterations number
;; only non-#f during the second iteration
;; in which case it is the first iterations number
[second-number #f])
(cond (cond
[(null? (cdr positions)) [(null? (cdr positions))
(let* ([language-details-panel #f] (let* ([language-details-panel #f]
@ -875,7 +916,9 @@
[else [else
(let* ([mixin (compose (let* ([mixin (compose
number-mixin number-mixin
(language-mixin language get-language-details-panel get/set-settings))] (language-mixin language
get-language-details-panel
get/set-settings))]
[item [item
(send hier-list new-item (send hier-list new-item
(if second-number (if second-number
@ -986,7 +1029,8 @@
(define/public (set-second-number _second-number) (set! second-number _second-number)) (define/public (set-second-number _second-number) (set! second-number _second-number))
(super-instantiate ()))) (super-instantiate ())))
;; make-details-panel : ((instanceof language<%>) -> (values panel (case-> (-> settings) (settings -> void)))) ;; make-details-panel : (instanceof language<%>)
;; -> (values panel (case-> (-> settings) (settings -> void)))
;; adds a details panel for `language', using ;; adds a details panel for `language', using
;; the language's default settings, unless this is ;; the language's default settings, unless this is
;; the to-show language. ;; the to-show language.
@ -1034,7 +1078,8 @@
[(not (and language-to-show settings-to-show)) [(not (and language-to-show settings-to-show))
(no-language-selected)] (no-language-selected)]
[(is-a? language-to-show drracket:module-language:module-language<%>) [(is-a? language-to-show drracket:module-language:module-language<%>)
;; the above changes the radio button selections, so do it before calling module-language-selected ;; the above changes the radio button selections,
;; so do it before calling module-language-selected
(module-language-selected)] (module-language-selected)]
[else [else
(define position (send language-to-show get-language-position)) (define position (send language-to-show get-language-position))
@ -1081,7 +1126,8 @@
[(null? position) [(null? position)
(send child select #t)] (send child select #t)]
[else [else
(when (is-a? child hierarchical-list-compound-item<%>) ;; test can fail when prefs are bad ;; test can fail when prefs are bad
(when (is-a? child hierarchical-list-compound-item<%>)
(send child open) (send child open)
(loop child (car position) (cdr position)))]))])))])) (loop child (car position) (cdr position)))]))])))]))
@ -1232,8 +1278,9 @@
(do-construct-details)) (do-construct-details))
(update-show/hide-details) (update-show/hide-details)
(when get/set-selected-language-settings (when get/set-selected-language-settings
;; this call to get/set-selected-language-settings has to come after the call to do-construct-details above ;; this call to get/set-selected-language-settings has to come after the call
;; because do-construct-details sets all of the controls to the language's default settings ;; to do-construct-details above because do-construct-details sets all of the
;; controls to the language's default settings
(get/set-selected-language-settings settings-to-show)) (get/set-selected-language-settings settings-to-show))
(size-discussion-canvas in-source-discussion-editor-canvas) (size-discussion-canvas in-source-discussion-editor-canvas)
(values (values
@ -1276,7 +1323,9 @@
[editor t])) [editor t]))
(send t set-styles-sticky #f) (send t set-styles-sticky #f)
(send t set-autowrap-bitmap #f) (send t set-autowrap-bitmap #f)
(define size-sd (make-object style-delta% 'change-size (send normal-control-font get-point-size))) (define size-sd (make-object style-delta%
'change-size
(send normal-control-font get-point-size)))
(define (do-insert str tt-style?) (define (do-insert str tt-style?)
(define before (send t last-position)) (define before (send t last-position))
(send t insert str before before) (send t insert str before before)
@ -1324,8 +1373,9 @@
(if definitions-text (if definitions-text
(find-language-position definitions-text) (find-language-position definitions-text)
(values #f #f))) (values #f #f)))
(define existing-lang-line (and current-line-start (define existing-lang-line
(send definitions-text get-text current-line-start current-line-end))) (and current-line-start
(send definitions-text get-text current-line-start current-line-end)))
(case (message-box/custom (case (message-box/custom
(string-constant drscheme) (string-constant drscheme)
(string-append (string-append
@ -1341,7 +1391,8 @@
existing-lang-line existing-lang-line
the-lang-line)] the-lang-line)]
[else [else
(format (string-constant racket-dialect-add-new-#lang-line) the-lang-line)])) (format (string-constant racket-dialect-add-new-#lang-line)
the-lang-line)]))
(cond (cond
[(and existing-lang-line [(and existing-lang-line
(equal? existing-lang-line the-lang-line)) (equal? existing-lang-line the-lang-line))
@ -1359,7 +1410,10 @@
[current-line-start [current-line-start
(send definitions-text begin-edit-sequence) (send definitions-text begin-edit-sequence)
(send definitions-text delete current-line-start current-line-end) (send definitions-text delete current-line-start current-line-end)
(send definitions-text insert the-lang-line current-line-start current-line-start) (send definitions-text insert
the-lang-line
current-line-start
current-line-start)
(send definitions-text end-edit-sequence)] (send definitions-text end-edit-sequence)]
[else [else
(send definitions-text begin-edit-sequence) (send definitions-text begin-edit-sequence)
@ -1597,34 +1651,41 @@
(floor (inexact->exact (unbox y-box)))))) (floor (inexact->exact (unbox y-box))))))
;
; ;
; ; ;;; ;
; ; ;
; ;;; ;; ;; ;;;;; ;;; ;;;; ;;;; ;
; ; ;; ; ; ; ; ; ; ; ; ; ;;; ;;;;
; ; ; ; ; ; ; ;;; ;;; ; ;;;
; ; ; ; ; ; ; ; ; ; ;;; ;;; ;; ;;;; ;;; ;;;; ;;;;
; ; ; ; ; ; ; ;; ; ; ; ; ; ;;; ;;;;;;; ;;;; ;;;;; ;;; ;; ;;; ;;
; ;;;;; ;;; ;;; ;;;;; ;;; ;; ;;;; ;;;; ; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;;
; ; ;;; ;;; ;;; ;;; ;;; ;;; ;;;; ;;;;
; ; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;;
; ; ;;; ;;; ;;; ;;; ;;;;; ;;; ;; ;;; ;; ;;;
; ; ;;; ;;; ;;; ;;; ;;; ;;; ;;;; ;;;;
; ;
; ;
; ;; ;
; ; ;
; ; ;;; ;; ;; ;; ;;;; ;; ;;; ;; ;; ;;; ;;;; ;
; ; ; ; ;; ; ; ;; ; ; ; ; ; ;; ; ; ; ; ;
; ; ;;;; ; ; ; ; ; ; ;;;; ; ; ;;;;; ;;; ;
; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;
; ; ; ; ; ; ; ; ; ;; ; ; ; ; ; ; ; ; ;;;
; ;;;;; ;;;;;;;; ;;; ;;;; ;; ;; ;;;;; ;;;; ;;;; ;;;; ; ;;;
; ; ; ; ;;; ;;;;; ;;; ;; ;; ;;; ;;; ;;; ;;;;; ;; ;;; ;;;; ;;;;
; ;;; ;;; ; ;;; ;;;;;;; ;;;;;;; ;;;;;;; ;;; ;;; ;;;;;;; ;;;;;;; ;; ;;; ;;; ;;
; ; ;;; ;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;; ;;; ;;; ;;; ;;; ;;; ;;;
; ; ;;; ;;;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;;;; ;;; ;;; ;;;;;;; ;;;;
; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;;
; ;;; ;;; ;;; ;;; ;;; ;;;;;;; ;;;;;;; ;;; ;;; ;;;;;;; ;;;;;; ;; ;;;
; ;;; ;;;;;; ;;; ;;; ;; ;;; ;; ;;; ;;;;;; ;; ;;; ;;;; ;;;;
; ;;; ;;;
; ;;;;;; ;;;;;;
;
;
(define (add-info-specified-languages) (define (add-info-specified-languages)
(for-each add-info-specified-language (for-each add-info-specified-language
@ -1634,9 +1695,10 @@
(define (add-info-specified-language directory) (define (add-info-specified-language directory)
(let ([info-proc (get-info/full directory)]) (let ([info-proc (get-info/full directory)])
(when info-proc (when info-proc
(let* ([lang-positions (append (let* ([lang-positions
(info-proc 'drscheme-language-positions (λ () null)) (append
(indirect-info-field info-proc 'get-drscheme-language-positions directory))] (info-proc 'drscheme-language-positions (λ () null))
(indirect-info-field info-proc 'get-drscheme-language-positions directory))]
[lang-modules (info-proc 'drscheme-language-modules (λ () null))] [lang-modules (info-proc 'drscheme-language-modules (λ () null))]
[numberss (info-proc 'drscheme-language-numbers [numberss (info-proc 'drscheme-language-numbers
(λ () (λ ()
@ -1693,66 +1755,66 @@
(length summaries) (length summaries)
(length urls) (length urls)
(length reader-specs))) (length reader-specs)))
(for-each
(λ (lang-module lang-position lang-numbers one-line-summary url reader-spec) (for ([lang-module (in-list lang-modules)]
(let ([% [lang-position (in-list lang-positions)]
((drracket:language:get-default-mixin) [lang-numbers (in-list numberss)]
(drracket:language:module-based-language->language-mixin [one-line-summary (in-list summaries)]
(drracket:language:simple-module-based-language->module-based-language-mixin [url (in-list urls)]
drracket:language:simple-module-based-language%)))] [reader-spec (in-list reader-specs)])
[reader (define %
(if reader-spec ((drracket:language:get-default-mixin)
(with-handlers ([exn:fail? (drracket:language:module-based-language->language-mixin
(λ (x) (drracket:language:simple-module-based-language->module-based-language-mixin
(message-box (string-constant drscheme) drracket:language:simple-module-based-language%))))
(if (exn? x) (define reader
(exn-message x) (if reader-spec
(format "uncaught exception: ~s" x)) (with-handlers ([exn:fail?
#:dialog-mixin frame:focus-table-mixin) (λ (x)
read-syntax/namespace-introduce)]) (message-box (string-constant drscheme)
(contract (if (exn? x)
(->* () (exn-message x)
(any/c port?) (format "uncaught exception: ~s" x))
(or/c syntax? eof-object?)) #:dialog-mixin frame:focus-table-mixin)
(dynamic-require read-syntax/namespace-introduce)])
(cond (contract
[(string? reader-spec) (->* ()
(build-path (any/c port?)
directory (or/c syntax? eof-object?))
(platform-independent-string->path reader-spec))] (dynamic-require
[else reader-spec]) (cond
'read-syntax) [(string? reader-spec)
(string->symbol (format "~s" lang-position)) (build-path
'drscheme)) directory
read-syntax/namespace-introduce)]) (platform-independent-string->path reader-spec))]
(add-language (instantiate % () [else reader-spec])
(module (if (string? lang-module) 'read-syntax)
(string->symbol (format "~s" lang-position))
'drscheme))
read-syntax/namespace-introduce))
(add-language (new %
[module (if (string? lang-module)
(build-path (build-path
directory directory
(platform-independent-string->path lang-module)) (platform-independent-string->path lang-module))
`(lib ,@lang-module))) `(lib ,@lang-module))]
(language-position lang-position) [language-position lang-position]
(language-id (format "plt:lang-from-module: ~s" lang-module)) [language-id (format "plt:lang-from-module: ~s" lang-module)]
(language-numbers lang-numbers) [language-numbers lang-numbers]
(one-line-summary one-line-summary) [one-line-summary one-line-summary]
(language-url url) [language-url url]
(reader reader))))) [reader reader])))]
lang-modules
lang-positions
numberss
summaries
urls
reader-specs)]
[else [else
(message-box (message-box
(string-constant drscheme) (string-constant drscheme)
(format (format
(string-append (string-append
"The drscheme-language-position, drscheme-language-modules, drscheme-language-numbers," "The drscheme-language-position, drscheme-language-modules,"
" and drscheme-language-readers specifications aren't correct. Expected" " drscheme-language-numbers, and drscheme-language-readers specifications"
" (listof (cons string (listof string))), (listof (listof string)), (listof (listof number)), (listof string)," " aren't correct. Expected (listof (cons string (listof string))),"
" (listof string), and (listof module-spec) respectively, where the lengths of the outer lists are the same." " (listof (listof string)), (listof (listof number)), (listof string),"
" Got ~e, ~e, ~e, ~e, ~e, and ~e") " (listof string), and (listof module-spec) respectively, where the lengths"
" of the outer lists are the same. Got ~e, ~e, ~e, ~e, ~e, and ~e")
lang-positions lang-positions
lang-modules lang-modules
numberss numberss
@ -1795,34 +1857,42 @@
; ;
; ;
; ;; ; ;; ; ;
; ; ; ; ;
; ; ;; ;; ;; ;;; ; ;;;;; ;;; ;; ;; ;
; ;; ; ; ; ; ; ; ; ;; ; ; ;;; ;;; ;;; ; ;;;
; ; ; ; ; ; ; ; ;;;;; ; ; ; ; ;;; ;;; ;;;
; ; ; ; ; ; ; ; ; ; ; ; ;;; ;; ;;; ;;; ;;; ;;; ;;;; ;;; ;;; ;;
; ; ; ; ;; ; ; ; ; ; ; ; ; ;;;;;;; ;;; ;;; ;;; ;;; ;;;; ;;; ;;;;;;;
; ;;;;; ;; ;; ;;;;; ;;;;; ;;; ;;;;; ;;; ;;; ; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;;
; ; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;;;;;; ;;; ;;;
; ; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;;;;;; ;;; ;;;
; ; ;;;;;;; ;;;;;;; ;;; ;;; ;;;; ;;; ;;; ;;;
; ; ;;; ;; ;; ;;; ;;; ;;; ;;; ;;; ;;; ;;;
; ;
; ;
; ;; ;
; ; ;
; ; ;;; ;; ;; ;; ;;;; ;; ;;; ;; ;; ;;; ;;;; ;
; ; ; ; ;; ; ; ;; ; ; ; ; ; ;; ; ; ; ; ;
; ; ;;;; ; ; ; ; ; ; ;;;; ; ; ;;;;; ;;; ;
; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;
; ; ; ; ; ; ; ; ; ;; ; ; ; ; ; ; ; ; ;;;
; ;;;;; ;;;;;;;; ;;; ;;;; ;; ;; ;;;;; ;;;; ;;;; ;;;; ; ;;;
; ; ; ; ;;; ;;;;; ;;; ;; ;; ;;; ;;; ;;; ;;;;; ;; ;;; ;;;; ;;;;
; ;;; ;;; ; ;;; ;;;;;;; ;;;;;;; ;;;;;;; ;;; ;;; ;;;;;;; ;;;;;;; ;; ;;; ;;; ;;
; ; ;;; ;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;; ;;; ;;; ;;; ;;; ;;; ;;;
; ; ;;; ;;;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;;;; ;;; ;;; ;;;;;;; ;;;;
; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;;
; ;;; ;;; ;;; ;;; ;;; ;;;;;;; ;;;;;;; ;;; ;;; ;;;;;;; ;;;;;; ;; ;;;
; ;;; ;;;;;; ;;; ;;; ;; ;;; ;; ;;; ;;;;;; ;; ;;; ;;;; ;;;;
; ;;; ;;;
; ;;;;;; ;;;;;;
;
;
;; add-expand-to-front-end : mixin ;; add-expand-to-front-end : mixin
@ -2003,18 +2073,18 @@
(super-new))))] (super-new))))]
[make-simple [make-simple
(λ (module id position numbers mred-launcher? one-line-summary extra-mixin) (λ (module id position numbers mred-launcher? one-line-summary extra-mixin)
(let ([% (define %
(extra-mixin (extra-mixin
((extras-mixin mred-launcher? one-line-summary) ((extras-mixin mred-launcher? one-line-summary)
((drracket:language:get-default-mixin) ((drracket:language:get-default-mixin)
(drracket:language:module-based-language->language-mixin (drracket:language:module-based-language->language-mixin
(drracket:language:simple-module-based-language->module-based-language-mixin (drracket:language:simple-module-based-language->module-based-language-mixin
drracket:language:simple-module-based-language%)))))]) drracket:language:simple-module-based-language%))))))
(instantiate % () (new %
(module module) (module module)
(language-id id) (language-id id)
(language-position position) (language-position position)
(language-numbers numbers))))]) (language-numbers numbers)))])
(add-language (add-language
(make-simple '(lib "lang/plt-pretty-big.rkt") (make-simple '(lib "lang/plt-pretty-big.rkt")
"plt:pretty-big" "plt:pretty-big"
@ -2023,7 +2093,9 @@
(list -200 3) (list -200 3)
#t #t
(string-constant pretty-big-scheme-one-line-summary) (string-constant pretty-big-scheme-one-line-summary)
(λ (%) (pretty-big-mixin (macro-stepper-mixin (assume-mixin (add-errortrace-key-mixin %))))))) (λ (%) (pretty-big-mixin
(macro-stepper-mixin
(assume-mixin (add-errortrace-key-mixin %)))))))
(add-language (add-language
(make-simple '(lib "r5rs/lang.rkt") (make-simple '(lib "r5rs/lang.rkt")
"plt:r5rs" "plt:r5rs"
@ -2032,7 +2104,9 @@
(list -200 -1000) (list -200 -1000)
#f #f
(string-constant r5rs-one-line-summary) (string-constant r5rs-one-line-summary)
(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 'racket/base (make-simple 'racket/base
@ -2076,20 +2150,24 @@
;
; ;
; ;; ;
; ; ; ;
; ;; ;; ;;; ;;;;; ;;; ; ;;; ;; ;; ;; ;;;; ;; ;;; ;; ;; ;;; ;
; ;; ; ; ; ; ; ; ; ; ; ;; ; ; ;; ; ; ; ; ; ;; ; ; ; ; ;;;
; ; ; ; ; ; ;;;;; ;;;; ;;;;; ; ;;;; ; ; ; ; ; ; ;;;; ; ; ;;;;; ; ;;; ;;;
; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;;; ;; ;;; ;;;; ;;;;; ;;; ;;;;; ;;; ;; ;; ;;; ;;; ;;; ;;;;; ;; ;;; ;;;;
; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;; ; ; ; ; ; ; ;;;;;;; ;;;;; ;;;; ;;;;;;; ;;; ;;;;;;; ;;;;;;; ;;;;;;; ;;; ;;; ;;;;;;; ;;;;;;; ;; ;;;
; ;;; ;;; ;;; ;;; ;;;;; ;;;;; ;;;;;;;; ;;; ;;;; ;; ;; ;;;;; ;;;; ;;;; ; ;;; ;;; ;;; ;;; ;;; ;; ;;; ;;; ;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;; ;;; ;;; ;;; ;;; ;;;
; ; ; ; ;;; ;;; ;;; ;;; ;;; ;;;; ;;;;; ;;;;;;; ;;;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;;;; ;;; ;;; ;;;;;;;
; ;;; ;;; ; ;;; ;;; ;;; ;;; ;;; ;;;;;;; ;;; ;;;;;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;;
; ; ;;; ;;; ;;;;; ;;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;;;;;; ;;;;;;; ;;; ;;; ;;;;;;; ;;;;;;
; ; ;;; ;;; ;;; ;;; ;;;;;; ;;; ;;;;;; ;;; ;;; ;; ;;; ;; ;;; ;;;;;; ;; ;;; ;;;;
; ;;; ;;;
; ;;;;;; ;;;;;;
;
;
(define (not-a-language-message) (define (not-a-language-message)
@ -2177,8 +2255,15 @@
(parent drs-frame) (parent drs-frame)
(label (string-constant drscheme)))) (label (string-constant drscheme))))
(define top-hp (new horizontal-pane% [parent dialog])) (define top-hp (new horizontal-pane% [parent dialog]))
(define qa-panel (new vertical-panel% [style '(border)] (parent top-hp) (stretchable-width #f))) (define qa-panel (new vertical-panel%
(define racketeer-panel (new vertical-panel% [style '(border)] [parent top-hp] [alignment '(center center)] [stretchable-width #f])) [style '(border)]
[parent top-hp]
[stretchable-width #f]))
(define racketeer-panel (new vertical-panel%
[style '(border)]
[parent top-hp]
[alignment '(center center)]
[stretchable-width #f]))
(define button-panel (new horizontal-pane% (define button-panel (new horizontal-pane%
(parent dialog) (parent dialog)
(stretchable-height #f) (stretchable-height #f)
@ -2227,7 +2312,9 @@
(for-each (for-each
display-text-pl display-text-pl
(sort (sort
(apply append (map get-text-pls (find-relevant-directories '(textbook-pls get-textbook-pls)))) (apply append
(map get-text-pls
(find-relevant-directories '(textbook-pls get-textbook-pls))))
(λ (x y) (λ (x y)
(cond (cond
[(string=? (cadr x) (string-constant how-to-design-programs)) [(string=? (cadr x) (string-constant how-to-design-programs))
@ -2244,12 +2331,14 @@
(new canvas-message% (new canvas-message%
[label (read-bitmap (collection-file-path "plt-logo-red-shiny.png" "icons"))] [label (read-bitmap (collection-file-path "plt-logo-red-shiny.png" "icons"))]
[parent racketeer-panel] [parent racketeer-panel]
[callback (λ () (change-current-lang-to (λ (x) (is-a? x drracket:module-language:module-language<%>))))]) [callback (λ () (change-current-lang-to
(λ (x) (is-a? x drracket:module-language:module-language<%>))))])
(new canvas-message% (new canvas-message%
(parent racketeer-panel) (parent racketeer-panel)
(label (string-constant use-language-in-source)) (label (string-constant use-language-in-source))
(color (send the-color-database find-color "blue")) (color (send the-color-database find-color "blue"))
(callback (λ () (change-current-lang-to (λ (x) (is-a? x drracket:module-language:module-language<%>))))) (callback (λ () (change-current-lang-to
(λ (x) (is-a? x drracket:module-language:module-language<%>)))))
(font (get-font #:underlined #t)))) (font (get-font #:underlined #t))))
(define (display-text-pl lst) (define (display-text-pl lst)