[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
bug#6332: Colors lost from list-colors-display
From: |
Juri Linkov |
Subject: |
bug#6332: Colors lost from list-colors-display |
Date: |
Sat, 12 Jun 2010 23:05:36 +0300 |
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/24.0.50 (x86_64-pc-linux-gnu) |
> I have added all 752 rgb.txt colors to `x-colors'.
Thank you!
I could now install the patch that adds the sorting option. OK?
=== modified file 'lisp/facemenu.el'
--- lisp/facemenu.el 2010-06-12 19:52:17 +0000
+++ lisp/facemenu.el 2010-06-12 19:54:57 +0000
@@ -479,6 +479,71 @@ (defun facemenu-read-color (&optional pr
nil
col)))
+(defun color-rgb-to-hsv (r g b)
+ "For R, G, B color components return a list of hue, saturation, value.
+R, G, B input values should be in [0..65535] range.
+Output values for hue are in [0..360] range.
+Output values for saturation and value are in [0..1] range."
+ (let* ((r (/ r 65535.0))
+ (g (/ g 65535.0))
+ (b (/ b 65535.0))
+ (max (max r g b))
+ (min (min r g b))
+ (h (cond ((= max min) 0)
+ ((= max r) (mod (+ (* 60 (/ (- g b) (- max min))) 360) 360))
+ ((= max g) (+ (* 60 (/ (- b r) (- max min))) 120))
+ ((= max b) (+ (* 60 (/ (- r g) (- max min))) 240))))
+ (s (cond ((= max 0) 0)
+ (t (- 1 (/ min max)))))
+ (v max))
+ (list h s v)))
+
+(defcustom list-colors-sort nil
+ "Sort order for `list-colors-display'.
+`nil' means default implementation-dependent order (defined in `x-colors').
+`name' sorts by color name.
+`r-g-b' sorts by red, green, blue components.
+`h-s-v' sorts by hue, saturation, value.
+`hsv-dist' sorts by the HVS distance to the specified color."
+ :type '(choice (const :tag "Color Name" name)
+ (const :tag "Red-Green-Blue" r-g-b)
+ (cons :tag "Distance on RGB cube"
+ (const :tag "Distance from Color" rgb-dist)
+ (color :tag "Source Color Name"))
+ (const :tag "Hue-Saturation-Value" h-s-v)
+ (cons :tag "Distance on HSV cylinder"
+ (const :tag "Distance from Color" hsv-dist)
+ (color :tag "Source Color Name"))
+ (const :tag "Unsorted" nil))
+ :group 'facemenu
+ :version "24.1")
+
+(defun list-colors-sort-key (color)
+ "Return a list of keys for sorting colors depending on `list-colors-sort'.
+COLOR is the name of the color. Filters out a color from the output
+when return value is nil."
+ (cond
+ ((null list-colors-sort) color)
+ ((eq list-colors-sort 'name)
+ color)
+ ((eq list-colors-sort 'r-g-b)
+ (color-values color))
+ ((eq (car-safe list-colors-sort) 'rgb-dist)
+ (color-distance color (cdr list-colors-sort)))
+ ((eq list-colors-sort 'h-s-v)
+ (apply 'color-rgb-to-hsv (color-values color)))
+ ((eq (car-safe list-colors-sort) 'hsv-dist)
+ (let* ((c-rgb (color-values color))
+ (c-hsv (apply 'color-rgb-to-hsv c-rgb))
+ (o-hsv (apply 'color-rgb-to-hsv
+ (color-values (cdr list-colors-sort)))))
+ (unless (and (eq (nth 0 c-rgb) (nth 1 c-rgb)) ; exclude grayscale
+ (eq (nth 1 c-rgb) (nth 2 c-rgb)))
+ ;; 3D Euclidean distance (sqrt is not needed for sorting)
+ (+ (expt (- 180 (abs (- 180 (abs (- (nth 0 c-hsv) ; wrap hue
+ (nth 0 o-hsv)))))) 2)
+ (expt (- (nth 1 c-hsv) (nth 1 o-hsv)) 2)
+ (expt (- (nth 2 c-hsv) (nth 2 o-hsv)) 2)))))))
(defun list-colors-display (&optional list buffer-name callback)
"Display names of defined colors, and show what they look like.
@@ -496,6 +561,30 @@ (defun list-colors-display (&optional li
(interactive)
(when (and (null list) (> (display-color-cells) 0))
(setq list (list-colors-duplicates (defined-colors)))
+ (when list-colors-sort
+ (setq list (mapcar
+ 'car
+ (sort (delq nil (mapcar
+ (lambda (c)
+ (let ((key (list-colors-sort-key
+ (car c))))
+ (when key
+ (cons c (if (consp key) key
+ (list key))))))
+ list))
+ (lambda (a b)
+ (let* ((a-keys (cdr a))
+ (b-keys (cdr b))
+ (a-key (car a-keys))
+ (b-key (car b-keys)))
+ (while (and a-key b-key (eq a-key b-key))
+ (setq a-keys (cdr a-keys) a-key (car a-keys)
+ b-keys (cdr b-keys) b-key (car b-keys)))
+ (cond
+ ((and (numberp a-key) (numberp b-key))
+ (< a-key b-key))
+ ((and (stringp a-key) (stringp b-key))
+ (string< a-key b-key)))))))))
(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)))
--
Juri Linkov
http://www.jurta.org/emacs/
- bug#6332: Colors lost from list-colors-display, (continued)
- bug#6332: Colors lost from list-colors-display, Juanma Barranquero, 2010/06/04
- bug#6332: Colors lost from list-colors-display, Juri Linkov, 2010/06/04
- bug#6332: Colors lost from list-colors-display, Juanma Barranquero, 2010/06/04
- bug#6332: Colors lost from list-colors-display, Juri Linkov, 2010/06/04
- bug#6332: Colors lost from list-colors-display, Juanma Barranquero, 2010/06/04
- bug#6332: Colors lost from list-colors-display, Juri Linkov, 2010/06/04
- bug#6332: Colors lost from list-colors-display, Juanma Barranquero, 2010/06/04
- bug#6332: Colors lost from list-colors-display, Juri Linkov, 2010/06/04
bug#6332: Colors lost from list-colors-display, Chong Yidong, 2010/06/12
- bug#6332: Colors lost from list-colors-display,
Juri Linkov <=