From: Matt Birkholz <puck@birchwood-abbey.net>
Date: Wed, 8 Jun 2016 22:27:59 +0000 (-0700)
Subject: x11/x11base.scm (x-get-window-property): Read entire string value.
X-Git-Tag: mit-scheme-pucked-9.2.12~261^2~24
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=f3193cb362285c40ce448a123f0c40023ae1bbf3;p=mit-scheme.git

x11/x11base.scm (x-get-window-property): Read entire string value.

The new char-ptr-to-prop-data-8 procedure reads the specified number
of bytes.  (c-peek-cstringp stops at #\NULs.)
---

diff --git a/src/x11/x11base.scm b/src/x11/x11base.scm
index bcdc05cf1..42a236738 100644
--- a/src/x11/x11base.scm
+++ b/src/x11/x11base.scm
@@ -782,7 +782,9 @@ USA.
 				 (c-> data-return "* char")
 				 (c-> nitems-return "ulong")))
 			       ((= 8 actual-format)
-				(c-peek-cstringp data-return))
+				(char-ptr-to-prop-data-8
+				 (c-> data-return "* char")
+				 (c-> nitems-return "ulong")))
 			       (else
 				(error "Unexpected format:" actual-format))))))
 	    (cleanup-alien! data-return)
@@ -814,6 +816,17 @@ USA.
 	    (loop (1+ index)))))
     result))
 
+(define (char-ptr-to-prop-data-8 data length)
+  (let ((scan (copy-alien data))
+	(result (make-string length)))
+    (let loop ((index 0))
+      (if (< index length)
+	  (begin
+	    (string-set! result index (ascii->char (c-> scan "uchar")))
+	    (alien-byte-increment! scan (c-sizeof "uchar"))
+	    (loop (1+ index)))))
+    result))
+
 (define (x-change-property display window property type format mode data)
   (guarantee-xdisplay display 'x-change-property)
   (guarantee-Window window 'x-change-property)