From: Matt Birkholz <matt@birchwood-abbey.net>
Date: Mon, 28 Aug 2017 18:33:32 +0000 (-0700)
Subject: x11: null terminate strings; punt unused optimization.
X-Git-Tag: mit-scheme-pucked-9.2.12~81
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=7ef8efd117032bf7aa1716b70c810161668b7c1e;p=mit-scheme.git

x11: null terminate strings; punt unused optimization.
---

diff --git a/src/x11/x11-base.scm b/src/x11/x11-base.scm
index ed50a8b5a..496d2b109 100644
--- a/src/x11/x11-base.scm
+++ b/src/x11/x11-base.scm
@@ -51,22 +51,18 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
   (if (not (zero? (C-call "x_window_set_input_hint" window (if hint? 1 0))))
       (error "XAllocWMHints failed.")))
 
+(define-integrable primitive-u8-set! (ucode-primitive bytevector-u8-set! 3))
+
 (define (->bytes string)
-  (if (and (or (bytevector? string)
-	       (and (ustring? string)
-		    (fix:= 1 (ustring-cp-size string))))
-	   (let ((end (string-length string)))
-	     (every-loop (lambda (cp) (fix:< cp #x80))
-			 cp1-ref string 0 end)))
+  (if (bytevector? string)
       string
-      (string->iso8859-1 string)))
-
-(define-integrable (every-loop proc ref string start end)
-  (let loop ((i start))
-    (if (fix:< i end)
-	(and (proc (ref string i))
-	     (loop (fix:+ i 1)))
-	#t)))
+      (let* ((end (string-length string))
+	     (result (make-bytevector (fix:1+ end))))
+	(do ((i 0 (fix:+ i 1)))
+	    ((not (fix:< i end))
+	     (primitive-u8-set! result i #x00))
+	  (primitive-u8-set! result i (char->integer (string-ref string i))))
+	result)))
 
 (define (x-window-set-name window name)
   (guarantee-xwindow window 'x-window-set-name)
diff --git a/src/x11/x11-graphics.scm b/src/x11/x11-graphics.scm
index f160f5542..d2753b089 100644
--- a/src/x11/x11-graphics.scm
+++ b/src/x11/x11-graphics.scm
@@ -58,23 +58,6 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 (define (x-graphics-reconfigure window width height)
   (C-call "x_graphics_reconfigure" window width height))
 
-(define (->bytes string)
-  (if (and (or (bytevector? string)
-	       (and (ustring? string)
-		    (fix:= 1 (ustring-cp-size string))))
-	   (let ((end (string-length string)))
-	     (every-loop (lambda (cp) (fix:< cp #x80))
-			 cp1-ref string 0 end)))
-      string
-      (string->iso8859-1 string)))
-
-(define-integrable (every-loop proc ref string start end)
-  (let loop ((i start))
-    (if (fix:< i end)
-	(and (proc (ref string i))
-	     (loop (fix:+ i 1)))
-	#t)))
-
 (define (x-graphics-open-window display geometry suppress-map)
   ;; Open a window on DISPLAY using GEOMETRY.  If GEOMETRY is false
   ;; map window interactively.  If third argument SUPPRESS-MAP? is
diff --git a/src/x11/x11-terminal.scm b/src/x11/x11-terminal.scm
index 1cee3cb1e..fdf6925e9 100644
--- a/src/x11/x11-terminal.scm
+++ b/src/x11/x11-terminal.scm
@@ -75,9 +75,9 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
     (let ((window
 	   (c-call "xterm_open_window" (make-alien '(struct |xwindow|))
 		   display
-		   (string->utf8 geometry)
-		   (string->utf8 name)
-		   (string->utf8 class)
+		   (->bytes geometry)
+		   (->bytes name)
+		   (->bytes class)
 		   (if map? 1 0))))
       (if (alien-null? window)
 	  (error "Could not open xterm:" geometry))
@@ -125,7 +125,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 (define (xterm-write-substring! xterm x y string start end highlight)
   (guarantee-all-ascii string 'xterm-write-substring!)
   (let ((code (c-call "xterm_write_substring"
-		      xterm x y (string->utf8 string) start end highlight)))
+		      xterm x y (->bytes string) start end highlight)))
     (case code
       ((1) (error:bad-range-argument x 'xterm-write-substring!))
       ((2) (error:bad-range-argument y 'xterm-write-substring!))
diff --git a/src/x11/x11.pkg b/src/x11/x11.pkg
index f9e0137d8..ceb8d09ab 100644
--- a/src/x11/x11.pkg
+++ b/src/x11/x11.pkg
@@ -35,11 +35,8 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
   (parent (x11))
   (export ()
 	  x-close-all-displays)
-  (import (runtime ustring)
-	  cp1-ref
-	  ustring-cp-size
-	  ustring?)
   (export (x11)
+	  ->bytes
 	  x-visual-deallocate
 	  x-close-display
 	  x-window-set-input-hint