>>>> "Gleb" == Gleb Arshinov
<gleb(a)barsook.com> writes:
>>>> "William" == William M Perry
<wmperry(a)gnu.org> writes:
Andy> closest match would be great
BP> Code to do this in emacs/w3 is already sitting around in
BP> font.el. Check out font-tty-find-closest-color
Gleb> Thanks for the pointer. I'll see if I can produce a patch
Gleb> to hook in a heuristic to set-face-* functions. Should be
Gleb> somewhat user-configurable. It can't be perfect, but I've
Gleb> been playing with different heuristics locally and it seems
Gleb> a great improvement over default behavior.
OK, I still have not gotten to producing a patch. However, I've been
using the following in my .emacs for a while now, and I've been very
happy with results. XEmacs becomes very colorful, and there are only
a few problematic faces. Perhaps, this will be useful to somebody.
Gleb
(require 'font)
(defvar my-available-colors (mapcar 'car (read-color-completion-table)))
(defvar my-color-substituion-alist
'(("pink" . "red") ; or it goes to white
("white" . "color_that_dont_exist")
("cyan". "color_that_dont_exist") ; don't like cyan
("sky blue". "color_that_dont_exist"))) ; ediff blue on blue face
; background
(defun my-string-in-list-p (string list)
(memq t (mapcar
(lambda (list-member) (not (not (equal list-member string))))
list)))
(defun my-colors-loose-match-p (c1 c2)
(cond
((string-match (downcase c1) (downcase c2)) t)
((string-match (downcase c2) (downcase c1)) t)
(t nil)))
(defun find-colors-loose-match-in-list (color list)
(cond ((not (car list)) nil)
((my-colors-loose-match-p color (car list)) (car list))
(t (find-colors-loose-match-in-list color (cdr list)))))
(defun my-font-normalize-color (color)
(cond
;; see if we have explicit substitution
((assoc color my-color-substituion-alist)
(cdr (assoc color my-color-substituion-alist)))
;; see if this is a valid color already
((my-string-in-list-p color my-available-colors) color)
;; see if we can get a text match
((find-colors-loose-match-in-list color my-available-colors)
(find-colors-loose-match-in-list color my-available-colors))
;; call font.el routine then do recursive call to go through
;; my-color-substituion-alist again
(t (my-font-normalize-color (font-normalize-color color)))))
(cond ((eq 'tty (device-type))
(defadvice set-face-foreground
(before my-canonize-color-advice
(face color &optional locale tag-set how-to-add))
(setq color (my-font-normalize-color color)))
(ad-activate 'set-face-foreground)
(defadvice set-face-background
(before my-canonize-color-advice
(face color &optional locale tag-set how-to-add))
(setq color (my-font-normalize-color color)))
(ad-activate 'set-face-background)))