;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001
;;        David J. Biesack

;; This file is not 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:


;; colorsel.el -- Interactive X color selection
;;
;; shamelessly derived from fontsel.el, which was written
;; by ar@mcdd1.uucp@uknet (Alastair Rae)
;;
;; This is a simple mode to allow you to see what colors look good
;; in emacs.  It could probably do more but I didn't think the time
;; & effort would be worth it.
;;
;; A good extension would be to be able to pop your original color
;; but I couldn't figure out a way to get its name. Any ideas?

;; Author: David Biesack (David.Biesack@sas.com  or biesack@mindspring.com)
;; Last Modified By: biesack@mindspring.com
;; Last Modified: Thu Mar 15 17:42:10 2001

(defun color-select () (interactive)
  (let ((buf (get-buffer-create "*color selection*")))
    (switch-to-buffer-other-window buf)
    (color-select-reload buf)
    (color-select-mode)))

(defun color-select-mode ()
"
Display and set X colors

b, space, RETURN	set background color based on current line
f       set foreground color based on current line
s       save current fore/background color for use with \\[color-reset]
r       reload initial or last saved for/background color set
R	reload list of colors
t	toggle the background and foreground colors
c	copy color on current line to selections buffer
?	describe mode
"
  (kill-all-local-variables)
  (setq color-select-mode-map (make-sparse-keymap))

  (define-key color-select-mode-map "s" 'color-save)
  (define-key color-select-mode-map " " 'color-select-exec)
  (define-key color-select-mode-map "\r" 'color-select-exec)
  (define-key color-select-mode-map "b" 'color-select-exec)
  (define-key color-select-mode-map "f" 'color-select-exec-foreground)
  (define-key color-select-mode-map "R" 'color-select-reload)
  (define-key color-select-mode-map "r" 'color-reset)
  (define-key color-select-mode-map "c" 'color-select-copy)
  (if (boundp 'epoch::version)
      (define-key color-select-mode-map "t" (function (lambda ()
                                                        (interactive)
                                                        (let ((fg (foreground))
                                                              (bg (background)))
                                                          (foreground bg)
                                                          (background fg)
                                                          (redraw-display)))))
      (define-key color-select-mode-map "t" 'x-flip-color))
  (define-key color-select-mode-map "?" 'describe-mode)

  (use-local-map color-select-mode-map)
  (setq major-mode 'color-select-mode)
  (setq mode-name "color Select"))

(defvar *colorsel-rgb-list* nil)

(defun color-select-exec ()
  "set color on current line" (interactive)
  (let* ((color (color-select-get-color)))
    (describe-color color)
    (cond ((boundp 'epoch::version)
           (epoch::background color))
          ((fboundp 'set-background-color)
           (set-background-color color))
          (t
           (x-set-background-color color)))
    (redraw-display)))

(defun describe-color (color)
  (let ((red   (nth 0 *colorsel-rgb-list*))
        (green (nth 1 *colorsel-rgb-list*))
        (blue  (nth 2 *colorsel-rgb-list*)))
    (message "%3d %3d %3d  ==  #%02x%02x%02x  ==  \"%s\" "
             red green blue
             red green blue
             color)))

(defun color-select-exec-foreground ()
  "set color on current line" (interactive)
  (let* ((color (color-select-get-color)))
    (describe-color color)
    (cond ((boundp 'epoch::version)
           (epoch::foreground color))
          ((fboundp 'set-foreground-color)
           (set-foreground-color color))
          (t
           (x-set-foreground-color color)))
    (redraw-display)))

(defun color-select-get-color ()
  "get name of color on current line"
  (beginning-of-line)
  (let* ((push (point))
         (red (read (current-buffer)))
         (green (read (current-buffer)))
         (blue (read (current-buffer)))
	 (beg (progn
                (forward-word 1)
                (backward-word 1)
		(point)))
	 (end (progn
		(end-of-line)
		(point)))
	 (color (buffer-substring beg end)))
    (setq *colorsel-rgb-list* (list red green blue))
    (goto-char push)
    color))

(defvar *x-rgb-file* "/usr/lib/X11/rgb.txt"
  "*Pathname of the X11 rgb.txt file listing RGB values of named colors")

(defvar *original-fg* (and (boundp 'epoch::version) (foreground)))
(defvar *original-bg* (and (boundp 'epoch::version) (background)))

(defun color-select-reload (&optional buf)
  "reload list of colors" (interactive)
  (if (not (null buf)) (set-buffer buf))
  (erase-buffer)
  (insert-file *x-rgb-file*)
  (not-modified)
  (goto-char (point-min))
)

(defun color-reset (&optional save)
  "Reset fore/background colors to their initial state,
or to the colors saved when \\[color-save] was last issued."
  (interactive)
  (cond ((boundp 'epoch::version)
         (epoch::foreground *original-fg*)
         (epoch::background *original-bg*))
        (t
         (error "Sorry, Emacs can't remember your previous color settings.")
         ))
  (redraw-display))

(defun color-save ()
  "Save current for/background color set for use with \\[color-reset]."
  (interactive)
  (setq *original-fg* (foreground) *original-bg* (background)))

(defun color-select-copy ()
  "copy color on current line to selections buffer" (interactive)
  (let ((push (get-buffer-window (current-buffer)))
	(buf (get-buffer-create "*Selected Colors*"))
	(color (color-select-get-color)))
    (if (not (windowp (get-buffer-window buf)))
	(switch-to-buffer-other-window buf))
    (set-buffer buf)
    (goto-char (point-max))
    (insert color)
    (insert "\n")
    (select-window push)))

(fset 'colorsel 'color-select)