[gtk-cffi-cvs] CVS gtk-cffi/gdk

[CVS User rklochkov]

Update of /project/gtk-cffi/cvsroot/gtk-cffi/gdk
In directory tiger.common-lisp.net:/tmp/cvs-serv21507/gdk

Modified Files:
	package.lisp pango.lisp window.lisp 
Log Message:
Finished GtkWindow
Made global clean-up. Now it compiles all from scratch with asdf:compile-op
Add version-dependent functions (for ex. "since gtk 3.2")



--- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/package.lisp	2012/02/12 17:29:41	1.8
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/package.lisp	2012/02/20 16:51:37	1.9
@@ -36,6 +36,11 @@
 
    #:window
    #:modifier-type
+   #:window-hints
+   #:gravity
+   #:geometry
+   #:window-edge
+   #:window-type-hint
 
    #:pixmap
    
--- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/pango.lisp	2012/01/27 18:41:31	1.6
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/pango.lisp	2012/02/20 16:51:37	1.7
@@ -1,5 +1,5 @@
 (defpackage #:pango-cffi
-  (:use #:common-lisp #:cffi-object #:cffi #:iterate #:g-object-cffi
+  (:use #:common-lisp #:cffi-objects #:iterate #:g-object-cffi
         #:alexandria #:gtk-cffi-utils)
   (:export
    #:font
@@ -22,10 +22,10 @@
 
 
 (defcfun ("pango_font_description_from_string" string->pango-font)
-  :pointer (str gtk-string))
+  :pointer (str :string))
 
 (defcfun ("pango_font_description_to_string" pango-font->string)
-  gtk-string (font :pointer))
+  :string (font :pointer))
 
 (defcfun pango-font-description-free :void (font :pointer))
 
@@ -159,8 +159,8 @@
 ;; for language we don't need foreign type, because we don't need
 ;; to free these pointers for languages
 (defcfun (string->language "pango_language_from_string") language 
-  (str gtk-string))
-(defcfun (language->string "pango_language_to_string") gtk-string 
+  (str :string))
+(defcfun (language->string "pango_language_to_string") :string 
   (language language))
 
 (eval-when (:compile-toplevel :load-toplevel)
@@ -275,10 +275,10 @@
 
 
 
-(template (:language :family :style :variant :stretch :weight :size
-                     :font-desc :strikethrough :underline :scale
-                     :rise :letter-spacing :fallback :gravity
-                     :gravity-hint)
+(template attr (:language :family :style :variant :stretch :weight :size
+                          :font-desc :strikethrough :underline :scale
+                          :rise :letter-spacing :fallback :gravity
+                          :gravity-hint)
   (flet ((in-type (type)
            (case type
              (:family :string)
@@ -287,11 +287,11 @@
              ((:strikethrough :fallback) :boolean)
              (:scale :double)
              (t (intern (symbol-name type) #.*package*)))))
-    `(defcfun ,(symbolicate 'pango-attr- param '-new) ,(attr->type param)
-       (value ,(in-type param)))))
+    `(defcfun ,(symbolicate 'pango-attr- attr '-new) ,(attr->type attr)
+       (value ,(in-type attr)))))
 
-(template (:foreground :background :strikethrough-color :underline-color)
-  `(defcfun ,(symbolicate 'pango-attr- param '-new) attr-color
+(template attr (:foreground :background :strikethrough-color :underline-color)
+  `(defcfun ,(symbolicate 'pango-attr- attr '-new) attr-color
      (red :uint16) (green :uint16) (blue :uint16)))
 
 (defcfun ("pango_attr_size_new_absolute" pango-attr-absolute-size-new) 
@@ -347,21 +347,20 @@
 (defcfun pango-attr-list-new :pointer)
 (defcfun pango-attr-list-insert :void (list :pointer) (attr :pointer))
 
-(template (t)
-  (declare (ignore param))
-  `(defun list->attr (l)
-     (destructuring-bind (type start-index end-index &rest params) l
-       (let ((ptr
-              (apply
-               (case type
-                 ,@(mapcar (lambda (x) `(,x 
-                                         (function ,(symbolicate 
-                                                     'pango-attr- x '-new))))
-                           (cdr (foreign-enum-keyword-list 'attr-type))))
-               params)))
-         (setf (foreign-slot-value ptr 'attribute 'start-index) start-index
-               (foreign-slot-value ptr 'attribute 'end-index) end-index)
-         ptr))))
+(defun list->attr (l)
+  (destructuring-bind (type start-index end-index &rest params) l
+    (let ((ptr
+           (apply
+            (template () ()
+              `(case type
+                 ,@(mapcar 
+                    (lambda (x) `(,x (function ,(symbolicate 
+                                                 'pango-attr- x '-new))))
+                    (cdr (foreign-enum-keyword-list 'attr-type)))))
+            params)))
+      (setf (foreign-slot-value ptr 'attribute 'start-index) start-index
+            (foreign-slot-value ptr 'attribute 'end-index) end-index)
+      ptr)))
          
 
 (defmethod translate-to-foreign (value (type attr-list))
--- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/window.lisp	2011/08/26 17:16:14	1.2
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/window.lisp	2012/02/20 16:51:37	1.3
@@ -10,3 +10,32 @@
   :shift :lock :control :mod1 :mod2 :mod3 :mod4 :mod5
   :button1 :button2 :button3 :button4 :button5
   (:super #.(ash 1 26)) :hyper :meta (:release #.(ash 1 30)))
+
+(defbitfield window-hints
+  :pos :min-size :max-size :base-size :aspect :resize-inc :win-gravity
+  :user-pos :user-size)
+
+(defcenum gravity
+  (:north-west 1) :north :north-east :west :center :east
+  :south-west :south :south-east :static)
+
+(defcenum window-edge
+  :north-west :north :north-east :west :east
+  :south-west :south :south-east)
+
+(defcenum window-type-hint
+  :normal :dialog :menu :toolbar :splashscreen :utility
+  :dock :desktop :dropdown-menu :popup-menu :tooltip :notification :combo :dnd)
+
+(defcstruct* geometry
+  (min-width :int)
+  (min-height :int)
+  (max-widht :int)
+  (max-height :int)
+  (base-width :int)
+  (base-height :int)
+  (width-inc :int)
+  (height-inc :int)
+  (min-aspect :double)
+  (max-aspect :double)
+  (win-gravity gravity))