mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-01-30 12:21:25 -08:00
Code Issues Projects Releases Wiki Activity

Changes for automatic remapping of X colors on terminal frames:

Browse source 
* term/pc-win.el (msdos-setup-initial-frame): New function, run by
	term-setup-hook.  Call msdos-remember-default-colors and
	msdos-handle-reverse-video.
	(msdos-face-setup): Parts of code moved to
	msdos-setup-initial-frame.
	(msdos-handle-reverse-video): New function, modeled after
	x-handle-reverse-video.
	(make-msdos-frame): Don't use initial-frame-alist and
	default-frame-alist.  Call msdos-handle-reverse-video.
	(msdos-color-aliases): Remove.
	(msdos-color-translate, msdos-approximate-color): Remove.
	(msdos-color-values): Use 16-bit RGB values.  RGB values updated
	for better approximation of X colors.
	(msdos-face-setup): Call tty-color-clear.  Remove code that sets
	up tty-color-alist (it is now on startup.el).
	(x-display-color-p, x-color-defined-p, x-color-values,
	x-defined-colors, face-color-supported-p, face-color-gray-p):
	Remove.

	* facemenu.el (facemenu-read-color, list-colors-display): Use
	defined-colors for all frame types.
	(facemenu-color-equal): Use color-values for all frame types.

	* faces.el (read-face-attribute): For :foreground and :background
	attributes and frames on character terminals, translate the color
	to the closest supported one before looking it up in the list of
	valid values.
	(face-valid-attribute-values): Call defined-colors for all types
	of frames.
	(defined-colors, color-defined-p, color-values, display-color-p):
	New finctions.
	(x-defined-colors, x-color-defined-p, x-color-values,
	x-display-color-p): Aliases for the above.

	* startup.el (command-line): Register terminal colors for frame
	types other than x and w32, but only if the terminal supports
	colors.  Call tty-color-define instead of face-register-tty-color.

	* term/x-win.el (xw-defined-colors): Renamed from
	x-defined-colors.
	* term/w32-win.el (xw-defined-colors): Likewise.

	* term/tty-colors.el: New file.
	* loadup.el: Load term/tty-colors.
This commit is contained in:
Eli Zaretskii 1999-12-06 17:55:00 +00:00
parent b55048d4d6
commit f795f63364
9 changed files with 1131 additions and 328 deletions
Download patch file Download diff file Expand all files Collapse all files

49
lisp/ChangeLog
View file

@ -1,3 +1,52 @@
1999-12-06 Eli Zaretskii <eliz@is.elta.co.il>
Changes for automatic remapping of X colors on terminal frames:
* term/pc-win.el (msdos-setup-initial-frame): New function, run by
term-setup-hook. Call msdos-remember-default-colors and
msdos-handle-reverse-video.
(msdos-face-setup): Parts of code moved to
msdos-setup-initial-frame.
(msdos-handle-reverse-video): New function, modeled after
x-handle-reverse-video.
(make-msdos-frame): Don't use initial-frame-alist and
default-frame-alist. Call msdos-handle-reverse-video.
(msdos-color-aliases): Remove.
(msdos-color-translate, msdos-approximate-color): Remove.
(msdos-color-values): Use 16-bit RGB values. RGB values updated
for better approximation of X colors.
(msdos-face-setup): Call tty-color-clear. Remove code that sets
up tty-color-alist (it is now on startup.el).
(x-display-color-p, x-color-defined-p, x-color-values,
x-defined-colors, face-color-supported-p, face-color-gray-p):
Remove.
* facemenu.el (facemenu-read-color, list-colors-display): Use
defined-colors for all frame types.
(facemenu-color-equal): Use color-values for all frame types.
* faces.el (read-face-attribute): For :foreground and :background
attributes and frames on character terminals, translate the color
to the closest supported one before looking it up in the list of
valid values.
(face-valid-attribute-values): Call defined-colors for all types
of frames.
(defined-colors, color-defined-p, color-values, display-color-p):
New finctions.
(x-defined-colors, x-color-defined-p, x-color-values,
x-display-color-p): Aliases for the above.
* startup.el (command-line): Register terminal colors for frame
types other than x and w32, but only if the terminal supports
colors. Call tty-color-define instead of face-register-tty-color.
* term/x-win.el (xw-defined-colors): Renamed from
x-defined-colors.
* term/w32-win.el (xw-defined-colors): Likewise.
* term/tty-colors.el: New file.
* loadup.el: Load term/tty-colors.
1999-12-06 Dave Love <fx@gnu.org>
* ffap.el: Autoload the ffap alias directly.

18
lisp/facemenu.el
View file

