Hello! I have patches for both guile2-xlib [1] and guile-cairo [2]. This adds xlib bindings to cairo, allowing output to a screen. To archive this I had to patch guile2-xlib to work as a library. Attached is a number of patches to the first, and one big patch to the later. Along with cairo's "official" example of xlib compatibility [3], ported to scheme.
The guile-xlib patch can be seen in two parts. The first simply breaks the library part to be usable as a C library. The second part adds a few bindings a needed in cairo. Should be noted that I'm still not to good with autotools, so the build process of guile-cairo at the moment requires that guile2-xlib is available. [1]: https://github.com/mwitmer/guile2-xlib [2]: http://www.non-gnu.org/guile-cairo/ [3]: https://cairographics.org/Xlib/ -- hugo
>From 8e632532c6ef550961cd16ec668918b1e91b7935 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <h...@lysator.liu.se>
Date: Mon, 29 Apr 2019 12:36:53 +0200
Subject: [PATCH] Add bindings for cairo-xlib.
This binds together cairo-xlib, guile-cairo, and guile-xlib.
This code is semi-transpansparent, since guile-xlib and guile-cairo has
different approaches to bindings (the former being opaque, the later
transparent).
Names are however kept in style with guile-cairo.
---
configure.ac | 14 ++++
guile-cairo.pc.in | 2 +-
guile-cairo/Makefile.am | 2 +-
guile-cairo/guile-cairo.c | 165 +++++++++++++++++++++++++++++++++++++-
4 files changed, 179 insertions(+), 4 deletions(-)
diff --git a/configure.ac b/configure.ac
index a8ba654..1a7334e 100644
--- a/configure.ac
+++ b/configure.ac
@@ -97,6 +97,20 @@ PKG_CHECK_MODULES(CAIRO, cairo >= 1.10.0)
AC_SUBST(CAIRO_LIBS)
AC_SUBST(CAIRO_CFLAGS)
+AC_ARG_WITH([xlib],
+ AS_HELP_STRING([--with-xlib],
+ [Add xlib bindings. @<:@default=false@:>@]),
+ [],
+ [with_xlib=no])
+
+AC_SUBST(XLIB, guile2-xlib)
+AS_IF([test "x$with_xlib" != "xno"], [
+ PKG_CHECK_MODULES(GUILE_X, guile2-xlib >= 0.2)
+ AC_SUBST(GUILE_X_LIBS)
+ AC_SUBST(GUILE_X_CFLAGS)
+ AC_SUBST(XLIB, guile2-xlib)
+])
+
AC_ARG_VAR(CAIRO_XML_DIR, [path to Cairo *.xml documentation])
AC_CONFIG_FILES([env], [chmod +x env])
diff --git a/guile-cairo.pc.in b/guile-cairo.pc.in
index dfe34df..223faf6 100644
--- a/guile-cairo.pc.in
+++ b/guile-cairo.pc.in
@@ -6,6 +6,6 @@ includedir=@includedir@/guile-cairo
Name: guile-cairo
Description: Cairo binding for Guile Scheme
Version: @VERSION@
-Requires: cairo guile-@GUILE_EFFECTIVE_VERSION@
+Requires: cairo guile-@GUILE_EFFECTIVE_VERSION@ @XLIB@
Libs: -L${libdir} -lguile-cairo
Cflags: -I${includedir}
diff --git a/guile-cairo/Makefile.am b/guile-cairo/Makefile.am
index 12838bc..cae8ed2 100644
--- a/guile-cairo/Makefile.am
+++ b/guile-cairo/Makefile.am
@@ -29,7 +29,7 @@ libguile_cairo_la_SOURCES = guile-cairo.c \
libguile_cairo_la_CFLAGS = $(CAIRO_CFLAGS) $(AM_CFLAGS) $(GUILE_CFLAGS)
-libguile_cairo_la_LIBADD = $(CAIRO_LIBS) $(GUILE_LIBS)
+libguile_cairo_la_LIBADD = $(CAIRO_LIBS) $(GUILE_LIBS) $(GUILE_X_LIBS)
libguile_cairo_la_LDFLAGS = -export-dynamic
libguile_cairo_la_includedir = $(includedir)/guile-cairo
diff --git a/guile-cairo/guile-cairo.c b/guile-cairo/guile-cairo.c
index 4136915..1340297 100644
--- a/guile-cairo/guile-cairo.c
+++ b/guile-cairo/guile-cairo.c
@@ -36,11 +36,25 @@
#include <cairo-svg.h>
#endif /* CAIRO_HAS_SVG_SURFACE */
+/* TODO this should be anded with a symbol from
+ automake showing that guile-xlib was available */
+#define WITH_XLIB CAIRO_HAS_XLIB_SURFACE
+
+#if WITH_XLIB
+#include <cairo-xlib.h>
+#include <guile-xlib.h>
+#endif /* WITH_XLIB */
+
#include "guile-cairo-compat.h"
#include "guile-cairo.h"
static cairo_user_data_key_t scm_cairo_key;
+#if WITH_XLIB
+static SCM xlib_drawable_table;
+static SCM xlib_screen_table;
+#endif /* WITH_XLIB */
+
#if SCM_MAJOR_VERSION >= 2
#define UNPROTECT (cairo_destroy_func_t)scm_gc_unprotect_object
#else
@@ -2342,7 +2356,7 @@ SCM_DEFINE_PUBLIC
(scm_cairo_surface_mark_dirty_rectangle, "cairo-surface-mark-d
scm_to_double (y),
scm_to_double (width),
scm_to_double (height));
-
+
SCHKRET (surf, SCM_UNSPECIFIED);
}
@@ -3465,7 +3479,149 @@ cairo_svg_version_to_string (cairo_svg_version_t
version);
#endif /* CAIRO_HAS_SVG_SURFACE */
-
+#if WITH_XLIB
+
+SCM_DEFINE_PUBLIC (scm_cairo_xlib_surface_create, "cairo-xlib-surface-create",
3, 0, 0,
+ (SCM drawable, SCM width, SCM height),
+ "")
+#define FUNC_NAME s_scm_cairo_xlib_surface_create
+{
+ xwindow_t *win = valid_win (drawable, SCM_ARG1, ~XWINDOW_STATE_DESTROYED,
FUNC_NAME);
+ xdisplay_t *dsp = get_display (scm_x_display_of (drawable));
+
+ /* Visual set to DefaultVisual since Gulie2-Xlib currently lacks Visual
support */
+ Visual *v = DefaultVisual (dsp->dsp, XDefaultScreen(dsp->dsp));
+ cairo_surface_t *surf = cairo_xlib_surface_create ( dsp->dsp,
+ win->win,
+ v,
+ scm_to_int (width),
+ scm_to_int (height));
+
+ /* Manual copying of SCONSRET to have time to run scm_hashq_set_x */
+ scm_c_check_cairo_status (cairo_surface_status (surf), NULL);
+ SCM smob = scm_take_cairo_surface (surf);
+ scm_hashq_set_x (xlib_drawable_table, smob, drawable);
+ return smob;
+}
+#undef FUNC_NAME
+
+/* cairo_xlib_surface_create_for_bitmap */
+
+SCM_DEFINE_PUBLIC (scm_cairo_xlib_surface_create_for_bitmap,
"cairo-xlib-surface-create-for-bitmap", 4, 0, 0,
+ (SCM drawable, SCM screen, SCM width, SCM height),
+ "")
+#define FUNC_NAME s_scm_cairo_xlib_surface_create_for_bitmap
+{
+ xwindow_t *pix = valid_win (drawable, SCM_ARG1, XWINDOW_STATE_PIXMAP,
FUNC_NAME);
+ SCM display = scm_x_display_of (drawable);
+ xdisplay_t *dsp = get_display (display);
+
+ xscreen_t *scr = ((xscreen_t *) SCM_SMOB_DATA (screen));
+
+ cairo_surface_t *surf = cairo_xlib_surface_create_for_bitmap ( dsp->dsp,
+ pix->win,
+ scr->scr,
+ scm_to_int
(width),
+ scm_to_int
(height));
+
+ /* Manual copying of SCONSRET to have time to run scm_hashq_set_x */
+ scm_c_check_cairo_status (cairo_surface_status (surf), NULL);
+ SCM smob = scm_take_cairo_surface (surf);
+ scm_hashq_set_x (xlib_drawable_table, smob, drawable);
+ scm_hashq_set_x (xlib_screen_table, smob, screen);
+ return smob;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE_PUBLIC (scm_cairo_xlib_surface_set_size,
"cairo-xlib-surface-set-size", 3, 0, 0,
+ (SCM surf, SCM width, SCM height),
+ "")
+{
+ cairo_xlib_surface_set_size (scm_to_cairo_surface (surf),
+ scm_to_int (width),
+ scm_to_int (height));
+ SCHKRET (surf, SCM_UNSPECIFIED);
+}
+
+SCM_DEFINE_PUBLIC (scm_cairo_xlib_surface_set_drawable,
"cairo-xlib-surface-set-drawable", 4, 0, 0,
+ (SCM surface, SCM drawable, SCM width, SCM height),
+ "")
+#define FUNC_NAME s_scm_cairo_xlib_surface_set_drawable
+{
+ xwindow_t *win = valid_win (drawable, SCM_ARG1, ~XWINDOW_STATE_DESTROYED,
FUNC_NAME);
+ cairo_xlib_surface_set_drawable (scm_to_cairo_surface (surface),
+ win->win,
+ scm_to_int (width),
+ scm_to_int (height));
+ scm_hashq_set_x (xlib_drawable_table, surface, drawable);
+ SCHKRET (surface, SCM_UNSPECIFIED);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE_PUBLIC (scm_cairo_xlib_surface_get_display,
"cairo-xlib-surface-get-display", 1, 0, 0,
+ (SCM surface),
+ "")
+#define FUNC_NAME s_scm_cairo_xlib_surface_get_display
+{
+ SCM ret = scm_hashq_ref (xlib_drawable_table, surface, SCM_BOOL_F);
+ if (scm_is_false (ret))
+ scm_misc_error (FUNC_NAME, "No Display found for surface ~a.", scm_list_1
(surface));
+
+ return scm_x_display_of (ret);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE_PUBLIC (scm_cairo_xlib_surface_get_drawable,
"cairo-xlib-surface-get-drawable", 1, 0, 0,
+ (SCM surface),
+ "")
+#define FUNC_NAME s_scm_cairo_xlib_surface_get_drawable
+{
+ SCM ret = scm_hashq_ref (xlib_drawable_table, surface, SCM_BOOL_F);
+ if (scm_is_false (ret))
+ scm_misc_error (FUNC_NAME, "No Drawable found for surface ~a.", scm_list_1
(surface));
+
+ return ret;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE_PUBLIC (scm_cairo_xlib_surface_get_screen,
"cairo-xlib-surface-get-screen", 1, 0, 0,
+ (SCM surface),
+ "")
+#define FUNC_NAME s_scm_cairo_xlib_surface_get_screen
+{
+ SCM ret = scm_hashq_ref (xlib_screen_table, surface, SCM_BOOL_F);
+ if (scm_is_false (ret))
+ scm_misc_error (FUNC_NAME, "No Screen found for surface ~a.", scm_list_1
(surface));
+
+ return ret;
+}
+#undef FUNC_NAME
+
+/* Visual ommited since Gulie2-Xlib currently lacks Visual support */
+/* cairo_xlib_surface_get_visual */
+
+SCM_DEFINE_PUBLIC (scm_cairo_xlib_surface_get_depth,
"cairo-xlib-surface-get-depth", 1, 0, 0,
+ (SCM surface),
+ "")
+{
+ return scm_from_int (cairo_xlib_surface_get_depth (scm_to_cairo_surface
(surface)));
+}
+
+SCM_DEFINE_PUBLIC (scm_cairo_xlib_surface_get_width,
"cairo-xlib-surface-get-width", 1, 0, 0,
+ (SCM surface),
+ "")
+{
+ return scm_from_int (cairo_xlib_surface_get_width (scm_to_cairo_surface
(surface)));
+}
+
+SCM_DEFINE_PUBLIC (scm_cairo_xlib_surface_get_height,
"cairo-xlib-surface-get-height", 1, 0, 0,
+ (SCM surface),
+ "")
+{
+ return scm_from_int (cairo_xlib_surface_get_height (scm_to_cairo_surface
(surface)));
+}
+
+#endif /* WITH_XLIB */
void
scm_init_cairo (void)
@@ -3483,5 +3639,10 @@ scm_init_cairo (void)
scm_init_cairo_vector_types ();
scm_init_cairo_enum_types ();
+ // TODO check GC around this
+ SCM s = scm_from_int(0x10);
+ xlib_drawable_table = scm_make_weak_key_hash_table (s);
+ xlib_screen_table = scm_make_weak_key_hash_table (s);
+
initialized = 1;
}
--
2.21.0
>From 7a83f54d65856e6df4df2dd45788aa176b36045c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <h...@hornquist.se>
Date: Mon, 29 Apr 2019 09:08:49 +0200
Subject: [PATCH 1/7] Rename xlib.c => guile-xlib.c, create guile-xlib.h.
This slightly restructures the project into being more of a library,
even in C space.
---
Makefile.am | 4 +-
configure.ac | 5 +-
xlib.c => guile-xlib.c | 229 ++---------------------------------------
guile-xlib.h | 228 ++++++++++++++++++++++++++++++++++++++++
4 files changed, 239 insertions(+), 227 deletions(-)
rename xlib.c => guile-xlib.c (91%)
create mode 100644 guile-xlib.h
diff --git a/Makefile.am b/Makefile.am
index 12b466e..4720a63 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -9,8 +9,8 @@ AUTOMAKE_OPTIONS = gnu
lib_LTLIBRARIES = libguilexlib.la
-BUILT_SOURCES = xlib.x
-libguilexlib_la_SOURCES = xlib.c $(BUILT_SOURCES)
+BUILT_SOURCES = guile-xlib.x
+libguilexlib_la_SOURCES = guile-xlib.c $(BUILT_SOURCES)
libguilexlib_la_LDFLAGS = -version-info 0:0 -export-dynamic
libguilexlib_la_CFLAGS = $(GUILE_CFLAGS)
libguilexlib_la_LIBADD = $(X_LIBS) $(X_PRE_LIBS) -lX11 $(X_EXTRA_LIBS)
$(GUILE_LIBS)
diff --git a/configure.ac b/configure.ac
index 1120f0d..1bfe878 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1,5 +1,6 @@
-AC_INIT(xlib.c)
-AM_INIT_AUTOMAKE(guile2-xlib, 0.1)
+AC_INIT(guile2-xlib, 0.1)
+AC_CONFIG_SRCDIR(guile-xlib.c)
+AM_INIT_AUTOMAKE
AC_CONFIG_MACRO_DIR([m4])
AM_MAINTAINER_MODE
diff --git a/xlib.c b/guile-xlib.c
similarity index 91%
rename from xlib.c
rename to guile-xlib.c
index 54d7be8..d829b22 100644
--- a/xlib.c
+++ b/guile-xlib.c
@@ -1,3 +1,5 @@
+#include "guile-xlib.h"
+
#include <X11/Xlib.h>
#include <X11/Xutil.h>
#include <libguile.h>
@@ -10,152 +12,6 @@
# define SCM_STRING_CHARS(x) (SCM_ROCHARS(x))
#endif
-/* Note on differences between this interface and raw Xlib in C.
-
- Some differences are inevitable. When the power of Xlib is made
- available in an general purpose interpreted environment like Guile,
- we need to make sure that the interface cannot be called in a way
- that would cause the environment as a whole to crash or hang. For
- example, in C you can call XCloseDisplay and then, say,
- XDestroyWindow for the display that you have just closed; and your
- program will probably hang or crash as a result. An interface like
- the one implemented here must protect the environment against such
- problems by detecting and rejecting invalid usage.
-
- In practice, this means that the interface needs to track the
- current state of X resources like displays and windows. So the
- Guile Xlib interface differs from C Xlib at least in that it stores
- certain additional state information and uses this information to
- detect and disallow invalid usage.
-
- Given that some difference is inevitable, one piece of Schemely
- behaviour is sufficiently useful - and sufficiently easier to
- implement in this interface than in a Scheme layer above it - that
- it merits a further small departure from C Xlib. This is the
- automatic freeing of X resources when the interface-level objects
- associated with them are garbage collected. It applies to displays
- (using XCloseDisplay), windows (XDestroyWindow) and non-default gcs
- (XFreeGC). Note that it is still possible to free these resources
- explicitly, using the x-close-display!, x-destroy-window! and
- x-free-gc! primitives respectively.
-
- Many further differences (between this interface and C Xlib) are
- possible, but none are compelling. The X people presumably thought
- quite carefully about the structure and completeness of the Xlib
- interface, and that's worth benefitting from. Layers presenting a
- graphical X interface with a different structure, or from a
- different angle, can easily be implemented in Scheme on top of
- this one. */
-
-
-/* Note on garbage collection and freeing of X resources.
-
- The one wrinkle in implementing automatic freeing of X resources is
- that almost all X resources depend on a valid display, so we have
- to be careful that the display resource is always freed (using
- XCloseDisplay) last of all.
-
- In most cases this is handled by having resource smobs include a
- reference to the display smob. But there is still a problem when
- all remaining X resource references are dropped between one GC
- cycle and the next: when this happens, the next GC sweep could free
- the display smob before it gets to some of the other resource
- smobs.
-
- Fortunately, resource smobs can check, in their free functions,
- whether this has happened, by looking at the SCM_TYP16 of their
- reference to the display smob. If the display smob is still valid,
- this will be scm_tc16_xdisplay, and the relevant X resource should
- be freed as normal. If the display smob has been freed earlier in
- this sweep, GC will have set its SCM_TYP16 to scm_tc_free_cell;
- this indicates that XCloseDisplay has already been called, and so
- the relevant X resource no longer needs to be freed. */
-
-
-/* SMOB TYPES */
-
-typedef struct xdisplay_t
-{
- /* The underlying Xlib display pointer. */
- Display *dsp;
-
- /* State - open/closed. */
- int state;
-
-#define XDISPLAY_STATE_OPEN 1
-#define XDISPLAY_STATE_CLOSED 2
-#define XDISPLAY_STATE_ANY ( XDISPLAY_STATE_OPEN |
XDISPLAY_STATE_CLOSED )
-
- /* Cached default gc smob for this display. */
- SCM gc;
-
-} xdisplay_t;
-
-typedef struct xscreen_t
-{
- /* The display that this screen is on. */
- SCM dsp;
-
- /* The underlying Xlib screen structure. */
- Screen *scr;
-
-} xscreen_t;
-
-typedef struct xwindow_t
-{
- /* The display that this window is on. */
- SCM dsp;
-
- /* The underlying Xlib window ID. */
- Window win;
-
- /* State - mapped/unmapped/destroyed. */
- int state;
-
-#define XWINDOW_STATE_UNMAPPED 1
-#define XWINDOW_STATE_MAPPED 2
-#define XWINDOW_STATE_DESTROYED 4
-#define XWINDOW_STATE_THIRD_PARTY 8
-#define XWINDOW_STATE_PIXMAP 16
-
-} xwindow_t;
-
-typedef struct xgc_t
-{
- /* The display that this GC belongs to. */
- SCM dsp;
-
- /* The underlying Xlib GC ID. */
- GC gc;
-
- /* State - default/created/freed. */
- int state;
-
-#define XGC_STATE_DEFAULT 1
-#define XGC_STATE_CREATED 2
-#define XGC_STATE_FREED 4
-
-} xgc_t;
-
-
-/* DECLARATIONS */
-
-int scm_tc16_xdisplay = 0;
-int scm_tc16_xscreen = 0;
-int scm_tc16_xwindow = 0;
-int scm_tc16_xgc = 0;
-
-SCM resource_id_hash;
-
-#define XDISPLAY(display) ((xdisplay_t *) SCM_SMOB_DATA (display))
-#define XSCREEN(screen) ((xscreen_t *) SCM_SMOB_DATA (screen))
-
-#define XDATA_ARCS 0
-#define XDATA_LINES 1
-#define XDATA_POINTS 2
-#define XDATA_SEGMENTS 3
-#define XDATA_RECTANGLES 4
-
static int xdisplay_print (SCM display, SCM port, scm_print_state *pstate);
static size_t xdisplay_free (SCM display);
static SCM xdisplay_mark (SCM display);
@@ -164,95 +20,21 @@ static SCM valid_dsp (SCM arg, int pos, int expected,
const char *func);
static SCM xscreen_mark (SCM screen);
static int valid_scr (SCM display, SCM screen, int pos, xdisplay_t *dsp, const
char *func);
-SCM scm_x_open_display_x (SCM host);
-SCM scm_x_close_display_x (SCM display);
-SCM scm_x_no_op_x (SCM display);
-SCM scm_x_flush_x (SCM display);
-SCM scm_x_connection_number (SCM display);
-SCM scm_x_screen_count (SCM display);
-SCM scm_x_default_screen (SCM display);
-SCM scm_x_q_length (SCM display);
-SCM scm_x_server_vendor (SCM display);
-SCM scm_x_protocol_version (SCM display);
-SCM scm_x_protocol_revision (SCM display);
-SCM scm_x_vendor_release (SCM display);
-SCM scm_x_display_string (SCM display);
-SCM scm_x_bitmap_unit (SCM display);
-SCM scm_x_bitmap_bit_order (SCM display);
-SCM scm_x_bitmap_pad (SCM display);
-SCM scm_x_image_byte_order (SCM display);
-SCM scm_x_next_request (SCM display);
-SCM scm_x_last_known_request_processed (SCM display);
-SCM scm_x_display_of (SCM whatever);
-SCM scm_x_all_planes (void);
-SCM scm_x_root_window (SCM display, SCM screen);
-SCM scm_x_black_pixel (SCM display, SCM screen);
-SCM scm_x_white_pixel (SCM display, SCM screen);
-SCM scm_x_display_width (SCM display, SCM screen);
-SCM scm_x_display_height (SCM display, SCM screen);
-SCM scm_x_display_width_mm (SCM display, SCM screen);
-SCM scm_x_display_height_mm (SCM display, SCM screen);
-SCM scm_x_display_planes (SCM display, SCM screen);
-SCM scm_x_display_cells (SCM display, SCM screen);
-SCM scm_x_screen_of_display (SCM display, SCM screen);
-SCM scm_x_screen_number_of_screen (SCM screen);
-SCM scm_x_min_colormaps (SCM display, SCM screen);
-SCM scm_x_max_colormaps (SCM display, SCM screen);
-
static int xwindow_print (SCM window, SCM port, scm_print_state *pstate);
static size_t xwindow_free (SCM window);
static SCM xwindow_mark (SCM window);
-static xwindow_t * valid_win (SCM arg, int pos, int expected, const char
*func);
-
-SCM scm_x_create_window_x (SCM display); /* @@@ simplified */
-SCM scm_x_map_window_x (SCM window);
-SCM scm_x_unmap_window_x (SCM window);
-SCM scm_x_destroy_window_x (SCM window);
-SCM scm_x_clear_window_x (SCM window);
-SCM scm_x_clear_area_x (SCM window, SCM x, SCM y, SCM width, SCM height, SCM
exposures);
-
-SCM scm_x_create_pixmap_x (SCM display, SCM screen, SCM width, SCM height, SCM
depth);
-SCM scm_x_copy_area_x (SCM source, SCM destination, SCM gc, SCM src_x, SCM
src_y, SCM width, SCM height, SCM dst_x, SCM dst_y);
static int xgc_print (SCM window, SCM port, scm_print_state *pstate);
static size_t xgc_free (SCM gc);
static SCM xgc_mark (SCM gc);
static xgc_t * valid_gc (SCM arg, int pos, int expected, const char *func);
-SCM scm_x_default_gc (SCM display, SCM screen);
-SCM scm_x_free_gc_x (SCM gc);
-SCM scm_x_create_gc_x (SCM gc, SCM changes);
-SCM scm_x_change_gc_x (SCM gc, SCM changes);
-SCM scm_x_set_dashes_x (SCM gc, SCM offset, SCM dashes);
-SCM scm_x_set_clip_rectangles_x (SCM gc, SCM x, SCM y, SCM rectangles, SCM
ordering);
-SCM scm_x_copy_gc_x (SCM src, SCM dst, SCM fields);
-
static void * valid_data (SCM arg, int pos, int type, int *allocatedp, int
*count, const char *func);
static SCM draw (SCM window, SCM gc, SCM data, int type, const char *func);
-SCM scm_x_draw_arcs_x (SCM window, SCM gc, SCM arcs);
-SCM scm_x_draw_lines_x (SCM window, SCM gc, SCM points);
-SCM scm_x_draw_points_x (SCM window, SCM gc, SCM points);
-SCM scm_x_draw_segments_x (SCM window, SCM gc, SCM segments);
-SCM scm_x_draw_rectangles_x (SCM window, SCM gc, SCM rectangles);
-
static SCM copy_event_fields (SCM display, XEvent *e, SCM event, const char
*func);
static SCM lookup_window (SCM display, XID id, const char *func);
-SCM scm_x_check_mask_event_x (SCM display, SCM mask, SCM event);
-SCM scm_x_check_typed_event_x (SCM display, SCM type, SCM event);
-SCM scm_x_check_typed_window_event_x (SCM window, SCM type, SCM event);
-SCM scm_x_check_window_event_x (SCM window, SCM mask, SCM event);
-SCM scm_x_events_queued_x (SCM display, SCM mode);
-SCM scm_x_pending_x (SCM display);
-SCM scm_x_mask_event_x (SCM display, SCM mask, SCM event);
-SCM scm_x_next_event_x (SCM display, SCM event);
-SCM scm_x_peek_event_x (SCM display, SCM event);
-SCM scm_x_select_input_x (SCM window, SCM mask);
-SCM scm_x_window_event_x (SCM window, SCM mask, SCM event);
-
-void init_xlib_core (void);
-
/* DISPLAYS */
@@ -972,7 +754,7 @@ SCM xwindow_mark (SCM window)
return win->dsp;
}
-static xwindow_t * valid_win (SCM arg, int pos, int expected, const char *func)
+xwindow_t * valid_win (SCM arg, int pos, int expected, const char *func)
{
SCM arg1 = arg;
xwindow_t *win = NULL;
@@ -2838,7 +2620,6 @@ SCM_DEFINE (scm_x_window_event_x, "x-window-event!", 2,
1, 0,
}
#undef FUNC_NAME
-
/* INITIALIZATION */
void
@@ -2874,7 +2655,9 @@ init_xlib_core ()
resource_id_hash =
scm_gc_protect_object (scm_make_weak_value_hash_table (scm_from_int (19)));
-#include "xlib.x"
+#ifndef SCM_MAGIC_SNARFER
+#include "guile-xlib.x"
+#endif
}
/*
diff --git a/guile-xlib.h b/guile-xlib.h
new file mode 100644
index 0000000..0052b30
--- /dev/null
+++ b/guile-xlib.h
@@ -0,0 +1,228 @@
+#ifndef GUILE2_XLIB_XLIB_H
+#define GUILE2_XLIB_XLIB_H
+
+#include <X11/Xlib.h>
+#include <libguile.h>
+
+/* Note on differences between this interface and raw Xlib in C.
+
+ Some differences are inevitable. When the power of Xlib is made
+ available in an general purpose interpreted environment like Guile,
+ we need to make sure that the interface cannot be called in a way
+ that would cause the environment as a whole to crash or hang. For
+ example, in C you can call XCloseDisplay and then, say,
+ XDestroyWindow for the display that you have just closed; and your
+ program will probably hang or crash as a result. An interface like
+ the one implemented here must protect the environment against such
+ problems by detecting and rejecting invalid usage.
+
+ In practice, this means that the interface needs to track the
+ current state of X resources like displays and windows. So the
+ Guile Xlib interface differs from C Xlib at least in that it stores
+ certain additional state information and uses this information to
+ detect and disallow invalid usage.
+
+ Given that some difference is inevitable, one piece of Schemely
+ behaviour is sufficiently useful - and sufficiently easier to
+ implement in this interface than in a Scheme layer above it - that
+ it merits a further small departure from C Xlib. This is the
+ automatic freeing of X resources when the interface-level objects
+ associated with them are garbage collected. It applies to displays
+ (using XCloseDisplay), windows (XDestroyWindow) and non-default gcs
+ (XFreeGC). Note that it is still possible to free these resources
+ explicitly, using the x-close-display!, x-destroy-window! and
+ x-free-gc! primitives respectively.
+
+ Many further differences (between this interface and C Xlib) are
+ possible, but none are compelling. The X people presumably thought
+ quite carefully about the structure and completeness of the Xlib
+ interface, and that's worth benefitting from. Layers presenting a
+ graphical X interface with a different structure, or from a
+ different angle, can easily be implemented in Scheme on top of
+ this one. */
+
+
+/* Note on garbage collection and freeing of X resources.
+
+ The one wrinkle in implementing automatic freeing of X resources is
+ that almost all X resources depend on a valid display, so we have
+ to be careful that the display resource is always freed (using
+ XCloseDisplay) last of all.
+
+ In most cases this is handled by having resource smobs include a
+ reference to the display smob. But there is still a problem when
+ all remaining X resource references are dropped between one GC
+ cycle and the next: when this happens, the next GC sweep could free
+ the display smob before it gets to some of the other resource
+ smobs.
+
+ Fortunately, resource smobs can check, in their free functions,
+ whether this has happened, by looking at the SCM_TYP16 of their
+ reference to the display smob. If the display smob is still valid,
+ this will be scm_tc16_xdisplay, and the relevant X resource should
+ be freed as normal. If the display smob has been freed earlier in
+ this sweep, GC will have set its SCM_TYP16 to scm_tc_free_cell;
+ this indicates that XCloseDisplay has already been called, and so
+ the relevant X resource no longer needs to be freed. */
+
+
+/* SMOB TYPES */
+
+typedef struct xdisplay_t
+{
+ /* The underlying Xlib display pointer. */
+ Display *dsp;
+
+ /* State - open/closed. */
+ int state;
+
+#define XDISPLAY_STATE_OPEN 1
+#define XDISPLAY_STATE_CLOSED 2
+#define XDISPLAY_STATE_ANY ( XDISPLAY_STATE_OPEN |
XDISPLAY_STATE_CLOSED )
+
+ /* Cached default gc smob for this display. */
+ SCM gc;
+
+} xdisplay_t;
+
+typedef struct xscreen_t
+{
+ /* The display that this screen is on. */
+ SCM dsp;
+
+ /* The underlying Xlib screen structure. */
+ Screen *scr;
+
+} xscreen_t;
+
+typedef struct xwindow_t
+{
+ /* The display that this window is on. */
+ SCM dsp;
+
+ /* The underlying Xlib window ID. */
+ Window win;
+
+ /* State - mapped/unmapped/destroyed. */
+ int state;
+
+#define XWINDOW_STATE_UNMAPPED 1
+#define XWINDOW_STATE_MAPPED 2
+#define XWINDOW_STATE_DESTROYED 4
+#define XWINDOW_STATE_THIRD_PARTY 8
+#define XWINDOW_STATE_PIXMAP 16
+
+} xwindow_t;
+
+typedef struct xgc_t
+{
+ /* The display that this GC belongs to. */
+ SCM dsp;
+
+ /* The underlying Xlib GC ID. */
+ GC gc;
+
+ /* State - default/created/freed. */
+ int state;
+
+#define XGC_STATE_DEFAULT 1
+#define XGC_STATE_CREATED 2
+#define XGC_STATE_FREED 4
+
+} xgc_t;
+
+
+/* DECLARATIONS */
+
+int scm_tc16_xdisplay = 0;
+int scm_tc16_xscreen = 0;
+int scm_tc16_xwindow = 0;
+int scm_tc16_xgc = 0;
+
+SCM resource_id_hash;
+
+#define XDISPLAY(display) ((xdisplay_t *) SCM_SMOB_DATA (display))
+#define XSCREEN(screen) ((xscreen_t *) SCM_SMOB_DATA (screen))
+
+#define XDATA_ARCS 0
+#define XDATA_LINES 1
+#define XDATA_POINTS 2
+#define XDATA_SEGMENTS 3
+#define XDATA_RECTANGLES 4
+
+SCM scm_x_open_display_x (SCM host);
+SCM scm_x_close_display_x (SCM display);
+SCM scm_x_no_op_x (SCM display);
+SCM scm_x_flush_x (SCM display);
+SCM scm_x_connection_number (SCM display);
+SCM scm_x_screen_count (SCM display);
+SCM scm_x_default_screen (SCM display);
+SCM scm_x_q_length (SCM display);
+SCM scm_x_server_vendor (SCM display);
+SCM scm_x_protocol_version (SCM display);
+SCM scm_x_protocol_revision (SCM display);
+SCM scm_x_vendor_release (SCM display);
+SCM scm_x_display_string (SCM display);
+SCM scm_x_bitmap_unit (SCM display);
+SCM scm_x_bitmap_bit_order (SCM display);
+SCM scm_x_bitmap_pad (SCM display);
+SCM scm_x_image_byte_order (SCM display);
+SCM scm_x_next_request (SCM display);
+SCM scm_x_last_known_request_processed (SCM display);
+SCM scm_x_display_of (SCM whatever);
+SCM scm_x_all_planes (void);
+SCM scm_x_root_window (SCM display, SCM screen);
+SCM scm_x_black_pixel (SCM display, SCM screen);
+SCM scm_x_white_pixel (SCM display, SCM screen);
+SCM scm_x_display_width (SCM display, SCM screen);
+SCM scm_x_display_height (SCM display, SCM screen);
+SCM scm_x_display_width_mm (SCM display, SCM screen);
+SCM scm_x_display_height_mm (SCM display, SCM screen);
+SCM scm_x_display_planes (SCM display, SCM screen);
+SCM scm_x_display_cells (SCM display, SCM screen);
+SCM scm_x_screen_of_display (SCM display, SCM screen);
+SCM scm_x_screen_number_of_screen (SCM screen);
+SCM scm_x_min_colormaps (SCM display, SCM screen);
+SCM scm_x_max_colormaps (SCM display, SCM screen);
+
+xwindow_t * valid_win (SCM arg, int pos, int expected, const char *func);
+
+SCM scm_x_create_window_x (SCM display); /* @@@ simplified */
+SCM scm_x_map_window_x (SCM window);
+SCM scm_x_unmap_window_x (SCM window);
+SCM scm_x_destroy_window_x (SCM window);
+SCM scm_x_clear_window_x (SCM window);
+SCM scm_x_clear_area_x (SCM window, SCM x, SCM y, SCM width, SCM height, SCM
exposures);
+
+SCM scm_x_create_pixmap_x (SCM display, SCM screen, SCM width, SCM height, SCM
depth);
+SCM scm_x_copy_area_x (SCM source, SCM destination, SCM gc, SCM src_x, SCM
src_y, SCM width, SCM height, SCM dst_x, SCM dst_y);
+
+SCM scm_x_default_gc (SCM display, SCM screen);
+SCM scm_x_free_gc_x (SCM gc);
+SCM scm_x_create_gc_x (SCM gc, SCM changes);
+SCM scm_x_change_gc_x (SCM gc, SCM changes);
+SCM scm_x_set_dashes_x (SCM gc, SCM offset, SCM dashes);
+SCM scm_x_set_clip_rectangles_x (SCM gc, SCM x, SCM y, SCM rectangles, SCM
ordering);
+SCM scm_x_copy_gc_x (SCM src, SCM dst, SCM fields);
+
+SCM scm_x_draw_arcs_x (SCM window, SCM gc, SCM arcs);
+SCM scm_x_draw_lines_x (SCM window, SCM gc, SCM points);
+SCM scm_x_draw_points_x (SCM window, SCM gc, SCM points);
+SCM scm_x_draw_segments_x (SCM window, SCM gc, SCM segments);
+SCM scm_x_draw_rectangles_x (SCM window, SCM gc, SCM rectangles);
+
+SCM scm_x_check_mask_event_x (SCM display, SCM mask, SCM event);
+SCM scm_x_check_typed_event_x (SCM display, SCM type, SCM event);
+SCM scm_x_check_typed_window_event_x (SCM window, SCM type, SCM event);
+SCM scm_x_check_window_event_x (SCM window, SCM mask, SCM event);
+SCM scm_x_events_queued_x (SCM display, SCM mode);
+SCM scm_x_pending_x (SCM display);
+SCM scm_x_mask_event_x (SCM display, SCM mask, SCM event);
+SCM scm_x_next_event_x (SCM display, SCM event);
+SCM scm_x_peek_event_x (SCM display, SCM event);
+SCM scm_x_select_input_x (SCM window, SCM mask);
+SCM scm_x_window_event_x (SCM window, SCM mask, SCM event);
+
+void init_xlib_core (void);
+
+#endif /* GUILE2_XLIB_XLIB_H */
--
2.21.0
>From eb22af0ff376cf39de9af515bdffcf42b2a1180a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <h...@lysator.liu.se> Date: Fri, 26 Apr 2019 19:26:47 +0200 Subject: [PATCH 2/7] Update autoconf files. Multiple thing: - Update which macros are used to get autotools to stop complaining. - Change how Guile version is detected. - Add guile 2.2 as an alternative guile version. - Change flags to guile-snarf to reflect above changes. - Update changed names. --- Makefile.am | 4 +++- configure.ac | 3 ++- 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/Makefile.am b/Makefile.am index 4720a63..29353b7 100644 --- a/Makefile.am +++ b/Makefile.am @@ -14,6 +14,8 @@ libguilexlib_la_SOURCES = guile-xlib.c $(BUILT_SOURCES) libguilexlib_la_LDFLAGS = -version-info 0:0 -export-dynamic libguilexlib_la_CFLAGS = $(GUILE_CFLAGS) libguilexlib_la_LIBADD = $(X_LIBS) $(X_PRE_LIBS) -lX11 $(X_EXTRA_LIBS) $(GUILE_LIBS) +libguilexlib_ladir = $(includedir) +libguilexlib_la_HEADERS = guile-xlib.h scmdatadir = $(datadir)/guile/xlib scmdata_DATA = xlib.scm @@ -24,7 +26,7 @@ EXTRA_DIST = $(scmdata_DATA) autogen.sh SUFFIXES = .x SNARF = guile-snarf .c.x: - $(SNARF) $(DEFS) $(INCLUDES) $(GUILE_CFLAGS) $(CPPFLAGS) $(CFLAGS) $< > $@ + $(SNARF) -o $@ $(INCLUDES) $(GUILE_CFLAGS) $(CPPFLAGS) $< info_TEXINFOS = guile-xlib.texi guile_xlib_TEXINFOS = xlib.texi diff --git a/configure.ac b/configure.ac index 1bfe878..b1ff6b9 100644 --- a/configure.ac +++ b/configure.ac @@ -4,7 +4,8 @@ AM_INIT_AUTOMAKE AC_CONFIG_MACRO_DIR([m4]) AM_MAINTAINER_MODE -PKG_CHECK_MODULES([GUILE], [guile-2.0]) +GUILE_PKG([2.2 2.0]) +GUILE_FLAGS AC_PROG_CC AC_PROG_CPP -- 2.21.0
>From e5bf6c53aa4c360c90ba73f7ed76baa861fec481 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <h...@hornquist.se> Date: Sat, 27 Apr 2019 17:43:01 +0200 Subject: [PATCH 3/7] Add /site/ to scmdatadir. --- Makefile.am | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Makefile.am b/Makefile.am index 29353b7..41fbbbb 100644 --- a/Makefile.am +++ b/Makefile.am @@ -17,7 +17,7 @@ libguilexlib_la_LIBADD = $(X_LIBS) $(X_PRE_LIBS) -lX11 $(X_EXTRA_LIBS) $(GUILE_L libguilexlib_ladir = $(includedir) libguilexlib_la_HEADERS = guile-xlib.h -scmdatadir = $(datadir)/guile/xlib +scmdatadir = $(datadir)/guile/site/xlib scmdata_DATA = xlib.scm EXTRA_DIST = $(scmdata_DATA) autogen.sh -- 2.21.0
>From 605ae6113c986ff02651a21ba66cd9814d5c42da Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <h...@hornquist.se> Date: Sun, 28 Apr 2019 22:31:16 +0200 Subject: [PATCH 4/7] Add pkgconfig. --- .gitignore | 1 + Makefile.am | 3 +++ configure.ac | 1 + 3 files changed, 5 insertions(+) diff --git a/.gitignore b/.gitignore index f254c49..1c6008a 100644 --- a/.gitignore +++ b/.gitignore @@ -20,3 +20,4 @@ texinfo.tex compile depcomp configure +guile2-xlib.pc diff --git a/Makefile.am b/Makefile.am index 41fbbbb..551ad74 100644 --- a/Makefile.am +++ b/Makefile.am @@ -20,6 +20,9 @@ libguilexlib_la_HEADERS = guile-xlib.h scmdatadir = $(datadir)/guile/site/xlib scmdata_DATA = xlib.scm +pkgconfigdir = $(libdir)/pkgconfig +pkgconfig_DATA = guile2-xlib.pc + EXTRA_DIST = $(scmdata_DATA) autogen.sh ## We assume the user has already installed Guile. diff --git a/configure.ac b/configure.ac index b1ff6b9..a9e6d22 100644 --- a/configure.ac +++ b/configure.ac @@ -2,6 +2,7 @@ AC_INIT(guile2-xlib, 0.1) AC_CONFIG_SRCDIR(guile-xlib.c) AM_INIT_AUTOMAKE AC_CONFIG_MACRO_DIR([m4]) +AC_CONFIG_FILES(guile2-xlib.pc) AM_MAINTAINER_MODE GUILE_PKG([2.2 2.0]) -- 2.21.0
>From 0c089a63e7b1fae8119ea3b780a47bf1cc582865 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <h...@hornquist.se>
Date: Sun, 28 Apr 2019 22:39:25 +0200
Subject: [PATCH 5/7] Add x-resize-window!.
---
guile-xlib.c | 26 ++++++++++++++++++++++++++
guile-xlib.h | 4 ++++
xlib.scm | 1 +
3 files changed, 31 insertions(+)
diff --git a/guile-xlib.c b/guile-xlib.c
index d829b22..9df32c1 100644
--- a/guile-xlib.c
+++ b/guile-xlib.c
@@ -2620,6 +2620,32 @@ SCM_DEFINE (scm_x_window_event_x, "x-window-event!", 2,
1, 0,
}
#undef FUNC_NAME
+SCM_DEFINE (scm_x_resize_window_x, "x-resize-window!", 3, 0, 0,
+ (SCM window,
+ SCM width,
+ SCM height),
+ "")
+#define FUNC_NAME s_scm_x_window_event_x
+{
+ SCM display1;
+ xdisplay_t *dsp;
+ xwindow_t *win;
+
+ display1 = valid_dsp (window, SCM_ARG1, XDISPLAY_STATE_OPEN, FUNC_NAME);
+ dsp = XDISPLAY (display1);
+ win = valid_win (window, SCM_ARG1, ~XWINDOW_STATE_DESTROYED, FUNC_NAME);
+
+ XResizeWindow (dsp->dsp, win->win,
+ scm_to_uint (width),
+ scm_to_uint (height));
+
+ return SCM_UNSPECIFIED;
+}
+
+xdisplay_t *get_display (SCM display) {
+ return XDISPLAY (valid_dsp (display, SCM_ARG1, XDISPLAY_STATE_OPEN,
"get_display"));
+}
+
/* INITIALIZATION */
void
diff --git a/guile-xlib.h b/guile-xlib.h
index 0052b30..862ded9 100644
--- a/guile-xlib.h
+++ b/guile-xlib.h
@@ -144,6 +144,8 @@ SCM resource_id_hash;
#define XDISPLAY(display) ((xdisplay_t *) SCM_SMOB_DATA (display))
#define XSCREEN(screen) ((xscreen_t *) SCM_SMOB_DATA (screen))
+xdisplay_t *get_display (SCM display);
+
#define XDATA_ARCS 0
#define XDATA_LINES 1
#define XDATA_POINTS 2
@@ -223,6 +225,8 @@ SCM scm_x_peek_event_x (SCM display, SCM event);
SCM scm_x_select_input_x (SCM window, SCM mask);
SCM scm_x_window_event_x (SCM window, SCM mask, SCM event);
+SCM scm_x_resize_window_x (SCM window, SCM width, SCM height);
+
void init_xlib_core (void);
#endif /* GUILE2_XLIB_XLIB_H */
diff --git a/xlib.scm b/xlib.scm
index a3fce6d..8510b0a 100644
--- a/xlib.scm
+++ b/xlib.scm
@@ -42,6 +42,7 @@
x-unmap-window!
x-destroy-window!
x-clear-window!
+ x-resize-window!
x-clear-area!
x-create-pixmap!
x-copy-area!
--
2.21.0
>From 65a5be82d4a867ebb5dc4858ee5a2186aec594e4 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <h...@hornquist.se>
Date: Sun, 28 Apr 2019 22:50:25 +0200
Subject: [PATCH 6/7] Add default to event-caputer.
---
guile-xlib.c | 9 +++++++++
1 file changed, 9 insertions(+)
diff --git a/guile-xlib.c b/guile-xlib.c
index 9df32c1..e073490 100644
--- a/guile-xlib.c
+++ b/guile-xlib.c
@@ -2356,6 +2356,15 @@ static SCM copy_event_fields (SCM display, XEvent *e,
SCM event, const char *fun
scm_c_vector_set_x(event, XEVENT_SLOT_COUNT, scm_from_int
(E.count));
break;
#undef E
+
+ default:
+ /* Default to a type value of -1. This makes the scheme code safer since
+ * event:type will always return an integer. This will both be triggered
+ * for any event type not mentioned above, as well as the first event
+ * captured, which might contain garbage data.
+ */
+ scm_c_vector_set_x(event, XEVENT_SLOT_TYPE, scm_from_int(-1));
+ break;
}
return event;
--
2.21.0
>From 8b4835755f0cc1790fbc71820f2750625adf76c7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <h...@hornquist.se> Date: Sun, 28 Apr 2019 22:50:38 +0200 Subject: [PATCH 7/7] Bump version from 0.1 to 0.2. --- configure.ac | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/configure.ac b/configure.ac index a9e6d22..a827494 100644 --- a/configure.ac +++ b/configure.ac @@ -1,4 +1,4 @@ -AC_INIT(guile2-xlib, 0.1) +AC_INIT(guile2-xlib, 0.2) AC_CONFIG_SRCDIR(guile-xlib.c) AM_INIT_AUTOMAKE AC_CONFIG_MACRO_DIR([m4]) -- 2.21.0
cairo-xlib.scm
Description: Lotus Screencam
