From rklochkov at common-lisp.net Sat Aug 4 17:40:26 2012 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Sat, 04 Aug 2012 10:40:26 -0700 Subject: [gtk-cffi-cvs] CVS gtk-cffi/gtk Message-ID: Update of /project/gtk-cffi/cvsroot/gtk-cffi/gtk In directory tiger.common-lisp.net:/tmp/cvs-serv6958/gtk Modified Files: color-button.lisp gtk-cffi.asd Log Message: Minor fixes --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/color-button.lisp 2012/07/31 17:57:12 1.1 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/color-button.lisp 2012/08/04 17:40:25 1.2 @@ -15,6 +15,7 @@ (defcfun gtk-color-button-new-with-rgba :pointer (rgbd prgba)) (defmethod gconstructor ((color-button color-button) &key color rgba) + (initialized color-button '(color rgba)) (cond (color (gtk-color-button-new-with-color color)) (rgba (gtk-color-button-new-with-rgba rgba)) @@ -30,7 +31,4 @@ (:get color pcolor &key) (:set color pcolor &key)) -(remove-setter color-button color) -(remove-setter color-button rgba) - (init-slots color-button) \ No newline at end of file --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/gtk-cffi.asd 2012/07/31 17:57:12 1.21 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/gtk-cffi.asd 2012/08/04 17:40:26 1.22 @@ -483,7 +483,7 @@ :author "Roman Klochkov " :version "0.99" :license "LLGPL" - :depends-on (gtk-cffi-core) + :depends-on (gtk-cffi-core gtk-cffi-image) :components ((:file status-icon))) From rklochkov at common-lisp.net Sun Aug 12 17:42:29 2012 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Sun, 12 Aug 2012 10:42:29 -0700 Subject: [gtk-cffi-cvs] CVS gtk-cffi/ext Message-ID: Update of /project/gtk-cffi/cvsroot/gtk-cffi/ext In directory tiger.common-lisp.net:/tmp/cvs-serv2591/ext Modified Files: lisp-model.lisp Log Message: Synced with current version of CFFI --- /project/gtk-cffi/cvsroot/gtk-cffi/ext/lisp-model.lisp 2012/07/21 19:26:38 1.5 +++ /project/gtk-cffi/cvsroot/gtk-cffi/ext/lisp-model.lisp 2012/08/12 17:42:29 1.6 @@ -267,8 +267,8 @@ get-n-columns (:int) get-column-type (:int (index :int)) get-iter (:boolean (iter (object tree-iter)) - (path (tree-path :free nil))) - get-path ((tree-path :free nil) (iter (object tree-iter))) + (path (tree-path :free-from-foreign nil))) + get-path ((tree-path :free-to-foreign nil) (iter (object tree-iter))) get-value (:void (iter (object tree-iter)) (n :int) (value :pointer)) iter-next (:boolean (iter (object tree-iter))) From rklochkov at common-lisp.net Sun Aug 12 17:42:29 2012 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Sun, 12 Aug 2012 10:42:29 -0700 Subject: [gtk-cffi-cvs] CVS gtk-cffi/g-lib Message-ID: Update of /project/gtk-cffi/cvsroot/gtk-cffi/g-lib In directory tiger.common-lisp.net:/tmp/cvs-serv2591/g-lib Modified Files: array.lisp list.lisp quark.lisp Log Message: Synced with current version of CFFI --- /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/array.lisp 2012/07/31 17:57:11 1.8 +++ /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/array.lisp 2012/08/12 17:42:29 1.9 @@ -11,19 +11,28 @@ () (:actual-type :pointer)) -(define-parse-method garray (type &key free) - (make-instance 'g-lib-array :type type :free free)) +(define-parse-method garray (type &rest rest) + (apply #'make-instance 'g-lib-array :type type rest)) (defcfun g-free :void (var :pointer)) +(defcfun g-malloc :pointer (n-bytes :int)) (defmethod free-ptr ((type g-lib-array) ptr) (g-free ptr)) -(define-foreign-type g-lib-string (cffi-objects::cffi-string) - ((free :initform t)) +(define-foreign-type g-lib-string (freeable) + ((free-from-foreign :initform t)) (:simple-parser g-lib-string) (:actual-type :pointer)) +(defmethod translate-to-foreign (value (type g-lib-string)) + (with-foreign-string ((str len) value) + (let ((ptr (g-malloc len))) + (lisp-string-to-foreign value ptr len) + ptr))) -(defmethod free-ptr ((type cffi-string) ptr) +(defmethod translate-from-foreign (value (type g-lib-string)) + (foreign-string-to-lisp value)) + +(defmethod free-ptr ((type g-lib-string) ptr) (g-free ptr)) \ No newline at end of file --- /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/list.lisp 2012/02/20 16:51:37 1.7 +++ /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/list.lisp 2012/08/12 17:42:29 1.8 @@ -37,7 +37,7 @@ (define-foreign-type g-list (freeable) ((list-type :initarg :elt :accessor list-type :initform nil :documentation "If null, then list is of pointers or GObjects") - (free :initform :container)) + (free-from-foreign :initform t)) (:simple-parser g-list) (:actual-type :pointer)) @@ -68,7 +68,8 @@ ;; Copy-paste fom g-list. Bad, but what to do? (define-foreign-type g-slist (freeable) ((list-type :initarg :elt :accessor list-type - :documentation "If null, then list is of pointers or GObjects")) + :documentation "If null, then list is of pointers or GObjects") + (free-from-foreign :initform t)) (:simple-parser g-slist) (:actual-type :pointer)) @@ -103,7 +104,7 @@ (g-slist-reverse p)))) (define-foreign-type string-list (freeable) - () + ((free-from-foreign :initform t)) (:actual-type :pointer) (:simple-parser string-list)) --- /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/quark.lisp 2012/02/12 17:29:41 1.3 +++ /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/quark.lisp 2012/08/12 17:42:29 1.4 @@ -16,5 +16,6 @@ (defcfun g-intern-string :pointer (string :string)) -(defcfun g-intern-static-string :pointer (string (pstring :free :none))) +(defcfun g-intern-static-string :pointer + (string (:string :free-to-foreign nil))) From rklochkov at common-lisp.net Sun Aug 12 17:42:30 2012 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Sun, 12 Aug 2012 10:42:30 -0700 Subject: [gtk-cffi-cvs] CVS gtk-cffi/g-object Message-ID: Update of /project/gtk-cffi/cvsroot/gtk-cffi/g-object In directory tiger.common-lisp.net:/tmp/cvs-serv2591/g-object Modified Files: defslots.lisp g-object.lisp g-type.lisp pobject.lisp Log Message: Synced with current version of CFFI --- /project/gtk-cffi/cvsroot/gtk-cffi/g-object/defslots.lisp 2012/05/07 09:02:04 1.12 +++ /project/gtk-cffi/cvsroot/gtk-cffi/g-object/defslots.lisp 2012/08/12 17:42:30 1.13 @@ -148,7 +148,7 @@ (cb-name (gensym))) `(progn (defcfun ,gtk-name :void - (,class pobject) (func pfunction) (data (pdata :free :all))) + (,class pobject) (func pfunction) (data (pdata :free-to-foreign t))) (defcallback ,cb-name :void ,params ;((tag pobject) (data pdata)) (funcall *callback* ,@(mapcar #'car params))) (defmethod foreach ((,class ,class) func &optional data) --- /project/gtk-cffi/cvsroot/gtk-cffi/g-object/g-object.lisp 2012/07/29 16:11:54 1.12 +++ /project/gtk-cffi/cvsroot/gtk-cffi/g-object/g-object.lisp 2012/08/12 17:42:30 1.13 @@ -10,8 +10,8 @@ (defclass g-object (object) ((signals :accessor gsignals :initform nil) ;; redefining VOLATILE for saving in hash - (cffi-objects::volatile :initform nil) - (cffi-objects::free-after :initform nil) + (volatile :initform nil) + (free-after :initform nil) (%properties :accessor %properties :initform nil :allocation :class)) (:documentation "Lisp wrapper for GObject")) --- /project/gtk-cffi/cvsroot/gtk-cffi/g-object/g-type.lisp 2012/05/07 09:02:04 1.7 +++ /project/gtk-cffi/cvsroot/gtk-cffi/g-object/g-type.lisp 2012/08/12 17:42:30 1.8 @@ -31,12 +31,13 @@ (defcstruct g-type-instance "GTypeInstance" - (g-class (:pointer g-type-class))) + (g-class (:pointer (:struct g-type-class)))) + (defun g-type-from-instance (ptr) (foreign-slot-value - (foreign-slot-value ptr 'g-type-instance 'g-class) - 'g-type-class 'g-type)) + (foreign-slot-value ptr '(:struct g-type-instance) 'g-class) + '(:struct g-type-class) 'g-type)) (defcfun g-type-fundamental g-type (id g-type)) (defcfun g-type-from-name g-type (name :string)) --- /project/gtk-cffi/cvsroot/gtk-cffi/g-object/pobject.lisp 2012/07/29 15:13:59 1.8 +++ /project/gtk-cffi/cvsroot/gtk-cffi/g-object/pobject.lisp 2012/08/12 17:42:30 1.9 @@ -53,7 +53,7 @@ (define-foreign-type cffi-pdata (cffi-pobject freeable-base) - ((free :initform :none)) + ((free-to-foreign :initform nil)) (:actual-type :pointer) (:simple-parser pdata) (:documentation "PDATA lets send any data via a c-pointer. C-pointer used as From rklochkov at common-lisp.net Sun Aug 12 17:42:30 2012 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Sun, 12 Aug 2012 10:42:30 -0700 Subject: [gtk-cffi-cvs] CVS gtk-cffi/gdk Message-ID: Update of /project/gtk-cffi/cvsroot/gtk-cffi/gdk In directory tiger.common-lisp.net:/tmp/cvs-serv2591/gdk Modified Files: atom.lisp pango.lisp rectangle.lisp Log Message: Synced with current version of CFFI --- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/atom.lisp 2012/02/12 17:29:41 1.2 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/atom.lisp 2012/08/12 17:42:30 1.3 @@ -8,7 +8,8 @@ (in-package :gdk-cffi) (defcfun gdk-atom-name :string (atom :pointer)) -(defcfun gdk-atom-intern-static-string :pointer (val (pstring :free :none))) +(defcfun gdk-atom-intern-static-string :pointer + (val (:string :free-to-foreign nil))) (defcfun gdk-atom-intern :pointer (val :string) (only-if-exists :boolean)) (define-foreign-type gatom () --- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/pango.lisp 2012/02/20 16:51:37 1.7 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/pango.lisp 2012/08/12 17:42:30 1.8 @@ -97,10 +97,8 @@ (define-foreign-type tab-array (freeable) () - (:actual-type :pointer)) - -(define-parse-method tab-array (&key free) - (make-instance 'tab-array :free free)) + (:actual-type :pointer) + (:simple-parser tab-array)) ;; We need to pass positions-in-pixels (boolean) and list of tab-stops ;; in lisp it is handy to represent as (pixels {tab-stop}*), where @@ -316,7 +314,7 @@ (defcfun pango-attr-shape-new attr-shape (ink rect-list) (logical rect-list)) (define-foreign-type attr-list (freeable) - ((free :initform t)) + ((free-from-foreign :initform t)) (:simple-parser attr-list) (:actual-type :pointer)) --- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/rectangle.lisp 2012/01/25 19:15:08 1.4 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/rectangle.lisp 2012/08/12 17:42:30 1.5 @@ -1,6 +1,6 @@ (in-package :gdk-cffi) -(defclass rectangle (object) +(defclass rectangle (struct) ()) (defmethod new-struct ((class (eql 'rectangle))) From rklochkov at common-lisp.net Sun Aug 12 17:42:30 2012 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Sun, 12 Aug 2012 10:42:30 -0700 Subject: [gtk-cffi-cvs] CVS gtk-cffi/gio Message-ID: Update of /project/gtk-cffi/cvsroot/gtk-cffi/gio In directory tiger.common-lisp.net:/tmp/cvs-serv2591/gio Modified Files: action-group.lisp Log Message: Synced with current version of CFFI --- /project/gtk-cffi/cvsroot/gtk-cffi/gio/action-group.lisp 2012/02/12 17:29:41 1.2 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gio/action-group.lisp 2012/08/12 17:42:30 1.3 @@ -11,7 +11,7 @@ (deffuns action-group (has-action :boolean (action-name :string)) - (list-actions (string-list :free t)) + (list-actions string-list) (:get action-enabled :boolean (action-name :string)) (:get action-parameter-type variant-type (action-name :string)) (:get action-state-type variant-type (action-name :string)) From rklochkov at common-lisp.net Sun Aug 12 17:42:30 2012 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Sun, 12 Aug 2012 10:42:30 -0700 Subject: [gtk-cffi-cvs] CVS gtk-cffi/gtk Message-ID: 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 ;;; @@ -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 +;;; + (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 " :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)) From rklochkov at common-lisp.net Sat Aug 18 13:55:27 2012 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Sat, 18 Aug 2012 06:55:27 -0700 Subject: [gtk-cffi-cvs] CVS gtk-cffi/g-object Message-ID: Update of /project/gtk-cffi/cvsroot/gtk-cffi/g-object In directory tiger.common-lisp.net:/tmp/cvs-serv14447/g-object Modified Files: g-object-class.lisp g-object.lisp g-value.lisp subclass.lisp Log Message: Added GtkSwitch GtkEntryCompletion GtkEntryBuffer --- /project/gtk-cffi/cvsroot/gtk-cffi/g-object/g-object-class.lisp 2012/05/07 09:02:04 1.6 +++ /project/gtk-cffi/cvsroot/gtk-cffi/g-object/g-object-class.lisp 2012/08/18 13:55:27 1.7 @@ -11,7 +11,7 @@ ((free-after :initform nil))) (defcstruct g-object-class - (type-class g-type-class) + (type-class (:struct g-type-class)) (construct-properties :pointer) (constructor :pointer) (set-property :pointer) @@ -71,11 +71,11 @@ (owner-type :ulong)) (defmethod flags ((g-param-spec g-param-spec)) - (foreign-slot-value (pointer g-param-spec) 'g-param-spec 'flags)) + (foreign-slot-value (pointer g-param-spec) '(:struct g-param-spec) 'flags)) (defmethod g-type ((g-param-spec g-param-spec) &key owner) (foreign-slot-value (pointer g-param-spec) - 'g-param-spec (if owner 'owner-type 'type))) + '(:struct g-param-spec) (if owner 'owner-type 'type))) (defun show-properties (g-object) (let ((gclass (make-instance 'g-object-class :object g-object))) --- /project/gtk-cffi/cvsroot/gtk-cffi/g-object/g-object.lisp 2012/08/12 17:42:30 1.13 +++ /project/gtk-cffi/cvsroot/gtk-cffi/g-object/g-object.lisp 2012/08/18 13:55:27 1.14 @@ -16,7 +16,7 @@ (:documentation "Lisp wrapper for GObject")) (defcstruct g-object - (g-type-instance :pointer) ;; *g-type-instance = g-type + (g-type-instance (:pointer (:struct g-type-instance))) (ref-count :uint) (g-data :pointer)) @@ -144,7 +144,8 @@ (collect (value (make-instance 'g-value - :pointer (mem-aref params 'g-value-struct i)))))) + :pointer (mem-aref + params '(:struct g-value-struct) i)))))) (lisp-return (make-instance 'g-value :pointer return))) (let ((res (apply lisp-func lisp-params))) (when (/= (g-type lisp-return) 0) @@ -160,7 +161,8 @@ closure-ptr)) -(defcfun "g_signal_handler_disconnect" :void (instance g-object) (id :ulong)) +(defcfun "g_signal_handler_disconnect" :void + (instance (:pointer (:struct g-object))) (id :ulong)) (defmethod connect ((g-object g-object) c-handler &key signal data after swapped) --- /project/gtk-cffi/cvsroot/gtk-cffi/g-object/g-value.lisp 2012/05/07 09:02:04 1.5 +++ /project/gtk-cffi/cvsroot/gtk-cffi/g-object/g-value.lisp 2012/08/18 13:55:27 1.6 @@ -24,7 +24,7 @@ (defcstruct g-value-struct "GValue struct" (g-type :ulong) - (data g-value-data :count 2)) + (data (:union g-value-data) :count 2)) (defcfun "g_value_init" :pointer (g-value pobject) (type :int)) (defcfun "g_value_set_boolean" :void (g-value pobject) (val :boolean)) @@ -49,8 +49,8 @@ (defmethod gconstructor ((g-value g-value) &key (value nil value-p) g-type &allow-other-keys) - (let ((ptr (foreign-alloc 'g-value-struct))) - (setf (foreign-slot-value ptr 'g-value-struct 'g-type) 0) + (let ((ptr (foreign-alloc '(:struct g-value-struct)))) + (setf (foreign-slot-value ptr '(:struct g-value-struct) 'g-type) 0) (init-g-value ptr g-type value value-p) ptr)) @@ -95,7 +95,7 @@ Depends on implementation of GLib/GObject! Returns integer GType." (if (null-pointer-p value) 0 - (foreign-slot-value value 'g-value-struct 'g-type))) + (foreign-slot-value value '(:struct g-value-struct) 'g-type))) (defmethod g-type ((g-value g-value) &rest rest) (declare (ignore rest)) --- /project/gtk-cffi/cvsroot/gtk-cffi/g-object/subclass.lisp 2011/08/08 15:02:01 1.2 +++ /project/gtk-cffi/cvsroot/gtk-cffi/g-object/subclass.lisp 2012/08/18 13:55:27 1.3 @@ -27,8 +27,8 @@ (defcfun g-type-register-static g-type - (parent-type g-type) (type-name :string) (info g-type-info) - (flags g-type-flags)) + (parent-type g-type) (type-name :string) + (info (:pointer (:struct g-type-info))) (flags g-type-flags)) (defcfun g-type-register-static-simple g-type (parent-type g-type) (type-name :string) (class-size :uint) @@ -42,7 +42,8 @@ (interface-data :pointer)) (defcfun g-type-add-interface-static :void - (instance-type g-type) (interface-type g-type) (info g-interface-info)) + (instance-type g-type) (interface-type g-type) + (info (:pointer (:struct g-interface-info)))) \ No newline at end of file From rklochkov at common-lisp.net Sat Aug 18 13:55:27 2012 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Sat, 18 Aug 2012 06:55:27 -0700 Subject: [gtk-cffi-cvs] CVS gtk-cffi/gdk Message-ID: Update of /project/gtk-cffi/cvsroot/gtk-cffi/gdk In directory tiger.common-lisp.net:/tmp/cvs-serv14447/gdk Modified Files: color.lisp Log Message: Added GtkSwitch GtkEntryCompletion GtkEntryBuffer --- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/color.lisp 2012/03/08 09:58:11 1.6 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/color.lisp 2012/08/18 13:55:27 1.7 @@ -7,13 +7,15 @@ (green :int16) (blue :int16)) -(defcfun gdk-color-parse :boolean (str :string) (color color-struct)) -(defcfun gdk-color-to-string :string (color color-struct)) +(defcfun gdk-color-parse :boolean (str :string) + (color (:pointer (:struct color-struct)))) +(defcfun gdk-color-to-string :string + (color (:pointer (:struct color-struct)))) (defcfun gdk-color-free :void (color :pointer)) (define-foreign-type color-cffi (freeable) () - (:actual-type color-struct) + (:actual-type :pointer) (:simple-parser pcolor)) (defmethod free-ptr ((class color-cffi) ptr) @@ -21,7 +23,7 @@ (defmethod translate-to-foreign (value (type color-cffi)) (if (pointerp value) value - (let ((color-st (foreign-alloc 'color-struct))) + (let ((color-st (foreign-alloc '(:struct color-struct)))) (gdk-color-parse (string value) color-st) color-st))) @@ -40,7 +42,7 @@ (define-foreign-type rgba-cffi (freeable) () - (:actual-type rgba-struct) + (:actual-type :pointer) (:simple-parser prgba)) (defcfun gdk-rgba-parse :boolean (color rgba-struct) (str :string)) From rklochkov at common-lisp.net Sat Aug 18 13:55:28 2012 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Sat, 18 Aug 2012 06:55:28 -0700 Subject: [gtk-cffi-cvs] CVS gtk-cffi/gtk Message-ID: Update of /project/gtk-cffi/cvsroot/gtk-cffi/gtk In directory tiger.common-lisp.net:/tmp/cvs-serv14447/gtk Modified Files: button.lisp entry.lisp gtk-cffi.asd package.lisp style-context.lisp Added Files: adjustment.lisp switch.lisp Log Message: Added GtkSwitch GtkEntryCompletion GtkEntryBuffer --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/button.lisp 2012/08/12 17:42:30 1.4 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/button.lisp 2012/08/18 13:55:28 1.5 @@ -1,7 +1,8 @@ ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*- ;;; ;;; button.lisp --- Wrappers for GtkButton, GtkCheckButton, GtkToggleButton, -;;; GtkScaleButton, GtkRadioButton, GtkVolumeButton +;;; GtkScaleButton, GtkRadioButton, GtkVolumeButton, +;;; GtkLockButton ;;; ;;; Copyright (C) 2012, Roman Klochkov ;;; @@ -189,3 +190,14 @@ (defmethod gconstructor ((volume-button volume-button) &key) (gtk-volume-button-new)) + +(defclass lock-button (button) + ()) + +(defcfun gtk-lock-button-new :pointer (permission pobject)) + +(defmethod gconstructor ((lock-button lock-button) &key permission) + (initialize lock-button 'permission) + (gtk-lock-button-new permission)) + +(defslot lock-button permission pobject) --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/entry.lisp 2012/08/12 17:42:30 1.5 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/entry.lisp 2012/08/18 13:55:28 1.6 @@ -43,6 +43,56 @@ (init-slots entry-buffer) +(defclass entry-completion (g-object) + ()) + +(defcfun gtk-entry-completion-new :pointer) +(defcfun gtk-entry-completion-new-with-area :pointer (area pobject)) + +(defmethod gconstructor ((entry-completion entry-completion) + &key area &allow-other-keys) + (initialize entry-completion 'area) + (if area + (gtk-entry-completion-new-with-area area) + (gtk-entry-completion-new))) + +(defslots entry-completion + model pobject + minimum-key-length :int + text-columns :int + inline-complection :boolean + inline-selection :boolean + popup-completion :boolean + popup-set-width :boolean + popup-single-match :boolean) + +(deffuns entry-completion + (:get entry pobject) + (compute-prefix (:string :free-from-foreign t) (key :string)) + (complete :void) + (:get completion-prefix :string) + (insert-prefix :void) + (insert-action-text :void (index :int) (text :string)) + (insert-action-markup :void (index :int) (markup :string)) + (delete-action :void (index :int))) + +(defcfun gtk-entry-completion-set-match-func :void + (entry-completion pobject) (func pfunction) (data pdata) (notify :pointer)) + +(defcallback cb-match-func :boolean + ((entry-completion pobject) (key :string) (tree-iter (object tree-iter)) + (data pdata)) + (funcall data entry-completion key tree-iter)) + +(defgeneric (setf match-func) (func entry-completion &key data destroy-notify) + (:method (func (entry-completion entry-completion) &key data destroy-notify) + (set-callback entry-completion gtk-entry-completion-set-match-func + cb-match-func func data destroy-notify))) +(save-setter entry-completion match-func) + +(init-slots entry-completion) + + (defclass entry (widget) ()) @@ -62,7 +112,7 @@ buffer pobject activates-default :boolean has-frame :boolean - inner-border (:pointer (:struct border)) + inner-border (struct border) width-chars :int alignment :float placeholder-text :string @@ -78,7 +128,13 @@ (:get text-length :uint16) (:set invisible-char unichar) (unset-invisible-char :void) - (:get layout pobject)) + (:get layout pobject) + (layout-index-to-text-index :int (layout-index :int)) + (text-index-to-layout-index :int (layout-index :int)) + (progress-pulse :void) + (im-context-filter-keypress :boolean (event pobject)) + (reset-im-context :void)) + @@ -91,6 +147,11 @@ (gtk-entry-get-text-area entry r) r))) - +(defcfun gtk-entry-get-layout-offsets :void (entry pobject) + (x :pointer) (y :pointer)) + +(defmethod layout-offsets ((entry entry)) + (with-foreign-outs-list ((x :int) (y :int)) :ignore + (gtk-entry-get-layout-offsets entry x y))) --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/gtk-cffi.asd 2012/08/12 17:42:30 1.23 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/gtk-cffi.asd 2012/08/18 13:55:28 1.24 @@ -43,7 +43,8 @@ ((:file widget) (:file invisible :depends-on (widget)) (:file actionable :depends-on (widget)) - (:file activatable :depends-on (widget)))) + (:file activatable :depends-on (widget)) + (:file switch :depends-on (actionable activatable)))) (defsystem gtk-cffi-misc :description "Interface to GTK/Glib via CFFI" --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/package.lisp 2012/08/12 17:42:30 1.24 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/package.lisp 2012/08/18 13:55:28 1.25 @@ -11,7 +11,7 @@ (:use #:common-lisp #:alexandria #:iterate #:cffi-objects #:g-object-cffi #:g-lib-cffi #:gdk-cffi #:gtk-cffi-utils) - (:shadow #:image #:window) + (:shadow #:image #:window #:switch) (:export ;;;; common #:gtk-init @@ -390,6 +390,12 @@ #:minus-button #:volume-button + + #:lock-button + ; slot + #:permission + + #:switch #:box ;; box slots --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/style-context.lisp 2012/08/12 17:42:30 1.3 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/style-context.lisp 2012/08/18 13:55:28 1.4 @@ -1,10 +1,10 @@ (in-package :gtk-cffi) - (defcstruct* border - (left :int16) - (right :int16) - (top :int16) - (bottom :int16)) +(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/adjustment.lisp 2012/08/18 13:55:28 NONE +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/adjustment.lisp 2012/08/18 13:55:28 1.1 ;;; ;;; adjustment.lisp -- GtkAdjustment ;;; ;;; Copyright (C) 2012, Roman Klochkov ;;; (in-package :gtk-cffi) (defclass adjustment (g-object) ()) (defcfun gtk-adjustment-new :pointer (value :double) (lower :double) (upper :double) (step-increment :double) (page-increment :double) (page-size :double)) (defmethod gconstructor ((adjustment adjustment) &key value lower upper step-increment page-increment page-size) (initialize adjustment '(value lower upper step-increment page-increment page-size)) (gtk-adjustment-new value lower upper step-increment page-increment page-size)) (defslots adjustment value :double lower :double page-increment :double page-size :double step-increment :double upper :double) (deffuns adjustment (clamp-page :void (lower :double) (upper :double)) (changed :void) (value-changed :void) (:get minimum-increment :double)) (defcfun gtk-adjustment-configure :pointer (adjustment pobject) (value :double) (lower :double) (upper :double) (step-increment :double) (page-increment :double) (page-size :double)) (defmethod reinitialize-instance ((adjustment adjustment) &key value lower upper step-increment page-increment page-size) (gtk-adjustment-configure adjustment value lower upper step-increment page-increment page-size)) --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/switch.lisp 2012/08/18 13:55:28 NONE +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/switch.lisp 2012/08/18 13:55:28 1.1 ;;; ;;; switch.lisp -- GtkSwitch ;;; ;;; Copyright (C) 2012, Roman Klochkov ;;; (in-package :gtk-cffi) (defclass switch (widget actionable activatable) ()) (defcfun gtk-switch-new :pointer) (defmethod gconstructor ((switch switch) &key &allow-other-keys) (gtk-switch-new)) (defslot switch active :boolean) (init-slots switch) From rklochkov at common-lisp.net Sun Aug 19 15:44:16 2012 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Sun, 19 Aug 2012 08:44:16 -0700 Subject: [gtk-cffi-cvs] CVS gtk-cffi/gtk Message-ID: Update of /project/gtk-cffi/cvsroot/gtk-cffi/gtk In directory tiger.common-lisp.net:/tmp/cvs-serv28844 Modified Files: expander.lisp Log Message: Summary: Added GtkScale --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/expander.lisp 2012/02/12 17:29:42 1.2 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/expander.lisp 2012/08/19 15:44:16 1.3 @@ -21,5 +21,5 @@ label-widget pobject label-fill :boolean) -(init-slots expander nil) +(init-slots expander) \ No newline at end of file From rklochkov at common-lisp.net Sun Aug 19 15:44:44 2012 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Sun, 19 Aug 2012 08:44:44 -0700 Subject: [gtk-cffi-cvs] CVS gtk-cffi/gtk Message-ID: Update of /project/gtk-cffi/cvsroot/gtk-cffi/gtk In directory tiger.common-lisp.net:/tmp/cvs-serv28908 Added Files: scale.lisp Log Message: GtkScale --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/scale.lisp 2012/08/19 15:44:44 NONE +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/scale.lisp 2012/08/19 15:44:44 1.1 ;;; ;;; scale.lisp -- GtkScale ;;; ;;; Copyright (C) 2012, Roman Klochkov ;;; (in-package :gtk-cffi) (defclass scale (range) ()) (defcfun gtk-scale-new :pointer) (defcfun gtk-scale-new-with-range :pointer) (defmethod gconstructor ((scale scale) &key range &allow-other-keys) (if range (gtk-scale-new-with-range range) (gtk-scale-new))) (defslots scale digits :int draw-value :boolean has-origin :boolean value-pos position-type) (deffuns scale (:get layout pobject) (add-mark :void (value :double) (position position-type) (markup :string)) (clear-marks :void)) (defcfun gtk-scale-get-layout-offsets :void (entry pobject) (x :pointer) (y :pointer)) (defmethod layout-offsets ((scale scale)) (with-foreign-outs-list ((x :int) (y :int)) :ignore (gtk-scale-get-layout-offsets scale x y))) (init-slots scale) From rklochkov at common-lisp.net Sun Aug 19 15:45:26 2012 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Sun, 19 Aug 2012 08:45:26 -0700 Subject: [gtk-cffi-cvs] CVS gtk-cffi/gtk Message-ID: Update of /project/gtk-cffi/cvsroot/gtk-cffi/gtk In directory tiger.common-lisp.net:/tmp/cvs-serv30347 Modified Files: entry.lisp gtk-cffi.asd package.lisp status-icon.lisp Log Message: Summary: GtkScale --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/entry.lisp 2012/08/18 13:55:28 1.6 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/entry.lisp 2012/08/19 15:45:26 1.7 @@ -59,8 +59,8 @@ (defslots entry-completion model pobject minimum-key-length :int - text-columns :int - inline-complection :boolean + text-column :int + inline-completion :boolean inline-selection :boolean popup-completion :boolean popup-set-width :boolean @@ -122,6 +122,8 @@ progress-fraction :double progress-pulse-step :double) +(defcenum entry-icon-position :primary :secondary) + (deffuns entry (:get text :string &key) (:set text :string &key) @@ -133,10 +135,14 @@ (text-index-to-layout-index :int (layout-index :int)) (progress-pulse :void) (im-context-filter-keypress :boolean (event pobject)) - (reset-im-context :void)) - - - + (reset-im-context :void) + (:get icon-storage-type image-type (icon-pos entry-icon-position)) + (set-icon-drag-source :void (icon-pos entry-icon-position) + (target-list (object target-list)) + (actions drag-action)) + (:get current-icon-drag-source :int) + (:get icon-at-pos :int (x :int) (y :int))) + (defcfun gtk-entry-get-text-area :void (entry pobject) (area (struct rectangle :out t))) @@ -147,6 +153,16 @@ (gtk-entry-get-text-area entry r) r))) +(defcfun gtk-entry-get-icon-area :void (entry pobject) + (icon-pos entry-icon-position) (area (struct rectangle :out t))) + +(defgeneric icon-area (entry icon-pos) + (:method ((entry entry) icon-pos) + (let ((r (make-instance 'rectangle))) + (gtk-entry-get-icon-area entry icon-pos r) + r))) + + (defcfun gtk-entry-get-layout-offsets :void (entry pobject) (x :pointer) (y :pointer)) @@ -155,3 +171,35 @@ (gtk-entry-get-layout-offsets entry x y))) +(template (item type from) ((pixbuf pobject t) + (stock :string t) + (icon-name :string t) + (gicon pobject t) + (activatable :boolean nil) + (sensitive :boolean nil) + (tooltip-text :string nil) + (tooltip-markup :string nil)) + (let ((set-name (if from + (symbolicate 'gtk-entry-set-icon-from- item) + (symbolicate 'gtk-entry-set-icon- item))) + (get-name (symbolicate 'gtk-entry-get-icon- + (if (eq item 'icon-name) 'name item))) + (lisp-name (symbolicate 'icon- item))) + `(progn + (defcfun ,set-name :void + (entry pobject) (icon-pos entry-icon-position) (,item ,type)) + + (defgeneric (setf ,lisp-name) (value entry icon-pos) + (:method (value (entry entry) icon-pos) + (,set-name entry icon-pos value))) + + (defcfun ,get-name ,type + (entry pobject) (icon-pos entry-icon-position)) + + (defgeneric ,lisp-name (entry icon-pos) + (:method ((entry entry) icon-pos) + (,get-name entry icon-pos)))))) + +(init-slots entry) + + --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/gtk-cffi.asd 2012/08/18 13:55:28 1.24 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/gtk-cffi.asd 2012/08/19 15:45:26 1.25 @@ -109,9 +109,9 @@ (defsystem gtk-cffi-entry :description "Interface to GTK/Glib via CFFI" :author "Roman Klochkov " - :version "0.1" + :version "0.99" :license "LLGPL" - :depends-on (gtk-cffi-widget) + :depends-on (gtk-cffi-image) :components ((:file entry))) @@ -516,6 +516,15 @@ :components ((:file color-button))) +(defsystem gtk-cffi-scale + :description "Interface to GTK/Glib via CFFI" + :author "Roman Klochkov " + :version "0.99" + :license "LLGPL" + :depends-on (gtk-cffi-range) + :components + ((:file scale))) + (defsystem gtk-cffi :description "Interface to GTK/Glib via CFFI" @@ -548,5 +557,6 @@ gtk-cffi-image gtk-cffi-combo-box gtk-cffi-status-icon + gtk-cffi-scale gtk-cffi-text-view)) --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/package.lisp 2012/08/18 13:55:28 1.25 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/package.lisp 2012/08/19 15:45:26 1.26 @@ -50,6 +50,11 @@ #:changed #:value-changed #:minimum-increment + + #:style-context + #:add-provider + #:load-css + #:junction-sides #:widget ;; widget slots @@ -129,6 +134,8 @@ #:preferred-height #:preferred-width #:preferred-size + #:request-mode + #:support-multidevice ;; methods #:activate #:show @@ -179,6 +186,9 @@ #:reset-style #:queue-compute-expand #:compute-expand + #:add-device-events + #:reparent + #:unparent #:pop-composite-child #:push-composite-child @@ -203,10 +213,18 @@ ;; container slots #:border-width #:child-property + #:focus-child + #:focus-vadjustment + #:resize-mode ;; methods #:add #:propagate-draw + #:accel-group + ;; methods + #:connect + #:disconnect + #:window ;; window slots #:default-size @@ -242,6 +260,7 @@ #:has-resize-grip #:application #:window-size + #:has-group ;; methods #:position-type #:add-accel-group @@ -294,7 +313,7 @@ #:remove-page #:add-action-widget #:remove-action-widget - #:update-button-state + #:update-buttons-state #:commit #:next-page #:previous-page @@ -310,7 +329,13 @@ #:list-windows #:current-grab #:current-device-grab - + + #:icon + ;; slots + #:state-wildcarded + #:size-wildcarded + #:direction-wildcarded + #:dialog ;;methods #:run @@ -324,6 +349,7 @@ #:content-area #:alternative-button-order #:alternative-dialog-button-order + #:widget-for-response #:about-dialog ;;slots @@ -342,6 +368,28 @@ #:logo #:logo-icon-name + #:entry-completion + ;; slots + #:text-column + #:minimum-key-length + #:inline-completion + ;; methods + #:insert-action-markup + #:insert-action-text + #:popup-single-match + #:complete + #:insert-prefix + #:compute-prefix + #:completion-prefix + #:delete-action + + #:entry-buffer + ;; slots + #:entry-buffer-length + #:bytes + ;; methods + #:emit-deleted-text + #:entry ;; entry slots #:text @@ -358,7 +406,23 @@ #:cursor-hadjustment #:progress-fraction #:progress-pulse-step - + #:text-length + #:placeholder-text + #:focus-hadjustment + #:inline-selection + #:popup-completion + #:popup-set-width + #:invisible-char + #:unset-invisible-char + ;; methods + #:icon-storage-type + #:progress-pulse + #:delete-text + #:set-icon-drag-source + #:layout-index-to-text-index + #:text-index-to-layout-index + #:current-icon-drag-source + #:icon-at-pos #:button ;; slots @@ -471,6 +535,7 @@ #:paned #:h-paned #:v-paned + #:paned-position #:frame ;; frame slots @@ -518,6 +583,7 @@ #:column #:get-cursor #:with-get-cursor-path + #:remove-column #:tree-view-column ;; tree-view-column slots @@ -544,12 +610,19 @@ #:add-with-viewport #:tree-selection - ;; tree-selection methods + ;; slots + #:user-data + ;; methods #:mode #:select-function #:with-selection #:get-selected + #:text-mark + ;; slots + #:left-gravity + #:deleted + #:text-iter ;; slots #:line @@ -690,6 +763,7 @@ #:serialize-formats #:register-serialize-format #:register-deserialize-format + #:lookup #:text-view ;; slots @@ -735,7 +809,16 @@ #:text-tag #:priority #:event + #:ref + #:unref + + #:text-appearance + + #:text-tag-table + #:text-tag-table-remove + #:text-attributes + #:appearance #:direction #:text-attributes-font @@ -877,10 +960,17 @@ #:child-pack-direction #:menu-item + ;; slots #:right-justified + #:reserve-indicator #:use-underline #:submenu #:accel-path + ;; methods + #:toggle-size-request + #:toggle-size-allocate + #:select + #:deselect #:tool-shell @@ -898,8 +988,15 @@ #:icon-source #:image + ;; slots + #:pixel-size + #:animation #:expander + ;; slots + #:expanded + #:label-fill + #:label-widget #:application @@ -923,6 +1020,8 @@ #:storage-type #:info-bar + + #:message-type #:spinner @@ -944,6 +1043,7 @@ #:color-button #:rgba #:color + #:alpha #:use-alpha #:title )) --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/status-icon.lisp 2012/07/31 17:57:12 1.1 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/status-icon.lisp 2012/08/19 15:45:26 1.2 @@ -67,7 +67,7 @@ (defgeneric geometry (status-icon) (:method ((status-icon status-icon)) (let ((area (make-instance 'rectangle))) - (with-foreign-objects ((screen :pointer) (orientation orientation)) + (with-foreign-objects ((screen :pointer) (orientation 'orientation)) (when (gtk-status-icon-get-geometry status-icon screen area orientation) (list (make-instance 'screen :pointer (mem-ref screen :pointer)) area (mem-ref orientation 'orientation))))))) From rklochkov at common-lisp.net Sun Aug 19 16:19:26 2012 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Sun, 19 Aug 2012 09:19:26 -0700 Subject: [gtk-cffi-cvs] CVS gtk-cffi/gtk Message-ID: Update of /project/gtk-cffi/cvsroot/gtk-cffi/gtk In directory tiger.common-lisp.net:/tmp/cvs-serv6291 Modified Files: builder.lisp package.lisp scale.lisp text-buffer.lisp Log Message: Synced package.lisp wight GtkScale --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/builder.lisp 2012/05/07 09:02:04 1.3 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/builder.lisp 2012/08/19 16:19:26 1.4 @@ -14,18 +14,19 @@ (gtk-builder-new)) (defcfun gtk-builder-add-from-file :uint - (builder pobject) (filename :string) (g-error g-error)) + (builder pobject) (filename :string) (g-error (:pointer (:struct g-error)))) (defcfun gtk-builder-add-from-string :uint - (builder pobject) (string :string) (length gsize) (g-error g-error)) + (builder pobject) (string :string) (length gsize) + (g-error (:pointer (:struct g-error)))) (defcfun gtk-builder-add-objects-from-file :uint (builder pobject) (filename :string) (object-ids string-list) - (g-error g-error)) + (g-error (:pointer (:struct g-error)))) (defcfun gtk-builder-add-objects-from-string :uint (builder pobject) (string :string) (length gsize) (object-ids string-list) - (g-error g-error)) + (g-error (:pointer (:struct g-error)))) (defgeneric add-from (builder &key filename string objects) (:method @@ -75,11 +76,11 @@ (defcfun gtk-builder-value-from-string :boolean (builder pobject) (pspec pobject) (string :string) (value pobject) - (g-error g-error)) + (g-error (:pointer (:struct g-error)))) (defcfun gtk-builder-value-from-string-type :boolean (builder pobject) (g-type g-type) (string :string) (value pobject) - (g-error g-error)) + (g-error (:pointer (:struct g-error)))) (defgeneric value-from-string (builder &key g-type param-spec string) (:method ((builder builder) &key g-type param-spec string) --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/package.lisp 2012/08/19 15:45:26 1.26 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/package.lisp 2012/08/19 16:19:26 1.27 @@ -1046,6 +1046,15 @@ #:alpha #:use-alpha #:title + + #:scale + ;; slots + #:digits + #:value-pos + #:draw-value + #:has-origin + ;; methods + #:clear-marks )) (in-package #:gtk-cffi) --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/scale.lisp 2012/08/19 15:44:44 1.1 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/scale.lisp 2012/08/19 16:19:26 1.2 @@ -8,13 +8,16 @@ (defclass scale (range) ()) -(defcfun gtk-scale-new :pointer) -(defcfun gtk-scale-new-with-range :pointer) +(defcfun gtk-scale-new :pointer (orientation orientation) (adjustment pobject)) +(defcfun gtk-scale-new-with-range :pointer (orientation orientation) + (min :double) (max :double) (step :double)) -(defmethod gconstructor ((scale scale) &key range &allow-other-keys) - (if range - (gtk-scale-new-with-range range) - (gtk-scale-new))) +(defmethod gconstructor ((scale scale) &key orientation adjustment + (min 0.0d0) (max 0.0d0) (step 0.0d0) &allow-other-keys) + (if adjustment + (gtk-scale-new orientation adjustment) + (gtk-scale-new-with-range orientation min max step))) + (defslots scale digits :int @@ -24,7 +27,8 @@ (deffuns scale (:get layout pobject) - (add-mark :void (value :double) (position position-type) (markup :string)) + (add-mark :void &key (value :double) + (position position-type) (markup :string)) (clear-marks :void)) (defcfun gtk-scale-get-layout-offsets :void (entry pobject) --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/text-buffer.lisp 2012/08/12 17:42:30 1.9 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/text-buffer.lisp 2012/08/19 16:19:26 1.10 @@ -186,7 +186,7 @@ (create-child-anchor pobject (text-iter pobject)) (create-mark pobject (mark-name :string) (where (struct text-iter)) (left-gravity :boolean)) - (add-mark :void (mark pobject) (where (struct text-iter))) + (add-mark :void &key (mark pobject) (where (struct text-iter))) (:get mark pobject (name :string)) (get-insert pobject) (:get selection-bound pobject) From rklochkov at common-lisp.net Sun Aug 19 16:22:29 2012 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Sun, 19 Aug 2012 09:22:29 -0700 Subject: [gtk-cffi-cvs] CVS gtk-cffi/g-lib Message-ID: Update of /project/gtk-cffi/cvsroot/gtk-cffi/g-lib In directory tiger.common-lisp.net:/tmp/cvs-serv7466/g-lib Modified Files: error.lisp variant.lisp Log Message: Fixed GDK for new CFFI version --- /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/error.lisp 2012/05/07 09:02:04 1.5 +++ /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/error.lisp 2012/08/19 16:22:29 1.6 @@ -32,7 +32,7 @@ (let ((p (mem-ref (pointer g-error) :pointer))) (unless (null-pointer-p p) (with-foreign-slots - ((domain errno message) p g-error) + ((domain errno message) p (:struct g-error)) `(:domain ,domain :errno ,errno :message ,message))))) ;(defmethod print-object ((g-error g-error) stream) --- /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/variant.lisp 2012/07/31 17:57:11 1.3 +++ /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/variant.lisp 2012/08/19 16:22:29 1.4 @@ -37,7 +37,7 @@ (defcfun g-variant-parse :pointer (type variant-type) (text :pointer) (limit :pointer) (end :pointer) - (g-error g-error)) + (g-error (:pointer (:struct g-error)))) (defcfun g-variant-print (:string :free-from-foreign t) (variant :pointer) (annotate :boolean)) From rklochkov at common-lisp.net Sun Aug 19 16:22:30 2012 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Sun, 19 Aug 2012 09:22:30 -0700 Subject: [gtk-cffi-cvs] CVS gtk-cffi/g-object Message-ID: Update of /project/gtk-cffi/cvsroot/gtk-cffi/g-object In directory tiger.common-lisp.net:/tmp/cvs-serv7466/g-object Modified Files: defslots.lisp g-type.lisp Log Message: Fixed GDK for new CFFI version --- /project/gtk-cffi/cvsroot/gtk-cffi/g-object/defslots.lisp 2012/08/12 17:42:30 1.13 +++ /project/gtk-cffi/cvsroot/gtk-cffi/g-object/defslots.lisp 2012/08/19 16:22:30 1.14 @@ -25,6 +25,7 @@ (setter (symbolicate prefix '- current-class '-set- name-gtk))) `(progn (save-setter ,current-class ,name-lisp) + (export ',name-lisp) (defcfun ,getter ,slot-type (object pobject)) (defcfun ,setter :void (widget pobject) (value ,slot-type)) (unless (fboundp ',name-lisp) @@ -65,6 +66,7 @@ (param-list (param-list params)) (cparams (remove '&key params))) `(progn + (export ',name-lisp) (defcfun ,fun-name ,res-type (,class pobject) , at cparams) (unless (fboundp ',name-lisp) (defgeneric ,name-lisp (,class , at param-list))) @@ -92,6 +94,7 @@ (param-list (param-list params)) (cparams (remove '&key params))) `(progn + (export ',name-lisp) ,(unless params `(save-setter ,class ,name-lisp)) ,(if last `(defcfun ,setter :void (widget pobject) --- /project/gtk-cffi/cvsroot/gtk-cffi/g-object/g-type.lisp 2012/08/12 17:42:30 1.8 +++ /project/gtk-cffi/cvsroot/gtk-cffi/g-object/g-type.lisp 2012/08/19 16:22:30 1.9 @@ -50,7 +50,8 @@ (class-size :uint) (instance-size :uint)) -(defcfun g-type-query :void (type g-type) (query g-type-query)) +(defcfun g-type-query :void (type g-type) + (query (:pointer (:struct g-type-query)))) (defun g-type->keyword (num) "Integer (GType) -> keyword from +fundamental-gtypes+" From rklochkov at common-lisp.net Sun Aug 19 16:22:30 2012 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Sun, 19 Aug 2012 09:22:30 -0700 Subject: [gtk-cffi-cvs] CVS gtk-cffi/gdk Message-ID: Update of /project/gtk-cffi/cvsroot/gtk-cffi/gdk In directory tiger.common-lisp.net:/tmp/cvs-serv7466/gdk Modified Files: color.lisp gdk-cffi.asd keys.lisp package.lisp pango.lisp Added Files: drag-drop.lisp Log Message: Fixed GDK for new CFFI version --- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/color.lisp 2012/08/18 13:55:27 1.7 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/color.lisp 2012/08/19 16:22:30 1.8 @@ -45,8 +45,9 @@ (:actual-type :pointer) (:simple-parser prgba)) -(defcfun gdk-rgba-parse :boolean (color rgba-struct) (str :string)) -(defcfun gdk-rgba-to-string :string (color rgba-struct)) +(defcfun gdk-rgba-parse :boolean (color (:pointer (:struct rgba-struct))) + (str :string)) +(defcfun gdk-rgba-to-string :string (color (:pointer (:struct rgba-struct)))) (defcfun gdk-rgba-free :void (color :pointer)) (defmethod free-ptr ((class rgba-cffi) ptr) @@ -54,7 +55,7 @@ (defmethod translate-to-foreign (value (type rgba-cffi)) (if (pointerp value) value - (let ((color-st (foreign-alloc 'rgba-struct))) + (let ((color-st (foreign-alloc '(:pointer (:struct rgba-struct))))) (assert (gdk-rgba-parse color-st (string value)) (value) "Bad RGBA color") color-st))) --- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/gdk-cffi.asd 2012/05/07 09:02:04 1.7 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/gdk-cffi.asd 2012/08/19 16:22:30 1.8 @@ -32,4 +32,5 @@ (:file image :depends-on (visual)) (:file atom :depends-on (loadlib)) (:file pixbuf :depends-on (image gc)) - (:file cairo :depends-on (pixbuf)))) + (:file cairo :depends-on (pixbuf)) + (:file drag-drop :depends-on (package)))) --- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/keys.lisp 2011/09/21 12:03:47 1.6 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/keys.lisp 2012/08/19 16:22:30 1.7 @@ -50,7 +50,7 @@ (level :int)) (defgdkfuns keymap - (lookup-key :uint (key keymap-key)) + (lookup-key :uint (key (:pointer (:struct keymap-key)))) (:get direction pango-cffi:direction) (have-bidi-layouts :boolean) (:get caps-lock-state :boolean) --- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/package.lisp 2012/05/07 09:02:04 1.11 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/package.lisp 2012/08/19 16:22:30 1.12 @@ -56,6 +56,9 @@ #:unichar #:keymap + #:have-bidi-layouts + #:caps-lock-state + #:num-lock-state #:keycode #:group #:level @@ -75,6 +78,8 @@ #:cairo-create #:cairo-set-source-pixbuf + + #:drag-action )) (in-package #:gdk-cffi) --- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/pango.lisp 2012/08/12 17:42:30 1.8 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/pango.lisp 2012/08/19 16:22:30 1.9 @@ -174,11 +174,11 @@ (end-index :uint)) (defcstruct attr-string - (attr attribute) + (attr (:struct attribute)) (value :string)) (defcstruct attr-language - (attr attribute) + (attr (:struct attribute)) (value language)) (defcstruct color @@ -187,19 +187,19 @@ (blue :uint16)) (defcstruct attr-color - (attr attribute) - (value color)) + (attr (:struct attribute)) + (value (:struct color))) (defcstruct attr-int - (attr attribute) + (attr (:struct attribute)) (value :int)) (defcstruct attr-float - (attr attribute) + (attr (:struct attribute)) (value :float)) (defcstruct attr-font-desc - (attr attribute) + (attr (:struct attribute)) (value font)) (defcstruct rectangle @@ -207,20 +207,20 @@ (width :int) (height :int)) (defcstruct attr-shape - (attr attribute) - (ink rectangle) - (logical rectangle) + (attr (:struct attribute)) + (ink (:struct rectangle)) + (logical (:struct rectangle)) (data :pointer) (copy-func :pointer) (destroy-func :pointer)) (defcstruct attr-size - (attr attribute) + (attr (:struct attribute)) (size :int) (absolute :uint)) (defun rect->list (rect) - (with-foreign-slots ((x y width height) rect rectangle) + (with-foreign-slots ((x y width height) rect (:struct rectangle)) (list x y width height))) (eval-when (:compile-toplevel :load-toplevel) @@ -243,32 +243,36 @@ (defun translate-to-enum (type value) (case type ((:style :weight :variant :stretch :underline :gravity :gravity-hint) - (convert-from-foreign value (intern (symbol-name type) #.*package*))) + (convert-from-foreign + value `(:struct ,(intern (symbol-name type) #.*package*)))) ((:strikethrough :fallback) (convert-from-foreign value :boolean)) (t value))) (defun attr->list (attr) - (let* ((type (mem-ref (foreign-slot-value attr 'attribute 'klass) + (let* ((type (mem-ref (foreign-slot-value attr '(:struct attribute) 'klass) 'attr-type)) (tail-type (attr->type type))) - (with-foreign-slots ((start-index end-index) attr attribute) + (with-foreign-slots ((start-index end-index) attr (:struct attribute)) (list* type start-index end-index (ecase tail-type ((attr-language attr-string attr-font-desc attr-float) - (list (foreign-slot-value attr tail-type 'value))) + (list (foreign-slot-value attr `(:struct ,tail-type) 'value))) (attr-int (list (translate-to-enum type - (foreign-slot-value attr tail-type 'value)))) + (foreign-slot-value attr `(:struct ,tail-type) + 'value)))) (attr-color (with-foreign-slots ((red green blue) - (foreign-slot-value attr 'attr-color 'value) - color) + (foreign-slot-value attr + '(:struct attr-color) + 'value) + (:struct color)) (list red green blue))) (attr-size (list (foreign-slot-value attr tail-type 'size))) (attr-shape - (with-foreign-slots ((ink logical) attr attr-shape) + (with-foreign-slots ((ink logical) attr (:struct attr-shape)) (list (rect->list ink) (rect->list logical))))))))) @@ -285,15 +289,16 @@ ((:strikethrough :fallback) :boolean) (:scale :double) (t (intern (symbol-name type) #.*package*))))) - `(defcfun ,(symbolicate 'pango-attr- attr '-new) ,(attr->type attr) - (value ,(in-type attr))))) + `(defcfun ,(symbolicate 'pango-attr- attr '-new) + (:pointer (:struct ,(attr->type attr))) (value ,(in-type attr))))) (template attr (:foreground :background :strikethrough-color :underline-color) - `(defcfun ,(symbolicate 'pango-attr- attr '-new) attr-color - (red :uint16) (green :uint16) (blue :uint16))) + `(defcfun ,(symbolicate 'pango-attr- attr '-new) + (:pointer (:struct attr-color)) (red :uint16) (green :uint16) + (blue :uint16))) (defcfun ("pango_attr_size_new_absolute" pango-attr-absolute-size-new) - attr-size (size :int)) + (:pointer (:struct attr-size)) (size :int)) (define-foreign-type rect-list (freeable) () @@ -301,8 +306,8 @@ (:actual-type :pointer)) (defmethod translate-to-foreign (value (type rect-list)) - (let ((ptr (foreign-alloc 'rectangle))) - (with-foreign-slots ((x y width height) ptr rectangle) + (let ((ptr (foreign-alloc '(:pointer (:struct rectangle))))) + (with-foreign-slots ((x y width height) ptr (:struct rectangle)) (destructuring-bind (new-x new-y new-width new-height) value (setf x new-x y new-y @@ -311,7 +316,8 @@ ptr)) -(defcfun pango-attr-shape-new attr-shape (ink rect-list) (logical rect-list)) +(defcfun pango-attr-shape-new (:pointer (:struct attr-shape)) + (ink rect-list) (logical rect-list)) (define-foreign-type attr-list (freeable) ((free-from-foreign :initform t)) @@ -356,8 +362,10 @@ 'pango-attr- x '-new)))) (cdr (foreign-enum-keyword-list 'attr-type))))) params))) - (setf (foreign-slot-value ptr 'attribute 'start-index) start-index - (foreign-slot-value ptr 'attribute 'end-index) end-index) + (setf (foreign-slot-value ptr '(:struct attribute) + 'start-index) start-index + (foreign-slot-value ptr '(:struct attribute) + 'end-index) end-index) ptr))) --- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/drag-drop.lisp 2012/08/19 16:22:30 NONE +++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/drag-drop.lisp 2012/08/19 16:22:30 1.1 (in-package :gdk-cffi) (defbitfield drag-action :default :copy :move :link :private :ask) From rklochkov at common-lisp.net Sun Aug 19 16:22:30 2012 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Sun, 19 Aug 2012 09:22:30 -0700 Subject: [gtk-cffi-cvs] CVS gtk-cffi/utils Message-ID: Update of /project/gtk-cffi/cvsroot/gtk-cffi/utils In directory tiger.common-lisp.net:/tmp/cvs-serv7466/utils Modified Files: utils.lisp Log Message: Fixed GDK for new CFFI version --- /project/gtk-cffi/cvsroot/gtk-cffi/utils/utils.lisp 2012/02/20 16:51:38 1.5 +++ /project/gtk-cffi/cvsroot/gtk-cffi/utils/utils.lisp 2012/08/19 16:22:30 1.6 @@ -39,6 +39,11 @@ ,(make-keyword flag))))))) (defmacro template (vars args &body body) + "Universal template macro. For every ARG in ARGS binded to VARS generates +body. ARGS is list. If VARS also list, then every element in ARGS is +a list of the same length. + BODY of template should be as of DEFMACRO. +It should return list (resulting program chunk)." (with-gensyms (%do %vars) (cond ((null vars) From rklochkov at common-lisp.net Tue Aug 21 19:48:02 2012 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Tue, 21 Aug 2012 12:48:02 -0700 Subject: [gtk-cffi-cvs] CVS gtk-cffi/gtk Message-ID: Update of /project/gtk-cffi/cvsroot/gtk-cffi/gtk In directory tiger.common-lisp.net:/tmp/cvs-serv19056/gtk Modified Files: entry.lisp gtk-cffi.asd package.lisp scale.lisp text-buffer.lisp Added Files: spin-button.lisp Log Message: Summary: Added GtkSpinButton, GtkEditable --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/entry.lisp 2012/08/19 15:45:26 1.7 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/entry.lisp 2012/08/21 19:48:02 1.8 @@ -1,11 +1,43 @@ ;;; -;;; entry.lisp -- GtkEntry, GtkEntryBuffer +;;; entry.lisp -- GtkEditable, GtkEntry, GtkEntryBuffer, GtkEntryCompletion ;;; ;;; Copyright (C) 2012, Roman Klochkov ;;; (in-package :gtk-cffi) +(defclass editable (object) + ()) + +(defslots editable + (editable-position . position) :int + (is-editable . editable) :boolean) + +(deffuns editable + (select-region :void (start :int) (end :int)) + (delete-text :void (start :int) (end :int)) + (:get chars :string (start :int) (end :int)) + (cut-clipboard :void &key) + (copy-clipboard :void &key) + (paste-clipboard :void &key) + (delete-selection :void &key)) + +(init-slots editable) + +(defcfun gtk-editable-get-selection-bounds :void (editable pobject) + (start :pointer) (end :pointer)) + +(defmethod selection-bounds ((editable editable) &key) + (with-foreign-outs-list ((start :int) (end :int)) :ignore + (gtk-editable-get-selection-bounds editable start end))) + +(defcfun gtk-editable-insert-text :uint (editable pobject) + (new-text :string) (new-text-length :int) (position :uint)) + +(defgeneric insert-text (editable position text) + (:method ((editable editable) position text) + (gtk-editable-insert-text editable text (length text) position))) + (defclass entry-buffer (g-object) ()) @@ -23,15 +55,14 @@ (:set text :string &key) (:get bytes :int) ((entry-buffer-length . get-length) :uint) - (delete-text :uint (poistion :uint) (n-chars :int)) + (delete-text :uint (position :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)))) +(defmethod insert-text ((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)) @@ -93,7 +124,7 @@ (init-slots entry-completion) -(defclass entry (widget) +(defclass entry (widget editable) ()) (defcfun gtk-entry-new :pointer) --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/gtk-cffi.asd 2012/08/19 15:45:26 1.25 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/gtk-cffi.asd 2012/08/21 19:48:02 1.26 @@ -525,6 +525,15 @@ :components ((:file scale))) +(defsystem gtk-cffi-spin-button + :description "Interface to GTK/Glib via CFFI" + :author "Roman Klochkov " + :version "0.99" + :license "LLGPL" + :depends-on (gtk-cffi-entry) + :components + ((:file spin-button))) + (defsystem gtk-cffi :description "Interface to GTK/Glib via CFFI" @@ -535,7 +544,7 @@ gtk-cffi-file-chooser-dialog gtk-cffi-file-chooser-button gtk-cffi-progress-bar - gtk-cffi-entry + gtk-cffi-spin-button gtk-cffi-color-button gtk-cffi-label gtk-cffi-paned --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/package.lisp 2012/08/19 16:19:26 1.27 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/package.lisp 2012/08/21 19:48:02 1.28 @@ -368,6 +368,12 @@ #:logo #:logo-icon-name + #:editable + ;; slots + #:chars + #:editable-position + #:is-editable + #:entry-completion ;; slots #:text-column @@ -1055,6 +1061,17 @@ #:has-origin ;; methods #:clear-marks + + #:spin-button + ;; slots + #:numeric + #:update-policy + #:wrap + #:snap-to-ticks + ;; methods + #:value-as-int + #:update + #:spin )) (in-package #:gtk-cffi) --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/scale.lisp 2012/08/19 16:19:26 1.2 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/scale.lisp 2012/08/21 19:48:02 1.3 @@ -39,4 +39,3 @@ (gtk-scale-get-layout-offsets scale x y))) (init-slots scale) - \ No newline at end of file --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/text-buffer.lisp 2012/08/19 16:19:26 1.10 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/text-buffer.lisp 2012/08/21 19:48:02 1.11 @@ -1,3 +1,8 @@ +;;; +;;; text-buffer.lisp -- GtkTextTagTable, GtkTextBuffer +;;; +;;; Copyright (C) 2012, Roman Klochkov +;;; (in-package :gtk-cffi) (defclass text-tag-table (g-object) @@ -76,7 +81,7 @@ (is-cursor-position :boolean) (:get chars-in-line :int) (:get bytes-in-line :int) - (get-attributes :boolean (struct text-attributes :out t)) + (get-attributes :boolean (attrib (struct text-attributes :out t))) (:get language pango-cffi:language) (is-end :boolean) (is-start :boolean) @@ -195,11 +200,12 @@ (select-range :void (ins (struct text-iter)) (bound (struct text-iter))) (remove-all-tags :void (start (struct text-iter)) (end (struct text-iter))) - (delete-selection :boolean (interactive :boolean) (default-editable :boolean)) - (paste-clipboard :void (clipboard pobject) (location pobject) + (delete-selection :boolean &key (interactive :boolean) + (default-editable :boolean)) + (paste-clipboard :void &key (clipboard pobject) (location pobject) (default-editable :boolean)) - (copy-clipboard :void (clipboard pobject)) - (cut-clipboard :void (clipboard pobject) (default-editable :boolean)) + (copy-clipboard :void &key (clipboard pobject)) + (cut-clipboard :void &key (clipboard pobject) (default-editable :boolean)) (begin-user-action :void) (end-user-action :void) (add-selection-clipboard :void (clipboard pobject)) @@ -438,7 +444,8 @@ (defcfun gtk-text-buffer-deserialize :boolean (register-buffer pobject) (content-buffer pobject) (format gatom) - (text-iter pobject) (data (garray :uint8)) (length :int) (err g-error)) + (text-iter pobject) (data (garray :uint8)) (length :int) + (err (:pointer (:struct g-error)))) (define-condition deserialize-warning (warning) ((g-error :initarg g-error)) @@ -496,7 +503,8 @@ ((register-buffer pobject) (content-buffer pobject) (iter (object text-buffer)) ;; object saves pointer, struct -- doesn't (array-data :pointer) (length :ulong) - (create-tags :boolean) (user-data pdata) (g-error g-error)) + (create-tags :boolean) (user-data pdata) + (g-error (:pointer (:struct g-error)))) (destructuring-bind (func data data-destroy) user-data (declare (ignore data-destroy)) (funcall func register-buffer content-buffer iter --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/spin-button.lisp 2012/08/21 19:48:02 NONE +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/spin-button.lisp 2012/08/21 19:48:02 1.1 ;;; ;;; spin-button.lisp -- GtkSpinButton ;;; ;;; Copyright (C) 2012, Roman Klochkov ;;; (in-package :gtk-cffi) (defclass spin-button (entry) ()) (defcfun gtk-spin-button-new :pointer (adjustment pobject) (climb-rate :double) (digits :uint)) (defcfun gtk-spin-button-new-with-range :pointer (min :double) (max :double) (step :double)) (defmethod gconstructor ((spin-button spin-button) &key adjustment climb-rate digits (min 0.0d0) (max 0.0d0) (step 0.0d0) &allow-other-keys) (initialize spin-button '(adjustment digits)) (if adjustment (gtk-spin-button-new adjustment climb-rate digits) (gtk-spin-button-new-with-range min max step))) (defcfun gtk-spin-button-configure :void (spin-button pobject) (adjustment pobject) (climb-rate :double) (digits :uint)) (defmethod reinitialize-instance ((spin-button spin-button) &key adjustment climb-rate digits) (gtk-spin-button-configure spin-button adjustment climb-rate digits)) (defcenum spin-button-update-policy :always :if-valid) (defcenum spin-type :step-forward :step-backward :page-forward :page-backward :home :end :user-defined) (defslots spin-button adjustment pobject digits :int value :double update-policy spin-button-update-policy numeric :boolean wrap :boolean snap-to-ticks :boolean) (deffuns spin-button (spin :void (direction spin-type) (increment :double)) (update :void) (:get value-as-int :int)) (defcfun gtk-spin-button-set-increments :void (spin-button pobject) (step :double) (page :double)) (defcfun gtk-spin-button-get-increments :void (spin-button pobject) (step :pointer) (page :pointer)) (defgeneric increments (spin-button) (:method ((spin-button spin-button)) (with-foreign-outs-list ((step :double) (page :double)) :ignore (gtk-spin-button-get-increments spin-button step page)))) (defgeneric (setf increments) (value spin-button) (:method (value (spin-button spin-button)) (destructuring-bind (step page) value (gtk-spin-button-set-increments spin-button step page)))) (save-setter spin-button increments) (defcfun gtk-spin-button-set-range :void (spin-button pobject) (min :double) (max :double)) (defcfun gtk-spin-button-get-range :void (spin-button pobject) (min :pointer) (max :pointer)) (defgeneric range (spin-button) (:method ((spin-button spin-button)) (with-foreign-outs-list ((min :double) (max :double)) :ignore (gtk-spin-button-get-range spin-button min max)))) (defgeneric (setf range) (value spin-button) (:method (value (spin-button spin-button)) (destructuring-bind (min max) value (gtk-spin-button-set-range spin-button min max)))) (save-setter spin-button range) (init-slots spin-button) From rklochkov at common-lisp.net Wed Aug 22 19:00:13 2012 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Wed, 22 Aug 2012 12:00:13 -0700 Subject: [gtk-cffi-cvs] CVS gtk-cffi/gtk Message-ID: Update of /project/gtk-cffi/cvsroot/gtk-cffi/gtk In directory tiger.common-lisp.net:/tmp/cvs-serv10863 Modified Files: gtk-cffi.asd text-buffer.lisp text-tag.lisp text-view.lisp Added Files: scrollable.lisp Log Message: Added GtkScrollable --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/gtk-cffi.asd 2012/08/21 19:48:02 1.26 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/gtk-cffi.asd 2012/08/22 19:00:13 1.27 @@ -31,6 +31,7 @@ (:file buildable :depends-on (loadlib)) (:file builder :depends-on (loadlib)) (:file color-chooser :depends-on (loadlib)) + (:file scrollable :depends-on (loadlib)) (:file adjustment :depends-on (loadlib)))) (defsystem gtk-cffi-widget @@ -308,7 +309,7 @@ (defsystem gtk-cffi-text-buffer :description "Interface to GTK/Glib via CFFI" :author "Roman Klochkov " - :version "0.1" + :version "0.99" :license "LLGPL" :depends-on (gtk-cffi-core) :components --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/text-buffer.lisp 2012/08/21 19:48:02 1.11 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/text-buffer.lisp 2012/08/22 19:00:13 1.12 @@ -1,5 +1,5 @@ ;;; -;;; text-buffer.lisp -- GtkTextTagTable, GtkTextBuffer +;;; text-buffer.lisp -- GtkTextTagTable, GtkTextIter, GtkTextBuffer ;;; ;;; Copyright (C) 2012, Roman Klochkov ;;; @@ -43,7 +43,7 @@ (defmethod free-struct ((class (eql 'text-iter)) value) (gtk-text-iter-free value)) -(defgtkslots text-iter +(defslots text-iter line :int offset :int line-offset :int @@ -54,7 +54,7 @@ (defbitfield text-search-flags :visible-only :text-only :case-insensitive) -(defgtkfuns text-iter +(deffuns text-iter ((text-iter-char . get-char) unichar) (:get slice :string (end pobject)) ((text-iter-text . get-text) :string (end pobject)) @@ -174,15 +174,15 @@ &key tag-table &allow-other-keys) (gtk-text-buffer-new tag-table)) -(defgtkslots text-buffer +(defslots text-buffer modified :boolean) (defcenum text-buffer-target-info - (:buffer-ocntent -1) + (:buffer-content -1) (:rich-text -2) (:info-text -3)) -(defgtkfuns text-buffer +(deffuns text-buffer (:get line-count :int) (:get char-count :int) (:get tag-table pobject) --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/text-tag.lisp 2011/09/21 12:03:47 1.4 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/text-tag.lisp 2012/08/22 19:00:13 1.5 @@ -10,9 +10,6 @@ (defcenum wrap-mode :none :char :word :word-char) -(defclass text-appearance (struct) - ()) - (defcstruct* text-appearance (bg-color pcolor) (fg-color pcolor) @@ -27,9 +24,6 @@ (is-text :boolean 1)) -(defclass text-attributes (struct) - ()) - (defcstruct* text-attributes (appearance (struct text-appearance)) (justification justification) --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/text-view.lisp 2012/02/20 16:51:37 1.5 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/text-view.lisp 2012/08/22 19:00:13 1.6 @@ -1,14 +1,22 @@ +;;;; -*- Mode: lisp; indent-tabs-mode: nil -*- +;;; +;;; text-view.lisp --- GtkTextView +;;; +;;; Copyright (C) 2012, Roman Klochkov +;;; + (in-package :gtk-cffi) -(defclass text-view (container) +(defclass text-view (container scrollable) ()) -(defcfun "gtk_text_view_new_with_buffer" :pointer (buffer pobject)) +(defcfun gtk-text-view-new-with-buffer :pointer (buffer pobject)) -(defcfun "gtk_text_view_new" :pointer) +(defcfun gtk-text-view-new :pointer) (defmethod gconstructor ((text-view text-view) &key buffer &allow-other-keys) + (initialize text-view 'buffer) (if buffer (gtk-text-view-new-with-buffer buffer) (gtk-text-view-new))) @@ -17,7 +25,7 @@ :private :widget :text :left :right :top :bottom) -(defgtkslots text-view +(defslots text-view buffer pobject wrap-mode wrap-mode editable :boolean @@ -32,10 +40,9 @@ indent :int tabs pango-cffi:tab-array accepts-tab :boolean) -(remove-setter text-view buffer) ; already in gconstructor -(defgtkfuns text-view +(deffuns text-view (scroll-to-mark :void (text-mark pobject) (within-margin :double) (use-align :boolean) (xalign :double) (yalign :double)) --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/scrollable.lisp 2012/08/22 19:00:14 NONE +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/scrollable.lisp 2012/08/22 19:00:14 1.1 ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*- ;;; ;;; text-view.lisp --- GtkTextView ;;; ;;; Copyright (C) 2012, Roman Klochkov ;;; (in-package :gtk-cffi) (defclass scrollable (object) ()) (defcenum scrollable-policy (:minimum 0) :natural) (defslots scrollable hadjustment pobject vadjustment pobject hscroll-policy scrollable-policy vscroll-policy scrollable-policy) (init-slots scrollable) From rklochkov at common-lisp.net Fri Aug 24 19:27:54 2012 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Fri, 24 Aug 2012 12:27:54 -0700 Subject: [gtk-cffi-cvs] CVS gtk-cffi/g-lib Message-ID: Update of /project/gtk-cffi/cvsroot/gtk-cffi/g-lib In directory tiger.common-lisp.net:/tmp/cvs-serv31128/g-lib Modified Files: array.lisp list.lisp variant.lisp Log Message: Fixed CFFI-OBJECTS:FREE-PTR generic usage (now specialized with EQL) --- /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/array.lisp 2012/08/12 17:42:29 1.9 +++ /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/array.lisp 2012/08/24 19:27:54 1.10 @@ -17,7 +17,7 @@ (defcfun g-free :void (var :pointer)) (defcfun g-malloc :pointer (n-bytes :int)) -(defmethod free-ptr ((type g-lib-array) ptr) +(defmethod free-ptr ((type (eql 'g-lib-array)) ptr) (g-free ptr)) (define-foreign-type g-lib-string (freeable) @@ -34,5 +34,5 @@ (defmethod translate-from-foreign (value (type g-lib-string)) (foreign-string-to-lisp value)) -(defmethod free-ptr ((type g-lib-string) ptr) +(defmethod free-ptr ((type (eql 'g-lib-string)) ptr) (g-free ptr)) \ No newline at end of file --- /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/list.lisp 2012/08/12 17:42:29 1.8 +++ /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/list.lisp 2012/08/24 19:27:54 1.9 @@ -41,7 +41,7 @@ (:simple-parser g-list) (:actual-type :pointer)) -(defmethod free-ptr ((type g-list) ptr) +(defmethod free-ptr ((type (eql 'g-list)) ptr) (g-list-free ptr)) (defmethod translate-from-foreign (ptr (g-list g-list)) @@ -80,7 +80,7 @@ (defcfun g-slist-reverse :pointer (g-slist :pointer)) -(defmethod free-ptr ((type g-slist) ptr) +(defmethod free-ptr ((type (eql 'g-slist)) ptr) (g-slist-free ptr)) (defmethod translate-from-foreign (ptr (g-slist g-slist)) @@ -110,7 +110,7 @@ (defcfun g-strfreev :void (ptr :pointer)) -(defmethod free-ptr ((type string-list) ptr) +(defmethod free-ptr ((type (eql 'string-list)) ptr) (g-strfreev ptr)) (defmethod translate-from-foreign (ptr (type string-list)) --- /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/variant.lisp 2012/08/19 16:22:29 1.4 +++ /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/variant.lisp 2012/08/24 19:27:54 1.5 @@ -17,7 +17,7 @@ (defcfun g-variant-type-free :void (ptr :pointer)) (defcfun g-variant-type-get-string-length gsize (ptr :pointer)) -(defmethod free-ptr ((type variant-type) ptr) +(defmethod free-ptr ((type (eql 'variant-type)) ptr) (g-variant-type-free ptr)) (defmethod translate-from-foreign (ptr (type variant-type)) @@ -44,7 +44,7 @@ (defcfun g-variant-unref :void (variant :pointer)) -(defmethod free-ptr ((type variant) ptr) +(defmethod free-ptr ((type (eql 'variant)) ptr) (g-variant-unref ptr)) (defmethod translate-from-foreign (ptr (type variant-type)) From rklochkov at common-lisp.net Fri Aug 24 19:27:54 2012 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Fri, 24 Aug 2012 12:27:54 -0700 Subject: [gtk-cffi-cvs] CVS gtk-cffi/g-object Message-ID: Update of /project/gtk-cffi/cvsroot/gtk-cffi/g-object In directory tiger.common-lisp.net:/tmp/cvs-serv31128/g-object Modified Files: g-value.lisp pobject.lisp Log Message: Fixed CFFI-OBJECTS:FREE-PTR generic usage (now specialized with EQL) --- /project/gtk-cffi/cvsroot/gtk-cffi/g-object/g-value.lisp 2012/08/18 13:55:27 1.6 +++ /project/gtk-cffi/cvsroot/gtk-cffi/g-object/g-value.lisp 2012/08/24 19:27:54 1.7 @@ -157,9 +157,9 @@ (unless (null-pointer-p value) (let* ((g-type (type-g-value value)) (fundamental-type (g-type-fundamental g-type))) - ;(format t "g-val:~a ~a ~a~%" g-type fundamental-type - ; (g-type->lisp g-type)) - (case fundamental-type +; (format t "g-val:~a ~a ~a~%" g-type fundamental-type +; (g-type->lisp g-type)) + (let ((res (case fundamental-type (#.(keyword->g-type :boxed) (find-object (g-value-get-boxed value) (g-type->lisp g-type))) @@ -173,7 +173,11 @@ (g-value-get-object value)) (t (funcall (select-accessor - fundamental-type :g-value-get-) value))))))) + fundamental-type :g-value-get-) value))))) + ;(format t "g-val value:~a~%" res) + res))))) + + (defmethod value ((g-value g-value)) (let ((l --- /project/gtk-cffi/cvsroot/gtk-cffi/g-object/pobject.lisp 2012/08/12 17:42:30 1.9 +++ /project/gtk-cffi/cvsroot/gtk-cffi/g-object/pobject.lisp 2012/08/24 19:27:54 1.10 @@ -59,7 +59,7 @@ (:documentation "PDATA lets send any data via a c-pointer. C-pointer used as an id for the data. NB! Don't forget to free pointers after use.")) -(defmethod free-ptr ((type cffi-pdata) object) +(defmethod free-ptr ((type (eql 'cffi-pdata)) object) ; it's not typo: ;we free object, not pointer (free object)) From rklochkov at common-lisp.net Fri Aug 24 19:27:54 2012 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Fri, 24 Aug 2012 12:27:54 -0700 Subject: [gtk-cffi-cvs] CVS gtk-cffi/gdk Message-ID: Update of /project/gtk-cffi/cvsroot/gtk-cffi/gdk In directory tiger.common-lisp.net:/tmp/cvs-serv31128/gdk Modified Files: color.lisp event.lisp pango.lisp Log Message: Fixed CFFI-OBJECTS:FREE-PTR generic usage (now specialized with EQL) --- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/color.lisp 2012/08/19 16:22:30 1.8 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/color.lisp 2012/08/24 19:27:54 1.9 @@ -9,8 +9,7 @@ (defcfun gdk-color-parse :boolean (str :string) (color (:pointer (:struct color-struct)))) -(defcfun gdk-color-to-string :string - (color (:pointer (:struct color-struct)))) +(defcfun gdk-color-to-string :string (color (:pointer (:struct color-struct)))) (defcfun gdk-color-free :void (color :pointer)) (define-foreign-type color-cffi (freeable) @@ -18,7 +17,7 @@ (:actual-type :pointer) (:simple-parser pcolor)) -(defmethod free-ptr ((class color-cffi) ptr) +(defmethod free-ptr ((class (eql 'color-cffi)) ptr) (gdk-color-free ptr)) (defmethod translate-to-foreign (value (type color-cffi)) @@ -50,7 +49,7 @@ (defcfun gdk-rgba-to-string :string (color (:pointer (:struct rgba-struct)))) (defcfun gdk-rgba-free :void (color :pointer)) -(defmethod free-ptr ((class rgba-cffi) ptr) +(defmethod free-ptr ((class (eql 'rgba-cffi)) ptr) (gdk-rgba-free ptr)) (defmethod translate-to-foreign (value (type rgba-cffi)) --- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/event.lisp 2011/09/11 15:48:21 1.3 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/event.lisp 2012/08/24 19:27:54 1.4 @@ -348,7 +348,7 @@ (t 'event-any)))) (defmethod get-slot ((event event) field) - (foreign-slot-value (pointer event) (event-type event) + (foreign-slot-value (pointer event) (list :struct (event-type event)) (find-symbol (string field) :gdk-cffi))) (defun parse-event (ev-pointer field) --- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/pango.lisp 2012/08/19 16:22:30 1.9 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/pango.lisp 2012/08/24 19:27:54 1.10 @@ -34,7 +34,7 @@ (:actual-type :pointer) (:simple-parser font)) -(defmethod free-ptr ((type font) ptr) +(defmethod free-ptr ((type (eql 'font)) ptr) (pango-font-description-free ptr)) (defmethod translate-to-foreign (value (type font)) @@ -115,7 +115,7 @@ (defcfun pango-tab-array-get-positions-in-pixels :boolean (tab-array :pointer)) (defcfun pango-tab-array-free :void (tab-array :pointer)) -(defmethod free-ptr ((type tab-array) ptr) +(defmethod free-ptr ((type (eql 'tab-array)) ptr) (pango-tab-array-free ptr)) @@ -333,7 +333,7 @@ (defcfun pango-attr-list-filter :pointer (ptr :pointer) (func :pointer) (data :pointer)) -(defmethod free-ptr ((type attr-list) ptr) +(defmethod free-ptr ((type (eql 'attr-list)) ptr) (pango-attr-list-unref ptr)) (defvar *attr-list* nil) From rklochkov at common-lisp.net Fri Aug 24 19:27:54 2012 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Fri, 24 Aug 2012 12:27:54 -0700 Subject: [gtk-cffi-cvs] CVS gtk-cffi/gtk Message-ID: Update of /project/gtk-cffi/cvsroot/gtk-cffi/gtk In directory tiger.common-lisp.net:/tmp/cvs-serv31128/gtk Modified Files: gtk-cffi.asd text-buffer.lisp text-tag.lisp text-view.lisp tree-model.lisp Log Message: Fixed CFFI-OBJECTS:FREE-PTR generic usage (now specialized with EQL) --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/gtk-cffi.asd 2012/08/22 19:00:13 1.27 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/gtk-cffi.asd 2012/08/24 19:27:54 1.28 @@ -319,7 +319,7 @@ (defsystem gtk-cffi-text-view :description "Interface to GTK/Glib via CFFI" :author "Roman Klochkov " - :version "0.1" + :version "0.99" :license "LLGPL" :depends-on (gtk-cffi-text-buffer) :components --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/text-buffer.lisp 2012/08/22 19:00:13 1.12 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/text-buffer.lisp 2012/08/24 19:27:54 1.13 @@ -14,7 +14,7 @@ &allow-other-keys) (gtk-text-tag-table-new)) -(defgtkfuns text-tag-table +(deffuns text-tag-table (add :void (tag pobject)) ((text-tag-table-remove . remove) :void (tag pobject)) (lookup pobject (name :string)) @@ -38,10 +38,10 @@ (u13 :int) (u14 :pointer)) -(defcfun gtk-text-iter-free :void (iter pobject)) +;(defcfun gtk-text-iter-free :void (iter pobject)) -(defmethod free-struct ((class (eql 'text-iter)) value) - (gtk-text-iter-free value)) +;(defmethod free-struct ((class (eql 'text-iter)) value) +; (gtk-text-iter-free value)) (defslots text-iter line :int --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/text-tag.lisp 2012/08/22 19:00:13 1.5 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/text-tag.lisp 2012/08/24 19:27:54 1.6 @@ -1,3 +1,9 @@ +;;;; -*- Mode: lisp; indent-tabs-mode: nil -*- +;;; +;;; text-tag.lisp --- GtkTextTag +;;; +;;; Copyright (C) 2012, Roman Klochkov +;;; (in-package :gtk-cffi) (defclass text-tag (g-object) --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/text-view.lisp 2012/08/22 19:00:13 1.6 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/text-view.lisp 2012/08/24 19:27:54 1.7 @@ -1,6 +1,6 @@ ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*- ;;; -;;; text-view.lisp --- GtkTextView +;;; text-view.lisp --- GtkTextView, GtkTextChildAnchor ;;; ;;; Copyright (C) 2012, Roman Klochkov ;;; --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/tree-model.lisp 2012/08/12 17:42:30 1.13 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/tree-model.lisp 2012/08/24 19:27:54 1.14 @@ -1,6 +1,13 @@ +;;;; -*- Mode: lisp; indent-tabs-mode: nil -*- +;;; +;;; tree-model.lisp --- GtkTreeModel, GtkTreePath, GtkTreeIter, +;;; GtkTreeRowReference +;;; +;;; Copyright (C) 2012, Roman Klochkov +;;; (in-package #:gtk-cffi) -;; I think, that tree-path as pointer is not useful on Lisp side +;; I think, that tree-path as a pointer is not useful on Lisp side ;; so it will be represented as a lisp array (defcfun gtk-tree-path-new :pointer) @@ -41,30 +48,30 @@ (defmethod translate-to-foreign ((value string) (tree-path tree-path)) (gtk-tree-path-new-from-string value)) -(defmethod free-ptr ((tree-path tree-path) ptr) +(defmethod free-ptr ((tree-path (eql 'tree-path)) ptr) (gtk-tree-path-free ptr)) -(defclass tree-row (object) +(defclass tree-row-reference (object) ()) -(defcfun "gtk_tree_row_reference_new" - :pointer (model pobject) (path pobject)) +(defcfun gtk-tree-row-reference-new :pointer (model pobject) (path tree-path)) -(defcfun "gtk_tree_row_reference_free" - :void (row pobject)) +(defcfun gtk-tree-row-reference-free :void (row pobject)) -(defmethod gconstructor ((tree-row tree-row) +(defmethod gconstructor ((tree-row-reference tree-row-reference) &key model path &allow-other-keys) (gtk-tree-row-reference-new model path)) -(defmethod free :before ((tree-row tree-row)) - (gtk-tree-row-reference-free tree-row)) +(defmethod free-ptr ((class (eql 'tree-row-reference)) ptr) + (gtk-tree-row-reference-free ptr)) -(defcfun "gtk_tree_row_reference_copy" (object tree-row) (row pobject)) - -(defmethod copy ((tree-row tree-row)) - (gtk-tree-row-reference-copy tree-row)) +(deffuns tree-row-reference + (copy (object tree-row-reference)) + (:get model pobject) + (:get path tree-path) + (valid :boolean)) + (defcstruct* tree-iter "GtkTreeIter" @@ -73,30 +80,6 @@ (u2 :pointer) (u3 :pointer)) -;(defclass tree-iter (object) -; ()) - -;(defmethod gconstructor ((tree-iter tree-iter) -; &key &allow-other-keys) -; (foreign-alloc 'tree-iter-struct)) - -;(defmethod copy ((tree-iter tree-iter)) -; (let* ((res (make-instance 'tree-iter)) -; (ptr (pointer tree-iter)) -; (new-ptr (pointer res))) -; (mapc (lambda (x) -; (setf (foreign-slot-value new-ptr 'tree-iter-struct x) -; (foreign-slot-value ptr 'tree-iter-struct x))) -; (foreign-slot-names 'tree-iter-struct)) -; res)) - -(defcfun "gtk_tree_iter_free" :void (iter pobject)) - -;(defmethod free-struct ((class (eql 'tree-iter)) value) -; (gtk-tree-iter-free value)) - -;(defmethod free :before ((tree-iter tree-iter)) -; (gtk-tree-iter-free tree-iter)) (defclass tree-model (object) ((columns :accessor columns :initarg :columns)