Download
(eval-when-compile (require 'cl))
(require 'hexrgb)
(defgroup Color-Palette nil
"A color palette: 1) hue x saturation palette and 2) brightness scale."
:prefix "palette-" :group 'doremi :group 'frames :group 'faces
:link `(url-link :tag "Send Bug Report"
,(concat "mailto:" "drew.adams" "@" "oracle" ".com?subject=\
palette.el bug: \
&body=Describe bug here, starting with `emacs -q'. \
Don't forget to mention your Emacs and library versions."))
:link '(url-link :tag "Other Libraries by Drew"
"http://www.emacswiki.org/cgi-bin/wiki/DrewsElispLibraries")
:link '(url-link :tag "Download"
"http://www.emacswiki.org/cgi-bin/wiki/palette.el")
:link '(url-link :tag "Description"
"http://www.emacswiki.org/cgi-bin/wiki/ColorPalette")
:link '(emacs-commentary-link :tag "Commentary" "palette"))
(defcustom palette-update-cursor-color-flag nil
"*Non-nil means dynamically update the cursor to make it stand out.
This can cause redisplay of the palette frame, which means a slowdown."
:type 'boolean :group 'Color-Palette :group 'doremi)
(defcustom palette-verbose-flag nil
"*Non-nil means display color info often.
Otherwise, display it only on demand.
Non-nil slows things down to recalculate color components often."
:type 'boolean :group 'Color-Palette :group 'doremi)
(defcustom palette-hex-rgb-digits 4
"*Number of hex RGB digits to use in output (messages, return values).
This is the number for each component (red, green, blue).
Must be a number from 1 to 4. This value is only for output.
\(Internally, 4 is used for calculation.)"
:type '(choice (const 1) (const 2) (const 3) (const 4)) :group 'Color-Palette)
(defcustom palette-message-info 'all
"*Type of information to print in a palette message.
Possible values are:
all - RGB hex, RGB decimal, and HSV decimal information
hex - RGB hex information
hsv - HSV decimal information
rgb - RGB decimal information
hex+hsv - RGB hex and HSV decimal information
hex+rgb - RGB hex and RGB decimal information
rgb+hsv - RGB decimal and HSV decimal information
RGB hex here means either the color name or an RGB hex color string.
The latter uses `palette-hex-rgb-digits' hex digits for each
component."
:type '(choice
(const :tag "RGB hex, RGB decimal, and HSV decimal information" all)
(const :tag "RGB hex information" hex)
(const :tag "HSV decimal information" hsv)
(const :tag "RGB decimal information" rgb)
(const :tag "RGB hex and HSV decimal information" hex+hsv)
(const :tag "RGB hex and RGB decimal information" hex+rgb)
(const :tag "RGB decimal and HSV decimal information" rgb+hsv))
:group 'Color-Palette :group 'doremi)
(defcustom palette-font
(and window-system
(or (car (x-list-fonts "-*-Courier-*-*-*-*-5-*-*-*-*-*-iso8859-1" nil nil 1))
(car (x-list-fonts "-*-fixed-*-*-*-*-5-*-*-*-*-*-iso8859-1" nil nil 1))
(car (x-list-fonts "-*-Terminal-*-*-*-*-5-*-*-*-*-*-iso8859-1" nil nil 1))
(car (x-list-fonts "-*-*-*-*-*-*-5-*-*-*-*-*-iso8859-1" nil nil 1))))
"*Font to use for the color palette.
The only characters in the font that are used are the space character
and `e'. The only things that matter about the font are these:
- The smaller the font, the smaller the color palette. A size of 5
is good, producing a frame that is about 8cm x 13 cm inside.
- The squarer the font, the better, so that the palette is not
unnecessarily elongated. Short, fat fonts are good.
- A fixed font is good, so that the brightness-indicator line, which
is a string of `e' characters, appears the same width as the
Brightness palette.
NOTE: Do not try to use library `palette.el' without a window manager.
That is, do not try to use it with `emacs -nw'."
:type 'string :group 'Color-Palette :group 'doremi)
(defcustom palette-change-color-hook nil
"*Functions to run at the end of `palette-set-current-color'.
Typically, applications bind this hook to a function that does
something with the new value of `palette-current-color' after a color
change."
:type 'hook :group 'Color-Palette)
(defcustom palette-exit-hook nil
"*Functions to run at the end of `palette-exit'.
This is reset to nil after running.
These hook functions are run after `palette-quit' is run.
Typically, applications bind this hook to a function that does
something with `palette-current-color'. When the user exits the
palette (using `\\<palette-mode-map>\\[palette-exit]), the value of `palette-current-color' \
can be used
by this hook."
:type 'hook :group 'Color-Palette)
(defcustom palette-save-color-hook nil
"*Functions to run at the end of `palette-save-new-color'."
:type 'hook :group 'Color-Palette)
(defvar palette-action nil
"Function called on the current palette color, whenever it changes.")
(defvar palette-current-color "#000000000000"
"Current (new) color, as a hex RGB color string.
Use `\\<palette-mode-map>\\[palette-save-new-color]' to save it.")
(defvar palette-last-color "#000000000000"
"Current color before last command, as a hex RGB color string.
Use `\\<palette-mode-map>\\[palette-swap-last-color]' to make this the current color.")
(defvar palette-old-color "#000000000000"
"Saved color, as a hex RGB color string.
Use `\\<palette-mode-map>\\[palette-restore-old-color]' to make this the current color.")
(defvaralias 'eyedrop-picked-background 'palette-picked-background)
(defvar palette-picked-background nil
"Color last picked from a face or frame background.
A hex RGB color string.
You can use `palette-pick-background-at-point' or
`palette-pick-background-at-mouse' to pick the color.")
(defvaralias 'eyedrop-picked-foreground 'palette-picked-foreground)
(defvar palette-picked-foreground nil
"Color last picked from a face or frame foreground.
A hex RGB color string.
You can use `palette-pick-foreground-at-point' or
`palette-pick-foreground-at-mouse' to pick the color.")
(defvaralias 'eyedrop-last-picked-color 'palette-last-picked-color)
(defvar palette-last-picked-color nil
"Color last picked from a face or frame foreground or background.
A hex RGB color string.")
(defvar palette-saved-blink-cursor-mode nil
"Value of option `blink-cursor-mode' before `palette' is displayed.
Option `blink-cursor-mode' is restored (turned on or off) to reflect
this saved value when you exit or quit the palette.
The saved value is updated when `palette' is called and whenever the
user updates `blink-cursor-mode'.")
(defvar palette-popup-map nil "Keymap for `palette-mode' popup menu.")
(defvar palette-mode-map nil "Keymap for `palette-mode'.")
(unless palette-mode-map
(let ((map (make-sparse-keymap "Color Palette"))
(popup-map (make-sparse-keymap "Color Palette Menu")))
(define-key map [down-mouse-1] 'ignore)
(define-key map [drag-mouse-1] 'ignore)
(define-key map [mouse-1] 'palette-background-at-mouse)
(define-key map [down-mouse-2] 'ignore)
(define-key map [drag-mouse-2] 'ignore)
(define-key map [mouse-2] 'palette-pick-background-at-mouse)
(define-key map [down-mouse-3] 'palette-popup-menu)
(define-key map [mouse-3] 'ignore)
(define-key map "?" 'palette-background-at-point)
(define-key map "." 'palette-current-color)
(define-key map "~" 'palette-pick-color-complement)
(define-key map "B" 'palette-increase-blue)
(define-key map "b" 'palette-decrease-blue)
(define-key map "c" 'palette-pick-color-by-name)
(define-key map "e" 'palette-toggle-cursor-color)
(define-key map "f" 'palette-toggle-verbose)
(define-key map "G" 'palette-increase-green)
(define-key map "g" 'palette-decrease-green)
(define-key map "H" 'palette-increase-hue)
(define-key map "h" 'palette-decrease-hue)
(define-key map "l" 'palette-swap-last-color)
(define-key map "n" 'palette-save-new-color)
(define-key map "o" 'palette-restore-old-color)
(define-key map "q" 'palette-quit)
(define-key map "R" 'palette-increase-red)
(define-key map "r" 'palette-decrease-red)
(define-key map "S" 'palette-increase-saturation)
(define-key map "s" 'palette-decrease-saturation)
(define-key map "u" 'palette-swap-last-color)
(define-key map "V" 'palette-increase-value)
(define-key map "v" 'palette-decrease-value)
(define-key map "w" 'palette-where-is-color)
(define-key map "x" 'palette-exit)
(define-key map "\C-hm" 'palette-help)
(define-key map "\C-l" 'palette-refresh)
(define-key map "\r" 'palette-pick-background-at-point)
(define-key map "\C-o" 'palette-restore-old-color)
(define-key map "\C-s" 'palette-save-new-color)
(define-key map "\M-c" 'palette-pick-color-by-name)
(define-key map "\M-h" 'palette-pick-color-by-hsv)
(define-key map "\M-r" 'palette-pick-color-by-rgb)
(define-key map "\M-w" 'palette-current-rgb-to-kill-ring)
(define-key map [(shift control f)] 'palette-right+pick)
(define-key map [(shift right)] 'palette-right+pick)
(define-key map [(shift control b)] 'palette-left+pick)
(define-key map [(shift left)] 'palette-left+pick)
(define-key map [(shift control n)] 'palette-down+pick)
(define-key map [(shift down)] 'palette-down+pick)
(define-key map [(shift control p)] 'palette-up+pick)
(define-key map [(shift up)] 'palette-up+pick)
(define-key popup-map [current-rgb-to-kill-ring]
'(menu-item "Copy Current Color as Kill" palette-current-rgb-to-kill-ring
:help "Copy color as RGB hex string, respecting `palette-hex-rgb-digits'"))
(define-key popup-map [current-color]
'(menu-item "Current Color Info" palette-current-color
:help "Return the current color and show info about it"))
(define-key popup-map [bg-at-point]
'(menu-item "Info at Cursor" palette-background-at-point
:help "Return the background color under the text cursor"))
(define-key popup-map [separator-1] '(menu-item "--"))
(define-key popup-map [pick-color-by-name]
`(menu-item "Choose Color By Name" palette-pick-color-by-name
:help "Set the current color to a color you name"))
(define-key popup-map [pick-color-by-hsv]
'(menu-item "Choose Color By HSV" palette-pick-color-by-hsv
:help "Set the current color by providing hue, saturation, and value"))
(define-key popup-map [pick-color-by-rgb]
'(menu-item "Choose Color By RGB" palette-pick-color-by-rgb
:help "Set the current color by providing red, green, and blue components"))
(define-key popup-map [separator-2] '(menu-item "--"))
(define-key popup-map [swap-last-color]
'(menu-item "Swap Last Color (Undo)" palette-swap-last-color
:help "Swap the last color and the current color"))
(define-key popup-map [save-new-color]
'(menu-item "Save Current Color" palette-save-new-color
:help "Save the current color as the old (original) color"))
(define-key popup-map [restore-old-color]
'(menu-item "Restore Old Color" palette-restore-old-color
:help "Restore the old (original) color as the current color"))
(define-key popup-map [separator-3] '(menu-item "--"))
(define-key popup-map [complement]
'(menu-item "Complement" palette-pick-color-complement
:help "Set the current color to its complement."))
(define-key popup-map [increase-red]
'(menu-item "Increase Red" palette-increase-red
:help "Increase the red component of the current color by ARG/100"))
(define-key popup-map [decrease-red]
'(menu-item " Decrease Red" palette-decrease-red
:help "Decrease the red component of the current color by ARG/100"))
(define-key popup-map [increase-green]
'(menu-item "Increase Green" palette-increase-green
:help "Increase the green component of the current color by ARG/100"))
(define-key popup-map [decrease-green]
'(menu-item " Decrease Green" palette-decrease-green
:help "Decrease the green component of the current color by ARG/100"))
(define-key popup-map [increase-blue]
'(menu-item "Increase Blue" palette-increase-blue
:help "Increase the blue component of the current color by ARG/100"))
(define-key popup-map [decrease-blue]
'(menu-item " Decrease Blue" palette-decrease-blue
:help "Decrease the blue component of the current color by ARG/100"))
(define-key popup-map [increase-hue]
'(menu-item "Increase Hue" palette-increase-hue
:help "Increase the hue component of the current color by ARG/100"))
(define-key popup-map [decrease-hue]
'(menu-item " Decrease Hue" palette-decrease-hue
:help "Decrease the hue component of the current color by ARG/100"))
(define-key popup-map [increase-saturation]
'(menu-item "Increase Saturation" palette-increase-saturation
:help "Increase the saturation component of the current color by ARG/100"))
(define-key popup-map [decrease-saturation]
'(menu-item " Decrease Saturation" palette-decrease-saturation
:help "Decrease the saturation component of the current color by ARG/100"))
(define-key popup-map [increase-value]
'(menu-item "Increase Value" palette-increase-value
:help "Increase the value component of the current color by ARG/100"))
(define-key popup-map [decrease-value]
'(menu-item " Decrease Value" palette-decrease-value
:help "Decrease the value component of the current color by ARG/100"))
(define-key popup-map [separator-4] '(menu-item "--"))
(define-key popup-map [toggle-verbose]
'(menu-item "Toggle Frequent Feedback" palette-toggle-verbose
:help "Toggle using frequent color info feedback (`palette-toggle-verbose-flag')"))
(define-key popup-map [toggle-cursor-color]
'(menu-item "Toggle Enhanced Cursor Color" palette-toggle-cursor-color
:help "Toggle updating the cursor color so the cursor stands out \
\(`palette-update-cursor-color-flag')"))
(define-key popup-map [refresh]
'(menu-item "Refresh" palette-refresh
:help "Refresh the color palette"))
(define-key popup-map [exit]
'(menu-item "Exit (Update Action)" palette-exit
:help "Exit the color palette with exit action, if defined."))
(define-key popup-map [quit]
'(menu-item "Quit (Cancel)" palette-quit
:help "Quit the color palette without any exit action."))
(setq palette-mode-map map
palette-popup-map popup-map)))
(substitute-key-definition 'forward-char 'palette-right palette-mode-map global-map)
(substitute-key-definition 'backward-char 'palette-left palette-mode-map global-map)
(substitute-key-definition 'next-line 'palette-down palette-mode-map global-map)
(substitute-key-definition 'previous-line 'palette-up palette-mode-map global-map)
(if (< emacs-major-version 22)
(define-derived-mode palette-mode fundamental-mode "Color Palette"
"Major mode for using the color palette.
Turning on this mode runs the normal hook `palette-mode-hook'.
Use command `palette' to display a color palette in Color Palette
mode (`palette-mode'). This has three sub-palettes (from left to
right):
- a hue x saturation palette - buffer Palette (Hue x Saturation)
Hue is horizontal; saturation is vertical. Hue is the tint of a
color, independent of its brightness and grayness. Saturation is
the purity of a color (opposite of grayness).
- a color-swatch palette - buffer Current/Original
- a value (brightness) palette - buffer Brightness
The color-swatch palette shows the current color and the original
color or the last color saved. Saving is not persistent.
In the color palette:
- `mouse-1' or `?' anywhere shows info about a color
- `mouse-2' or `RET' anywhere picks a color as the current color
- Cursor motion is along the grid of colors, with wrapping.
Shifted cursor motion updates the current color as you move.
- `n', `C-s' saves the current color
- `o', `C-o' restores the old (saved) color
- `l', `u' swaps the current color and the last color (last, undo)
- `c', `M-c' picks a color by name or RGB hex string
- `M-h' picks a color by HSV components (decimal)
- `M-r' picks a color by RGB components (decimal)
- `~' picks the complement of the current color
- `r', `g', `b', `h', `s', `v' decreases the red, green, blue, hue,
saturation, value component of the current color, respectively;
`R', `G', `B', `H', `S', `V' increases the component
- `M-w' copies the current color (RGB hex) to the kill ring
- `q' quits the palette
- `C-l' refreshes the palette: use if you have a display problem
- `C-h m' provides info on Color Palette mode
Some things to keep in mind when using the Color Palette:
* Whenever you input a color name, you can use completion against the
list of all recognized colors. If you also use my library Icicles,
then you can match any part(s) of the color name.
* You can at any time use an RGB hexadecimal color string in place of
a recognized color name. An RGB string has the form #XXXXXXXXXXXX,
where each X is a hex digit (the # is optional for input). The
number of Xs must be 12 or less and a multiple of 3, with the same
number of Xs for each of red, green, and blue. Examples:
#FF0099 (red: FF, green: 00, blue: 99), #0C1FA329E (red: 0C1,
green: FA3, blue: 29E).
* For output, that is, messages and some return values, an RGB value
respects user option `palette-hex-rgb-digits', which determines the
number of hex digits (1 to 4) per RGB component.
* Once you find a color you like, you can use its RGB string anywhere
in Emacs as the color definition of a face or a frame. Its RGB
string is the value of `palette-current-color'.
* Hue 0.0 and hue 1.0 are the same: pure red. The hue x saturation
palette shows this discontinuity. Move the cursor horizontally
near the right side of this palette and you will see the hue value
jump between 0.0 and 1.0 at a certain point.
* By default, information about the color at any location is only
available upon demand, by clicking `mouse-1' or `mouse-2', or
hitting `?' or `RET'. If you prefer additional feedback, set
option `palette-verbose-flag' to non-nil to display color
information each time you move the cursor, pick a color, or modify
a color swatch. This can slow things down a bit, because it means
additional computation of color components.
* Non-nil `palette-update-cursor-color-flag' updates the frame
foreground and cursor color dynamically, so that the position of
the current color stands out well against the palette. For
example, if the current color is red then the foreground color
becomes cyan. The default value is nil. When nil, you cannot see
the black cursor against a black background. When non-nil, there
are two annoyances: 1) updating the cursor color causes redisplay
of the frame, which is slow; 2) If you ask for information about a
color that is very different from the current color, then it still
might be difficult to see the cursor because of its color. In that
case, you can hit `RET' to make it the current color so its
position stands out better.
(Hit `l' to undo).
* You can at any time toggle options `palette-verbose-flag' and
`palette-update-cursor-color-flag' with keys `f' (for \"feedback\")
and `e' (for \"enhanced cursor color\").
* By default, feedback about a color includes its RGB hex string, RGB
decimal components, and HSV decimal components. If your minibuffer
is too short for all of that info, or if you are interested in only
some of it, then you can change the value of user option
`palette-message-info' accordingly. In addition, you can use
commands `palette-hex-info', `palette-hsv-info', `palette-rgb-info'
at any time to obtain only color information of one type.
* If you enter an empty name (that is, just hit `RET') when you are
prompted for a color name, then a name is picked randomly."
(setq mode-line-format nil)
(set (make-local-variable 'auto-hscroll-mode) nil)
(set (make-local-variable 'auto-window-vscroll) nil)
(set (make-local-variable 'transient-mark-mode) nil)
(set (make-local-variable 'truncate-lines) t)
(setq show-trailing-whitespace nil
cursor-in-non-selected-windows t)
(when (fboundp 'blink-cursor-mode)
(add-hook 'blink-cursor-mode-hook 'palette-update-blink-cursor-mode)
(blink-cursor-mode 1)))
(define-derived-mode palette-mode nil "Color Palette"
"Major mode for using the color palette.
Turning on this mode runs the normal hook `palette-mode-hook'.
Use command `palette' to display a color palette in Color Palette
mode (`palette-mode'). This has three sub-palettes (from left to
right):
- a hue x saturation palette - buffer Palette (Hue x Saturation)
Hue is horizontal; saturation is vertical. Hue is the tint of a
color, independent of its brightness and grayness. Saturation is
the purity of a color (opposite of grayness).
- a color-swatch palette - buffer Current/Original
- a value (brightness) palette - buffer Brightness
The color-swatch palette shows the current color and the original
color or the last color saved. Saving is not persistent.
In the color palette:
- `mouse-1' or `?' anywhere shows info about a color
- `mouse-2' or `RET' anywhere picks a color as the current color
- Cursor motion is along the grid of colors, with wrapping.
Shifted cursor motion updates the current color as you move.
- `n', `C-s' saves the current color
- `o', `C-o' restores the old (saved) color
- `l', `u' swaps the current color and the last color (last, undo)
- `c', `M-c' picks a color by name or RGB hex string
- `M-h' picks a color by HSV components (decimal)
- `M-r' picks a color by RGB components (decimal)
- `~' picks the complement of the current color
- `r', `g', `b', `h', `s', `v' decreases the red, green, blue, hue,
saturation, value component of the current color, respectively;
`R', `G', `B', `H', `S', `V' increases the component
- `M-w' copies the current color (RGB hex) to the kill ring
- `q' quits the palette
- `C-l' refreshes the palette: use if you have a display problem
- `C-h m' provides info on Color Palette mode
Some things to keep in mind when using the Color Palette:
* Whenever you input a color name, you can use completion against the
list of all recognized colors. If you also use my library Icicles,
then you can match any part(s) of the color name.
* You can at any time use an RGB hexadecimal color string in place of
a recognized color name. An RGB string has the form #XXXXXXXXXXXX,
where each X is a hex digit (the # is optional for input). The
number of Xs must be 12 or less and a multiple of 3, with the same
number of Xs for each of red, green, and blue. Examples:
#FF0099 (red: FF, green: 00, blue: 99), #0C1FA329E (red: 0C1,
green: FA3, blue: 29E).
* For output, that is, messages and some return values, an RGB value
respects user option `palette-hex-rgb-digits', which determines the
number of hex digits (1 to 4) per RGB component.
* Once you find a color you like, you can use its RGB string anywhere
in Emacs as the color definition of a face or a frame. Its RGB
string is the value of `palette-current-color'.
* Hue 0.0 and hue 1.0 are the same: pure red. The hue x saturation
palette shows this discontinuity. Move the cursor horizontally
near the right side of this palette and you will see the hue value
jump between 0.0 and 1.0 at a certain point.
* By default, information about the color at any location is only
available upon demand, by clicking `mouse-1' or `mouse-2', or
hitting `?' or `RET'. If you prefer additional feedback, set
option `palette-verbose-flag' to non-nil to display color
information each time you move the cursor, pick a color, or modify
a color swatch. This can slow things down a bit, because it means
additional computation of color components.
* Non-nil `palette-update-cursor-color-flag' updates the frame
foreground and cursor color dynamically, so that the position of
the current color stands out well against the palette. For
example, if the current color is red then the foreground color
becomes cyan. The default value is nil. When nil, you cannot see
the black cursor against a black background. When non-nil, there
are two annoyances: 1) updating the cursor color causes redisplay
of the frame, which is slow; 2) If you ask for information about a
color that is very different from the current color, then it still
might be difficult to see the cursor because of its color. In that
case, you can hit `RET' to make it the current color so its
position stands out better.
(Hit `l' to undo).
* You can at any time toggle options `palette-verbose-flag' and
`palette-update-cursor-color-flag' with keys `f' (for \"feedback\")
and `e' (for \"enhanced cursor color\").
* By default, feedback about a color includes its RGB hex string, RGB
decimal components, and HSV decimal components. If your minibuffer
is too short for all of that info, or if you are interested in only
some of it, then you can change the value of user option
`palette-message-info' accordingly. In addition, you can use
commands `palette-hex-info', `palette-hsv-info', `palette-rgb-info'
at any time to obtain only color information of one type.
* If you enter an empty name (that is, just hit `RET') when you are
prompted for a color name, then a name is picked randomly."
(setq mode-line-format nil)
(set (make-local-variable 'auto-hscroll-mode) nil)
(set (make-local-variable 'auto-window-vscroll) nil)
(set (make-local-variable 'transient-mark-mode) nil)
(set (make-local-variable 'truncate-lines) t)
(setq show-trailing-whitespace nil
cursor-in-non-selected-windows t)
(when (fboundp 'blink-cursor-mode)
(add-hook 'blink-cursor-mode-hook 'palette-update-blink-cursor-mode)
(blink-cursor-mode 1))))
(defun palette-update-blink-cursor-mode ()
"Update `palette-saved-blink-cursor-mode' from option `blink-cursor-mode'.
No update is made if we are in the palette."
(unless (eq major-mode 'palette-mode)
(setq palette-saved-blink-cursor-mode blink-cursor-mode)))
(defun palette-popup-menu (event)
"Display a popup menu of palette commands.
EVENT is a mouse event."
(interactive "e")
(popup-menu palette-popup-map))
(defun palette-help ()
"Describe Color Palette mode."
(interactive)
(let ((pop-up-frames t)) (describe-mode (get-buffer "Palette (Hue x Saturation)"))))
(defun palette-hex-info (color)
"Print the hexadecimal RGB string for COLOR.
With prefix arg, prompts for color name.
Otherwise, uses the color at the cursor."
(interactive
(list (if current-prefix-arg (hexrgb-read-color nil t) (palette-background-at-point))))
(message "RGB hex: %s" (hexrgb-rgb-hex-to-rgb-hex color palette-hex-rgb-digits)))
(defun palette-hsv-info (color)
"Print the HSV components of COLOR.
With prefix arg, prompts for color name.
Otherwise, uses the color at the cursor."
(interactive
(list (if current-prefix-arg (hexrgb-read-color nil t) (palette-background-at-point))))
(message "HSV: %s" (hexrgb-hex-to-hsv color)))
(defun palette-rgb-info (color)
"Print the RGB components of COLOR.
With prefix arg, prompts for color name.
Otherwise, uses the color at the cursor."
(interactive
(list (if current-prefix-arg (hexrgb-read-color nil t) (palette-background-at-point))))
(message "RGB: %s" (hexrgb-hex-to-rgb color)))
(defun palette-current-color (&optional msg-p)
"Return the current palette color, `palette-current-color'.
The value returned respects option `palette-hex-rgb-digits'.
For the full value instead, use variable, not function,
`palette-current-color'.
Interactively, display a message with information about the color.
Non-interactively, non-nil optional arg MSG-P means show an
informative message."
(interactive "p")
(let ((color (hexrgb-rgb-hex-to-rgb-hex palette-current-color palette-hex-rgb-digits)))
(when msg-p (palette-color-message color t))
color))
(defun palette-current-rgb-to-kill-ring (&optional msg-p)
"Copy the RGB hex string for the current color to the kill ring.
Respect option `palette-hex-rgb-digits'."
(interactive "p")
(kill-new (palette-current-color))
(when msg-p (message "Copied: %s" (palette-current-color))))
(defalias 'eyedrop-background-at-mouse 'palette-background-at-mouse)
(defun palette-background-at-mouse (event &optional msg-p)
"Return the background color under the mouse pointer.
Display it in a message, respecting option `palette-hex-rgb-digits'.
Return the full value, however, ignoring `palette-hex-rgb-digits'.
EVENT is a mouse event.
Non-interactively, non-nil optional arg MSG-P means display an
informative message."
(interactive "e\np")
(while (input-pending-p) (discard-input))
(set-buffer (window-buffer (posn-window (event-end event))))
(mouse-set-point event)
(let ((bg (palette-background-at-point)))
(when msg-p (if bg (palette-color-message bg t) (message "No background color here")))
bg))
(defalias 'eyedrop-foreground-at-mouse 'palette-foreground-at-mouse)
(defun palette-foreground-at-mouse (event &optional msg-p)
"Return the foreground color under the mouse pointer.
Display it in a message, respecting option `palette-hex-rgb-digits'.
Return the full value, however, ignoring `palette-hex-rgb-digits'.
EVENT is a mouse event.
Non-interactively, non-nil optional arg MSG-P means display an
informative message."
(interactive "e\np")
(while (input-pending-p) (discard-input))
(set-buffer (window-buffer (posn-window (event-end event))))
(mouse-set-point event)
(let ((fg (palette-foreground-at-point)))
(when msg-p (if fg (palette-color-message fg t) (message "No foreground color here")))
fg))
(defalias 'eyedrop-face-at-point 'palette-face-at-point)
(defun palette-face-at-point ()
"Return the face under the text cursor.
If there is more than one face, return the first one.
Return nil if there is no face at point."
(let* ((faceprop (or (get-char-property (point) 'read-face-name)
(get-char-property (point) 'face)
'default))
(face (cond ((symbolp faceprop) faceprop)
((and (consp faceprop) (not (keywordp (car faceprop)))
(not (memq (car faceprop)
'(foreground-color background-color))))
(car faceprop))
(t nil))))
(if (facep face) face nil)))
(defalias 'background-color 'palette-background-at-point)
(defalias 'eyedrop-background-at-point 'palette-background-at-point)
(defun palette-background-at-point (&optional msg-p)
"Return the background color under the text cursor.
Display it in a message, respecting option `palette-hex-rgb-digits'.
Return the full value, however, ignoring `palette-hex-rgb-digits'.
There need be no defined face at the cursor position (point).
Non-interactively, non-nil optional arg MSG-P means display an
informative message.
NOTE: The cursor is positioned in each of the windows so that it
corresponds as well as possible to the other windows. However,
this correspondance is by no means exact. In particular, the
color in the main Palette buffer (`Hue x Saturation') does not
necessarily reflect the current color accurately.
If you want information about the current color, then use \
\\<palette-mode-map>`\\[palette-current-color]'
instead. (Or use `\\[palette-background-at-point]' from the
color-swatch buffer (`Current/Original')."
(interactive "p")
(let* ((face (or (and (not (eq major-mode 'palette-mode)) (palette-face-at-point))
(get-char-property (point) 'read-face-name)
(get-char-property (point) 'face)
'default))
(bg (cond ((and face (symbolp face))
(condition-case nil
(face-background face nil 'default)
(error (or (face-background face)
(cdr (assq 'background-color (frame-parameters)))))))
((consp face)
(cond ((eq 'background-color (car face)) (cdr face))
((and (consp (cdr face)) (memq 'background-color face))
(cdr (memq 'background-color face)))
((and (consp (cdr face)) (memq ':background face))
(cadr (memq ':background face)))
(t (cdr (assq 'background-color (frame-parameters))))))
(t nil))))
(when msg-p (if bg (palette-color-message bg t) (message "No background color here")))
bg))
(defalias 'foreground-color 'palette-foreground-at-point)
(defalias 'eyedrop-foreground-at-point 'palette-foreground-at-point)
(defun palette-foreground-at-point (&optional msg-p)
"Return the foreground color under the text cursor.
Display it in a message, respecting option `palette-hex-rgb-digits'.
Return the full value, however, ignoring `palette-hex-rgb-digits'.
There need be no defined face at the cursor position (point).
Non-interactively, non-nil optional arg MSG-P means display an
informative message."
(interactive "p")
(let* ((face (or (and (not (eq major-mode 'palette-mode))
(palette-face-at-point))
(get-char-property (point) 'read-face-name)
(get-char-property (point) 'face)
'default))
(fg (cond ((and face (symbolp face))
(condition-case nil
(face-foreground face nil 'default)
(error (or (face-foreground face)
(cdr (assq 'foreground-color (frame-parameters)))))))
((consp face)
(cond ((eq 'foreground-color (car face)) (cdr face))
((and (consp (cdr face)) (memq 'foreground-color face))
(cdr (memq 'foreground-color face)))
((and (consp (cdr face)) (memq ':foreground face))
(cadr (memq ':foreground face)))
(t (cdr (assq 'foreground-color (frame-parameters))))))
(t nil))))
(when msg-p (if fg (palette-color-message fg t) (message "No foreground color here")))
fg))
(defalias 'eyedrop-pick-background-at-mouse 'palette-pick-background-at-mouse)
(defun palette-pick-background-at-mouse (event &optional show-p msg-p)
"Set the current color to the background color under the mouse pointer.
The background color is saved in `palette-picked-background' and
`palette-last-picked-color'. The new current color is returned.
EVENT is a mouse event.
Non-nil optional arg SHOW-P (prefix arg) means display the palette.
If called from the color palette, update the current color there.
Non-interactively, non-nil optional arg MSG-P means show an
informative message."
(interactive "e\nP\p")
(setq palette-last-color palette-current-color)
(let ((win (posn-window (event-end event)))
(bg (palette-background-at-mouse event)))
(palette-set-current-color bg)
(setq palette-picked-background bg
palette-last-picked-color bg)
(unless (stringp bg) (error "No background color here to pick"))
(when msg-p (palette-color-message bg))
(cond ((get-buffer-window "Palette (Hue x Saturation)" 'visible)
(palette-brightness-scale)
(palette-swatch))
(show-p (palette bg)))
(select-window win)
(when (and palette-action (eq major-mode 'palette-mode)) (funcall palette-action))
bg))
(defun palette-set-current-color (new-value)
"Set `palette-current-color' and run `palette-change-color-hook'.
NEW-VALUE is the new value. It is returned.
Use this everywhere instead of (setq palette-current-color new-value)."
(prog1 (setq palette-current-color new-value)
(run-hooks 'palette-change-color-hook)))
(defalias 'eyedrop-pick-foreground-at-mouse 'palette-pick-foreground-at-mouse)
(defun palette-pick-foreground-at-mouse (event &optional show-p msg-p)
"Set the current color to the foreground color under the mouse pointer.
The foreground color is saved in `palette-picked-foreground' and
`palette-last-picked-color'. The new current color is returned.
EVENT is a mouse event.
Non-nil optional arg SHOW-P (prefix arg) means display the palette.
If called from the color palette, update the current color there.
Non-interactively, non-nil optional arg MSG-P means show an
informative message."
(interactive "e\nP\p")
(setq palette-last-color palette-current-color)
(let ((win (posn-window (event-end event)))
(fg (palette-foreground-at-mouse event)))
(palette-set-current-color fg)
(setq palette-picked-foreground fg
palette-last-picked-color fg)
(unless (stringp fg) (error "No foreground color here to pick"))
(when msg-p (palette-color-message fg))
(cond ((get-buffer-window "Palette (Hue x Saturation)" 'visible)
(palette-brightness-scale)
(palette-swatch))
(show-p (palette fg)))
(select-window win)
fg))
(defalias 'eyedropper-background 'palette-pick-background-at-point)
(defalias 'pick-background-color 'palette-pick-background-at-point)
(defalias 'eyedrop-pick-background-at-point 'palette-pick-background-at-point)
(defun palette-pick-background-at-point (&optional show-p msg-p)
"Set the current color to the background color under the text cursor.
The background color is saved in `palette-picked-background' and
`palette-last-picked-color'. The (new) current color is returned.
Non-nil optional arg SHOW-P (prefix arg) means display the palette.
If called from the color palette, update the current color there.
Non-interactively, non-nil optional arg MSG-P means show an
informative message."
(interactive "P\np")
(setq palette-last-color palette-current-color)
(save-selected-window
(palette-set-current-color (palette-background-at-point))
(setq palette-picked-background palette-current-color
palette-last-picked-color palette-current-color)
(unless (stringp palette-current-color) (error "No background color here to pick"))
(when msg-p (palette-color-message palette-current-color))
(cond ((get-buffer-window "Palette (Hue x Saturation)" 'visible)
(palette-brightness-scale)
(palette-swatch))
(show-p (palette palette-current-color))))
(when (and palette-action (eq major-mode 'palette-mode)) (funcall palette-action))
palette-current-color)
(defalias 'eyedropper-foreground 'palette-pick-foreground-at-point)
(defalias 'pick-foreground-color 'palette-pick-foreground-at-point)
(defalias 'eyedrop-pick-foreground-at-point 'palette-pick-foreground-at-point)
(defun palette-pick-foreground-at-point (&optional show-p msg-p)
"Set the current color to the foreground color under the text cursor.
The foreground color is saved in `palette-picked-foreground' and
`palette-last-picked-color'. The (new) current color is returned.
Non-nil optional arg SHOW-P (prefix arg) means display the palette.
If called from the color palette, update the current color there.
Non-interactively, non-nil optional arg MSG-P means show an
informative message."
(interactive "P\np")
(setq palette-last-color palette-current-color)
(save-selected-window
(palette-set-current-color (palette-foreground-at-point))
(setq palette-picked-foreground palette-current-color
palette-last-picked-color palette-current-color)
(unless (stringp palette-current-color) (error "No foreground color here to pick"))
(when msg-p (palette-color-message palette-current-color))
(cond ((get-buffer-window "Palette (Hue x Saturation)" 'visible)
(palette-brightness-scale)
(palette-swatch))
(show-p (palette palette-current-color))))
palette-current-color)
(defun palette-pick-color-by-name (color)
"Set the current palette color to a COLOR you name.
Instead of a color name, you can use an RGB string #XXXXXXXXXXXX,
where each X is a hex digit. The number of Xs must be a multiple of
3, with the same number of Xs for each of red, green, and blue.
If you enter an empty color name, then a color is picked randomly.
The new current color is returned."
(interactive (list (hexrgb-read-color nil nil t)))
(when (string= "" color)
(let* ((colors (hexrgb-defined-colors))
(rand (random (length colors))))
(setq color (elt colors rand))))
(setq palette-last-color palette-current-color)
(save-selected-window
(setq color (hexrgb-color-name-to-hex color))
(palette-set-current-color color)
(palette-where-is-color color)
(palette-brightness-scale)
(palette-swatch))
palette-current-color)
(defalias 'rgb 'palette-pick-color-by-rgb)
(defun palette-pick-color-by-rgb (red green blue)
"Set the current color by providing RED, GREEN, and BLUE components.
Each component is from 0.0 to 1.0 inclusive."
(interactive "nColor by RGB (0 to 1) - Red: \nnGreen: \nnBlue: ")
(setq palette-last-color palette-current-color)
(save-selected-window
(palette-set-current-color (hexrgb-rgb-to-hex red green blue))
(palette-where-is-color palette-current-color)
(palette-brightness-scale)
(palette-swatch))
palette-current-color)
(defalias 'hsv 'palette-pick-color-by-hsv)
(defun palette-pick-color-by-hsv (hue saturation value)
"Set the current color by providing HUE, SATURATION, and VALUE.
Each component is from 0.0 to 1.0 inclusive."
(interactive "nColor by HSV (0 to 1) - Hue: \nnSaturation: \nnValue: ")
(setq palette-last-color palette-current-color)
(save-selected-window
(palette-set-current-color (hexrgb-hsv-to-hex hue saturation value))
(palette-where-is-color palette-current-color)
(palette-brightness-scale)
(palette-swatch))
palette-current-color)
(defalias 'complement 'palette-pick-color-complement)
(defun palette-pick-color-complement ()
"Set the current palette color to its complement."
(interactive)
(setq palette-last-color palette-current-color)
(save-selected-window
(palette-set-current-color (hexrgb-complement palette-current-color))
(palette-where-is-color palette-current-color)
(palette-brightness-scale)
(palette-swatch))
palette-current-color)
(defun palette-save-new-color ()
"Save the current color as the old (original) color.
The old color becomes the last color, so it is available by \
`\\<palette-mode-map>\\[palette-swap-last-color]'.
This command runs `palette-save-color-hook' at the end.
The saved color is returned."
(interactive)
(save-selected-window
(setq palette-last-color palette-old-color
palette-old-color palette-current-color)
(palette-swatch t))
(run-hooks 'palette-save-color-hook)
palette-old-color)
(defun palette-swap-last-color ()
"Swap the last color and the current color."
(interactive)
(save-selected-window
(setq palette-last-color (prog1 palette-current-color
(palette-set-current-color palette-last-color)))
(palette-where-is-color palette-current-color)
(palette-brightness-scale)
(palette-swatch)))
(defun palette-restore-old-color ()
"Restore the old (original) color as the current color."
(interactive)
(save-selected-window
(setq palette-last-color palette-current-color)
(palette-set-current-color palette-old-color)
(palette-where-is-color palette-current-color)
(palette-brightness-scale)
(palette-swatch)))
(defun palette-refresh ()
"Refresh the color palette."
(interactive)
(save-selected-window
(let ((win (get-buffer-window "Current/Original" 'visible)))
(when win (select-window win) (goto-char (point-min)) (recenter)))))
(defun palette-exit ()
"Exit the color palette with exit action, if defined.
Call `palette-quit', then run `palette-exit-hook', then reset
`palette-action' and `palette-exit-hook'.
Turn off `blink-cursor-mode', if it was off before showing palette.
Return `palette-current-color'."
(interactive)
(unwind-protect
(progn (palette-quit 'dont-reset)
(run-hooks 'palette-exit-hook))
(setq palette-action nil
palette-exit-hook nil)
(when (and (fboundp 'blink-cursor-mode) (not palette-saved-blink-cursor-mode))
(blink-cursor-mode -1))
(remove-hook 'blink-cursor-mode-hook 'palette-update-blink-cursor-mode)
palette-current-color))
(defun palette-quit (&optional dont-reset)
"Quit the color palette without any exit action.
Unlike palette-exit', this does not run `palette-exit-hook'.
Unless DONT-RESET is non-nil, reset `palette-action' and
`palette-exit-hook'.
Turn off `blink-cursor-mode', if it was off before showing palette.
Return `palette-current-color'."
(interactive)
(unwind-protect
(progn
(let ((win (get-buffer-window "Palette (Hue x Saturation)" 'visible)))
(when win (select-window win) (delete-frame)))
(when (get-buffer "Palette (Hue x Saturation)")
(kill-buffer "Palette (Hue x Saturation)"))
(when (get-buffer "Brightness") (kill-buffer "Brightness"))
(when (get-buffer "Current/Original") (kill-buffer "Current/Original")))
(unless dont-reset
(setq palette-action nil
palette-exit-hook nil))
(when (and (fboundp 'blink-cursor-mode) (not palette-saved-blink-cursor-mode))
(blink-cursor-mode -1))
(remove-hook 'blink-cursor-mode-hook 'palette-update-blink-cursor-mode)
palette-current-color))
(defun palette-where-is-color (color &optional cursor-color)
"Move to the palette location of COLOR.
This does not change the current color.
Non-nil optional arg CURSOR-COLOR means update the cursor color, if
option `palette-update-cursor-color-flag' is non-nil."
(interactive (list (hexrgb-read-color nil t)))
(setq color (hexrgb-color-name-to-hex color))
(let ((target-hue (hexrgb-hue color))
(target-sat (hexrgb-saturation color))
(hue-sat-win (get-buffer-window "Palette (Hue x Saturation)" 'visible))
bg hue sat)
(unless hue-sat-win (error "No Palette displayed - use command `palette'"))
(select-window hue-sat-win)
(if (< target-sat 0.049)
(goto-char (- (point-max) 50))
(while (and (not (eobp)) (setq bg (palette-background-at-point))
(setq sat (hexrgb-saturation bg)) (< target-sat sat))
(condition-case nil (forward-line 1) (goto-char (point-max))))
(while (and (not (bobp)) (setq bg (palette-background-at-point))
(setq sat (hexrgb-saturation bg)) (> target-sat sat))
(condition-case nil (forward-line -1) (goto-char (point-min))))
(while (and (not (eolp)) (setq bg (palette-background-at-point))
(setq hue (hexrgb-hue bg)) (< target-hue hue))
(forward-char))
(while (and (not (bolp)) (setq bg (palette-background-at-point))
(setq hue (hexrgb-hue bg)) (> target-hue hue))
(backward-char))
(when palette-update-cursor-color-flag
(let ((col (or cursor-color (palette-complement-or-alternative color))))
(modify-frame-parameters (selected-frame) `(,(cons 'foreground-color col)
,(cons 'cursor-color col)
,(cons 'mouse-color col)))))
(when palette-verbose-flag (palette-color-message color)))))
(defun palette-right (&optional arg)
"Move right ARG places, wrapping around from the left.
ARG < 0 means move left, wrapping around from the right."
(interactive "p")
(let* ((fwd-p (wholenump arg))
(start (point))
(max (save-excursion
(if (not fwd-p) (beginning-of-line) (end-of-line) (forward-char -1))
(- (point) start))))
(setq arg (prefix-numeric-value arg))
(forward-char (if fwd-p (min max arg) (max max arg)))
(when (if fwd-p (< max arg) (< arg max))
(if fwd-p (beginning-of-line) (end-of-line) (forward-char -1))
(forward-char (if fwd-p (- arg (1+ max)) (1+ (- arg max)))))
(unless (or (input-pending-p) (not palette-verbose-flag))
(let ((bg (palette-background-at-point)))
(if bg (palette-color-message bg t) (message "No background color here"))
bg))))
(defun palette-left (&optional arg)
"Move left ARG chars, wrapping around from the right.
ARG < 0 means move right, wrapping around from the left."
(interactive "p")
(palette-right (- (prefix-numeric-value arg))))
(defun palette-down (&optional arg)
"Move down ARG places, wrapping around from the top.
ARG < 0 means move up, wrapping around from the bottom."
(interactive "p")
(let* ((fwd-p (wholenump arg))
(column (current-column))
(start (line-beginning-position))
(max (save-excursion (if (not fwd-p)
(goto-char (point-min))
(goto-char (point-max))
(forward-line -1))
(beginning-of-line)
(count-lines (point) start))))
(unless fwd-p (setq max (- max)))
(setq arg (prefix-numeric-value arg))
(forward-line (if fwd-p (min max arg) (max max arg)))
(when (if fwd-p (< max arg) (< arg max))
(if fwd-p (goto-char (point-min)) (goto-char (point-max)) (forward-line -1))
(forward-line (if fwd-p (- arg (1+ max)) (1+ (- arg max)))))
(move-to-column column))
(unless (or (input-pending-p) (not palette-verbose-flag))
(let ((bg (palette-background-at-point)))
(if bg (palette-color-message bg t) (message "No background color here"))
bg)))
(defun palette-up (&optional arg)
"Move up ARG chars, wrapping around from the bottom.
ARG < 0 means move down, wrapping around from the top."
(interactive "p")
(palette-down (- (prefix-numeric-value arg))))
(defun palette-right+pick (&optional arg)
"`palette-right' followed by `palette-pick-background-at-point'.
The prefix ARG is passed is passed to `palette-right'."
(interactive "p")
(setq palette-last-color palette-current-color)
(palette-right arg)
(unless (input-pending-p) (palette-pick-background-at-point)))
(defun palette-left+pick (&optional arg)
"`palette-left' followed by `palette-pick-background-at-point'.
The prefix ARG is passed is passed to `palette-left'."
(interactive "p")
(setq palette-last-color palette-current-color)
(palette-left arg)
(unless (input-pending-p) (palette-pick-background-at-point)))
(defun palette-down+pick (&optional arg)
"`palette-down' followed by `palette-pick-background-at-point'.
The prefix ARG is passed is passed to `palette-down'."
(interactive "p")
(setq palette-last-color palette-current-color)
(palette-down arg)
(unless (input-pending-p) (palette-pick-background-at-point)))
(defun palette-up+pick (&optional arg)
"`palette-up' followed by `palette-pick-background-at-point'.
The prefix ARG is passed is passed to `palette-up'."
(interactive "p")
(setq palette-last-color palette-current-color)
(palette-up arg)
(unless (input-pending-p) (palette-pick-background-at-point)))
(defun palette-increase-hue (&optional arg)
"Increase the hue component of the current color by ARG/100."
(interactive "p")
(setq palette-last-color palette-current-color)
(save-selected-window
(let ((hue (+ (/ (float arg) 100.0) (hexrgb-hue palette-current-color)))
(sat (hexrgb-saturation palette-current-color))
(val (hexrgb-value palette-current-color)))
(palette-set-current-color (hexrgb-hsv-to-hex hue sat val))
(palette-where-is-color palette-current-color)
(palette-brightness-scale)
(palette-swatch)))
palette-current-color)
(defun palette-decrease-hue (&optional arg)
"Decrease the hue component of the current color by ARG/100."
(interactive "p")
(setq palette-last-color palette-current-color)
(palette-increase-hue (- arg)))
(defun palette-increase-saturation (&optional arg)
"Increase the saturation component of the current color by ARG/100."
(interactive "p")
(setq palette-last-color palette-current-color)
(save-selected-window
(let ((hue (hexrgb-hue palette-current-color))
(sat (+ (/ (float arg) 100.0) (hexrgb-saturation palette-current-color)))
(val (hexrgb-value palette-current-color)))
(palette-set-current-color (hexrgb-hsv-to-hex hue sat val))
(palette-where-is-color palette-current-color)
(palette-brightness-scale)
(palette-swatch)))
palette-current-color)
(defun palette-decrease-saturation (&optional arg)
"Decrease the saturation component of the current color by ARG/100."
(interactive "p")
(setq palette-last-color palette-current-color)
(palette-increase-saturation (- arg)))
(defun palette-increase-value (&optional arg)
"Increase the value component of the current color by ARG/100."
(interactive "p")
(setq palette-last-color palette-current-color)
(save-selected-window
(let ((hue (hexrgb-hue palette-current-color))
(sat (hexrgb-saturation palette-current-color))
(val (+ (/ (float arg) 100.0) (hexrgb-value palette-current-color))))
(palette-set-current-color (hexrgb-hsv-to-hex hue sat val))
(palette-where-is-color palette-current-color)
(palette-brightness-scale)
(palette-swatch)))
palette-current-color)
(defun palette-decrease-value (&optional arg)
"Decrease the value component of the current color by ARG/100."
(interactive "p")
(setq palette-last-color palette-current-color)
(palette-increase-value (- arg)))
(defun palette-increase-red (&optional arg)
"Increase the red component of the current color by ARG/100."
(interactive "p")
(setq palette-last-color palette-current-color)
(save-selected-window
(let ((red (+ (/ (float arg) 100.0) (hexrgb-red palette-current-color)))
(green (hexrgb-green palette-current-color))
(blue (hexrgb-blue palette-current-color)))
(palette-set-current-color (hexrgb-rgb-to-hex red green blue))
(palette-where-is-color palette-current-color)
(palette-brightness-scale)
(palette-swatch)))
palette-current-color)
(defun palette-decrease-red (&optional arg)
"Decrease the red component of the current color by ARG/100."
(interactive "p")
(setq palette-last-color palette-current-color)
(palette-increase-red (- arg)))
(defun palette-increase-green (&optional arg)
"Increase the green component of the current color by ARG/100."
(interactive "p")
(setq palette-last-color palette-current-color)
(save-selected-window
(let ((red (hexrgb-red palette-current-color))
(green (+ (/ (float arg) 100.0) (hexrgb-green palette-current-color)))
(blue (hexrgb-blue palette-current-color)))
(palette-set-current-color (hexrgb-rgb-to-hex red green blue))
(palette-where-is-color palette-current-color)
(palette-brightness-scale)
(palette-swatch)))
palette-current-color)
(defun palette-decrease-green (&optional arg)
"Decrease the green component of the current color by ARG/100."
(interactive "p")
(setq palette-last-color palette-current-color)
(palette-increase-green (- arg)))
(defun palette-increase-blue (&optional arg)
"Increase the blue component of the current color by ARG/100."
(interactive "p")
(setq palette-last-color palette-current-color)
(save-selected-window
(let ((red (hexrgb-red palette-current-color))
(green (hexrgb-green palette-current-color))
(blue (+ (/ (float arg) 100.0) (hexrgb-blue palette-current-color))))
(palette-set-current-color (hexrgb-rgb-to-hex red green blue))
(palette-where-is-color palette-current-color)
(palette-brightness-scale)
(palette-swatch)))
palette-current-color)
(defun palette-decrease-blue (&optional arg)
"Decrease the blue component of the current color by ARG/100."
(interactive "p")
(setq palette-last-color palette-current-color)
(palette-increase-blue (- arg)))
(defalias 'toggle-palette-verbose 'palette-toggle-verbose)
(defun palette-toggle-verbose ()
"Toggle using frequent color info feedback.
This toggles option `palette-toggle-verbose-flag'."
(interactive)
(setq palette-verbose-flag (not palette-verbose-flag))
(message "Verbose color feedback is now %s" (if palette-verbose-flag "ON" "OFF")))
(defalias 'toggle-palette-cursor-color 'palette-toggle-cursor-color)
(defun palette-toggle-cursor-color ()
"Toggle updating the cursor color so the cursor stands out.
This toggles option `palette-update-cursor-color-flag'."
(interactive)
(setq palette-update-cursor-color-flag (not palette-update-cursor-color-flag))
(unless palette-update-cursor-color-flag
(modify-frame-parameters
(selected-frame)
'((foreground-color . "Black") (cursor-color . "Black") (mouse-color . "Black"))))
(message "Cursor highlighting is now %s" (if palette-update-cursor-color-flag "ON" "OFF")))
(defalias 'colors 'palette)
(defun palette (&optional color)
"Display a color-palette frame in Color Palette mode.
This includes these areas:
- a hue x saturation palette
- a swatch of the current color
- a swatch of the original (old) color
- a brightness scale
COLOR is the color used for both swatches.
If you enter an empty color name, then a color is picked randomly.
See `palette-mode' for more information."
(interactive (list (hexrgb-read-color nil nil t)))
(message "Loading palette...")
(when (string= "" color)
(let* ((colors (hexrgb-defined-colors))
(rand (random (length colors))))
(setq color (elt colors rand))))
(palette-set-current-color (hexrgb-color-name-to-hex color))
(setq palette-old-color palette-current-color)
(when (and (boundp 'blink-cursor-mode) (not (eq major-mode 'palette-mode)))
(setq palette-saved-blink-cursor-mode blink-cursor-mode))
(unless palette-font (error "You must define `palette-font'. `C-h v' for more information"))
(palette-quit 'dont-reset)
(let* ((pop-up-frames t)
(window-min-width 5)
(fit-frame-inhibit-fitting-flag t)
(temp-buffer-setup-hook nil)
(temp-buffer-show-functions nil)
(width 100)
(height 100)
(stringlen (* width height)))
(set-buffer (get-buffer-create "Palette (Hue x Saturation)"))
(make-variable-frame-local '1on1-change-cursor-on-input-method-flag)
(modify-frame-parameters
(make-frame
`((menu-bar-lines . 0) (tool-bar-lines . 0) (left-fringe . 0) (right-fringe . 0)
(fringe . 0) (height . 100) (width . 115) (minibuffer) (vertical-scroll-bars)
(cursor-type . box) (background-color . "Black") (mouse-color . "Black")
(cursor-color . "Black") ,(cons 'font palette-font)))
'((1on1-change-cursor-on-input-method-flag)))
(with-output-to-temp-buffer "Palette (Hue x Saturation)"
(let* ((cells (make-string stringlen ?\ ))
(hue 0.999999)
(sat 1.0)
(index 0)
(col "#000000000000")
(hhh 0)
(sss 0))
(while (< index stringlen)
(setq sss 0)
(while (< sss height)
(setq hhh 0
hue 1.0)
(while (< hhh width)
(put-text-property index (1+ index)
'face (cons 'background-color
(setq col (hexrgb-hsv-to-hex hue sat 1.0)))
cells)
(put-text-property index (1+ index) 'pointer 'hand cells)
(setq hue (* (- hue 0.01) 0.999)
hhh (1+ hhh)
index (1+ index)))
(setq sat (* sat 0.97)
sss (1+ sss))))
(set-buffer "Palette (Hue x Saturation)")
(setq sss 0
index 0)
(while (< sss height)
(insert (substring cells index (+ index width)) ?\n)
(setq sss (1+ sss)
index (+ index width)))))
(select-window (get-buffer-window "Palette (Hue x Saturation)" 'visible))
(set-window-dedicated-p (selected-window) t)
(setq header-line-format nil
window-size-fixed t)
(palette-mode)
(setq buffer-read-only t)
(split-window (selected-window) width t)
(palette-swatch)
(palette-swatch t)
(split-window (selected-window) 10 t)
(palette-brightness-scale)
(select-window (get-buffer-window "Palette (Hue x Saturation)" 'visible)))
(redisplay t)
(palette-color-message color)
palette-current-color)
(defun palette-brightness-scale (&optional color msg-p)
"Display a brightness (value) scale for COLOR.
If a color palette is already displayed, then just update it.
Non-interactively, non-nil optional arg MSG-P means show an
informative message."
(interactive (list (hexrgb-read-color) t))
(setq color (or color palette-current-color))
(setq color (hexrgb-color-name-to-hex color))
(let* ((width 5)
(height 100)
(hue-sat-win (get-buffer-window "Palette (Hue x Saturation)" 'visible))
(pop-up-frames (not hue-sat-win))
(stringlen (* width height))
(target-val (hexrgb-value color))
(val 1.0))
(if (and msg-p hue-sat-win)
(palette-pick-color-by-name color)
(let ((split-window-preferred-function (lambda (w) (eq w (get-lru-window)))))
(with-output-to-temp-buffer "Brightness"
(let* ((cells (make-string stringlen ?\ ))
(hue (hexrgb-hue color))
(sat (hexrgb-saturation color))
(index 0)
(col "#FFFFFFFFFFFF")
(hhh 0)
(sss 0))
(while (< index stringlen)
(setq sss 0)
(while (< sss height)
(setq hhh 0
col (hexrgb-hsv-to-hex hue sat val))
(while (< hhh width)
(put-text-property index (1+ index) 'face (cons 'background-color col)
cells)
(put-text-property index (1+ index) 'pointer 'hand cells)
(setq hhh (1+ hhh)
index (1+ index)))
(setq val (* val 0.97)
sss (1+ sss))))
(set-buffer "Brightness")
(setq sss 0
index 0)
(while (< sss height)
(insert (substring cells index (+ index width)) ?\n)
(setq sss (1+ sss)
index (+ index width))))))
(select-window (get-buffer-window "Brightness" 'visible))
(set-window-dedicated-p (selected-window) t)
(setq header-line-format nil)
(while (and (not (eobp))
(setq val (hexrgb-value (palette-background-at-point)))
(< target-val val))
(condition-case nil (forward-line 1) (goto-char (point-max))))
(while (and (not (bobp))
(setq val (hexrgb-value (palette-background-at-point)))
(> target-val val))
(condition-case nil (forward-line -1) (goto-char (point-min))))
(save-excursion
(let ((buffer-read-only nil)
(cells (make-string 5 ?e))
(bg (get-text-property (point) 'face)))
(delete-char 5)
(put-text-property 0 5 'face bg cells)
(insert cells)))
(palette-mode)
(setq buffer-read-only t)
(let ((complement-color (palette-complement-or-alternative color)))
(cond (hue-sat-win
(select-window hue-sat-win)
(palette-where-is-color color complement-color))
(t
(modify-frame-parameters
(selected-frame)
`((menu-bar-lines . 0) (tool-bar-lines . 0) (cursor-type . box)
(left-fringe . 0) (right-fringe . 0) (fringe . 0) (minibuffer) (height . 101)
(vertical-scroll-bars) (background-color . "White") ,(cons 'width (1+ width))
,(cons 'foreground-color complement-color)
,(cons 'mouse-color complement-color)
,(cons 'font palette-font) ,(cons 'cursor-color complement-color)))
(when msg-p (redisplay t))))))))
(defun palette-swatch (&optional oldp color msg-p)
"Display a color swatch.
OLDP non-nil means update the original (old) color;
nil means update the current (new) color.
If a color palette is already displayed, then just update it.
Interactively, you are prompted for the COLOR to display.
Non-interactively, non-nil optional arg MSG-P means show an
informative message."
(interactive (list nil (hexrgb-read-color) t))
(let* ((width 10)
(height 50)
(hue-sat-win (get-buffer-window "Palette (Hue x Saturation)" 'visible))
(swatch-name "Current/Original")
(pop-up-frames (not hue-sat-win))
(stringlen (* width height)))
(if (and msg-p hue-sat-win)
(palette-pick-color-by-name color)
(setq color (or color (hexrgb-color-name-to-hex
(if oldp palette-old-color palette-current-color))))
(let* ((cells (make-string stringlen ?\ ))
(hue (hexrgb-hue color))
(sat (hexrgb-saturation color))
(val 1.0)
(index 0)
(col "#FFFFFFFFFFFF")
(hhh 0)
(sss 0))
(while (< index stringlen)
(setq sss 0)
(while (< sss height)
(setq hhh 0)
(while (< hhh width)
(put-text-property index (1+ index) 'face (cons 'background-color color)
cells)
(put-text-property index (1+ index) 'pointer 'hand cells)
(setq hhh (1+ hhh)
index (1+ index)))
(setq sss (1+ sss))))
(set-buffer (get-buffer-create swatch-name))
(if oldp
(goto-char (+ stringlen height 1))
(unless (= (point-min) (point-max))
(delete-region (point-min) (+ stringlen height 1))
(goto-char (point-min))))
(setq sss 0
index 0)
(while (< sss height)
(insert (substring cells index (+ index width)) ?\n)
(setq sss (1+ sss)
index (+ index width))))
(let ((split-window-preferred-function (lambda (w) (eq w (get-lru-window)))))
(display-buffer swatch-name))
(select-window (get-buffer-window swatch-name 'visible))
(set-window-dedicated-p (selected-window) t)
(setq header-line-format nil)
(palette-mode)
(goto-char (point-min))
(unless hue-sat-win
(let ((complement-color (palette-complement-or-alternative color)))
(modify-frame-parameters
(selected-frame)
`((menu-bar-lines . 0) (tool-bar-lines . 0) (left-fringe . 0) (right-fringe . 0)
(fringe . 0) (minibuffer) (vertical-scroll-bars) (background-color . "White")
(cursor-type . box) ,(cons 'foreground-color complement-color)
,(cons 'mouse-color complement-color) ,(cons 'height (1+ height))
,(cons 'width (1+ width)) ,(cons 'cursor-color complement-color)
,(cons 'font palette-font)))
(when msg-p (redisplay t)))))))
(defun palette-complement-or-alternative (color &optional alternative)
"Complement of COLOR, or ALTERNATIVE if COLOR is its own complement.
The default ALTERNATIVE color is Red."
(let ((hue (hexrgb-hue color)))
(setq alternative (or alternative (if (or (hexrgb-approx-equal hue 1.0 0.2)
(hexrgb-approx-equal hue 0.0 0.0 0.1))
"Cyan"
"Red")))
(let ((complement (hexrgb-complement color)))
(if (or (hexrgb-approx-equal (hexrgb-value complement) (hexrgb-value color) 0.4)
(< (hexrgb-saturation color) 0.2))
alternative
complement))))
(defalias 'eyedrop-color-message 'palette-color-message)
(defun palette-color-message (color &optional hint-p)
"Print information about COLOR, according to `palette-message-info'.
If an RGB hex pattern is shown then it respects option
`palette-hex-rgb-digits'.
Return COLOR as a color name or a full RGB hex pattern (ignoring
`palette-hex-rgb-digits').
Non-nil HINT-P means provide a hint about how to pick the color."
(let* ((rgb (hexrgb-hex-to-rgb color))
(hex (if (eq ?# (aref color 0))
(hexrgb-rgb-hex-to-rgb-hex color palette-hex-rgb-digits)
color))
(hsv (apply #'hexrgb-rgb-to-hsv rgb))
(msg (case palette-message-info
(all (format "Color: %s, RGB: %s, HSV: %s" hex rgb hsv))
(hex (format "Color: %s" hex))
(hsv (format "HSV: %s" hsv))
(rgb (format "RGB: %s" rgb))
(hex+hsv (format "Color: %s, HSV: %s" hex hsv))
(hex+rgb (format "Color: %s, RGB: %s" hex rgb))
(rgb+hsv (format "RGB: %s, HSV: %s" rgb hsv)))))
(if hint-p (message "%s (pick: mouse-2, RET)" msg) (message "%s" msg)))
color)
(defun palette-barf-if-outside-palette ()
"Raise an error if `this-command' is called outside the palette."
(unless (eq major-mode 'palette-mode)
(error "Command `%s' must be called from the minibuffer" this-command)))
(provide 'eyedropper)
(provide 'palette)