From 08e589f6c584cb2a4c46f9e99547ac6c2bc75bf0 Mon Sep 17 00:00:00 2001
From: Dmitry Kalyanov <Kalyanov.Dmitry@gmail.com>
Date: Tue, 2 Jun 2009 00:08:06 +0400
Subject: [PATCH] Some changes for being able to save snapshots of widgets

---
 gdk/gdk.functions.lisp |   40 +++++++++++++++++++++++++++++++++++++++-
 gtk/gtk.widget.lisp    |    5 ++++-
 2 files changed, 43 insertions(+), 2 deletions(-)

diff --git a/gdk/gdk.functions.lisp b/gdk/gdk.functions.lisp
index 96a5bf1..f050253 100644
--- a/gdk/gdk.functions.lisp
+++ b/gdk/gdk.functions.lisp
@@ -53,4 +53,42 @@
 
 (defcfun gdk-atom-intern gdk-atom
   (name :string)
-  (only-if-exists :boolean))
\ No newline at end of file
+  (only-if-exists :boolean))
+
+(export 'drawable-size)
+
+(defcfun gdk-pixbuf-get-from-drawable (g-object pixbuf)
+  (dest (g-object pixbuf))
+  (src (g-object drawable))
+  (colormap :pointer)
+  (src-x :int)
+  (src-y :int)
+  (dest-x :int)
+  (dest-y :int)
+  (width :int)
+  (height :int))
+
+(defun pixbuf-get-from-drawable (pixbuf drawable &key (src-x 0) (src-y 0) (dest-x 0) (dest-y 0) (width -1) (height -1))
+  (gdk-pixbuf-get-from-drawable pixbuf drawable (null-pointer) src-x src-y dest-x dest-y width height))
+
+(export 'pixbuf-get-from-drawable)
+
+(defcfun gdk-pixbuf-savev :boolean
+  (pixbuf (g-object pixbuf))
+  (filename :string)
+  (type :string)
+  (option-keys (:pointer (:pointer :char)))
+  (option-values (:pointer (:pointer :char)))
+  (error :pointer))
+
+(defun pixbuf-save (pixbuf filename type)
+  (gdk-pixbuf-savev pixbuf
+                    (etypecase filename
+                      (string filename)
+                      (pathname (namestring filename)))
+                    type
+                    (null-pointer)
+                    (null-pointer)
+                    (null-pointer)))
+
+(export 'pixbuf-save)
diff --git a/gtk/gtk.widget.lisp b/gtk/gtk.widget.lisp
index 0e5def4..38bb750 100644
--- a/gtk/gtk.widget.lisp
+++ b/gtk/gtk.widget.lisp
@@ -541,8 +541,11 @@
 
 (export 'widget-trigger-tooltip-query)
 
-(defcfun (widget-snapshot "gtk_widget_get_snapshot") g-object
+(defcfun gtk-widget-get-snapshot g-object
   (widget g-object)
   (clip-rectangle (g-boxed-ptr rectangle)))
 
+(defun widget-snapshot (widget &optional clip-rectangle)
+  (gtk-widget-get-snapshot widget clip-rectangle))
+
 (export 'widget-snapshot)
\ No newline at end of file
-- 
1.7.10.4