x11: Fix x-list-fonts procedure.

diff --git a/src/x11/NEWS b/src/x11/NEWS
index 2c975f27c56cb0fd62c6d0c1ccd9a04a074e847b..936b5de763ff1de7a27c5c97b0fd29d0618777f2 100644 (file)
--- 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 1b2c4c459ef6e441b18f55f0e7d0c17f98bb3b00..3d931ac01edf57cf6dbd39133c383838b9282f47 100644 (file)
--- 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 c71b2aa076b30f7d7a5dd90dacd229abe5bd603f..24378cd631bed5907d6ef00432f53edeaa45f783 100644 (file)
--- 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 4e712ac6360aee464a3578fbd1c7207e8fd3cb0e..d71f8cd9c344daf719725e89e5af49ebe74baa6a 100644 (file)
--- 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)