;; create-pixmap-cursor returns a cursor, that was build using the
;; pixmaps src and mask, and the colors foreground and background. x
;; and y specify the hotspot of the cursor. See XCreatePixmapCursor.

(define (create-pixmap-cursor src mask x y foreground background)
  (let ((display (pixmap-display src)))
    (make-cursor (%create-pixmap-cursor (display-Xdisplay display)
					(pixmap-Xpixmap src)
					(pixmap-Xpixmap mask)
					x y
					(color-Xcolor foreground)
					(color-Xcolor background))
		 display
		 #t)))

(define create-cursor create-pixmap-cursor) ;; for compatibility with elk

(import-lambda-definition %create-pixmap-cursor (Xdisplay src mask x y f b)
  "scx_Create_Pixmap_Cursor")

;; Special cursor values

(define (special-cursor:none dpy)
  (make-cursor 0 dpy #f))

;; create-glyph-cursor returns a cursor, that was build using the font
;; src, an integer src-char, a font mask, an integer mask-char, and
;; the colors foreground and background. See XCreateGlyphCursor.

(define (create-glyph-cursor src src-char mask mask-char foreground background)
  (let ((display (font-display src)))
    (make-cursor (%create-glyph-cursor (display-Xdisplay display)
				       (font-Xfont src)
				       src-char
				       (font-Xfont mask)
				       mask-char
				       (color-Xcolor foreground)
				       (color-Xcolor background))
		 display
		 #t)))

(import-lambda-definition %create-glyph-cursor 
			  (Xdisplay src srcc mask maskc f b)
  "scx_Create_Glyph_Cursor")

;; create-font-cursor returns a cursor, that was build with
;; create-glyph-cursor using a font named "cursor", src-char, the
;; character following src-char as mask-char, and black and as
;; foreground and background.

(define (create-font-cursor display src-char)
  (let ((font (load-font display "cursor")))
    (create-glyph-cursor font src-char
			 font (+ 1 src-char)
			 (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)
    ))

;; recolor-cursor resets the colors of an existing cursor. See XRecolorCursor.

(define (recolor-cursor cursor foreground background)
  (%recolor-cursor (display-Xdisplay (cursor-display cursor))
		   (cursor-Xcursor cursor)
		   foreground background))

(import-lambda-definition %recolor-cursor (Xdisplay Xcursor f b)
  "scx_Recolor_Cursor")