From: Matt Birkholz <matt@birchwood-abbey.net>
Date: Mon, 30 Jul 2018 01:10:33 +0000 (-0700)
Subject: x11: Fix x-list-fonts procedure.
X-Git-Tag: mit-scheme-pucked-blowfish-1.1.0^2
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=3dc1d33db76ef788d029a0eefdf32aa173af4eec;p=mit-scheme.git

x11: Fix x-list-fonts procedure.
---

diff --git a/src/x11/NEWS b/src/x11/NEWS
index 2c975f27c..936b5de76 100644
--- a/src/x11/NEWS
+++ b/src/x11/NEWS
@@ -22,6 +22,11 @@ along with MIT/GNU Scheme; if not, write to the Free Software
 Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
 02110-1301, USA.
 
+mit-scheme-x11 1.2 - Matt Birkholz, 2018-07-29
+==============================================
+
+Fix the x-list-fonts procedure.
+
 mit-scheme-x11 1.1 - Matt Birkholz, 2018-07-12
 ==============================================
 
diff --git a/src/x11/configure.ac b/src/x11/configure.ac
index 1b2c4c459..3d931ac01 100644
--- a/src/x11/configure.ac
+++ b/src/x11/configure.ac
@@ -2,7 +2,7 @@ dnl Process this file with autoconf to produce a configure script.
 
 AC_PREREQ([2.69])
 AC_INIT([MIT/GNU Scheme x11 plugin],
-        [1.1],
+        [1.2],
         [bug-mit-scheme@gnu.org],
         [mit-scheme-x11])
 AC_CONFIG_SRCDIR([x11.pkg])
diff --git a/src/x11/make.scm b/src/x11/make.scm
index c71b2aa07..24378cd63 100644
--- a/src/x11/make.scm
+++ b/src/x11/make.scm
@@ -5,4 +5,4 @@ Load the X11 option. |#
 (with-loader-base-uri (system-library-uri "x11/")
   (lambda ()
     (load-package-set "x11")))
-(add-subsystem-identification! "X11" '(1 1))
\ No newline at end of file
+(add-subsystem-identification! "X11" '(1 2))
\ No newline at end of file
diff --git a/src/x11/x11-base.scm b/src/x11/x11-base.scm
index 4e712ac63..d71f8cd9c 100644
--- a/src/x11/x11-base.scm
+++ b/src/x11/x11-base.scm
@@ -117,7 +117,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 
 (define (x-display-get-size display screen)
   (guarantee-xdisplay display 'x-display-get-size)
-  (let ((results (malloc (* 2 (c-sizeof "int")))))
+  (let ((results (malloc (* 2 (c-sizeof "int")) 'int)))
     (c-call "x_display_get_size" display screen results)
     (let ((width (c-> results "int"))
 	  (height (c-> (c-array-loc results "int" 1) "int")))
@@ -465,7 +465,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 
 (define (x-window-query-pointer window)
   (guarantee-xwindow window 'x-window-query-pointer)
-  (let ((result (malloc (* 5 (c-sizeof "int")))))
+  (let ((result (malloc (* 5 (c-sizeof "int")) 'int)))
     (if (zero? (C-call "x_window_query_pointer" window result))
 	(error "XQueryPointer failed:" window))
     (let ((v (make-vector 5))
@@ -727,7 +727,10 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
   ;; LIMIT is an exact non-negative integer or #F for no limit.
   ;; Returns #F or a vector of at least one string.
   (guarantee-xdisplay display 'x-list-fonts)
-  (let ((actual-count-return (malloc "int" 'int)))
+  (and limit
+       (guarantee exact-positive-integer? limit 'x-list-fonts))
+  (let ((actual-count-return (malloc (c-sizeof "int") 'int))
+	(pattern-bytes (->bytes pattern)))
 
     (define (cleanup-names! copy)
       (if (not (alien-null? copy))
@@ -736,7 +739,8 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 	    (alien-null! copy))))
 
     (define (init-names! copy)
-      (c-call "x_list_fonts" copy display pattern limit actual-count-return))
+      (c-call "x_list_fonts" copy
+	      display pattern-bytes (or limit 1000000) actual-count-return))
 
     (let ((names (make-alien '(* char))))
       (add-alien-cleanup! names cleanup-names! init-names!)
@@ -751,7 +755,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 	      (let loop ((i 0))
 		(if (< i actual-count)
 		    (begin
-		      (vector-set! result i (c-peek-cstringp! scan 0))
+		      (vector-set! result i (c-peek-cstringp! scan))
 		      (loop (1+ i)))))
 	      (cleanup-alien! names)
 	      (free actual-count-return)