* 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:
parent
567cc88e47
commit
28a37474d2
|
@ -4,8 +4,5 @@
|
|||
;;; are to be used.
|
||||
|
||||
(provide 'motif)
|
||||
|
||||
(require 'xwidgets)
|
||||
|
||||
(set! widget-subdirectory 'xm)
|
||||
(set! load-always '(support))
|
||||
|
|
59
scm/xaw.scm
59
scm/xaw.scm
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)))
|
||||
|
|
Loading…
Reference in New Issue