Tue Jul 13 21:17:41 CEST 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>

* Use libsmokebase instead of libsmokeqtcore.

Sat Apr 3 21:11:26 CEST 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>

* slot-value access for static attributes using the class instead of an object.

Sat Apr 3 14:04:39 CEST 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>

* Make the slot-* functions work for C++ class attributes.

Allow slot-value to be used to access C++ member variables of objects.

Sat Apr 3 14:03:07 CEST 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>

* Fix attribute vs method map to same Lisp name clash.

e.g.: setWidget() and set_widget are in Lisp both #'set-widget. Prefer the method

over the attribute; the attribute will be accessible with SLOT-VALUE.

Wed Mar 10 17:38:58 CET 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>

* Improve missing to-lisp-translator error message.

Sat Feb 20 21:56:27 CET 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>

* Allow passing integers as enum arguments.

--- old-smoke/src/libsmoke/CMakeLists.txt 2014-10-30 08:05:54.000000000 +0100

+++ new-smoke/src/libsmoke/CMakeLists.txt 2014-10-30 08:05:54.000000000 +0100

@@ -10,21 +10,21 @@

# FIXME look for smoke.h

-find_library(smokeqtcore_LIB smokeqtcore)

-if (smokeqtcore_LIB)

- set(smokeqtcore_FOUND TRUE)

-endif (smokeqtcore_LIB)

-

-if (smokeqtcore_FOUND)

- message(STATUS "Found smokeqtcore: ${smokeqtcore}")

-else (smokeqtcore_FOUND)

- message(FATAL_ERROR "Could not find smokeqtcore")

-endif (smokeqtcore_FOUND)

+find_library(smokebase_LIB smokebase)

+if (smokebase_LIB)

+ set(smokebase_FOUND TRUE)

+endif (smokebase_LIB)

+

+if (smokebase_FOUND)

+ message(STATUS "Found smokebase: ${smokebase}")

+else (smokebase_FOUND)

+ message(FATAL_ERROR "Could not find smokebase")

+endif (smokebase_FOUND)

set(SMOKE_C_SOURCES smoke.cpp smokebinding.cpp)

add_library(clsmoke SHARED ${SMOKE_C_SOURCES})

-target_link_libraries(clsmoke ${QT_LIBRARIES} ${smokeqtcore_LIB})

+target_link_libraries(clsmoke ${QT_LIBRARIES} ${smokebase_LIB})

set_target_properties(clsmoke

PROPERTIES

SOVERSION "0.0"

--- old-smoke/src/objects/stack.lisp 2014-10-30 08:05:54.000000000 +0100

+++ new-smoke/src/objects/stack.lisp 2014-10-30 08:05:54.000000000 +0100

@@ -112,8 +112,9 @@

(when (stack-p type)

(funcall (cdr translation) pointer))))

(prog1 (foreign-slot-value stack-item 'smoke-stack-item 'voidp)

- (cerror "Return the pointer"

- "Do not know how to convert the type ~A to Lisp." type))))

+ (cerror "Return the pointer"

+ "Missing type translator to convert the type ~A to Lisp."

+ type))))

(1 (foreign-slot-value stack-item 'smoke-stack-item 'bool))

(2 (code-char (foreign-slot-value stack-item 'smoke-stack-item 'char)))

(3 (code-char (foreign-slot-value stack-item 'smoke-stack-item 'uchar)))

@@ -139,13 +140,17 @@

(let ((class (get-class type)))

(if (has-pointer-p object)

(if (derived-p (class-of (get-object object))

- (get-class type))

+ (get-class type))

(get-object object)

(progn

- (cerror "Remove the old object."

- "The object at pointer ~A is ~A but should be a ~A."

- object (get-object object) type)

- (remove-object object)

+ (when (stack-p type)

+ ;; The first member varible of a class can have the

+ ;; same address as its object.

+ ;; e.g.: QSharedData::ref

+ (cerror "Remove the old object."

+ "The object at pointer ~A is ~A but should be a ~A."

+ object (get-object object) type)

+ (remove-object object))

(instance-to-lisp object (find-smoke-class class) type)))

(instance-to-lisp object (find-smoke-class class) type))))

--- old-smoke/src/overload-resolution.lisp 2014-10-30 08:05:54.000000000 +0100

+++ new-smoke/src/overload-resolution.lisp 2014-10-30 08:05:54.000000000 +0100

@@ -369,7 +369,7 @@

(defun coerce-c-string (string)

(make-auto-pointer (foreign-string-alloc string)))

