[gtk-cffi-cvs] CVS gtk-cffi/gtk
CVS User rklochkov
rklochkov at common-lisp.net
Sun Aug 12 17:42:30 UTC 2012
Update of /project/gtk-cffi/cvsroot/gtk-cffi/gtk
In directory tiger.common-lisp.net:/tmp/cvs-serv2591/gtk
Modified Files:
button.lisp combo-box.lisp container.lisp entry.lisp
gtk-cffi.asd package.lisp statusbar.lisp style-context.lisp
text-buffer.lisp tree-model.lisp widget.lisp window.lisp
Log Message:
Synced with current version of CFFI
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/button.lisp 2012/07/31 17:57:12 1.3
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/button.lisp 2012/08/12 17:42:30 1.4
@@ -1,6 +1,7 @@
;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
;;;
-;;; button.lisp --- Wrapper for GtkButton
+;;; button.lisp --- Wrappers for GtkButton, GtkCheckButton, GtkToggleButton,
+;;; GtkScaleButton, GtkRadioButton, GtkVolumeButton
;;;
;;; Copyright (C) 2012, Roman Klochkov <kalimehtar at mail.ru>
;;;
@@ -18,6 +19,7 @@
(defmethod gconstructor ((button button)
&key label type &allow-other-keys)
"type can be :stock or :mnemonic, any other means button with label"
+ (initialize button '(label type))
(if label
(let ((creator
(case type
@@ -64,6 +66,7 @@
(defcfun gtk-toggle-button-new-with-mnemonic :pointer (label :string))
(defmethod gconstructor ((toggle-button toggle-button) &key label type)
+ (initialize toggle-button '(label type))
(if label
(case type
(:mnemonic (gtk-toggle-button-new-with-mnemonic label))
@@ -88,11 +91,101 @@
(defcfun gtk-check-button-new-with-mnemonic :pointer (label :string))
(defmethod gconstructor ((check-button check-button) &key label type)
+ (initialize check-button '(label type))
(if label
(case type
(:mnemonic (gtk-check-button-new-with-mnemonic label))
(otherwise (gtk-check-button-new-with-label label)))
(gtk-check-button-new)))
+(defclass radio-button (check-button)
+ ())
+
+(defcfun gtk-radio-button-new :pointer)
+(defcfun gtk-radio-button-new-with-label :pointer (label :string))
+(defcfun gtk-radio-button-new-with-mnemonic :pointer (label :string))
+
+(defcfun gtk-radio-button-new-from-widget :pointer (group-member pobject))
+(defcfun gtk-radio-button-new-with-label-from-widget :pointer
+ (group-member pobject) (label :string))
+(defcfun gtk-radio-button-new-with-mnemonic-from-widget :pointer
+ (group-member pobject) (label :string))
+
+
+(defmethod gconstructor ((radio-button radio-button) &key label type widget)
+ (initialize radio-button '(label type widget))
+ (if label
+ (case type
+ (:mnemonic (if widget
+ (gtk-radio-button-new-with-mnemonic-from-widget
+ widget label)
+ (gtk-radio-button-new-with-mnemonic label)))
+ (otherwise (if widget
+ (gtk-radio-button-new-with-label-from-widget widget
+ label)
+ (gtk-radio-button-new-with-label label))))
+ (if widget
+ (gtk-radio-button-new-from-widget widget)
+ (gtk-radio-button-new))))
+
+(defclass radio-group (object)
+ ())
+
+(defgeneric as-list (object)
+ (:method ((radio-button radio-button))
+ (convert-from-foreign (pointer radio-button)
+ '(g-slist :free-from-foreign nil))))
+
+(defslot radio-button group (object radio-group))
+(deffuns radio-button
+ (join-group :void (group-source pobject)))
+
+(init-slots radio-button)
+
+(defclass link-button (button)
+ ())
+
+(defcfun gtk-link-button-new :pointer (uri :string))
+(defcfun gtk-link-button-new-with-label :pointer (uri :string) (label :string))
+
+
+(defmethod gconstructor ((link-button link-button) &key uri label)
+ (initialize link-button '(label uri))
+ (if label
+ (gtk-link-button-new-with-label uri label)
+ (gtk-link-button-new uri)))
+
+(defslots link-button
+ uri :string
+ visited :boolean)
+
+(init-slots link-button)
+
+(defclass scale-button (button)
+ ())
+
+(defcfun gtk-scale-button-new :pointer)
+
+(defmethod gconstructor ((scale-button scale-button) &key)
+ (gtk-scale-button-new))
+
+(defslots scale-button
+ adjustment pobject
+ value :double)
+
+(deffuns scale-button
+ (:set icons (null-array :string))
+ (:get popup pobject)
+ (:get plus-button pobject)
+ (:get minus-button pobject))
+
+(init-slots scale-button)
+
+(defclass volume-button (scale-button)
+ ())
+
+(defcfun gtk-volume-button-new :pointer)
+(defmethod gconstructor ((volume-button volume-button) &key)
+ (gtk-volume-button-new))
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/combo-box.lisp 2012/07/21 19:26:39 1.4
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/combo-box.lisp 2012/08/12 17:42:30 1.5
@@ -80,7 +80,7 @@
(save-setter combo-box active-id)
(defcfun gtk-combo-box-set-active-iter
- :void (combo-box pobject) (iter (struct tree-iter :free :none)))
+ :void (combo-box pobject) (iter (struct tree-iter :free-to-foreign nil)))
(defcfun gtk-combo-box-get-active-iter
:boolean (combo-box pobject) (iter (struct tree-iter :out t)))
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/container.lisp 2012/07/29 15:13:59 1.4
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/container.lisp 2012/08/12 17:42:30 1.5
@@ -80,7 +80,7 @@
(funcall (lambda (x) (if (cdr x) x (car x)))
(mapcar (lambda (key)
(with-g-value
- (:g-type (child-property-type parent skey))
+ (:g-type (child-property-type parent key))
(gtk-container-child-get-property
parent widget key *g-value*)))
keys)))
@@ -97,7 +97,7 @@
(mapc (lambda (key value)
(declare (type (or symbol string) key))
(with-g-value (:value value
- :g-type (child-property-type parent skey))
+ :g-type (child-property-type parent key))
(gtk-container-child-set-property parent widget
key *g-value*)))
keys (if (listp values) values (list values))))
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/entry.lisp 2012/03/08 09:58:12 1.4
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/entry.lisp 2012/08/12 17:42:30 1.5
@@ -1,46 +1,96 @@
+;;;
+;;; entry.lisp -- GtkEntry, GtkEntryBuffer
+;;;
+;;; Copyright (C) 2012, Roman Klochkov <kalimehtar at mail.ru>
+;;;
+
(in-package :gtk-cffi)
-(defclass entry (widget)
+(defclass entry-buffer (g-object)
())
-(defcstruct border
- ""
- (left :int)
- (right :int)
- (top :int)
- (bottom :int))
+(defcfun gtk-entry-buffer-new :pointer)
-(defcfun "gtk_entry_new" :pointer)
+(defmethod gconstructor ((entry-buffer entry-buffer)
+ &key &allow-other-keys)
+ (gtk-entry-buffer-new))
-;(defcfun "gtk_entry_new_with_max_length" :pointer (max :int))
+(defslots entry-buffer
+ max-length :int)
-(defmethod gconstructor ((entry entry)
- &key &allow-other-keys)
- (gtk-entry-new))
+(deffuns entry-buffer
+ (:get text :string &key)
+ (:set text :string &key)
+ (:get bytes :int)
+ ((entry-buffer-length . get-length) :uint)
+ (delete-text :uint (poistion :uint) (n-chars :int))
+ (emit-deleted-text :void (poistion :uint) (n-chars :int)))
+
+(defcfun gtk-entry-buffer-insert-text :uint
+ (entry-buffer pobject) (position :uint) (chars :string) (n-chars :int))
+
+(defgeneric insert-text (entry-buffer position text)
+ (:method ((entry-buffer entry-buffer) position text)
+ (gtk-entry-buffer-insert-text entry-buffer position text (length text))))
+
+(defcfun gtk-entry-buffer-emit-inserted-text :uint
+ (entry-buffer pobject) (position :uint) (chars :string) (n-chars :int))
+
+(defgeneric emit-inserted-text (entry-buffer position text)
+ (:method ((entry-buffer entry-buffer) position text)
+ (gtk-entry-buffer-emit-inserted-text entry-buffer position
+ text (length text))))
-(defcfun gtk-entry-get-text :string (entry pobject))
-(defcfun gtk-entry-set-text :void (entry pobject) (text :string))
+(init-slots entry-buffer)
-(defmethod text ((entry entry) &key)
- (gtk-entry-get-text entry))
+(defclass entry (widget)
+ ())
+
+(defcfun gtk-entry-new :pointer)
+(defcfun gtk-entry-new-with-buffer :pointer (buffer pobject))
-(defmethod (setf text) (value (entry entry) &key)
- (gtk-entry-set-text entry value))
+(defmethod gconstructor ((entry entry)
+ &key buffer &allow-other-keys)
+ (initialize entry 'buffer)
+ (if buffer
+ (gtk-entry-new-with-buffer buffer)
+ (gtk-entry-new)))
-(defgtkslots entry
+(defslots entry
visibility :boolean
max-length :int
-; entry-buffer pobject
+ buffer pobject
activates-default :boolean
has-frame :boolean
- inner-border border
+ inner-border (:pointer (:struct border))
width-chars :int
alignment :float
+ placeholder-text :string
overwrite-mode :boolean
completion pobject
cursor-hadjustment pobject
progress-fraction :double
progress-pulse-step :double)
+
+(deffuns entry
+ (:get text :string &key)
+ (:set text :string &key)
+ (:get text-length :uint16)
+ (:set invisible-char unichar)
+ (unset-invisible-char :void)
+ (:get layout pobject))
+
+
+
+(defcfun gtk-entry-get-text-area :void (entry pobject)
+ (area (struct rectangle :out t)))
+
+(defgeneric text-area (entry)
+ (:method ((entry entry))
+ (let ((r (make-instance 'rectangle)))
+ (gtk-entry-get-text-area entry r)
+ r)))
+
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/gtk-cffi.asd 2012/08/04 17:40:26 1.22
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/gtk-cffi.asd 2012/08/12 17:42:30 1.23
@@ -30,7 +30,8 @@
(:file orientable :depends-on (loadlib))
(:file buildable :depends-on (loadlib))
(:file builder :depends-on (loadlib))
- (:file color-chooser :depends-on (loadlib))))
+ (:file color-chooser :depends-on (loadlib))
+ (:file adjustment :depends-on (loadlib))))
(defsystem gtk-cffi-widget
:description "Interface to GTK/Glib via CFFI"
@@ -337,7 +338,7 @@
:author "Roman Klochkov <kalimehtar at mail.ru>"
:version "0.99"
:license "LLGPL"
- :depends-on (gtk-cffi-bin gtk-cffi-range)
+ :depends-on (gtk-cffi-bin gtk-cffi-range gtk-cffi-entry)
:components
((:file combo-box)
(:file combo-box-text)))
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/package.lisp 2012/07/31 17:57:12 1.23
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/package.lisp 2012/08/12 17:42:30 1.24
@@ -38,6 +38,18 @@
#:orientation
#:buildable
+
+ #:adjustment
+ #:value
+ #:lower
+ #:upper
+ #:step-increment
+ #:page-increment
+ #:page-size
+ #:clamp-page
+ #:changed
+ #:value-changed
+ #:minimum-increment
#:widget
;; widget slots
@@ -362,6 +374,22 @@
#:toggled
#:check-button
+
+ #:link-button
+ #:uri
+ #:visited
+
+ #:radio-button
+ #:group
+ #:as-list
+ #:join-group
+
+ #:scale-button
+ #:icons
+ #:plus-button
+ #:minus-button
+
+ #:volume-button
#:box
;; box slots
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/statusbar.lisp 2012/07/29 15:13:59 1.7
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/statusbar.lisp 2012/08/12 17:42:30 1.8
@@ -3,7 +3,7 @@
(defclass statusbar (box)
())
-(defcfun "gtk_statusbar_new" :pointer)
+(defcfun gtk-statusbar-new :pointer)
(defmethod gconstructor ((statusbar statusbar) &key &allow-other-keys)
(gtk-statusbar-new))
@@ -11,7 +11,7 @@
(deffuns statusbar
((statusbar-push . push) :uint (context-id :uint) (text :string))
((statusbar-pop . pop) :void (context-id :uint))
- (:get context-id :uint (context pstring))
+ (:get context-id :uint (context :string))
(:get message-area pobject))
(defcfun gtk-statusbar-remove :void
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/style-context.lisp 2011/09/10 16:26:11 1.2
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/style-context.lisp 2012/08/12 17:42:30 1.3
@@ -1,5 +1,11 @@
(in-package :gtk-cffi)
+ (defcstruct* border
+ (left :int16)
+ (right :int16)
+ (top :int16)
+ (bottom :int16))
+
(defclass style-context (g-object)
(provider (styles :initform nil)))
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/text-buffer.lisp 2012/05/13 16:20:07 1.8
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/text-buffer.lisp 2012/08/12 17:42:30 1.9
@@ -133,7 +133,8 @@
(funcall *callback* ch data))
(defcfun gtk-text-iter-forward-find-char :boolean
- (text-iter pobject) (pred pfunction) (data (pdata :free t)) (limit pobject))
+ (text-iter pobject) (pred pfunction) (data (pdata :free-to-foreign t))
+ (limit pobject))
(defgeneric forward-find-char (text-iter pred &key data limit)
(:method ((text-iter text-iter) pred &key data limit)
@@ -145,7 +146,8 @@
(gtk-text-iter-forward-find-char text-iter pred data limit))))
(defcfun gtk-text-iter-backward-find-char :boolean
- (text-iter pobject) (pred pfunction) (data (pdata :free t)) (limit pobject))
+ (text-iter pobject) (pred pfunction) (data (pdata :free-to-foreign t))
+ (limit pobject))
(defgeneric backward-find-char (text-iter pred &key data limit)
(:method ((text-iter text-iter) pred &key data limit)
@@ -484,8 +486,8 @@
(setf (mem-ref size :int) (length res))
res)))
-(defcallback cb-serialize-destroy :void
- ((user-data pdata :free t))
+(defcallback cb-serialize-destroy :void
+ ((user-data pdata :free-from-foreign t))
(destructuring-bind (func data data-destroy) user-data
(declare (ignore func))
(funcall data-destroy data)))
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/tree-model.lisp 2012/07/29 16:11:54 1.12
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/tree-model.lisp 2012/08/12 17:42:30 1.13
@@ -12,7 +12,7 @@
(path :pointer) (depth :pointer))
(define-foreign-type tree-path (freeable)
- ((free :initform :all)) ; NB: except callbacks
+ ((free-from-foreign :initform t)) ; NB: except callbacks
(:simple-parser tree-path)
(:actual-type :pointer))
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/widget.lisp 2012/07/31 17:57:12 1.15
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/widget.lisp 2012/08/12 17:42:30 1.16
@@ -119,7 +119,7 @@
:has-grab :rc-style :composite-child :no-reparent :app-paintable
:recieves-default :double-buffered :no-show-all)
-(defgtkslots widget
+(defslots widget
name :string
direction text-direction
default-direction text-direction
@@ -407,7 +407,7 @@
())
(defcstruct widget-class
- (parent-class g-object-class)
+ (parent-class (:struct g-object-class))
(activate-signal :pointer)
(dispatch-child-properties-changed :pointer)
(destroy :pointer)
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/window.lisp 2012/07/31 17:57:12 1.6
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/window.lisp 2012/08/12 17:42:30 1.7
@@ -105,7 +105,7 @@
(mask window-hints))
(is-active :boolean)
(has-toplevel-focus :boolean)
- (list-toplevels (g-list :free :none))
+ (list-toplevels (g-list :free-from-foreign nil))
(add-mnemonic :void (keyval key) (target pobject))
(remove-mnemonic :void (keyval key) (target pobject))
(mnemonic-activate :boolean &key (keyval key) (modifier modifier-type))
More information about the gtk-cffi-cvs
mailing list