Update of /cvsroot/scsh/scx/scheme/xlib
In directory usw-pr-cvs1:/tmp/cvs-serv30722
Modified Files:
client.scm colormap.scm font-type.scm grab.scm graphics.scm
utility.scm
Log Message:
fixed some bugs and typos.
Index: client.scm
===================================================================
RCS file: /cvsroot/scsh/scx/scheme/xlib/client.scm,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -r1.1 -r1.2
*** client.scm 2001/08/21 14:45:32 1.1
--- client.scm 2001/08/29 14:43:49 1.2
***************
*** 125,137 ****
(window-Xwindow window)))
(make-window* (lambda (Xwindow)
! (make-window Xwindow (window-display window)
! #f)))
(make-pixmap* (lambda (Xpixmap)
! (make-pixmap Xpixmap (window-display window)
! #f))))
! (vector-set! res 2 make-pixmap*)
! (vector-set! res 3 make-window*)
! (vector-set! res 6 make-pixmap*)
! (vector-set! res 7 make-window*)
(map cons
'(input? initial-state icon-pixmap icon-window icon-x icon-y
--- 125,141 ----
(window-Xwindow window)))
(make-window* (lambda (Xwindow)
! (if (null? Xwindow)
! Xwindow
! (make-window Xwindow (window-display window)
! #f))))
(make-pixmap* (lambda (Xpixmap)
! (if (null? Xpixmap)
! Xpixmap
! (make-pixmap Xpixmap (window-display window)
! #f)))))
! (vector-set! res 2 (make-pixmap* (vector-ref res 2)))
! (vector-set! res 3 (make-window* (vector-ref res 3)))
! (vector-set! res 6 (make-pixmap* (vector-ref res 6)))
! (vector-set! res 7 (make-window* (vector-ref res 7)))
(map cons
'(input? initial-state icon-pixmap icon-window icon-x icon-y
***************
*** 198,202 ****
(define (wm-normal-hints window)
! (let* ((v (%wm-normal-hints (display-Xdisplay (window-Xwindow window))
(window-Xwindow window)))
(alist (map cons
--- 202,206 ----
(define (wm-normal-hints window)
! (let* ((v (%wm-normal-hints (display-Xdisplay (window-display window))
(window-Xwindow window)))
(alist (map cons
***************
*** 208,213 ****
(vector->list v))))
alist))
-
(define (set-wm-normal-hints! window . args)
(let ((alist (named-args->alist args)))
--- 212,219 ----
(vector->list v))))
alist))
+ (import-lambda-definition %wm-normal-hints (Xdisplay Xwindow)
+ "scx_Wm_Normal_Hints")
+
(define (set-wm-normal-hints! window . args)
(let ((alist (named-args->alist args)))
***************
*** 215,218 ****
--- 221,227 ----
(window-Xwindow window)
alist)))
+
+ (import-lambda-definition %set-wm-normal-hints (Xdisplay Xwindow alist)
+ "scx_Set_Wm_Normal_Hints")
(define (icon-sizes window)
Index: colormap.scm
===================================================================
RCS file: /cvsroot/scsh/scx/scheme/xlib/colormap.scm,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -r1.6 -r1.7
*** colormap.scm 2001/08/22 14:53:08 1.6
--- colormap.scm 2001/08/29 14:43:49 1.7
***************
*** 2,8 ****
;; alloc-color returns the pixel closest to the specified color supported by
the
! ;; hardware. See XAllocColor.
! (define (alloc-color colormap color)
(let ((Xpixel (%alloc-color (colormap-Xcolormap colormap)
(color-Xcolor color)
--- 2,8 ----
;; alloc-color returns the pixel closest to the specified color supported by
the
! ;; hardware. See XAllocColor. The color parameter is mutated!
! (define (alloc-color! colormap color)
(let ((Xpixel (%alloc-color (colormap-Xcolormap colormap)
(color-Xcolor color)
Index: font-type.scm
===================================================================
RCS file: /cvsroot/scsh/scx/scheme/xlib/font-type.scm,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -r1.5 -r1.6
*** font-type.scm 2001/08/21 14:51:22 1.5
--- font-type.scm 2001/08/29 14:43:49 1.6
***************
*** 38,42 ****
(symbol->string font-name)
font-name))))
! (make-font font-name #f Xfontstruct display #t)))
(import-lambda-definition %load-font (Xdisplay font_name)
--- 38,44 ----
(symbol->string font-name)
font-name))))
! (if (= Xfontstruct 0)
! #f
! (make-font font-name #f Xfontstruct display #t))))
(import-lambda-definition %load-font (Xdisplay font_name)
Index: grab.scm
===================================================================
RCS file: /cvsroot/scsh/scx/scheme/xlib/grab.scm,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -r1.1 -r1.2
*** grab.scm 2001/08/22 12:06:41 1.1
--- grab.scm 2001/08/29 14:43:49 1.2
***************
*** 42,49 ****
(cursor-Xcursor cursor)))
! (import-lambda-definfition %grab-button (Xdisplay Xwindow button
! mods ownerp events
! ptr-sync? kbd-sync?
! Xconfine-to Xcursor)
"scx_Grab_Button")
--- 42,49 ----
(cursor-Xcursor cursor)))
! (import-lambda-definition %grab-button (Xdisplay Xwindow button
! mods ownerp events
! ptr-sync? kbd-sync?
! Xconfine-to Xcursor)
"scx_Grab_Button")
***************
*** 75,87 ****
; ---
! (define (grab-keybord window owner? ptr-sync? kbd-sync? time)
! (%grab-keybord (display-Xdisplay (window-display window))
! (window-Xwindow window)
! owner? ptr-sync? kbd-sync? time))
!
! (import-lambda-definition %grab-keybord (Xdisplay Xwindow
! owner? ptr-sync? kbd-sync?
! time)
! "scx_Grab_Keybord")
--- 75,87 ----
; ---
! (define (grab-keyboard window owner? ptr-sync? kbd-sync? time)
! (%grab-keyboard (display-Xdisplay (window-display window))
! (window-Xwindow window)
! owner? ptr-sync? kbd-sync? time))
!
! (import-lambda-definition %grab-keyboard (Xdisplay Xwindow
! owner? ptr-sync? kbd-sync?
! time)
! "scx_Grab_Keyboard")
***************
*** 89,99 ****
! (define (ungrab-keybord display time)
! (%ungrab-keybord (display-Xdisplay display)
! time))
! (import-lambda-definition %ungrab-keybord (Xdisplay time)
! "scx_Ungrab_Keybord")
--- 89,99 ----
! (define (ungrab-keyboard display time)
! (%ungrab-keyboard (display-Xdisplay display)
! time))
! (import-lambda-definition %ungrab-keyboard (Xdisplay time)
! "scx_Ungrab_Keyboard")
Index: graphics.scm
===================================================================
RCS file: /cvsroot/scsh/scx/scheme/xlib/graphics.scm,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -r1.5 -r1.6
*** graphics.scm 2001/08/22 11:49:01 1.5
--- graphics.scm 2001/08/29 14:43:49 1.6
***************
*** 59,63 ****
(import-lambda-definition %draw-point (Xdisplay Xdrawable Xgcontext x y)
! "scx_Draw-Point")
--- 59,63 ----
(import-lambda-definition %draw-point (Xdisplay Xdrawable Xgcontext x y)
! "scx_Draw_Point")
***************
*** 93,97 ****
(define (draw-lines drawable gcontext points relative?)
(%draw-lines (display-Xdisplay (drawable-display drawable))
! (drawalbe-Xobject drawable)
(gcontext-Xgcontext gcontext)
(list->vector points)
--- 93,97 ----
(define (draw-lines drawable gcontext points relative?)
(%draw-lines (display-Xdisplay (drawable-display drawable))
! (drawable-Xobject drawable)
(gcontext-Xgcontext gcontext)
(list->vector points)
***************
*** 106,111 ****
;; integers in Form: (x1, y1, x2, y2)
! (define (draw-segments drawalbe gcontext points)
! (%draw-segments (display-Xdisplay (drawable-display drawalbe))
(drawable-Xobject drawable)
(gcontext-Xgcontext gcontext)
--- 106,111 ----
;; integers in Form: (x1, y1, x2, y2)
! (define (draw-segments drawable gcontext points)
! (%draw-segments (display-Xdisplay (drawable-display drawable))
(drawable-Xobject drawable)
(gcontext-Xgcontext gcontext)
***************
*** 113,117 ****
(import-lambda-definition %draw-segments (Xdisplay Xdrawable Xgcontext vec)
! "Draw_Segments")
--- 113,117 ----
(import-lambda-definition %draw-segments (Xdisplay Xdrawable Xgcontext vec)
! "scx_Draw_Segments")
***************
*** 206,212 ****
(import-lambda-definition %fill-polygon (Xdisplay Xdrawable Xgcontext
vec relative shape)
! "scx_Fill-Polygon")
!
!
!
!
--- 206,208 ----
(import-lambda-definition %fill-polygon (Xdisplay Xdrawable Xgcontext
vec relative shape)
! "scx_Fill_Polygon")
Index: utility.scm
===================================================================
RCS file: /cvsroot/scsh/scx/scheme/xlib/utility.scm,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -r1.1 -r1.2
*** utility.scm 2001/08/28 14:45:09 1.1
--- utility.scm 2001/08/29 14:43:49 1.2
***************
*** 26,36 ****
(str-or-sym->str option)))
! (import-lambda-defition %get-default (Xdisplay program option)
! "scx_Get_Default")
; ---
! (define (resource-manager-sting dpy)
(%resource-manager-string (display-Xdisplay dpy)))
--- 26,36 ----
(str-or-sym->str option)))
! (import-lambda-definition %get-default (Xdisplay program option)
! "scx_Get_Default")
; ---
! (define (resource-manager-string dpy)
(%resource-manager-string (display-Xdisplay dpy)))
***************
*** 43,47 ****
(reverse (%parse-geometry string)))
! (import-lambda-definiton %parse-geometry (string)
"scx_Parse_Geometry")
--- 43,47 ----
(reverse (%parse-geometry string)))
! (import-lambda-definition %parse-geometry (string)
"scx_Parse_Geometry")
***************
*** 56,62 ****
(let ((xa-string (make-atom 31)) ; (31 is XA_STRING)
(xa-cut-buffers
! (make-vector (make-atom 9) (make-aotm 10) (make-atom 11)
! (make-atom 12) (make-atom 13) (make-atom 14)
! (make-aotm 15) (make-atom 16))))
;(9...16 are XA_CUT_BUFFER0...XA_CUT_BUFFER7)
(set! store-buffer (lambda (dpy bytes buf)
--- 56,62 ----
(let ((xa-string (make-atom 31)) ; (31 is XA_STRING)
(xa-cut-buffers
! (vector (make-atom 9) (make-atom 10) (make-atom 11)
! (make-atom 12) (make-atom 13) (make-atom 14)
! (make-atom 15) (make-atom 16))))
;(9...16 are XA_CUT_BUFFER0...XA_CUT_BUFFER7)
(set! store-buffer (lambda (dpy bytes buf)
***************
*** 86,93 ****
#f))
(if (and (eq? type xa-string)
! (< format 32)) data ""))
"")))
! (set! fetch-bytes (lambda (dyp)
(fetch-buffer dpy 0)))
--- 86,95 ----
#f))
(if (and (eq? type xa-string)
! (< format 32))
! data
! ""))
"")))
! (set! fetch-bytes (lambda (dpy)
(fetch-buffer dpy 0)))
|