480 |
(when (and (null list) (> (display-color-cells) 0)) |
(when (and (null list) (> (display-color-cells) 0)) |
481 |
(setq list (defined-colors)) |
(setq list (defined-colors)) |
482 |
;; Delete duplicate colors. |
;; Delete duplicate colors. |
483 |
|
|
484 |
|
;; Identify duplicate colors by the name rather than the color |
485 |
|
;; value. For example, on MS-Windows, logical colors are added to |
486 |
|
;; the list that might have the same value but have different |
487 |
|
;; names and meanings. For example, `SystemMenuText' (the color |
488 |
|
;; w32 uses for the text in menu entries) and `SystemWindowText' |
489 |
|
;; (the default color w32 uses for the text in windows and |
490 |
|
;; dialogs) may be the same display color and be adjacent in the |
491 |
|
;; list. Detecting duplicates by name insures that both of these |
492 |
|
;; colors remain despite identical color values. |
493 |
(let ((l list)) |
(let ((l list)) |
494 |
(while (cdr l) |
(while (cdr l) |
495 |
(if (facemenu-color-equal (car l) (car (cdr l))) |
(if (facemenu-color-name-equal (car l) (car (cdr l))) |
496 |
(setcdr l (cdr (cdr l))) |
(setcdr l (cdr (cdr l))) |
497 |
(setq l (cdr l))))) |
(setq l (cdr l))))) |
498 |
(when (memq (display-visual-class) '(gray-scale pseudo-color direct-color)) |
(when (memq (display-visual-class) '(gray-scale pseudo-color direct-color)) |
525 |
(cond ((equal a b) t) |
(cond ((equal a b) t) |
526 |
((equal (color-values a) (color-values b))))) |
((equal (color-values a) (color-values b))))) |
527 |
|
|
528 |
|
(defun facemenu-color-name-equal (a b) |
529 |
|
"Return t if colors A and B are the same color. |
530 |
|
A and B should be strings naming colors. These names are |
531 |
|
downcased, stripped of spaces and the string `grey' is turned |
532 |
|
into `gray'. This accommodates alternative spellings of colors |
533 |
|
found commonly in the list. It returns nil if the colors differ." |
534 |
|
(progn |
535 |
|
(setq a (replace-regexp-in-string "grey" "gray" |
536 |
|
(replace-regexp-in-string " " "" |
537 |
|
(downcase a))) |
538 |
|
b (replace-regexp-in-string "grey" "gray" |
539 |
|
(replace-regexp-in-string " " "" |
540 |
|
(downcase b)))) |
541 |
|
|
542 |
|
(equal a b))) |
543 |
|
|
544 |
(defun facemenu-add-face (face &optional start end) |
(defun facemenu-add-face (face &optional start end) |
545 |
"Add FACE to text between START and END. |
"Add FACE to text between START and END. |
546 |
If START is nil or START to END is empty, add FACE to next typed character |
If START is nil or START to END is empty, add FACE to next typed character |