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

adjust the way languages are chosen when opening a file.

Browse Source 
Specifically, in the case that we're inheriting a language setting
from some earlier preference or something and the language we're
inheriting is one that saves prefixes, and the current file being
opened does not match any of the possible prefixes, then revert
to the not-a-language language, instead of using the value from
the preference

Also: finish the removal of the EoPL language level from the
DrRacket langauge dialog, and clean up the 'get guidance' dialog

Please cherrypick this commit to the 5.2 release branch
This commit is contained in:
Robby Findler 2011-10-08 08:51:02 -05:00
parent 41b18e3608
commit d362bda6d3
3 changed files with 44 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

61
collects/drracket/private/language-configuration.rkt
View File

@ -560,7 +560,10 @@
(= (length positions) (length numbers))
((length numbers) . >= . 1))
(error 'drracket:language
"languages position and numbers must be lists of strings and numbers, respectively, must have the same length, and must each contain at least one element, got: ~e ~e"
(string-append
"languages position and numbers must be lists of strings and numbers,"
" respectively, must have the same length, and must each contain at"
" least one element, got: ~e ~e")
positions numbers))
(when (null? (cdr positions))
@ -1825,26 +1828,14 @@
[else
(string<=? (cadr x) (cadr y))])))))
(define plt-logo-shiny
(make-object bitmap% (collection-file-path "plt-logo-red-shiny.png" "icons")
'png/mask))
(define (display-racketeer)
(new canvas-message%
(parent racketeer-panel)
(label (string-constant racketeer?)))
(new canvas%
(new canvas-message%
[label (read-bitmap (collection-file-path "plt-logo-red-shiny.png" "icons"))]
[parent racketeer-panel]
[stretchable-width #f]
[paint-callback
(λ (c dc)
(send dc set-scale 1/2 1/2)
(send dc draw-bitmap plt-logo-shiny 0 0
'solid (send the-color-database find-color "black")
(send plt-logo-shiny get-loaded-mask)))]
[style '(transparent)]
[min-width (floor (/ (send plt-logo-shiny get-width) 2))]
[min-height (floor (/ (send plt-logo-shiny get-height) 2))])
[callback (λ () (change-current-lang-to (λ (x) (is-a? x drracket:module-language:module-language<%>))))])
(new canvas-message%
(parent racketeer-panel)
(label (string-constant use-language-in-source))
@ -1907,23 +1898,32 @@
(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)))
(define dc (get-dc))
(cond
[(string? label)
(define old-font (send dc get-font))
(define 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)]
[(is-a? label bitmap%)
(send dc draw-bitmap label 0 0)]))
(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))))))
(cond
[(string? label)
(define-values (w h _1 _2) (send (get-dc) get-text-extent label font #t))
(min-width (inexact->exact (ceiling w)))
(min-height (inexact->exact (ceiling h)))]
[(is-a? label bitmap%)
(min-width (inexact->exact (ceiling (send label get-width))))
(min-height (inexact->exact (ceiling (send label get-height))))])))
(define (question/answer line1 line2 icon-lst)
(display-two-line-choice
@ -1947,7 +1947,7 @@
(define (get-text-pls info-filename)
(let ([proc (get-info/full info-filename)])
(if proc
(let ([qs (proc 'textbook-pls)])
(let ([qs (proc 'textbook-pls (λ () '()))])
(unless (list? qs)
(error 'splash-questions "expected a list, got ~e" qs))
(for-each
@ -1963,7 +1963,10 @@
(andmap string? (cdr pr)))
(error
'splash-questions
"expected a list of lists, with each inner list being at least three elements long and the first element of the inner list being a list of strings and the rest of the elements being strings, got ~e"
(string-append
"expected a list of lists, with each inner list being at least three elements long"
" and the first element of the inner list being a list of strings and the rest of"
" the elements being strings, got ~e")
pr)))
qs)
qs)

18
collects/drracket/private/unit.rkt
View File

@ -609,12 +609,18 @@ module browser threading seems wrong.
(drracket:language-configuration:get-languages)
module-language
module-language-settings)])
(when matching-language
(set-next-settings
(drracket:language-configuration:language-settings
matching-language
settings)
#f))))
(cond
[matching-language
(set-next-settings
(drracket:language-configuration:language-settings
matching-language
settings)
#f)]
[else
(when (send (drracket:language-configuration:language-settings-language (get-next-settings)) get-reader-module)
(set-next-settings
(drracket:language-configuration:get-default-language-settings)
#f))])))
(set-modified #f))
(end-edit-sequence)

5
collects/eopl/info.rkt
View File

@ -4,8 +4,3 @@
(define scribblings '(("eopl.scrbl" () (teaching -20))))
(define textbook-pls
(list (list '("eopl-small.png" "eopl")
"Essentials of Programming Languages"
(string-constant teaching-languages)
"Essentials of Programming Languages (3rd ed.)")))