diff --git a/scheme/xlib/gcontext.scm b/scheme/xlib/gcontext.scm index cea6647..e01b6e6 100644 --- a/scheme/xlib/gcontext.scm +++ b/scheme/xlib/gcontext.scm @@ -1,22 +1,21 @@ ;; ... -(define (create-gcontext . args) +(define (create-gcontext drawable . 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)))))) + (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) "scx_Create_Gc") diff --git a/scheme/xlib/window.scm b/scheme/xlib/window.scm index 4e59402..295cf03 100644 --- a/scheme/xlib/window.scm +++ b/scheme/xlib/window.scm @@ -2,15 +2,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 'parent root 'width 500 'height 300 '((border-width . 4))) +;; 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 . args) +(define (create-window parent width height . 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))) + (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 (map car change-win-attr-list)