Proposal: Windows Control Panel Colors

[Michael Mauger]

The following patch is intended to make NT Emacs more attractive.  The
first portion of the patch adds the colors found on the Windows
control panel to the `w32-color-map'; the second portion of the patch
modifies some of the standard Emacs faces to use these colors under
w32.  The result is that Emacs displays major frame components in
colors similar to the colors used in other applications.  Menus and
scroll bars already follow the Windows theme because they use standard
Windows controls.

This functionality is needed in Windows because Windows lacks the Xrdb
color mapping capability that permits X11 applications to enforce this
type of uniform appearance across applications.

The colors added to the color map are named using the logical color
names in the registry prefixed with "W32".  The list of color names
has been pretty constant across versions of Windows.  I use this patch
on Win2K and Win98 without problems.  The following is the list of
colors added under Win2k:

     W32ActiveBorder
     W32ActiveTitle
     W32AppWorkSpace
     W32Background
     W32ButtonAlternateFace
     W32ButtonDkShadow
     W32ButtonFace
     W32ButtonHilight
     W32ButtonLight
     W32ButtonShadow
     W32ButtonText
     W32GradientActiveTitle
     W32GradientInactiveTitle
     W32GrayText
     W32Hilight
     W32HilightText
     W32HotTrackingColor
     W32InactiveBorder
     W32InactiveTitle
     W32InactiveTitleText
     W32InfoText
     W32InfoWindow
     W32Menu
     W32MenuText
     W32Scrollbar
     W32TitleText
     W32Window
     W32WindowFrame
     W32WindowText

The colors are stored under HKEY_CURRENT_USER\Control Panel\Colors in
the registry.

The Emacs faces that are modified are:

    mode-line
        bg: W32GradientActiveTitle
        fg: W32ActiveTitleText

    mode-line-inactive
        bg: W32GradientInactiveTitle
        fg: W32InactiveTitleText

    toolbar
        bg: W32Menu
        fg: W32MenuText

    region
        bg: W32Hilight
        fg: W32HilightText

Other possibilities include tooltip (W32InfoWindow/W32InfoText)

To see the impact of this patch you can view the following web page:
<http://www.geocities.com/mmaug/emacs/cpanel-emacs.html>

Use M-x list-colors-display to see the added colors.

If it's decided that this patch should be included, please check it
in.  (I don't have access to do so, and I have submitted my copyright
assignment to GNU.)

Here's the patch:

Index: emacs/src/w32fns.c
===================================================================
RCS file: /cvsroot/emacs/emacs/src/w32fns.c,v
retrieving revision 1.216
diff -u -b -r1.216 w32fns.c
--- emacs/src/w32fns.c  24 May 2003 22:05:34 -0000      1.216
+++ emacs/src/w32fns.c  2 Jun 2003 04:24:32 -0000
@@ -1025,6 +1025,57 @@
   return (cmap);
 }

+#define W32_CPANEL_COLOR_PREFIX "W32"
+#define W32_CPANEL_COLOR_PREFIX_LEN ((sizeof W32_CPANEL_COLOR_PREFIX)-1)
+
+void
+w32_cpanel_colors (pcmap)
+     Lisp_Object* pcmap;
+{
+  HKEY hkey;
+
+  /* Lookup under the current user or local machine. */
+  if (RegOpenKeyEx (HKEY_CURRENT_USER, "Control Panel\\Colors", 0,
+                   KEY_READ, &hkey) == ERROR_SUCCESS
+      || RegOpenKeyEx (HKEY_LOCAL_MACHINE, "Control Panel\\Colors", 0,
+                      KEY_READ, &hkey) == ERROR_SUCCESS)
+    {
+      DWORD dwIndex;
+      CHAR achName[256 + W32_CPANEL_COLOR_PREFIX_LEN];
+      DWORD cName;
+      char achRGB[64];
+      DWORD cRGB;
+      int red, green, blue;
+
+      strcpy(achName, W32_CPANEL_COLOR_PREFIX);
+
+      /* Enumerate each key and add its name and color to the color map
+        with the color name prefix. */
+      for (dwIndex = 0;
+          cName = ((sizeof achName) / (sizeof achName[0]))
+                - W32_CPANEL_COLOR_PREFIX_LEN,
+            cRGB = sizeof achRGB,
+            RegEnumValue(hkey, dwIndex,
+                         (LPTSTR) achName + W32_CPANEL_COLOR_PREFIX_LEN,
+                         (LPDWORD) &cName,
+                         NULL, NULL,
+                         (LPBYTE) achRGB, (LPDWORD) &cRGB) == ERROR_SUCCESS;
+          ++dwIndex)
+       {
+         if (sscanf (achRGB, " %u %u %u", &red, &green, &blue) == 3)
+           {
+             *pcmap = Fcons (Fcons (build_string (achName),
+                                    make_number (RGB (red, green, blue))),
+                             *pcmap);
+           }
+       }
+
+      RegCloseKey (hkey);
+    }
+
+  return;
+}
+
 Lisp_Object
 w32_to_x_color (rgb)
      Lisp_Object rgb;
@@ -6773,6 +6828,8 @@
   }
   if (NILP (Vw32_color_map))
     Vw32_color_map = Fw32_default_color_map ();
+
+  w32_cpanel_colors (&Vw32_color_map);

   if (! NILP (xrm_string))
     xrm_option = (unsigned char *) SDATA (xrm_string);
Index: emacs/lisp/faces.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/faces.el,v
retrieving revision 1.279
diff -u -b -r1.279 faces.el
--- emacs/lisp/faces.el 28 May 2003 11:17:33 -0000      1.279
+++ emacs/lisp/faces.el 2 Jun 2003 04:26:50 -0000
@@ -1800,9 +1800,13 @@


 (defface mode-line
-  '((((type x w32 mac) (class color))
+  '((((type x mac) (class color))
      :box (:line-width -1 :style released-button)
      :background "grey75" :foreground "black")
+    (((type w32))
+     :box (:line-width -1 :style released-button)
+     :background "W32GradientActiveTitle"
+     :foreground "W32TitleText")
     (t
      :inverse-video t))
   "Basic mode line face for selected window."
@@ -1813,11 +1817,15 @@
 (defface mode-line-inactive
   '((t
      :inherit mode-line)
-    (((type x w32 mac) (background light) (class color))
+    (((type w32))
+     :box (:line-width -1 :color "W32InactiveTitle" :style nil)
+     :background "W32GradientInactiveTitle"
+     :foreground "W32InactiveTitleText")
+    (((type x mac) (background light) (class color))
      :weight light
      :box (:line-width -1 :color "grey75" :style nil)
      :foreground "grey20" :background "grey90")
-    (((type x w32 mac) (background dark) (class color))
+    (((type x mac) (background dark) (class color))
      :weight light
      :box (:line-width -1 :color "grey40" :style nil)
      :foreground "grey80" :background "grey30"))
@@ -1868,9 +1876,12 @@


 (defface tool-bar
-  '((((type x w32 mac) (class color))
+  '((((type x mac) (class color))
      :box (:line-width 1 :style released-button)
      :background "grey75" :foreground "black")
+    (((type w32))
+     :box nil
+     :background "W32Menu" :foreground "W32MenuText")
     (((type x) (class mono))
      :box (:line-width 1 :style released-button)
      :background "grey" :foreground "black")
@@ -1896,6 +1907,8 @@
      :background "blue" :foreground "white")
     (((type tty) (class mono))
      :inverse-video t)
+    (((type w32))
+     :background "W32Hilight" :foreground "W32HilightText")
     (((class color) (background dark))
      :background "blue3")
     (((class color) (background light))

--
Michael Mauger
http://www.geocities.com/mmaug/


__________________________________
Do you Yahoo!?
Yahoo! Calendar - Free online calendar with sync to Outlook(TM).
http://calendar.yahoo.com