From c72bd59c42d9353617934a585d1344e273747d54 Mon Sep 17 00:00:00 2001 From: frese Date: Wed, 29 Aug 2001 14:43:49 +0000 Subject: [PATCH] fixed some bugs and typos. --- scheme/xlib/client.scm | 29 +++++++++++++++++++---------- scheme/xlib/colormap.scm | 4 ++-- scheme/xlib/font-type.scm | 4 +++- scheme/xlib/grab.scm | 34 +++++++++++++++++----------------- scheme/xlib/graphics.scm | 16 ++++++---------- scheme/xlib/utility.scm | 20 +++++++++++--------- 6 files changed, 58 insertions(+), 49 deletions(-) diff --git a/scheme/xlib/client.scm b/scheme/xlib/client.scm index 36359a6..ebfdd6b 100644 --- a/scheme/xlib/client.scm +++ b/scheme/xlib/client.scm @@ -124,15 +124,19 @@ (let ((res (%wm-hints (display-Xdisplay (window-display window)) (window-Xwindow window))) (make-window* (lambda (Xwindow) - (make-window Xwindow (window-display window) - #f))) + (if (null? Xwindow) + 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*) + (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 icon-mask window-group urgency) @@ -197,7 +201,7 @@ (set-text-property! w s xa-wm-client-machine)) (define (wm-normal-hints window) - (let* ((v (%wm-normal-hints (display-Xdisplay (window-Xwindow window)) + (let* ((v (%wm-normal-hints (display-Xdisplay (window-display window)) (window-Xwindow window))) (alist (map cons '(x y width height us-position us-size @@ -207,7 +211,9 @@ gravity) (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,6 +221,9 @@ (window-Xwindow window) alist))) +(import-lambda-definition %set-wm-normal-hints (Xdisplay Xwindow alist) + "scx_Set_Wm_Normal_Hints") + (define (icon-sizes window) (let ((r (%icon-sizes (display-Xdisplay (window-display window)) (window-Xwindow window)))) diff --git a/scheme/xlib/colormap.scm b/scheme/xlib/colormap.scm index 2df85ef..7875b54 100644 --- a/scheme/xlib/colormap.scm +++ b/scheme/xlib/colormap.scm @@ -1,9 +1,9 @@ ;; Author: David Frese ;; alloc-color returns the pixel closest to the specified color supported by the -;; hardware. See XAllocColor. +;; hardware. See XAllocColor. The color parameter is mutated! -(define (alloc-color colormap color) +(define (alloc-color! colormap color) (let ((Xpixel (%alloc-color (colormap-Xcolormap colormap) (color-Xcolor color) (display-Xdisplay (colormap-display colormap))))) diff --git a/scheme/xlib/font-type.scm b/scheme/xlib/font-type.scm index 3f90adf..17545d6 100644 --- a/scheme/xlib/font-type.scm +++ b/scheme/xlib/font-type.scm @@ -37,7 +37,9 @@ (if (symbol? font-name) (symbol->string font-name) font-name)))) - (make-font font-name #f Xfontstruct display #t))) + (if (= Xfontstruct 0) + #f + (make-font font-name #f Xfontstruct display #t)))) (import-lambda-definition %load-font (Xdisplay font_name) "scx_Load_Font") diff --git a/scheme/xlib/grab.scm b/scheme/xlib/grab.scm index 5c26050..6af8f6f 100644 --- a/scheme/xlib/grab.scm +++ b/scheme/xlib/grab.scm @@ -41,10 +41,10 @@ (window-Xwindow confine-to) (cursor-Xcursor cursor))) -(import-lambda-definfition %grab-button (Xdisplay Xwindow button - mods ownerp events - ptr-sync? kbd-sync? - Xconfine-to Xcursor) +(import-lambda-definition %grab-button (Xdisplay Xwindow button + mods ownerp events + ptr-sync? kbd-sync? + Xconfine-to Xcursor) "scx_Grab_Button") @@ -74,27 +74,27 @@ ; --- -(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)) +(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-keybord (Xdisplay Xwindow - owner? ptr-sync? kbd-sync? - time) - "scx_Grab_Keybord") +(import-lambda-definition %grab-keyboard (Xdisplay Xwindow + owner? ptr-sync? kbd-sync? + time) + "scx_Grab_Keyboard") ; --- -(define (ungrab-keybord display time) - (%ungrab-keybord (display-Xdisplay display) - time)) +(define (ungrab-keyboard display time) + (%ungrab-keyboard (display-Xdisplay display) + time)) -(import-lambda-definition %ungrab-keybord (Xdisplay time) - "scx_Ungrab_Keybord") +(import-lambda-definition %ungrab-keyboard (Xdisplay time) + "scx_Ungrab_Keyboard") ; --- diff --git a/scheme/xlib/graphics.scm b/scheme/xlib/graphics.scm index c4075cb..65d2344 100644 --- a/scheme/xlib/graphics.scm +++ b/scheme/xlib/graphics.scm @@ -58,7 +58,7 @@ x y)) (import-lambda-definition %draw-point (Xdisplay Xdrawable Xgcontext x y) - "scx_Draw-Point") + "scx_Draw_Point") ;; _____ @@ -92,7 +92,7 @@ (define (draw-lines drawable gcontext points relative?) (%draw-lines (display-Xdisplay (drawable-display drawable)) - (drawalbe-Xobject drawable) + (drawable-Xobject drawable) (gcontext-Xgcontext gcontext) (list->vector points) relative?)) @@ -105,14 +105,14 @@ ;; Note: points is a list which contains lists with 4 ;; integers in Form: (x1, y1, x2, y2) -(define (draw-segments drawalbe gcontext points) - (%draw-segments (display-Xdisplay (drawable-display drawalbe)) +(define (draw-segments drawable gcontext points) + (%draw-segments (display-Xdisplay (drawable-display drawable)) (drawable-Xobject drawable) (gcontext-Xgcontext gcontext) (list->vector points))) (import-lambda-definition %draw-segments (Xdisplay Xdrawable Xgcontext vec) - "Draw_Segments") + "scx_Draw_Segments") (define (draw-rectangle drawable gcontext x y width height) @@ -205,8 +205,4 @@ (import-lambda-definition %fill-polygon (Xdisplay Xdrawable Xgcontext vec relative shape) - "scx_Fill-Polygon") - - - - + "scx_Fill_Polygon") diff --git a/scheme/xlib/utility.scm b/scheme/xlib/utility.scm index be826b9..b2e4ff5 100644 --- a/scheme/xlib/utility.scm +++ b/scheme/xlib/utility.scm @@ -25,13 +25,13 @@ (str-or-sym->str program) (str-or-sym->str option))) -(import-lambda-defition %get-default (Xdisplay program option) - "scx_Get_Default") +(import-lambda-definition %get-default (Xdisplay program option) + "scx_Get_Default") ; --- -(define (resource-manager-sting dpy) +(define (resource-manager-string dpy) (%resource-manager-string (display-Xdisplay dpy))) (import-lambda-definition %resource-manager-string (Xdisplay) @@ -42,7 +42,7 @@ (define (parse-geometry string) (reverse (%parse-geometry string))) -(import-lambda-definiton %parse-geometry (string) +(import-lambda-definition %parse-geometry (string) "scx_Parse_Geometry") ; --- @@ -55,9 +55,9 @@ (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)))) + (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) (if (<= 0 buf 7) @@ -85,10 +85,12 @@ 100000 #f)) (if (and (eq? type xa-string) - (< format 32)) data "")) + (< format 32)) + data + "")) ""))) - (set! fetch-bytes (lambda (dyp) + (set! fetch-bytes (lambda (dpy) (fetch-buffer dpy 0))) (set! rotate-buffers (lambda (dpy delta)