Added X-LIST-FONTS primitive.

diff --git a/v7/src/microcode/x11base.c b/v7/src/microcode/x11base.c
index 34362e03b26133f1394aeccf6e5a97b77ab13aae..7ab89336a02fabc92b0da8ebd4c4bf59eedf47d1 100644 (file)
--- a/v7/src/microcode/x11base.c
+++ b/v7/src/microcode/x11base.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: x11base.c,v 1.54 1994/09/16 21:20:13 cph Exp $
+$Id: x11base.c,v 1.55 1994/09/17 17:35:12 adams Exp $
 
 Copyright (c) 1989-93 Massachusetts Institute of Technology
 
@@ -1998,7 +1998,8 @@ DEFINE_PRIMITIVE ("X-FONT-STRUCTURE", Prim_x_font_structure, 2, 2,
 }
 
 DEFINE_PRIMITIVE ("X-WINDOW-FONT-STRUCTURE", Prim_x_window_font_structure, 1, 1,
-                 0)
+ "(x-window)\n\
+  Returns the font-structure for the font currently associated with X-WINDOW")
 {
   XFontStruct *font;
   PRIMITIVE_HEADER (1);
@@ -2006,3 +2007,46 @@ DEFINE_PRIMITIVE ("X-WINDOW-FONT-STRUCTURE", Prim_x_window_font_structure, 1, 1,
   font = XW_FONT (x_window_arg (1));
   PRIMITIVE_RETURN (convert_font_struct (ulong_to_integer (font->fid), font));
 }
+
+DEFINE_PRIMITIVE ("X-LIST-FONTS", Prim_x_list_fonts, 3, 3,
+ "(display pattern limit)\n\
+  LIMIT is an exact non-negative integer or #F for no limit\n\
+  Returns #F or a vector of at least one string.")
+{
+    PRIMITIVE_HEADER (1);
+    {
+       SCHEME_OBJECT result;
+       Display *display = XD_DISPLAY (x_display_arg (1));
+       char *pattern = STRING_ARG (2);
+       int maxnames =
+         (FIXNUM_P (ARG_REF (3))) ? FIXNUM_TO_LONG (ARG_REF (3))
+                                   : 1000000;
+       int actual_count = 0;
+       int words;
+       int i;
+       char **names = XListFonts (display, pattern, maxnames, &actual_count);
+
+       if (!names)
+         PRIMITIVE_RETURN (SHARP_F);
+
+       words = actual_count + 1; /* the vector of strings */
+
+       for (i=0; i<actual_count; i++)
+           words += STRING_LENGTH_TO_GC_LENGTH (strlen (names[i]));
+       
+       if (GC_Check (words)) {
+           /* this causes the primitive to be restarted, so deallocate names */
+           XFreeFontNames (names);
+           Primitive_GC (words);
+           /* notreached */
+       }
+
+       result = allocate_marked_vector (TC_VECTOR, actual_count, false);
+
+       for (i = 0;  i<actual_count;  i++)
+         VECTOR_SET (result, i, char_pointer_to_string (names[i]));
+       
+       XFreeFontNames (names);
+       PRIMITIVE_RETURN (result);
+    }
+}