blob: 4e9c36ea3157a1d7cbb3d8a74ee567f16b7a46f7 (
plain)
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
|
<h4 class="subsection">Abstract Display Example</h4> <p>Here is a simple example using functions of the ewoc package to implement a <em>color components</em> display, an area in a buffer that represents a vector of three integers (itself representing a 24-bit RGB value) in various ways. </p> <div class="example"> <pre class="example">(setq colorcomp-ewoc nil
colorcomp-data nil
colorcomp-mode-map nil
colorcomp-labels ["Red" "Green" "Blue"])
(defun colorcomp-pp (data)
(if data
(let ((comp (aref colorcomp-data data)))
(insert (aref colorcomp-labels data) "\t: #x"
(format "%02X" comp) " "
(make-string (ash comp -2) ?#) "\n"))
(let ((cstr (format "#%02X%02X%02X"
(aref colorcomp-data 0)
(aref colorcomp-data 1)
(aref colorcomp-data 2)))
(samp " (sample text) "))
(insert "Color\t: "
(propertize samp 'face
`(foreground-color . ,cstr))
(propertize samp 'face
`(background-color . ,cstr))
"\n"))))
(defun colorcomp (color)
"Allow fiddling with COLOR in a new buffer.
The buffer is in Color Components mode."
(interactive "sColor (name or #RGB or #RRGGBB): ")
(when (string= "" color)
(setq color "green"))
(unless (color-values color)
(error "No such color: %S" color))
(switch-to-buffer
(generate-new-buffer (format "originally: %s" color)))
(kill-all-local-variables)
(setq major-mode 'colorcomp-mode
mode-name "Color Components")
(use-local-map colorcomp-mode-map)
(erase-buffer)
(buffer-disable-undo)
(let ((data (apply 'vector (mapcar (lambda (n) (ash n -8))
(color-values color))))
(ewoc (ewoc-create 'colorcomp-pp
"\nColor Components\n\n"
(substitute-command-keys
"\n\\{colorcomp-mode-map}"))))
(set (make-local-variable 'colorcomp-data) data)
(set (make-local-variable 'colorcomp-ewoc) ewoc)
(ewoc-enter-last ewoc 0)
(ewoc-enter-last ewoc 1)
(ewoc-enter-last ewoc 2)
(ewoc-enter-last ewoc nil)))
</pre>
</div> <p>This example can be extended to be a color selection widget (in other words, the “controller” part of the “model–view–controller” design paradigm) by defining commands to modify <code>colorcomp-data</code> and to finish the selection process, and a keymap to tie it all together conveniently. </p> <div class="example"> <pre class="example">(defun colorcomp-mod (index limit delta)
(let ((cur (aref colorcomp-data index)))
(unless (= limit cur)
(aset colorcomp-data index (+ cur delta)))
(ewoc-invalidate
colorcomp-ewoc
(ewoc-nth colorcomp-ewoc index)
(ewoc-nth colorcomp-ewoc -1))))
(defun colorcomp-R-more () (interactive) (colorcomp-mod 0 255 1))
(defun colorcomp-G-more () (interactive) (colorcomp-mod 1 255 1))
(defun colorcomp-B-more () (interactive) (colorcomp-mod 2 255 1))
(defun colorcomp-R-less () (interactive) (colorcomp-mod 0 0 -1))
(defun colorcomp-G-less () (interactive) (colorcomp-mod 1 0 -1))
(defun colorcomp-B-less () (interactive) (colorcomp-mod 2 0 -1))
(defun colorcomp-copy-as-kill-and-exit ()
"Copy the color components into the kill ring and kill the buffer.
The string is formatted #RRGGBB (hash followed by six hex digits)."
(interactive)
(kill-new (format "#%02X%02X%02X"
(aref colorcomp-data 0)
(aref colorcomp-data 1)
(aref colorcomp-data 2)))
(kill-buffer nil))
(setq colorcomp-mode-map
(let ((m (make-sparse-keymap)))
(suppress-keymap m)
(define-key m "i" 'colorcomp-R-less)
(define-key m "o" 'colorcomp-R-more)
(define-key m "k" 'colorcomp-G-less)
(define-key m "l" 'colorcomp-G-more)
(define-key m "," 'colorcomp-B-less)
(define-key m "." 'colorcomp-B-more)
(define-key m " " 'colorcomp-copy-as-kill-and-exit)
m))
</pre>
</div> <p>Note that we never modify the data in each node, which is fixed when the ewoc is created to be either <code>nil</code> or an index into the vector <code>colorcomp-data</code>, the actual color components. </p><div class="_attribution">
<p class="_attribution-p">
Copyright © 1990-1996, 1998-2022 Free Software Foundation, Inc. <br>Licensed under the GNU GPL license.<br>
<a href="https://www.gnu.org/software/emacs/manual/html_node/elisp/Abstract-Display-Example.html" class="_attribution-link">https://www.gnu.org/software/emacs/manual/html_node/elisp/Abstract-Display-Example.html</a>
</p>
</div>
|
