[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