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

hopefully do not show the save diamond when it is not available and do not show languages for which the fonts are not installed

Browse Source 
svn: r1088
This commit is contained in:
Robby Findler 2005-10-15 14:41:40 +00:00
parent 07de57c7cf
commit 8e1b196d97
2 changed files with 35 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
collects/drscheme/private/app.ss
View File

@ -216,12 +216,12 @@
(define nl-radio-box
(instantiate radio-box% ()
(label #f)
(choices (string-constants interact-with-drscheme-in-language))
(choices good-interact-strings)
(parent natural-language-state-panel)
(callback (λ (x y) (void)))))
(define stupid-internal-define-syntax3
(let loop ([languages (all-languages)]
(let loop ([languages languages-with-good-labels]
[n 0])
(cond
[(null? languages) (void)]
@ -955,5 +955,23 @@
(label native-lang-string)
(parent help-menu)
(callback (λ (x1 x2) (switch-language-to #f language))))))
(string-constants interact-with-drscheme-in-language)
(all-languages)))))))
good-interact-strings
languages-with-good-labels)))
(define-values (languages-with-good-labels good-interact-strings)
(let loop ([langs (all-languages)]
[strs (string-constants interact-with-drscheme-in-language)]
[good-langs '()]
[good-strs '()])
(cond
[(null? strs) (values (reverse good-langs)
(reverse good-strs))]
[else (let ([str (car strs)]
[lang (car langs)])
(if (andmap (λ (char) (send normal-control-font screen-glyph-exists? char))
(string->list str))
(loop (cdr langs)
(cdr strs)
(cons lang good-langs)
(cons str good-strs))
(loop (cdr langs) (cdr strs) good-langs good-strs)))]))))))

14
collects/drscheme/private/unit.ss
View File

@ -1333,8 +1333,20 @@ module browser threading seems wrong.
(define/private (add-modified-flag text string)
(if (send text is-modified?)
(string-append "◆ " string)
(let ([prefix (get-save-diamond-prefix)])
(if prefix
(string-append prefix string)
string))
string))
(define/private (get-save-diamond-prefix)
(let ([candidate-prefixes '("◆ " "* ")])
(ormap
(lambda (candidate)
(and (andmap (λ (x) (send normal-control-font screen-glyph-exists? x))
(string->list candidate))
candidate))
candidate-prefixes)))
[define/override get-canvas% (λ () (drscheme:get/extend:get-definitions-canvas))]