Sat Apr 3 14:34:21 CEST 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>
* Account for possible lisp-object metatype id change when loading an image.
diff -rN -u old-qt.core/src/variant.lisp new-qt.core/src/variant.lisp
--- old-qt.core/src/variant.lisp 2014-10-30 06:57:55.000000000 +0100
+++ new-qt.core/src/variant.lisp 2014-10-30 06:57:55.000000000 +0100
@@ -76,54 +76,59 @@
(defun copy-object-from-pointer (class pointer)
(make-instance class :arg0 (make-instance class :pointer pointer)))
-(macrolet
- ((variant-conversions ((variant) &body types)
- (let* ((special-types '(long-long ulong-long map list hash))
- (exclude-types
- (append '(63) ;; ColorGroup
- (mapcar #'(lambda (s)
- (value
- (symbol-value
- (intern (format nil "VARIANT.+~A+" s)
- :qt))))
- special-types)))
- (qt-types (loop for i from 1 to (value qt:variant.+user-type+)
- when (and (qt:variant.type-to-name i)
- ;; type-to-name returns longlong but
- ;; should be LongLong
- (not (member i exclude-types)))
- collect
- (smoke::lispify (qt:variant.type-to-name i)
- :qt))))
- `(ecase (cxx:user-type ,variant)
- ,@(loop for type in (append types special-types
- (remove nil qt-types))
- collect
- (if (symbolp type)
- `(,(value (symbol-value
- (let ((*package*
- (find-package :cl-smoke.qt)))
- (symbolicate 'variant.+ type '+))))
- ,(if (fboundp (intern (format nil "TO-~A" type) :cxx))
- `(,(intern (format nil "TO-~A" type) :cxx) ,variant)
- `(copy-object-from-pointer
- ;; intern since these types are in
- ;; qt.gui not qt.core
- (intern ,(symbol-name type) :qt)
- (cxx:const-data ,variant))))
- type))))))
- (defun qt:from-variant (variant)
- "Returns the value of VARIANT."
- (variant-conversions (variant)
- (#.(value qt:variant.+invalid+)
- (cerror "Return (VALUES)" "Type of variant ~A is invalid." variant)
- (values))
- (#.*cxx-lisp-object-metatype*
- (let* ((lisp-object (cl-smoke-lisp-object-value (pointer variant)))
- (value))
- (setf value (translate-cxx-lisp-object lisp-object))
- (free-cxx-lisp-object lisp-object)
- value)))))
+(eval-startup ()
+;; *cxx-lisp-object-metatype* can change when loading an image
+(eval '
+ (macrolet
+ ((variant-conversions ((variant) &body types)
+ (let* ((special-types '(long-long ulong-long map list hash))
+ (exclude-types
+ (append '(63) ;; ColorGroup
+ (mapcar #'(lambda (s)
+ (value
+ (symbol-value
+ (intern (format nil "VARIANT.+~A+" s)
+ :qt))))
+ special-types)))
+ (qt-types (loop for i from 1 to (value qt:variant.+user-type+)
+ when (and (qt:variant.type-to-name i)
+ ;; type-to-name returns longlong but
+ ;; should be LongLong
+ (not (member i exclude-types)))
+ collect
+ (smoke::lispify (qt:variant.type-to-name i)
+ :qt))))
+ `(ecase (cxx:user-type ,variant)
+ ,@(loop for type in (append special-types
+ (remove nil qt-types))
+ collect
+ `(,(value (symbol-value
+ (let ((*package*
+ (find-package :cl-smoke.qt)))
+ (symbolicate 'variant.+ type '+))))
+ ,(if (fboundp (intern (format nil "TO-~A" type) :cxx))
+ `(,(intern (format nil "TO-~A" type) :cxx) ,variant)
+ `(copy-object-from-pointer
+ ;; intern since these types are in
+ ;; qt.gui not qt.core
+ (intern ,(symbol-name type) :qt)
+ (cxx:const-data ,variant)))))
+ ,@(loop for type in types
+ collect
+ `(,(eval (first type))
+ ,@(rest type)))))))
+ (defun qt:from-variant (variant)
+ "Returns the value of VARIANT."
+ (variant-conversions (variant)
+ ((value qt:variant.+invalid+)
+ (cerror "Return (VALUES)" "Type of variant ~A is invalid." variant)
+ (values))
+ (*cxx-lisp-object-metatype*
+ (let* ((lisp-object (cl-smoke-lisp-object-value (pointer variant)))
+ (value))
+ (setf value (translate-cxx-lisp-object lisp-object))
+ (free-cxx-lisp-object lisp-object)
+ value)))))))
(defmethod qt:value ((variant qt:variant))
"Returns the value of VARIANT."