[gtk-cffi-cvs] CVS gtk-cffi/gtk
CVS User rklochkov
rklochkov at common-lisp.net
Sat Sep 10 16:26:11 UTC 2011
Update of /project/gtk-cffi/cvsroot/gtk-cffi/gtk
In directory tiger.common-lisp.net:/tmp/cvs-serv27495/gtk
Modified Files:
common.lisp generics.lisp gtk-cffi.asd lisp-model.lisp
style-context.lisp tree-model.lisp widget.lisp
Added Files:
addons.lisp
Log Message:
Some refactoring. Now we can use (show #(1 2 3)) or (show '(1 2 3)) to lookup
through the sequence in GTK list view
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/common.lisp 2011/08/26 17:16:14 1.2
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/common.lisp 2011/09/10 16:26:11 1.3
@@ -22,7 +22,7 @@
(defcfun "gtk_main_quit" :void)
-
+(defun defmodel (body)
"
Source:
`(window :height 100
@@ -46,8 +46,6 @@
(make-instance 'label :id :label1)
(make-instance 'button :id :button1))))
"
-
-(defun defmodel (body)
(labels
((rest-translate (l)
"(:height 100 (:label) (:h-box)) -> (:height 100 :kids (list ....))"
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/generics.lisp 2011/08/26 17:16:14 1.2
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/generics.lisp 2011/09/10 16:26:11 1.3
@@ -1,129 +1,129 @@
(in-package :gtk-cffi)
-(defgeneric destroy (gtk-object))
-(defgeneric flags (gtk-object))
+;; (defgeneric destroy (gtk-object))
+;; (defgeneric flags (gtk-object))
-(defgeneric text (widget &rest flags))
-(defgeneric (setf text) (text widget &rest rest))
-(defgeneric (setf mnemonic-widget) (widget label))
-(defgeneric mnemonic-widget (label))
-(defgeneric activate (widget))
-(defgeneric realize (widget))
-(defgeneric size-request (widget))
-(defgeneric (setf size-request) (size widget))
-(defgeneric style-field (widget field &optional state type))
-(defgeneric (setf style-field) (value widget field &optional state type))
-(defgeneric color (widget &rest rest))
-(defgeneric (setf color) (color widget &rest rest))
-(defgeneric font (widget &rest rest))
-(defgeneric (setf font) (font widget &rest rest))
-(defgeneric bg-pixmap (widget &rest state))
-(defgeneric (setf bg-pixmap) (pixmap widget &rest rest))
-(defgeneric allocation (widget))
-(defgeneric (setf allocation) (value widget))
-(defgeneric show (widget &rest flags))
-(defgeneric hide (widget))
-(defgeneric gdk-window (widget))
-(defgeneric (setf justify) (justify label))
-(defgeneric justify (label))
-
-(defgeneric child (bin))
-
-(defgeneric (setf default-size) (coords window))
-(defgeneric default-size (window))
-(defgeneric (setf screen) (screen window))
-(defgeneric screen (window))
-(defgeneric transient-for (window))
-(defgeneric (setf transient-for) (window parent))
-(defgeneric (setf win-position) (pos window))
-
-(defgeneric add (container widget))
-(defgeneric border-width (container))
-(defgeneric (setf border-width) (value container))
-(defgeneric reparent (widget new-parent))
-(defgeneric propagate-expose (container child event))
-
-(defgeneric run (dialog &key keep-alive))
-(defgeneric (setf has-separator) (has dialog))
-(defgeneric has-separator (dialog))
-(defgeneric add-button (dialog string response))
-
-;(defgeneric get-iter (text-buffer text-iter pos))
-(defgeneric buffer (text-view))
-(defgeneric (setf buffer) (buffer text-view))
-
-(defgeneric add-attribute (cell-layout cell-renderer attr column))
-(defgeneric (setf cell-data-func) (c-handler
- cell-layout cell-renderer
- &optional data destroy-notify))
-(defgeneric clear-attributes (cell-layout cell-renderer))
-(defgeneric clear (cell-layout))
-
-(defgeneric (setf sort-column-id) (id tree-view-column))
-(defgeneric (setf reorderable) (reorderable tree-view-column))
-(defgeneric reorderable (tree-view-column))
-(defgeneric (setf widget) (widget tree-view-column))
-(defgeneric widget (tree-view-column))
-(defgeneric pack (tree-view-column cell-renderer &rest flags))
-(defgeneric cell-get-position (tree-view-column cell-renderer))
-(defgeneric cell-renderers (tree-view-column))
-(defgeneric get-cell-at (tree-view-column x))
-(defgeneric (setf title) (title tree-view-column))
-(defgeneric title (tree-view-column))
-
-(defgeneric get-indices (tree-path))
-(defgeneric get-index (tree-path &optional pos))
-(defgeneric copy (struct-object))
-(defgeneric foreach (tree-model func &optional data))
-(defgeneric iter->path (tree-model tree-iter))
-(defgeneric iter->string (tree-model tree-iter))
-(defgeneric model-values (tree-model &key iter columns col))
-(defgeneric path->iter (tree-model tree-path &optional tree-iter))
-(defgeneric n-columns (tree-model))
-(defgeneric column-type (tree-model col))
-
-
-(defgeneric path-from-child (tree-model-filter tree-path))
-(defgeneric iter-to-child (tree-model-filter tree-iter))
-(defgeneric (setf model-values) (values tree-model-filter
- &key iter columns col))
-(defgeneric (setf visible-column) (column tree-model-filter))
-
-(defgeneric (setf shadow-type) (shadow-type frame))
-(defgeneric shadow-type (frame))
-
-(defgeneric (setf policy) (policy scrolled-window))
-
-(defgeneric get-selection (tree-view))
-(defgeneric path-at-pos (tree-view x y))
-(defgeneric get-cursor (tree-view))
-(defgeneric column (tree-view n))
-(defgeneric append-column (tree-view tree-view-column))
-(defgeneric (setf search-column) (n tree-view))
-(defgeneric search-column (tree-view))
-(defgeneric model (tree-view))
-(defgeneric (setf model) (model tree-view))
-
-(defgeneric get-selected (tree-selection))
-(defgeneric tree-selection-foreach (tree-selection func &optional data))
-
-(defgeneric append-iter (list-store &optional tree-iter))
-(defgeneric append-values (list-store values))
-
-(defgeneric append-text (combo-box text))
-(defgeneric prepend-text (combo-box text))
-(defgeneric insert-text (combo-box text))
-(defgeneric remove-text (combo-box pos))
-(defgeneric active-text (combo-box))
-
-
-(defgeneric fraction (progress-bar))
-(defgeneric (setf fraction) (fraction progress-bar))
+;; (defgeneric text (widget &rest flags))
+;; (defgeneric (setf text) (text widget &rest rest))
+;; (defgeneric (setf mnemonic-widget) (widget label))
+;; (defgeneric mnemonic-widget (label))
+;; (defgeneric activate (widget))
+;; (defgeneric realize (widget))
+;; (defgeneric size-request (widget))
+;; (defgeneric (setf size-request) (size widget))
+;; (defgeneric style-field (widget field &optional state type))
+;; (defgeneric (setf style-field) (value widget field &optional state type))
+;; (defgeneric color (widget &rest rest))
+;; (defgeneric (setf color) (color widget &rest rest))
+;; (defgeneric font (widget &rest rest))
+;; (defgeneric (setf font) (font widget &rest rest))
+;; (defgeneric bg-pixmap (widget &rest state))
+;; (defgeneric (setf bg-pixmap) (pixmap widget &rest rest))
+;; (defgeneric allocation (widget))
+;; (defgeneric (setf allocation) (value widget))
+;; (defgeneric show (widget &rest flags))
+;; (defgeneric hide (widget))
+;; (defgeneric gdk-window (widget))
+;; (defgeneric (setf justify) (justify label))
+;; (defgeneric justify (label))
+
+;; (defgeneric child (bin))
+
+;; (defgeneric (setf default-size) (coords window))
+;; (defgeneric default-size (window))
+;; (defgeneric (setf screen) (screen window))
+;; (defgeneric screen (window))
+;; (defgeneric transient-for (window))
+;; (defgeneric (setf transient-for) (window parent))
+;; (defgeneric (setf win-position) (pos window))
+
+;; (defgeneric add (container widget))
+;; (defgeneric border-width (container))
+;; (defgeneric (setf border-width) (value container))
+;; (defgeneric reparent (widget new-parent))
+;; (defgeneric propagate-expose (container child event))
+
+;; (defgeneric run (dialog &key keep-alive))
+;; (defgeneric (setf has-separator) (has dialog))
+;; (defgeneric has-separator (dialog))
+;; (defgeneric add-button (dialog string response))
+
+;; ;(defgeneric get-iter (text-buffer text-iter pos))
+;; (defgeneric buffer (text-view))
+;; (defgeneric (setf buffer) (buffer text-view))
+
+;; (defgeneric add-attribute (cell-layout cell-renderer attr column))
+;; (defgeneric (setf cell-data-func) (c-handler
+;; cell-layout cell-renderer
+;; &optional data destroy-notify))
+;; (defgeneric clear-attributes (cell-layout cell-renderer))
+;; (defgeneric clear (cell-layout))
+
+;; (defgeneric (setf sort-column-id) (id tree-view-column))
+;; (defgeneric (setf reorderable) (reorderable tree-view-column))
+;; (defgeneric reorderable (tree-view-column))
+;; (defgeneric (setf widget) (widget tree-view-column))
+;; (defgeneric widget (tree-view-column))
+;; (defgeneric pack (tree-view-column cell-renderer &rest flags))
+;; (defgeneric cell-get-position (tree-view-column cell-renderer))
+;; (defgeneric cell-renderers (tree-view-column))
+;; (defgeneric get-cell-at (tree-view-column x))
+;; (defgeneric (setf title) (title tree-view-column))
+;; (defgeneric title (tree-view-column))
+
+;; (defgeneric get-indices (tree-path))
+;; (defgeneric get-index (tree-path &optional pos))
+;; (defgeneric copy (struct-object))
+;; (defgeneric foreach (tree-model func &optional data))
+;; (defgeneric iter->path (tree-model tree-iter))
+;; (defgeneric iter->string (tree-model tree-iter))
+;; (defgeneric model-values (tree-model &key iter columns col))
+;; (defgeneric path->iter (tree-model tree-path &optional tree-iter))
+;; (defgeneric n-columns (tree-model))
+;; (defgeneric column-type (tree-model col))
+
+
+;; (defgeneric path-from-child (tree-model-filter tree-path))
+;; (defgeneric iter-to-child (tree-model-filter tree-iter))
+;; (defgeneric (setf model-values) (values tree-model-filter
+;; &key iter columns col))
+;; (defgeneric (setf visible-column) (column tree-model-filter))
+
+;; (defgeneric (setf shadow-type) (shadow-type frame))
+;; (defgeneric shadow-type (frame))
+
+;; (defgeneric (setf policy) (policy scrolled-window))
+
+;; (defgeneric get-selection (tree-view))
+;; (defgeneric path-at-pos (tree-view x y))
+;; (defgeneric get-cursor (tree-view))
+;; (defgeneric column (tree-view n))
+;; (defgeneric append-column (tree-view tree-view-column))
+;; (defgeneric (setf search-column) (n tree-view))
+;; (defgeneric search-column (tree-view))
+;; (defgeneric model (tree-view))
+;; (defgeneric (setf model) (model tree-view))
+
+;; (defgeneric get-selected (tree-selection))
+;; (defgeneric tree-selection-foreach (tree-selection func &optional data))
+
+;; (defgeneric append-iter (list-store &optional tree-iter))
+;; (defgeneric append-values (list-store values))
+
+;; (defgeneric append-text (combo-box text))
+;; (defgeneric prepend-text (combo-box text))
+;; (defgeneric insert-text (combo-box text))
+;; (defgeneric remove-text (combo-box pos))
+;; (defgeneric active-text (combo-box))
+
+
+;; (defgeneric fraction (progress-bar))
+;; (defgeneric (setf fraction) (fraction progress-bar))
-(defgeneric (setf kid) (kid container))
-(defgeneric (setf kids) (kids container))
+;; (defgeneric (setf kid) (kid container))
+;; (defgeneric (setf kids) (kids container))
-(defgeneric resize (table &key rows columns))
+;; (defgeneric resize (table &key rows columns))
-(defgeneric attach (table widget &key left right top bottom
- xoptions yoptions xpadding ypadding))
\ No newline at end of file
+;; (defgeneric attach (table widget &key left right top bottom
+;; xoptions yoptions xpadding ypadding))
\ No newline at end of file
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/gtk-cffi.asd 2011/08/28 10:30:13 1.4
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/gtk-cffi.asd 2011/09/10 16:26:11 1.5
@@ -452,7 +452,16 @@
:license "GPL"
:depends-on (gtk-cffi-tree-model)
:components
- ((:file :lisp-model)))
+ ((:file lisp-model)))
+
+(defsystem gtk-cffi-addons
+ :description "Useful bits for GTK"
+ :author "Roman Klochkov <kalimehtar at mail.ru>"
+ :version "0.1"
+ :license "GPL"
+ :depends-on (gtk-cffi-tree-model)
+ :components
+ ((:file addons)))
(defsystem gtk-cffi
:description "Interface to GTK/Glib via CFFI"
@@ -484,5 +493,6 @@
gtk-cffi-notebook
gtk-cffi-image
gtk-cffi-text-view
+ gtk-cffi-addons
gtk-cffi-lisp-model))
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/lisp-model.lisp 2011/08/26 17:16:14 1.3
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/lisp-model.lisp 2011/09/10 16:26:11 1.4
@@ -25,12 +25,14 @@
(:method ((lisp-model-array lisp-model-array))
(length (larray lisp-model-array))))
-(defgeneric get-iter (lisp-model-impl iter path)
- (:method ((lisp-model-list lisp-model-list) iter path)
- (let ((index (get-index (make-instance 'tree-path :pointer path))))
- (when (< index (lisp-model-length lisp-model-list))
- (with-foreign-slots ((stamp u1) iter tree-iter-struct)
- (setf stamp 0 u1 (make-pointer index)))))))
+(defmethod get-iter ((lisp-model-impl lisp-model-impl) iter path)
+ (warn "Undefined implementation of GET-ITER for ~a" lisp-model-impl))
+
+(defmethod get-iter ((lisp-model-list lisp-model-list) iter path)
+ (let ((index (get-index (make-instance 'tree-path :pointer path))))
+ (when (< index (lisp-model-length lisp-model-list))
+ (with-foreign-slots ((stamp u1) iter tree-iter-struct)
+ (setf stamp 0 u1 (make-pointer index))))))
(defgeneric get-path (lisp-model-impl iter)
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/style-context.lisp 2011/08/26 17:16:14 1.1
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/style-context.lisp 2011/09/10 16:26:11 1.2
@@ -22,6 +22,7 @@
(defcfun gtk-style-context-get-border-color :void
(style-context pobject) (state state-flags) (color :pointer))
+(defgeneric color (object &key type state))
(defmethod color ((style-context style-context)
&key type (state :normal))
(with-foreign-object (color 'prgba)
@@ -35,6 +36,7 @@
(defcfun gtk-style-context-get-font pango-cffi:font
(style-context pobject) (state state-flags))
+(defgeneric font (object &key state))
(defmethod font ((style-context style-context)
&key (state :normal))
(gtk-style-context-get-font style-context state))
@@ -42,6 +44,7 @@
(defgtkfun add-provider :void style-context
(style-provider pobject) (priority :uint))
+(defgeneric load-css (style-context text))
(defmethod load-css ((style-context style-context) text)
(if (slot-boundp style-context 'provider)
(css-provider-load (slot-value style-context 'provider) :data text)
@@ -73,15 +76,18 @@
value)))
(slot-value style-context 'styles))))
+(defgeneric (setf color) (value object &key type state))
(defmethod (setf color) (value (style-context style-context)
&key type (state :normal))
(check-type type (member :bg :border nil))
(load-css style-context (make-css style-context type state value)))
+(defgeneric (setf font) (value object &key state))
(defmethod (setf font) (value (style-context style-context)
&key (state :normal))
(load-css style-context (make-css style-context :font state value)))
+(defgeneric (setf bg-pixmap) (value object &key state))
(defmethod (setf bg-pixmap) (value (style-context style-context)
&key (state :normal))
(load-css style-context
@@ -89,6 +95,7 @@
(format nil
"url('~a')" value))))
+(defgeneric bg-pixmap (object &key state))
(defmethod bg-pixmap ((style-context style-context) &key (state :normal))
(cdr (assoc (list :bg-image state) (slot-value style-context 'styles)
:test #'equal)))
\ No newline at end of file
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/tree-model.lisp 2011/08/26 17:16:14 1.3
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/tree-model.lisp 2011/09/10 16:26:11 1.4
@@ -58,10 +58,10 @@
(defmethod free :before ((tree-row tree-row))
(gtk-tree-row-reference-free tree-row))
-(defcfun "gtk_tree_row_reference_copy" :pointer (row pobject))
+(defcfun "gtk_tree_row_reference_copy" (object tree-row) (row pobject))
(defmethod copy ((tree-row tree-row))
- (make-instance 'tree-row :pointer (gtk-tree-row-reference-copy tree-row)))
+ (gtk-tree-row-reference-copy tree-row))
(defcstruct tree-iter-struct
"GtkTreeIter"
@@ -94,7 +94,7 @@
(defclass tree-model (object)
((columns :accessor columns :initarg :columns)
- (iter :accessor tree-iter)))
+ (iter :accessor tree-iter :documentation "Current tree-iter")))
(defcstruct tree-model-iface
"GtkTreeModelIface"
@@ -133,14 +133,11 @@
(defvar *tree-model-foreach* nil)
(defcallback cb-tree-model-foreach :boolean
- ((model pobject) (path :pointer) (tree-iter :pointer) (data pdata))
+ ((model pobject) (path (object tree-path))
+ (tree-iter (object tree-iter)) (data pdata))
(if *tree-model-foreach*
- (funcall *tree-model-foreach*
- model
- (make-instance 'tree-path :pointer path)
- (make-instance 'tree-iter :pointer tree-iter)
- data)
- t))
+ (funcall *tree-model-foreach* model path tree-iter data)
+ t))
(defcfun "gtk_tree_model_foreach" :void
(model pobject) (func :pointer) (data pdata))
@@ -149,11 +146,11 @@
(let ((*tree-model-foreach* func))
(gtk-tree-model-foreach tree-model (callback cb-tree-model-foreach) data)))
-(defcfun "gtk_tree_model_get_path" :pointer (model pobject) (iter pobject))
+(defcfun "gtk_tree_model_get_path" (object tree-path)
+ (model pobject) (iter pobject))
(defmethod iter->path ((tree-model tree-model) (tree-iter tree-iter))
- (make-instance 'tree-path :pointer
- (gtk-tree-model-get-path tree-model tree-iter)))
+ (gtk-tree-model-get-path tree-model tree-iter))
(defcfun "gtk_tree_model_get_string_from_iter" :string
(model pobject) (iter pobject))
@@ -166,7 +163,7 @@
(defmethod model-values
((tree-model tree-model) &key
- (iter (tree-iter tree-model)) col (columns (when col (list col))))
+ (iter (tree-iter tree-model)) col (columns (ensure-list col)))
"columns = num0 &optional num1 num2 ..."
;(format t "model-values: ~a ~a ~a~%" tree-model tree-iter cols)
(mapcar
@@ -180,8 +177,9 @@
(model pobject) (iter pobject) (path pobject))
(defmethod path->iter ((tree-model tree-model) (tree-path tree-path)
- &optional (tree-iter (iter tree-model)))
- (gtk-tree-model-get-iter tree-model tree-iter tree-path) tree-iter)
+ &optional (tree-iter (tree-iter tree-model)))
+ (gtk-tree-model-get-iter tree-model tree-iter tree-path)
+ tree-iter)
(defcfun "gtk_tree_model_get_iter_from_string" :boolean
(model pobject) (iter pobject) (path :string))
@@ -191,8 +189,8 @@
(gtk-tree-model-get-iter-from-string tree-model tree-iter tree-path-string)
tree-iter)
-(defmacro with-tree-iter (&body body)
- `(with-object (%iter) (make-instance 'tree-iter)
+(defmacro with-tree-iter (var &body body)
+ `(with-object (,var) (make-instance 'tree-iter)
, at body))
(defcfun gtk-tree-model-get-n-columns :int (tree-model pobject))
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/widget.lisp 2011/08/28 15:38:31 1.4
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/widget.lisp 2011/09/10 16:26:11 1.5
@@ -29,7 +29,7 @@
(width :int)
(height :int))
-(init-slots requisition nil)
+(init-slots requisition)
(defclass allocation (struct)
())
@@ -39,23 +39,26 @@
(x :int) (y :int)
(width :int) (height :int))
-(init-slots allocation nil)
+(init-slots allocation)
-(defgtkfun activate :boolean widget)
(defcfun gtk-widget-show :boolean (widget pobject))
(defcfun gtk-widget-show-all :boolean (widget pobject))
(defcfun gtk-widget-show-now :boolean (widget pobject))
+(defgeneric show (widget &key all now)
+ (:documentation "gtk_widget_show[_now|_all] ALL and NOW are booleans"))
(defmethod show ((widget widget) &key (all t) now)
(funcall (cond
(now #'gtk-widget-show-now)
(all #'gtk-widget-show-all)
(t #'gtk-widget-show)) widget))
-(defgtkfun hide :boolean widget)
(defcfun gtk-widget-draw :void (widget pobject) (context :pointer))
+
+(defgeneric draw (widget &optional context)
+ (:documentation "context is cl-cairo2 context"))
(defmethod draw ((widget widget) &optional (context cl-cairo2:*context*))
(cl-cairo2::with-context-pointer (context cntx-pointer)
(gtk-widget-draw widget cntx-pointer)))
@@ -64,7 +67,8 @@
(widget pobject) (x :int) (y :int) (width :int) (height :int))
(defcfun gtk-widget-queue-draw-region :void (widget pobject) (region pobject))
(defcfun gtk-widget-queue-draw :void (widget pobject))
-
+
+(defgeneric queue-draw (widget &key area region))
(defmethod queue-draw ((widget widget) &key area region)
(cond
(area (apply #'gtk-widget-queue-draw-area widget area))
@@ -74,6 +78,7 @@
(defcfun gtk-widget-queue-resize :void (widget pobject))
(defcfun gtk-widget-queue-resize-no-redraw :void (widget pobject))
+(defgeneric queue-resize (widget &key no-redraw))
(defmethod queue-resize ((widget widget) &key no-redraw)
(if no-redraw
(gtk-widget-queue-resize-no-redraw widget)
@@ -82,42 +87,22 @@
(defcfun "gtk_widget_get_size_request" :void
(widget pobject) (width :pointer) (height :pointer))
+(defgeneric size-request (widget))
(defmethod size-request ((widget widget))
"returns (width height)"
- (with-foreign-outs-list ((width :int) (height :int))
- (gtk-widget-get-size-request widget width height)))
+ (with-foreign-outs-list ((width :int) (height :int)) :ignore
+ (gtk-widget-get-size-request widget width height)))
(defcfun "gtk_widget_set_size_request"
:void (widget pobject) (w :int) (h :int))
+(defgeneric (setf size-request) (coords widget))
(defmethod (setf size-request) (coords (widget widget))
"coords = (width height)"
(gtk-widget-set-size-request widget
(first coords)
(second coords)))
-(save-setter widget size-request)
-
-(defgtkfun size-allocate :void widget (allocation (struct allocation)))
-
-(defgtkfun add-accelerator :void widget
- (accel-signal :string) (accel-group pobject) (accel-key key)
- (accel-mods modifier-type) (accel-flags accel-flags))
-
-(defgtkfun remove-accelerator :boolean widget
- (accel-group pobject) (accel-key key) (accel-mods modifier-type))
-
-(defcfun gtk-widget-set-accel-path :void
- (widget pobject) (accel-path :string) (accel-group pobject))
-
-(defmethod (setf widget-accel-path) (value (widget widget)
- (accel-group accel-group))
- (gtk-widget-set-accel-path widget value accel-group))
-
-(defgtkfun list-accel-closures g-list widget)
-(defgtkfun can-activate-accel :boolean widget (signal-id :uint))
-(defgtkfun (widget-event . event) :boolean widget (event event))
-(defgtkfun send-expose :int widget (event event))
-(defgtkfun send-focus-change :boolean widget (event event))
+(save-setter widget size-request)
(defcfun gtk-widget-intersect :boolean
(src1 pobject) (src2 (struct rectangle)) (dest (struct rectangle :out t)))
@@ -127,26 +112,16 @@
(when (gtk-widget-intersect rect1 rect2 dest)
dest)))
-(defgtkfun is-focus :boolean widget)
-(defgtkfun grab-focus :void widget)
-(defgtkfun grab-default :void widget)
-
-(defgtkfun override-color :void widget (state state-flags) (color prgba))
-
-(defgtkfun override-background-color :void
- widget (state state-flags) (color prgba))
-
-(defgtkfun override-symbolic-color :void widget (name :string) (color prgba))
-
-(defcfun gtk-widget-get-style-context pobject (widget pobject))
-
-(defmethod style-context ((widget widget))
- (gtk-widget-get-style-context widget))
-
-(defgtkfun override-font :void widget (font pango-cffi:font))
(defcenum align :fill :start :end :center)
+(defbitfield widget-flags
+ (:toplevel 16)
+ :no-window :realized :mapped :visible :sensitive
+ :parent-sensitive :can-focus :set-focus :can-default :has-default
+ :has-grab :rc-style :composite-child :no-reparent :app-paintable
+ :recieves-default :double-buffered :no-show-all)
+
(defgtkslots widget
name gtk-string
direction text-direction
@@ -186,128 +161,131 @@
support-multidevice :boolean
app-paintable :boolean)
-(defbitfield widget-flags
- (:toplevel 16)
- :no-window
- :realized
- :mapped
- :visible
- :sensitive
- :parent-sensitive
- :can-focus
- :set-focus
- :can-default
- :has-default
- :has-grab
- :rc-style
- :composite-child
- :no-reparent
- :app-paintable
- :recieves-default
- :double-buffered
- :no-show-all)
-
-
-(defgtkfun destroy :void widget)
-
-(defgtkfun render-icon-pixbuf pobject widget
- (stock-id :string) (size icon-size))
-
-(defgtkfun add-events :void widget (events event-mask))
+(defgtkfuns widget
+ (activate :boolean)
+ (hide :boolean)
+ (size-allocate :void (allocation (struct allocation)))
+ (add-accelerator :void
+ (accel-signal :string) (accel-group pobject) (accel-key key)
+ (accel-mods modifier-type) (accel-flags accel-flags))
+ (remove-accelerator :boolean
+ (accel-group pobject) (accel-key key) (accel-mods modifier-type))
+ (list-accel-closures g-list)
+ (can-activate-accel :boolean (signal-id :uint))
+ ((widget-event . event) :boolean (event event))
+ (send-expose :int (event event))
+ (send-focus-change :boolean (event event))
+ (is-focus :boolean)
+ (grab-focus :void)
+ (grab-default :void)
+ (override-color :void (state state-flags) (color prgba))
+ (override-background-color :void (state state-flags) (color prgba))
+ (override-symbolic-color :void (name :string) (color prgba))
+ (:get style-context pobject)
+ (override-font :void (font pango-cffi:font))
+ (:set (widget-accel-path . accel-path) :string
+ (accel-group pobject))
+ (destroy :void)
+ (render-icon-pixbuf pobject (stock-id :string) (size icon-size))
+ (add-events :void (events event-mask))
+ (:get device-events event-mask (device pobject))
+ (add-device-events :void (device pobject) (events event-mask))
+ (:get device-enabled :boolean (device pobject))
+ (:get toplevel pobject)
+ (:get ancestor pobject (widget-type g-type))
+ (is-ancestor :boolean (ancestor pobject))
+ ;; region should be cairo_region_t, but it is not realized in cl-cairo2 yet
+ (shape-combine-region :void (region pobject))
+ (input-shape-combine-region :void (region pobject))
+ (:get path (object widget-path))
+ (is-composited :boolean)
+ (override-cursor :void (cursor prgba) (secondary-cursor prgba))
+ (create-pango-context pobject)
+ (:get pango-context pobject)
+ (create-pango-layout pobject)
+ (:set redraw-on-allocate :boolean)
+ (mnemonic-activate :boolean (group-cycling :boolean))
+ (unparent :void)
+ ((widget-map . map) :void)
+ (unmap :void)
+ (realize :void)
+ (unrealize :void)
+ (:get accessible pobject)
+ (child-focus :boolean (direction direction-type))
+ (child-notify :void (child-property :string))
+ (freeze-child-notify :void)
+;(defgtkgetter window pobject widget)
+ (:get settings pobject)
+ (:get clipboard pobject (selection gatom))
+ (:get display pobject)
+ (:get root-window pobject)
+ (:get screen pobject)
+ (has-screen :boolean)
+ (thaw-child-notify :void)
+ (list-mnemonic-labels g-list-object)
+ (add-mnemonic-label :void (label pobject))
+ (remove-mnemonic-label :void (label pobject))
+ (error-bell :void)
+ (keynav-failed :boolean (direction direction-type))
+ (trigger-tooltip-query :void)
+ (:get allocated-width :int)
+ (:get allocated-height :int)
+ (is-sensitive :boolean)
+ (:get state-flags state-flags)
+ (has-default :boolean)
+ (has-focus :boolean)
+ (has-grab :boolean)
+ (is-drawable :boolean)
+ (is-toplevel :boolean)
+ (device-is-shadowed :boolean (device pobject))
+ (reset-style :void)
+ (queue-compute-expand :void)
+ (compute-expand :boolean (orientation orientation)))
-(defgtkgetter device-events event-mask widget (device pobject))
+(setf (documentation 'clipboard 'function)
+ "SELECTION should be :PRIMARY or :CLIPOARD")
(defcfun gtk-widget-set-device-events :void
(widget pobject) (device pobject) (events event-mask))
+(defgeneric (setf device-events) (events widget device))
(defmethod (setf device-events) (events (widget widget) device)
(gtk-widget-set-device-events widget device events))
-(defgtkfun add-device-events :void widget
- (device pobject) (events event-mask))
-
(defcfun gtk-widget-set-device-enabled :void
(widget pobject) (device pobject) (enabled :boolean))
+(defgeneric (setf device-enabled) (enable widget device))
(defmethod (setf device-enabled) (enabled (widget widget) device)
(gtk-widget-set-device-enabled widget device enabled))
-(defgtkgetter device-enabled :boolean widget (device pobject))
-
-(defgtkgetter toplevel pobject widget)
-(defgtkgetter ancestor pobject widget (widget-type g-type))
-
-
(defcfun ("gtk_widget_pop_composite_child" pop-composite-child) :void)
(defcfun ("gtk_widget_push_composite_child" push-composite-child) :void)
(defcfun gtk-widget-get-pointer :void
(widget pobject) (x :pointer) (y :pointer))
+(defgeneric get-pointer (widget))
(defmethod get-pointer ((widget widget))
- (with-foreign-outs ((x :int) (y :int))
+ (with-foreign-outs ((x :int) (y :int)) :ignore
(gtk-widget-get-pointer widget x y)))
-(defgtkfun is-ancestor :boolean widget (ancestor pobject))
-
(defcfun gtk-widget-translate-coordinates :boolean
(src-widget pobject) (dst-widget pobject) (src-x :int) (src-y :int)
(dst-x :pointer) (dst-y :pointer))
(defmethod translate-coordinates ((src-widget widget) (dst-widget widget)
src-x src-y)
- (with-foreign-outs ((dst-x :int) (dst-y :int))
+ "Returns (values dst-x dst-y)"
+ (with-foreign-outs ((dst-x :int) (dst-y :int)) :if-success
(gtk-widget-translate-coordinates src-widget dst-widget
src-x src-y dst-x dst-y)))
-;; region should be cairo_region_t, but it is not realized in cl-cairo2 yet
-(defgtkfun shape-combine-region :void widget (region pobject))
-(defgtkfun input-shape-combine-region :void widget (region pobject))
-
-(defgtkgetter path (object widget-path) widget)
-(defgtkfun is-composited :boolean widget)
-
-(defgtkfun override-cursor :void widget (cursor prgba) (secondary-cursor prgba))
-
-(defgtkfun create-pango-context pobject widget)
-(defgtkgetter pango-context pobject widget)
-(defgtkfun create-pango-layout pobject widget)
-
-(defgtksetter redraw-on-allocate :boolean widget)
-(defgtkfun mnemonic-activate :boolean widget (group-cycling :boolean))
-
-(defgtkfun unparent :void widget)
-(defgtkfun (widget-map . map) :void widget)
-(defgtkfun unmap :void widget)
-(defgtkfun realize :void widget)
-(defgtkfun unrealize :void widget)
-
-(defgtkgetter accessible pobject widget)
-(defgtkfun child-focus :boolean widget (direction direction-type))
-(defgtkfun child-notify :void widget (child-property :string))
-(defgtkfun freeze-child-notify :void widget)
-
-;(defgtkgetter window pobject widget)
-(defgtkgetter settings pobject widget)
-(defgtkgetter clipboard pobject widget (selection gatom))
-(setf (documentation 'clipboard 'function)
- "SELECTION should be :PRIMARY or :CLIPOARD")
-
-(defgtkgetter display pobject widget)
-(defgtkgetter root-window pobject widget)
-(defgtkgetter screen pobject widget)
-(defgtkfun has-screen :boolean widget)
-(defgtkfun thaw-child-notify :void widget)
-(defgtkfun list-mnemonic-labels g-list-object widget)
-(defgtkfun add-mnemonic-label :void widget (label pobject))
-(defgtkfun remove-mnemonic-label :void widget (label pobject))
-(defgtkfun error-bell :void widget)
-(defgtkfun keynav-failed :boolean widget (direction direction-type))
-(defgtkfun trigger-tooltip-query :void widget)
-
(defcfun gtk-cairo-should-draw-window :boolean
(context :pointer) (gdk-window pobject))
+(defgeneric cairo-should-draw-window (window &optional context)
+ (:documentation "WINDOW may be GdkWindow or GtkWidget"))
(defmethod cairo-should-draw-window (window
&optional (context cl-cairo2:*context*))
(cl-cairo2::with-context-pointer (context cntx-pointer)
@@ -320,6 +298,7 @@
(defcfun gtk-cairo-transform-to-window :void
(context :pointer) (widget pobject) (gdk-window pobject))
+(defgeneric cairo-transform-to-window (widget window &optional context))
(defmethod cairo-transform-to-window ((widget widget) window
&optional (context cl-cairo2:*context*))
(cl-cairo2::with-context-pointer (context cntx-pointer)
@@ -329,40 +308,29 @@
&optional (context cl-cairo2:*context*))
(cairo-transform-to-window widget (window window) context))
-
-(defgtkgetter allocated-width :int widget)
-(defgtkgetter allocated-height :int widget)
-(defgtkfun is-sensitive :boolean widget)
-(defgtkgetter state-flags state-flags widget)
-
(defcfun gtk-widget-set-state-flags :void
(widget pobject) (flags state-flags) (clear :boolean))
(defcfun gtk-widget-unset-state-flags :void
(widget pobject) (flags state-flags))
+(defgeneric (setf state-flags) (value widget &key type))
(defmethod (setf state-flags) (value (widget widget) &key type)
- "If TYPE = :CLEAR, clear state before set, :UNSET -- unset bits"
+ "If TYPE = :SET, only set bits, :UNSET -- unset bits,
+otherwise set state = VALUE"
(case type
- (:clear (gtk-widget-set-state-flags widget value t))
+ (:set (gtk-widget-set-state-flags widget value nil))
(:unset (gtk-widget-unset-state-flags widget value))
- (t (gtk-widget-set-state-flags widget value nil))))
-
-(defgtkfun has-default :boolean widget)
-(defgtkfun has-focus :boolean widget)
-(defgtkfun has-grab :boolean widget)
-(defgtkfun is-drawable :boolean widget)
-(defgtkfun is-toplevel :boolean widget)
-(defgtkfun device-is-shadowed :boolean widget (device pobject))
[257 lines skipped]
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/addons.lisp 2011/09/10 16:26:11 NONE
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/addons.lisp 2011/09/10 16:26:11 1.1
[276 lines skipped]
More information about the gtk-cffi-cvs
mailing list