From: Juri Linkov <juri@jurta.org>
Subject: list-colors-display: display all color names
Date: Sun, 26 Dec 2004 21:45:47 +0200 [thread overview]
Message-ID: <87d5wwsuly.fsf@jurta.org> (raw)
It's too bad that `list-colors-display' currently doesn't contain
all variants of color names with alternative spellings and spaces.
When I put a color name into the search ring in one buffer and then
isearch it with C-s C-s in the *Colors* buffer to see how the color
looks, often the search fails. I need to edit the search string
to add spaces or change the spelling of color names and to try again.
This is very inconvenient. The *Colors* buffer should contain all
color names, even duplicates with the same color values.
I understand that the reason to remove color names with the same
color value was to reduce the amount of lines in the *Colors* buffer.
So I propose the patch which displays all duplicate color names on the
same line. When there is only one color name, it is displayed in both
background and foreground color examples. When there are two duplicate
color names, one of them is displayed in background, and another in
foreground color. When there are more than two color names, the first
of them is displayed in the background example, and all others are
separated by comma in the foreground color example. For instance,
white white
black black
dark slate gray DarkSlateGray, dark slate grey, DarkSlateGrey
dim gray DimGray, dim grey, DimGrey
slate gray SlateGray, slate grey, SlateGrey
light slate gray LightSlateGray, light slate grey, LightSlateGrey
gray grey
light grey LightGrey, light gray, LightGray
midnight blue MidnightBlue
navy navy blue, NavyBlue
This eliminates the need to identify duplicate colors by the name.
Index: lisp/facemenu.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/facemenu.el,v
retrieving revision 1.73
diff -u -r1.73 facemenu.el
--- lisp/facemenu.el 4 Sep 2004 19:11:18 -0000 1.73
+++ lisp/facemenu.el 26 Dec 2004 17:04:43 -0000
@@ -471,50 +471,59 @@
col)))
;;;###autoload
-(defun list-colors-display (&optional list)
+(defun list-colors-display (&optional list buffer-name)
"Display names of defined colors, and show what they look like.
If the optional argument LIST is non-nil, it should be a list of
-colors to display. Otherwise, this command computes a list
-of colors that the current display can handle."
+colors to display. Otherwise, this command computes a list of
+colors that the current display can handle. If the optional
+argument BUFFER-NAME is nil, it defaults to *Colors*."
(interactive)
(when (and (null list) (> (display-color-cells) 0))
- (setq list (defined-colors))
- ;; Delete duplicate colors.
-
- ;; Identify duplicate colors by the name rather than the color
- ;; value. For example, on MS-Windows, logical colors are added to
- ;; the list that might have the same value but have 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. Detecting duplicates by name insures that both of these
- ;; colors remain despite identical color values.
- (let ((l list))
- (while (cdr l)
- (if (facemenu-color-name-equal (car l) (car (cdr l)))
- (setcdr l (cdr (cdr l)))
- (setq l (cdr l)))))
+ (setq list (list-colors-duplicates (defined-colors)))
(when (memq (display-visual-class) '(gray-scale pseudo-color direct-color))
;; Don't show more than what the display can handle.
(let ((lc (nthcdr (1- (display-color-cells)) list)))
(if lc
(setcdr lc nil)))))
- (with-output-to-temp-buffer "*Colors*"
+ (with-output-to-temp-buffer (or buffer-name "*Colors*")
(save-excursion
(set-buffer standard-output)
- (let (s)
- (while list
- (setq s (point))
- (insert (car list))
- (indent-to 20)
- (put-text-property s (point) 'face
- (cons 'background-color (car list)))
- (setq s (point))
- (insert " " (car list) "\n")
- (put-text-property s (point) 'face
- (cons 'foreground-color (car list)))
- (setq list (cdr list)))))))
+ (dolist (color list)
+ (or (consp color) (setq color (list color)))
+ (put-text-property
+ (prog1 (point)
+ (insert (car color))
+ (indent-to 22))
+ (point)
+ 'face (cons 'background-color (car color)))
+ (put-text-property
+ (prog1 (point)
+ (insert " "
+ (if (cdr color)
+ (mapconcat 'identity (reverse (cdr color)) ", ")
+ (car color))
+ "\n"))
+ (point)
+ 'face (cons 'foreground-color (car color)))))))
+
+(defun list-colors-duplicates (&optional list)
+ "Return a list of colors with grouped duplicate colors.
+If a color has no duplicates, then the element of the returned list
+has the form '(COLOR-NAME). The element of the returned list with
+duplicate colors has the form '(COLOR-NAME DUPLICATE-COLOR-NAME ...).
+This function uses the predicate `facemenu-color-equal' to compare
+color names. If the optional argument LIST is non-nil, it should
+be a list of colors to display. Otherwise, this function uses
+a list of colors that the current display can handle."
+ (let* ((list (mapcar 'list (or list (defined-colors))))
+ (l list))
+ (while (cdr l)
+ (if (facemenu-color-equal (car (car l)) (car (car (cdr l))))
+ (progn
+ (setcdr (car l) (cons (car (car (cdr l))) (cdr (car l))))
+ (setcdr l (cdr (cdr l))))
+ (setq l (cdr l))))
+ list))
(defun facemenu-color-equal (a b)
"Return t if colors A and B are the same color.
@@ -525,22 +534,6 @@
(cond ((equal a b) t)
((equal (color-values a) (color-values b)))))
-(defun facemenu-color-name-equal (a b)
- "Return t if colors A and B are the same color.
-A and B should be strings naming colors. These names are
-downcased, stripped of spaces and the string `grey' is turned
-into `gray'. This accommodates alternative spellings of colors
-found commonly in the list. It returns nil if the colors differ."
- (progn
- (setq a (replace-regexp-in-string "grey" "gray"
- (replace-regexp-in-string " " ""
- (downcase a)))
- b (replace-regexp-in-string "grey" "gray"
- (replace-regexp-in-string " " ""
- (downcase b))))
-
- (equal a b)))
-
(defun facemenu-add-face (face &optional start end)
"Add FACE to text between START and END.
If START is nil or START to END is empty, add FACE to next typed character
--
Juri Linkov
http://www.jurta.org/emacs/
next reply other threads:[~2004-12-26 19:45 UTC|newest]
Thread overview: 25+ messages / expand[flat|nested] mbox.gz Atom feed top
2004-12-26 19:45 Juri Linkov [this message]
2004-12-28 4:57 ` list-colors-display: display all color names Richard Stallman
2005-01-04 9:07 ` Juri Linkov
2005-01-04 16:37 ` Drew Adams
2005-01-04 21:09 ` Eli Zaretskii
2005-01-04 21:57 ` Stefan Monnier
2005-01-05 5:38 ` Juri Linkov
2005-01-05 18:12 ` Drew Adams
2005-01-05 19:11 ` Eli Zaretskii
2005-01-05 19:21 ` Edward O'Connor
2005-01-06 4:35 ` Eli Zaretskii
2005-01-05 5:32 ` Juri Linkov
2005-01-05 18:12 ` Drew Adams
2005-01-05 19:13 ` Eli Zaretskii
2005-01-05 18:59 ` Eli Zaretskii
2005-01-05 19:46 ` Drew Adams
2005-01-06 4:50 ` Eli Zaretskii
2005-01-06 8:27 ` Juri Linkov
2005-01-06 9:05 ` Miles Bader
2005-01-06 10:44 ` Juri Linkov
2005-01-05 20:08 ` Richard Stallman
2005-01-05 3:30 ` Richard Stallman
2005-01-06 8:29 ` Juri Linkov
2004-12-29 14:46 ` Michael Mauger
2004-12-29 19:02 ` Juri Linkov
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87d5wwsuly.fsf@jurta.org \
--to=juri@jurta.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.