From 8e1b196d97685bf29f78897fc81f16f4b7b4bc64 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Sat, 15 Oct 2005 14:41:40 +0000
Subject: [PATCH] hopefully do not show the save diamond when it is not
 available and do not show languages for which the fonts are not installed

svn: r1088
---
 collects/drscheme/private/app.ss  | 26 ++++++++++++++++++++++----
 collects/drscheme/private/unit.ss | 14 +++++++++++++-
 2 files changed, 35 insertions(+), 5 deletions(-)

diff --git a/collects/drscheme/private/app.ss b/collects/drscheme/private/app.ss
index 05661c1049..2df8c95cc2 100644
--- a/collects/drscheme/private/app.ss
+++ b/collects/drscheme/private/app.ss
@@ -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)))]))))))
diff --git a/collects/drscheme/private/unit.ss b/collects/drscheme/private/unit.ss
index 28376eb5c7..b410aa51fa 100644
--- a/collects/drscheme/private/unit.ss
+++ b/collects/drscheme/private/unit.ss
@@ -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))]