From ad4a2c4e90303713b089383980ddaca3c715ca9b Mon Sep 17 00:00:00 2001 Message-Id: From: Mark Wooding Date: Wed, 10 Dec 2008 02:58:13 +0000 Subject: [PATCH] Initial checkin Organization: Straylight/Edgeware From: espen --- gio/alien/g_callback_input_stream.c | 120 +++++++++++++++ gio/alien/g_callback_input_stream.h | 53 +++++++ gio/alien/g_callback_output_stream.c | 124 ++++++++++++++++ gio/alien/g_callback_output_stream.h | 58 ++++++++ gio/defpackage.lisp | 29 ++++ gio/export.lisp | 4 + gio/gio.lisp | 42 ++++++ gio/streams.lisp | 209 +++++++++++++++++++++++++++ 8 files changed, 639 insertions(+) create mode 100644 gio/alien/g_callback_input_stream.c create mode 100644 gio/alien/g_callback_input_stream.h create mode 100644 gio/alien/g_callback_output_stream.c create mode 100644 gio/alien/g_callback_output_stream.h create mode 100644 gio/defpackage.lisp create mode 100644 gio/export.lisp create mode 100644 gio/gio.lisp create mode 100644 gio/streams.lisp diff --git a/gio/alien/g_callback_input_stream.c b/gio/alien/g_callback_input_stream.c new file mode 100644 index 0000000..e48b601 --- /dev/null +++ b/gio/alien/g_callback_input_stream.c @@ -0,0 +1,120 @@ +#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__ + diff --git a/gio/alien/g_callback_input_stream.h b/gio/alien/g_callback_input_stream.h new file mode 100644 index 0000000..d6f1a7e --- /dev/null +++ b/gio/alien/g_callback_input_stream.h @@ -0,0 +1,53 @@ +#ifndef __G_CALLBACK_INPUT_STREAM_H__ +#define __G_CALLBACK_INPUT_STREAM_H__ + +#include + +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__ */ diff --git a/gio/alien/g_callback_output_stream.c b/gio/alien/g_callback_output_stream.c new file mode 100644 index 0000000..f4432cd --- /dev/null +++ b/gio/alien/g_callback_output_stream.c @@ -0,0 +1,124 @@ +#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__ + diff --git a/gio/alien/g_callback_output_stream.h b/gio/alien/g_callback_output_stream.h new file mode 100644 index 0000000..32536a5 --- /dev/null +++ b/gio/alien/g_callback_output_stream.h @@ -0,0 +1,58 @@ +#ifndef __G_CALLBACK_OUTPUT_STREAM_H__ +#define __G_CALLBACK_OUTPUT_STREAM_H__ + +#include + +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__ */ diff --git a/gio/defpackage.lisp b/gio/defpackage.lisp new file mode 100644 index 0000000..a7a3438 --- /dev/null +++ b/gio/defpackage.lisp @@ -0,0 +1,29 @@ +;; Common Lisp bindings for GTK+ v2.x +;; Copyright 1999-2008 Espen S. Johnsen +;; +;; 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")) + diff --git a/gio/export.lisp b/gio/export.lisp new file mode 100644 index 0000000..bfbb1f6 --- /dev/null +++ b/gio/export.lisp @@ -0,0 +1,4 @@ +(in-package "GIO") + +;;; Autogenerating exported symbols +(export-from-system) diff --git a/gio/gio.lisp b/gio/gio.lisp new file mode 100644 index 0000000..3d23fa8 --- /dev/null +++ b/gio/gio.lisp @@ -0,0 +1,42 @@ +;; Common Lisp bindings for GTK+ 2.x +;; Copyright 1999-2008 Espen S. Johnsen +;; +;; 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") + + diff --git a/gio/streams.lisp b/gio/streams.lisp new file mode 100644 index 0000000..99f29c9 --- /dev/null +++ b/gio/streams.lisp @@ -0,0 +1,209 @@ +;; Common Lisp bindings for GTK+ 2.x +;; Copyright 2008 Espen S. Johnsen +;; +;; 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]