[gtk-cffi-cvs] CVS gtk-cffi/gtk
CVS User rklochkov
rklochkov at common-lisp.net
Mon May 7 09:02:05 UTC 2012
Update of /project/gtk-cffi/cvsroot/gtk-cffi/gtk
In directory tiger.common-lisp.net:/tmp/cvs-serv22276/gtk
Modified Files:
assistant.lisp builder.lisp combo-box.lisp
file-chooser-dialog.lisp file-chooser.lisp gtk-cffi.asd
icon.lisp image.lisp misc.lisp package.lisp progress-bar.lisp
table.lisp tree-model.lisp widget.lisp
Added Files:
buildable.lisp file-filter.lisp orientable.lisp range.lisp
Log Message:
Added with-progress in extensions
Added GtkOrientable, GtkRange, GtkBuildable, & Cairo support in gdk (see examples/ex6)
Fixed all examples.
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/assistant.lisp 2012/03/08 09:58:12 1.2
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/assistant.lisp 2012/05/07 09:02:04 1.3
@@ -34,7 +34,7 @@
(:get page-complete :boolean (page pobject))
(add-action-widget :void (child pobject) &key)
(remove-action-widget :void (child pobject))
- (update-button-state :void)
+ (update-buttons-state :void)
(commit :void)
(next-page :void)
(previous-page :void))
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/builder.lisp 2012/03/08 09:58:12 1.2
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/builder.lisp 2012/05/07 09:02:04 1.3
@@ -27,21 +27,23 @@
(builder pobject) (string :string) (length gsize) (object-ids string-list)
(g-error g-error))
-(defmethod add-from ((builder builder) &key filename string objects)
- (with-g-error g-error
- (when
- (= 0
- (if filename
- (if objects
- (gtk-builder-add-objects-from-file builder filename
- objects g-error)
- (gtk-builder-add-from-file builder filename g-error))
- (if objects
- (gtk-builder-add-objects-from-string
- builder string (length string) objects g-error)
- (gtk-builder-add-from-string builder
- string (length string) g-error))))
- (throw-g-error g-error))))
+(defgeneric add-from (builder &key filename string objects)
+ (:method
+ ((builder builder) &key filename string objects)
+ (with-g-error g-error
+ (when
+ (= 0
+ (if filename
+ (if objects
+ (gtk-builder-add-objects-from-file builder filename
+ objects g-error)
+ (gtk-builder-add-from-file builder filename g-error))
+ (if objects
+ (gtk-builder-add-objects-from-string
+ builder string (length string) objects g-error)
+ (gtk-builder-add-from-string
+ builder string (length string) g-error))))
+ (throw-g-error g-error)))))
(defcfun gtk-builder-connect-signals-full :void
(builder pobject) (func pfunction) (user-data :pointer))
@@ -56,10 +58,11 @@
:after (not (null (find :after flags)))
:swapped (not (null (find :swapped flags)))))
-(defmethod connect-signals ((builder builder) &key func)
- (gtk-builder-connect-signals-full builder
- (or func (callback cb-find-defun))
- (null-pointer)))
+(defgeneric connect-signals (builder &key func)
+ (:method ((builder builder) &key func)
+ (gtk-builder-connect-signals-full builder
+ (or func (callback cb-find-defun))
+ (null-pointer))))
(deffuns builder
@@ -78,16 +81,17 @@
(builder pobject) (g-type g-type) (string :string) (value pobject)
(g-error g-error))
-(defmethod value-from-string ((builder builder) &key g-type param-spec string)
- (let ((value (make-instance 'g-value)))
- (with-g-error g-error
- (unless (if param-spec
- (gtk-builder-value-from-string builder param-spec string
- value g-error)
- (gtk-builder-value-from-string-type builder g-type string
- value g-error))
- (throw-g-error g-error)))
- value))
+(defgeneric value-from-string (builder &key g-type param-spec string)
+ (:method ((builder builder) &key g-type param-spec string)
+ (let ((value (make-instance 'g-value)))
+ (with-g-error g-error
+ (unless (if param-spec
+ (gtk-builder-value-from-string builder param-spec string
+ value g-error)
+ (gtk-builder-value-from-string-type builder g-type string
+ value g-error))
+ (throw-g-error g-error)))
+ value)))
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/combo-box.lisp 2011/04/25 19:16:08 1.1.1.1
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/combo-box.lisp 2012/05/07 09:02:04 1.2
@@ -1,58 +1,82 @@
(in-package :gtk-cffi)
(defclass combo-box (bin)
- ((model :accessor model :initarg :model)))
+ ())
-(defcfun "gtk_combo_box_new_with_model" :pointer (model pobject))
+(defcfun gtk-combo-box-new :pointer)
+(defcfun gtk-combo-box-new-with-entry :pointer)
+(defcfun gtk-combo-box-new-with-model :pointer (model pobject))
+(defcfun gtk-combo-box-new-with-model-and-entry :pointer (model pobject))
+(defcfun gtk-combo-box-new-with-area :pointer (area pobject))
+(defcfun gtk-combo-box-new-with-area-and-entry :pointer (area pobject))
+
+(defmethod gconstructor ((combo-box combo-box)
+ &key model area entry &allow-other-keys)
+ (cond
+ (model
+ (if entry
+ (gtk-combo-box-new-with-model-and-entry model)
+ (gtk-combo-box-new-with-model model)))
+ (area
+ (if entry
+ (gtk-combo-box-new-with-area-and-entry area)
+ (gtk-combo-box-new-with-area area)))
+ (t
+ (if entry
+ (gtk-combo-box-new-with-entry)
+ (gtk-combo-box-new)))))
-(defcfun "gtk_combo_box_new" :pointer)
-(defcfun "gtk_combo_box_new_text" :pointer)
-
-(defmethod initialize-instance
- :after ((combo-box combo-box)
- &key model text-only &allow-other-keys)
- (setf (pointer combo-box)
- (cond
- (model (gtk-combo-box-new-with-model model))
- (text-only (gtk-combo-box-new-text))
- (t (gtk-combo-box-new)))))
-
-
-(defcfun "gtk_combo_box_set_model" :void (combo-box pobject) (model pobject))
-
-(defmethod (setf model) :after ((tree-model tree-model) (combo-box combo-box))
+(defcfun gtk-combo-box-set-model :void (combo-box pobject) (model pobject))
+(defmethod (setf model) (tree-model (combo-box combo-box))
(gtk-combo-box-set-model combo-box tree-model))
-(defmethod (setf model) :after (badval (combo-box combo-box))
- (error "Should be tree-model in setf model "))
-
-(defcfun "gtk_combo_box_append_text" :void
- (combo-box pobject) (text gtk-string))
-
-(defmethod append-text ((combo-box combo-box) text)
- (gtk-combo-box-append-text combo-box text))
-
-(defcfun "gtk_combo_box_prepend_text" :void
- (combo-box pobject) (text gtk-string))
+(defslots combo-box
+ wrap-width :int
+ row-span-column :int
+ column-span-column :int
+ active :int
+ active-iter pobject
+ id-column :int
+ add-tearoffs :boolean
+ title :string
+ focus-on-click :boolean
+ button-sensitivity sensitivity-type
+ entry-text-column :int
+ popup-fixed-width :boolean)
+
+(deffuns combo-box
+ (:get model pobject)
+ (:get active-id :string)
+ (popup-for-device :void (device pobject))
+ (popup :void)
+ (popdown :void)
+ (:get row-separator-func :pointer)
+ (:get has-entry :boolean))
+
+
+(defcallback cb-row-separator-func
+ :boolean ((model pobject) (iter pobject) (data pdata))
+ (funcall data model iter))
+
+(defcfun gtk-combo-box-set-row-separator-func :void
+ (combo-box pobject) (func pfunction) (data pdata) (notify :pointer))
+
+
+(defmethod (setf row-separator-func) (func (combo-box combo-box)
+ &key data destroy-notify)
+ (set-callback combo-box gtk-combo-box-set-row-separator-func
+ cb-row-separator-func func data destroy-notify))
-(defmethod prepend-text ((combo-box combo-box) text)
- (gtk-combo-box-prepend-text combo-box text))
-(defcfun "gtk_combo_box_insert_text" :void
- (combo-box pobject) (text gtk-string))
-(defmethod insert-text ((combo-box combo-box) text)
- (gtk-combo-box-insert-text combo-box text))
+(defcfun gtk-combo-box-set-active-id :boolean
+ (combo-box pobject) (active-id :string))
+(defmethod (setf active-id) (active-id (combo-box combo-box))
+ (values active-id
+ (gtk-combo-box-set-active-id combo-box active-id)))
-(defcfun "gtk_combo_box_remove_text" :void
- (combo-box pobject) (pos :int))
-(defmethod remove-text ((combo-box combo-box) pos)
- (gtk-combo-box-remove-text combo-box pos))
-(defcfun "gtk_combo_box_get_active_text" gtk-string (combo-box pobject))
-(defmethod active-text ((combo-box combo-box))
- (gtk-combo-box-get-active-text combo-box))
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/file-chooser-dialog.lisp 2012/02/12 17:29:42 1.3
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/file-chooser-dialog.lisp 2012/05/07 09:02:04 1.4
@@ -9,18 +9,10 @@
(but2-text :string) (but2-response dialog-response)
(null :pointer))
-;; (defcfun "gtk_file_chooser_dialog_new_with_backend" :pointer
-;; (title :string) (parent pobject) (action file-chooser-action)
-;; (backend :string)
-;; (but1-text :string) (but1-response dialog-response)
-;; (but2-text :string) (but2-response dialog-response)
-;; (null :pointer))
-
-
(defmethod gconstructor ((file-chooser-dialog file-chooser-dialog)
- &key title parent action &allow-other-keys)
+ &key (title "") dialog-parent action &allow-other-keys)
(gtk-file-chooser-dialog-new
- title parent action
+ title dialog-parent action
"gtk-cancel" :cancel
(case action
((:open :select-folder) "gtk-open")
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/file-chooser.lisp 2012/02/12 17:29:42 1.2
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/file-chooser.lisp 2012/05/07 09:02:04 1.3
@@ -6,13 +6,18 @@
(defcenum file-chooser-action
:open :save :select-folder :create-folder)
-(defcfun "gtk_file_chooser_set_filename" :boolean
- (chooser pobject) (filename :string))
-
-(defmethod (setf filename) (filename (file-chooser file-chooser))
- (gtk-file-chooser-set-filename file-chooser filename))
-
-(defcfun "gtk_file_chooser_get_filename" :string (chooser pobject))
-
-(defmethod filename ((file-chooser file-chooser))
- (gtk-file-chooser-get-filename file-chooser))
\ No newline at end of file
+(defslots file-chooser
+ filename :string
+ action file-chooser-action
+ local-only :boolean
+ select-multiple :boolean
+ show-hidden :boolean
+ do-overwrite-confirmation :boolean
+ create-folders :boolean
+ current-folder-uri :string
+ preview-widget pobject
+ preview-widget-active :boolean
+ use-preview-label :boolean
+ extra-widget pobject
+ filter pobject)
+
\ No newline at end of file
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/gtk-cffi.asd 2012/03/08 09:58:12 1.17
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/gtk-cffi.asd 2012/05/07 09:02:04 1.18
@@ -27,6 +27,8 @@
(:file css-provider :depends-on (style-provider))
(:file icon :depends-on (loadlib enums))
(:file window-group :depends-on (loadlib))
+ (:file orientable :depends-on (loadlib))
+ (:file buildable :depends-on (loadlib))
(:file builder :depends-on (loadlib))))
(defsystem gtk-cffi-widget
@@ -318,14 +320,23 @@
((:file text-mark)
(:file text-view)))
+(defsystem gtk-cffi-range
+ :description "Interface to GTK/Glib via CFFI"
+ :author "Roman Klochkov <kalimehtar at mail.ru>"
+ :version "0.99"
+ :license "LLGPL"
+ :depends-on (gtk-cffi-bin gtk-cffi-tree-model)
+ :components
+ ((:file range)))
+
(defsystem gtk-cffi-combo-box
:description "Interface to GTK/Glib via CFFI"
:author "Roman Klochkov <kalimehtar at mail.ru>"
- :version "0.1"
+ :version "0.99"
:license "LLGPL"
- :depends-on (gtk-cffi-bin)
+ :depends-on (gtk-cffi-bin gtk-cffi-range)
:components
- ((:file :combo-box)))
+ ((:file combo-box)))
(defsystem gtk-cffi-message-dialog
:description "Interface to GTK/Glib via CFFI"
@@ -334,25 +345,26 @@
:license "LLGPL"
:depends-on (gtk-cffi-dialog)
:components
- ((:file :message-dialog)))
+ ((:file message-dialog)))
(defsystem gtk-cffi-file-chooser
:description "Interface to GTK/Glib via CFFI"
:author "Roman Klochkov <kalimehtar at mail.ru>"
- :version "0.1"
+ :version "0.8"
:license "LLGPL"
:depends-on (gtk-cffi-core)
:components
- ((:file :file-chooser)))
+ ((:file file-chooser)
+ (:file file-filter)))
(defsystem gtk-cffi-file-chooser-dialog
:description "Interface to GTK/Glib via CFFI"
:author "Roman Klochkov <kalimehtar at mail.ru>"
- :version "0.1"
+ :version "0.99"
:license "LLGPL"
:depends-on (gtk-cffi-file-chooser gtk-cffi-dialog)
:components
- ((:file :file-chooser-dialog)))
+ ((:file file-chooser-dialog)))
(defsystem gtk-cffi-file-chooser-button
:description "Interface to GTK/Glib via CFFI"
@@ -482,5 +494,6 @@
gtk-cffi-statusbar
gtk-cffi-notebook
gtk-cffi-image
+ gtk-cffi-combo-box
gtk-cffi-text-view))
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/icon.lisp 2012/02/12 17:29:42 1.3
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/icon.lisp 2012/05/07 09:02:04 1.4
@@ -1,3 +1,9 @@
+;;;
+;;; icon-size.lisp -- GtkIconSize
+;;;
+;;; Copyright (C) 2012, Roman Klochkov <kalimehtar at mail.ru>
+;;;
+
(in-package :gtk-cffi)
(defcenum icon-size
@@ -14,10 +20,9 @@
(defclass icon-source (object) ())
-(defcfun "gtk_icon_source_new" :pointer)
+(defcfun gtk-icon-source-new :pointer)
-(defmethod gconstructor ((icon-source icon-source) &rest rest)
- (declare (ignore icon-source rest))
+(defmethod gconstructor ((icon-source icon-source) &key)
(gtk-icon-source-new))
(defgtkslots icon-source
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/image.lisp 2012/02/12 17:29:42 1.2
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/image.lisp 2012/05/07 09:02:04 1.3
@@ -1,17 +1,104 @@
+;;;
+;;; image.lisp -- GtkImage
+;;;
+;;; Copyright (C) 2012, Roman Klochkov <kalimehtar at mail.ru>
+;;;
+
(in-package :gtk-cffi)
(defclass image (misc)
())
-(defcfun "gtk_image_new_from_file" :pointer (filename :string))
-;(defcenum "gtk_image_new_from_icon_set" :pointer
-; (icon-set pobject) (icon-size icon-size))
-(defcfun "gtk_image_new_from_pixbuf" :pointer (pixbuf pobject))
-(defcfun "gtk_image_new_from_stock" :pointer
+(defcfun gtk-image-new-from-file :pointer (filename :string))
+(defcfun gtk-image-new-from-icon-set :pointer
+ (icon-set pobject) (icon-size icon-size))
+(defcfun gtk-image-new-from-pixbuf :pointer (pixbuf pobject))
+(defcfun gtk-image-new-from-icon-name :pointer (icon-name :string) (icon-size icon-size))
+(defcfun gtk-image-new-from-animation :pointer (animation pobject))
+(defcfun gtk-image-new-from-stock :pointer
(stock-id :string) (size icon-size))
+(defcfun gtk-image-new-from-gicon :pointer
+ (gicon pobject) (icon-size icon-size))
+(defcfun gtk-image-new :pointer)
-(defmethod gconstructor ((image image) &key file pixbuf stock-id icon-size)
+(defmethod gconstructor ((image image)
+ &key file pixbuf stock-id gicon
+ icon-size icon-name icon-set animation)
(cond
(file (gtk-image-new-from-file file))
(pixbuf (gtk-image-new-from-pixbuf pixbuf))
- (stock-id (gtk-image-new-from-stock stock-id icon-size))))
\ No newline at end of file
+ (stock-id (gtk-image-new-from-stock stock-id icon-size))
+ (icon-set (gtk-image-new-from-icon-set icon-set icon-size))
+ (icon-name (gtk-image-new-from-icon-name icon-name icon-size))
+ (animation (gtk-image-new-from-animation animation))
+ (gicon (gtk-image-new-from-gicon gicon icon-size))
+ (t (gtk-image-new))))
+
+(defslots image
+ pixel-size :int)
+
+
+(defcfun gtk-image-set-from-file :pointer (image pobject) (filename :string))
+(defcfun gtk-image-set-from-icon-set :pointer
+ (image pobject) (icon-set pobject) (icon-size icon-size))
+(defcfun gtk-image-set-from-pixbuf :pointer (image pobject) (pixbuf pobject))
+(defcfun gtk-image-set-from-icon-name :pointer (image pobject)
+ (icon-name :string) (icon-size icon-size))
+(defcfun gtk-image-set-from-animation :pointer (image pobject)
+ (animation pobject))
+(defcfun gtk-image-set-from-stock :pointer
+ (image pobject) (stock-id :string) (size icon-size))
+(defcfun gtk-image-set-from-gicon :pointer
+ (image pobject) (gicon pobject) (icon-size icon-size))
+(defcfun gtk-image-clear :void (image pobject))
+
+
+(defmethod reinitialize-instance ((image image) &key file pixbuf stock-id gicon
+ icon-size icon-name icon-set animation)
+ (cond
+ (file (gtk-image-set-from-file image file))
+ (pixbuf (gtk-image-set-from-pixbuf image pixbuf))
+ (stock-id (gtk-image-set-from-stock image stock-id icon-size))
+ (icon-set (gtk-image-set-from-icon-set image icon-set icon-size))
+ (icon-name (gtk-image-set-from-icon-name image icon-name icon-size))
+ (animation (gtk-image-set-from-animation image animation))
+ (gicon (gtk-image-set-from-gicon image gicon icon-size))
+ (t (gtk-image-clear image))))
+
+(defcenum image-type
+ :empty :pixbuf :stock :icon-set :animation :icon-name :gicon)
+
+(deffuns image
+ (:get pixbuf pobject)
+ (:get animation pobject)
+ (:get storage-type image-type))
+
+(defcfun gtk-image-get-icon-set :void (image pobject) (icon-set :pointer)
+ (icon-size :pointer))
+(defgeneric icon-set (image)
+ (:method ((image image))
+ (with-foreign-outs ((icon-set 'pobject) (icon-size 'icon-size)) :ignore
+ (gtk-image-get-icon-set image icon-set icon-size))))
+
+(defcfun gtk-image-get-gicon :void (image pobject) (gicon :pointer)
+ (icon-size :pointer))
+(defgeneric gicon (image)
+ (:method ((image image))
+ (with-foreign-outs ((gicon 'pobject) (icon-size 'icon-size)) :ignore
+ (gtk-image-get-gicon image gicon icon-size))))
+
+(defcfun gtk-image-get-icon-name :void (image pobject)
+ (icon-name :pointer) (icon-size :pointer))
+(defmethod icon-name ((image image))
+ (with-foreign-outs ((icon-name :string) (icon-size 'icon-size)) :ignore
+ (gtk-image-get-icon-set image icon-name icon-size)))
+
+(defcfun gtk-image-get-stock :void (image pobject)
+ (stock :pointer) (icon-size :pointer))
+(defgeneric stock (image)
+ (:method ((image image))
+ (with-foreign-outs ((stock :string) (icon-size 'icon-size)) :ignore
+ (gtk-image-get-stock image stock icon-size))))
+
+
+
\ No newline at end of file
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/misc.lisp 2011/04/25 19:16:08 1.1.1.1
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/misc.lisp 2012/05/07 09:02:04 1.2
@@ -3,19 +3,32 @@
(defclass misc (widget)
())
-(defcfun "gtk_misc_set_alignment" :void (misc pobject) (x :float) (y :float))
+(defcfun gtk-misc-set-alignment :void (misc pobject) (x :float) (y :float))
-(defmethod (setf alignment) (coords (misc misc))
- (gtk-misc-set-alignment misc
- (float (first coords))
- (float (second coords))))
+(defgeneric (setf alignment) (coords misc)
+ (:method (coords (misc misc))
+ (gtk-misc-set-alignment misc
+ (float (first coords))
+ (float (second coords)))))
+(save-setter misc alignment)
-(defcfun "gtk_misc_get_alignment" :void (misc pobject)
+(defcfun gtk-misc-get-alignment :void (misc pobject)
(x :pointer) (y :pointer))
(defmethod alignment ((misc misc))
- (with-foreign-objects ((x :float) (y :float))
- (gtk-misc-get-alignment misc x y)
- (list (mem-ref x :float)
- (mem-ref y :float))))
+ (with-foreign-outs-list ((x :float) (y :float)) :ignore
+ (gtk-misc-get-alignment misc x y)))
+
+(defcfun gtk-misc-set-padding :void (misc pobject) (x :int) (y :int))
+(defmethod (setf padding) (coords (misc misc))
+ (gtk-misc-set-padding misc
+ (first coords)
+ (second coords)))
+(save-setter misc padding)
+
+(defcfun gtk-misc-get-padding :void (misc pobject) (x :pointer) (y :pointer))
+(defmethod padding ((misc misc))
+ (with-foreign-outs-list ((x :int) (y :int)) :ignore
+ (gtk-misc-get-padding misc x y)))
+
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/package.lisp 2012/03/08 09:58:12 1.17
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/package.lisp 2012/05/07 09:02:04 1.18
@@ -33,6 +33,11 @@
#:append-type
#:append-for-widget
#:prepend-type
+
+ #:orientable
+ #:orientation
+
+ #:buildable
#:widget
;; widget slots
@@ -374,6 +379,7 @@
#:misc
;; misc slots
#:alignment
+ #:padding
#:label
;; label slots
@@ -693,6 +699,50 @@
#:is-text
#:combo-box
+ ;; slots
+ #:wrap-width
+ #:row-span-column
+ #:column-span-column
+ #:active
+ #:active-iter
+ #:id-column
+ #:add-tearoffs
+ #:title
+ #:focus-on-click
+ #:button-sensitivity
+ #:entry-text-column
+ #:popup-fixed-width
+ ;; methods
+ #:model
+ #:active-id
+ #:popup-for-device
+ #:popup
+ #:popdown
+ #:row-separator-func
+ #:has-entry
+ #:active-id
+ #:row-separator-func
+
+ #:range
+ ;; slots
+ #:fill-level
+ #:restrict-to-fill-level
+ #:show-fill-level
+ #:adjustment
+ #:inverted
+ #:value
+ #:round-digits
+ #:lower-stepper-sensitivity
+ #:upper-stepper-sensitivity
+ #:flippable
+ #:min-slider-size
+ #:slider-size-fixed
+ ;; methods
+ #:increments
+ #:range
+ #:slider-range
+ #:range-rect
+
#:append-text
#:prepend-text
#:insert-text
@@ -712,6 +762,25 @@
#:file-chooser
;; file-chooser slots
#:filename
+ #:action
+ #:local-only
+ #:select-multiple
+ #:show-hidden
+ #:do-overwrite-confirmation
+ #:create-folders
+ #:current-folder-uri
+ #:preview-widget
+ #:preview-widget-active
+ #:use-preview-label
+ #:extra-widget
+ #:filter
+
+ #:file-filter
+ ;; file-filter methods
+ #:add-mime-type
+ #:add-pattern
+ #:add-pixbuf-formats
+ #:needed
#:file-chooser-dialog
@@ -720,6 +789,10 @@
#:progress-bar
;; progress-bar slots
#:fraction
+ #:inverted
+ #:show-text
+ #:ellipsize
+ #:pulse-step
#:table
;; table methods
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/progress-bar.lisp 2011/04/25 19:16:08 1.1.1.1
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/progress-bar.lisp 2012/05/07 09:02:04 1.2
@@ -1,21 +1,28 @@
+;;;
+;;; progress-bar.lisp -- GtkProgressBar
+;;;
+;;; Copyright (C) 2012, Roman Klochkov <kalimehtar at mail.ru>
+;;;
+
(in-package :gtk-cffi)
-(defclass progress-bar (widget)
+(defclass progress-bar (widget orientable)
())
-(defcfun "gtk_progress_bar_new" :pointer)
+(defcfun gtk-progress-bar-new :pointer)
-(defmethod gconstructor ((progress-bar progress-bar)
- &key &allow-other-keys)
+(defmethod gconstructor ((progress-bar progress-bar) &key)
(gtk-progress-bar-new))
-(defcfun "gtk_progress_bar_set_fraction" :void
- (bar pobject) (fraction :double))
-
-(defmethod (setf fraction) (fraction (progress-bar progress-bar))
- (gtk-progress-bar-set-fraction progress-bar (coerce fraction 'double-float)))
-
-(defcfun "gtk_progress_bar_get_fraction" :double (bar pobject))
+(defslots progress-bar
+ fraction :double
+ inverted :boolean
+ show-text :boolean
+ ellipsize pango-cffi:ellipsize-mode
+ pulse-step :double)
+
+(deffuns progress-bar
+ (:get text :string &key)
+ (:set text :string &key))
-(defmethod fraction ((progress-bar progress-bar))
- (gtk-progress-bar-get-fraction progress-bar))
+(init-slots progress-bar)
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/table.lisp 2011/04/25 19:16:08 1.1.1.1
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/table.lisp 2012/05/07 09:02:04 1.2
@@ -3,10 +3,8 @@
(defclass table (container)
())
-(defcfun "gtk_table_new" :pointer
- (rows :uint)
- (columns :uint)
- (homogeneous :boolean))
+(defcfun gtk-table-new :pointer
+ (rows :uint) (columns :uint) (homogeneous :boolean))
(defmethod gconstructor ((table table)
@@ -17,55 +15,74 @@
(defbitfield attach-options
:expand :shrink :fill)
-(defcfun "gtk_table_attach_defaults" :void
+(defcfun gtk-table-attach-defaults :void
(table pobject) (widget pobject)
(left-attach :uint) (right-attach :uint)
(top-attach :uint) (bottom-attach :uint))
-(defcfun "gtk_table_attach" :void
+(defcfun gtk-table-attach :void
(table pobject) (widget pobject)
(left-attach :uint) (right-attach :uint)
(top-attach :uint) (bottom-attach :uint)
(xoptions attach-options) (yoptions attach-options)
(xpadding :uint) (ypadding :uint))
-(defmethod attach ((table table) (widget widget)
- &key (left 0) (right 1) (top 0) (bottom 1)
- (xoptions :default) (yoptions :default)
- (xpadding 0) (ypadding 0))
- (flet ((def (m) (if (eq m :default) '(:expand :fill) m)))
- (if (and (eq xoptions :default)
- (eq yoptions :default)
+(defgeneric attach (table widget &key)
+ (:method ((table table) (widget widget)
+ &key (left 0) (right 1) (top 0) (bottom 1)
+ (xoptions '(:expand :fill) xoptions-p)
+ (yoptions '(:expand :fill) yoptions-p)
+ (xpadding 0) (ypadding 0))
+ (if (and (null xoptions-p)
+ (null yoptions-p)
(eq xpadding 0)
(eq ypadding 0))
(gtk-table-attach-defaults table widget left right top bottom)
(gtk-table-attach table widget left right top bottom
- (def xoptions) (def yoptions) xpadding ypadding))))
+ xoptions yoptions xpadding ypadding))))
-(defcfun "gtk_table_resize" :void
+(defcfun gtk-table-get-size :void
+ (table pobject) (rows (:pointer :int)) (columns (:pointer :int)))
+
+(defgeneric table-size (table)
+ (:method ((table table))
+ (with-foreign-outs-list ((rows :int) (columns :int)) :ignore
+ (gtk-table-get-size table rows columns))))
+
+(defcfun gtk-table-resize :void
(table pobject) (rows :uint) (columns :uint))
-(defmethod resize ((table table) &key (rows :default) (columns :default))
- (gtk-table-resize table
- (if (eq rows :default)
- (property table :n-rows) rows)
- (if (eq columns :default)
- (property table :n-columns) columns)))
+(defgeneric (setf table-size) (new-size table)
+ (:method ((new-size list) (table table))
+ (destructuring-bind (rows columns) new-size
+ (gtk-table-resize table rows columns))))
+
+(defgeneric resize (table &key)
+ (:method ((table table) &key rows columns)
+ (unless (and rows columns)
+ (destructuring-bind (cur-rows cur-columns) (table-size table)
+ (unless rows (setf rows cur-rows))
+ (unless columns (setf columns cur-columns))))
+ (gtk-table-resize table rows columns)))
(defmethod pack ((table table) (list list) &rest rest)
"Table should have list of widgets to add"
(declare (ignore rest))
- (let (;(cols (max (property table :n-columns) (length list)))
- (rows (+ (property table :n-rows) 1)))
- ;(resize table :rows rows :columns cols)
- (let ((width 1))
- (loop
- :for i :from 0
- :for widget :in list
- :do (cond
- ((numberp widget) (setf width widget) (incf i -1))
- ((not (null widget))
- (attach table widget
- :left i :right (+ i width)
- :top (- rows 1) :bottom rows)))))))
+ (let ((rows (+ (first (table-size table)) 1))
+ (width 1))
+ (loop
+ :for i :from 0
+ :for widget :in list
+ :do (cond
+ ((numberp widget) (setf width widget) (incf i -1))
+ ((not (null widget))
+ (attach table widget
+ :left i :right (+ i width)
+ :top (- rows 1) :bottom rows))))))
+
+
+
+
+
+
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/tree-model.lisp 2012/02/12 17:29:42 1.7
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/tree-model.lisp 2012/05/07 09:02:04 1.8
@@ -130,15 +130,17 @@
(defmethod free :before ((tree-model tree-model))
(free (tree-iter tree-model)))
-(make-foreach tree-model
+(make-foreach tree-model
+ (model pobject)
(path (object tree-path))
- (tree-iter (object tree-iter)))
+ (tree-iter (object tree-iter))
+ (data pdata))
(defcfun "gtk_tree_model_get_path" (object tree-path)
(model pobject) (iter pobject))
(defmethod iter->path ((tree-model tree-model) (tree-iter tree-iter))
- (warn "Dangerous method: don't forget to use free")
+; (warn "Dangerous method: don't forget to use free")
(gtk-tree-model-get-path tree-model tree-iter))
(defcfun "gtk_tree_model_get_string_from_iter" :string
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/widget.lisp 2012/02/20 18:50:28 1.11
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/widget.lisp 2012/05/07 09:02:04 1.12
@@ -7,7 +7,7 @@
(in-package :gtk-cffi)
-(defclass widget (g-object)
+(defclass widget (g-object buildable)
((%style-properties :accessor %style-properties
:initform nil :allocation :class)))
@@ -162,7 +162,6 @@
hexpand-set :boolean
vexpand :boolean
vexpand-set :boolean
- allocation (struct allocation)
window pobject
support-multidevice :boolean
app-paintable :boolean)
@@ -247,7 +246,16 @@
(queue-compute-expand :void)
(compute-expand :boolean (orientation orientation))
(:set-last device-events event-mask (device pobject))
- (:set-last device-enabled :boolean (device pobject)))
+ (:set-last device-enabled :boolean (device pobject))
+ (:set allocation (struct allocation)))
+
+(defcfun gtk-widget-get-allocation :void
+ (widget pobject) (allocation (struct allocation :out t)))
+
+(defmethod allocation ((widget widget))
+ (let ((res (make-instance 'allocation)))
+ (gtk-widget-get-allocation widget res)
+ res))
(setf (documentation 'clipboard 'function)
"SELECTION should be :PRIMARY or :CLIPOARD")
@@ -258,21 +266,21 @@
(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)) :ignore
- (gtk-widget-get-pointer widget x y)))
+(defgeneric get-pointer (widget)
+ (:method ((widget widget))
+ (with-foreign-outs ((x :int) (y :int)) :ignore
+ (gtk-widget-get-pointer widget x y))))
(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)
- "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)))
+(defgeneric translate-coordinates (src-widget dst-widget src-x src-y)
+ (:method ((src-widget widget) (dst-widget widget) src-x src-y)
+ "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))))
(defcfun gtk-cairo-should-draw-window :boolean
(context :pointer) (gdk-window pobject))
@@ -291,11 +299,10 @@
(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)
- (gtk-cairo-transform-to-window cntx-pointer widget window)))
+(defgeneric cairo-transform-to-window (widget window &optional context)
+ (:method ((widget widget) window &optional (context cl-cairo2:*context*))
+ (cl-cairo2::with-context-pointer (context cntx-pointer)
+ (gtk-cairo-transform-to-window cntx-pointer widget window))))
(defmethod cairo-transform-to-window ((widget widget) (window widget)
&optional (context cl-cairo2:*context*))
@@ -351,13 +358,13 @@
(defcfun gtk-widget-get-preferred-size :void
(widget pobject) (minimum :pointer) (natural :pointer))
-(defgeneric preferred-size (widget))
-(defmethod preferred-size ((widget widget))
- "Returns (values minimum natural).
+(defgeneric preferred-size (widget)
+ (:method ((widget widget))
+ "Returns (values minimum natural).
Minimum and natural are requisition objects."
- (with-foreign-outs ((minimum 'requisition) (natural 'requisition))
- :ignore
- (gtk-widget-get-preferred-size widget minimum natural)))
+ (with-foreign-outs ((minimum 'requisition) (natural 'requisition))
+ :ignore
+ (gtk-widget-get-preferred-size widget minimum natural))))
(defcstruct requested-size
"GtkRequestedSize"
@@ -372,8 +379,7 @@
"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)
@@ -385,9 +391,6 @@
natural-size (third x)))))
(gtk-distribute-natural-allocation extra-space length sizes-struct))))
-
-(init-slots widget)
-
(template (name with-type) ((color t)
(font nil)
(bg-pixmap nil))
@@ -401,7 +404,10 @@
&key ,@(when with-type '(type)) (state :normal))
(setf (,name (style-context widget) ,@(when with-type '(:type type))
:state state)
- value))))
+ value))
+ (save-setter widget ,name)))
+
+(init-slots widget)
(defclass widget-class (g-object-class)
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/buildable.lisp 2012/05/07 09:02:05 NONE
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/buildable.lisp 2012/05/07 09:02:05 1.1
;;;
;;; buildable.lisp -- GtkBuildable
;;;
;;; Copyright (C) 2012, Roman Klochkov <kalimehtar at mail.ru>
;;;
(in-package :gtk-cffi)
(defclass buildable (object)
())
(defslot buildable name :string)--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/file-filter.lisp 2012/05/07 09:02:05 NONE
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/file-filter.lisp 2012/05/07 09:02:05 1.1
(in-package :gtk-cffi)
(defclass file-filter (g-object)
())
(defcfun gtk-file-filter-new :pointer)
(defmethod gconstructor ((file-filter file-filter) &key)
(gtk-file-filter-new))
(defslot file-filter name :string)
(defbitfield filter-flags
:filename :uri :display-name :mime-type)
(deffuns file-filter
(add-mime-type :void (mime-type :string))
(add-pattern :void (pattern :string))
(add-pixbuf-formats :void)
(:get needed filter-flags))
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/orientable.lisp 2012/05/07 09:02:05 NONE
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/orientable.lisp 2012/05/07 09:02:05 1.1
;;;
;;; orientable.lisp -- GtkOrientable
;;;
;;; Copyright (C) 2012, Roman Klochkov <kalimehtar at mail.ru>
;;;
(in-package :gtk-cffi)
(defclass orientable (object)
())
(defcenum orientation :horizontal :vertical)
(defslot orientable orientation orientation)
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/range.lisp 2012/05/07 09:02:05 NONE
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/range.lisp 2012/05/07 09:02:05 1.1
(in-package :gtk-cffi)
(defclass range (widget)
())
(defcenum sensitivity-type
:auto :on :off)
(defslots range
fill-level :double
restrict-to-fill-level :boolean
show-fill-level :boolean
adjustment pobject
inverted :boolean
value :double
round-digits :int
lower-stepper-sensitivity sensitivity-type
upper-stepper-sensitivity sensitivity-type
flippable :boolean
min-slider-size :int
slider-size-fixed :boolean)
(defcfun gtk-range-set-increments :void
(range pobject) (step :double) (page :double))
(defgeneric (setf increments) (increments range)
(:method (increments (range range))
(destructuring-bind (step page) increments
(gtk-range-set-increments range step page))
increments))
(defcfun gtk-range-set-range :void
(range pobject) (min :double) (max :double))
(defgeneric (setf range) (min-max range)
(:method (min-max (range range))
(destructuring-bind (min max) min-max
(gtk-range-set-increments range min max))
min-max))
(defcfun gtk-range-get-slider-range :void
(range pobject) (start :pointer) (end :pointer))
(defgeneric slider-range (range)
(:method ((range range))
(with-foreign-outs-list ((start :int) (end :int)) :ignore
(gtk-range-get-slider-range range start end))))
(defcfun gtk-range-get-range-rect :void
(range pobject) (rect (struct rectangle :out t)))
(defgeneric range-rect (rect)
(:method ((range range))
(let ((dest (make-instance 'rectangle)))
(gtk-range-get-range-rect range dest)
dest)))
More information about the gtk-cffi-cvs
mailing list