tty-colors.el

windows版本的emacs

    ("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) ; no "lightmagenta", see the comment above
    ("darkmagenta"	139 0 139)
    ("darkred"		139 0 0)  ; but no "lightred", see the comment above
    ("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-defined-color-alist nil
  "An alist of defined terminal colors and their RGB values.

See the docstring of `tty-color-alist' for the details.")

(defun tty-color-alist (&optional frame)
  "Return an alist of colors supported by FRAME's terminal.
FRAME defaults to the selected frame.
Each element of the returned alist 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."
  tty-defined-color-alist)

(defun tty-modify-color-alist (elt &optional frame)
  "Put the association ELT int the alist of terminal colors for FRAME.
ELT should be of the form  \(NAME INDEX R G B\) (see `tty-color-alist'
for details).
If FRAME is unspecified or nil, it defaults to the selected frame.
Value is the modified color alist for FRAME."
  (let* ((entry (assoc (car elt) (tty-color-alist frame))))
    (if entry
	(setcdr entry (cdr elt))
      (setq tty-defined-color-alist (cons elt tty-defined-color-alist)))
    tty-defined-color-alist))

(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 frame)
  "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 a command to switch this color on, 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.
FRAME is the frame where the defined color should be used.
If FRAME is not specified or is nil, it defaults to the selected frame."
  (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))
  (tty-modify-color-alist
   (append (list (tty-color-canonicalize name) index) rgb) frame))

(defun tty-color-clear (&optional frame)
  "Clear the list of supported tty colors for frame FRAME.
If FRAME is unspecified or nil, it defaults to the selected frame."
  (setq tty-defined-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.
The gray diagonal is the diagonal of the 3D cube in RGB space which
connects the points corresponding to the black and white colors.  All the
colors whose RGB coordinates belong to this diagonal are various shades
of gray, thus the name."
  (let ((mag (sqrt (* 3 (+ (* r r) (* g g) (* b b))))))
    (if (< mag 1) 0 (acos (/ (+ r g b) mag)))))

(defun tty-color-approximate (rgb &optional frame)
  "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.
FRAME defaults to the selected frame."
  (let* ((color-list (tty-color-alist frame))
	 (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 &optional frame)
  "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.

If FRAME is unspecified or nil, it defaults to the selected frame."
  (and (stringp color)
       (let* ((color (tty-color-canonicalize color))
	      (idx (cadr (assoc color (tty-color-alist frame)))))
	 (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 frame)))))))

(defun tty-color-by-index (idx &optional frame)
  "Given a numeric index of a tty color, return its description.

FRAME, if unspecified or nil, defaults to the selected frame.
Value is a list of the form \(NAME INDEX R G B\)."
  (and idx
       (let ((colors (tty-color-alist frame))
	     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 frame))))
    (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)) frame) frame)))
	(cddr (tty-color-by-index (tty-color-translate color frame) frame)))))

(defun tty-color-desc (color &optional frame)
  "Return the description of the color COLOR for a character terminal.

FRAME, if unspecified or nil, defaults to the selected frame.
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 frame)))
    (tty-color-by-index idx frame)))

(defun tty-color-gray-shades (&optional display)
  "Return the number of gray colors supported by DISPLAY's terminal.
A color is considered gray if the 3 components of its RGB value are equal."
  (let* ((frame (if (framep display) display
		  ;; FIXME: this uses an arbitrary frame from DISPLAY!
		  (car (frames-on-display-list display))))
	 (colors (tty-color-alist frame))
	 (count 0)
	 desc r g b)
    (while colors
      (setq desc (cddr (car colors))
	    r (car desc)
	    g (cadr desc)
	    b (car (cddr desc)))
      (and (numberp r)
	   (eq r g) (eq g b)
	   (setq count (1+ count)))
      (setq colors (cdr colors)))
    count))

;;; tty-colors.el ends here