Function: list-colors-print

list-colors-print is a byte-compiled function defined in facemenu.el.gz.

Signature

(list-colors-print LIST &optional CALLBACK)

Source Code

;; Defined in /usr/src/emacs/lisp/facemenu.el.gz
(defun list-colors-print (list &optional callback)
  (let ((callback-fn
         ;; Expect CALLBACK to be a function, but allow it to be a form that
         ;; evaluates to a function, for backward-compatibility.  (Bug#45831)
         (cond ((functionp callback)
                (lambda (button)
                  (funcall callback (button-get button 'color-name))))
               (callback
                `(lambda (button)
                  (funcall ,callback (button-get button 'color-name)))))))
    (dolist (color list)
      (if (consp color)
	  (if (cdr color)
	      (setq color (sort color (lambda (a b)
					(string< (downcase a)
						 (downcase b))))))
	(setq color (list color)))
      (let* ((opoint (point))
             (fg (readable-foreground-color (car color))))
	(insert (car color))
	(indent-to 22)
	(put-text-property opoint (point) 'face `(:background ,(car color)
                                                  :foreground ,fg))
	(put-text-property
	 (prog1 (point)
	   (insert " ")
	   ;; Insert all color names.
	   (insert (mapconcat 'identity color ",")))
	 (point)
	 'face (list :foreground (car color)))
	(insert (propertize " " 'display '(space :align-to (- right 9))))
	(insert " ")
	(insert (propertize
		 (apply 'format "#%02x%02x%02x"
			(mapcar (lambda (c) (ash c -8))
				(color-values (car color))))
		 'mouse-face 'highlight
		 'help-echo
		 (let ((hsv (apply 'color-rgb-to-hsv
				   (color-name-to-rgb (car color)))))
		   (format "H:%.2f S:%.2f V:%.2f"
			   (nth 0 hsv) (nth 1 hsv) (nth 2 hsv)))))
	(when callback
	  (make-text-button
	   opoint (point)
	   'follow-link t
	   'mouse-face (list :background (car color)
			     :foreground fg)
	   'color-name (car color)
	   'action callback-fn)))
      (insert "\n"))
    (goto-char (point-min))))