/[mcclim]/mcclim/Experimental/pointer-doc-hack.lisp
ViewVC logotype

Contents of /mcclim/Experimental/pointer-doc-hack.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (show annotations)
Sun Jan 27 22:24:07 2008 UTC (6 years, 2 months ago) by thenriksen
Branch: MAIN
CVS Tags: McCLIM-0-9-6, HEAD
Changes since 1.2: +45 -34 lines
Added some amazing hacks to pointer-documentation-panes for the notion of a "background message".

This is the beginning of extending pointer-documentation-panes into
more generally useful minibuffer-like panes.

For now, this just means that the Listener shows arglists and other
things for Drei commands. It's still a little flickery, though.
1 ;;; -*- Mode: Lisp; Package: CLIM-INTERNALS -*-
2
3 ;;; (c) copyright 2003 by Andy Hefner (andy.hefner@verizon.net)
4
5 ;;; This library is free software; you can redistribute it and/or
6 ;;; modify it under the terms of the GNU Library General Public
7 ;;; License as published by the Free Software Foundation; either
8 ;;; version 2 of the License, or (at your option) any later version.
9 ;;;
10 ;;; This library is distributed in the hope that it will be useful,
11 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
12 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13 ;;; Library General Public License for more details.
14 ;;;
15 ;;; You should have received a copy of the GNU Library General Public
16 ;;; License along with this library; if not, write to the
17 ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
18 ;;; Boston, MA 02111-1307 USA.
19
20
21 ;;; This hack gives you pretty graphical icons in the pointer documentation.
22
23 (in-package :clim-internals)
24
25
26 (defparameter *data-mouse-left* '(
27 #2A((0 0 0 0 0 1 1 1 2 3 4 5 6 7 8 9 10 0 0 0 0 0)
28 (0 0 0 11 12 13 14 15 16 17 18 19 20 21 22 22 23 24 25 0 0 0)
29 (0 0 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 0 0)
30 (0 1 44 45 46 47 48 31 49 19 50 51 19 37 52 53 54 55 41 56 57 0)
31 (1 58 59 60 61 62 63 64 65 66 50 19 67 68 41 69 66 70 71 72 73 74)
32 (1 75 76 77 78 79 80 81 82 36 83 83 67 68 84 85 85 16 85 86 87 88)
33 (89 90 91 92 93 94 95 81 69 50 50 51 67 40 96 97 98 99 100 101 102 103)
34 (104 105 106 107 108 109 110 111 112 69 82 113 113 114 115 116 117 41 23 118 102 43)
35 (104 119 120 121 122 123 81 31 124 49 17 124 125 21 96 16 86 22 126 127 87 43)
36 (128 129 130 121 131 132 65 113 82 53 71 133 69 112 125 41 134 135 136 56 137 25)
37 (1 138 139 121 121 140 67 33 121 121 83 36 50 132 141 37 84 142 136 143 144 145)
38 (146 52 147 121 121 54 83 121 148 148 121 36 50 67 53 149 116 16 126 87 150 25)
39 (151 98 121 121 121 152 83 121 148 148 121 19 51 67 53 65 85 153 22 154 155 25)
40 (156 97 157 121 121 55 36 121 148 148 121 33 66 71 82 114 21 41 49 115 56 25)
41 (74 115 158 121 159 160 33 121 148 148 121 50 67 133 20 49 96 85 34 66 161 145)
42 (162 134 36 34 163 18 66 121 148 148 121 67 164 82 40 85 41 165 121 166 167 43)
43 (0 25 96 33 33 70 133 121 148 148 121 168 53 112 49 32 85 169 121 170 171 0)
44 (0 25 172 116 17 17 20 121 148 148 121 113 65 124 32 16 124 173 168 174 145 0)
45 (0 0 24 142 175 21 98 121 148 148 121 121 121 121 153 38 16 175 136 176 0 0)
46 (0 0 176 118 134 170 177 121 148 148 148 148 148 148 121 126 178 179 180 181 0 0)
47 (0 0 0 182 183 184 185 121 148 148 148 148 148 148 121 186 187 5 171 0 0 0)
48 (0 0 0 0 188 136 189 121 121 121 121 121 121 121 136 143 5 176 0 0 0 0)
49 (0 0 0 0 0 190 7 191 135 127 127 189 186 191 73 192 176 0 0 0 0 0)
50 (0 0 0 0 0 0 0 8 7 193 193 2 9 190 194 0 0 0 0 0 0 0))
51
52 #(0 0 0 163 122 34 81 81 81 86 86 86 89 89 89 91 91 91 90 90 90 85 85 85 82 82
53 82 78 78 78 73 73 73 160 119 34 155 113 31 218 139 11 244 147 4 252 150 0 146
54 146 146 167 167 167 197 197 197 194 194 194 173 173 173 157 157 157 135 135
55 135 132 132 132 71 71 71 63 63 63 153 113 32 206 131 17 222 147 30 238 173 72
56 247 157 23 255 152 0 155 155 155 192 192 192 230 230 230 232 232 232 195 195
57 195 165 165 165 140 140 140 153 153 153 169 169 169 148 148 148 115 115 115
58 61 61 61 209 133 17 226 144 16 244 196 124 250 216 164 250 189 99 163 163 163
59 193 193 193 191 191 191 144 144 144 180 180 180 208 208 208 201 201 201 105
60 105 105 59 59 59 232 142 7 233 148 17 250 162 29 255 182 71 255 161 25 255
61 160 15 255 154 0 170 170 170 190 190 190 188 188 188 168 168 168 176 176 176
62 183 183 183 185 185 185 125 125 125 96 96 96 53 53 53 229 144 14 255 165 28
63 255 198 53 255 209 58 255 179 23 255 162 1 255 156 0 178 178 178 196 196 196
64 150 150 150 159 159 159 141 141 141 106 106 106 56 56 56 162 121 34 224 148
65 25 255 196 53 255 255 112 255 255 113 255 201 25 255 169 0 152 152 152 161
66 161 161 162 162 162 147 147 147 134 134 134 124 124 124 107 107 107 58 58 58
67 157 117 33 240 164 36 255 249 105 255 255 201 255 255 157 255 197 16 255 166
68 0 255 153 0 171 171 171 174 174 174 166 166 166 154 154 154 158 158 158 156
69 156 156 120 120 120 255 177 40 255 255 166 255 255 255 255 255 198 255 176 7
70 164 164 164 160 160 160 126 126 126 119 119 119 160 119 33 255 182 24 255 255
71 203 255 255 219 186 186 186 182 182 182 137 137 137 122 122 122 113 113 113
72 102 102 102 255 179 0 255 255 248 202 202 202 177 177 177 130 130 130 98 98
73 98 92 92 92 64 64 64 48 48 48 247 247 247 211 137 0 172 172 172 99 99 99 50
74 50 50 205 205 205 145 145 145 123 123 123 100 100 100 49 49 49 240 240 240
75 220 220 220 239 239 239 199 199 199 112 112 112 54 54 54 221 221 221 184 184
76 184 179 179 179 175 175 175 95 95 95 181 181 181 215 215 215 143 143 143 68
77 68 68 131 131 131 229 229 229 101 101 101 149 149 149 70 70 70 151 151 151
78 121 121 121 111 111 111 88 88 88 65 65 65 75 75 75 118 118 118 133 133 133
79 139 139 139 114 114 114 109 109 109 80 80 80 117 117 117 79 79 79 110 110 110
80 77 77 77 83 83 83 74 74 74)))
81
82
83 (defparameter *data-mouse-middle* '(
84 #2A((0 0 0 0 0 1 2 3 3 3 3 3 3 3 3 4 5 0 0 0 0 0)
85 (0 0 0 6 7 8 9 10 10 11 12 13 10 10 10 14 15 16 1 0 0 0)
86 (0 0 17 18 19 20 21 22 22 23 24 25 26 22 22 27 28 29 30 31 0 0)
87 (0 32 18 33 34 35 36 22 22 37 38 39 40 41 41 42 43 44 29 45 7 0)
88 (32 46 47 48 49 50 51 52 22 53 53 53 53 22 41 54 55 56 57 58 59 17)
89 (32 9 60 42 61 62 63 64 22 53 53 53 53 22 22 65 65 66 65 19 67 68)
90 (69 70 71 72 73 74 62 75 22 53 53 53 53 22 22 76 77 48 70 8 78 79)
91 (80 48 81 73 73 82 36 83 22 53 53 53 53 22 22 84 85 29 15 86 78 31)
92 (69 87 73 73 73 62 88 22 22 22 22 22 22 22 22 66 19 14 9 89 67 31)
93 (32 84 73 73 90 91 88 50 92 42 57 63 54 93 87 29 94 95 96 45 97 1)
94 (32 48 98 73 73 99 100 36 101 102 102 103 34 91 101 104 105 33 96 106 107 108)
95 (32 109 110 73 73 43 102 101 111 112 102 103 34 101 111 112 84 66 9 67 113 1)
96 (114 77 73 73 73 115 101 111 112 111 112 116 101 111 112 111 112 117 14 118 119 1)
97 (120 76 121 73 73 44 101 111 101 111 112 36 101 111 101 111 112 29 122 21 45 1)
98 (17 21 123 73 124 125 126 111 101 111 112 34 101 111 101 111 112 65 74 55 127 108)
99 (128 94 103 74 129 130 131 112 55 101 111 101 111 112 28 101 111 132 73 133 134 31)
100 (0 1 135 36 36 136 111 112 137 101 111 101 111 112 122 101 138 139 73 60 140 0)
101 (0 1 47 84 51 141 111 112 92 92 101 111 112 142 143 126 144 73 145 146 108 0)
102 (0 0 16 33 147 101 111 112 51 148 101 111 112 143 117 149 150 151 96 152 0 0)
103 (0 0 152 86 94 112 111 112 143 84 101 111 112 60 15 126 153 154 155 156 0 0)
104 (0 0 0 157 158 159 112 19 60 109 60 112 14 15 118 18 112 160 140 0 0 0)
105 (0 0 0 0 161 96 162 163 33 33 33 164 8 89 96 106 160 152 0 0 0 0)
106 (0 0 0 0 0 165 166 167 95 89 89 162 18 167 59 168 152 0 0 0 0 0)
107 (0 0 0 0 0 0 0 169 166 170 170 171 4 165 172 0 0 0 0 0 0 0))
108
109 #(3 3 3 63 63 63 69 69 69 15 127 219 78 78 78 73 73 73 55 55 55 59 59 59 124
110 124 124 126 126 126 37 145 247 39 146 247 104 179 249 93 173 249 135 135 135
111 132 132 132 71 71 71 53 53 53 114 114 114 141 141 141 172 172 172 154 154 154
112 68 158 255 111 180 255 190 221 255 195 224 255 106 177 255 153 153 153 169
113 169 169 148 148 148 115 115 115 61 61 61 48 48 48 130 130 130 193 193 193 218
114 218 218 192 192 192 98 173 255 81 164 255 79 163 255 94 171 255 69 158 255
115 180 180 180 208 208 208 201 201 201 105 105 105 111 111 111 131 131 131 147
116 147 147 179 179 179 174 174 174 167 167 167 69 160 255 43 166 255 176 176 176
117 190 190 190 183 183 183 185 185 185 125 125 125 96 96 96 143 143 143 203 203
118 203 197 197 197 182 182 182 70 163 255 159 159 159 146 146 146 106 106 106 56
119 56 56 47 47 47 134 134 134 173 173 173 235 235 235 255 255 255 230 230 230 69
120 162 255 161 161 161 162 162 162 107 107 107 58 58 58 46 46 46 211 211 211 229
121 229 229 68 159 255 158 158 158 156 156 156 120 120 120 160 160 160 170 170
122 170 119 119 119 254 254 254 186 186 186 178 178 178 171 171 171 137 137 137
123 122 122 122 113 113 113 102 102 102 234 234 234 202 202 202 188 188 188 193
124 210 255 196 196 196 195 195 195 165 165 165 150 150 150 98 98 98 92 92 92 64
125 64 64 144 144 144 247 247 247 50 125 255 150 183 255 99 99 99 50 50 50 205
126 205 205 194 194 194 145 145 145 123 123 123 100 100 100 49 49 49 240 240 240
127 163 163 163 220 220 220 239 239 239 199 199 199 194 211 255 112 112 112 54 54
128 54 221 221 221 209 227 255 50 126 255 198 242 255 175 175 175 95 95 95 152
129 152 152 202 220 255 187 187 187 56 141 255 252 255 255 68 68 68 195 212 255
130 164 164 164 155 155 155 61 154 255 181 181 181 101 101 101 149 149 149 168
131 168 168 197 215 255 58 145 255 196 240 255 70 70 70 52 130 255 156 191 255 88
132 88 88 65 65 65 75 75 75 118 118 118 133 133 133 91 91 91 80 80 80 117 117 117
133 129 129 129 127 127 127 79 79 79 85 85 85 110 110 110 77 77 77 82 82 82 83 83
134 83 81 81 81 74 74 74)))
135
136 (defparameter *data-mouse-right* '(
137 #2A((0 0 0 0 0 1 2 3 4 5 6 7 8 9 10 10 10 0 0 0 0 0)
138 (0 0 0 11 12 13 14 15 16 17 18 19 20 21 22 22 22 10 10 0 0 0)
139 (0 0 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 10 0 0)
140 (0 40 24 41 42 43 30 44 45 19 42 46 19 34 47 48 49 50 51 52 10 0)
141 (40 53 54 44 55 56 17 29 57 58 42 19 59 60 61 62 63 64 65 66 39 10)
142 (40 14 67 68 69 18 70 34 71 33 72 72 59 60 73 74 75 76 77 78 39 10)
143 (79 80 20 81 82 31 18 17 83 42 42 46 59 84 73 85 86 87 88 89 90 10)
144 (91 44 92 82 82 93 30 34 94 83 71 56 56 95 73 73 96 97 98 99 90 10)
145 (79 100 82 82 82 18 57 34 101 45 17 101 100 21 73 73 102 103 104 105 106 10)
146 (40 107 82 82 108 109 57 56 71 68 110 70 83 94 100 111 73 73 112 89 39 10)
147 (40 44 113 82 82 114 59 115 115 115 115 115 115 115 116 34 117 41 35 22 39 10)
148 (40 118 119 82 82 120 72 115 10 10 10 10 10 10 115 26 107 16 14 121 122 1)
149 (123 124 82 82 82 125 72 115 10 10 10 10 10 10 10 115 126 127 128 129 130 1)
150 (131 132 133 82 82 134 33 115 10 10 115 115 115 10 10 115 21 111 45 27 135 1)
151 (23 27 136 82 137 138 30 115 10 10 115 115 115 10 10 115 139 126 31 58 140 141)
152 (142 143 33 31 144 18 58 115 10 10 10 10 10 10 10 115 111 55 82 145 146 147)
153 (0 1 139 30 30 148 70 115 10 10 10 10 10 10 115 29 126 149 82 67 150 0)
154 (0 1 54 107 17 17 20 115 10 10 10 10 10 115 29 16 101 93 151 152 141 0)
155 (0 0 153 41 154 21 124 115 10 10 115 10 10 10 115 155 16 154 156 157 0 0)
156 (0 0 157 158 143 67 159 115 10 10 115 115 10 10 10 160 161 53 162 163 0 0)
157 (0 0 0 3 164 165 28 115 10 10 115 155 115 10 10 115 166 7 150 0 0 0)
158 (0 0 0 0 167 156 168 115 115 115 115 15 13 115 115 115 7 157 0 0 0 0)
159 (0 0 0 0 0 169 9 170 171 172 172 168 24 170 173 174 157 0 0 0 0 0)
160 (0 0 0 0 0 0 0 175 9 176 176 4 177 169 178 0 0 0 0 0 0 0))
161
162 #(3 3 3 63 63 63 69 69 69 75 75 75 81 81 81 86 86 86 89 89 89 91 91 91 90 90 90
163 85 85 85 90 6 216 55 55 55 59 59 59 124 124 124 126 126 126 127 127 127 146
164 146 146 167 167 167 197 197 197 194 194 194 173 173 173 157 157 157 136 57
165 255 53 53 53 114 114 114 141 141 141 172 172 172 154 154 154 139 139 139 155
166 155 155 192 192 192 230 230 230 232 232 232 195 195 195 165 165 165 143 45
167 255 147 53 255 157 93 255 147 75 255 114 20 255 48 48 48 130 130 130 193 193
168 193 218 218 218 147 147 147 163 163 163 191 191 191 143 52 254 175 110 253
169 202 160 254 198 159 255 143 67 254 112 23 246 111 111 111 131 131 131 179 179
170 179 174 174 174 170 170 170 190 190 190 188 188 188 168 168 168 145 62 253
171 168 102 252 180 122 253 180 124 253 185 139 253 126 41 255 143 143 143 180
172 180 180 203 203 203 182 182 182 178 178 178 196 196 196 153 92 255 151 86 253
173 147 67 253 141 56 253 162 99 254 149 81 254 47 47 47 134 134 134 235 235 235
174 255 255 255 176 176 176 169 169 169 153 91 255 152 82 255 144 62 255 141 58
175 255 136 56 255 115 21 255 46 46 46 211 211 211 229 229 229 171 171 171 166
176 166 166 153 88 255 148 74 255 141 57 255 132 47 255 160 160 160 164 164 164
177 151 91 253 150 85 255 143 55 255 133 51 255 114 21 255 158 158 158 254 254
178 254 186 186 186 185 185 185 148 148 148 143 51 254 234 234 234 202 202 202
179 220 202 247 177 177 177 150 150 150 144 144 144 247 247 247 208 208 208 106
180 106 106 99 99 99 50 50 50 162 162 162 205 205 205 159 159 159 145 145 145 135
181 135 135 123 123 123 100 100 100 49 49 49 161 161 161 240 240 240 201 201 201
182 105 105 105 220 220 220 239 239 239 199 199 199 152 152 152 112 112 112 64 64
183 64 54 54 54 137 137 137 221 221 221 175 175 175 95 95 95 61 61 61 183 183 183
184 215 215 215 68 68 68 181 181 181 101 101 101 71 71 71 149 149 149 140 140 140
185 113 113 113 70 70 70 120 120 120 151 151 151 221 203 248 121 121 121 88 88 88
186 65 65 65 118 118 118 133 133 133 109 109 109 80 80 80 117 117 117 79 79 79
187 110 110 110 122 122 122 119 119 119 96 96 96 77 77 77 82 82 82 83 83 83 78 78
188 78 74 74 74)))
189
190
191
192
193
194
195 (defun kludge-design (data)
196 (let* ((colormap (second data))
197 (designs (make-array (/ (length colormap ) 3))))
198 (loop for i from 0 below (/ (length colormap) 3)
199 do (setf (aref designs i) (make-rgb-color (/ (aref colormap (+ 0 (* i 3))) 256.0)
200 (/ (aref colormap (+ 1 (* i 3))) 256.0)
201 (/ (aref colormap (+ 2 (* i 3))) 256.0))))
202 (make-pattern (first data) designs)))
203
204
205 (defparameter *icon-mouse-left* (kludge-design *data-mouse-left*))
206 (defparameter *icon-mouse-middle* (kludge-design *data-mouse-middle*))
207 (defparameter *icon-mouse-right* (kludge-design *data-mouse-right*))
208
209
210
211
212 (defmethod frame-print-pointer-documentation
213 ((frame standard-application-frame) input-context stream state event)
214 (unless state
215 (return-from frame-print-pointer-documentation nil))
216 (destructuring-bind (current-modifier new-translators)
217 state
218 (let ((x (device-event-x event))
219 (y (device-event-y event))
220 (pstream *pointer-documentation-output*))
221 (if (null new-translators)
222 (when (and (background-message pstream)
223 (not (record-on-display pstream (background-message pstream))))
224 (cond ((> (get-universal-time)
225 (+ (background-message-time pstream)
226 *background-message-minimum-lifetime*))
227 (setf (background-message pstream) nil))
228 (t
229 (setf (output-record-parent (background-message pstream)) nil)
230 (stream-add-output-record pstream (background-message pstream))
231 (replay (background-message pstream) pstream))))
232 (loop for (button presentation translator context)
233 in new-translators
234 for name = (cadr (assoc button +button-documentation+))
235 for first-one = t then nil
236 do (progn
237 (unless first-one
238 (stream-increment-cursor-position pstream 12 0)
239 #+nil(write-string "; " pstream))
240 (unless (zerop current-modifier)
241 (print-modifiers pstream current-modifier :short)
242 (write-string "-" pstream))
243
244 ;; Hefner's pointer-documentation hack.
245 (setf name (cond
246 ((eql button +pointer-left-button+) *icon-mouse-left*)
247 ((eql button +pointer-middle-button+) *icon-mouse-middle*)
248 ((eql button +pointer-right-button+) *icon-mouse-right*)
249 (t name)))
250 (if (not (typep name 'indexed-pattern)) (format pstream "~A: " name)
251 (multiple-value-bind (x y) (stream-cursor-position pstream)
252 (draw-pattern* pstream name x y)
253 (stream-increment-cursor-position pstream 24 0)))
254
255 (document-presentation-translator translator
256 presentation
257 (input-context-type context)
258 *application-frame*
259 event
260 stream
261 x y
262 :stream pstream
263 :documentation-type
264 :pointer)) ))
265 ;finally nil #+nil (when new-translators
266 ; (write-char #\. pstream)))
267 ;; Wasteful to do this after doing
268 ;; find-innermost-presentation-context above... look at doing this
269 ;; first and then doing the innermost test.
270 (let ((all-translators (find-applicable-translators
271 (stream-output-history stream)
272 input-context
273 *application-frame*
274 stream
275 x y
276 :for-menu t))
277 (other-modifiers nil))
278 (loop for (translator) in all-translators
279 for gesture = (gesture translator)
280 unless (eq gesture t)
281 do (loop for (name type modifier) in gesture
282 unless (eql modifier current-modifier)
283 do (pushnew modifier other-modifiers)))
284 (when other-modifiers
285 (setf other-modifiers (sort other-modifiers #'cmp-modifiers))
286 (terpri pstream)
287 (write-string "To see other commands, press " pstream)
288 (loop for modifier-tail on other-modifiers
289 for (modifier) = modifier-tail
290 for count from 0
291 do (progn
292 (if (null (cdr modifier-tail))
293 (progn
294 (when (> count 1)
295 (write-char #\, pstream))
296 (when (> count 0)
297 (write-string " or " pstream)))
298 (when (> count 0)
299 (write-string ", " pstream)))
300 (print-modifiers pstream modifier :long)))
301 (write-char #\. pstream))))))

  ViewVC Help
Powered by ViewVC 1.1.5