--- /dev/null
+#include "g_callback_input_stream.h"
+
+G_DEFINE_TYPE (GCallbackInputStream, g_callback_input_stream, G_TYPE_INPUT_STREAM);
+
+struct _GCallbackInputStreamPrivate {
+ GCallbackInputStreamReadFunc read_func;
+ GCallbackInputStreamCloseFunc close_func;
+ gpointer user_data;
+};
+
+static gssize g_callback_input_stream_read (GInputStream *stream,
+ void *buffer,
+ gsize count,
+ GCancellable *cancellable,
+ GError **error);
+static gssize g_callback_input_stream_skip (GInputStream *stream,
+ gsize count,
+ GCancellable *cancellable,
+ GError **error);
+static gboolean g_callback_input_stream_close (GInputStream *stream,
+ GCancellable *cancellable,
+ GError **error);
+
+
+static void
+g_callback_input_stream_finalize (GObject *object)
+{
+ GCallbackInputStream *stream;
+
+ stream = G_CALLBACK_INPUT_STREAM (object);
+
+ G_OBJECT_CLASS (g_callback_input_stream_parent_class)->finalize (object);
+}
+
+static void
+g_callback_input_stream_class_init (GCallbackInputStreamClass *klass)
+{
+ GObjectClass *gobject_class = G_OBJECT_CLASS (klass);
+ GInputStreamClass *stream_class = G_INPUT_STREAM_CLASS (klass);
+
+ g_type_class_add_private (klass, sizeof (GCallbackInputStreamPrivate));
+
+ gobject_class->finalize = g_callback_input_stream_finalize;
+
+ stream_class->read_fn = g_callback_input_stream_read;
+ stream_class->skip = g_callback_input_stream_skip;
+ stream_class->close_fn = g_callback_input_stream_close;
+}
+
+static void
+g_callback_input_stream_init (GCallbackInputStream *callback_stream)
+{
+ callback_stream->priv =
+ G_TYPE_INSTANCE_GET_PRIVATE (callback_stream,
+ G_TYPE_CALLBACK_INPUT_STREAM,
+ GCallbackInputStreamPrivate);
+}
+
+GInputStream*
+g_callback_input_stream_new (GCallbackInputStreamReadFunc read_func,
+ GCallbackInputStreamCloseFunc close_func,
+ gpointer user_data)
+{
+ GCallbackInputStream *stream;
+
+ stream = g_object_new (G_TYPE_CALLBACK_INPUT_STREAM, NULL);
+
+ stream->priv->read_func = read_func;
+ stream->priv->close_func = close_func;
+ stream->priv->user_data = user_data;
+
+ return G_INPUT_STREAM (stream);
+}
+
+static gssize
+g_callback_input_stream_read (GInputStream *stream,
+ void *buffer,
+ gsize count,
+ GCancellable *cancellable,
+ GError **error)
+{
+ GCallbackInputStream *callback_stream = G_CALLBACK_INPUT_STREAM (stream);
+ GCallbackInputStreamReadFunc read_func = callback_stream->priv->read_func;
+ gpointer user_data = callback_stream->priv->user_data;
+
+ return read_func (buffer, count, cancellable, error, user_data);
+}
+
+static gssize
+g_callback_input_stream_skip (GInputStream *stream,
+ gsize count,
+ GCancellable *cancellable,
+ GError **error)
+{
+ GCallbackInputStream *callback_stream = G_CALLBACK_INPUT_STREAM (stream);
+ GCallbackInputStreamReadFunc read_func = callback_stream->priv->read_func;
+ gpointer user_data = callback_stream->priv->user_data;
+
+ return read_func (NULL, count, cancellable, error, user_data);
+}
+
+static gboolean
+g_callback_input_stream_close (GInputStream *stream,
+ GCancellable *cancellable,
+ GError **error)
+{
+ GCallbackInputStream *callback_stream = G_CALLBACK_INPUT_STREAM (stream);
+ GCallbackInputStreamCloseFunc close_func = callback_stream->priv->close_func;
+ gpointer user_data = callback_stream->priv->user_data;
+
+ callback_stream = G_CALLBACK_INPUT_STREAM (stream);
+
+ if (callback_stream->priv->close_func)
+ return close_func (cancellable, error, user_data);
+
+ return TRUE;
+}
+
+#define __G_CALLBACK_INPUT_STREAM_C__
+
--- /dev/null
+#ifndef __G_CALLBACK_INPUT_STREAM_H__
+#define __G_CALLBACK_INPUT_STREAM_H__
+
+#include <gio/gio.h>
+
+G_BEGIN_DECLS
+
+#define G_TYPE_CALLBACK_INPUT_STREAM (g_callback_input_stream_get_type ())
+#define G_CALLBACK_INPUT_STREAM(o) (G_TYPE_CHECK_INSTANCE_CAST ((o), G_TYPE_CALLBACK_INPUT_STREAM, GCallbackInputStream))
+#define G_CALLBACK_INPUT_STREAM_CLASS(k) (G_TYPE_CHECK_CLASS_CAST((k), G_TYPE_CALLBACK_INPUT_STREAM, GCallbackInputStreamClass))
+#define G_IS_CALLBACK_INPUT_STREAM(o) (G_TYPE_CHECK_INSTANCE_TYPE ((o), G_TYPE_CALLBACK_INPUT_STREAM))
+#define G_IS_CALLBACK_INPUT_STREAM_CLASS(k) (G_TYPE_CHECK_CLASS_TYPE ((k), G_TYPE_CALLBACK_INPUT_STREAM))
+#define G_CALLBACK_INPUT_STREAM_GET_CLASS(o) (G_TYPE_INSTANCE_GET_CLASS ((o), G_TYPE_CALLBACK_INPUT_STREAM, GCallbackInputStreamClass))
+
+
+typedef struct _GCallbackInputStream GCallbackInputStream;
+typedef struct _GCallbackInputStreamClass GCallbackInputStreamClass;
+typedef struct _GCallbackInputStreamPrivate GCallbackInputStreamPrivate;
+
+struct _GCallbackInputStream
+{
+ GInputStream parent_instance;
+
+ /*< private >*/
+ GCallbackInputStreamPrivate *priv;
+};
+
+struct _GCallbackInputStreamClass
+{
+ GInputStreamClass parent_class;
+};
+
+GType g_callback_input_stream_get_type (void) G_GNUC_CONST;
+
+typedef gssize (*GCallbackInputStreamReadFunc) (void *buffer,
+ gsize count,
+ GCancellable *cancellable,
+ GError **error,
+ gpointer data);
+
+typedef gboolean (*GCallbackInputStreamCloseFunc) (GCancellable *cancellable,
+ GError **error,
+ gpointer data);
+
+
+GInputStream*
+g_callback_input_stream_new (GCallbackInputStreamReadFunc read_func,
+ GCallbackInputStreamCloseFunc close_func,
+ gpointer user_data);
+
+G_END_DECLS
+
+#endif /* __G_CALLBACK_INPUT_STREAM_H__ */
--- /dev/null
+#include "g_callback_output_stream.h"
+
+G_DEFINE_TYPE (GCallbackOutputStream, g_callback_output_stream, G_TYPE_OUTPUT_STREAM);
+
+struct _GCallbackOutputStreamPrivate {
+ GCallbackOutputStreamWriteFunc write_func;
+ GCallbackOutputStreamFlushFunc flush_func;
+ GCallbackOutputStreamCloseFunc close_func;
+ gpointer user_data;
+};
+
+static gssize g_callback_output_stream_write (GOutputStream *stream,
+ void const *buffer,
+ gsize count,
+ GCancellable *cancellable,
+ GError **error);
+static gboolean g_callback_output_stream_flush (GOutputStream *stream,
+ GCancellable *cancellable,
+ GError **error);
+static gboolean g_callback_output_stream_close (GOutputStream *stream,
+ GCancellable *cancellable,
+ GError **error);
+
+
+static void
+g_callback_output_stream_finalize (GObject *object)
+{
+ GCallbackOutputStream *stream;
+
+ stream = G_CALLBACK_OUTPUT_STREAM (object);
+
+ G_OBJECT_CLASS (g_callback_output_stream_parent_class)->finalize (object);
+}
+
+static void
+g_callback_output_stream_class_init (GCallbackOutputStreamClass *klass)
+{
+ GObjectClass *gobject_class = G_OBJECT_CLASS (klass);
+ GOutputStreamClass *stream_class = G_OUTPUT_STREAM_CLASS (klass);
+
+ g_type_class_add_private (klass, sizeof (GCallbackOutputStreamPrivate));
+
+ gobject_class->finalize = g_callback_output_stream_finalize;
+
+ stream_class->write_fn = g_callback_output_stream_write;
+ stream_class->flush = g_callback_output_stream_flush;
+ stream_class->close_fn = g_callback_output_stream_close;
+}
+
+static void
+g_callback_output_stream_init (GCallbackOutputStream *callback_stream)
+{
+ callback_stream->priv =
+ G_TYPE_INSTANCE_GET_PRIVATE (callback_stream,
+ G_TYPE_CALLBACK_OUTPUT_STREAM,
+ GCallbackOutputStreamPrivate);
+}
+
+GOutputStream*
+g_callback_output_stream_new (GCallbackOutputStreamWriteFunc write_func,
+ GCallbackOutputStreamFlushFunc flush_func,
+ GCallbackOutputStreamCloseFunc close_func,
+ gpointer user_data)
+{
+ GCallbackOutputStream *stream;
+
+ stream = g_object_new (G_TYPE_CALLBACK_OUTPUT_STREAM, NULL);
+
+ stream->priv->write_func = write_func;
+ stream->priv->flush_func = flush_func;
+ stream->priv->close_func = close_func;
+ stream->priv->user_data = user_data;
+
+ return G_OUTPUT_STREAM (stream);
+}
+
+static gssize
+g_callback_output_stream_write (GOutputStream *stream,
+ const void *buffer,
+ gsize count,
+ GCancellable *cancellable,
+ GError **error)
+{
+ GCallbackOutputStream *callback_stream = G_CALLBACK_OUTPUT_STREAM (stream);
+ GCallbackOutputStreamWriteFunc write_func = callback_stream->priv->write_func;
+ gpointer user_data = callback_stream->priv->user_data;
+
+ return write_func (buffer, count, cancellable, error, user_data);
+}
+
+static gboolean
+g_callback_output_stream_flush (GOutputStream *stream,
+ GCancellable *cancellable,
+ GError **error)
+{
+ GCallbackOutputStream *callback_stream = G_CALLBACK_OUTPUT_STREAM (stream);
+ GCallbackOutputStreamFlushFunc flush_func = callback_stream->priv->flush_func;
+ gpointer user_data = callback_stream->priv->user_data;
+
+ if (callback_stream->priv->flush_func)
+ return flush_func (cancellable, error, user_data);
+
+ return TRUE;
+}
+
+static gboolean
+g_callback_output_stream_close (GOutputStream *stream,
+ GCancellable *cancellable,
+ GError **error)
+{
+ GCallbackOutputStream *callback_stream = G_CALLBACK_OUTPUT_STREAM (stream);
+ GCallbackOutputStreamCloseFunc close_func = callback_stream->priv->close_func;
+ gpointer user_data = callback_stream->priv->user_data;
+
+ callback_stream = G_CALLBACK_OUTPUT_STREAM (stream);
+
+ if (callback_stream->priv->close_func)
+ return close_func (cancellable, error, user_data);
+
+ return TRUE;
+}
+
+#define __G_CALLBACK_OUTPUT_STREAM_C__
+
--- /dev/null
+#ifndef __G_CALLBACK_OUTPUT_STREAM_H__
+#define __G_CALLBACK_OUTPUT_STREAM_H__
+
+#include <gio/gio.h>
+
+G_BEGIN_DECLS
+
+#define G_TYPE_CALLBACK_OUTPUT_STREAM (g_callback_output_stream_get_type ())
+#define G_CALLBACK_OUTPUT_STREAM(o) (G_TYPE_CHECK_INSTANCE_CAST ((o), G_TYPE_CALLBACK_OUTPUT_STREAM, GCallbackOutputStream))
+#define G_CALLBACK_OUTPUT_STREAM_CLASS(k) (G_TYPE_CHECK_CLASS_CAST((k), G_TYPE_CALLBACK_OUTPUT_STREAM, GCallbackOutputStreamClass))
+#define G_IS_CALLBACK_OUTPUT_STREAM(o) (G_TYPE_CHECK_INSTANCE_TYPE ((o), G_TYPE_CALLBACK_OUTPUT_STREAM))
+#define G_IS_CALLBACK_OUTPUT_STREAM_CLASS(k) (G_TYPE_CHECK_CLASS_TYPE ((k), G_TYPE_CALLBACK_OUTPUT_STREAM))
+#define G_CALLBACK_OUTPUT_STREAM_GET_CLASS(o) (G_TYPE_INSTANCE_GET_CLASS ((o), G_TYPE_CALLBACK_OUTPUT_STREAM, GCallbackOutputStreamClass))
+
+
+typedef struct _GCallbackOutputStream GCallbackOutputStream;
+typedef struct _GCallbackOutputStreamClass GCallbackOutputStreamClass;
+typedef struct _GCallbackOutputStreamPrivate GCallbackOutputStreamPrivate;
+
+struct _GCallbackOutputStream
+{
+ GOutputStream parent_instance;
+
+ /*< private >*/
+ GCallbackOutputStreamPrivate *priv;
+};
+
+struct _GCallbackOutputStreamClass
+{
+ GOutputStreamClass parent_class;
+};
+
+GType g_callback_output_stream_get_type (void) G_GNUC_CONST;
+
+typedef gssize (*GCallbackOutputStreamWriteFunc) (const void *buffer,
+ gsize count,
+ GCancellable *cancellable,
+ GError **error,
+ gpointer data);
+
+typedef gboolean (*GCallbackOutputStreamFlushFunc) (GCancellable *cancellable,
+ GError **error,
+ gpointer data);
+
+typedef gboolean (*GCallbackOutputStreamCloseFunc) (GCancellable *cancellable,
+ GError **error,
+ gpointer data);
+
+
+GOutputStream*
+g_callback_output_stream_new (GCallbackOutputStreamWriteFunc read_func,
+ GCallbackOutputStreamFlushFunc flush_func,
+ GCallbackOutputStreamCloseFunc close_func,
+ gpointer user_data);
+
+G_END_DECLS
+
+#endif /* __G_CALLBACK_OUTPUT_STREAM_H__ */
--- /dev/null
+;; Common Lisp bindings for GTK+ v2.x
+;; Copyright 1999-2008 Espen S. Johnsen <espen@users.sf.net>
+;;
+;; Permission is hereby granted, free of charge, to any person obtaining
+;; a copy of this software and associated documentation files (the
+;; "Software"), to deal in the Software without restriction, including
+;; without limitation the rights to use, copy, modify, merge, publish,
+;; distribute, sublicense, and/or sell copies of the Software, and to
+;; permit persons to whom the Software is furnished to do so, subject to
+;; the following conditions:
+;;
+;; The above copyright notice and this permission notice shall be
+;; included in all copies or substantial portions of the Software.
+;;
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+;; IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+;; CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
+;; $Id: defpackage.lisp,v 1.1 2008-12-10 02:58:13 espen Exp $
+
+
+(defpackage "GIO"
+ (:use "COMMON-LISP" "GFFI" "GLIB" "AUTOEXPORT" "PKG-CONFIG" "CLG-UTILS"
+ #+sbcl "SB-GRAY"))
+
--- /dev/null
+(in-package "GIO")
+
+;;; Autogenerating exported symbols
+(export-from-system)
--- /dev/null
+;; Common Lisp bindings for GTK+ 2.x
+;; Copyright 1999-2008 Espen S. Johnsen <espen@users.sf.net>
+;;
+;; Permission is hereby granted, free of charge, to any person obtaining
+;; a copy of this software and associated documentation files (the
+;; "Software"), to deal in the Software without restriction, including
+;; without limitation the rights to use, copy, modify, merge, publish,
+;; distribute, sublicense, and/or sell copies of the Software, and to
+;; permit persons to whom the Software is furnished to do so, subject to
+;; the following conditions:
+;;
+;; The above copyright notice and this permission notice shall be
+;; included in all copies or substantial portions of the Software.
+;;
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+;; IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+;; CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
+;; $Id: gio.lisp,v 1.1 2008-12-10 02:58:13 espen Exp $
+
+
+(in-package "GIO")
+
+(use-prefix "g")
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (init-types-in-library gio "libgio-2.0" :prefix "g_"
+ :ignore ("g_io_extension_get_type"))
+ (init-types-in-library gio "gio-alien" :prefix "g_"))
+
+
+(define-types-in-library gio "libgio-2.0"
+ ("GIOErrorEnum" :type io-error)
+ ("GIOModule" :ignore t))
+
+(define-types-in-library gio "gio-alien")
+
+
--- /dev/null
+;; Common Lisp bindings for GTK+ 2.x
+;; Copyright 2008 Espen S. Johnsen <espen@users.sf.net>
+;;
+;; Permission is hereby granted, free of charge, to any person obtaining
+;; a copy of this software and associated documentation files (the
+;; "Software"), to deal in the Software without restriction, including
+;; without limitation the rights to use, copy, modify, merge, publish,
+;; distribute, sublicense, and/or sell copies of the Software, and to
+;; permit persons to whom the Software is furnished to do so, subject to
+;; the following conditions:
+;;
+;; The above copyright notice and this permission notice shall be
+;; included in all copies or substantial portions of the Software.
+;;
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+;; IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+;; CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
+;; $Id: streams.lisp,v 1.1 2008-12-10 02:58:13 espen Exp $
+
+
+(in-package "GIO")
+
+(use-prefix "g")
+
+;;; Input streams
+
+(defbinding input-stream-read (stream buffer &key length cancellable) gssize
+ (stream input-stream)
+ (buffer pointer)
+ (length gsize)
+ (cancellable (or null cancellable))
+ (nil gerror-signal :out))
+
+(defbinding input-stream-read-all (stream buffer &key length cancellable) boolean
+ (stream input-stream)
+ (buffer pointer)
+ (length gsize)
+ (bytes-read gsize :out)
+ (cancellable (or null cancellable))
+ (nil gerror-signal :out))
+
+(defbinding input-stream-skip (stream length &key cancellable) gssize
+ (stream input-stream)
+ (length gsize)
+ (cancellable (or null cancellable))
+ (nil gerror-signal :out))
+
+(defbinding input-stream-close (stream &key cancellable) boolean
+ (stream input-stream)
+ (cancellable (or null cancellable))
+ (nil gerror-signal :out))
+
+
+;;; Output streams
+
+(defbinding output-stream-write (stream buffer &key length cancellable) gssize
+ (stream output-stream)
+ (buffer (or (unboxed-vector (unsigned-byte 8)) pointer))
+ ((or length (length buffer)) gsize)
+ (cancellable (or null cancellable))
+ (nil gerror-signal :out))
+
+(defbinding output-stream-write-all (stream buffer &key length cancellable) boolean
+ (stream output-stream)
+ (buffer (or (unboxed-vector (unsigned-byte 8)) pointer))
+ ((or length (length buffer)) gsize)
+ (bytes-written gsize :out)
+ (cancellable (or null cancellable))
+ (nil gerror-signal :out))
+
+(defbinding output-stream-flush (stream &key cancellable) boolean
+ (stream output-stream)
+ (cancellable (or null cancellable))
+ (nil gerror-signal :out))
+
+(defbinding output-stream-close (stream &key cancellable) boolean
+ (stream output-stream)
+ (cancellable (or null cancellable))
+ (nil gerror-signal :out))
+
+
+;;; Unix streams
+
+(defbinding %unix-input-stream-new () pointer
+ (fd int)
+ (close-fd-p boolean))
+
+(defmethod allocate-foreign ((stream unix-input-stream) &key fd close-fd)
+ (%unix-input-stream-new fd close-fd))
+
+(defbinding %unix-output-stream-new () pointer
+ (fd int)
+ (close-fd-p boolean))
+
+(defmethod allocate-foreign ((stream unix-output-stream) &key fd close-fd)
+ (%unix-output-stream-new fd close-fd))
+
+
+;;; Callback streams (clg extension)
+
+(define-callback callback-stream-read-func gssize
+ ((buffer pointer) (count gsize) (cancellable (or null cancellable))
+ (gerror pointer) (stream-id pointer-data))
+ (declare (ignore cancellable))
+ (handler-case
+ (let* ((sequence (make-array count :element-type '(unsigned-byte 8)))
+ (stream (find-user-data stream-id))
+ (bytes-read (read-sequence sequence stream)))
+ (unless (null-pointer-p buffer)
+ (make-c-vector '(unsigned-byte 8) bytes-read
+ :content sequence :location buffer))
+ bytes-read)
+ (serious-condition (condition)
+ (gerror-set-in-callback gerror (file-error-domain)
+ (enum-int :failed 'file-error-enum) (princ-to-string condition))
+ -1)))
+
+(define-callback callback-stream-write-func gssize
+ ((buffer pointer) (count gsize) (cancellable (or null cancellable))
+ (gerror pointer) (stream-id pointer-data))
+ (declare (ignore cancellable))
+ (handler-case
+ (let ((stream (find-user-data stream-id)))
+ (write-sequence
+ (map-c-vector 'vector 'identity buffer '(unsigned-byte 8) count)
+ stream))
+ (serious-condition (condition)
+ (gerror-set-in-callback gerror (file-error-domain)
+ (enum-int :failed 'file-error-enum) (princ-to-string condition))
+ -1)))
+
+(define-callback callback-stream-flush-func boolean
+ ((cancellable (or null cancellable)) (gerror pointer)
+ (stream-id pointer-data))
+ (declare (ignore cancellable))
+ (handler-case (force-output (find-user-data stream-id))
+ (serious-condition (condition)
+ (gerror-set-in-callback gerror (file-error-domain)
+ (enum-int :failed 'file-error-enum) (princ-to-string condition))
+ -1)))
+
+(define-callback callback-stream-close-func boolean
+ ((cancellable (or null cancellable)) gerror (stream-id pointer-data))
+ (declare (ignore cancellable gerror))
+ (destroy-user-data stream-id))
+
+(defbinding %callback-input-stream-new (stream-id) pointer
+ (callback-stream-read-func callback)
+ (callback-stream-close-func callback)
+ (stream-id pointer-data))
+
+(defbinding %callback-output-stream-new (stream-id) pointer
+ (callback-stream-read-func callback)
+ (callback-stream-flush-func callback)
+ (callback-stream-close-func callback)
+ (stream-id pointer-data))
+
+(defmethod allocate-foreign ((stream callback-input-stream) &key base-stream)
+ (%callback-input-stream-new (register-user-data base-stream)))
+
+(defmethod allocate-foreign ((stream callback-output-stream) &key base-stream)
+ (%callback-input-stream-new (register-user-data base-stream)))
+
+
+;;; Lisp integration
+
+(deftype input-stream-designator () '(or stream input-stream integer))
+(deftype output-stream-designator () '(or stream input-stream integer))
+
+(define-type-method alien-type ((type input-stream-designator))
+ (declare (ignore type))
+ (alien-type 'input-stream))
+
+(define-type-method alien-arg-wrapper ((type input-stream-designator) var stream style form &optional copy-in-p)
+ (declare (ignore type))
+ (let ((%stream (make-symbol "STREAM")))
+ `(let ((,%stream (etypecase ,stream
+ (input-stream ,stream)
+ (integer (make-instance 'unix-input-stream :fd ,stream))
+ (stream (make-instance 'callback-input-stream
+ :base-stream ,stream)))))
+ (unwind-protect
+ ,(alien-arg-wrapper 'input-stream var %stream style form copy-in-p)
+ (unless (typep ,stream 'input-stream)
+ (input-stream-close ,%stream))))))
+
+(define-type-method alien-type ((type output-stream-designator))
+ (declare (ignore type))
+ (alien-type 'output-stream))
+
+(define-type-method alien-arg-wrapper ((type output-stream-designator) var stream style form &optional copy-in-p)
+ (declare (ignore type))
+ (let ((%stream (make-symbol "STREAM")))
+ `(let ((,%stream (etypecase ,stream
+ (output-stream ,stream)
+ (integer (make-instance 'unix-output-stream :fd ,stream))
+ (stream (make-instance 'callback-output-stream
+ :base-stream ,stream)))))
+ (unwind-protect
+ ,(alien-arg-wrapper 'input-stream var %stream style form copy-in-p)
+ (unless (typep ,stream 'output-stream)
+ (output-stream-close ,%stream))))))
+
+;; TODO: make GIO streams appear as Lisp streams
~mdw / clg / commitdiff