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

CVS User rklochkov rklochkov at common-lisp.net
Wed Jan 25 19:15:09 UTC 2012


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

Modified Files:
	css-provider.lisp gtk-cffi.asd package.lisp text-buffer.lisp 
	widget.lisp 
Log Message:
Refactored freeable
Added loadlib to gio
Fixed compilation without loading



--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/css-provider.lisp	2011/08/26 17:16:14	1.1
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/css-provider.lisp	2012/01/25 19:15:08	1.2
@@ -22,13 +22,13 @@
 (defcfun gtk-css-provider-load-from-path :boolean
   (css-provider pobject) (path :string) (g-error object))
 
-(defmethod css-provider-load ((css-provider css-provider)
-                              &key data filename gfile)
-  (with-g-error g-error
-    (unless 
+(defgeneric css-provider-load (css-provider &key data filename gfile)
+  (:method  ((css-provider css-provider) &key data filename gfile)
+    (with-g-error g-error
+      (unless 
         (cond 
           (data (gtk-css-provider-load-from-data css-provider data -1 g-error))
           (filename (gtk-css-provider-load-from-path css-provider 
                                                      filename g-error))
           (gfile (gtk-css-provider-load-from-file css-provider gfile g-error)))
-      (cerror "Continue" "CSS Provider load error: ~a" g-error))))
+        (cerror "Continue" "CSS Provider load error: ~a" g-error)))))
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/gtk-cffi.asd	2012/01/21 18:35:00	1.11
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/gtk-cffi.asd	2012/01/25 19:15:08	1.12
@@ -14,7 +14,7 @@
   :author "Roman Klochkov <kalimehtar at mail.ru>"
   :version "0.5"
   :license "GPL"
-  :depends-on (gdk-cffi g-object-cffi g-lib-cffi gtk-cffi-utils)
+  :depends-on (gdk-cffi g-object-cffi g-lib-cffi gtk-cffi-utils gio-cffi)
   :components
   ((:file package)
    (:file enums :depends-on (package))
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/package.lisp	2012/01/21 18:35:00	1.11
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/package.lisp	2012/01/25 19:15:08	1.12
@@ -24,7 +24,9 @@
    #:object-by-id
    #:gsignal
    #:yield
-   
+
+   #:css-provider
+   #:css-provider-load
    
    #:widget
    ;; widget slots
@@ -610,3 +612,4 @@
 
 (in-package #:gtk-cffi)
 (register-package "Gtk" *package*)
+(register-prefix *package* 'gtk)
\ No newline at end of file
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/text-buffer.lisp	2011/12/31 17:20:56	1.4
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/text-buffer.lisp	2012/01/25 19:15:08	1.5
@@ -59,14 +59,14 @@
   (:get visible-slice gtk-string (end pobject))
   (:get visible-text gtk-string (end pobject))
   (:get pixbuf pobject)
-  (:get marks (g-slist pobject))
-  (:get toggled-tags (g-slist pobject) (toggle-on :boolean))
+  (:get marks (g-slist :elt pobject))
+  (:get toggled-tags (g-slist :elt pobject) (toggle-on :boolean))
   (:get child-anchor pobject)
   (begins-tag :boolean (tag pobject))
   (ends-tag :boolean (tag pobject))
   (toggles-tag :boolean (tag pobject))
   (has-tag :boolean (tag pobject))
-  (:get tags (g-slist pobject))
+  (:get tags (g-slist :elt pobject))
   ((text-iter-editable . editable) :boolean (default-setting :boolean))
   (can-insert :boolean (default-editability :boolean))
   (starts-word :boolean)
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/widget.lisp	2011/09/17 20:04:56	1.6
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/widget.lisp	2012/01/25 19:15:08	1.7
@@ -363,7 +363,8 @@
 (defmethod preferred-size ((widget widget))
   "Returns (values minimum natural).
 Minimum and natural are requisition objects."
-  (with-foreign-outs ((minimum 'requisition) (natural 'requisition)) :ignore
+  (with-foreign-outs ((minimum 'requisition) (natural 'requisition))
+      :ignore
     (gtk-widget-get-preferred-size widget minimum natural)))
 
 (defcstruct requested-size
@@ -379,7 +380,8 @@
   "EXTRA-SPACE -- integer, extra space to redistribute among children.
 SIZES -- {(widget minimum-size natural-size)}*"
   (let ((length (length sizes)))
-    (let ((sizes-struct (foreign-alloc 'requested-size :count length)))
+    (let ((sizes-struct (foreign-alloc 'requested-size
+                                       :count length)))
       (iter
         (for i from 0 below length)
         (for x in sizes)
@@ -394,22 +396,22 @@
 
 (init-slots widget nil)
 
-(macrolet 
-    ((from-style (name &optional type)
-       `(progn
-          (defmethod ,name ((widget widget) 
-                            &key ,@(when type '(type)) (state :normal))
-            (,name (style-context widget) ,@(when type '(:type type)) 
-                   :state state))
-          
-          (defmethod (setf ,name) (value (widget widget) 
-                                   &key ,@(when type '(type)) (state :normal))
-            (setf (,name (style-context widget) ,@(when type '(:type type)) 
-                         :state state) 
-                  value)))))
-  (from-style color t)
-  (from-style font)
-  (from-style bg-pixmap))
+(template
+    ((color t)
+     (font nil)
+     (bg-pixmap nil))
+  (destructuring-bind (name with-type) param
+    `(progn
+       (defmethod ,name ((widget widget) 
+                         &key ,@(when with-type '(type)) (state :normal))
+         (,name (style-context widget) ,@(when with-type '(:type type)) 
+                :state state))
+       
+       (defmethod (setf ,name) (value (widget widget) 
+                                &key ,@(when with-type '(type)) (state :normal))
+         (setf (,name (style-context widget) ,@(when with-type '(:type type))
+                      :state state)
+               value)))))
         
 
 (defclass widget-class (g-object-class)





More information about the gtk-cffi-cvs mailing list