glib/glib.glist.lisp

   1 (in-package :glib)
   2
   3 (define-foreign-type glist-type ()
   4   ((type :reader glist-type-type :initarg :type :initform :pointer)
   5    (free-from-foreign :reader glist-type-free-from-foreign :initarg :free-from-foreign :initform t)
   6    (free-to-foreign :reader glist-type-free-to-foreign :initarg :free-to-foreign :initform t))
   7   (:actual-type :pointer))
   8
   9 (define-parse-method glist (type &key (free-from-foreign t) (free-to-foreign t))
  10   (make-instance 'glist-type
  11                  :type type
  12                  :free-from-foreign free-from-foreign
  13                  :free-to-foreign free-to-foreign))
  14
  15 (defcstruct g-list
  16   (data :pointer)
  17   (next :pointer)
  18   (prev :pointer))
  19
  20 (defcfun g-list-first (:pointer g-list) (list (:pointer g-list)))
  21
  22 (defcfun g-list-free :void (list (:pointer g-list)))
  23
  24 (defun g-list-next (list)
  25   (if (null-pointer-p list)
  26       (null-pointer)
  27       (foreign-slot-value list 'g-list 'next)))
  28
  29 (defmethod translate-from-foreign (pointer (type glist-type))
  30   (prog1
  31       (iter (for c initially pointer then (g-list-next c))
  32             (until (null-pointer-p c))
  33             (collect (convert-from-foreign (foreign-slot-value c 'g-list 'data) (glist-type-type type))))
  34     (when (glist-type-free-from-foreign type)
  35       (g-list-free pointer))))
  36
  37
  38 (define-foreign-type gslist-type ()
  39   ((type :reader gslist-type-type :initarg :type :initform :pointer)
  40    (free-from-foreign :reader gslist-type-free-from-foreign :initarg :free-from-foreign :initform t)
  41    (free-to-foreign :reader gslist-type-free-to-foreign :initarg :free-to-foreign :initform t))
  42   (:actual-type :pointer))
  43
  44 (define-parse-method gslist (type &key (free-from-foreign t) (free-to-foreign t))
  45   (make-instance 'gslist-type
  46                  :type type
  47                  :free-from-foreign free-from-foreign
  48                  :free-to-foreign free-to-foreign))
  49
  50 (defcstruct g-slist
  51   (data :pointer)
  52   (next :pointer))
  53
  54 (defcfun g-slist-alloc (:pointer g-slist))
  55
  56 (defcfun g-slist-free :void (list (:pointer g-slist)))
  57
  58 (defun g-slist-next (list)
  59   (if (null-pointer-p list)
  60       (null-pointer)
  61       (foreign-slot-value list 'g-slist 'next)))
  62
  63 (defmethod translate-from-foreign (pointer (type gslist-type))
  64   (prog1
  65       (iter (for c initially pointer then (g-slist-next c))
  66             (until (null-pointer-p c))
  67             (collect (convert-from-foreign (foreign-slot-value c 'g-slist 'data) (gslist-type-type type))))
  68     (when (gslist-type-free-from-foreign type)
  69       (g-slist-free pointer))))
  70
  71 (defmethod translate-to-foreign (list (type gslist-type))
  72   (let ((result (null-pointer)) last)
  73     (iter (for item in list)
  74           (for n = (g-slist-alloc))
  75           (for ptr = (convert-to-foreign item (gslist-type-type type)))
  76           (setf (foreign-slot-value n 'g-slist 'data) ptr)
  77           (setf (foreign-slot-value n 'g-slist 'next) (null-pointer))
  78           (when last
  79             (setf (foreign-slot-value last 'g-slist 'next) n))
  80           (setf last n)
  81           (when (first-iteration-p)
  82             (setf result n)))
  83     result))
  84