Sun Jan 10 09:49:36 CET 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>

* Support modular smoke & cleanup.

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

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

@@ -18,7 +18,7 @@

package))))

(values

(if (= 8 (type-id (return-type method)))

- `(define-constant ,symbol ;; a long not really an enum.

+ `(define-constant ,symbol ;; a long, not really an enum.

,(enum-call method))

`(define-constant ,symbol

(make-instance 'enum

@@ -52,11 +52,16 @@

`(defun ,name ,(if (< argument-count 0)

'(&rest args)

(make-lambda argument-count))

- (call-using-args (find-class (quote ,(lispify (name class) package)))

- ,method-name

- ,(if (< argument-count 0)

- 'args

- `(list ,@(make-lambda argument-count)))))

+ (call-using-args

+ (find-class (quote ,(lispify (name class)

+ (if (string= (name class)

+ "QGlobalSpace")

+ *package* ;; See #'MAKE-SMOKE-CLASSES

+ package))))

+ ,method-name

+ ,(if (< argument-count 0)

+ 'args

+ `(list ,@(make-lambda argument-count)))))

name)))

(defun ensure-generic-methods (symbols-names)

@@ -108,7 +113,10 @@

(exports))

(map-methods

#'(lambda (method)

- (when (enum-p method)

+ (when (and (enum-p method)

+ ;; qt.network has QIODevice::NotOpen(), but the

+ ;; class is external (workaround).

+ (not (external-p (get-class method))))

(multiple-value-bind (def export) (constant-definition package method smoke)

(push def

constants)

@@ -131,8 +139,12 @@

(when (static-p method)

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

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

- (setf (gethash function-symbol function-symbols)

- (if methods (- (id method)) (id method)))))))

+ (unless (fboundp function-symbol) ;; do not overwrite

+ ;; existing functions e.g. qInstallMsgHandler of

+ ;; qt.core with that of qt.gui which causes a

+ ;; segfault when loading from an saved image.

+ (setf (gethash function-symbol function-symbols)

+ (if methods (- (id method)) (id method))))))))

(eval smoke))

(loop for id being the hash-values of function-symbols do

(let ((method (make-smoke-method

@@ -149,10 +161,8 @@

(push export exports))))

`(progn (check-recompile ,smoke)

,@functions

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

- ;; eval on startup for class map.

- (make-smoke-classes ,package ,smoke))

(eval-when (:load-toplevel :execute)

+ (make-smoke-classes ,package ,smoke)

(ensure-generic-methods ',(hash-table-alist generics)))

,@constants

(eval-when (:load-toplevel :execute)