New colormap accessor

[Kerry Kimbrough <Kimbrough@dsg.csc.ti.com>]

VERSION:
    R3

CLIENT MACHINE and OPERATING SYSTEM:
    n/a

DISPLAY:
    n/a

WINDOW MANAGER:
    n/a

AREA:
    CLX

SYNOPSIS:
    CLX should define a colormap-visual accessor to paper over a shortcoming of
    the protocol.

DESCRIPTION:
    After a colormap has been created, the X protocol does not allow a client to
    query the server to return its visual type.  But it's useful to know this
    colormap attribute, since the behavior and even the validity of
    alloc-color-cells, etc.  depend on the class of the visual type.

FIX:
    Store visual on colormap-plist when colormap is created. Define
    colormap-visual accessor. Note: create-colormap also changed to accept (or
    visual-info card29) for visual argument. This change should be made where
    applicable in other CLX functions, so that visual-info can be used
    consistently as the primary interface to visual types.
    
(defmacro colormap-visual (colormap)
  "Access a visual-info structure on the colormap-plist."
  `(getf (colormap-plist ,colormap) :visual))

(defun display-visual-info (display visual)
  "Return a visual-info structure for the given VISUAL id."
  (declare (type (or visual-info card29) visual)
	   (type display display))
  (declare-values (or visual-info null))
  
  (if (visual-info-p visual)

      ;; Return given visual-info.
      visual

      ;; Else look up visual id among display screens
      (block search
	(dolist (screen (display-roots display))
	  ;; Look up visual among screen depths
	  (dolist (depth (screen-depths screen))
	    (let ((visual-info (find visual (rest depth)
				     :key #'visual-info-id
				     :test #'eq)))
	      (when visual-info
		(return-from search visual-info))))))))
      

(defun create-colormap (visual window &optional alloc-p)
  (declare (type (or visual-info card29) visual)
	   (type window window)
	   (type boolean alloc-p))
  (declare-values colormap)
  (let* ((display (window-display window))
	 (colormap (make-colormap :display display))
	 (id (allocate-resource-id display colormap 'colormap)))
    (setf (colormap-id     colormap) id
	  (colormap-visual (display-visual-info display visual)))
    (with-buffer-request (display *x-createcolormap*)
      ((data boolean) alloc-p)
      (resource-id id)
      (window window)
      (card29 visual))
    colormap))