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

minor tweaks to the language dialog that were mentioned a while back, but that I only just got to

Browse Source 
svn: r18137
This commit is contained in:
Robby Findler 2010-02-17 23:10:10 +00:00
parent 12dc4f3421
commit a7dbbc2fa6
3 changed files with 35 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/drscheme/private/language-configuration.ss
View File

@ -745,6 +745,7 @@
module-language*language) module-language*language)
(module-language-selected)] (module-language-selected)]
[else [else
(send languages-hier-list focus) ;; only focus when the module language isn't selected
(send use-chosen-language-rb set-selection 0) (send use-chosen-language-rb set-selection 0)
(send use-language-in-source-rb set-selection #f) (send use-language-in-source-rb set-selection #f)
(let ([language-position (send language-to-show get-language-position)]) (let ([language-position (send language-to-show get-language-position)])
@ -893,6 +894,8 @@
(send languages-hier-list stretchable-width #t) (send languages-hier-list stretchable-width #t)
(send languages-hier-list stretchable-height #t) (send languages-hier-list stretchable-height #t)
(send languages-hier-list accept-tab-focus #t)
(send languages-hier-list allow-tab-exit #t)
(send parent reflow-container) (send parent reflow-container)
(close-all-languages) (close-all-languages)
(open-current-language) (open-current-language)
@ -903,7 +906,6 @@
(when details-shown? (when details-shown?
(do-construct-details)) (do-construct-details))
(update-show/hide-details) (update-show/hide-details)
(send languages-hier-list focus)
(size-discussion-canvas in-source-discussion-editor-canvas) (size-discussion-canvas in-source-discussion-editor-canvas)
(values (values
(λ () selected-language) (λ () selected-language)

48
collects/drscheme/private/module-language.ss
View File

@ -60,24 +60,36 @@
(inherit get-language-name) (inherit get-language-name)
(define/public (get-users-language-name defs-text) (define/public (get-users-language-name defs-text)
(let ([defs-port (open-input-text-editor defs-text)]) (let* ([defs-port (open-input-text-editor defs-text)]
(with-handlers ((exn:fail? (λ (x) (void)))) [read-successfully?
(let/ec k (with-handlers ((exn:fail? (λ (x) #f)))
(let ([orig-security (current-security-guard)]) (let/ec k
(parameterize ([current-security-guard (let ([orig-security (current-security-guard)])
(make-security-guard (parameterize ([current-security-guard
orig-security (make-security-guard
(lambda (what path modes) #t) orig-security
(lambda (what host port mode) (k (void))))]) (lambda (what path modes) #t)
(read-language defs-port (λ () (void))) (lambda (what host port mode) (k #f)))])
(void))))) (read-language defs-port (λ () (void)))
(let* ([str (send defs-text get-text 0 (file-position defs-port))] #t))))])
[pos (regexp-match-positions #rx"#(?:!|lang )" str)]) (cond
(cond [read-successfully?
[(not pos) (let* ([str (send defs-text get-text 0 (file-position defs-port))]
(get-language-name)] [pos (regexp-match-positions #rx"#(?:!|lang )" str)])
[else (cond
(substring str (cdr (car pos)) (string-length str))])))) [(not pos)
(get-language-name)]
[else
;; newlines can break things (ie the language text won't
;; be in the right place in the interactions window, which
;; at least makes the test suites unhappy), so get rid of
;; them from the name. Otherwise, if there is some wierd formatting,
;; so be it.
(regexp-replace* #rx"[\r\n]+"
(substring str (cdr (car pos)) (string-length str))
" ")]))]
[else
(get-language-name)])))
(define/override (use-namespace-require/copy?) #f) (define/override (use-namespace-require/copy?) #f)

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

@ -1602,13 +1602,13 @@ TODO
(set-clickback before after (λ args (send-url url)) (set-clickback before after (λ args (send-url url))
click-delta))) click-delta)))
(unless (is-default-settings? user-language-settings) (unless (is-default-settings? user-language-settings)
(insert/delta this (string-append " " (string-constant custom)) dark-green-delta)) (insert/delta this (string-append " [" (string-constant custom) "]") dark-green-delta))
(when custodian-limit (when custodian-limit
(insert/delta this (insert/delta this
"; memory limit: " "; memory limit: "
welcome-delta) welcome-delta)
(insert/delta this (insert/delta this
(format "~a megabytes" (floor (/ custodian-limit 1024 1024))) (format "~a MB" (floor (/ custodian-limit 1024 1024)))
dark-green-delta)) dark-green-delta))
(insert/delta this ".\n" welcome-delta) (insert/delta this ".\n" welcome-delta)