jyapayne/swig
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge new set of GOOPS changes by John Lenz.

Browse source 
GOOPS objects are now manipulated directly by the C code.
Some fixes to typemap-GOOPS interaction.


git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk/SWIG@5254 626c5289-ae23-0410-ae9c-e8d60b6d4f22
This commit is contained in:
Matthias Köppe 2003-11-02 23:15:19 +00:00
commit 3e64557893
3 changed files with 98 additions and 41 deletions
Download patch file Download diff file Expand all files Collapse all files

46
Lib/guile/common.scm
View file

@ -16,41 +16,27 @@
(define-class <swig-metaclass> (<class>)
(new-function #:init-value #f))
(define-method (compute-get-n-set (class <swig-metaclass>) s)
(case (slot-definition-allocation s)
((#:swig-virtual)
(list
;getter
(let ((func (get-keyword #:slot-ref (slot-definition-options s) #f)))
(lambda (x) (func (slot-ref x 'smob))))
;setter
(let ((func (get-keyword #:slot-set! (slot-definition-options s) #f)))
(lambda (x val) (func (slot-ref x 'smob) val)))))
((#:swig-virtual-class)
(list
;getter
(let ((func (get-keyword #:slot-ref (slot-definition-options s) #f))
(class (get-keyword #:class (slot-definition-options s) #f)))
(lambda (x) (make class #:init-smob (func (slot-ref x 'smob)))))
;setter
(let ((func (get-keyword #:slot-set! (slot-definition-options s) #f)))
(lambda (x val) (func (slot-ref x 'smob) (slot-ref val 'smob))))))
(else (next-method))))
(define-method (initialize (class <swig-metaclass>) initargs)
(slot-set! class 'new-function (get-keyword #:new-function initargs #f))
(next-method))
(define-class <swig> ()
(smob #:init-value #f)
#:metaclass <swig-metaclass>)
(define-class <swig> ()
(swig-smob #:init-value #f)
#:metaclass <swig-metaclass>
)
(define-method (initialize (obj <swig>) initargs)
(next-method)
(let ((arg (get-keyword #:init-smob initargs #f)))
(if arg
(slot-set! obj 'smob arg)
(slot-set! obj 'smob (apply (slot-ref (class-of obj) 'new-function)
(get-keyword #:args initargs '()))))))
(slot-set! obj 'swig-smob
(let ((arg (get-keyword #:init-smob initargs #f)))
(if arg
arg
(let ((ret (apply (slot-ref (class-of obj) 'new-function) (get-keyword #:args initargs '()))))
;; if the class is registered with runtime environment,
;; new-Function will return a <swig> goops class. In that case, extract the smob
;; from that goops class and set it as the current smob.
(if (slot-exists? ret 'swig-smob)
(slot-ref ret 'swig-smob)
ret))))))
(export <swig-metaclass> <swig>)