From mboxrd@z Thu Jan 1 00:00:00 1970 Path: main.gmane.org!not-for-mail From: Michael Mauger Newsgroups: gmane.emacs.devel Subject: Re: list-colors-display: filter same adjecent colors Date: Fri, 5 Mar 2004 15:49:19 -0800 (PST) Sender: emacs-devel-bounces+emacs-devel=quimby.gnus.org@gnu.org Message-ID: <20040305234919.33704.qmail@web60305.mail.yahoo.com> References: NNTP-Posting-Host: deer.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=us-ascii X-Trace: sea.gmane.org 1078885006 32054 80.91.224.253 (10 Mar 2004 02:16:46 GMT) X-Complaints-To: usenet@sea.gmane.org NNTP-Posting-Date: Wed, 10 Mar 2004 02:16:46 +0000 (UTC) Cc: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+emacs-devel=quimby.gnus.org@gnu.org Wed Mar 10 03:16:39 2004 Return-path: Original-Received: from quimby.gnus.org ([80.91.224.244]) by deer.gmane.org with esmtp (Exim 3.35 #1 (Debian)) id 1B0tGx-0005XB-00 for ; Wed, 10 Mar 2004 03:16:39 +0100 Original-Received: from monty-python.gnu.org ([199.232.76.173]) by quimby.gnus.org with esmtp (Exim 3.35 #1 (Debian)) id 1B0tGx-0007Tl-00 for ; Wed, 10 Mar 2004 03:16:39 +0100 Original-Received: from localhost ([127.0.0.1] helo=monty-python.gnu.org) by monty-python.gnu.org with esmtp (Exim 4.30) id 1B0tDl-0007Cp-2Q for emacs-devel@quimby.gnus.org; Tue, 09 Mar 2004 21:13:21 -0500 Original-Received: from list by monty-python.gnu.org with tmda-scanned (Exim 4.30) id 1AzP4m-0007KA-MB for emacs-devel@gnu.org; Fri, 05 Mar 2004 18:49:56 -0500 Original-Received: from mail by monty-python.gnu.org with spam-scanned (Exim 4.30) id 1AzP4F-00079I-N4 for emacs-devel@gnu.org; Fri, 05 Mar 2004 18:49:55 -0500 Original-Received: from [216.109.118.116] (helo=web60305.mail.yahoo.com) by monty-python.gnu.org with smtp (Exim 4.30) id 1AzP4F-00079D-86 for emacs-devel@gnu.org; Fri, 05 Mar 2004 18:49:23 -0500 Original-Received: from [12.76.163.171] by web60305.mail.yahoo.com via HTTP; Fri, 05 Mar 2004 15:49:19 PST Original-To: Eli Zaretskii In-Reply-To: X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.2 Precedence: list List-Id: Emacs development discussions. List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+emacs-devel=quimby.gnus.org@gnu.org Xref: main.gmane.org gmane.emacs.devel:20285 X-Report-Spam: http://spam.gmane.org/gmane.emacs.devel:20285 --- Eli Zaretskii wrote: > > Date: Mon, 23 Feb 2004 19:43:58 -0800 (PST) > > From: Michael Mauger > > > > This was another conversation from November. > > > > See > http://mail.gnu.org/archive/html/emacs-devel/2003-11/msg00189.html > > Thanks for following up. > > > (defun facemenu-color-equal (a b) > > "Return t if colors A and B are the same color. > > -A and B should be strings naming colors. > > -This function queries the display system to find out what the color > > -names mean. It returns nil if the colors differ or if it can't > > -determine the correct answer." > > - (cond ((equal a b) t) > > - ((equal (color-values a) (color-values b))))) > > +A and B should be strings naming colors. These names are > > +downcased, stripped of spaces and the string `grey' is turned > > +into `gray'. This accomidates 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))) > > Hmm, how about making this a new function, and leaving the original > facemenu-color-equal alone? None of the Lisp files bundled with > Emacs use facemenu-color-equal, but perhaps some add-on packages do, > as it sounds like useful functionality and is there since 1994. > > Also, I think we should mention the MS-Windows case and the special > color names used there explicitly, at least in a comment to the > function's code, if not in the doc string. A year from now, no one > will remember why we modified the way colors are compared. > How does this patch look: Index: emacs/lisp/facemenu.el =================================================================== RCS file: /cvsroot/emacs/emacs/lisp/facemenu.el,v retrieving revision 1.71 diff -u -r1.71 facemenu.el --- emacs/lisp/facemenu.el 1 Sep 2003 15:45:11 -0000 1.71 +++ emacs/lisp/facemenu.el 27 Feb 2004 04:57:36 -0000 @@ -480,9 +480,15 @@ (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. On w32, logical colors are added to the list that might + ;; have the same value but have different names and meanings. + ;; Detecting duplicates by name insures that all of these logical + ;; colors remain despite similar color values. (let ((l list)) (while (cdr l) - (if (facemenu-color-equal (car l) (car (cdr l))) + (if (facemenu-color-name-equal (car l) (car (cdr l))) (setcdr l (cdr (cdr l))) (setq l (cdr l))))) (when (memq (display-visual-class) '(gray-scale pseudo-color direct-color)) @@ -514,6 +520,22 @@ determine the correct answer." (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 accomidates 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. __________________________________ Do you Yahoo!? Yahoo! Search - Find what you’re looking for faster http://search.yahoo.com