let lookup-color accept xlib:color type

also let update-color-map use internal lookup-color (instead of xlib:lookup-color), like the rest of stumpwm. this allows xlib:colors everwhere!
beaubrueggemann · Jun 7, 2012 · 612b7fb · 612b7fb
1 parent b1271a9
commit 612b7fb
Showing 1 changed file with 4 additions and 2 deletions.
diff --git a/color.lisp b/color.lisp
@@ -66,7 +66,9 @@ then call (update-color-map).")
   (xlib:alloc-color (xlib:screen-default-colormap (screen-number screen)) color))
 
 (defun lookup-color (screen color)
-  (xlib:lookup-color (xlib:screen-default-colormap (screen-number screen)) color))
+  (cond
+    ((typep color 'xlib:color) color)
+    (t (xlib:lookup-color (xlib:screen-default-colormap (screen-number screen)) color))))
 
 ;; Normal colors are dimmed and bright colors are intensified in order
 ;; to more closely resemble the VGA pallet.
@@ -75,7 +77,7 @@ then call (update-color-map).")
   (let ((scm (xlib:screen-default-colormap (screen-number screen))))
     (labels ((map-colors (amt)
                (loop for c in *colors*
-                     as color = (xlib:lookup-color scm c)
+                     as color = (lookup-color screen c)
                      do (adjust-color color amt)
                      collect (xlib:alloc-color scm color))))
       (setf (screen-color-map-normal screen) (apply #'vector (map-colors -0.25))