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))
(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))))

View File

@ -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)))))

View File

@ -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")

View File

@ -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")
; ---

View File

@ -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")

View File

@ -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)