;; Author: David Frese

(define (alloc-color colormap color)
  (let ((Xpixel (%alloc-color (colormap-Xcolormap colormap)
			      (color-Xcolor color)
			      (display-Xdisplay (colormap-display colormap)))))
    (if Xpixel
	(make-pixel Xpixel)
	Xpixel)))

(import-lambda-definition %alloc-color (Xcolormap Xcolor Xdisplay)
  "Alloc_Color")

;; ...

(define (alloc-named-color colormap color-name)
  (let ((Xres (%alloc-named-color (colormap-Xcolormap colormap)
				  (if (symbol? color-name)
				      (symbol->string color-name)
				      color-name))))
    (if Xres
	(list (make-pixel (car Xres))
	      (apply make-color (cadr Xres))
	      (apply make-color (caddr Xres)))
	Xres)))