[gtk-cffi-cvs] CVS gtk-cffi/g-lib
CVS User rklochkov
rklochkov at common-lisp.net
Fri Aug 26 17:16:13 UTC 2011
Update of /project/gtk-cffi/cvsroot/gtk-cffi/g-lib
In directory tiger.common-lisp.net:/tmp/cvs-serv16215/g-lib
Modified Files:
g-lib-cffi.asd list.lisp package.lisp quark.lisp
Added Files:
array.lisp file.lisp
Log Message:
Added GTK3 support. Dropped GTK2 support.
Refactored CFFI layer.
--- /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/g-lib-cffi.asd 2011/04/25 19:16:07 1.1.1.1
+++ /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/g-lib-cffi.asd 2011/08/26 17:16:13 1.2
@@ -16,9 +16,11 @@
:license "BSD"
:depends-on (cffi-object)
:components
- ((:file :package)
- (:file :loadlib :depends-on (:package))
- (:file :list :depends-on (:loadlib))
- (:file :quark :depends-on (:loadlib))
- (:file :error :depends-on (:quark))
- (:file :mainloop :depends-on (:loadlib))))
\ No newline at end of file
+ ((:file package)
+ (:file loadlib :depends-on (package))
+ (:file list :depends-on (loadlib))
+ (:file quark :depends-on (loadlib))
+ (:file array :depends-on (loadlib))
+ (:file error :depends-on (quark))
+ (:file file :depends-on (loadlib))
+ (:file mainloop :depends-on (loadlib))))
\ No newline at end of file
--- /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/list.lisp 2011/08/08 15:02:01 1.2
+++ /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/list.lisp 2011/08/26 17:16:13 1.3
@@ -11,44 +11,58 @@
;; I don't see where one can use GList as is. So there is no such class.
;; Only convertors to and from lisp lists
-(defcstruct g-list-struct
- "GList"
- (data object)
- (next :pointer)
- (prev :pointer))
+(defcfun "g_list_free" :void (g-list :pointer))
-(defcfun "g_list_free" :void (g-list g-list-struct))
+(defcfun "g_list_foreach" :void
+ (g-list :pointer) (func :pointer) (data :pointer))
-(defcfun "g_list_foreach"
- :void (g-list g-list-struct) (func :pointer) (data object))
+(defcfun "g_list_prepend" :pointer (g-list :pointer) (data object))
-(defcfun "g_list_prepend"
- g-list-struct (g-list g-list-struct) (data object))
+(defcfun "g_list_reverse" :pointer (glist :pointer))
-(defcfun "g_list_reverse" g-list-struct (glist g-list-struct))
+(defvar *list*)
+(defvar *list-type*)
-(defvar *list* nil)
+(defgeneric object-type (type-name)
+ (:documentation "Tests is TYPE-NAME is member of object types")
+ (:method ((type-name (eql 'object))) t)
+ (:method (type-name) nil))
+
(defcallback list-collect :void ((data :pointer) (user-data :pointer))
(declare (ignore user-data))
- (push data *list*))
+ (push (cond
+ ((null *list-type*) data)
+ ((or (object-type *list-type*)
+ (and (consp *list-type*) (object-type (car *list-type*))))
+ (convert-from-foreign data *list-type*))
+ (t (mem-ref data *list-type*))) *list*))
(define-foreign-type g-list ()
- ()
- (:actual-type :pointer)
- (:simple-parser g-list))
+ ((list-type :initarg :type :accessor list-type
+ :documentation "If null, then list is of pointers or GObjects"))
+ (:actual-type :pointer))
-(defmethod translate-from-foreign (ptr (name g-list))
+(define-parse-method g-list (&optional type)
+ (make-instance 'g-list :type type))
+
+(defmethod translate-from-foreign (ptr (g-list g-list))
(declare (type foreign-pointer ptr))
- (let ((*list* nil))
+ (let ((*list* nil)
+ (*list-type* (list-type g-list)))
(g-list-foreach ptr (callback list-collect) (null-pointer))
(g-list-free ptr)
*list*))
-(defmethod translate-to-foreign (lisp-list (name g-list))
+(defmethod translate-to-foreign (lisp-list (g-list g-list))
(declare (type list lisp-list))
- (let ((p (null-pointer)))
- (mapc (lambda (x)
- (setf p (g-list-prepend p x)))
- lisp-list)
- (g-list-reverse p)))
\ No newline at end of file
+ (let ((converter
+ (let ((list-type (list-type g-list)))
+ (if list-type
+ (lambda (x) (foreign-alloc list-type :initial-element x))
+ #'identity))))
+ (let ((p (null-pointer)))
+ (mapc (lambda (x)
+ (setf p (g-list-prepend p (apply converter x))))
+ lisp-list)
+ (g-list-reverse p))))
--- /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/package.lisp 2011/04/25 19:16:07 1.1.1.1
+++ /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/package.lisp 2011/08/26 17:16:13 1.2
@@ -9,7 +9,7 @@
(defpackage #:g-lib-cffi
(:nicknames #:g-lib #:glib)
- (:use #:common-lisp #:cffi #:cffi-object)
+ (:use #:common-lisp #:cffi #:cffi-object #:iterate)
(:export
;; gerror macro
#:with-g-error
@@ -18,11 +18,16 @@
#:g-list
#:g-quark
#:g-error
-
+ #:garray
+ #:with-array
+ #:*array-length*
#:timeout-add
#:timeout-remove
#:yield
#:g-intern-static-string
+ #:g-free
+
+ #:g-file
))
--- /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/quark.lisp 2011/04/25 19:16:07 1.1.1.1
+++ /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/quark.lisp 2011/08/26 17:16:13 1.2
@@ -16,4 +16,5 @@
(defcfun g-intern-string :pointer (string gtk-string))
-(defcfun g-intern-static-string :pointer (string gtk-dyn-string))
\ No newline at end of file
+(defcfun g-intern-static-string :pointer (string gtk-dyn-string))
+
--- /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/array.lisp 2011/08/26 17:16:13 NONE
+++ /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/array.lisp 2011/08/26 17:16:13 1.1
;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
;;;
;;; array.lisp --- CFFI wrapper for arrays
;;;
;;; Copyright (C) 2011, Roman Klochkov <kalimehtar at mail.ru>
;;;
(in-package :g-lib-cffi)
(defvar *array-length*)
(defmacro with-array (&body body)
`(with-foreign-object (*array-length* :uint)
, at body))
(define-foreign-type cffi-array ()
((element-type :initarg :type :accessor element-type))
(:actual-type :pointer))
(define-parse-method garray (type)
(make-instance 'cffi-array :type type))
(defmethod translate-to-foreign (value (cffi-array cffi-array))
value)
(defcfun g-free :void (var :pointer))
(defmethod translate-from-foreign (ptr (cffi-array cffi-array))
(assert (boundp '*array-length*) nil
"Array should be returned in WITH-ARRAY form")
(let ((array-length (mem-ref *array-length* :uint)))
(let ((res (make-array array-length)))
(iter
(for i from 0 below array-length)
(setf (aref res i) (mem-aref ptr (element-type cffi-array) i)))
(g-free ptr)
res)))
--- /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/file.lisp 2011/08/26 17:16:13 NONE
+++ /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/file.lisp 2011/08/26 17:16:13 1.1
;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
;;;
;;; file.lisp -- interface to GFile
;;;
;;; Copyright (C) 2007, Roman Klochkov <kalimehtar at mail.ru>
;;;
(in-package #:g-lib-cffi)
(defclass g-file (object)
())
(define-foreign-type gfile (cffi-object)
()
(:actual-type :pointer)
(:simple-parser g-file))
(defmethod translate-from-foreign (ptr (gfile gfile))
(declare (type foreign-pointer ptr))
(make-instance 'g-file :pointer ptr))
More information about the gtk-cffi-cvs
mailing list