1 ;;; gpl.el --- Highlight and edit gpl color palettes
3 (defconst gpl:version "0.01")
4 ;; Copyright (C) 2008 Niels Giesen
6 ;; Author: Niels Giesen
7 ;; Keywords: extensions, tools
9 ;; This program is free software; you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation, either version 3 of the License, or
12 ;; (at your option) any later version.
14 ;; This program is distributed in the hope that it will be useful,
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;; GNU General Public License for more details.
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
24 ;; GPL provides font-locking and has functions to edit the values
25 ;; of colors (hue, saturation value, red, green and blue vals)
26 ;; in-place in a simple, intuitive, and lightweight fashion. See the
27 ;; documentation of `gpl-mode'.
29 ;; The methods and keybindings used are roughly the same as in the new
30 ;; css-color mode. I should maybe have abstracted both color notation
31 ;; models better, but did not feel like it. With under 200 lines of
32 ;; code, it did not seem worth the effort.
34 ;; The css-color.el used is the one by Niels Giesen, at
35 ;; `http://niels.kicks-ass.org/public/elisp/css-color.el'.
39 ;; Put this file in your load-path. Put a declaration such as
41 ;; (autoload 'gpl-mode "gpl")
42 ;; (add-to-list 'auto-mode-alist
43 ;; '("\\.gpl\\'" . gpl-mode))
45 ;; In your initialization file (e.g. ~/.emacs) to make sure `gpl-mode'
46 ;; is started anytime you open a *.gpl file, and gpl-mode is only
47 ;; loaded when needed.
53 '(("^[[:space:]]*\\([a-fA-F[:digit:]]\\{1,3\\}\\)[[:space:]]+\\([a-fA-F[:digit:]]\\{1,3\\}\\)[[:space:]]+\\([a-fA-F[:digit:]]\\{1,3\\}\\)"
55 (let ((color (concat "#" (apply 'css-color-rgb-to-hex
56 (mapcar 'string-to-number
58 (match-string-no-properties 1)
59 (match-string-no-properties 2)
60 (match-string-no-properties 3)))))))
62 (put-text-property (match-beginning 0)
65 (put-text-property (match-beginning 0)
67 'face (list :background
70 (css-color-foreground-color
74 (define-derived-mode gpl-mode fundamental-mode "GPL"
75 "Mode for font-locking and editing color palettes of the GPL format.
77 Such palettes are used and produced by free software applications
78 such as the GIMP, Inkscape, Scribus, Agave and on-line tools such
79 as http://colourlovers.com.
82 URL `http://niels.kicks-ass.org/public/elisp/css-palette.el' to import
83 such palette into a css-file as hexadecimal color palette."
84 (setq font-lock-defaults
89 (let ((m (make-sparse-keymap)))
90 (define-key m "=" 'gpl-up)
91 (define-key m "-" 'gpl-down)
92 (define-key m "h" 'gpl-hue-up)
93 (define-key m "H" 'gpl-hue-down)
94 (define-key m "v" 'gpl-value-up)
95 (define-key m "V" 'gpl-value-down)
96 (define-key m "s" 'gpl-saturation-up)
97 (define-key m "S" 'gpl-saturation-down)
99 "Mode map for `gpl-mode'")
101 (defun gpl-get-color-at-point ()
102 (or (get-text-property (point) 'color)
103 (apply 'css-color-rgb-to-hsv
104 (gpl-get-rgb-list-at-point))))
106 (defun gpl-get-rgb-list-at-point ()
107 (mapcar 'string-to-number
109 (buffer-substring-no-properties
111 (+ 11 (point-at-bol))) "[[:space:]]+" t)))
113 (defun gpl-replcolor-at-p (fun increment)
118 (gpl-get-color-at-point)
120 (delete-region (point) (+ (point) 11))
123 (defun gpl-hsv-to-gimp-color (h s v)
125 (apply 'format "%3d %3d %3d"
126 (css-color-hsv-to-rgb h s v))
128 'color (list h s v)))
130 (defun gpl-what-channel ()
131 (/ (- (point) (point-at-bol)) 4))
133 (defun gpl-adjust-channel-at-p (incr)
136 (channel (gpl-what-channel)))
139 (gpl-get-rgb-list-at-point)))
140 (setf (nth channel rgb)
141 (css-color-within-bounds
142 (+ incr (nth channel rgb))
144 (delete-region (point) (+ 11 (point)))
147 (apply 'format "%3d %3d %3d" rgb)
152 (defun gpl-inchue (color incr)
153 (destructuring-bind (h s v) color
154 (gpl-hsv-to-gimp-color
157 (defun gpl-incsat (color incr)
158 (destructuring-bind (h s v) color
159 (gpl-hsv-to-gimp-color
160 h (css-color-within-bounds (+ incr s) 0 100) v)))
162 (defun gpl-incval (color incr)
163 (destructuring-bind (h s v) color
164 (gpl-hsv-to-gimp-color
165 h s (css-color-within-bounds (+ incr v) 0 100))))
167 (defun gpl-adj-hue-at-p (increment)
169 (gpl-replcolor-at-p 'gpl-inchue increment))
171 (defun gpl-adj-saturation-at-p (increment)
173 (gpl-replcolor-at-p 'gpl-incsat increment))
175 (defun gpl-adj-value-at-p (increment)
177 (gpl-replcolor-at-p 'gpl-incval increment))
179 ;; channels (r, g, b)
182 (gpl-adjust-channel-at-p val))
184 (defun gpl-down (val)
186 (gpl-adjust-channel-at-p (- val)))
188 (defun gpl-hue-up (val)
190 (gpl-adj-hue-at-p val))
192 (defun gpl-hue-down (val)
194 (gpl-adj-hue-at-p (- val)))
196 (defun gpl-saturation-up (val)
198 (gpl-adj-saturation-at-p val))
200 (defun gpl-saturation-down (val)
202 (gpl-adj-saturation-at-p (- val)))
204 (defun gpl-value-up (val)
206 (gpl-adj-value-at-p val))
208 (defun gpl-value-down (val)
210 (gpl-adj-value-at-p (- val)))