mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-12-26 10:49:33 +00:00
(msdos-approximate-color): New function.
(msdos-color-translate): Call it to find a DOS color that best approximates an X-style "#NNNNNN" color specification.
This commit is contained in:
parent
f670496a30
commit
a13b5fad5d
@ -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)
|
||||
|
Loading…
Reference in New Issue
Block a user