Update of /cvsroot/scsh/scx/scheme/xlib
In directory usw-pr-cvs1:/tmp/cvs-serv335
Modified Files:
gcontext.scm window.scm
Log Message:
made the mandatory arguments to create-gcontext (drawable) and
create-window (parent width height) _really_ mandatory.
Index: gcontext.scm
===================================================================
RCS file: /cvsroot/scsh/scx/scheme/xlib/gcontext.scm,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -r1.7 -r1.8
*** gcontext.scm 2001/08/22 11:49:01 1.7
--- gcontext.scm 2001/08/29 14:47:03 1.8
***************
*** 1,21 ****
;; ...
! (define (create-gcontext . args)
(let ((alist (named-args->alist args)))
! (receive (drawable rest) (alist-split alist '((drawable . #f)))
! (let* ((rest (map cons
! (map car rest)
! (map (lambda (obj)
! (cond
! ((pixel? obj) (pixel-Xpixel obj))
! ((font? obj) (font-Xfont obj))
! ((pixmap? obj) (pixmap-Xpixmap obj))
! (else obj)))
! (map cdr rest))))
! (display (drawable-display drawable))
! (Xdisplay (display-Xdisplay display))
! (Xobject (drawable-Xobject drawable)))
! (let ((Xgcontext (%create-gcontext Xdisplay Xobject rest)))
! (make-gcontext Xgcontext display #t))))))
(import-lambda-definition %create-gcontext (Xdisplay Xdrawable alist)
--- 1,20 ----
;; ...
! (define (create-gcontext drawable . args)
(let ((alist (named-args->alist args)))
! (let* ((rest (map cons
! (map car alist)
! (map (lambda (obj)
! (cond
! ((pixel? obj) (pixel-Xpixel obj))
! ((font? obj) (font-Xfont obj))
! ((pixmap? obj) (pixmap-Xpixmap obj))
! (else obj)))
! (map cdr alist))))
! (display (drawable-display drawable))
! (Xdisplay (display-Xdisplay display))
! (Xobject (drawable-Xobject drawable)))
! (let ((Xgcontext (%create-gcontext Xdisplay Xobject rest)))
! (make-gcontext Xgcontext display #t)))))
(import-lambda-definition %create-gcontext (Xdisplay Xdrawable alist)
Index: window.scm
===================================================================
RCS file: /cvsroot/scsh/scx/scheme/xlib/window.scm,v
retrieving revision 1.9
retrieving revision 1.10
diff -C2 -r1.9 -r1.10
*** window.scm 2001/08/22 11:49:01 1.9
--- window.scm 2001/08/29 14:47:03 1.10
***************
*** 3,15 ****
;; create-window takes an alist of names and values - see
;; change-window-attributes and configure-window. Mandatory arguments for
! ;; create-window are 'parent, 'width and 'height. Example:
! ;; (create-window 'parent root 'width 500 'height 300 '((border-width . 4)))
;; Returns the new window or raises an exception if something went wrong.
! (define (create-window . args)
(let ((alist (named-args->alist args)))
! (receive (x y width height border-width parent change-win-attr-list)
! (alist-split alist '((x . 0) (y . 0) (width . #f) (height . #f)
! (border-width . 2) (parent . #f)))
(let* ((change-win-attr-list
(map cons
--- 3,14 ----
;; create-window takes an alist of names and values - see
;; change-window-attributes and configure-window. Mandatory arguments for
! ;; create-window are parent, width and height. Example:
! ;; (create-window root 500 300 'x 0 '((border-width . 4)))
;; Returns the new window or raises an exception if something went wrong.
! (define (create-window parent width height . args)
(let ((alist (named-args->alist args)))
! (receive (x y border-width change-win-attr-list)
! (alist-split alist '((x . 0) (y . 0) (border-width . 2)))
(let* ((change-win-attr-list
(map cons
|