* Beautified xaw and motif Scheme files.

git-svn-id: svn://svn.zoy.org/elk/trunk@87 55e467fa-43c5-0310-a8a2-de718669efc6
This commit is contained in:
sam 2003-09-04 12:45:48 +00:00
parent 567cc88e47
commit 28a37474d2
4 changed files with 8 additions and 81 deletions

View File

@ -4,8 +4,5 @@
;;; are to be used.
(provide 'motif)
(require 'xwidgets)
(set! widget-subdirectory 'xm)
(set! load-always '(support))

View File

@ -2,61 +2,6 @@
;;;
;;; The Scheme part of the X11 widget interface.
; kludge
(define site-lib-xaw "")
(define site-lib-xmotif "")
(provide 'xaw)
(require 'xwidgets)
(require 'xaw)
(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))))
(feature? (string->symbol (format #f "~a:~a.so" widget-subdirectory widget-subdirectory))))
(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)) "" " ")))
;; XXX: don't load all widgets, they're all in the same lib
;;(set! wl (cons (format #f "~a/~a.so" widget-subdirectory file)
;; wl))))
(set! wl (list (format #f "~a/~a.so" widget-subdirectory widget-subdirectory)))))
(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)

View File

@ -2,11 +2,7 @@
;;;
;;; The Scheme part of the Xlib extension.
; kludge
(define site-lib-xlib "")
(fluid-let ((load-libraries (string-append site-lib-xlib " " load-libraries)))
(require 'xlib.so))
(require 'xlib.so)
(define (create-window . args)
(apply-with-keywords

View File

@ -2,24 +2,13 @@
;;;
;;; The Scheme part of the Xt extension.
;; kludge
(define site-lib-xt "")
(define site-force-load-xm "")
(define site-lib-xmotif "")
(define widgets (if (feature? 'motif) 'motif 'xaw))
(if (feature? 'motif)
(fluid-let ((load-libraries
(string-append site-force-load-xm " " site-lib-xmotif " "
load-libraries)))
(require 'xaw.so 'xt-motif.so))
(fluid-let ((load-libraries
(string-append site-lib-xt " " load-libraries)))
(require 'xaw.so)))
(require 'xlib)
(require 'xt.so (string->symbol (format #f "~a-xt.so" widgets)))
(require (string->symbol (format #f "~a-widgets.so" widgets)))
(load 'xlib.scm)
(provide 'xlib)
(provide 'xt)
(provide 'xwidgets)
(define (manage-child w)
(manage-children (list w)))