Sun Aug 2 12:12:41 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>

* Cleanup C++ to Lisp translation

--- old-smoke/src/smoke.lisp 2014-10-30 08:12:15.000000000 +0100

+++ new-smoke/src/smoke.lisp 2014-10-30 08:12:15.000000000 +0100

@@ -31,12 +31,10 @@

(defun call-s-method (method object-pointer stack-pointer)

(foreign-funcall-pointer

(foreign-slot-value (smoke-class-pointer (get-class method))

- 'smoke-class

- 'class-function)

+ 'smoke-class 'class-function)

()

smoke-index (foreign-slot-value (smoke-method-pointer method)

- 'smoke-method

- 'method)

+ 'smoke-method 'method)

:pointer object-pointer

smoke-stack stack-pointer

:void))

@@ -51,25 +49,21 @@

(call-s-method method object-pointer (call-stack-pointer stack))

(foreign-slot-value (call-stack-pointer stack) 'smoke-stack-item 'class)))

-

(defun smoke-call (class pointer method-name &optional (args nil))

- (s-call

- (make-smoke-method-from-name class method-name)

- pointer args))

+ (s-call (make-smoke-method-from-name class method-name) pointer args))

(defun static-call (smoke class-name method-name &rest args)

- (s-call

- (make-smoke-method-from-name (make-smoke-class smoke class-name)

- method-name)

- (null-pointer) args))

+ (s-call (make-smoke-method-from-name (make-smoke-class smoke class-name)

+ method-name)

+ (null-pointer) args))

(defun enum-call (method)

"Return the enum value for METHOD."

;; FIXME:

+ ;;

;; we could use static call, but QGraphicsEllipseItem::Type has

;; wrongly QGraphicsGridLayout as return type. Smoke ignores case

- ;; and confuses it with the member function type() ??

- ;; (27.2.09)

+ ;; and confuses it with the member function type() ?? (27.2.09)

;;

(assert (enum-p method))

(with-stack (stack nil nil)

@@ -81,41 +75,35 @@

Calls the destructor and frees the memory."

(declare (optimize (speed 3)))

(let ((method-name (concatenate 'string "~" (constructor-name class))))

- (s-call

- (make-smoke-method-from-name class method-name)

- pointer)))

+ (s-call (make-smoke-method-from-name class method-name) pointer)))

(defun delete-object (object)

(let ((method-name (concatenate 'string "~" (name (class-of object)))))

(s-call

- (make-smoke-method-from-name (class-of object) method-name)

- (pointer object)))

+ (make-smoke-method-from-name (class-of object) method-name)

+ (pointer object)))

(setf (slot-value object 'pointer) (null-pointer)))

(defun set-binding (object)

"Sets the Smoke binding for OBJECT, that receives its callbacks."

(declare (optimize (speed 3)))

(with-foreign-object (stack 'smoke-stack-item 2)

- (setf (foreign-slot-value (mem-aref stack

- 'smoke-stack-item

- 1)

- 'smoke-stack-item

- 'voidp)

+ (setf (foreign-slot-value (mem-aref stack 'smoke-stack-item 1)

+ 'smoke-stack-item 'voidp)

(smoke-module-binding (smoke (class-of object))))

(foreign-funcall-pointer

(foreign-slot-value (smoke-class-pointer (class-of object))

- 'smoke-class

- 'class-function)

+ 'smoke-class 'class-function)

()

smoke-index 0 ;; set binding method index

- :pointer (pointer object) smoke-stack stack

+ :pointer (pointer object)

+ smoke-stack stack

:void)))

(defun init (smoke module)

"Returns the a new Smoke binding for the Smoke module SMOKE."

(use-foreign-library libsmoke-c)

- (let* ((binding (smoke-init smoke

- (callback destructed)

+ (let* ((binding (smoke-init smoke (callback destructed)

(callback dispatch-method))))

(setf (binding smoke) binding

(smoke-module-pointer module) smoke

@@ -127,17 +115,16 @@

(let ((pointer-symbol-map (make-hash-table)))

(defun register-smoke-module-var (symbol)

"Registers SYMBOL of a variable containing a pointer to a Smoke module."

- (setf (gethash (pointer-address (smoke-module-pointer (eval symbol))) pointer-symbol-map)

+ (setf (gethash (pointer-address (smoke-module-pointer (eval symbol)))

+ pointer-symbol-map)

symbol))

(defun get-smoke-variable-for-pointer (pointer)

"Returns the SYMBOL of the variable whose value is POINTER."

(gethash (pointer-address pointer) pointer-symbol-map)))

(defun call (object method-name &rest args)

- (smoke-call (class-of object)

- (pointer object)

- method-name

- args))

+ (smoke-call (class-of object) (pointer object)

+ method-name args))

(defmethod documentation ((class smoke-standard-class) (doc-type (eql 't)))

(declare (optimize (speed 3)))

@@ -150,7 +137,6 @@

(call-next-method)

(sort (mapcar #'method-declaration methods) #'string<=))))

-

(declaim (inline cstring=))

(defun cstring= (string1 string2)

"Returns T when the C strings STRING1 and STRING2 are equal

@@ -196,10 +182,10 @@

(t (:default ,(format nil "~(~A~)" library)))))

(eval-startup (:compile-toplevel :execute)

(load-foreign-library ',library))

+

(eval-startup (:compile-toplevel :execute)

- (defcvar (,variable ,variable-name

- :read-only t

- :library ,library) :pointer)

+ (defcvar (,variable ,variable-name :read-only t :library ,library)

+ :pointer)

(defcfun (,init-function ,(format nil "_Z~A~Av"

(length function-name)

function-name)

@@ -213,7 +199,6 @@

(register-smoke-module-var ',smoke-module))

(define-classes-and-gfs ,package ,smoke-module))))

-

(defun fgrep-classes (smoke str)

(map-classes #'(lambda (class)

(when (search str (name class))