scsh-conservatory
/
scx
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

made the mandatory arguments to create-gcontext (drawable) and 

create-window (parent width height) _really_ mandatory.
This commit is contained in:
frese 2001-08-29 14:47:03 +00:00
parent fd66d0396b
commit aa1926d027
2 changed files with 20 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
scheme/xlib/gcontext.scm
View File

@ -1,22 +1,21 @@
;; ... ;; ...
(define (create-gcontext . args) (define (create-gcontext drawable . args)
(let ((alist (named-args->alist args))) (let ((alist (named-args->alist args)))
(receive (drawable rest) (alist-split alist '((drawable . #f)))
(let* ((rest (map cons (let* ((rest (map cons
(map car rest) (map car alist)
(map (lambda (obj) (map (lambda (obj)
(cond (cond
((pixel? obj) (pixel-Xpixel obj)) ((pixel? obj) (pixel-Xpixel obj))
((font? obj) (font-Xfont obj)) ((font? obj) (font-Xfont obj))
((pixmap? obj) (pixmap-Xpixmap obj)) ((pixmap? obj) (pixmap-Xpixmap obj))
(else obj))) (else obj)))
(map cdr rest)))) (map cdr alist))))
(display (drawable-display drawable)) (display (drawable-display drawable))
(Xdisplay (display-Xdisplay display)) (Xdisplay (display-Xdisplay display))
(Xobject (drawable-Xobject drawable))) (Xobject (drawable-Xobject drawable)))
(let ((Xgcontext (%create-gcontext Xdisplay Xobject rest))) (let ((Xgcontext (%create-gcontext Xdisplay Xobject rest)))
(make-gcontext Xgcontext display #t)))))) (make-gcontext Xgcontext display #t)))))
(import-lambda-definition %create-gcontext (Xdisplay Xdrawable alist) (import-lambda-definition %create-gcontext (Xdisplay Xdrawable alist)
"scx_Create_Gc") "scx_Create_Gc")

11
scheme/xlib/window.scm
View File

@ -2,15 +2,14 @@
;; create-window takes an alist of names and values - see ;; create-window takes an alist of names and values - see
;; change-window-attributes and configure-window. Mandatory arguments for ;; change-window-attributes and configure-window. Mandatory arguments for
;; create-window are 'parent, 'width and 'height. Example: ;; create-window are parent, width and height. Example:
;; (create-window 'parent root 'width 500 'height 300 '((border-width . 4))) ;; (create-window root 500 300 'x 0 '((border-width . 4)))
;; Returns the new window or raises an exception if something went wrong. ;; 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))) (let ((alist (named-args->alist args)))
(receive (x y width height border-width parent change-win-attr-list) (receive (x y border-width change-win-attr-list)
(alist-split alist '((x . 0) (y . 0) (width . #f) (height . #f) (alist-split alist '((x . 0) (y . 0) (border-width . 2)))
(border-width . 2) (parent . #f)))
(let* ((change-win-attr-list (let* ((change-win-attr-list
(map cons (map cons
(map car change-win-attr-list) (map car change-win-attr-list)