@ -467,9 +467,7 @@ These special properties include `invisible', `intangible' and `read-only'."
"Read a color using the minibuffer."
(let ((col (completing-read (or prompt "Color: ")
(or facemenu-color-alist
(if window-system
(mapcar 'list (x-defined-colors))
(mapcar 'list (tty-defined-colors))))
(mapcar 'list (defined-colors)))
nil t)))
(if (equal "" col)
nil
@ -483,9 +481,7 @@ colors to display. Otherwise, this command computes a list
of colors that the current display can handle."
(interactive)
(when (null list)
(setq list (if window-system
(x-defined-colors)
(tty-defined-colors)))
(setq list (defined-colors))
;; Delete duplicate colors.
(let ((l list))
(while (cdr l)
@ -511,15 +507,11 @@ of colors that the current display can handle."
(defun facemenu-color-equal (a b)
"Return t if colors A and B are the same color.
A and B should be strings naming colors.
This function queries the window-system server to find out what the
color names mean. It returns nil if the colors differ or if it can't
This function queries the display system to find out what the color
names mean. It returns nil if the colors differ or if it can't
determine the correct answer."
(cond ((equal a b) t)
((and (memq window-system '(x w32))
(equal (x-color-values a) (x-color-values b))))
((eq window-system 'pc)
(and (x-color-defined-p a) (x-color-defined-p b)
(eq (msdos-color-translate a) (msdos-color-translate b))))))
((equal (color-values a) (color-values b)))))
(defun facemenu-add-face (face &optional start end)
"Add FACE to text between START and END.

64
lisp/faces.el
View file

@ -758,8 +758,7 @@ an integer value."
(internal-lisp-face-attribute-values attribute))))
((:foreground :background)
(mapcar #'(lambda (c) (cons c c))
(or (and window-system (x-defined-colors frame))
(tty-defined-colors))))
(defined-colors frame)))
((:height)
'integerp)
(:stipple
@ -858,6 +857,13 @@ of a global face. Value is the new attribute value."
(cond ((listp valid)
(setq new-value
(face-read-string face old-value attribute-name valid))
;; Terminal frames can support colors that don't appear
;; explicitly in VALID, using color approximation code
;; in tty-colors.el.
(if (and (memq attribute '(:foreground :background))
(not (memq window-system '(x w32 mac)))
(not (eq new-value 'unspecified)))
(setq new-value (car (tty-color-desc new-value))))
(unless (eq new-value 'unspecified)
(setq new-value (cdr (assoc new-value valid)))))
((eq valid 'integerp)
@ -1139,6 +1145,60 @@ is used. If nil or omitted, use the selected frame."
(face-attr-match-p face (face-spec-choose spec frame) frame))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Frame-type independent color support.
;;; We keep the old x-* names as aliases for back-compatibility.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun defined-colors (&optional frame)
"Return a list of colors supported for a particular frame.
The argument FRAME specifies which frame to try.
The value may be different for frames on different display types.
If FRAME doesn't support colors, the value is nil."
(if (memq (framep (or frame (selected-frame))) '(x w32))
(xw-defined-colors frame)
(mapcar 'car tty-color-alist)))
(defalias 'x-defined-colors 'defined-colors)
(defun color-defined-p (color &optional frame)
"Return non-nil if color COLOR is supported on frame FRAME.
If FRAME is omitted or nil, use the selected frame.
If COLOR is the symbol `unspecified', the value is nil."
(if (eq color 'unspecified)
nil
(if (memq (framep (or frame (selected-frame))) '(x w32))
(xw-color-defined-p color frame)
(numberp (tty-color-translate color)))))
(defalias 'x-color-defined-p 'color-defined-p)
(defun color-values (color &optional frame)
"Return a description of the color named COLOR on frame FRAME.
The value is a list of integer RGB values--\(RED GREEN BLUE\).
These values appear to range from 0 to 65280 or 65535, depending
on the system; white is \(65280 65280 65280\) or \(65535 65535 65535\).
If FRAME is omitted or nil, use the selected frame.
If FRAME cannot display COLOR, the value is nil.
If COLOR is the symbol `unspecified', the value is nil."
(if (eq color 'unspecified)
nil
(if (memq (framep (or frame (selected-frame))) '(x w32))
(xw-color-values color frame)
(tty-color-values color frame))))
(defalias 'x-color-values 'color-values)
(defun display-color-p (&optional display)
"Return t if DISPLAY supports color.
The optional argument DISPLAY specifies which display to ask about.
DISPLAY should be either a frame or a display name (a string).
If omitted or nil, that stands for the selected frame's display."
(if (and (stringp display) (not (fboundp 'x-display-list)))
nil
(if (memq (framep (or display (selected-frame))) '(x w32))
(xw-display-color-p display)
(tty-display-color-p))))
(defalias 'x-display-color-p 'display-color-p)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Background mode.

1
lisp/loadup.el
View file

@ -107,6 +107,7 @@
(load "isearch")
(load "window")
(load "frame")
(load "term/tty-colors")
(load "faces")
(if (fboundp 'frame-face-alist)
(progn

18
lisp/startup.el
View file

@ -735,16 +735,16 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'."
(funcall initial-major-mode))))
;; Register default TTY colors for the case the terminal hasn't a
;; terminal init file. The colors are good for xterm-color and the
;; FreeBSD console (cons.*). They should be sufficient for Linux
;; too, I guess.
(or (eq window-system 'pc) ; pc-win.el did this already
(let ((colors '("black" "red" "green" "yellow" "blue" "magenta"
"cyan" "white"))
(i 0))
;; terminal init file.
(or (memq window-system '(x w32))
(not (tty-display-color-p))
(let* ((colors (if (eq window-system 'pc)
msdos-color-values
tty-standard-colors))
(color (car colors)))
(while colors
(face-register-tty-color (car colors) i)
(setq colors (cdr colors) i (1+ i)))))
(tty-color-define (car color) (cadr color) (cddr color))
(setq colors (cdr colors) color (car colors)))))
;; Load library for our terminal type.
;; User init file can set term-file-prefix to nil to prevent this.

359
lisp/term/pc-win.el
View file

@ -26,285 +26,46 @@
(load "term/internal" nil t)
;; Color translation -- doesn't really need to be fast.
;; Colors listed here do not include the "light-",
;; "medium-" and "dark-" prefixes that are accounted for
;; by `msdos-color-translate', which see below).
(defvar msdos-color-aliases
'(("snow" . "white")
("ghost white" . "white")
("ghostwhite" . "white")
("white smoke" . "white")
("whitesmoke" . "white")
("gainsboro" . "white")
("floral white" . "white")
("floralwhite" . "white")
("old lace" . "white")
("oldlace" . "white")
("linen" . "white")
("antique white" . "white")
("antiquewhite" . "white")
("papaya whip" . "white")
("papayawhip" . "white")
("blanched almond" . "white")
("blanchedalmond" . "white")
("bisque" . "white")
("peach puff" . "lightred")
("peachpuff" . "lightred")
("navajo white" . "lightred")
("navajowhite" . "lightred")
("moccasin" . "lightred")
("cornsilk" . "white")
("ivory" . "white")
("lemon chiffon" . "yellow")
("lemonchiffon" . "yellow")
("seashell" . "white")
("honeydew" . "white")
("mint cream" . "white")
("mintcream" . "white")
("azure" . "lightcyan")
("alice blue" . "lightcyan")
("aliceblue" . "lightcyan")
("lavender" . "lightcyan")
("lavender blush" . "lightcyan")
("lavenderblush" . "lightcyan")
("misty rose" . "lightred")
("mistyrose" . "lightred")
("aquamarine" . "blue")
("cadet blue" . "blue")
("cadetblue" . "blue")
("cornflower blue" . "lightblue")
("cornflowerblue" . "lightblue")
("midnight blue" . "blue")
("midnightblue" . "blue")
("navy blue" . "cyan")
("navyblue" . "cyan")
("navy" . "cyan")
("royalblue" . "blue")
("royal blue" . "blue")
("sky blue" . "lightblue")
("skyblue" . "lightblue")
("dodger blue" . "blue")
("dodgerblue" . "blue")
("powder blue" . "lightblue")
("powderblue" . "lightblue")
("slate blue" . "cyan")
("slateblue" . "cyan")
("steel blue" . "blue")
("steelblue" . "blue")
("coral" . "lightred")
("tomato" . "lightred")
("firebrick" . "red")
("gold" . "yellow")
("goldenrod" . "yellow")
("goldenrod yellow" . "yellow")
("goldenrodyellow" . "yellow")
("pale goldenrod" . "yellow")
("palegoldenrod" . "yellow")
("olive green" . "lightgreen")
("olivegreen" . "lightgreen")
("olive drab" . "green")
("olivedrab" . "green")
("forest green" . "green")
("forestgreen" . "green")
("lime green" . "lightgreen")
("limegreen" . "lightgreen")
("sea green" . "lightcyan")
("seagreen" . "lightcyan")
("spring green" . "green")
("springgreen" . "green")
("lawn green" . "lightgreen")
("lawngreen" . "lightgreen")
("chartreuse" . "yellow")
("yellow green" . "lightgreen")
("yellowgreen" . "lightgreen")
("green yellow" . "lightgreen")
("greenyellow" . "lightgreen")
("slate grey" . "lightgray")
("slategrey" . "lightgray")
("slate gray" . "lightgray")
("slategray" . "lightgray")
("dim grey" . "darkgray")
("dimgrey" . "darkgray")
("dim gray" . "darkgray")
("dimgray" . "darkgray")
("light grey" . "lightgray")
("lightgrey" . "lightgray")
("light gray" . "lightgray")
("gray" . "darkgray")
("grey" . "darkgray")
("khaki" . "green")
("maroon" . "red")
("orange" . "brown")
("orchid" . "brown")
("saddle brown" . "red")
("saddlebrown" . "red")
("peru" . "red")
("burlywood" . "brown")
("sandy brown" . "brown")
("sandybrown" . "brown")
("pink" . "lightred")
("hotpink" . "lightred")
("hot pink" ."lightred")
("plum" . "magenta")
("indian red" . "red")
("indianred" . "red")
("violet red" . "magenta")
("violetred" . "magenta")
("orange red" . "red")
("orangered" . "red")
("salmon" . "lightred")
("sienna" . "lightred")
("tan" . "lightred")
("chocolate" . "brown")
("thistle" . "magenta")
("turquoise" . "lightgreen")
("pale turquoise" . "cyan")
("paleturquoise" . "cyan")
("violet" . "magenta")
("blue violet" . "lightmagenta")
("blueviolet" . "lightmagenta")
("wheat" . "white")
("green yellow" . "yellow")
("greenyellow" . "yellow")
("purple" . "magenta")
("rosybrown" . "brown")
("rosy brown" . "brown")
("beige" . "brown"))
"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)
(length (member name x-colors))))
(try))
(if (or (< val 0) (>= val (length x-colors))) (setq val nil))
(or val
(and (setq try (cdr (assoc name msdos-color-aliases)))
(msdos-color-translate try))
(and (> len 5)
(string= "light" (substring name 0 5))
(setq try (msdos-color-translate (substring name 5)))
(logior try 8))
(and (> len 6)
(string= "light " (substring name 0 6))
(setq try (msdos-color-translate (substring name 6)))
(logior try 8))
(and (> len 4)
(string= "pale" (substring name 0 4))
(setq try (msdos-color-translate (substring name 4)))
(logior try 8))
(and (> len 5)
(string= "pale " (substring name 0 5))
(setq try (msdos-color-translate (substring name 5)))
(logior try 8))
(and (> len 6)
(string= "medium" (substring name 0 6))
(msdos-color-translate (substring name 6)))
(and (> len 7)
(string= "medium " (substring name 0 7))
(msdos-color-translate (substring name 7)))
(and (> len 4)
(or (string= "dark" (substring name 0 4))
(string= "deep" (substring name 0 4)))
(msdos-color-translate (substring name 4)))
(and (> len 5)
(or (string= "dark " (substring name 0 5))
(string= "deep " (substring name 0 5)))
(msdos-color-translate (substring name 5)))
(and (> len 4) ;; gray shades: gray0 to gray100
(save-match-data
(and
(string-match "gr[ae]y[0-9]" name)
(string-match "[0-9]+\\'" name)
(let ((num (string-to-int
(substring name (match-beginning 0)))))
(msdos-color-translate
(cond
((> num 90) "white")
((> num 50) "lightgray")
((> num 10) "darkgray")
(t "black")))))))
(and (> len 1) ;; purple1 to purple4 and the like
(save-match-data
(and
(string-match "[1-4]\\'" name)
(msdos-color-translate
(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)))))))
;;;
;;; This is copied from etc/rgb.txt, except that some values were changed
;;; a bit to make them consistent with DOS console colors. The order of
;;; the colors is according to the PC text mode color codes.
;;; a bit to make them consistent with DOS console colors, and the RGB
;;; values were scaled up to 16 bits, as `tty-define-color' requires.
;;;
;;; The mapping between the 16 standard EGA/VGA colors and X color names
;;; was done by running a Unix version of Emacs inside an X client and a
;;; DJGPP-compiled Emacs on the same PC. The names of X colors used to
;;; define the pixel values are shown as comments to each color below.
;;;
;;; If you want to change the RGB values, keep in mind that various pieces
;;; of Emacs think that a color whose RGB values add up to less than 0.6 of
;;; the values for WHITE (i.e. less than 459) are ``dark'', otherwise the
;;; the values for WHITE (i.e. less than 117963) are ``dark'', otherwise the
;;; color is ``light''; see `frame-set-background-mode' in lisp/faces.el for
;;; an example.
(defvar msdos-color-values
'(("black" 0 0 0)
("blue" 0 0 255)
("green" 0 255 0)
("cyan" 0 255 255)
("red" 255 0 0)
("magenta" 139 0 139) ; dark magenta
("brown" 165 42 42)
("lightgray" 211 211 211)
("darkgray" 102 102 102) ; gray40
("lightblue" 173 216 230)
("lightgreen" 144 238 144)
("lightcyan" 224 255 255)
("lightred" 255 52 179) ; maroon1
("lightmagenta" 238 0 238) ; magenta2
("yellow" 255 255 0)
("white" 255 255 255))
"A list of MS-DOS console colors and their RGB values.")
'(("white" 15 65535 65535 65535)
("yellow" 14 65535 65535 0) ; Yellow
("lightmagenta" 13 65535 0 65535) ; Magenta
("lightred" 12 65535 0 0) ; Red
("lightcyan" 11 0 65535 65535) ; Cyan
("lightgreen" 10 0 65535 0) ; Green
("lightblue" 9 0 0 65535) ; Blue
("darkgray" 8 26112 26112 26112) ; Gray40
("lightgray" 7 48640 48640 48640) ; Gray
("brown" 6 40960 20992 11520) ; Sienna
("magenta" 5 35584 0 35584) ; DarkMagenta
("red" 4 45568 8704 8704) ; FireBrick
("cyan" 3 0 52736 53504) ; DarkTurquoise
("green" 2 8704 35584 8704) ; ForestGreen
("blue" 1 0 0 52480) ; MediumBlue
("black" 0 0 0 0))
"A list of MS-DOS console colors, their indices and 16-bit RGB values.")
(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)
(modify-frame-parameters terminal-frame default-frame-alist)
(tty-color-clear)
(defun msdos-face-setup ()
(modify-frame-parameters terminal-frame default-frame-alist)
(face-clear-tty-colors)
(let ((colors msdos-color-values)
(i 0))
(while colors
(face-register-tty-color (car (car colors)) i)
(setq colors (cdr colors) i (1+ i))))
(frame-set-background-mode terminal-frame)
(face-set-after-frame-default terminal-frame)
(set-face-foreground 'bold "yellow" terminal-frame)
(set-face-foreground 'italic "red" terminal-frame)
(set-face-foreground 'bold-italic "lightred" terminal-frame)
@ -319,18 +80,47 @@
(set-face-background 'msdos-menu-passive-face "blue" terminal-frame)
(set-face-background 'msdos-menu-select-face "red" terminal-frame))
;; We have only one font, so...
(add-hook 'before-init-hook 'msdos-face-setup)
(defun msdos-handle-reverse-video (frame parameters)
"Handle the reverse-video frame parameter on MS-DOS frames."
(when (cdr (assq 'reverse parameters))
(let* ((params (frame-parameters frame))
(bg (cdr (assq 'foreground-color params)))
(fg (cdr (assq 'background-color params))))
(modify-frame-parameters frame '((reverse . nil)))
(if (equal bg (cdr (assq 'mouse-color params)))
(modify-frame-parameters frame
(list (cons 'mouse-color fg))))
(if (equal bg (cdr (assq 'cursor-color params)))
(modify-frame-parameters frame
(list (cons 'cursor-color fg)))))))
;; This must run after all the default colors are inserted into
;; tty-color-alist, since msdos-handle-reverse-video needs to know the
;; actual frame colors. tty-color-alist is set up by startup.el, but
;; only after it runs before-init-hook and after-init-hook.
(defun msdos-setup-initial-frame ()
(modify-frame-parameters terminal-frame default-frame-alist)
;; This remembers the screen colors after applying default-frame-alist,
;; so that all subsequent frames could begin with those colors.
(msdos-remember-default-colors terminal-frame)
(modify-frame-parameters terminal-frame initial-frame-alist)
(msdos-handle-reverse-video terminal-frame
(frame-parameters terminal-frame))
(frame-set-background-mode terminal-frame)
(face-set-after-frame-default terminal-frame))
(add-hook 'term-setup-hook 'msdos-setup-initial-frame)
;; We create frames as if we were a terminal, but with a twist.
(defun make-msdos-frame (&optional parameters)
(let* ((parms
(append initial-frame-alist default-frame-alist parameters nil))
(frame (make-terminal-frame parms))
success)
(let ((frame (make-terminal-frame parameters))
success)
(unwind-protect
(progn
(x-handle-reverse-video frame parms)
(msdos-handle-reverse-video frame (frame-parameters frame))
(frame-set-background-mode frame)
(face-set-after-frame-default frame)
(setq success t))
@ -346,12 +136,10 @@
;; a useful function for returning 'nil regardless of argument.
;; From src/xfns.c
(defun x-display-color-p (&optional display) 't)
(defun x-list-fonts (pattern &optional face frame maximum width)
(if (or (null width) (and (numberp width) (= width 1)))
(list "ms-dos")
(list "no-such-font")))
(defun x-color-defined-p (color) (numberp (msdos-color-translate color)))
(defun x-display-pixel-width (&optional frame) (frame-width frame))
(defun x-display-pixel-height (&optional frame) (frame-height frame))
(defun x-display-planes (&optional frame) 4) ;bg switched to 16 colors as well
@ -367,33 +155,12 @@
(fset 'x-display-save-under 'ignore)
(fset 'x-get-resource 'ignore)
(defun x-color-values (color &optional frame)
"Return a description of the color named COLOR on frame FRAME.\n\
The value is a list of integer RGB values--(RED GREEN BLUE).\n\
These values range from 0 to 255; white is (255 255 255).\n\
If FRAME is omitted or nil, use the selected frame."
(if (x-color-defined-p color)
(let ((frame (or frame (selected-frame)))
(color-code (msdos-color-translate color)))
(cdr (nth color-code msdos-color-values)))))
;; From lisp/term/x-win.el
(setq x-display-name "pc")
(defvar x-display-name "pc"
"The display name specifying the MS-DOS display and frame type.")
(setq split-window-keep-point t)
(defvar x-colors (mapcar 'car msdos-color-values)
"The list of colors available on a PC display under MS-DOS.")
(defun x-defined-colors (&optional frame)
"Return a list of colors supported for a particular frame.
The argument FRAME specifies which frame to try.
The value may be different for frames on different X displays."
x-colors)
(defun face-color-supported-p (color)
(x-color-defined-p color))
(defun face-color-gray-p (color)
(member (msdos-color-translate color)
'("black" "lightgray" "darkgray" "white")))
;; From lisp/term/w32-win.el
;

938
lisp/term/tty-colors.el Normal file
View file

@ -0,0 +1,938 @@
;;; tty-color.el --- color support for character terminals
;; Copyright (C) 1999 Free Software Foundation, Inc.
;; Author: Eli Zaretskii <eliz@is.elta.co.il>
;; Maintainer: FSF
;; Keywords: terminals, faces
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;; Emacs support for colors evolved from the X Window System; color
;; support for character-based terminals came later. Many Lisp
;; packages use color names defined by X and assume the availability
;; of certain functions that look up colors, convert them to pixel
;; values, etc.
;; This file provides a more or less useful emulation of the X color
;; functionality for character-based terminals, and thus relieves the
;; rest of Emacs from including special code for this case.
;; Here's how it works. The support for terminal and MSDOS frames
;; maintains an alist, called `tty-color-alist', which associates
;; colors supported by the terminal driver with small integers.
;; (These small integers are passed to the library functions which set
;; the color, and are effectively indices of the colors in the
;; supported color palette.) When Emacs needs to send a color command
;; to the terminal, the color name is first looked up in
;; `tty-color-alist'. If not found, functions from this file can be
;; used to map the color to one of the supported colors.
;; Specifically, the X RGB values of the requested color are extracted
;; from `color-name-rgb-alist' and then the supported color is found
;; with the minimal distance in the RGB space from the requested
;; color.
;; `tty-color-alist' is created at startup by calling the function
;; `tty-color-define', defined below, passing it each supported color,
;; its index, and its RGB values. The standard list of colors
;; supported by many Unix color terminals, including xterm, FreeBSD,
;; and GNU/Linux, is supplied below in `tty-standard-colors'. If your
;; terminal supports different or additional colors, call
;; `tty-color-define' from your `.emacs' or `site-start.el'.
;;; Code:
(defvar color-name-rgb-alist
'(("snow" 255 250 250)
("ghostwhite" 248 248 255)
("whitesmoke" 245 245 245)
("gainsboro" 220 220 220)
("floralwhite" 255 250 240)
("oldlace" 253 245 230)
("linen" 250 240 230)
("antiquewhite" 250 235 215)
("papayawhip" 255 239 213)
("blanchedalmond" 255 235 205)
("bisque" 255 228 196)
("peachpuff" 255 218 185)
("navajowhite" 255 222 173)
("moccasin" 255 228 181)
("cornsilk" 255 248 220)
("ivory" 255 255 240)
("lemonchiffon" 255 250 205)
("seashell" 255 245 238)
("honeydew" 240 255 240)
("mintcream" 245 255 250)
("azure" 240 255 255)
("aliceblue" 240 248 255)
("lavender" 230 230 250)
("lavenderblush" 255 240 245)
("mistyrose" 255 228 225)
("white" 255 255 255)
("black" 0 0 0)
("darkslategray" 47 79 79)
("darkslategrey" 47 79 79)
("dimgray" 105 105 105)
("dimgrey" 105 105 105)
("slategray" 112 128 144)
("slategrey" 112 128 144)
("lightslategray" 119 136 153)
("lightslategrey" 119 136 153)
("gray" 190 190 190)
("grey" 190 190 190)
("lightgrey" 211 211 211)
("lightgray" 211 211 211)
("midnightblue" 25 25 112)
("navy" 0 0 128)
("navyblue" 0 0 128)
("cornflowerblue" 100 149 237)
("darkslateblue" 72 61 139)
("slateblue" 106 90 205)
("mediumslateblue" 123 104 238)
("lightslateblue" 132 112 255)
("mediumblue" 0 0 205)
("royalblue" 65 105 225)
("blue" 0 0 255)
("dodgerblue" 30 144 255)
("deepskyblue" 0 191 255)
("skyblue" 135 206 235)
("lightskyblue" 135 206 250)
("steelblue" 70 130 180)
("lightsteelblue" 176 196 222)
("lightblue" 173 216 230)
("powderblue" 176 224 230)
("paleturquoise" 175 238 238)
("darkturquoise" 0 206 209)
("mediumturquoise" 72 209 204)
("turquoise" 64 224 208)
("cyan" 0 255 255)
("lightcyan" 224 255 255)
("cadetblue" 95 158 160)
("mediumaquamarine" 102 205 170)
("aquamarine" 127 255 212)
("darkgreen" 0 100 0)
("darkolivegreen" 85 107 47)
("darkseagreen" 143 188 143)
("seagreen" 46 139 87)
("mediumseagreen" 60 179 113)
("lightseagreen" 32 178 170)
("palegreen" 152 251 152)
("springgreen" 0 255 127)
("lawngreen" 124 252 0)
("green" 0 255 0)
("chartreuse" 127 255 0)
("mediumspringgreen" 0 250 154)
("greenyellow" 173 255 47)
("limegreen" 50 205 50)
("yellowgreen" 154 205 50)
("forestgreen" 34 139 34)
("olivedrab" 107 142 35)
("darkkhaki" 189 183 107)
("khaki" 240 230 140)
("palegoldenrod" 238 232 170)
("lightgoldenrodyellow" 250 250 210)
("lightyellow" 255 255 224)
("yellow" 255 255 0)
("gold" 255 215 0)
("lightgoldenrod" 238 221 130)
("goldenrod" 218 165 32)
("darkgoldenrod" 184 134 11)
("rosybrown" 188 143 143)
("indianred" 205 92 92)
("saddlebrown" 139 69 19)
("sienna" 160 82 45)
("peru" 205 133 63)
("burlywood" 222 184 135)
("beige" 245 245 220)
("wheat" 245 222 179)
("sandybrown" 244 164 96)
("tan" 210 180 140)
("chocolate" 210 105 30)
("firebrick" 178 34 34)
("brown" 165 42 42)
("darksalmon" 233 150 122)
("salmon" 250 128 114)
("lightsalmon" 255 160 122)
("orange" 255 165 0)
("darkorange" 255 140 0)
("coral" 255 127 80)
("lightcoral" 240 128 128)
("tomato" 255 99 71)
("orangered" 255 69 0)
("red" 255 0 0)
("hotpink" 255 105 180)
("deeppink" 255 20 147)
("pink" 255 192 203)
("lightpink" 255 182 193)
("palevioletred" 219 112 147)
("maroon" 176 48 96)
("mediumvioletred" 199 21 133)
("violetred" 208 32 144)
("magenta" 255 0 255)
("violet" 238 130 238)
("plum" 221 160 221)
("orchid" 218 112 214)
("mediumorchid" 186 85 211)
("darkorchid" 153 50 204)
("darkviolet" 148 0 211)
("blueviolet" 138 43 226)
("purple" 160 32 240)
("mediumpurple" 147 112 219)
("thistle" 216 191 216)
("snow1" 255 250 250)
("snow2" 238 233 233)
("snow3" 205 201 201)
("snow4" 139 137 137)
("seashell1" 255 245 238)
("seashell2" 238 229 222)
("seashell3" 205 197 191)
("seashell4" 139 134 130)
("antiquewhite1" 255 239 219)
("antiquewhite2" 238 223 204)
("antiquewhite3" 205 192 176)
("antiquewhite4" 139 131 120)
("bisque1" 255 228 196)
("bisque2" 238 213 183)
("bisque3" 205 183 158)
("bisque4" 139 125 107)
("peachpuff1" 255 218 185)
("peachpuff2" 238 203 173)
("peachpuff3" 205 175 149)
("peachpuff4" 139 119 101)
("navajowhite1" 255 222 173)
("navajowhite2" 238 207 161)
("navajowhite3" 205 179 139)
("navajowhite4" 139 121 94)
("lemonchiffon1" 255 250 205)
("lemonchiffon2" 238 233 191)
("lemonchiffon3" 205 201 165)
("lemonchiffon4" 139 137 112)
("cornsilk1" 255 248 220)
("cornsilk2" 238 232 205)
("cornsilk3" 205 200 177)
("cornsilk4" 139 136 120)
("ivory1" 255 255 240)
("ivory2" 238 238 224)
("ivory3" 205 205 193)
("ivory4" 139 139 131)
("honeydew1" 240 255 240)
("honeydew2" 224 238 224)
("honeydew3" 193 205 193)
("honeydew4" 131 139 131)
("lavenderblush1" 255 240 245)
("lavenderblush2" 238 224 229)
("lavenderblush3" 205 193 197)
("lavenderblush4" 139 131 134)
("mistyrose1" 255 228 225)
("mistyrose2" 238 213 210)
("mistyrose3" 205 183 181)
("mistyrose4" 139 125 123)
("azure1" 240 255 255)
("azure2" 224 238 238)
("azure3" 193 205 205)
("azure4" 131 139 139)
("slateblue1" 131 111 255)
("slateblue2" 122 103 238)
("slateblue3" 105 89 205)
("slateblue4" 71 60 139)
("royalblue1" 72 118 255)
("royalblue2" 67 110 238)
("royalblue3" 58 95 205)
("royalblue4" 39 64 139)
("blue1" 0 0 255)
("blue2" 0 0 238)
("blue3" 0 0 205)
("blue4" 0 0 139)
("dodgerblue1" 30 144 255)
("dodgerblue2" 28 134 238)
("dodgerblue3" 24 116 205)
("dodgerblue4" 16 78 139)
("steelblue1" 99 184 255)
("steelblue2" 92 172 238)
("steelblue3" 79 148 205)
("steelblue4" 54 100 139)
("deepskyblue1" 0 191 255)
("deepskyblue2" 0 178 238)
("deepskyblue3" 0 154 205)
("deepskyblue4" 0 104 139)
("skyblue1" 135 206 255)
("skyblue2" 126 192 238)
("skyblue3" 108 166 205)
("skyblue4" 74 112 139)
("lightskyblue1" 176 226 255)
("lightskyblue2" 164 211 238)
("lightskyblue3" 141 182 205)
("lightskyblue4" 96 123 139)
("slategray1" 198 226 255)
("slategray2" 185 211 238)
("slategray3" 159 182 205)
("slategray4" 108 123 139)
("lightsteelblue1" 202 225 255)
("lightsteelblue2" 188 210 238)
("lightsteelblue3" 162 181 205)
("lightsteelblue4" 110 123 139)
("lightblue1" 191 239 255)
("lightblue2" 178 223 238)
("lightblue3" 154 192 205)
("lightblue4" 104 131 139)
("lightcyan1" 224 255 255)
("lightcyan2" 209 238 238)
("lightcyan3" 180 205 205)
("lightcyan4" 122 139 139)
("paleturquoise1" 187 255 255)
("paleturquoise2" 174 238 238)
("paleturquoise3" 150 205 205)
("paleturquoise4" 102 139 139)
("cadetblue1" 152 245 255)
("cadetblue2" 142 229 238)
("cadetblue3" 122 197 205)
("cadetblue4" 83 134 139)
("turquoise1" 0 245 255)
("turquoise2" 0 229 238)
("turquoise3" 0 197 205)
("turquoise4" 0 134 139)
("cyan1" 0 255 255)
("cyan2" 0 238 238)
("cyan3" 0 205 205)
("cyan4" 0 139 139)
("darkslategray1" 151 255 255)
("darkslategray2" 141 238 238)
("darkslategray3" 121 205 205)
("darkslategray4" 82 139 139)
("aquamarine1" 127 255 212)
("aquamarine2" 118 238 198)
("aquamarine3" 102 205 170)
("aquamarine4" 69 139 116)
("darkseagreen1" 193 255 193)
("darkseagreen2" 180 238 180)
("darkseagreen3" 155 205 155)
("darkseagreen4" 105 139 105)
("seagreen1" 84 255 159)
("seagreen2" 78 238 148)
("seagreen3" 67 205 128)
("seagreen4" 46 139 87)
("palegreen1" 154 255 154)
("palegreen2" 144 238 144)
("palegreen3" 124 205 124)
("palegreen4" 84 139 84)
("springgreen1" 0 255 127)
("springgreen2" 0 238 118)
("springgreen3" 0 205 102)
("springgreen4" 0 139 69)
("green1" 0 255 0)
("green2" 0 238 0)
("green3" 0 205 0)
("green4" 0 139 0)
("chartreuse1" 127 255 0)
("chartreuse2" 118 238 0)
("chartreuse3" 102 205 0)
("chartreuse4" 69 139 0)
("olivedrab1" 192 255 62)
("olivedrab2" 179 238 58)
("olivedrab3" 154 205 50)
("olivedrab4" 105 139 34)
("darkolivegreen1" 202 255 112)
("darkolivegreen2" 188 238 104)
("darkolivegreen3" 162 205 90)
("darkolivegreen4" 110 139 61)
("khaki1" 255 246 143)
("khaki2" 238 230 133)
("khaki3" 205 198 115)
("khaki4" 139 134 78)
("lightgoldenrod1" 255 236 139)
("lightgoldenrod2" 238 220 130)
("lightgoldenrod3" 205 190 112)
("lightgoldenrod4" 139 129 76)
("lightyellow1" 255 255 224)
("lightyellow2" 238 238 209)
("lightyellow3" 205 205 180)
("lightyellow4" 139 139 122)
("yellow1" 255 255 0)
("yellow2" 238 238 0)
("yellow3" 205 205 0)
("yellow4" 139 139 0)
("gold1" 255 215 0)
("gold2" 238 201 0)
("gold3" 205 173 0)
("gold4" 139 117 0)
("goldenrod1" 255 193 37)
("goldenrod2" 238 180 34)
("goldenrod3" 205 155 29)
("goldenrod4" 139 105 20)
("darkgoldenrod1" 255 185 15)
("darkgoldenrod2" 238 173 14)
("darkgoldenrod3" 205 149 12)
("darkgoldenrod4" 139 101 8)
("rosybrown1" 255 193 193)
("rosybrown2" 238 180 180)
("rosybrown3" 205 155 155)
("rosybrown4" 139 105 105)
("indianred1" 255 106 106)
("indianred2" 238 99 99)
("indianred3" 205 85 85)
("indianred4" 139 58 58)
("sienna1" 255 130 71)
("sienna2" 238 121 66)
("sienna3" 205 104 57)
("sienna4" 139 71 38)
("burlywood1" 255 211 155)
("burlywood2" 238 197 145)
("burlywood3" 205 170 125)
("burlywood4" 139 115 85)
("wheat1" 255 231 186)
("wheat2" 238 216 174)
("wheat3" 205 186 150)
("wheat4" 139 126 102)
("tan1" 255 165 79)
("tan2" 238 154 73)
("tan3" 205 133 63)
("tan4" 139 90 43)
("chocolate1" 255 127 36)
("chocolate2" 238 118 33)
("chocolate3" 205 102 29)
("chocolate4" 139 69 19)
("firebrick1" 255 48 48)
("firebrick2" 238 44 44)
("firebrick3" 205 38 38)
("firebrick4" 139 26 26)
("brown1" 255 64 64)
("brown2" 238 59 59)
("brown3" 205 51 51)
("brown4" 139 35 35)
("salmon1" 255 140 105)
("salmon2" 238 130 98)
("salmon3" 205 112 84)
("salmon4" 139 76 57)
("lightsalmon1" 255 160 122)
("lightsalmon2" 238 149 114)
("lightsalmon3" 205 129 98)
("lightsalmon4" 139 87 66)
("orange1" 255 165 0)
("orange2" 238 154 0)
("orange3" 205 133 0)
("orange4" 139 90 0)
("darkorange1" 255 127 0)
("darkorange2" 238 118 0)
("darkorange3" 205 102 0)
("darkorange4" 139 69 0)
("coral1" 255 114 86)
("coral2" 238 106 80)
("coral3" 205 91 69)
("coral4" 139 62 47)
("tomato1" 255 99 71)
("tomato2" 238 92 66)
("tomato3" 205 79 57)
("tomato4" 139 54 38)
("orangered1" 255 69 0)
("orangered2" 238 64 0)
("orangered3" 205 55 0)
("orangered4" 139 37 0)
("red1" 255 0 0)
("red2" 238 0 0)
("red3" 205 0 0)
("red4" 139 0 0)
("deeppink1" 255 20 147)
("deeppink2" 238 18 137)
("deeppink3" 205 16 118)
("deeppink4" 139 10 80)
("hotpink1" 255 110 180)
("hotpink2" 238 106 167)
("hotpink3" 205 96 144)
("hotpink4" 139 58 98)
("pink1" 255 181 197)
("pink2" 238 169 184)
("pink3" 205 145 158)
("pink4" 139 99 108)
("lightpink1" 255 174 185)
("lightpink2" 238 162 173)
("lightpink3" 205 140 149)
("lightpink4" 139 95 101)
("palevioletred1" 255 130 171)
("palevioletred2" 238 121 159)
("palevioletred3" 205 104 137)
("palevioletred4" 139 71 93)
("maroon1" 255 52 179)
("maroon2" 238 48 167)
("maroon3" 205 41 144)
("maroon4" 139 28 98)
("violetred1" 255 62 150)
("violetred2" 238 58 140)
("violetred3" 205 50 120)
("violetred4" 139 34 82)
("magenta1" 255 0 255)
("magenta2" 238 0 238)
("magenta3" 205 0 205)
("magenta4" 139 0 139)
("orchid1" 255 131 250)
("orchid2" 238 122 233)
("orchid3" 205 105 201)
("orchid4" 139 71 137)
("plum1" 255 187 255)
("plum2" 238 174 238)
("plum3" 205 150 205)
("plum4" 139 102 139)
("mediumorchid1" 224 102 255)
("mediumorchid2" 209 95 238)
("mediumorchid3" 180 82 205)
("mediumorchid4" 122 55 139)
("darkorchid1" 191 62 255)
("darkorchid2" 178 58 238)
("darkorchid3" 154 50 205)
("darkorchid4" 104 34 139)
("purple1" 155 48 255)
("purple2" 145 44 238)
("purple3" 125 38 205)
("purple4" 85 26 139)
("mediumpurple1" 171 130 255)
("mediumpurple2" 159 121 238)
("mediumpurple3" 137 104 205)
("mediumpurple4" 93 71 139)
("thistle1" 255 225 255)
("thistle2" 238 210 238)
("thistle3" 205 181 205)
("thistle4" 139 123 139)
("gray0" 0 0 0)
("grey0" 0 0 0)
("gray1" 3 3 3)
("grey1" 3 3 3)
("gray2" 5 5 5)
("grey2" 5 5 5)
("gray3" 8 8 8)
("grey3" 8 8 8)
("gray4" 10 10 10)
("grey4" 10 10 10)
("gray5" 13 13 13)
("grey5" 13 13 13)
("gray6" 15 15 15)
("grey6" 15 15 15)
("gray7" 18 18 18)
("grey7" 18 18 18)
("gray8" 20 20 20)
("grey8" 20 20 20)
("gray9" 23 23 23)
("grey9" 23 23 23)
("gray10" 26 26 26)
("grey10" 26 26 26)
("gray11" 28 28 28)
("grey11" 28 28 28)
("gray12" 31 31 31)
("grey12" 31 31 31)
("gray13" 33 33 33)
("grey13" 33 33 33)
("gray14" 36 36 36)
("grey14" 36 36 36)
("gray15" 38 38 38)
("grey15" 38 38 38)
("gray16" 41 41 41)
("grey16" 41 41 41)
("gray17" 43 43 43)
("grey17" 43 43 43)
("gray18" 46 46 46)
("grey18" 46 46 46)
("gray19" 48 48 48)
("grey19" 48 48 48)
("gray20" 51 51 51)
("grey20" 51 51 51)
("gray21" 54 54 54)
("grey21" 54 54 54)
("gray22" 56 56 56)
("grey22" 56 56 56)
("gray23" 59 59 59)
("grey23" 59 59 59)
("gray24" 61 61 61)
("grey24" 61 61 61)
("gray25" 64 64 64)
("grey25" 64 64 64)
("gray26" 66 66 66)
("grey26" 66 66 66)
("gray27" 69 69 69)
("grey27" 69 69 69)
("gray28" 71 71 71)
("grey28" 71 71 71)
("gray29" 74 74 74)
("grey29" 74 74 74)
("gray30" 77 77 77)
("grey30" 77 77 77)
("gray31" 79 79 79)
("grey31" 79 79 79)
("gray32" 82 82 82)
("grey32" 82 82 82)
("gray33" 84 84 84)
("grey33" 84 84 84)
("gray34" 87 87 87)
("grey34" 87 87 87)
("gray35" 89 89 89)
("grey35" 89 89 89)
("gray36" 92 92 92)
("grey36" 92 92 92)
("gray37" 94 94 94)
("grey37" 94 94 94)
("gray38" 97 97 97)
("grey38" 97 97 97)
("gray39" 99 99 99)
("grey39" 99 99 99)
("gray40" 102 102 102)
("grey40" 102 102 102)
("gray41" 105 105 105)
("grey41" 105 105 105)
("gray42" 107 107 107)
("grey42" 107 107 107)
("gray43" 110 110 110)
("grey43" 110 110 110)
("gray44" 112 112 112)
("grey44" 112 112 112)
("gray45" 115 115 115)
("grey45" 115 115 115)
("gray46" 117 117 117)
("grey46" 117 117 117)
("gray47" 120 120 120)
("grey47" 120 120 120)
("gray48" 122 122 122)
("grey48" 122 122 122)
("gray49" 125 125 125)
("grey49" 125 125 125)
("gray50" 127 127 127)
("grey50" 127 127 127)
("gray51" 130 130 130)
("grey51" 130 130 130)
("gray52" 133 133 133)
("grey52" 133 133 133)
("gray53" 135 135 135)
("grey53" 135 135 135)
("gray54" 138 138 138)
("grey54" 138 138 138)
("gray55" 140 140 140)
("grey55" 140 140 140)
("gray56" 143 143 143)
("grey56" 143 143 143)
("gray57" 145 145 145)
("grey57" 145 145 145)
("gray58" 148 148 148)
("grey58" 148 148 148)
("gray59" 150 150 150)
("grey59" 150 150 150)
("gray60" 153 153 153)
("grey60" 153 153 153)
("gray61" 156 156 156)
("grey61" 156 156 156)
("gray62" 158 158 158)
("grey62" 158 158 158)
("gray63" 161 161 161)
("grey63" 161 161 161)
("gray64" 163 163 163)
("grey64" 163 163 163)
("gray65" 166 166 166)
("grey65" 166 166 166)
("gray66" 168 168 168)
("grey66" 168 168 168)
("gray67" 171 171 171)
("grey67" 171 171 171)
("gray68" 173 173 173)
("grey68" 173 173 173)
("gray69" 176 176 176)
("grey69" 176 176 176)
("gray70" 179 179 179)
("grey70" 179 179 179)
("gray71" 181 181 181)
("grey71" 181 181 181)
("gray72" 184 184 184)
("grey72" 184 184 184)
("gray73" 186 186 186)
("grey73" 186 186 186)
("gray74" 189 189 189)
("grey74" 189 189 189)
("gray75" 191 191 191)
("grey75" 191 191 191)
("gray76" 194 194 194)
("grey76" 194 194 194)
("gray77" 196 196 196)
("grey77" 196 196 196)
("gray78" 199 199 199)
("grey78" 199 199 199)
("gray79" 201 201 201)
("grey79" 201 201 201)
("gray80" 204 204 204)
("grey80" 204 204 204)
("gray81" 207 207 207)
("grey81" 207 207 207)
("gray82" 209 209 209)
("grey82" 209 209 209)
("gray83" 212 212 212)
("grey83" 212 212 212)
("gray84" 214 214 214)
("grey84" 214 214 214)
("gray85" 217 217 217)
("grey85" 217 217 217)
("gray86" 219 219 219)
("grey86" 219 219 219)
("gray87" 222 222 222)
("grey87" 222 222 222)
("gray88" 224 224 224)
("grey88" 224 224 224)
("gray89" 227 227 227)
("grey89" 227 227 227)
("gray90" 229 229 229)
("grey90" 229 229 229)
("gray91" 232 232 232)
("grey91" 232 232 232)
("gray92" 235 235 235)
("grey92" 235 235 235)
("gray93" 237 237 237)
("grey93" 237 237 237)
("gray94" 240 240 240)
("grey94" 240 240 240)
("gray95" 242 242 242)
("grey95" 242 242 242)
("gray96" 245 245 245)
("grey96" 245 245 245)
("gray97" 247 247 247)
("grey97" 247 247 247)
("gray98" 250 250 250)
("grey98" 250 250 250)
("gray99" 252 252 252)
("grey99" 252 252 252)
("gray100" 255 255 255)
("grey100" 255 255 255)
("darkgrey" 169 169 169)
("darkgray" 169 169 169)
("darkblue" 0 0 139)
("darkcyan" 0 139 139)
("darkmagenta" 139 0 139)
("darkred" 139 0 0)
("lightgreen" 144 238 144))
"An alist of X color names and associated 8-bit RGB values.")
(defvar tty-standard-colors
'(("white" 7 65535 65535 65535)
("cyan" 6 0 65535 65535)
("magenta" 5 65535 0 65535)
("blue" 4 0 0 65535)
("yellow" 3 65535 65535 0)
("green" 2 0 65535 0)
("red" 1 65535 0 0)
("black" 0 0 0 0))
"An alist of 8 standard tty colors, their indices and RGB values.")
(defvar tty-color-alist nil
"An alist of colors supported by the terminal.
Each element is of the form:
\(NAME INDEX R G B\)
where NAME is the name of the color, a string;
INDEX is the index of this color to be sent to the terminal driver
when the color should be displayed; it is typically a small integer;
R, G, and B are the intensities of, accordingly, red, green, and blue
components of the color, represented as numbers between 0 and 65535.
The file `etc/rgb.txt' in the Emacs distribution lists the standard
RGB values of the X colors. If RGB is nil, this color will not be
considered by `tty-color-translate' as an approximation to another
color.")
(defun tty-color-canonicalize (color)
"Return COLOR in canonical form.
A canonicalized color name is all-lower case, with any blanks removed."
(let ((color (downcase color)))
(while (string-match " +" color)
(setq color (replace-match "" nil nil color)))
color))
(defun tty-color-define (name index &optional rgb)
"Specify a tty color by its NAME, terminal INDEX and RGB values.
NAME is a string, INDEX is typically a small integer used to send to
the terminal driver to switch on this color, and RGB is a list of 3
numbers that specify the intensity of red, green, and blue components
of the color.
If specified, each one of the RGB components must be a number between
0 and 65535. If RGB is omitted, the specified color will never be used
by `tty-color-translate' as an approximation to another color."
(if (or (not (stringp name))
(not (integerp index))
(and rgb (or (not (listp rgb)) (/= (length rgb) 3))))
(error "Invalid specification for tty color \"%s\"" name))
(let* ((name (tty-color-canonicalize name))
(entry (assoc name tty-color-alist)))
(if entry
(setcdr entry (cons index rgb))
(setq tty-color-alist
(cons (append (list name index) rgb) tty-color-alist)))
tty-color-alist))
(defun tty-color-clear ()
"Clear the list of supported tty colors."
(setq tty-color-alist nil))
(defun tty-color-off-gray-diag (r g b)
"Compute the angle between the color given by R,G,B and the gray diagonal."
(let ((mag (sqrt (* 3 (+ (* r r) (* g g) (* b b))))))
(if (< mag 1) 0 (acos (/ (+ r g b) mag)))))
(defun tty-color-approximate (rgb)
"Given a list of 3 rgb values in RGB, find the color in `tty-color-alist'
which is the best approximation in the 3-dimensional RGB space,
and return the index associated with the approximating color.
Each value of the RGB triplet has to be scaled to the 0..255 range."
(let* ((color-list tty-color-alist)
(candidate (car color-list))
(best-distance 195076) ;; 3 * 255^2 + 15
best-color)
(while candidate
(let* ((try-rgb (cddr candidate))
(r (car rgb))
(g (cadr rgb))
(b (nth 2 rgb))
;; If the approximated color is not close enough to the
;; gray diagonal of the RGB cube, favor non-gray colors.
;; (The number 0.065 is an empirical ad-hoc'ery.)
(favor-non-gray (>= (tty-color-off-gray-diag r g b) 0.065))
try-r try-g try-b
dif-r dif-g dif-b dist)
;; If the RGB values of the candidate color are unknown, we
;; never consider it for approximating another color.
(if try-rgb
(progn
(setq try-r (lsh (car try-rgb) -8)
try-g (lsh (cadr try-rgb) -8)
try-b (lsh (nth 2 try-rgb) -8))
(setq dif-r (- (car rgb) try-r)
dif-g (- (cadr rgb) try-g)
dif-b (- (nth 2 rgb) try-b))
(setq dist (+ (* dif-r dif-r) (* dif-g dif-g) (* dif-b dif-b)))
(if (and (< dist best-distance)
;; The candidate color is on the gray diagonal
;; if its RGB components are all equal.
(or (/= try-r try-g) (/= try-g try-b)
(not favor-non-gray)))
(setq best-distance dist
best-color candidate)))))
(setq color-list (cdr color-list))
(setq candidate (car color-list)))
(cadr best-color)))
(defun tty-color-translate (color)
"Given a color COLOR, return the index of the corresponding TTY color.
COLOR must be a string that is either the color's name, or its X-style
specification like \"#RRGGBB\" or \"RGB:rr/gg/bb\", where each primary.
color can be given with 1 to 4 hex digits.
If COLOR is a color name that is found among supported colors in
`tty-color-alist', the associated index is returned. Otherwise, the
RGB values of the color, either as given by the argument or from
looking up the name in `color-name-rgb-alist', are used to find the
supported color that is the best approximation for COLOR in the RGB
space.
If COLOR is neither a valid X RGB specification of the color, nor a
name of a color in `color-name-rgb-alist', the returned value is nil."
(and (stringp color)
(let* ((color (tty-color-canonicalize color))
(idx (cadr (assoc color tty-color-alist))))
(or idx
(let* ((len (length color))
(maxval 256)
(rgb
(cond
((and (>= len 4) ;; X-style "#XXYYZZ" color spec
(eq (aref color 0) ?#)
(member (aref color 1)
'(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9
?a ?b ?c ?d ?e ?f)))
;; Translate the string "#XXYYZZ" into a list
;; of numbers (XX YY ZZ). If the primary colors
;; are specified with less than 4 hex digits,
;; the used digits represent the most significant
;; bits of the value (e.g. #XYZ = #X000Y000Z000).
(let* ((ndig (/ (- len 1) 3))
(i1 1)
(i2 (+ i1 ndig))
(i3 (+ i2 ndig)))
(list
(lsh
(string-to-number (substring color i1 i2) 16)
(* 4 (- 2 ndig)))
(lsh
(string-to-number (substring color i2 i3) 16)
(* 4 (- 2 ndig)))
(lsh
(string-to-number (substring color i3) 16)
(* 4 (- 2 ndig))))))
((and (>= len 9) ;; X-style RGB:xx/yy/zz color spec
(string= (substring color 0 4) "rgb:"))
;; Translate the string "RGB:XX/YY/ZZ" into a list
;; of numbers (XX YY ZZ). If fewer than 4 hex
;; digits are used, they represent the fraction
;; of the maximum value (RGB:X/Y/Z = #XXXXYYYYZZZZ).
(let* ((ndig (/ (- len 3) 3))
(maxval (1- (expt 16 (- ndig 1))))
(i1 4)
(i2 (+ i1 ndig))
(i3 (+ i2 ndig)))
(list
(/ (* (string-to-number
(substring color i1 (- i2 1)) 16)
255)
maxval)
(/ (* (string-to-number
(substring color i2 (- i3 1)) 16)
255)
maxval)
(/ (* (string-to-number
(substring color i3) 16)
255)
maxval))))
(t
(cdr (assoc color color-name-rgb-alist))))))
(and rgb (tty-color-approximate rgb)))))))
(defun tty-color-by-index (idx)
"Given a numeric index of a tty color, return its description.
Value is a list of the form \(NAME INDEX R G B\)."
(and idx
(let ((colors tty-color-alist)
desc found)
(while colors
(setq desc (car colors))
(if (eq idx (car (cdr desc)))
(setq found desc))
(setq colors (cdr colors)))
found)))
(defun tty-color-values (color &optional frame)
"Return RGB values of the color COLOR on a termcap frame FRAME.
If COLOR is not directly supported by the display, return the RGB
values for a supported color that is its best approximation.
The value is a list of integer RGB values--\(RED GREEN BLUE\).
These values range from 0 to 65535; white is (65535 65535 65535).
If FRAME is omitted or nil, use the selected frame."
(let* ((frame (or frame (selected-frame)))
(color (tty-color-canonicalize color))
(supported (assoc color tty-color-alist)))
(or (and supported (cddr supported)) ; full spec in tty-color-alist
(and supported ; no RGB values in tty-color-alist: use X RGB values
(assoc color color-name-rgb-alist)
(cddr
(tty-color-by-index
(tty-color-approximate
(cdr (assoc color color-name-rgb-alist))))))
(cddr (tty-color-by-index (tty-color-translate color))))))
(defun tty-color-desc (color)
"Return the description of the color COLOR for a character terminal.
Value is a list of the form \(NAME INDEX R G B\). Note that the returned
NAME is not necessarily the same string as the argument COLOR, because
the latter might need to be approximated if it is not supported directly."
(let ((idx (tty-color-translate color)))
(tty-color-by-index idx)))

6
lisp/term/w32-win.el
View file

@ -517,10 +517,8 @@ This returns ARGS with the arguments that have been processed removed."
"GreenYellow")
"The full list of X colors from the `rgb.text' file.")
(defun x-defined-colors (&optional frame)
"Return a list of colors supported for a particular frame.
The argument FRAME specifies which frame to try.
The value may be different for frames on different X displays."
(defun xw-defined-colors (&optional frame)
"Internal function called by `defined-colors', which see."
(or frame (setq frame (selected-frame)))
(let* ((color-map-colors (mapcar (lambda (clr) (car clr)) w32-color-map))
(all-colors (or color-map-colors x-colors))

6
lisp/term/x-win.el
View file

@ -428,10 +428,8 @@ This function returns ARGS minus the arguments that have been processed."
"GreenYellow")
"The list of X colors from the `rgb.txt' file.")
(defun x-defined-colors (&optional frame)
"Return a list of colors supported for a particular frame.
The argument FRAME specifies which frame to try.
The value may be different for frames on different X displays."
(defun xw-defined-colors (&optional frame)
"Internal function called by `defined-colors', which see."
(or frame (setq frame (selected-frame)))
(let ((all-colors x-colors)
(this-color nil)