fixed some bugs and typos.

This commit is contained in:
frese 2001-08-29 14:43:49 +00:00
parent 6162bf3dec
commit c72bd59c42
6 changed files with 58 additions and 49 deletions

View File

@ -124,15 +124,19 @@
(let ((res (%wm-hints (display-Xdisplay (window-display window)) (let ((res (%wm-hints (display-Xdisplay (window-display window))
(window-Xwindow window))) (window-Xwindow window)))
(make-window* (lambda (Xwindow) (make-window* (lambda (Xwindow)
(make-window Xwindow (window-display window) (if (null? Xwindow)
#f))) Xwindow
(make-window Xwindow (window-display window)
#f))))
(make-pixmap* (lambda (Xpixmap) (make-pixmap* (lambda (Xpixmap)
(make-pixmap Xpixmap (window-display window) (if (null? Xpixmap)
#f)))) Xpixmap
(vector-set! res 2 make-pixmap*) (make-pixmap Xpixmap (window-display window)
(vector-set! res 3 make-window*) #f)))))
(vector-set! res 6 make-pixmap*) (vector-set! res 2 (make-pixmap* (vector-ref res 2)))
(vector-set! res 7 make-window*) (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 (map cons
'(input? initial-state icon-pixmap icon-window icon-x icon-y '(input? initial-state icon-pixmap icon-window icon-x icon-y
icon-mask window-group urgency) icon-mask window-group urgency)
@ -197,7 +201,7 @@
(set-text-property! w s xa-wm-client-machine)) (set-text-property! w s xa-wm-client-machine))
(define (wm-normal-hints window) (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))) (window-Xwindow window)))
(alist (map cons (alist (map cons
'(x y width height us-position us-size '(x y width height us-position us-size
@ -207,7 +211,9 @@
gravity) gravity)
(vector->list v)))) (vector->list v))))
alist)) alist))
(import-lambda-definition %wm-normal-hints (Xdisplay Xwindow)
"scx_Wm_Normal_Hints")
(define (set-wm-normal-hints! window . args) (define (set-wm-normal-hints! window . args)
(let ((alist (named-args->alist args))) (let ((alist (named-args->alist args)))
@ -215,6 +221,9 @@
(window-Xwindow window) (window-Xwindow window)
alist))) alist)))
(import-lambda-definition %set-wm-normal-hints (Xdisplay Xwindow alist)
"scx_Set_Wm_Normal_Hints")
(define (icon-sizes window) (define (icon-sizes window)
(let ((r (%icon-sizes (display-Xdisplay (window-display window)) (let ((r (%icon-sizes (display-Xdisplay (window-display window))
(window-Xwindow window)))) (window-Xwindow window))))

View File

@ -1,9 +1,9 @@
;; Author: David Frese ;; Author: David Frese
;; alloc-color returns the pixel closest to the specified color supported by the ;; 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) (let ((Xpixel (%alloc-color (colormap-Xcolormap colormap)
(color-Xcolor color) (color-Xcolor color)
(display-Xdisplay (colormap-display colormap))))) (display-Xdisplay (colormap-display colormap)))))

View File

@ -37,7 +37,9 @@
(if (symbol? font-name) (if (symbol? font-name)
(symbol->string font-name) (symbol->string font-name)
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) (import-lambda-definition %load-font (Xdisplay font_name)
"scx_Load_Font") "scx_Load_Font")

View File

@ -41,10 +41,10 @@
(window-Xwindow confine-to) (window-Xwindow confine-to)
(cursor-Xcursor cursor))) (cursor-Xcursor cursor)))
(import-lambda-definfition %grab-button (Xdisplay Xwindow button (import-lambda-definition %grab-button (Xdisplay Xwindow button
mods ownerp events mods ownerp events
ptr-sync? kbd-sync? ptr-sync? kbd-sync?
Xconfine-to Xcursor) Xconfine-to Xcursor)
"scx_Grab_Button") "scx_Grab_Button")
@ -74,27 +74,27 @@
; --- ; ---
(define (grab-keybord window owner? ptr-sync? kbd-sync? time) (define (grab-keyboard window owner? ptr-sync? kbd-sync? time)
(%grab-keybord (display-Xdisplay (window-display window)) (%grab-keyboard (display-Xdisplay (window-display window))
(window-Xwindow window) (window-Xwindow window)
owner? ptr-sync? kbd-sync? time)) owner? ptr-sync? kbd-sync? time))
(import-lambda-definition %grab-keybord (Xdisplay Xwindow (import-lambda-definition %grab-keyboard (Xdisplay Xwindow
owner? ptr-sync? kbd-sync? owner? ptr-sync? kbd-sync?
time) time)
"scx_Grab_Keybord") "scx_Grab_Keyboard")
; --- ; ---
(define (ungrab-keybord display time) (define (ungrab-keyboard display time)
(%ungrab-keybord (display-Xdisplay display) (%ungrab-keyboard (display-Xdisplay display)
time)) time))
(import-lambda-definition %ungrab-keybord (Xdisplay time) (import-lambda-definition %ungrab-keyboard (Xdisplay time)
"scx_Ungrab_Keybord") "scx_Ungrab_Keyboard")
; --- ; ---

View File

@ -58,7 +58,7 @@
x y)) x y))
(import-lambda-definition %draw-point (Xdisplay Xdrawable Xgcontext 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?) (define (draw-lines drawable gcontext points relative?)
(%draw-lines (display-Xdisplay (drawable-display drawable)) (%draw-lines (display-Xdisplay (drawable-display drawable))
(drawalbe-Xobject drawable) (drawable-Xobject drawable)
(gcontext-Xgcontext gcontext) (gcontext-Xgcontext gcontext)
(list->vector points) (list->vector points)
relative?)) relative?))
@ -105,14 +105,14 @@
;; Note: points is a list which contains lists with 4 ;; Note: points is a list which contains lists with 4
;; integers in Form: (x1, y1, x2, y2) ;; integers in Form: (x1, y1, x2, y2)
(define (draw-segments drawalbe gcontext points) (define (draw-segments drawable gcontext points)
(%draw-segments (display-Xdisplay (drawable-display drawalbe)) (%draw-segments (display-Xdisplay (drawable-display drawable))
(drawable-Xobject drawable) (drawable-Xobject drawable)
(gcontext-Xgcontext gcontext) (gcontext-Xgcontext gcontext)
(list->vector points))) (list->vector points)))
(import-lambda-definition %draw-segments (Xdisplay Xdrawable Xgcontext vec) (import-lambda-definition %draw-segments (Xdisplay Xdrawable Xgcontext vec)
"Draw_Segments") "scx_Draw_Segments")
(define (draw-rectangle drawable gcontext x y width height) (define (draw-rectangle drawable gcontext x y width height)
@ -205,8 +205,4 @@
(import-lambda-definition %fill-polygon (Xdisplay Xdrawable Xgcontext (import-lambda-definition %fill-polygon (Xdisplay Xdrawable Xgcontext
vec relative shape) vec relative shape)
"scx_Fill-Polygon") "scx_Fill_Polygon")

View File

@ -25,13 +25,13 @@
(str-or-sym->str program) (str-or-sym->str program)
(str-or-sym->str option))) (str-or-sym->str option)))
(import-lambda-defition %get-default (Xdisplay program option) (import-lambda-definition %get-default (Xdisplay program option)
"scx_Get_Default") "scx_Get_Default")
; --- ; ---
(define (resource-manager-sting dpy) (define (resource-manager-string dpy)
(%resource-manager-string (display-Xdisplay dpy))) (%resource-manager-string (display-Xdisplay dpy)))
(import-lambda-definition %resource-manager-string (Xdisplay) (import-lambda-definition %resource-manager-string (Xdisplay)
@ -42,7 +42,7 @@
(define (parse-geometry string) (define (parse-geometry string)
(reverse (%parse-geometry string))) (reverse (%parse-geometry string)))
(import-lambda-definiton %parse-geometry (string) (import-lambda-definition %parse-geometry (string)
"scx_Parse_Geometry") "scx_Parse_Geometry")
; --- ; ---
@ -55,9 +55,9 @@
(let ((xa-string (make-atom 31)) ; (31 is XA_STRING) (let ((xa-string (make-atom 31)) ; (31 is XA_STRING)
(xa-cut-buffers (xa-cut-buffers
(make-vector (make-atom 9) (make-aotm 10) (make-atom 11) (vector (make-atom 9) (make-atom 10) (make-atom 11)
(make-atom 12) (make-atom 13) (make-atom 14) (make-atom 12) (make-atom 13) (make-atom 14)
(make-aotm 15) (make-atom 16)))) (make-atom 15) (make-atom 16))))
;(9...16 are XA_CUT_BUFFER0...XA_CUT_BUFFER7) ;(9...16 are XA_CUT_BUFFER0...XA_CUT_BUFFER7)
(set! store-buffer (lambda (dpy bytes buf) (set! store-buffer (lambda (dpy bytes buf)
(if (<= 0 buf 7) (if (<= 0 buf 7)
@ -85,10 +85,12 @@
100000 100000
#f)) #f))
(if (and (eq? type xa-string) (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))) (fetch-buffer dpy 0)))
(set! rotate-buffers (lambda (dpy delta) (set! rotate-buffers (lambda (dpy delta)