-(defun coerce-enum (enum)

+(defun coerce-from-enum (enum)

(cxx-support:value enum))

(defun coerce-double-float (number)

@@ -378,6 +378,11 @@

(defun coerce-single-float (number)

(float number 0f0))

+(defun coerce-to-enum (number)

+ ;; we can skip the enum type because it is not checked at this

+ ;; point.

+ (make-instance 'enum :value number))

+

;; FIXME incomplete

(defun+using-type promotion object (object type)

(declare (smoke-type type))

@@ -386,13 +391,15 @@

(object.typep 'string))

(make-match 'promotion 'coerce-c-string)))

(6 (when (object.typep 'enum)

- (make-match 'promotion 'coerce-enum)))

+ (make-match 'promotion 'coerce-from-enum)))

(7 (when (object.typep 'enum)

- (make-match 'promotion 'coerce-enum)))

+ (make-match 'promotion 'coerce-from-enum)))

(10 (when (object.typep 'real)

(make-match 'promotion 'coerce-single-float)))

(11 (when (object.typep 'real)

- (make-match 'promotion 'coerce-double-float)))))

+ (make-match 'promotion 'coerce-double-float)))

+ (12 (when (object.typep '(integer 0))

+ (make-match 'promotion 'coerce-to-enum)))))

(declaim (inline coerce-to-class))

(defun coerce-cast (object to-class)

@@ -522,7 +529,6 @@

(condition-class condition)

(condition-arguments condition)))))

-

(defun call-using-args (object-or-class name arguments)

"Calls the method NAME of OBJECT-OR-CLASS with ARGUMENTS."

(declare (optimize (speed 3))

@@ -547,3 +553,53 @@

(null-pointer)

(cast object-or-class (get-class method)))

sequence arguments)))

+

+(defmethod slot-missing (meta-class (class smoke-standard-class) slot-name operation &optional new-value)

+ (let ((method (find-smoke-method class (lisp-to-cxx (string slot-name)))))

+ (if (or (not (valid-p method)) (not (static-p method)))

+ (call-next-method)

+ (ecase operation

+ (setf

+ (handler-case (funcall (fdefinition

+ (intern

+ (concatenate 'string "SET-"

+ (string-upcase

+ (string slot-name)))

+ :cxx))

+ class new-value)

+ (undefined-function ()

+ (error "The C++ attribute ~A of ~A is read only." slot-name class))

+ (no-applicable-cxx-method (condition)

+ (if (null (viable-functions (condition-method condition)

+ (length (condition-arguments condition))

+ (condition-class condition)))

+ (error "The C++ attribute ~A of ~A is read only." slot-name class)

+ (error condition)))))

+ (slot-boundp t)

+ (slot-makunbound (error "Can not unbind the C++ attribute ~A of ~A." slot-name class))

+ (slot-value (s-call method (null-pointer)))))))

+

+(defmethod slot-missing ((class smoke-standard-class) object slot-name operation &optional new-value)

+ (let ((method (find-smoke-method class (lisp-to-cxx (string slot-name)))))

+ (if (not (valid-p method))

+ (call-next-method)

+ (ecase operation

+ (setf

+ (handler-case (funcall (fdefinition

+ (intern

+ (concatenate 'string "SET-"

+ (string-upcase

+ (string slot-name)))

+ :cxx))

+ object new-value)

+ (undefined-function ()

+ (error "The C++ attribute ~A of ~A is read only." slot-name object))

+ (no-applicable-cxx-method (condition)

+ (if (null (viable-functions (condition-method condition)

+ (length (condition-arguments condition))

+ (condition-class condition)))

+ (error "The C++ attribute ~A of ~A is read only." slot-name object)

+ (error condition)))))

+ (slot-boundp t)

+ (slot-makunbound (error "Can not unbind the C++ attribute ~A of ~A." slot-name object))

+ (slot-value (s-call method (cast object (get-class method))))))))

--- old-smoke/src/smoke-to-clos.lisp 2014-10-30 08:05:54.000000000 +0100

+++ new-smoke/src/smoke-to-clos.lisp 2014-10-30 08:05:54.000000000 +0100

@@ -138,8 +138,9 @@

(unless (nth-value 1 (gethash (lispify name :cxx) setf-function-symbols))

(setf (gethash (lispify name :cxx) setf-function-symbols) t)

(push (setf-method-definition method) functions)))

- (setf (gethash (lispify name "CXX") generics)

- name))

+ (let ((lisp-name (lispify name "CXX")))

+ (unless (and (gethash lisp-name generics) (attribute-p method))

+ (setf (gethash lisp-name generics) name))))

(when (static-p method)

(let* ((function-symbol (static-method-symbol package method))

(methods (gethash function-symbol function-symbols)))