(msdos-approximate-color): New function.

(msdos-color-translate): Call it to find a DOS color that best
approximates an X-style "#NNNNNN" color specification.

diff --git a/lisp/term/pc-win.el b/lisp/term/pc-win.el
index 2a20dea4527aa9646689f0ffbd4ca1f6c393ff09..c97391060c80410fd51d803ec75d6a67baa130dc 100644 (file)
--- a/lisp/term/pc-win.el
+++ b/lisp/term/pc-win.el
@@ -175,6 +175,7 @@
   "List of alternate names for colors.")
 
 (defun msdos-color-translate (name)
+  "Translate color specification in NAME into something DOS terminal groks."
   (setq name (downcase name))
   (let* ((len (length name))
         (val (- (length x-colors)
@@ -232,7 +233,33 @@
               (and
                (string-match "[1-4]\\'" name)
                (msdos-color-translate
-                (substring name 0 (match-beginning 0)))))))))
+                (substring name 0 (match-beginning 0))))))
+       (and (= len 7)  ;; X-style "#XXYYZZ" color spec
+            (eq (aref name 0) ?#)
+            (member (aref name 1)
+                    '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9
+                         ?A ?B ?C ?D ?E ?F ?a ?b ?c ?d ?e ?f))
+            (msdos-color-translate
+             (msdos-approximate-color (string-to-number
+                                       (substring name 1) 16)))))))
+
+(defun msdos-approximate-color (num)
+  "Return a DOS color name which is the best approximation for the number NUM."
+  (let ((color-values msdos-color-values)
+       (candidate (car msdos-color-values))
+       (best-distance 16777216)        ;; 0xFFFFFF + 1
+       best-color)
+    (while candidate
+      (let* ((values (cdr candidate))
+            (value (+ (lsh (car values) 16)
+                      (lsh (car (cdr values)) 8)
+                      (nth 2 values))))
+        (if (< (abs (- value num)) best-distance)
+            (setq best-distance (abs (- value num))
+                  best-color (car candidate))))
+      (setq color-values (cdr color-values))
+      (setq candidate (car color-values)))
+    best-color))
 ;; ---------------------------------------------------------------------------
 ;; We want to delay setting frame parameters until the faces are setup
 (defvar default-frame-alist nil)