(msdos-approximate-color): New function.

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

1 files changed, 28 insertions, 1 deletions

diff --git a/lisp/term/pc-win.el b/lisp/term/pc-win.el
index 2a20dea4527..c97391060c8 100644
--- 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)