[Top][All Lists]

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Patch to display "System" colors

From: Michael Mauger
Subject: Patch to display "System" colors
Date: Fri, 14 Nov 2003 16:26:57 -0800 (PST)

Several months ago, support for the colors defined in the W32 control
panel was added.  These colors are logical colors rather than physical
colors (i.e., "SystemActiveTitleText" vs "LightGreen").  The logical
colors can be identified by the "System" prefix.

I noticed that `list-colors-display' was not showing all the logical
colors.  This is because it skips colors that have the same color value
as the previous color value in the list.  (Thus "LightGreen" is skipped
when the previous color was "light green" because they both have the
color value (43052688).)  However, the System colors should not be
skipped just because they have the same color value as the previous
system color.

This small patch will show all of the logical system colors in
`list-colors-display' while still filtering similiar physical colors.

-- Michael

Index: emacs/lisp/facemenu.el
RCS file: /cvsroot/emacs/emacs/lisp/facemenu.el,v
retrieving revision 1.71
diff -u -b -r1.71 facemenu.el
--- emacs/lisp/facemenu.el      1 Sep 2003 15:45:11 -0000       1.71
+++ emacs/lisp/facemenu.el      15 Nov 2003 00:22:27 -0000
@@ -482,9 +482,18 @@
     ;; Delete duplicate colors.
     (let ((l list))
       (while (cdr l)
-       (if (facemenu-color-equal (car l) (car (cdr l)))
-           (setcdr l (cdr (cdr l)))
-         (setq l (cdr l)))))
+       (let ((this (car l))
+             (next (car (cdr l))))
+         (if (and
+              ;; Avoid filtering out "System" logical colors.
+              (or (<= (length this) 6)
+                  (not (equal (substring this 0 6) "System")))
+              (or (<= (length next) 6)
+                  (not (equal (substring next 0 6) "System")))
+              ;; If neither is a System color, compare them.
+              (facemenu-color-equal this next))
+             (setcdr l (cdr (cdr l)))))
+           (setq l (cdr l))))
     (when (memq (display-visual-class) '(gray-scale pseudo-color
       ;; Don't show more than what the display can handle.
       (let ((lc (nthcdr (1- (display-color-cells)) list)))

Do you Yahoo!?
Protect your identity with Yahoo! Mail AddressGuard

reply via email to

[Prev in Thread] Current Thread [Next in Thread]