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-selected)]
[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-language-in-source-rb set-selection #f)
(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-height #t)
(send languages-hier-list accept-tab-focus #t)
(send languages-hier-list allow-tab-exit #t)
(send parent reflow-container)
(close-all-languages)
(open-current-language)
@ -903,7 +906,6 @@
(when details-shown?
(do-construct-details))
(update-show/hide-details)
(send languages-hier-list focus)
(size-discussion-canvas in-source-discussion-editor-canvas)
(values
(λ () selected-language)

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

@ -60,24 +60,36 @@
(inherit get-language-name)
(define/public (get-users-language-name defs-text)
(let ([defs-port (open-input-text-editor defs-text)])
(with-handlers ((exn:fail? (λ (x) (void))))
(let/ec k
(let ([orig-security (current-security-guard)])
(parameterize ([current-security-guard
(make-security-guard
orig-security
(lambda (what path modes) #t)
(lambda (what host port mode) (k (void))))])
(read-language defs-port (λ () (void)))
(void)))))
(let* ([str (send defs-text get-text 0 (file-position defs-port))]
[pos (regexp-match-positions #rx"#(?:!|lang )" str)])
(cond
[(not pos)
(get-language-name)]
[else
(substring str (cdr (car pos)) (string-length str))]))))
(let* ([defs-port (open-input-text-editor defs-text)]
[read-successfully?
(with-handlers ((exn:fail? (λ (x) #f)))
(let/ec k
(let ([orig-security (current-security-guard)])
(parameterize ([current-security-guard
(make-security-guard
orig-security
(lambda (what path modes) #t)
(lambda (what host port mode) (k #f)))])
(read-language defs-port (λ () (void)))
#t))))])
(cond
[read-successfully?
(let* ([str (send defs-text get-text 0 (file-position defs-port))]
[pos (regexp-match-positions #rx"#(?:!|lang )" str)])
(cond
[(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)

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

@ -1602,13 +1602,13 @@ TODO
(set-clickback before after (λ args (send-url url))
click-delta)))
(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
(insert/delta this
"; memory limit: "
welcome-delta)
(insert/delta this
(format "~a megabytes" (floor (/ custodian-limit 1024 1024)))
(format "~a MB" (floor (/ custodian-limit 1024 1024)))
dark-green-delta))
(insert/delta this ".\n" welcome-delta)