Only some small changes.

c/xlib/color.c

@@ -16,9 +16,9 @@ s48_value Int_Extract_RGB_Values(XColor col) {
   S48_DECLARE_GC_PROTECT(1);
   S48_GC_PROTECT_1(res);
   
-  res = s48_cons( s48_enter_integer(col.red), res );
-  res = s48_cons( s48_enter_integer(col.green), res );
   res = s48_cons( s48_enter_integer(col.blue), res );
+  res = s48_cons( s48_enter_integer(col.green), res );
+  res = s48_cons( s48_enter_integer(col.red), res );
   
   S48_GC_UNPROTECT();
   return res;

c/xlib/type.c

@@ -24,7 +24,7 @@ s48_value s48_enter_symbol(char* name) {
    and the scheme symbols:
 */
 
-s48_value Bits_To_Symbols(unsigned long bits, int mask_flag, SYMDESCR* table) {
+s48_value Bits_To_Symbols(unsigned long bits, SYMDESCR* table) {
   s48_value res = S48_NULL;
   char* name;
   int val;
@@ -38,32 +38,29 @@ s48_value Bits_To_Symbols(unsigned long bits, int mask_flag, SYMDESCR* table) {
     val = table[i].val;
     
     if ((val & bits) != 0) {
-      if (mask_flag == 0) {
+      res = s48_cons(s48_enter_symbol(name), res);
-	res = s48_enter_symbol(name);
-	break;
-      } else {
-	res = s48_cons(s48_enter_symbol(name), res);
-      }
     }
     i++;
   }
-  if ((mask_flag == 0) && S48_NULL_P(res))
-    res = s48_enter_integer(bits); // or an exception??
 
   S48_GC_UNPROTECT();
   return res;
 }
 
-unsigned long Symbols_To_Bits(s48_value Syms, int mask_flag, SYMDESCR* table) {
+s48_value Bit_To_Symbol(unsigned long bits, SYMDESCR* table) {
+  s48_value res = Bits_To_Symbols(bits, table);
+  if (S48_NULL_P(res))
+    return s48_enter_integer(bits);
+  else
+    return S48_CAR(res);
+}}
+
+unsigned long Symbols_To_Bits(s48_value Syms, SYMDESCR* table) {
   unsigned long res = 0;
   s48_value l;
 
-  if (mask_flag) {
+  for (l = Syms; !S48_NULL_P(l); l = S48_CDR(l)) {
-    for (l = Syms; !S48_NULL_P(l); l = S48_CDR(l)) {
+    res |= Symbol_To_Bit(S48_CAR(l), table);
-      res |= Symbol_To_Bit(S48_CAR(l), table);
-    }
-  } else {
-    res |= Symbol_To_Bit(l, table);
   }
 
   return res;

c/xlib/window.c

@@ -28,13 +28,13 @@ unsigned long AList_To_XSetWindowAttributes(s48_value attrAlist,
       Xattrs->border_pixel = s48_extract_integer(value);
       mask |= CWBorderPixel;
     } else if (cname == "bit-gravity") {
-      Xattrs->bit_gravity = Symbols_To_Bits(value, 0, Bit_Grav_Syms);
+      Xattrs->bit_gravity = Symbol_To_Bit(value, Bit_Grav_Syms);
       mask |= CWBitGravity;
     } else if (cname == "gravity") {
-      Xattrs->win_gravity = Symbols_To_Bits(value, 0, Grav_Syms);
+      Xattrs->win_gravity = Symbol_To_Bit(value, Grav_Syms);
       mask |= CWWinGravity;
     } else if (cname == "backing-store") {
-      Xattrs->backing_store = Symbols_To_Bits(value, 0, Backing_Store_Syms);
+      Xattrs->backing_store = Symbol_To_Bit(value, Backing_Store_Syms);
       mask |= CWBackingStore;
     } else if (cname == "backing-planes") {
       Xattrs->backing_planes = s48_extract_integer(value);
@@ -46,10 +46,10 @@ unsigned long AList_To_XSetWindowAttributes(s48_value attrAlist,
       Xattrs->save_under = !S48_FALSE_P(value);
       mask |= CWSaveUnder;
     } else if (cname == "event-mask") {
-      Xattrs->event_mask = Symbols_To_Bits(value, 1, Event_Syms);
+      Xattrs->event_mask = Symbols_To_Bits(value, Event_Syms);
       mask |= CWEventMask;
     } else if (cname == "do-not-propagate-mask") {
-      Xattrs->do_not_propagate_mask = Symbols_To_Bits(value, 1, Event_Syms);
+      Xattrs->do_not_propagate_mask = Symbols_To_Bits(value, Event_Syms);
       mask |= CWDontPropagate;
     } else if (cname == "override-redirect") {
       Xattrs->override_redirect = !S48_FALSE_P(value);
@@ -142,24 +142,36 @@ s48_value Get_Window_Attributes(s48_value Xdisplay, s48_value Xwindow) {
   s48_value res = S48_NULL;
   S48_GC_PROTECT_1(res);
 
-  XGetWindowAttributes(dpy, win, &WA);
+  if (!XGetWindowAttributes(dpy, win, &WA))
+    res = S48_FALSE;
+  else {
   
-  // ... usw.
+    // WA.screen - ignored in Elk
-  res = s48_cons( s48_enter_integer(WA.backing_planes), res);
+    res = s48_cons( WA.overide_redirect ? S48_TRUE : S48_FALSE, res);
-  res = s48_cons( Bits_To_Symbols(WA.backing_store, 1, Backing_Store_Syms), 
+    res = s48_cons( ENTER_MASK( WA.do_not_propagate_mask ), res);
-		  res);
+    res = s48_cons( ENTER_MASK( WA.your_event_mask ), res);
-  res = s48_cons( Bits_To_Symbols(WA.win_gravity, 1, Grav_Syms), 
+    res = s48_cons( ENTER_MASK( WA.all_event_mask ), res);
-		  res);
+    res = s48_cons( Bit_To_Symbol( WA.map_state, Map_State_Syms), res);
-  res = s48_cons( Bits_To_Symbols(WA.bit_gravity, 1, Bit_Grav_Syms), res);
+    res = s48_cons( WA.map_installed ? S48_TRUE : S48_FALSE, res);
-  res = s48_cons( Bits_To_Symbols(WA.class, 1, Class_Syms), res);
+    res = s48_cons( ENTER_COLORMAP( WA.colormap ), res);
-  res = s48_cons( s48_enter_integer(WA.root), res); // a Window !
+    res = s48_cons( WA.save_under ? S48_TRUE : s48_FALSE );
-  res = s48_cons( s48_enter_integer((long)WA.visual), res); // a Visual* !
+    res = s48_cons( ENTER_PIXEL(WA.backing_pixel), res);
-  res = s48_cons( s48_enter_integer(WA.depth), res);
+    res = s48_cons( s48_enter_integer(WA.backing_planes), res);
-  res = s48_cons( s48_enter_integer(WA.border_width), res);
+    res = s48_cons( Bit_To_Symbol(WA.backing_store, Backing_Store_Syms), 
-  res = s48_cons( s48_enter_integer(WA.height), res);
+		    res);
-  res = s48_cons( s48_enter_integer(WA.width), res);
+    res = s48_cons( Bit_To_Symbol(WA.win_gravity, Grav_Syms), 
-  res = s48_cons( s48_enter_integer(WA.y), res);
+		    res);
-  res = s48_cons( s48_enter_integer(WA.x), res);
+    res = s48_cons( Bit_To_Symbol(WA.bit_gravity, Bit_Grav_Syms), res);
+    res = s48_cons( Bit_To_Symbol(WA.class, Class_Syms), res);
+    res = s48_cons( ENTER_WINDOW(WA.root), res);
+    res = s48_cons( ENTER_VISUAL(WA.visual), res);
+    res = s48_cons( s48_enter_integer(WA.depth), res);
+    res = s48_cons( s48_enter_integer(WA.border_width), res);
+    res = s48_cons( s48_enter_integer(WA.height), res);
+    res = s48_cons( s48_enter_integer(WA.width), res);
+    res = s48_cons( s48_enter_integer(WA.y), res);
+    res = s48_cons( s48_enter_integer(WA.x), res);
+  }
 
   S48_GC_UNPROTECT();
   return res;

scheme/xlib/display.scm

@@ -23,7 +23,7 @@
 (define (display-default-root-window display)
   (let* ((Xdisplay (display-Xdisplay display))
 	 (Xwindow (%default-root-window Xdisplay)))
-    (make-window 0 Xwindow (make-display Xdisplay))))
+    (make-window Xwindow (make-display Xdisplay))))
 
 (define display-root-window display-default-root-window)
 

scheme/xlib/drawable.scm

@@ -0,0 +1,22 @@
+;(define (drawable-abstraction pixmap-fun window-fun)
+;  (lambda (drawable)
+;    (cond
+;     ((pixmap? drawable) (pixmap-fun drawable))
+;     ((window? drawable) (window-fun drawable))
+;     (else (error "expected a drawable object" drawable)))))
+
+;(define drawable-display (drawable-abstraction pixmap-display window-display))
+;(define drawable-Xobject (drawable-abstraction pixmap-Xpixmap window-Xwindow))
+
+;; not so sure with pixmap-root, not found in Elk.
+(define drawable-root (drawable-abstraction (lambda (pixm)
+					      (display-default-root-window
+					       (pixmap-display pixm)))
+					    window-root))
+(define drawable-x (drawable-abstraction pixmap-x window-x))
+(define drawable-y (drawable-abstraction pixmap-y window-y))
+(define drawable-width (drawable-abstraction pixmap-width window-width))
+(define drawable-height (drawable-abstraction pixmap-height window-height))
+(define drawable-border-width (drawable-abstraction pixmap-border-width 
+						    window-border-width))
+(define drawable-depth (drawable-abstraction pixmap-depth window-depth))

scheme/xlib/gcontext.scm

@@ -0,0 +1,165 @@
+;; ...
+
+(define (create-gcontext . args)
+  (let ((alist (named-args->alist args)))
+    (receive (drawable rest) (alist-split '((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))))))
+
+(import-lambda-definition %create-gcontext (Xdisplay Xdrawable alist)
+  "Create_Gc")
+
+;; ...
+
+(define (copy-gcontext gcontext drawable)
+  (let* ((new-gcontext (create-gcontext 'drawable drawable))
+	 (new-Xgcontext (gcontext-Xgcontext new-gcontext))
+	 (Xgcontext (gcontext-Xgcontext gcontext))
+	 (Xdisplay (display-Xdisplay (gcontext-display gcontext)))
+	 (%copy-gcontext Xdisplay Xgcontext new-Xgcontext))
+    new-gcontext))
+
+(import-lambda-definition %copy-gcontext (Xdisplay Xsource Xdest)
+  "Copy_Gc")
+
+;; ...
+
+(define (get-gcontext-values gcontext)
+  (let ((Xgcontext (gcontext-Xgcontext gcontext))
+	(Xdisplay (display-Xdisplay (gcontext-display gcontext))))
+    (let ((lst (%get-gcontext-values Xgcontext Xdisplay)))
+      (if (not lst)
+	  (error "cannot get gcontext values." gcontext)
+	  (let*
+	      ((alist (map cons
+			   '(function plane-mask foreground background 
+			     line-width line-style cap-style join-style 
+			     fill-style arc-mode tile stipple ts-x ts-y font 
+			     subwindow-mode exposures clip-x clip-y clip-mask 
+			     dash-offset dashes)
+			   lst))
+	       (mod-alist (map (lambda (name-val)
+				 (case (car name-val)
+			       ((plane-mask foreground background)
+				(cons (car name-val)
+				      (make-pixel (cdr name-val))))
+				;((tile stipple clip-mask)
+				;(cons (car name-val)
+				;      (make-pixmap (cdr name-val) dyp??)))
+				;((font) (cons (make-font ...??)))
+			       (else name-val)))
+			       alist))))
+	  mod-alist))))
+
+(import-lambda-defintion %get-gcontext-values (Xgcontext Xdisplay)
+  "Get_Gc_Values")
+
+;;...
+
+(define (make-gcontext-getter name)
+  (lambda (gcontext)
+    (cdr (assq name (get-gcontext-values gcontext)))))
+
+(define gcontext-function (make-gcontext-getter 'function))
+(define gcontext-plane-mask (make-gcontext-getter 'plane-mask))
+(define gcontext-foreground (make-gcontext-getter 'foreground))
+(define gcontext-background (make-gcontext-getter 'background))
+(define gcontext-line-width (make-gcontext-getter 'line-width))
+(define gcontext-line-style (make-gcontext-getter 'line-style))
+(define gcontext-cap-style (make-gcontext-getter 'cap-style))
+(define gcontext-join-style (make-gcontext-getter 'join-style))
+(define gcontext-fill-style (make-gcontext-getter 'fill-style))
+(define gcontext-arc-mode (make-gcontext-getter 'arc-mode))
+(define gcontext-tile (make-gcontext-getter 'tile))
+(define gcontext-stipple (make-gcontext-getter 'stipple))
+(define gcontext-ts-x (make-gcontext-getter 'ts-x))
+(define gcontext-ts-y (make-gcontext-getter 'ts-y))
+(define gcontext-font (make-gcontext-getter 'font))
+(define gcontext-subwindow-mode (make-gcontext-getter 'subwindow-mode))
+(define gcontext-exposures (make-gcontext-getter 'exposures))
+(define gcontext-clip-x (make-gcontext-getter 'clip-x))
+(define gcontext-clip-y (make-gcontext-getter 'clip-y))
+(define gcontext-clip-mask (make-gcontext-getter 'clip-mask))
+(define gcontext-dash-offset (make-gcontext-getter 'dash-offset))
+(define gcontext-dashes (make-gcontext-getter 'dashes))
+
+;; ...
+
+(define (change-gcontext gcontext . attrs)
+  (let* ((alist (named-args->alist attrs))
+	 (prep-alist 
+	  (map cons
+	       (map car alist)
+	       (map (lambda (value)
+		      (cond
+		       ((pixmap? value) (pixmap-Xpixmap value))
+		       ((font? value) (font-Xfont value)) ;;??
+		       ((pixel? value) (pixel-Xpixel value))
+		       (else value)))
+		    (map cdr alist)))))
+    (%change-gcontext (gcontext-Xgcontext gcontext)
+		      (display-Xdisplay (gcontext-display gcontext))
+		      prep-alist)))
+
+
+(import-lambda-definiton %change-gcontext (Xgcontext Xdisplay)
+  "Change_Gc")
+
+(define (make-gcontext-setter name)
+  (lambda (gcontext value)
+    (change-gcontext gcontext (cons name value))))
+
+(define set-gcontext-function! (make-gcontext-setter 'function))
+(define set-gcontext-plane-mask! (make-gcontext-setter 'plane-mask))
+(define set-gcontext-foreground! (make-gcontext-setter 'foreground))
+(define set-gcontext-background! (make-gcontext-setter 'background))
+(define set-gcontext-line-width! (make-gcontext-setter 'line-width))
+(define set-gcontext-line-style! (make-gcontext-setter 'line-style))
+(define set-gcontext-cap-style! (make-gcontext-setter 'cap-style))
+(define set-gcontext-join-style! (make-gcontext-setter 'join-style))
+(define set-gcontext-fill-style! (make-gcontext-setter 'fill-style))
+(define set-gcontext-fill-rule! (make-gcontext-setter 'fill-rule))
+(define set-gcontext-arc-mode! (make-gcontext-setter 'arc-mode))
+(define set-gcontext-tile! (make-gcontext-setter 'tile))
+(define set-gcontext-stipple! (make-gcontext-setter 'stipple))
+(define set-gcontext-ts-x! (make-gcontext-setter 'ts-x))
+(define set-gcontext-ts-y! (make-gcontext-setter 'ts-y))
+(define set-gcontext-font! (make-gcontext-setter 'font))
+(define set-gcontext-subwindow-mode! (make-gcontext-setter 'subwindow-mode))
+(define set-gcontext-exposures! (make-gcontext-setter 'exposures))
+(define set-gcontext-clip-x! (make-gcontext-setter 'clip-x))
+(define set-gcontext-clip-y! (make-gcontext-setter 'clip-y))
+(define set-gcontext-clip-mask! (make-gcontext-setter 'clip-mask))
+(define set-gcontext-dash-offset! (make-gcontext-setter 'dash-offset))
+(define set-gcontext-dashes! (make-gcontext-setter 'dashes))
+
+;; set-dashlist! is a more complex form of set-dashes!. (set-dashes! N) is 
+;; equivalent to (set-dash-list! .. #(N N))
+
+(define (set-gcontext-dashlist! gcontext dash-offset dash-list)
+  (%set-dashlist (gcontext-Xgcontext gcontext)
+		 (display-Xdisplay (gcontext-display gcontext))
+		 dash-offset
+		 dash-list))
+
+(import-lambda-definiton %set-dashlist (Xgcontext Xdisplay dashoffset dashlist)
+  "Set_Dashlist")
+
+;; ...
+
+(define (set-gcontext-clip-rectangles! gcontext x y rectangles ordering)
+  ...)
+
+

scheme/xlib/stuff.scm

@@ -17,3 +17,26 @@
 
 
 (define-exported-binding "string->symbol" string->symbol)
+
+
+;; alist-split returns multiple values. the first values are all associations 
+;; of the keys. and additionaly the "rest" of the alist as one value.
+
+(define (alist-split alist key-def-list)
+  (let ((keys (map car key-def-list)))
+    (let ((vals (map (lambda (key)
+		       (let ((v (assq key alist)))
+			 (if v v (assq key key-def-list))))
+		     keys))
+	  (rest (fold-right (lambda (this rest)
+			      (if (memq (car this) keys)
+				  rest
+				  (cons this rest)))
+			    '()
+			    alist)))
+      (apply values (append vals (list rest))))))
+
+;; according to the XLib constant "Null" which is defined as "0L"
+
+(define null-resource? zero?)
+(define null-resource 0)

scheme/xlib/window.scm

@@ -4,26 +4,9 @@
 
 (define (create-window . args)
   (let ((alist (named-args->alist args)))
-    ;; filter attributes
+    (receive (x y width height border-width parent change-win-attr-list)
-    (let* ((x 0)
+	     (alist-split alist '((x . 0) (y . 0) (width . #f) (height . #f)
-	   (y 0)
+				  (border-width . 2) (parent . #f)))
-	   (width #f)
-	   (height #f)
-	   (border-width 2)
-	   (parent #f)
-	   (change-win-attr-list '()))
-      (for-each (lambda (name-val)
-		  (let ((val (cdr name-val)))
-		    (case (car name-val)
-		      ((x) (set! x val))
-		      ((y) (set! y val))
-		      ((width) (set! width val))
-		      ((height) (set! height val))
-		      ((parent) (set! parent val))
-		      ((border-width) (set! border-width val))
-		      (else (set! change-win-attr-list
-				  (cons name-val change-win-attr-list))))))
-		alist)
       (let* ((display (window-display parent))
 	     (Xwindow (%create-window (display-Xdisplay display)
 				      (window-Xwindow parent)
@@ -31,7 +14,7 @@
 				      change-win-attr-list)))
 	(if (= Xwindow 0)
 	    (error "cannot create window")
-	    (make-window #f Xwindow display))))))
+	    (make-window Xwindow display))))))
 
 (import-lambda-definition %create-window (Xdisplay Xparent x y width height 
 						   border-width attrAlist)
@@ -95,20 +78,34 @@
 (define (get-window-attributes window)
   (let ((Xwindow (window-Xwindow window))
 	(Xdisplay (display-Xdisplay (window-display window))))
-    (let* ((lst (%get-window-attributes Xdisplay Xwindow))
+    (let ((lst (%get-window-attributes Xdisplay Xwindow)))
-	   (alist (map cons
+      (if (not lst)
-		       '(x y width height border-width depth visual root class 
+	  (error "cannot get window attributes." window)
-			   bit-gravity win-gravity backing-store backing-planes
+	  (let*
-			   backing-pixel save-under colormap map-installed
+	      ((alist (map cons
-			   map-state all-event-masks your-event-mask 
+			   '(x y width height border-width depth visual root 
-			   do-not-propagate-mask override-redirect screen)
+			     class bit-gravity win-gravity backing-store 
-		       lst))
+			     backing-planes backing-pixel save-under colormap 
-	   (mod-alist (map (lambda (name-val)
+			     map-installed map-state all-event-masks 
-			     (case (car name-val)
+			     your-event-mask do-not-propagate-mask 
-			       ;((root) (make-window ...
+			     override-redirect
-			       (else name-val)))
+			     ; screen not supported
-			   alist)))
+			   )
-      mod-alist)))
+			   lst))
+	       (mod-alist (map (lambda (name-val)
+				 (case (car name-val)
+				   ;((...-mask))
+				   ;((font) ...)
+				   ((backing-pixel) 
+				    (cons 'backing-pixel
+					  (make-pixel (cdr name-val))))
+				   ;((root) 
+				   ; (cons 'root 
+				   ;      (make-window (cdr name-val) dpy??)))
+			           ;((visual) ??)
+				   (else name-val)))
+			       alist)))
+	    mod-alist)))))
 
 (import-lambda-definition %get-window-attributes (Xdisplay Xwindow)
   "Get_Window_Attributes")

scheme/xlib/xlib-interfaces.scm

@@ -16,6 +16,9 @@
 	  window-set-tag!
 	  window-Xwindow
 	  window-display
+	  drawable-abstraction
+	  drawable-display
+	  drawable-Xobject
 
 	  make-color
 	  color?
@@ -35,6 +38,13 @@
 	  pixel-Xpixel
 	  pixel-tag
 
+	  make-gcontext
+	  gcontext?
+	  gcontext-display
+	  free-gcontext
+	  gcontext-Xgcontext
+	  gcontext-tag
+	  
 	  ))
 
 (define-structure xlib-types xlib-types-interface
@@ -49,7 +59,8 @@
 	 type/window-type
 	 type/color-type
 	 type/colormap-type
-	 type/pixel-type))
+	 type/pixel-type
+	 type/gcontext-type))
 
 ;;; Basic package
 
@@ -190,12 +201,31 @@
   (open scsh
 	scheme
 	external-calls
+	receiving
 	xlib-types
 	xlib-basic
-;	xlib-graphics ;; for clear-window
+	xlib-graphics ;; for clear-window
 	)
   (files window))
 
+;;; the display-interface
+
+(define-interface xlib-drawable-interface
+  (export drawable?
+	  drawable-root
+	  drawable-x
+	  drawable-y
+	  drawable-width
+	  drawable-height
+	  drawable-border-width
+	  drawable-depth))
+
+(define-structure xlib-drawable xlib-drawable-interface
+  (open scsh
+	scheme
+	xlib-types)
+  (files drawable))
+
 ;;; the color-interface
 
 (define-interface xlib-color-interface
@@ -251,3 +281,77 @@
 	  black-pixel
 	  white-pixel
 	  ))
+
+;;; the gcontext-interface
+
+(define-interface xlib-gcontext-interface
+  (open scsh
+	scheme
+	external-calls
+	receiving
+	xlib-types
+	xlib-basic)
+  (files gcontext))
+
+(define-structure xlib-gcontext xlib-gcontext-interface
+  (export gcontext?
+	  gcontext-display
+	  create-gcontext
+	  copy-gcontext
+	  free-gcontext
+
+	  query-best-size
+	  query-best-cursor
+	  query-best-title
+	  query-best-stipple
+
+	  gcontext-function
+	  gcontext-plane-mask
+	  gcontext-foreground
+	  gcontext-background
+	  gcontext-line-width
+	  gcontext-line-style
+	  gcontext-cap-style
+	  gcontext-join-style
+	  gcontext-fill-style
+	  gcontext-fill-rule
+	  gcontext-arc-mode
+	  gcontext-tile
+	  gcontext-stipple
+	  gcontext-ts-x
+	  gcontext-ts-y
+	  gcontext-font
+	  gcontext-subwindow-mode
+	  gcontext-exposures
+	  gcontext-clip-x
+	  gcontext-clip-y
+	  gcontext-clip-mask
+	  gcontext-dash-offset
+	  gcontext-dashes
+
+	  set-gcontext-function!
+	  set-gcontext-plane-mask!
+	  set-gcontext-foreground!
+	  set-gcontext-background!
+	  set-gcontext-line-width!
+	  set-gcontext-line-style!
+	  set-gcontext-cap-style!
+	  set-gcontext-join-style!
+	  set-gcontext-fill-style!
+	  set-gcontext-fill-rule!
+	  set-gcontext-arc-mode!
+	  set-gcontext-tile!
+	  set-gcontext-stipple!
+	  set-gcontext-ts-x!
+	  set-gcontext-ts-y!
+	  set-gcontext-font!
+	  set-gcontext-subwindow-mode!
+	  set-gcontext-exposures!
+	  set-gcontext-clip-x!
+	  set-gcontext-clip-y!
+	  set-gcontext-clip-mask!
+	  set-gcontext-dash-offset!
+
+	  set-gcontext-clip-rectangles!
+	  set-gcontext-dashlist!
+	  ))