lisp/facemenu.el (list-colors-duplicates): Detect more duplicates on Windows.

Fixes: debbugs:9722
This commit is contained in:
Juanma Barranquero 2011-10-18 16:31:27 +02:00
parent 97d0a92c79
commit 343a34ff0b
2 changed files with 18 additions and 5 deletions

View file

@ -1,3 +1,9 @@
2011-10-18 Juanma Barranquero <lekktu@gmail.com>
* facemenu.el (list-colors-duplicates): On Windows, detect more
duplicates by assuming that only colors matching "^System" are
special "system colors". (Bug#9722)
2011-10-18 Stefan Monnier <monnier@iro.umontreal.ca>
* vc/log-edit.el (log-edit): Add "Author:" header to encourage people
@ -26,7 +32,7 @@
* font-lock.el (font-lock-maximum-size): Mark as obsolete.
2011-10-17 Ryan Barrett <emacs@ryanb.org> (tiny change)
2011-10-17 Ryan Barrett <emacs@ryanb.org> (tiny change)
* dirtrack.el (dirtrack): Support shell buffers with path
prefixes, e.g. tramp-based remote shells. (Bug#9647)
@ -465,8 +471,8 @@
* net/newst-reader.el (newsticker-html-renderer)
(newsticker-show-news): Automatically
load html rendering package if newsticker-html-renderer is
set. Fixes "Warning: defvar ignored because w3m-fill-column is
load html rendering package if newsticker-html-renderer is set.
Fixes "Warning: defvar ignored because w3m-fill-column is
let-bound" and the error "Symbol's value as variable is void:
w3m-fill-column".

View file

@ -639,8 +639,15 @@ a list of colors that the current display can handle."
(l list))
(while (cdr l)
(if (and (facemenu-color-equal (car (car l)) (car (car (cdr l))))
(not (if (fboundp 'w32-default-color-map)
(not (assoc (car (car l)) (w32-default-color-map))))))
;; On MS-Windows, there are logical colors that might have
;; the same value but different names and meanings. For
;; example, `SystemMenuText' (the color w32 uses for the
;; text in menu entries) and `SystemWindowText' (the default
;; color w32 uses for the text in windows and dialogs) may
;; be the same display color and be adjacent in the list.
;; This makes them different to any other color. Bug#9722
(not (and (eq system-type 'windows-nt)
(string-match-p "^System" (car (car l))))))
(progn
(setcdr (car l) (cons (car (car (cdr l))) (cdr (car l))))
(setcdr l (cdr (cdr l))))