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

329
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,7 +321,8 @@
(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 :
;; (vertical-panel panel language-setting -> language-setting)
;; (union dialog #f) [...more stuff...] ;; (union dialog #f) [...more stuff...]
;; -> (-> (union #f language<%>)) (-> settings[corresponding to fst thnk result]) ;; -> (-> (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
@ -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,7 +660,8 @@
[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
(new (class canvas%
(define/override (on-paint) (define/override (on-paint)
(define dc (get-dc)) (define dc (get-dc))
(send dc set-font normal-control-font) (send dc set-font normal-control-font)
@ -654,7 +685,8 @@
[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
(new selectable-hierlist%
[parent languages-hier-list-panel] [parent languages-hier-list-panel]
[style '(no-border no-hscroll auto-vscroll transparent)])) [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))
@ -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,7 +1373,8 @@
(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
(and current-line-start
(send definitions-text get-text current-line-start current-line-end))) (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)
@ -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,32 +1651,39 @@
(floor (inexact->exact (unbox y-box)))))) (floor (inexact->exact (unbox y-box))))))
; ;
; ;
; ; ;;; ;
; ; ;
; ;;; ;;;;
; ;;;
; ;;; ;;; ;; ;;;; ;;; ;;;; ;;;; ; ;;; ;;; ;; ;;;; ;;; ;;;; ;;;;
; ; ;; ; ; ; ; ; ; ; ;
; ; ; ; ; ; ; ;;; ;;;
; ; ; ; ; ; ; ; ;
; ; ; ; ; ; ; ;; ; ; ; ;
; ;;; ;;;;;;; ;;;; ;;;;; ;;; ;; ;;; ;; ; ;;; ;;;;;;; ;;;; ;;;;; ;;; ;; ;;; ;;
; ; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;;
; ; ;;; ;;; ;;; ;;; ;;; ;;; ;;;; ;;;;
; ; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;;
;
;
;
; ;;
; ;
; ;;; ;;; ;;; ;;; ;;;;; ;;; ;; ;;; ;; ;;; ; ;;; ;;; ;;; ;;; ;;;;; ;;; ;; ;;; ;; ;;;
; ; ; ; ;; ; ; ;; ; ; ; ; ; ;; ; ; ; ; ; ;;; ;;; ;;; ;;; ;;; ;;; ;;;; ;;;;
; ; ;;;; ; ; ; ; ; ; ;;;; ; ; ;;;;; ;;; ;
; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;
; ; ; ; ; ; ; ; ; ;; ; ; ; ; ; ; ; ;
; ;;;;; ;;;;;;;; ;;; ;;;; ;; ;; ;;;;; ;;;; ;;;; ;;;; ;
; ; ; ;
;
;
;
; ;;;
; ;;;
; ;;; ;;;;; ;;; ;; ;; ;;; ;;; ;;; ;;;;; ;; ;;; ;;;; ;;;;
; ;;; ;;;;;;; ;;;;;;; ;;;;;;; ;;; ;;; ;;;;;;; ;;;;;;; ;; ;;; ;;; ;;
; ;;; ;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;; ;;; ;;; ;;; ;;; ;;; ;;;
; ;;; ;;;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;;;; ;;; ;;; ;;;;;;; ;;;;
; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;;
; ;;; ;;; ;;; ;;; ;;; ;;;;;;; ;;;;;;; ;;; ;;; ;;;;;;; ;;;;;; ;; ;;;
; ;;; ;;;;;; ;;; ;;; ;; ;;; ;; ;;; ;;;;;; ;; ;;; ;;;; ;;;;
; ;;; ;;; ; ;;; ;;;
; ;;;;;; ;;;;;;
; ;
; ;
@ -1634,7 +1695,8 @@
(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
(append
(info-proc 'drscheme-language-positions (λ () null)) (info-proc 'drscheme-language-positions (λ () null))
(indirect-info-field info-proc 'get-drscheme-language-positions directory))] (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))]
@ -1693,14 +1755,19 @@
(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)]
[lang-numbers (in-list numberss)]
[one-line-summary (in-list summaries)]
[url (in-list urls)]
[reader-spec (in-list reader-specs)])
(define %
((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%))))
[reader (define reader
(if reader-spec (if reader-spec
(with-handlers ([exn:fail? (with-handlers ([exn:fail?
(λ (x) (λ (x)
@ -1724,35 +1791,30 @@
'read-syntax) 'read-syntax)
(string->symbol (format "~s" lang-position)) (string->symbol (format "~s" lang-position))
'drscheme)) 'drscheme))
read-syntax/namespace-introduce)]) read-syntax/namespace-introduce))
(add-language (instantiate % () (add-language (new %
(module (if (string? lang-module) [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
@ -1797,34 +1859,42 @@
; ;
; ;
; ;; ; ;; ; ;
; ; ; ; ;
; ; ;; ;; ;; ;;; ; ;;;;; ;;; ;; ;; ;
; ;; ; ; ; ; ; ; ; ;; ; ; ;;; ;;; ;;; ; ;;;
; ; ; ; ; ; ; ; ;;;;; ; ; ; ; ;;; ;;; ;;;
; ; ; ; ; ; ; ; ; ; ; ; ;;; ;; ;;; ;;; ;;; ;;; ;;;; ;;; ;;; ;;
; ; ; ; ;; ; ; ; ; ; ; ;
; ;;;;;;; ;;; ;;; ;;; ;;; ;;;; ;;; ;;;;;;; ; ;;;;;;; ;;; ;;; ;;; ;;; ;;;; ;;; ;;;;;;;
;
;
;
;
;
;
; ;;
; ;
; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;;
; ; ; ; ;; ; ; ;; ; ; ; ; ; ;; ; ; ; ; ; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;;;;;; ;;; ;;;
; ; ;;;; ; ; ; ; ; ; ;;;; ; ; ;;;;; ;;; ; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;;;;;; ;;; ;;;
; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;;;;;;; ;;;;;;; ;;; ;;; ;;;; ;;; ;;; ;;;
; ; ; ; ; ; ; ; ; ;; ; ; ; ; ; ; ; ; ;;; ;; ;; ;;; ;;; ;;; ;;; ;;; ;;; ;;;
; ;;;;; ;;;;;;;; ;;; ;;;; ;; ;; ;;;;; ;;;; ;;;; ;;;; ;
; ; ; ;
;
;
;
;
;
;
; ;;;
; ;;;
; ;;; ;;;;; ;;; ;; ;; ;;; ;;; ;;; ;;;;; ;; ;;; ;;;; ;;;;
; ;;; ;;;;;;; ;;;;;;; ;;;;;;; ;;; ;;; ;;;;;;; ;;;;;;; ;; ;;; ;;; ;;
; ;;; ;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;; ;;; ;;; ;;; ;;; ;;; ;;;
; ;;; ;;;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;;;; ;;; ;;; ;;;;;;; ;;;;
; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;;
; ;;; ;;; ;;; ;;; ;;; ;;;;;;; ;;;;;;; ;;; ;;; ;;;;;;; ;;;;;; ;; ;;;
; ;;; ;;;;;; ;;; ;;; ;; ;;; ;; ;;; ;;;;;; ;; ;;; ;;;; ;;;;
; ;;; ;;; ; ;;; ;;;
; ;;;;;; ;;;;;;
; ;
; ;
;; add-expand-to-front-end : mixin ;; add-expand-to-front-end : mixin
;; overrides front-end to make the language a language that expands its arguments ;; overrides front-end to make the language a language that expands its arguments
(define (add-expand-to-front-end %) (define (add-expand-to-front-end %)
@ -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,18 +2150,22 @@
; ;
; ;
; ;; ;
; ; ; ;
; ;; ;; ;;; ;;;;; ;;; ; ;;; ;; ;; ;; ;;;; ;; ;;; ;; ;; ;;; ; ; ;;;
; ;; ; ; ; ; ; ; ; ; ; ;; ; ; ;; ; ; ; ; ; ;; ; ;
; ; ; ; ; ; ;;;;; ;;;; ;;;;; ; ;;;; ; ; ; ; ; ; ;;;; ; ; ;;;;;
; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;
; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;; ; ; ; ; ;
; ;;; ;;; ;;; ;;; ;;;;; ;;;;; ;;;;;;;; ;;; ;;;; ;; ;; ;;;;; ;;;; ;;;;
; ; ;
; ;;; ;;; ; ;;; ;;;
; ;;; ;; ;;; ;;;; ;;;;; ;;; ;;;;; ;;; ;; ;; ;;; ;;; ;;; ;;;;; ;; ;;; ;;;;
; ;;;;;;; ;;;;; ;;;; ;;;;;;; ;;; ;;;;;;; ;;;;;;; ;;;;;;; ;;; ;;; ;;;;;;; ;;;;;;; ;; ;;;
; ;;; ;;; ;;; ;;; ;;; ;; ;;; ;;; ;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;; ;;; ;;; ;;; ;;; ;;;
; ;;; ;;; ;;; ;;; ;;; ;;;; ;;;;; ;;;;;;; ;;;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;;;; ;;; ;;; ;;;;;;;
; ;;; ;;; ;;; ;;; ;;; ;;;;;;; ;;; ;;;;;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;;
; ;;; ;;; ;;;;; ;;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;;;;;; ;;;;;;; ;;; ;;; ;;;;;;; ;;;;;;
; ;;; ;;; ;;; ;;; ;;;;;; ;;; ;;;;;; ;;; ;;; ;; ;;; ;; ;;; ;;;;;; ;; ;;; ;;;;
; ;;; ;;;
; ;;;;;; ;;;;;;
; ;
; ;
@ -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)