diff --git a/scheme/xlib/cursor.scm b/scheme/xlib/cursor.scm index 25716b4..8841d8a 100644 --- a/scheme/xlib/cursor.scm +++ b/scheme/xlib/cursor.scm @@ -15,11 +15,11 @@ "scx_Create_Pixmap_Cursor") (define (create-glyph-cursor src src-char mask mask-char foreground background) - (let ((display (pixmap-display src))) + (let ((display (font-display src))) (make-cursor (%create-glyph-cursor (display-Xdisplay display) - (pixmap-Xpixmap src) + (font-Xfont src) src-char - (pixmap-Xpixmap mask) + (font-Xfont mask) mask-char (color-Xcolor foreground) (color-Xcolor background)) @@ -34,8 +34,8 @@ (let ((font (load-font display "cursor"))) (create-glyph-cursor font src-char font (+ 1 src-char) - (make-color 0 0 0) - (make-color 1 1 1)) + (create-color 0 0 0) + (create-color 65535 65535 65535)) ;; elk protects that with unwind-protect, and calls unload-font to free ;; the font, but we free it anyway on garbage-collection...(??) ;;(unload-font font) diff --git a/scheme/xlib/event.scm b/scheme/xlib/event.scm index efd0a1a..b499e4c 100644 --- a/scheme/xlib/event.scm +++ b/scheme/xlib/event.scm @@ -62,7 +62,7 @@ (cdr r))))) (import-lambda-definition %next-event (Xdisplay) - "Next_Event") + "scx_Next_Event") (define (peek-event display) (let ((r (%peek-event (display-Xdisplay display)))) diff --git a/scheme/xlib/font.scm b/scheme/xlib/font.scm index 52dab69..5b78f0f 100644 --- a/scheme/xlib/font.scm +++ b/scheme/xlib/font.scm @@ -6,16 +6,16 @@ (make-font #f #f Xfontstruct display #f))) (import-lambda-definition %gcontext-font (Xdisplay Xgcontext) - "GContext_Font") + "scx_GContext_Font") (define (list-font-names display pattern) - (%list-font-names (display-Xdisplay) + (%list-font-names (display-Xdisplay display) (if (symbol? pattern) (symbol->string pattern) pattern))) (import-lambda-definition %list-font-names (Xdisplay pattern) - "List_Font_Names") + "scx_List_Font_Names") (define (list-fonts display pattern) (let ((v (%list-fonts (display-Xdisplay display) @@ -31,7 +31,7 @@ v)))) (import-lambda-definition %list-fonts (Xdisplay pattern) - "List_Fonts") + "scx_List_Fonts") (define (font-properties font) (let ((v (%font-properties (font-Xfontstruct font)))) @@ -41,7 +41,7 @@ v)))) (import-lambda-definition %font-properties (Xfontstruct) - "Font_Properties") + "scx_Font_Properties") (define (font-property font property-name) (let ((atom (intern-atom (font-display font) @@ -50,13 +50,13 @@ (atom-Xatom atom)))) (import-lambda-definition %font-property (Xfontstruct Xatom) - "Font_Property") + "scx_Font_Property") (define (font-path display) (vector->list (%font-path (display-Xdisplay display)))) (import-lambda-definition %font-path (Xdisplay) - "Font_Path") + "scx_Font_Path") (define (set-font-path! display path) (%set-font-path! (display-Xdisplay display) @@ -67,7 +67,7 @@ (list->vector path)))) (import-lambda-definition %set-font-path! (Xdisplay path) - "Set_Font_Path") + "scx_Set_Font_Path") ;; ............ @@ -75,7 +75,7 @@ (%font-info (font-Xfontstruct font))) (import-lambda-definition %font-info (Xfontstruct) - "Font_Info") + "scx_Font_Info") (define (font-info-getter num) (lambda (font) @@ -105,7 +105,7 @@ (calc-index font i)))))) (import-lambda-definition %char-info (Xfontstruct index) - "Char_Info") + "scx_Char_Info") ;; calc-index calculates the array-position in XFontStruct.per_char by giving ;; the character index which ranges between [font-min-byte2...font-max-byte2] diff --git a/scheme/xlib/graphics.scm b/scheme/xlib/graphics.scm index fb35be6..fc2748b 100644 --- a/scheme/xlib/graphics.scm +++ b/scheme/xlib/graphics.scm @@ -11,7 +11,7 @@ (import-lambda-definition %clear-area (Xwindow Xdisplay x y width height exposures?) - "Clear_Area") + "scx_Clear_Area") ;; _____ @@ -27,7 +27,7 @@ (import-lambda-definition %copy-area (Xdisplay srcXdrawable Xgcontext srcx srcy width height destXdrawable destx desty) - "Copy_Area") + "scx_Copy_Area") ;; _____ @@ -46,7 +46,7 @@ (import-lambda-definition %copy-plane (Xdisplay srcXdrawable Xgcontext plane srcx srcy width height destXdrawable destx desty) - "Copy_Plane") + "scx_Copy_Plane") ;; _____ @@ -58,7 +58,7 @@ x y)) (import-lambda-definition %draw-point (Xdisplay Xdrawable Xgcontext x y) - "Draw-Point") + "scx_Draw-Point") ;; _____ @@ -72,7 +72,7 @@ (import-lambda-definition %draw-points (Xdisplay Xdrawable Xgcontext vec relative) - "Draw_Points") + "scx_Draw_Points") ;; _____ @@ -84,7 +84,7 @@ x1 y1 x2 y2)) (import-lambda-definition %draw-line (Xdisplay Xdrawable Xgcontext x1 y1 x2 y2) - "Draw_Line") + "scx_Draw_Line") ;; _____ @@ -98,7 +98,7 @@ relative?)) (import-lambda-definition %draw-lines (Xdisplay Xdrawable Xgcontext vec rel) - "Draw_Lines") + "scx_Draw_Lines") ;; _____ @@ -123,7 +123,7 @@ (import-lambda-definition %draw-rectangle (Xdisplay Xdrawable Xgcontext x y w h) - "Draw_Rectangle") + "scx_Draw_Rectangle") (define (fill-rectangle drawable gcontext x y width height) (%fill-rectangle (display-Xdisplay (drawable-display drawable)) @@ -133,7 +133,7 @@ (import-lambda-definition %fill-rectangle (Xdisplay Xdrawable Xgcontext x y w h) - "Fill_Rectangle") + "scx_Fill_Rectangle") (define (draw-rectangles drawable gcontext vector-of-rectangles) @@ -144,7 +144,7 @@ (import-lambda-definition %draw-rectangles (Xdisplay Xdrawable Xgcontext vec) - "Draw_Rectangles") + "scx_Draw_Rectangles") (define (fill-rectangles drawable gcontext vector-of-rectangles) @@ -155,7 +155,7 @@ (import-lambda-definition %fill-rectangles (Xdisplay Xdrawable Xgcontext vec) - "Fill_Rectangles") + "scx_Fill_Rectangles") (define (draw-arc drawable gcontext x y width height angle1 angle2) @@ -166,7 +166,7 @@ (import-lambda-definition %draw-arc (Xdisplay Xdrawable Xgcontext x y w h a1 a2) - "Draw_Arc") + "scx_Draw_Arc") (define (fill-arc drawable gcontext x y width height angle1 angle2) @@ -177,7 +177,7 @@ (import-lambda-definition %fill-arc (Xdisplay Xdrawable Xgcontext x y w h a1 a2) - "Fill_Arc") + "scx_Fill_Arc") (define (draw-arcs drawable gcontext vector-of-data) (%draw-arcs (display-Xdisplay (drawable-display drawable)) @@ -186,7 +186,7 @@ vector-of-data)) (import-lambda-definition %draw-arcs (Xdisplay Xdrawable Xgcontext vec) - "Draw_Arcs") + "scx_Draw_Arcs") (define (fill-arcs drawable gcontext vector-of-data) (%fill-arcs (display-Xdisplay (drawable-display drawable)) @@ -195,7 +195,7 @@ vector-of-data)) (import-lambda-definition %fill-arcs (Xdisplay Xdrawable Xgcontext vec) - "Fill_Arcs") + "scx_Fill_Arcs") (define (fill-polygon drawable gcontext vector-of-points relative? shape) (%fill-polygon (display-Xdisplay (drawable-display drawable)) @@ -205,7 +205,7 @@ (import-lambda-definition %fill-polygon (Xdisplay Xdrawable Xgcontext vec relative shape) - "Fill-Polygon") + "scx_Fill-Polygon") diff --git a/scheme/xlib/pixmap.scm b/scheme/xlib/pixmap.scm index 8fc7c9b..3aba073 100644 --- a/scheme/xlib/pixmap.scm +++ b/scheme/xlib/pixmap.scm @@ -48,7 +48,9 @@ (let ((res (%read-bitmap-file (display-Xdisplay (drawable-display drawable)) (drawable-Xobject drawable) filename))) - (set-car! res (make-pixmap (drawable-display drawable) (car res) #t)))) + (if (pair? res) + (set-car! res (make-pixmap (car res) (drawable-display drawable) #t)) + res))) (import-lambda-definition %read-bitmap-file (Xdisplay Xdrawable file) "scx_Read_Bitmap_File") diff --git a/scheme/xlib/window.scm b/scheme/xlib/window.scm index 85b08af..079b66d 100644 --- a/scheme/xlib/window.scm +++ b/scheme/xlib/window.scm @@ -52,7 +52,7 @@ ((pixmap? value) (pixmap-Xpixmap value)) ((pixel? value) (pixel-Xpixel value)) ((colormap? value) (colormap-Xcolormap value)) -;... ((cursor? value) (cursor-Xcursor value)) + ((cursor? value) (cursor-Xcursor value)) (else value))) (map cdr alist))))) (%change-window-attributes (window-Xwindow window)