1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
|
;;; gpl.el --- Highlight and edit gpl color palettes
(defconst gpl:version "0.01")
;; Copyright (C) 2008 Niels Giesen
;; Author: Niels Giesen
;; Keywords: extensions, tools
;; This program 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 3 of the License, or
;; (at your option) any later version.
;; This program 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 this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; GPL provides font-locking and has functions to edit the values
;; of colors (hue, saturation value, red, green and blue vals)
;; in-place in a simple, intuitive, and lightweight fashion. See the
;; documentation of `gpl-mode'.
;; The methods and keybindings used are roughly the same as in the new
;; css-color mode. I should maybe have abstracted both color notation
;; models better, but did not feel like it. With under 200 lines of
;; code, it did not seem worth the effort.
;; The css-color.el used is the one by Niels Giesen, at
;; `http://niels.kicks-ass.org/public/elisp/css-color.el'.
;; Installation:
;; Put this file in your load-path. Put a declaration such as
;; (autoload 'gpl-mode "gpl")
;; (add-to-list 'auto-mode-alist
;; '("\\.gpl\\'" . gpl-mode))
;; In your initialization file (e.g. ~/.emacs) to make sure `gpl-mode'
;; is started anytime you open a *.gpl file, and gpl-mode is only
;; loaded when needed.
;;; Code:
(require 'css-color)
(defvar gpl-keywords
'(("^[[:space:]]*\\([a-fA-F[:digit:]]\\{1,3\\}\\)[[:space:]]+\\([a-fA-F[:digit:]]\\{1,3\\}\\)[[:space:]]+\\([a-fA-F[:digit:]]\\{1,3\\}\\)"
(0
(let ((color (concat "#" (apply 'css-color-rgb-to-hex
(mapcar 'string-to-number
(list
(match-string-no-properties 1)
(match-string-no-properties 2)
(match-string-no-properties 3)))))))
(put-text-property (match-beginning 0)
(match-end 0)
'keymap gpl-map)
(put-text-property (match-beginning 0)
(match-end 0)
'face (list :background
color
:foreground
(css-color-foreground-color
color))))))))
;;;###autoload
(define-derived-mode gpl-mode fundamental-mode "GPL"
"Mode for font-locking and editing color palettes of the GPL format.
Such palettes are used and produced by free software applications
such as the GIMP, Inkscape, Scribus, Agave and on-line tools such
as http://colourlovers.com.
You can also use
URL `http://niels.kicks-ass.org/public/elisp/css-palette.el' to import
such palette into a css-file as hexadecimal color palette."
(setq font-lock-defaults
'((gpl-keywords)
t)))
(defvar gpl-map
(let ((m (make-sparse-keymap)))
(define-key m "=" 'gpl-up)
(define-key m "-" 'gpl-down)
(define-key m "h" 'gpl-hue-up)
(define-key m "H" 'gpl-hue-down)
(define-key m "v" 'gpl-value-up)
(define-key m "V" 'gpl-value-down)
(define-key m "s" 'gpl-saturation-up)
(define-key m "S" 'gpl-saturation-down)
m)
"Mode map for `gpl-mode'")
(defun gpl-get-color-at-point ()
(or (get-text-property (point) 'color)
(apply 'css-color-rgb-to-hsv
(gpl-get-rgb-list-at-point))))
(defun gpl-get-rgb-list-at-point ()
(mapcar 'string-to-number
(split-string
(buffer-substring-no-properties
(point-at-bol)
(+ 11 (point-at-bol))) "[[:space:]]+" t)))
(defun gpl-replcolor-at-p (fun increment)
(let ((pos (point)))
(beginning-of-line)
(insert
(funcall fun
(gpl-get-color-at-point)
increment))
(delete-region (point) (+ (point) 11))
(goto-char pos)))
(defun gpl-hsv-to-gimp-color (h s v)
(propertize
(apply 'format "%3d %3d %3d"
(css-color-hsv-to-rgb h s v))
'keymap gpl-map
'color (list h s v)))
(defun gpl-what-channel ()
(/ (- (point) (point-at-bol)) 4))
(defun gpl-adjust-channel-at-p (incr)
(interactive "p")
(let ((pos (point))
(channel (gpl-what-channel)))
(beginning-of-line)
(let ((rgb
(gpl-get-rgb-list-at-point)))
(setf (nth channel rgb)
(css-color-within-bounds
(+ incr (nth channel rgb))
0 255))
(delete-region (point) (+ 11 (point)))
(insert
(propertize
(apply 'format "%3d %3d %3d" rgb)
'keymap gpl-map
'color nil)))
(goto-char pos)))
(defun gpl-inchue (color incr)
(destructuring-bind (h s v) color
(gpl-hsv-to-gimp-color
(+ incr h) s v)))
(defun gpl-incsat (color incr)
(destructuring-bind (h s v) color
(gpl-hsv-to-gimp-color
h (css-color-within-bounds (+ incr s) 0 100) v)))
(defun gpl-incval (color incr)
(destructuring-bind (h s v) color
(gpl-hsv-to-gimp-color
h s (css-color-within-bounds (+ incr v) 0 100))))
(defun gpl-adj-hue-at-p (increment)
(interactive "p")
(gpl-replcolor-at-p 'gpl-inchue increment))
(defun gpl-adj-saturation-at-p (increment)
(interactive "p")
(gpl-replcolor-at-p 'gpl-incsat increment))
(defun gpl-adj-value-at-p (increment)
(interactive "p")
(gpl-replcolor-at-p 'gpl-incval increment))
;; channels (r, g, b)
(defun gpl-up (val)
(interactive "p")
(gpl-adjust-channel-at-p val))
(defun gpl-down (val)
(interactive "p")
(gpl-adjust-channel-at-p (- val)))
;; hue
(defun gpl-hue-up (val)
(interactive "p")
(gpl-adj-hue-at-p val))
(defun gpl-hue-down (val)
(interactive "p")
(gpl-adj-hue-at-p (- val)))
;; saturation
(defun gpl-saturation-up (val)
(interactive "p")
(gpl-adj-saturation-at-p val))
(defun gpl-saturation-down (val)
(interactive "p")
(gpl-adj-saturation-at-p (- val)))
;; value
(defun gpl-value-up (val)
(interactive "p")
(gpl-adj-value-at-p val))
(defun gpl-value-down (val)
(interactive "p")
(gpl-adj-value-at-p (- val)))
(provide 'gpl)
;;; gpl.el ends here
|
