;;; -*-Scheme-*- ;;; ;;; The Scheme part of the X11 widget interface. ; kludge (define site-lib-xaw "") (define site-lib-xmotif "") (require 'xt) (define widget-subdirectory 'xaw) (define load-always '()) (define widget-aliases #f) (define (widget-loaded? w) (feature? (string->symbol (format #f "~a:~a.so" widget-subdirectory w)))) (define-macro (load-widgets . w) (let ((wl '()) (l '())) (if (null? w) (error 'load-widgets "no arguments")) (for-each (lambda (w) (if (not (symbol? w)) (error 'load-widgets "argument not a symbol")) (if (not (widget-loaded? w)) (set! l (cons w l)))) w) (for-each (lambda (w) (if (not (widget-loaded? w)) (set! l (cons w l)))) load-always) (if (not (null? l)) (begin (if (not widget-aliases) (load (format #f "~a/ALIASES" widget-subdirectory))) (if autoload-notify? (format #t "[Loading ")) (do ((f l (cdr f))) ((null? f)) (let* ((file (car f)) (alias (assq (car f) widget-aliases))) (if alias (set! file (cdr alias))) (if autoload-notify? (format #t "~a~a" file (if (null? (cdr f)) "" " "))) ;;(set! wl (cons (format #f "~a/~a.so" widget-subdirectory file) (set! wl (cons (format #f "~a/~a.so" widget-subdirectory widget-subdirectory) wl)))) (if autoload-notify? (format #t "]~%")) `(fluid-let ((load-libraries (if (feature? 'motif) (string-append site-lib-xmotif " " load-libraries) (string-append site-lib-xaw " " load-libraries)))) (load ',wl))) #f))) (define load-widget load-widgets) (provide 'xwidgets)