fixed some bugs and typos.
This commit is contained in:
parent
6162bf3dec
commit
c72bd59c42
|
@ -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))))
|
||||||
|
|
|
@ -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)))))
|
||||||
|
|
|
@ -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")
|
||||||
|
|
|
@ -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")
|
||||||
|
|
||||||
|
|
||||||
; ---
|
; ---
|
||||||
|
|
|
@ -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")
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -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)
|
||||||
|
|
Loading…
Reference in New Issue