scheme/dynlink.scm

   1 ;; -*- scheme -*-
   2
   3 (display "in sgt's hacked dynlink.scm\n")
   4
   5 (debug-enable 'debug)
   6 (debug-enable 'backtrace)
   7 (read-enable 'positions)
   8
   9 (define-module (gtk dynlink)
  10   :use-module (gtk config)
  11   :use-module (ice-9 regex)
  12   :use-module (ice-9 debug)
  13 )
  14
  15 (define (update-registered-modules)
  16   (set! registered-modules
  17         (append! (convert-c-registered-modules #f)
  18                  registered-modules)))
  19 ;
  20 ; my attempt at using guile's own dynamic-libary stuff from boot-9.
  21 ;
  22 (define-public (merge-compiled-code init-func libname)
  23   (let* ((module (current-module))
  24          (interface (module-public-interface module))
  25          (libnamenolib (make-shared-substring libname 3)))
  26     ;; make the new primitives visible from within the current module.
  27     (module-use! module interface) ; XXX - is this safe?
  28     (save-module-excursion
  29      (lambda ()
  30        (update-registered-modules)
  31        (set-current-module interface)
  32
  33        (display "new merge-compiled-code ")
  34        (display libnamenolib)(display " ")(display init-func)(newline)
  35
  36        (let* ((modname (list 'gtk '%static-initfuncs%
  37                              (string->symbol init-func)))
  38               (modinfo (or-map (lambda (modinfo)
  39                                  (if (equal? (car modinfo) modname)
  40                                      modinfo
  41                                      #f))
  42                                registered-modules))
  43               (init-func (if modinfo (cadr modinfo) init-func))
  44
  45               (sharlib-full (try-using-libtool-name
  46                              "/usr/local/contrib/moderated/lib" libname))
  47
  48 ;             (lib       (if modinfo (caddr modinfo)
  49 ;                            (or (link-dynamic-module sharlib-full init-func)
  50 ;                                (error "can't open library" libname)))))
  51
  52 ; link-dynamic-module never returns anything.
  53               )
  54          (display "sharlibfull is ") (display sharlib-full)(newline)
  55          (link-dynamic-module sharlib-full init-func)
  56
  57 ;        (display "lib is ") (display lib)(newline)
  58          (display "modinfo is ") (display modinfo)(newline)
  59
  60 )))))
  61
  62 (define default-module-prefix
  63   (string->symbol (string-append "gtk-" gtkconf-version)))
  64 (define module-prefix #f)
  65
  66 (define-public (gtk-version-set prefix)
  67   (if (and module-prefix (not (eq? prefix module-prefix)))
  68       (error "Can't mix" module-prefix 'and prefix)
  69       (set! module-prefix prefix)))
  70
  71 (define-public (gtk-version-alias suffix)
  72   (if (not module-prefix)
  73       (set! module-prefix default-module-prefix))
  74 ;  (display "module-prefix is ")(display module-prefix)(newline)
  75   (let* ((mod-name (list module-prefix suffix))
  76          (mod-iface (resolve-interface mod-name)))
  77     (or mod-iface
  78         (error "no such module" mod-name))
  79     (set-module-public-interface! (current-module) mod-iface)))