scsh-checkins
[Top] [All Lists]

[Scsh-checkins] CVS: scx/scheme/xlib gcontext.scm,1.7,1.8 window.scm,1.9

To: scsh-checkins@lists.sourceforge.net
Subject: [Scsh-checkins] CVS: scx/scheme/xlib gcontext.scm,1.7,1.8 window.scm,1.9,1.10
From: David Frese <frese@users.sourceforge.net>
Date: Wed, 29 Aug 2001 07:47:05 -0700
List-id: <scsh-checkins.lists.sourceforge.net>
Sender: scsh-checkins-admin@lists.sourceforge.net
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



<Prev in Thread] Current Thread [Next in Thread>
  • [Scsh-checkins] CVS: scx/scheme/xlib gcontext.scm,1.7,1.8 window.scm,1.9,1.10, David Frese <=