1 ;;;************************************************************************
4 ;;;* This file contains generic SWIG GOOPS classes for generated
5 ;;;* GOOPS file support
6 ;;;************************************************************************
8 (define-module (Swig swigrun))
10 (define-module (Swig common)
11 #:use-module (oop goops)
12 #:use-module (Swig swigrun))
14 (define-class <swig-metaclass> (<class>)
15 (new-function #:init-value #f))
17 (define-method (initialize (class <swig-metaclass>) initargs)
19 (slot-set! class 'new-function (get-keyword #:new-function initargs #f)))
21 (define-class <swig> ()
22 (swig-smob #:init-value #f)
23 #:metaclass <swig-metaclass>
26 (define-method (initialize (obj <swig>) initargs)
28 (slot-set! obj 'swig-smob
29 (let ((arg (get-keyword #:init-smob initargs #f)))
32 (let ((ret (apply (slot-ref (class-of obj) 'new-function) (get-keyword #:args initargs '()))))
33 ;; if the class is registered with runtime environment,
34 ;; new-Function will return a <swig> goops class. In that case, extract the smob
35 ;; from that goops class and set it as the current smob.
36 (if (slot-exists? ret 'swig-smob)
37 (slot-ref ret 'swig-smob)
40 (define (display-address o file)
41 (display (number->string (object-address o) 16) file))
43 (define (display-pointer-address o file)
44 ;; Don't fail if the function SWIG-PointerAddress is not present.
45 (let ((address (false-if-exception (SWIG-PointerAddress o))))
49 (display (number->string address 16) file)))))
51 (define-method (write (o <swig>) file)
52 ;; We display _two_ addresses to show the object's identity:
53 ;; * first the address of the GOOPS proxy object,
54 ;; * second the pointer address.
55 ;; The reason is that proxy objects are created and discarded on the
56 ;; fly, so different proxy objects for the same C object will appear.
57 (let ((class (class-of o)))
58 (if (slot-bound? class 'name)
61 (display (class-name class) file)
62 (display #\space file)
63 (display-address o file)
64 (display-pointer-address o file)
68 (export <swig-metaclass> <swig>)
70 ;;; common.scm ends here