/[cffi-objects]/struct.lisp
ViewVC logotype

Diff of /struct.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 7 by rklochkov, Thu Aug 9 16:55:23 2012 UTC revision 8 by rklochkov, Sun Aug 12 17:36:30 2012 UTC
# Line 51  or may be cons (class-name . struct-name Line 51  or may be cons (class-name . struct-name
51                  (if (slot-boundp ,class-name 'value)                  (if (slot-boundp ,class-name 'value)
52                      (getf (slot-value ,class-name 'value) ',x)                      (getf (slot-value ,class-name 'value) ',x)
53                      (foreign-slot-value (pointer ,class-name)                      (foreign-slot-value (pointer ,class-name)
54                                          ',struct-name ',x)))                                          '(:struct ,struct-name) ',x)))
55                (unless (fboundp '(setf ,x))                (unless (fboundp '(setf ,x))
56                  (defgeneric (setf ,x) (val ,class-name)))                  (defgeneric (setf ,x) (val ,class-name)))
57                (defmethod (setf ,x) (val (,class-name ,class-name))                (defmethod (setf ,x) (val (,class-name ,class-name))
58                  (if (slot-boundp ,class-name 'value)                  (if (slot-boundp ,class-name 'value)
59                      (setf (getf (slot-value ,class-name 'value) ',x) val)                      (setf (getf (slot-value ,class-name 'value) ',x) val)
60                      (setf (foreign-slot-value (pointer ,class-name)                      (setf (foreign-slot-value (pointer ,class-name)
61                                                ',struct-name ',x)                                                '(:struct ,struct-name) ',x)
62                            val)))                            val)))
63                (save-setter ,class-name ,x)))                (save-setter ,class-name ,x)))
64            (foreign-slot-names struct-name)))))            (foreign-slot-names `(:struct ,struct-name))))))
65    
66  (defmacro defbitaccessors (class slot &rest fields)  (defmacro defbitaccessors (class slot &rest fields)
67    (let ((pos 0))    (let ((pos 0))
# Line 139  Only exception is the presence of OBJECT Line 139  Only exception is the presence of OBJECT
139    "Return the size in bytes of a foreign typedef."    "Return the size in bytes of a foreign typedef."
140    (foreign-type-size (object-class type)))    (foreign-type-size (object-class type)))
141    
142  (define-parse-method struct (class &key (free :no-transfer) out)  (define-parse-method struct (class &rest rest)
143    (make-instance 'cffi-struct    (apply #'make-instance 'cffi-struct :class class rest))
                  :class class :free free :out out))  
144    
145  (defun %class (type value)  (defun %class (type value)
146    (or (object-class type) (class-name (class-of value))))    (or (object-class type) (class-name (class-of value))))

Legend:
Removed from v.7  
changed lines
  Added in v.8

  ViewVC Help
Powered by ViewVC 1.1.5