From 2757856cbf54c1f51c0e666cf32215a71787afcc Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Fri, 27 Feb 2004 19:59:35 +0000
Subject: [PATCH] .

original commit: 615882337b5b8687b03f868246f1c075b12393ae
---
 collects/mred/mred-sig.ss       |  2 ++
 collects/mred/mred.ss           |  4 +++-
 collects/mred/private/kernel.ss |  6 +++---
 collects/tests/mred/draw.ss     | 27 +++++++++++++++++++++++++--
 4 files changed, 33 insertions(+), 6 deletions(-)

diff --git a/collects/mred/mred-sig.ss b/collects/mred/mred-sig.ss
index 48006765..c0bfcc2a 100644
--- a/collects/mred/mred-sig.ss
+++ b/collects/mred/mred-sig.ss
@@ -39,6 +39,8 @@
      control<%>
      current-eventspace
      current-eventspace-has-standard-menus?
+     current-ps-afm-file-paths
+     current-ps-cmap-file-paths
      current-ps-setup
      current-text-keymap-initializer
      cursor%
diff --git a/collects/mred/mred.ss b/collects/mred/mred.ss
index 9915cf43..11dc6e33 100644
--- a/collects/mred/mred.ss
+++ b/collects/mred/mred.ss
@@ -7895,7 +7895,9 @@
 	current-eventspace-has-menu-root?
 	eventspace-handler-thread
 	make-namespace-with-mred
-	file-creator-and-type)
+	file-creator-and-type
+	current-ps-afm-file-paths
+	current-ps-cmap-file-paths)
 
 
 ) ;; end of module
diff --git a/collects/mred/private/kernel.ss b/collects/mred/private/kernel.ss
index e0d50a9e..28673b89 100644
--- a/collects/mred/private/kernel.ss
+++ b/collects/mred/private/kernel.ss
@@ -907,7 +907,7 @@
     tell)
   (define-class editor-stream-in-bytes-base% editor-stream-in-base% #f)
   (define-class editor-stream-out-bytes-base% editor-stream-out-base% #f
-    get-string)
+    get-bytes)
   (define-class editor-stream-in% object% #f
     ok?
     jump-to
@@ -935,8 +935,8 @@
     get-clipboard-bitmap
     set-clipboard-bitmap
     get-clipboard-data
-    get-clipboard-bytes
-    set-clipboard-bytes
+    get-clipboard-string
+    set-clipboard-string
     set-clipboard-client)
   (define-function get-the-clipboard)
   (define-class clipboard-client% object% ()
diff --git a/collects/tests/mred/draw.ss b/collects/tests/mred/draw.ss
index 769cdff2..1b94d359 100644
--- a/collects/tests/mred/draw.ss
+++ b/collects/tests/mred/draw.ss
@@ -1,6 +1,15 @@
 
 (require (lib "class100.ss"))
 
+(define manual-chinese? #f)
+
+(when manual-chinese?
+  (send the-font-name-directory set-post-script-name 
+	(send the-font-name-directory find-or-create-font-id "MOESung-Regular" 'default)
+	'normal
+	'normal
+	"MOESung-Regular"))
+
 (define sys-path 
   (lambda (f)
     (build-path (collection-path "icons") f)))
@@ -488,7 +497,8 @@
 					   [wgt '(normal  bold    normal normal bold       normal)]
 					   [sze '(12      12      12     12     12         32)]
 					   [x 244]
-					   [y 210])
+					   [y 210]
+					   [chinese? #t])
 				  (unless (null? fam)
 				    (let ([fnt (make-object font% (car sze) (car fam) (car stl) (car wgt))]
 					  [s "AgMh"])
@@ -498,7 +508,20 @@
 				      (let-values ([(w h d a) (send dc get-text-extent s fnt)])
 					(send dc draw-rectangle x y w h)
 					(send dc draw-line x (+ y (- h d)) (+ x w) (+ y (- h d)))
-					(loop (cdr fam) (cdr stl) (cdr wgt) (cdr sze) x (+ y h))))))
+					(when chinese?
+					  (let ([s "\u7238"]
+						[x (+ x (* 1.5 w))]
+						[cfnt (if (and (dc . is-a? . post-script-dc%)
+							       manual-chinese?)
+							  (make-object font% 12 "MOESung-Regular" 'default)
+							  fnt)])
+					    (send dc set-font cfnt)
+					    (send dc draw-text s x y)
+					    (send dc set-font fnt)
+					    (let-values ([(w h d a) (send dc get-text-extent s cfnt)])
+					      (send dc draw-rectangle x y w h)
+					      (send dc draw-line x (+ y (- h d)) (+ x w) (+ y (- h d))))))
+					(loop (cdr fam) (cdr stl) (cdr wgt) (cdr sze) x (+ y h) #f)))))
 				(send dc set-pen save-pen)))
 
 			    ; Bitmap copying: