Mercurial > emacs
annotate lisp/strokes.el @ 89172:0da59936bc31
Comment fix.
author | Dave Love <fx@gnu.org> |
---|---|
date | Sun, 06 Oct 2002 21:16:08 +0000 |
parents | ae3e8c9e9b87 |
children | 0fb0ba55467e |
rev | line source |
---|---|
19347 | 1 ;;; strokes.el --- control Emacs through mouse strokes |
19345 | 2 |
43233
ae3e8c9e9b87
(strokes-do-stroke, strokes-do-complex-stroke): Doc fix.
Pavel Janík <Pavel@Janik.cz>
parents:
41603
diff
changeset
|
3 ;; Copyright (C) 1997, 2000, 2002 Free Software Foundation, Inc. |
19345 | 4 |
27975
ede0e764fc12
Change maintainer's mail address.
Gerd Moellmann <gerd@gnu.org>
parents:
19897
diff
changeset
|
5 ;; Author: David Bakhash <cadet@alum.mit.edu> |
ede0e764fc12
Change maintainer's mail address.
Gerd Moellmann <gerd@gnu.org>
parents:
19897
diff
changeset
|
6 ;; Maintainer: David Bakhash <cadet@alum.mit.edu> |
19345 | 7 ;; Keywords: lisp, mouse, extensions |
8 | |
9 ;; This file is part of GNU Emacs. | |
10 | |
11 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
12 ;; it under the terms of the GNU General Public License as published by | |
13 ;; the Free Software Foundation; either version 2, or (at your option) | |
14 ;; any later version. | |
15 | |
16 ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 ;; GNU General Public License for more details. | |
20 | |
21 ;; You should have received a copy of the GNU General Public License | |
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
24 ;; Boston, MA 02111-1307, USA. | |
25 | |
26 ;;; Commentary: | |
27 | |
28 ;; This is the strokes package. It is intended to allow the user to | |
29 ;; control Emacs by means of mouse strokes. Once strokes is loaded, you | |
30 ;; can always get help be invoking `strokes-help': | |
31 | |
32 ;; > M-x strokes-help | |
33 | |
34 ;; and you can learn how to use the package. A mouse stroke, for now, | |
35 ;; can be defined as holding the middle button, for instance, and then | |
36 ;; moving the mouse in whatever pattern you wish, which you have set | |
37 ;; Emacs to understand as mapping to a given command. For example, you | |
38 ;; may wish the have a mouse stroke that looks like a capital `C' which | |
39 ;; means `copy-region-as-kill'. Treat strokes just like you do key | |
40 ;; bindings. For example, Emacs sets key bindings globally with the | |
41 ;; `global-set-key' command. Likewise, you can do | |
42 | |
43 ;; > M-x global-set-stroke | |
44 | |
45 ;; to interactively program in a stroke. It would be wise to set the | |
46 ;; first one to this very command, so that from then on, you invoke | |
47 ;; `global-set-stroke' with a stroke. likewise, there may eventually | |
48 ;; be a `local-set-stroke' command, also analogous to `local-set-key'. | |
49 | |
50 ;; You can always unset the last stroke definition with the command | |
51 | |
52 ;; > M-x strokes-unset-last-stroke | |
53 | |
54 ;; and the last stroke that was added to `strokes-global-map' will be | |
55 ;; removed. | |
56 | |
57 ;; Other analogies between strokes and key bindings are as follows: | |
58 | |
59 ;; 1) To describe a stroke binding, you can type | |
60 | |
61 ;; > M-x describe-stroke | |
62 | |
63 ;; analogous to `describe-key'. It's also wise to have a stroke, | |
64 ;; like an `h', for help, or a `?', mapped to `describe-stroke'. | |
65 | |
66 ;; 2) stroke bindings are set internally through the Lisp function | |
67 ;; `define-stroke', similar to the `define-key' function. some | |
68 ;; examples for a 3x3 stroke grid would be | |
69 | |
70 ;; (define-stroke c-mode-stroke-map | |
71 ;; '((0 . 0) (1 . 1) (2 . 2)) | |
72 ;; 'kill-region) | |
73 ;; (define-stroke strokes-global-map | |
74 ;; '((0 . 0) (0 . 1) (0 . 2) (1 . 2) (2 . 2)) | |
75 ;; 'list-buffers) | |
76 | |
77 ;; however, if you would probably just have the user enter in the | |
78 ;; stroke interactively and then set the stroke to whatever he/she | |
79 ;; entered. The Lisp function to interactively read a stroke is | |
80 ;; `strokes-read-stroke'. This is especially helpful when you're | |
81 ;; on a fast computer that can handle a 9x9 stroke grid. | |
82 | |
83 ;; NOTE: only global stroke bindings are currently implemented, | |
84 ;; however mode- and buffer-local stroke bindings may eventually | |
85 ;; be implemented in a future version. | |
86 | |
87 ;; The important variables to be aware of for this package are listed | |
88 ;; below. They can all be altered through the customizing package via | |
89 | |
90 ;; > M-x customize | |
91 | |
92 ;; and customizing the group named `strokes'. You can also read | |
93 ;; documentation on the variables there. | |
94 | |
95 ;; `strokes-minimum-match-score' (determines the threshold of error that | |
31640
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
96 ;; makes a stroke acceptable or unacceptable. If your strokes aren't |
19345 | 97 ;; matching, then you should raise this variable. |
98 | |
99 ;; `strokes-grid-resolution' (determines the grid dimensions that you use | |
100 ;; when defining/reading strokes. The finer the grid your computer can | |
101 ;; handle, the more you can do, but even a 3x3 grid is pretty cool.) | |
43233
ae3e8c9e9b87
(strokes-do-stroke, strokes-do-complex-stroke): Doc fix.
Pavel Janík <Pavel@Janik.cz>
parents:
41603
diff
changeset
|
102 ;; The default value (9) should be fine for most decent computers. |
19345 | 103 ;; NOTE: This variable should not be set to a number less than 3. |
104 | |
105 ;; `strokes-display-strokes-buffer' will allow you to hide the strokes | |
106 ;; buffer when doing simple strokes. This is a speedup for slow | |
107 ;; computers as well as people who don't want to see their strokes. | |
108 | |
109 ;; If you find that your mouse is accelerating too fast, you can | |
110 ;; execute the UNIX X command to slow it down. A good possibility is | |
111 | |
112 ;; % xset m 5/4 8 | |
113 | |
114 ;; which seems, heuristically, to work okay, without much disruption. | |
115 | |
116 ;; Whenever you load in the strokes package, you will be able to save | |
117 ;; what you've done upon exiting Emacs. You can also do | |
118 | |
119 ;; > M-x save-strokes | |
120 | |
121 ;; and it will save your strokes in ~/.strokes, or you may wish to change | |
122 ;; this by setting the variable `strokes-file'. | |
123 | |
124 ;; Note that internally, all of the routines that are part of this | |
125 ;; package are able to deal with complex strokes, as they are a superset | |
126 ;; of simple strokes. However, the default of this package will map | |
127 ;; mouse button2 to the command `strokes-do-stroke', and NOT | |
128 ;; `strokes-do-complex-stroke'. If you wish to use complex strokes, you | |
129 ;; will have to override this key mapping. Complex strokes are terminated | |
130 ;; with mouse button3. The strokes package will not interfere with | |
131 ;; `mouse-yank', but you may want to examine how this is done (see the | |
132 ;; variable `strokes-click-command') | |
133 | |
134 ;; To get strokes to work as part of your your setup, then you'll have | |
135 ;; put the strokes package in your load-path (preferably byte-compiled) | |
136 ;; and then add the following to your .emacs file (or wherever | |
137 ;; you put Emacs-specific startup preferences): | |
138 | |
31640
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
139 ;;(and window-system |
19345 | 140 ;; (require 'strokes)) |
141 | |
142 ;; Once loaded, you can start stroking. You can also toggle between | |
143 ;; strokes mode by simple typing | |
144 | |
145 ;; > M-x strokes-mode | |
146 | |
147 ;; I am now in the process of porting this package to Emacs. I also hope | |
148 ;; that, with the help of others, this package will be useful in entering | |
149 ;; in pictographic-like language text using the mouse (i.e. Korean). | |
150 ;; Japanese and Chinese are a bit trickier, but I'm sure that with help | |
151 ;; it can be done. The next version will allow the user to enter strokes | |
152 ;; which "remove the pencil from the paper" so to speak, so one character | |
153 ;; can have multiple strokes. | |
154 | |
155 ;; You can read more about strokes at: | |
156 | |
157 ;; http://www.mit.edu/people/cadet/strokes-help.html | |
158 | |
159 ;; If you're interested in using strokes for writing English into Emacs | |
160 ;; using strokes, then you'll want to read about it on the web page above | |
161 ;; or just download from http://www.mit.edu/people/cadet/strokes-abc.el, | |
162 ;; which is nothing but a file with some helper commands for inserting | |
163 ;; alphanumerics and punctuation. | |
164 | |
31640
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
165 ;; Great thanks to Rob Ristroph for his generosity in letting me use |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
166 ;; his PC to develop this, Jason Johnson for his help in algorithms, |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
167 ;; Euna Kim for her help in Korean, and massive thanks to the helpful |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
168 ;; guys on the help instance on athena (zeno, jered, amu, gsstark, |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
169 ;; ghudson, etc) Special thanks to Steve Baur, Kyle Jones, and Hrvoje |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
170 ;; Niksic for all their help. And special thanks to Dave Gillespie |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
171 ;; for all the elisp help--he is responsible for helping me use the cl |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
172 ;; macros at (near) max speed. |
19345 | 173 |
174 ;; Tasks: (what I'm getting ready for future version)... | |
175 ;; 2) use 'strokes-read-complex-stroke for korean, etc. | |
176 ;; 4) buffer-local 'strokes-local-map, and mode-stroke-maps would be nice | |
177 ;; 6) add some hooks, like `strokes-read-stroke-hook' | |
178 ;; 7) See what people think of the factory settings. Should I change | |
179 ;; them? They're all pretty arbitrary in a way. I guess they | |
180 ;; should be minimal, but computers are getting lots faster, and | |
181 ;; if I choose the defaults too conservatively, then strokes will | |
31640
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
182 ;; surely disappoint some people on decent machines (until they |
19345 | 183 ;; figure out M-x customize). I need feedback. |
184 ;; Other: I always have the most beta version of strokes, so if you | |
185 ;; want it just let me know. | |
186 | |
187 ;;; Code: | |
188 | |
189 ;;; Requirements and provisions... | |
190 | |
191 (autoload 'mail-position-on-field "sendmail") | |
31640
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
192 (eval-when-compile (require 'cl)) |
19345 | 193 |
194 ;;; Constants... | |
195 | |
31640
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
196 (defconst strokes-version "2.4-Emacs") |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
197 |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
198 (defconst strokes-bug-address "cadet@alum.mit.edu") |
19345 | 199 |
31640
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
200 (defconst strokes-lift :strokes-lift |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
201 "Symbol representing a stroke lift event for complex strokes. |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
202 Complex strokes are those which contain two or more simple strokes.") |
19345 | 203 |
31640
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
204 (defconst strokes-xpm-header "/* XPM */ |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
205 static char * stroke_xpm[] = { |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
206 /* width height ncolors cpp [x_hot y_hot] */ |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
207 \"33 33 9 1 26 23\", |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
208 /* colors */ |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
209 \" c none s none\", |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
210 \"* c #000000 s foreground\", |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
211 \"R c #FFFF00000000\", |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
212 \"O c #FFFF80000000\", |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
213 \"Y c #FFFFFFFF0000\", |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
214 \"G c #0000FFFF0000\", |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
215 \"B c #00000000FFFF\", |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
216 \"P c #FFFF0000FFFF\", |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
217 \". c #45458B8B0000\", |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
218 /* pixels */\n" |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
219 "The header to all xpm buffers created by strokes") |
19345 | 220 |
221 ;;; user variables... | |
222 | |
223 (defgroup strokes nil | |
224 "Control Emacs through mouse strokes" | |
31640
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
225 :link '(url-link "http://www.mit.edu/people/cadet/strokes-help.html") |
19345 | 226 :group 'mouse) |
227 | |
228 (defcustom strokes-modeline-string " Strokes" | |
31640
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
229 "*Modeline identification when strokes-mode is on \(default is \" Strokes\"\)." |
19345 | 230 :type 'string |
231 :group 'strokes) | |
232 | |
233 (defcustom strokes-character ?@ | |
234 "*Character used when drawing strokes in the strokes buffer. | |
31640
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
235 \(The default is `@', which works well.\)" |
19345 | 236 :type 'character |
237 :group 'strokes) | |
238 | |
239 (defcustom strokes-minimum-match-score 1000 | |
240 "*Minimum score for a stroke to be considered a possible match. | |
31640
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
241 Setting this variable to 0 would require a perfectly precise match. |
19345 | 242 The default value is 1000, but it's mostly dependent on how precisely |
243 you manage to replicate your user-defined strokes. It also depends on | |
244 the value of `strokes-grid-resolution', since a higher grid resolution | |
245 will correspond to more sample points, and thus more distance | |
246 measurements. Usually, this is not a problem since you first set | |
247 `strokes-grid-resolution' based on what your computer seems to be able | |
248 to handle (though the defaults are usually more than sufficent), and | |
249 then you can set `strokes-minimum-match-score' to something that works | |
250 for you. The only purpose of this variable is to insure that if you | |
251 do a bogus stroke that really doesn't match any of the predefined | |
252 ones, then strokes should NOT pick the one that came closest." | |
253 :type 'integer | |
254 :group 'strokes) | |
255 | |
256 (defcustom strokes-grid-resolution 9 | |
257 "*Integer defining dimensions of the stroke grid. | |
258 The grid is a square grid, where STROKES-GRID-RESOLUTION defaults to | |
259 `9', making a 9x9 grid whose coordinates go from (0 . 0) on the top | |
260 left to ((STROKES-GRID-RESOLUTION - 1) . (STROKES-GRID-RESOLUTION - 1)) | |
261 on the bottom right. The greater the resolution, the more intricate | |
262 your strokes can be. | |
263 NOTE: This variable should be odd and MUST NOT be less than 3 and need | |
264 not be greater than 33, which is the resolution of the pixmaps. | |
265 WARNING: Changing the value of this variable will gravely affect the | |
266 strokes you have already programmed in. You should try to | |
267 figure out what it should be based on your needs and on how | |
268 quick the particular platform(s) you're operating on, and | |
269 only then start programming in your custom strokes." | |
270 :type 'integer | |
271 :group 'strokes) | |
272 | |
30540
ed5f60298be9
(strokes-file): Run the file name through
Eli Zaretskii <eliz@gnu.org>
parents:
27975
diff
changeset
|
273 (defcustom strokes-file (convert-standard-filename "~/.strokes") |
19345 | 274 "*File containing saved strokes for stroke-mode (default is ~/.strokes)." |
275 :type 'file | |
276 :group 'strokes) | |
277 | |
278 (defcustom strokes-buffer-name " *strokes*" | |
279 "The buffer that the strokes take place in (default is ` *strokes*')." | |
280 :type 'string | |
281 :group 'strokes) | |
282 | |
283 (defcustom strokes-use-strokes-buffer t | |
284 "*If non-nil, the strokes buffer is used and strokes are displayed. | |
285 If nil, strokes will be read the same, however the user will not be | |
286 able to see the strokes. This be helpful for people who don't like | |
287 the delay in switching to the strokes buffer." | |
288 :type 'boolean | |
289 :group 'strokes) | |
290 | |
291 (defcustom strokes-click-command 'mouse-yank-at-click | |
292 "*Command to execute when stroke is actually a `click' event. | |
19897
d9bb216aa23f
(strokes-click-command): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
19347
diff
changeset
|
293 This is set to `mouse-yank-at-click' by default." |
19345 | 294 :type 'function |
295 :group 'strokes) | |
296 | |
297 ;;; internal variables... | |
298 | |
31640
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
299 ;; This is an internal variable, but we defcustom it so Customize can |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
300 ;; use it. |
19345 | 301 ;;;###autoload |
31640
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
302 (defcustom strokes-mode nil |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
303 "Non-nil when `strokes' is globally enabled. |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
304 Setting this variable directly does not take effect. Use either Customize |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
305 or M-x strokes-mode." |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
306 :type 'boolean |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
307 :set (lambda (symbol value) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
308 (strokes-mode (or value 0))) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
309 :initialize 'custom-initialize-default |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
310 :require 'strokes |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
311 :version "21.1" |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
312 :group 'strokes) |
19345 | 313 |
314 (defvar strokes-window-configuration nil | |
315 "The special window configuration used when entering strokes. | |
316 This is set properly in the function `strokes-update-window-configuration'.") | |
317 | |
318 (defvar strokes-last-stroke nil | |
319 "Last stroke entered by the user. | |
320 Its value gets set every time the function | |
321 `strokes-fill-stroke' gets called, | |
322 since that is the best time to set the variable") | |
323 | |
324 (defvar strokes-global-map '() | |
325 "Association list of strokes and their definitions. | |
326 Each entry is (STROKE . COMMAND) where STROKE is itself a list of | |
327 coordinates (X . Y) where X and Y are lists of positions on the | |
328 normalized stroke grid, with the top left at (0 . 0). COMMAND is the | |
329 corresponding interactive function") | |
330 | |
331 (defvar strokes-load-hook nil | |
332 "Function or functions to be called when `strokes' is loaded.") | |
333 | |
31640
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
334 ;;; ### NOT IMPLEMENTED YET ### |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
335 ;;(defvar edit-strokes-menu |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
336 ;; '("Edit-Strokes" |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
337 ;; ["Add stroke..." strokes-global-set-stroke t] |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
338 ;; ["Delete stroke..." strokes-edit-delete-stroke t] |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
339 ;; ["Change stroke" strokes-smaller t] |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
340 ;; ["Change definition" strokes-larger t] |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
341 ;; ["[Re]List Strokes chronologically" strokes-list-strokes t] |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
342 ;; ["[Re]List Strokes alphabetically" strokes-list-strokes t] |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
343 ;; ["Quit" strokes-edit-quit t] |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
344 ;; )) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
345 |
19345 | 346 ;;; Macros... |
347 | |
31640
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
348 (defmacro strokes-while-inhibiting-garbage-collector (&rest forms) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
349 "Execute FORMS without interference from the garbage collector." |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
350 `(let ((gc-cons-threshold 134217727)) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
351 ,@forms)) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
352 |
19345 | 353 (defsubst strokes-click-p (stroke) |
354 "Non-nil if STROKE is really click." | |
19347 | 355 (< (length stroke) 2)) |
19345 | 356 |
357 ;;; old, but worked pretty good (just in case)... | |
358 ;;(defmacro strokes-define-stroke (stroke-map stroke def) | |
359 ;; "Add STROKE to STROKE-MAP alist with given command DEF" | |
19347 | 360 ;; (list 'if (list '< (list 'length stroke) 2) |
19345 | 361 ;; (list 'error |
362 ;; "That's a click, not a stroke. See `strokes-click-command'") | |
363 ;; (list 'setq stroke-map (list 'cons (list 'cons stroke def) | |
364 ;; (list 'remassoc stroke stroke-map))))) | |
365 | |
366 (defsubst strokes-remassoc (key list) | |
31640
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
367 (let (elt) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
368 (while (setq elt (assoc key list)) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
369 (setq list (delete elt list)))) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
370 list) |
19345 | 371 |
372 (defmacro strokes-define-stroke (stroke-map stroke def) | |
373 "Add STROKE to STROKE-MAP alist with given command DEF." | |
374 `(if (strokes-click-p ,stroke) | |
375 (error "That's a click, not a stroke; see `strokes-click-command'") | |
376 (setq ,stroke-map (cons (cons ,stroke ,def) | |
377 (strokes-remassoc ,stroke ,stroke-map))))) | |
378 | |
379 (defalias 'define-stroke 'strokes-define-stroke) | |
380 | |
381 (defsubst strokes-square (x) | |
382 "Returns the square of the number X" | |
383 (* x x)) | |
384 | |
385 (defsubst strokes-distance-squared (p1 p2) | |
386 "Gets the distance (squared) between to points P1 and P2. | |
387 P1 and P2 are cons cells in the form (X . Y)." | |
388 (let ((x1 (car p1)) | |
389 (y1 (cdr p1)) | |
390 (x2 (car p2)) | |
391 (y2 (cdr p2))) | |
392 (+ (strokes-square (- x2 x1)) | |
393 (strokes-square (- y2 y1))))) | |
394 | |
395 ;;; Advice for various functions... | |
396 | |
397 ;; I'd originally wanted to write a macro that would just take in the | |
398 ;; generic functions which use mouse button2 in various modes. Most of | |
399 ;; them are identical in form: they take an event as the single argument | |
400 ;; and then do their thing. I tried writing a macro that looked | |
401 ;; something like this, but failed. Advice just ain't that easy. The | |
402 ;; one that bugged me the most was `Manual-follow-xref', because that had | |
403 ;; &rest arguments, and I didn't know how to work around it in defadvice. | |
404 ;; However, I was able to fix up most of the important modes (i.e. the | |
405 ;; ones I use all the time). One `bug' in the program that I just can't | |
406 ;; seem to figure out is why I can only advise other button2 functions | |
407 ;; successfully when the variable `strokes-use-strokes-buffer' is nil. I | |
408 ;; did all the save-excursion/save-window-excursion stuff SPECIFICALLY so | |
409 ;; that using the strokes buffer or not would absolutely not affect any | |
410 ;; other part of the program. If someone can figure out how to make the | |
411 ;; following advices work w/ regardless of that variable | |
412 ;; `strokes-use-strokes-buffer', then that would be a great victory. If | |
413 ;; someone out there would be kind enough to make the commented code | |
414 ;; below work, I'd be grateful. By the way, I put the `protect' keywords | |
415 ;; there to insure that if a stroke went bad, then | |
416 ;; `strokes-click-command' would be set back. If this isn't necessary, | |
417 ;; then feel free to let me know. | |
418 | |
419 ;; For what follows, I really wanted something that would work like this: | |
420 | |
421 ;;(strokes-fix-button2 'vm-mouse-button-2) | |
422 | |
423 ;; Or even better, I could have simply done something like: | |
424 | |
425 ;;(mapcar 'strokes-fix-button2 | |
426 ;; '(vm-mouse-button-2 | |
427 ;; rmail-summary-mouse-goto-msg | |
428 ;; <rest of them>)) | |
429 | |
430 ;;; With help from Hans (author of advice.el)... | |
431 (defmacro strokes-fix-button2-command (command) | |
432 "Fix COMMAND so that it can also work with strokes. | |
433 COMMAND must take one event argument. | |
434 Example of how one might fix up a command that's bound to button2 | |
435 and which is an interactive funcion of one event argument: | |
436 | |
437 \(strokes-fix-button2-command 'rmail-summary-mouse-goto-msg)" | |
438 (let ((command (eval command))) | |
439 `(progn | |
440 (defadvice ,command (around strokes-fix-button2 compile preactivate) | |
441 ,(format "Fix %s to work with strokes." command) | |
31640
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
442 (let ((strokes-click-command |
19345 | 443 ',(intern (format "ad-Orig-%s" command)))) |
31640
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
444 (strokes-do-stroke (ad-get-arg 0))))))) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
445 |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
446 (defvar strokes-insinuated nil) |
19345 | 447 |
31640
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
448 (defun strokes-insinuate () |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
449 "Insinuate Emacs with strokes advices." |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
450 (unless strokes-insinuated |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
451 (strokes-fix-button2-command 'vm-mouse-button-2) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
452 (strokes-fix-button2-command 'rmail-summary-mouse-goto-msg) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
453 (strokes-fix-button2-command 'Buffer-menu-mouse-select) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
454 (strokes-fix-button2-command 'w3-widget-button-click) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
455 (strokes-fix-button2-command 'widget-image-button-press) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
456 (strokes-fix-button2-command 'Info-follow-clicked-node) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
457 (strokes-fix-button2-command 'compile-mouse-goto-error) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
458 (strokes-fix-button2-command 'gdbsrc-select-or-yank) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
459 (strokes-fix-button2-command 'hypropos-mouse-get-doc) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
460 (strokes-fix-button2-command 'gnus-mouse-pick-group) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
461 (strokes-fix-button2-command 'gnus-mouse-pick-article) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
462 (strokes-fix-button2-command 'gnus-article-push-button) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
463 (strokes-fix-button2-command 'dired-mouse-find-file) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
464 (strokes-fix-button2-command 'url-dired-find-file-mouse) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
465 (strokes-fix-button2-command 'dired-u-r-mouse-toggle) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
466 (strokes-fix-button2-command 'dired-u-w-mouse-toggle) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
467 (strokes-fix-button2-command 'dired-u-x-mouse-toggle) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
468 (strokes-fix-button2-command 'dired-g-r-mouse-toggle) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
469 (strokes-fix-button2-command 'dired-g-w-mouse-toggle) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
470 (strokes-fix-button2-command 'dired-g-x-mouse-toggle) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
471 (strokes-fix-button2-command 'dired-o-r-mouse-toggle) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
472 (strokes-fix-button2-command 'dired-o-w-mouse-toggle) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
473 (strokes-fix-button2-command 'isearch-yank-x-selection) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
474 (strokes-fix-button2-command 'occur-mode-mouse-goto) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
475 (strokes-fix-button2-command 'cvs-mouse-find-file) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
476 (setq strokes-insinuated t))) |
19345 | 477 |
478 ;;; I can fix the customize widget button click, but then | |
479 ;;; people will get confused when they try to customize | |
480 ;;; strokes with the mouse and customize tells them that | |
481 ;;; `strokes-click-command' is mapped to `ad-Orig-widget-button-click' | |
482 ;;(strokes-fix-button2-command 'widget-button-click) | |
483 | |
484 ;;; without the advice, each advised function would look like... | |
485 ;;(defadvice vm-mouse-button-2 (around vm-strokes activate protect) | |
486 ;; "Allow strokes to work in VM." | |
487 ;; (if strokes-use-strokes-buffer | |
488 ;; ;; then strokes is no good and we'll have to use the original | |
489 ;; ad-do-it | |
490 ;; ;; otherwise, we can make strokes work too... | |
491 ;; (let ((strokes-click-command 'ad-Orig-vm-mouse-button-2)) | |
492 ;; (strokes-do-stroke (ad-get-arg 0))))) | |
493 | |
494 ;;; Functions... | |
495 | |
496 (defsubst strokes-mouse-event-p (event) | |
31640
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
497 (and (consp event) (symbolp (car event)) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
498 (or (eq (car event) 'mouse-movement) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
499 (memq 'click (get (car event) 'event-symbol-elements)) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
500 (memq 'down (get (car event) 'event-symbol-elements)) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
501 (memq 'drag (get (car event) 'event-symbol-elements))))) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
502 |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
503 (defsubst strokes-button-press-event-p (event) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
504 (and (consp event) (symbolp (car event)) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
505 (memq 'down (get (car event) 'event-symbol-elements)))) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
506 |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
507 (defsubst strokes-button-release-event-p (event) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
508 (and (consp event) (symbolp (car event)) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
509 (or (memq 'click (get (car event) 'event-symbol-elements)) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
510 (memq 'drag (get (car event) 'event-symbol-elements))))) |
19345 | 511 |
512 (defun strokes-event-closest-point-1 (window &optional line) | |
513 "Return position of start of line LINE in WINDOW. | |
514 If LINE is nil, return the last position visible in WINDOW." | |
515 (let* ((total (- (window-height window) | |
516 (if (window-minibuffer-p window) | |
517 0 1))) | |
518 (distance (or line total))) | |
519 (save-excursion | |
520 (goto-char (window-start window)) | |
521 (if (= (vertical-motion distance) distance) | |
522 (if (not line) | |
523 (forward-char -1))) | |
524 (point)))) | |
525 | |
526 (defun strokes-event-closest-point (event &optional start-window) | |
527 "Return the nearest position to where EVENT ended its motion. | |
528 This is computed for the window where EVENT's motion started, | |
529 or for window WINDOW if that is specified." | |
530 (or start-window (setq start-window (posn-window (event-start event)))) | |
531 (if (eq start-window (posn-window (event-end event))) | |
31640
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
532 (if (eq (posn-point (event-end event)) 'vertical-line) |
19345 | 533 (strokes-event-closest-point-1 start-window |
534 (cdr (posn-col-row (event-end event)))) | |
31640
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
535 (if (eq (posn-point (event-end event)) 'mode-line) |
19345 | 536 (strokes-event-closest-point-1 start-window) |
31640
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
537 (posn-point (event-end event)))) |
19345 | 538 ;; EVENT ended in some other window. |
539 (let* ((end-w (posn-window (event-end event))) | |
540 (end-w-top) | |
541 (w-top (nth 1 (window-edges start-window)))) | |
542 (setq end-w-top | |
543 (if (windowp end-w) | |
544 (nth 1 (window-edges end-w)) | |
545 (/ (cdr (posn-x-y (event-end event))) | |
19347 | 546 (frame-char-height end-w)))) |
19345 | 547 (if (>= end-w-top w-top) |
548 (strokes-event-closest-point-1 start-window) | |
549 (window-start start-window))))) | |
550 | |
551 (defun strokes-lift-p (object) | |
31640
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
552 "Return non-nil if OBJECT is a stroke-lift." |
19345 | 553 (eq object strokes-lift)) |
554 | |
555 (defun strokes-unset-last-stroke () | |
556 "Undo the last stroke definition." | |
557 (interactive) | |
558 (let ((command (cdar strokes-global-map))) | |
19347 | 559 (if (y-or-n-p |
19345 | 560 (format "really delete last stroke definition, defined to `%s'? " |
561 command)) | |
562 (progn | |
563 (setq strokes-global-map (cdr strokes-global-map)) | |
564 (message "That stroke has been deleted")) | |
565 (message "Nothing done")))) | |
566 | |
567 ;;;###autoload | |
568 (defun strokes-global-set-stroke (stroke command) | |
569 "Interactively give STROKE the global binding as COMMAND. | |
570 Operated just like `global-set-key', except for strokes. | |
571 COMMAND is a symbol naming an interactively-callable function. STROKE | |
572 is a list of sampled positions on the stroke grid as described in the | |
573 documentation for the `strokes-define-stroke' function." | |
574 (interactive | |
575 (list | |
576 (and (or strokes-mode (strokes-mode t)) | |
577 (strokes-read-complex-stroke | |
578 "Define a new stroke. Draw with button1 (or 2). End with button3...")) | |
579 (read-command "command to map stroke to: "))) | |
580 (strokes-define-stroke strokes-global-map stroke command)) | |
581 | |
582 ;;;###autoload | |
583 (defalias 'global-set-stroke 'strokes-global-set-stroke) | |
584 | |
585 ;;(defun global-unset-stroke (stroke); FINISH THIS DEFUN! | |
586 ;; "delete all strokes matching STROKE from `strokes-global-map', | |
587 ;; letting the user input | |
588 ;; the stroke with the mouse" | |
589 ;; (interactive | |
590 ;; (list | |
591 ;; (strokes-read-stroke "Enter the stroke you want to delete..."))) | |
592 ;; (strokes-define-stroke 'strokes-global-map stroke command)) | |
593 | |
594 (defun strokes-get-grid-position (stroke-extent position &optional grid-resolution) | |
595 "Map POSITION to a new grid position based on its STROKE-EXTENT and GRID-RESOLUTION. | |
596 STROKE-EXTENT as a list \(\(XMIN . YMIN\) \(XMAX . YMAX\)\). | |
597 If POSITION is a `strokes-lift', then it is itself returned. | |
598 Optional GRID-RESOLUTION may be used in place of STROKES-GRID-RESOLUTION. | |
599 The grid is a square whose dimesion is [0,GRID-RESOLUTION)." | |
600 (cond ((consp position) ; actual pixel location | |
601 (let ((grid-resolution (or grid-resolution strokes-grid-resolution)) | |
602 (x (car position)) | |
603 (y (cdr position)) | |
604 (xmin (caar stroke-extent)) | |
605 (ymin (cdar stroke-extent)) | |
606 ;; the `1+' is there to insure that the | |
607 ;; formula evaluates correctly at the boundaries | |
31640
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
608 (xmax (1+ (car (cadr stroke-extent)))) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
609 (ymax (1+ (cdr (cadr stroke-extent))))) |
19345 | 610 (cons (floor (* grid-resolution |
611 (/ (float (- x xmin)) | |
612 (- xmax xmin)))) | |
613 (floor (* grid-resolution | |
614 (/ (float (- y ymin)) | |
615 (- ymax ymin))))))) | |
616 ((strokes-lift-p position) ; stroke lift | |
617 strokes-lift))) | |
618 | |
619 (defun strokes-get-stroke-extent (pixel-positions) | |
620 "From a list of absolute PIXEL-POSITIONS, returns absolute spatial extent. | |
621 The return value is a list ((XMIN . YMIN) (XMAX . YMAX))." | |
622 (if pixel-positions | |
623 (let ((xmin (caar pixel-positions)) | |
624 (xmax (caar pixel-positions)) | |
625 (ymin (cdar pixel-positions)) | |
626 (ymax (cdar pixel-positions)) | |
627 (rest (cdr pixel-positions))) | |
628 (while rest | |
629 (if (consp (car rest)) | |
630 (let ((x (caar rest)) | |
631 (y (cdar rest))) | |
632 (if (< x xmin) | |
633 (setq xmin x)) | |
634 (if (> x xmax) | |
635 (setq xmax x)) | |
636 (if (< y ymin) | |
637 (setq ymin y)) | |
638 (if (> y ymax) | |
639 (setq ymax y)))) | |
640 (setq rest (cdr rest))) | |
641 (let ((delta-x (- xmax xmin)) | |
642 (delta-y (- ymax ymin))) | |
643 (if (> delta-x delta-y) | |
644 (setq ymin (- ymin | |
645 (/ (- delta-x delta-y) | |
646 2)) | |
647 ymax (+ ymax | |
648 (/ (- delta-x delta-y) | |
649 2))) | |
650 (setq xmin (- xmin | |
651 (/ (- delta-y delta-x) | |
652 2)) | |
653 xmax (+ xmax | |
654 (/ (- delta-y delta-x) | |
655 2)))) | |
656 (list (cons xmin ymin) | |
657 (cons xmax ymax)))) | |
658 nil)) | |
659 | |
660 (defun strokes-eliminate-consecutive-redundancies (entries) | |
661 "Returns a list with no consecutive redundant entries." | |
662 ;; defun a grande vitesse grace a Dave G. | |
663 (loop for element on entries | |
664 if (not (equal (car element) (cadr element))) | |
665 collect (car element))) | |
666 ;; (loop for element on entries | |
667 ;; nconc (if (not (equal (car el) (cadr el))) | |
668 ;; (list (car el))))) | |
669 ;; yet another (orig) way of doing it... | |
670 ;; (if entries | |
671 ;; (let* ((current (car entries)) | |
672 ;; (rest (cdr entries)) | |
673 ;; (non-redundant-list (list current)) | |
674 ;; (next nil)) | |
675 ;; (while rest | |
676 ;; (setq next (car rest)) | |
677 ;; (if (equal current next) | |
678 ;; (setq rest (cdr rest)) | |
679 ;; (setq non-redundant-list (cons next non-redundant-list) | |
680 ;; current next | |
681 ;; rest (cdr rest)))) | |
682 ;; (nreverse non-redundant-list)) | |
683 ;; nil)) | |
684 | |
685 (defun strokes-renormalize-to-grid (positions &optional grid-resolution) | |
686 "Map POSITIONS to a new grid whose dimensions are based on GRID-RESOLUTION. | |
687 POSITIONS is a list of positions and stroke-lifts. | |
688 Optional GRID-RESOLUTION may be used in place of STROKES-GRID-RESOLUTION. | |
689 The grid is a square whose dimesion is [0,GRID-RESOLUTION)." | |
690 (or grid-resolution (setq grid-resolution strokes-grid-resolution)) | |
691 (let ((stroke-extent (strokes-get-stroke-extent positions))) | |
692 (mapcar (function | |
693 (lambda (pos) | |
694 (strokes-get-grid-position stroke-extent pos grid-resolution))) | |
695 positions))) | |
696 | |
697 (defun strokes-fill-stroke (unfilled-stroke &optional force) | |
698 "Fill in missing grid locations in the list of UNFILLED-STROKE. | |
699 If FORCE is non-nil, then fill the stroke even if it's `stroke-click'. | |
700 NOTE: This is where the global variable `strokes-last-stroke' is set." | |
701 (setq strokes-last-stroke ; this is global | |
702 (if (and (strokes-click-p unfilled-stroke) | |
703 (not force)) | |
704 unfilled-stroke | |
705 (loop for grid-locs on unfilled-stroke | |
706 nconc (let* ((current (car grid-locs)) | |
707 (current-is-a-point-p (consp current)) | |
708 (next (cadr grid-locs)) | |
709 (next-is-a-point-p (consp next)) | |
710 (both-are-points-p (and current-is-a-point-p | |
711 next-is-a-point-p)) | |
712 (x1 (and current-is-a-point-p | |
713 (car current))) | |
714 (y1 (and current-is-a-point-p | |
715 (cdr current))) | |
716 (x2 (and next-is-a-point-p | |
717 (car next))) | |
718 (y2 (and next-is-a-point-p | |
719 (cdr next))) | |
720 (delta-x (and both-are-points-p | |
721 (- x2 x1))) | |
722 (delta-y (and both-are-points-p | |
723 (- y2 y1))) | |
724 (slope (and both-are-points-p | |
725 (if (zerop delta-x) | |
726 nil ; undefined vertical slope | |
727 (/ (float delta-y) | |
728 delta-x))))) | |
729 (cond ((not both-are-points-p) | |
730 (list current)) | |
731 ((null slope) ; undefinded vertical slope | |
732 (if (>= delta-y 0) | |
733 (loop for y from y1 below y2 | |
734 collect (cons x1 y)) | |
735 (loop for y from y1 above y2 | |
736 collect (cons x1 y)))) | |
737 ((zerop slope) ; (= y1 y2) | |
738 (if (>= delta-x 0) | |
739 (loop for x from x1 below x2 | |
740 collect (cons x y1)) | |
741 (loop for x from x1 above x2 | |
742 collect (cons x y1)))) | |
743 ((>= (abs delta-x) (abs delta-y)) | |
744 (if (> delta-x 0) | |
745 (loop for x from x1 below x2 | |
746 collect (cons x | |
747 (+ y1 | |
748 (round (* slope | |
749 (- x x1)))))) | |
750 (loop for x from x1 above x2 | |
751 collect (cons x | |
752 (+ y1 | |
753 (round (* slope | |
754 (- x x1)))))))) | |
755 (t ; (< (abs delta-x) (abs delta-y)) | |
756 (if (> delta-y 0) | |
757 (loop for y from y1 below y2 | |
758 collect (cons (+ x1 | |
759 (round (/ (- y y1) | |
760 slope))) | |
761 y)) | |
762 (loop for y from y1 above y2 | |
763 collect (cons (+ x1 | |
764 (round (/ (- y y1) | |
765 slope))) | |
766 y)))))))))) | |
767 | |
768 (defun strokes-rate-stroke (stroke1 stroke2) | |
769 "Rates STROKE1 with STROKE2 and returns a score based on a distance metric. | |
770 Note: the rating is an error rating, and therefore, a return of 0 | |
771 represents a perfect match. Also note that the order of stroke | |
772 arguments is order-independent for the algorithm used here." | |
773 (if (and stroke1 stroke2) | |
774 (let ((rest1 (cdr stroke1)) | |
775 (rest2 (cdr stroke2)) | |
776 (err (strokes-distance-squared (car stroke1) | |
777 (car stroke2)))) | |
778 (while (and rest1 rest2) | |
779 (while (and (consp (car rest1)) | |
780 (consp (car rest2))) | |
781 (setq err (+ err | |
782 (strokes-distance-squared (car rest1) | |
783 (car rest2))) | |
784 stroke1 rest1 | |
785 stroke2 rest2 | |
786 rest1 (cdr stroke1) | |
787 rest2 (cdr stroke2))) | |
788 (cond ((and (strokes-lift-p (car rest1)) | |
789 (strokes-lift-p (car rest2))) | |
790 (setq rest1 (cdr rest1) | |
791 rest2 (cdr rest2))) | |
792 ((strokes-lift-p (car rest2)) | |
793 (while (consp (car rest1)) | |
794 (setq err (+ err | |
795 (strokes-distance-squared (car rest1) | |
796 (car stroke2))) | |
797 rest1 (cdr rest1)))) | |
798 ((strokes-lift-p (car rest1)) | |
799 (while (consp (car rest2)) | |
800 (setq err (+ err | |
801 (strokes-distance-squared (car stroke1) | |
802 (car rest2))) | |
803 rest2 (cdr rest2)))))) | |
804 (if (null rest2) | |
805 (while (consp (car rest1)) | |
806 (setq err (+ err | |
807 (strokes-distance-squared (car rest1) | |
808 (car stroke2))) | |
809 rest1 (cdr rest1)))) | |
810 (if (null rest1) | |
811 (while (consp (car rest2)) | |
812 (setq err (+ err | |
813 (strokes-distance-squared (car stroke1) | |
814 (car rest2))) | |
815 rest2 (cdr rest2)))) | |
816 (if (or (strokes-lift-p (car rest1)) | |
817 (strokes-lift-p (car rest2))) | |
818 (setq err nil) | |
819 err)) | |
820 nil)) | |
821 | |
822 (defun strokes-match-stroke (stroke stroke-map) | |
823 "Finds the best matching command of STROKE in STROKE-MAP. | |
824 Returns the corresponding match as (COMMAND . SCORE)." | |
825 (if (and stroke stroke-map) | |
826 (let ((score (strokes-rate-stroke stroke (caar stroke-map))) | |
827 (command (cdar stroke-map)) | |
828 (map (cdr stroke-map))) | |
829 (while map | |
830 (let ((newscore (strokes-rate-stroke stroke (caar map)))) | |
831 (if (or (and newscore score (< newscore score)) | |
832 (and newscore (null score))) | |
833 (setq score newscore | |
834 command (cdar map))) | |
835 (setq map (cdr map)))) | |
836 (if score | |
837 (cons command score) | |
838 nil)) | |
839 nil)) | |
840 | |
841 ;;;###autoload | |
842 (defun strokes-read-stroke (&optional prompt event) | |
843 "Read a simple stroke (interactively) and return the stroke. | |
844 Optional PROMPT in minibuffer displays before and during stroke reading. | |
845 This function will display the stroke interactively as it is being | |
846 entered in the strokes buffer if the variable | |
847 `strokes-use-strokes-buffer' is non-nil. | |
19347 | 848 Optional EVENT is acceptable as the starting event of the stroke" |
19345 | 849 (save-excursion |
19347 | 850 (let ((pix-locs nil) |
851 (grid-locs nil) | |
852 (safe-to-draw-p nil)) | |
853 (if strokes-use-strokes-buffer | |
854 ;; switch to the strokes buffer and | |
855 ;; display the stroke as it's being read | |
856 (save-window-excursion | |
857 (set-window-configuration strokes-window-configuration) | |
858 (when prompt | |
859 (message prompt) | |
860 (setq event (read-event)) | |
31640
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
861 (or (strokes-button-press-event-p event) |
19347 | 862 (error "You must draw with the mouse"))) |
863 (unwind-protect | |
864 (track-mouse | |
865 (or event (setq event (read-event) | |
866 safe-to-draw-p t)) | |
31640
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
867 (while (not (strokes-button-release-event-p event)) |
19347 | 868 (if (strokes-mouse-event-p event) |
869 (let ((point (strokes-event-closest-point event))) | |
870 (if (and point safe-to-draw-p) | |
871 ;; we can draw that point | |
872 (progn | |
873 (goto-char point) | |
874 (subst-char-in-region point (1+ point) ?\ strokes-character)) | |
875 ;; otherwise, we can start drawing the next time... | |
876 (setq safe-to-draw-p t)) | |
31640
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
877 (push (cdr (mouse-pixel-position)) |
19347 | 878 pix-locs))) |
879 (setq event (read-event))))) | |
880 ;; protected | |
881 ;; clean up strokes buffer and then bury it. | |
882 (when (equal (buffer-name) strokes-buffer-name) | |
883 (subst-char-in-region (point-min) (point-max) strokes-character ?\ ) | |
884 (goto-char (point-min)) | |
885 (bury-buffer)))) | |
886 ;; Otherwise, don't use strokes buffer and read stroke silently | |
887 (when prompt | |
888 (message prompt) | |
889 (setq event (read-event)) | |
31640
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
890 (or (strokes-button-press-event-p event) |
19347 | 891 (error "You must draw with the mouse"))) |
892 (track-mouse | |
893 (or event (setq event (read-event))) | |
31640
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
894 (while (not (strokes-button-release-event-p event)) |
19347 | 895 (if (strokes-mouse-event-p event) |
31640
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
896 (push (cdr (mouse-pixel-position)) |
19347 | 897 pix-locs)) |
898 (setq event (read-event)))) | |
899 (setq grid-locs (strokes-renormalize-to-grid (nreverse pix-locs))) | |
900 (strokes-fill-stroke (strokes-eliminate-consecutive-redundancies grid-locs))))) | |
19345 | 901 |
902 ;;;###autoload | |
903 (defun strokes-read-complex-stroke (&optional prompt event) | |
904 "Read a complex stroke (interactively) and return the stroke. | |
905 Optional PROMPT in minibuffer displays before and during stroke reading. | |
906 Note that a complex stroke allows the user to pen-up and pen-down. This | |
907 is implemented by allowing the user to paint with button1 or button2 and | |
908 then complete the stroke with button3. | |
19347 | 909 Optional EVENT is acceptable as the starting event of the stroke" |
19345 | 910 (save-excursion |
911 (save-window-excursion | |
19347 | 912 (set-window-configuration strokes-window-configuration) |
913 (let ((pix-locs nil) | |
914 (grid-locs nil)) | |
915 (if prompt | |
31640
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
916 (while (not (strokes-button-press-event-p event)) |
19347 | 917 (message prompt) |
918 (setq event (read-event)))) | |
919 (unwind-protect | |
920 (track-mouse | |
921 (or event (setq event (read-event))) | |
31640
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
922 (while (not (and (strokes-button-press-event-p event) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
923 (eq 'mouse-3 |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
924 (car (get (car event) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
925 'event-symbol-elements))))) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
926 (while (not (strokes-button-release-event-p event)) |
19347 | 927 (if (strokes-mouse-event-p event) |
928 (let ((point (strokes-event-closest-point event))) | |
929 (when point | |
930 (goto-char point) | |
931 (subst-char-in-region point (1+ point) ?\ strokes-character)) | |
31640
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
932 (push (cdr (mouse-pixel-position)) |
19347 | 933 pix-locs))) |
934 (setq event (read-event))) | |
935 (push strokes-lift pix-locs) | |
31640
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
936 (while (not (strokes-button-press-event-p event)) |
19347 | 937 (setq event (read-event)))) |
938 ;; ### KLUDGE! ### sit and wait | |
939 ;; for some useless event to | |
940 ;; happen to fix the minibuffer bug. | |
31640
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
941 (while (not (strokes-button-release-event-p (read-event)))) |
19347 | 942 (setq pix-locs (nreverse (cdr pix-locs)) |
943 grid-locs (strokes-renormalize-to-grid pix-locs)) | |
944 (strokes-fill-stroke | |
945 (strokes-eliminate-consecutive-redundancies grid-locs))) | |
946 ;; protected | |
947 (when (equal (buffer-name) strokes-buffer-name) | |
948 (subst-char-in-region (point-min) (point-max) strokes-character ?\ ) | |
949 (goto-char (point-min)) | |
950 (bury-buffer))))))) | |
19345 | 951 |
952 (defun strokes-execute-stroke (stroke) | |
953 "Given STROKE, execute the command which corresponds to it. | |
954 The command will be executed provided one exists for that stroke, | |
955 based on the variable `strokes-minimum-match-score'. | |
956 If no stroke matches, nothing is done and return value is nil." | |
957 (let* ((match (strokes-match-stroke stroke strokes-global-map)) | |
958 (command (car match)) | |
959 (score (cdr match))) | |
960 (cond ((strokes-click-p stroke) | |
31640
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
961 ;; This is the case of a `click' type event. |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
962 ;; The `sit-for' is a minor frob that has to do with timing |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
963 ;; problems. Without the `sit-for', mouse-yank will not |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
964 ;; yank at the proper location if the user opted for |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
965 ;; mouse-yank-at-point to be nil (i.e. mouse-yank takes |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
966 ;; place at pointer position). The sit-for tells redisplay |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
967 ;; to be sure to wait for the `*strokes*' buffer to vanish |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
968 ;; from consideration when deciding on a point to be used |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
969 ;; for mouse-yank. |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
970 (sit-for 0) |
19345 | 971 (command-execute strokes-click-command)) |
972 ((and match (<= score strokes-minimum-match-score)) | |
973 (message "%s" command) | |
974 (command-execute command)) | |
975 ((null strokes-global-map) | |
976 (if (file-exists-p strokes-file) | |
19347 | 977 (and (y-or-n-p |
19345 | 978 (format "No strokes loaded. Load `%s'? " |
979 strokes-file)) | |
980 (strokes-load-user-strokes)) | |
981 (error "No strokes defined; use `global-set-stroke'"))) | |
982 (t | |
983 (error | |
984 "No stroke matches; see variable `strokes-minimum-match-score'") | |
985 nil)))) | |
986 | |
987 ;;;###autoload | |
988 (defun strokes-do-stroke (event) | |
43233
ae3e8c9e9b87
(strokes-do-stroke, strokes-do-complex-stroke): Doc fix.
Pavel Janík <Pavel@Janik.cz>
parents:
41603
diff
changeset
|
989 "Read a simple stroke from the user and then execute its command. |
19345 | 990 This must be bound to a mouse event." |
991 (interactive "e") | |
992 (or strokes-mode (strokes-mode t)) | |
993 (strokes-execute-stroke (strokes-read-stroke nil event))) | |
994 | |
995 ;;;###autoload | |
996 (defun strokes-do-complex-stroke (event) | |
43233
ae3e8c9e9b87
(strokes-do-stroke, strokes-do-complex-stroke): Doc fix.
Pavel Janík <Pavel@Janik.cz>
parents:
41603
diff
changeset
|
997 "Read a complex stroke from the user and then execute its command. |
19345 | 998 This must be bound to a mouse event." |
999 (interactive "e") | |
1000 (or strokes-mode (strokes-mode t)) | |
1001 (strokes-execute-stroke (strokes-read-complex-stroke nil event))) | |
1002 | |
1003 ;;;###autoload | |
1004 (defun strokes-describe-stroke (stroke) | |
1005 "Displays the command which STROKE maps to, reading STROKE interactively." | |
1006 (interactive | |
1007 (list | |
1008 (strokes-read-complex-stroke | |
1009 "Enter stroke to describe; end with button3..."))) | |
1010 (let* ((match (strokes-match-stroke stroke strokes-global-map)) | |
1011 (command (or (and (strokes-click-p stroke) | |
1012 strokes-click-command) | |
1013 (car match))) | |
1014 (score (cdr match))) | |
1015 (if (or (and match | |
1016 (<= score strokes-minimum-match-score)) | |
1017 (and (strokes-click-p stroke) | |
1018 strokes-click-command)) | |
1019 (message "That stroke maps to `%s'" command) | |
1020 (message "That stroke is undefined")) | |
1021 (sleep-for 1))) ; helpful for recursive edits | |
1022 | |
1023 ;;;###autoload | |
1024 (defalias 'describe-stroke 'strokes-describe-stroke) | |
1025 | |
1026 ;;;###autoload | |
19347 | 1027 (defun strokes-help () |
31640
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1028 "Get instructional help on using the `strokes' package." |
19347 | 1029 (interactive) |
43233
ae3e8c9e9b87
(strokes-do-stroke, strokes-do-complex-stroke): Doc fix.
Pavel Janík <Pavel@Janik.cz>
parents:
41603
diff
changeset
|
1030 (let ((helpdoc |
ae3e8c9e9b87
(strokes-do-stroke, strokes-do-complex-stroke): Doc fix.
Pavel Janík <Pavel@Janik.cz>
parents:
41603
diff
changeset
|
1031 "This is help for the strokes package. |
19345 | 1032 |
19347 | 1033 If you find something wrong with strokes, or feel that it can be |
1034 improved in some way, then please feel free to email me: | |
19345 | 1035 |
19347 | 1036 David Bakhash <cadet@mit.edu> |
19345 | 1037 |
19347 | 1038 or just do |
19345 | 1039 |
19347 | 1040 M-x strokes-report-bug |
19345 | 1041 |
19347 | 1042 ------------------------------------------------------------ |
19345 | 1043 |
19347 | 1044 ** Strokes... |
19345 | 1045 |
19347 | 1046 The strokes package allows you to define strokes, made with |
1047 the mouse or other pointer device, that Emacs can interpret as | |
1048 corresponding to commands, and then executes the commands. It does | |
1049 character recognition, so you don't have to worry about getting it | |
1050 right every time. | |
19345 | 1051 |
31640
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1052 Strokes also allows you to compose documents graphically. You can |
43233
ae3e8c9e9b87
(strokes-do-stroke, strokes-do-complex-stroke): Doc fix.
Pavel Janík <Pavel@Janik.cz>
parents:
41603
diff
changeset
|
1053 fully edit documents in Chinese, Japanese, etc. based on Emacs |
31640
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1054 strokes. Once you've done so, you can ascii compress-and-encode them |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1055 and then safely save them for later use, send letters to friends |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1056 \(using Emacs, of course). Strokes will later decode these documents, |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1057 extracting the strokes for editing use once again, so the editing |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1058 cycle can continue. |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1059 |
19347 | 1060 Strokes are easy to program and fun to use. To start strokes going, |
1061 you'll want to put the following line in your .emacs file as mentioned | |
1062 in the commentary to strokes.el. | |
1063 | |
1064 This will load strokes when and only when you start Emacs on a window | |
1065 system, with a mouse or other pointer device defined. | |
19345 | 1066 |
19347 | 1067 To toggle strokes-mode, you just do |
1068 | |
1069 > M-x strokes-mode | |
19345 | 1070 |
31640
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1071 ** Strokes for controlling the behavior of Emacs... |
19345 | 1072 |
19347 | 1073 When you're ready to start defining strokes, just use the command |
19345 | 1074 |
19347 | 1075 > M-x global-set-stroke |
19345 | 1076 |
19347 | 1077 You will see a ` *strokes*' buffer which is waiting for you to enter in |
1078 your stroke. When you enter in the stroke, you draw with button1 or | |
1079 button2, and then end with button3. Next, you enter in the command | |
1080 which will be executed when that stroke is invoked. Simple as that. | |
1081 For now, try to define a stroke to copy a region. This is a popular | |
1082 edit command, so type | |
19345 | 1083 |
19347 | 1084 > M-x global-set-stroke |
19345 | 1085 |
31640
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1086 Then, in the ` *strokes*' buffer, draw the letter `C' (for `copy') |
19347 | 1087 and then, when it asks you to enter the command to map that to, type |
1088 | |
1089 > copy-region-as-kill | |
19345 | 1090 |
19347 | 1091 That's about as hard as it gets. |
1092 Remember: paint with button1 or button2 and then end with button3. | |
19345 | 1093 |
19347 | 1094 If ever you want to know what a certain strokes maps to, then do |
19345 | 1095 |
19347 | 1096 > M-x describe-stroke |
19345 | 1097 |
19347 | 1098 and you can enter in any arbitrary stroke. Remember: The strokes |
31640
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1099 package lets you program in simple and complex (multi-lift) strokes. |
19347 | 1100 The only difference is how you *invoke* the two. You will most likely |
1101 use simple strokes, as complex strokes were developed for | |
31640
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1102 Chinese/Japanese/Korean. So the middle mouse button (mouse-2) will |
19347 | 1103 invoke the command `strokes-do-stroke' in buffers where button2 doesn't |
1104 already have a meaning other than its original, which is `mouse-yank'. | |
1105 But don't worry: `mouse-yank' will still work with strokes. See the | |
1106 variable `strokes-click-command'. | |
19345 | 1107 |
19347 | 1108 If ever you define a stroke which you don't like, then you can unset |
1109 it with the command | |
19345 | 1110 |
19347 | 1111 > M-x strokes-unset-last-stroke |
19345 | 1112 |
31640
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1113 You can always get an idea of what your current strokes look like with |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1114 the command |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1115 |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1116 > M-x strokes-list-strokes |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1117 |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1118 Your strokes will be displayed in alphabetical order (based on command |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1119 names) and the beginning of each simple stroke will be marked by a |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1120 color dot. Since you may have several simple strokes in a complex |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1121 stroke, the dot colors are arranged in the rainbow color sequence, |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1122 `ROYGBIV'. If you want a listing of your strokes from most recent |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1123 down, then use a prefix argument: |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1124 |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1125 > C-u M-x strokes-list-strokes |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1126 |
19347 | 1127 Your strokes are stored as you enter them. They get saved in a file |
1128 called ~/.strokes, along with other strokes configuration variables. | |
1129 You can change this location by setting the variable `strokes-file'. | |
1130 You will be prompted to save them when you exit Emacs, or you can save | |
1131 them with | |
19345 | 1132 |
19347 | 1133 > M-x save-strokes |
19345 | 1134 |
19347 | 1135 Your strokes get loaded automatically when you enable `strokes-mode'. |
1136 You can also load in your user-defined strokes with | |
19345 | 1137 |
19347 | 1138 > M-x load-user-strokes |
19345 | 1139 |
31640
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1140 ** Strokes for pictographic editing... |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1141 |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1142 If you'd like to create graphical files with strokes, you'll have to |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1143 be running a version of Emacs with XPM support. You use the |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1144 binding C-mouse-2 to start drawing your strokes. These are just |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1145 complex strokes, and thus you continue drawing with mouse-1 or mouse-2 and |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1146 end with mouse-3-3. Then the stroke image gets inserted into the |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1147 buffer. You treat it like any other character, which you can copy, |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1148 paste, delete, move, etc. The command which is bound to C-mouse-2 is |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1149 called `strokes-compose-complex-stroke'. When all is done, you may |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1150 want to send the file, or save it. This is done with |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1151 |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1152 > M-x strokes-encode-buffer |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1153 |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1154 Likewise, to decode the strokes from a strokes-encoded buffer you do |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1155 |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1156 > M-x strokes-decode-buffer |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1157 |
19347 | 1158 ** A few more important things... |
19345 | 1159 |
31640
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1160 o The command `strokes-do-complex-stroke' is invoked with M-mouse-2, |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1161 so that you can execute complex strokes (i.e. with more than one lift) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1162 if preferred. |
19345 | 1163 |
19347 | 1164 o Strokes are a bit computer-dependent in that they depend somewhat on |
1165 the speed of the computer you're working on. This means that you | |
1166 may have to tweak some variables. You can read about them in the | |
1167 commentary of `strokes.el'. Better to just use apropos and read their | |
1168 docstrings. All variables/functions start with `strokes'. The one | |
1169 variable which many people wanted to see was | |
1170 `strokes-use-strokes-buffer' which allows the user to use strokes | |
1171 silently--without displaying the strokes. All variables can be set | |
1172 by customizing the group named `strokes' via the customization package: | |
19345 | 1173 |
19347 | 1174 > M-x customize")) |
43233
ae3e8c9e9b87
(strokes-do-stroke, strokes-do-complex-stroke): Doc fix.
Pavel Janík <Pavel@Janik.cz>
parents:
41603
diff
changeset
|
1175 (with-output-to-temp-buffer "*Help with Strokes*" |
31640
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1176 (princ helpdoc) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1177 (set-buffer standard-output) |
43233
ae3e8c9e9b87
(strokes-do-stroke, strokes-do-complex-stroke): Doc fix.
Pavel Janík <Pavel@Janik.cz>
parents:
41603
diff
changeset
|
1178 (help-mode) |
19347 | 1179 (print-help-return-message)))) |
19345 | 1180 |
1181 (defun strokes-report-bug () | |
1182 "Submit a bug report for strokes." | |
1183 (interactive) | |
1184 (let ((reporter-prompt-for-summary-p t)) | |
1185 (reporter-submit-bug-report | |
1186 strokes-bug-address "Strokes" | |
1187 (cons | |
1188 'strokes-version | |
1189 (nconc | |
1190 (mapcar | |
1191 'intern | |
1192 (sort | |
1193 (let (completion-ignore-case) | |
1194 (all-completions "strokes-" obarray 'user-variable-p)) | |
1195 'string-lessp)) | |
1196 (list 'reporter-version))) | |
1197 (function | |
1198 (lambda () | |
1199 (save-excursion | |
1200 (mail-position-on-field "subject") | |
1201 (beginning-of-line) | |
1202 (skip-chars-forward "^:\n") | |
1203 (if (looking-at ": Strokes;") | |
1204 (progn | |
1205 (goto-char (match-end 0)) | |
1206 (delete-char -1) | |
1207 (insert " " strokes-version " bug:"))))))))) | |
1208 | |
1209 (defsubst strokes-fill-current-buffer-with-whitespace () | |
31640
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1210 "Erase the contents of the current buffer and fill it with whitespace." |
19345 | 1211 (erase-buffer) |
1212 (loop repeat (frame-height) do | |
1213 (insert-char ?\ (1- (frame-width))) | |
1214 (newline)) | |
1215 (goto-char (point-min))) | |
1216 | |
31640
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1217 (defun strokes-window-configuration-changed-p () |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1218 "Non-nil if the `strokes-window-configuration' frame properties changed. |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1219 This is based on the last time the `strokes-window-configuration was updated." |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1220 (compare-window-configurations (current-window-configuration) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1221 strokes-window-configuration)) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1222 |
19345 | 1223 (defun strokes-update-window-configuration () |
31640
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1224 "Ensure that `strokes-window-configuration' is up-to-date." |
19345 | 1225 (interactive) |
1226 (let ((current-window (selected-window))) | |
1227 (cond ((or (window-minibuffer-p current-window) | |
1228 (window-dedicated-p current-window)) | |
1229 ;; don't try to update strokes window configuration | |
1230 ;; if window is dedicated or a minibuffer | |
1231 nil) | |
1232 ((or (interactive-p) | |
31640
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1233 (not (buffer-live-p (get-buffer strokes-buffer-name))) |
19345 | 1234 (null strokes-window-configuration)) |
1235 ;; create `strokes-window-configuration' from scratch... | |
1236 (save-excursion | |
1237 (save-window-excursion | |
1238 (get-buffer-create strokes-buffer-name) | |
1239 (set-window-buffer current-window strokes-buffer-name) | |
1240 (delete-other-windows) | |
1241 (fundamental-mode) | |
1242 (auto-save-mode 0) | |
1243 (if (featurep 'font-lock) | |
1244 (font-lock-mode 0)) | |
1245 (abbrev-mode 0) | |
1246 (buffer-disable-undo (current-buffer)) | |
1247 (setq truncate-lines nil) | |
1248 (strokes-fill-current-buffer-with-whitespace) | |
1249 (setq strokes-window-configuration (current-window-configuration)) | |
1250 (bury-buffer)))) | |
31640
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1251 ((strokes-window-configuration-changed-p) ; simple update |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1252 ;; update the strokes-window-configuration for this |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1253 ;; specific frame... |
19345 | 1254 (save-excursion |
1255 (save-window-excursion | |
1256 (set-window-buffer current-window strokes-buffer-name) | |
1257 (delete-other-windows) | |
1258 (strokes-fill-current-buffer-with-whitespace) | |
1259 (setq strokes-window-configuration (current-window-configuration)) | |
1260 (bury-buffer))))))) | |
1261 | |
1262 ;;;###autoload | |
1263 (defun strokes-load-user-strokes () | |
1264 "Load user-defined strokes from file named by `strokes-file'." | |
1265 (interactive) | |
1266 (cond ((and (file-exists-p strokes-file) | |
1267 (file-readable-p strokes-file)) | |
1268 (load-file strokes-file)) | |
1269 ((interactive-p) | |
1270 (error "Trouble loading user-defined strokes; nothing done")) | |
1271 (t | |
1272 (message "No user-defined strokes, sorry")))) | |
1273 | |
1274 ;;;###autoload | |
1275 (defalias 'load-user-strokes 'strokes-load-user-strokes) | |
1276 | |
1277 (defun strokes-prompt-user-save-strokes () | |
1278 "Save user-defined strokes to file named by `strokes-file'." | |
1279 (interactive) | |
1280 (save-excursion | |
1281 (let ((current strokes-global-map)) | |
1282 (unwind-protect | |
1283 (progn | |
1284 (setq strokes-global-map nil) | |
1285 (strokes-load-user-strokes) | |
1286 (if (and (not (equal current strokes-global-map)) | |
1287 (or (interactive-p) | |
43233
ae3e8c9e9b87
(strokes-do-stroke, strokes-do-complex-stroke): Doc fix.
Pavel Janík <Pavel@Janik.cz>
parents:
41603
diff
changeset
|
1288 (yes-or-no-p "Save your strokes? "))) |
19345 | 1289 (progn |
1290 (require 'pp) ; pretty-print variables | |
1291 (message "Saving strokes in %s..." strokes-file) | |
1292 (get-buffer-create "*saved-strokes*") | |
1293 (set-buffer "*saved-strokes*") | |
1294 (erase-buffer) | |
1295 (emacs-lisp-mode) | |
1296 (goto-char (point-min)) | |
41570
7456b3a795c4
(strokes-prompt-user-save-strokes): Use insert instead of insert-string.
Pavel Janík <Pavel@Janik.cz>
parents:
31640
diff
changeset
|
1297 (insert |
19345 | 1298 ";; -*- Syntax: Emacs-Lisp; Mode: emacs-lisp -*-\n") |
41570
7456b3a795c4
(strokes-prompt-user-save-strokes): Use insert instead of insert-string.
Pavel Janík <Pavel@Janik.cz>
parents:
31640
diff
changeset
|
1299 (insert (format ";;; saved strokes for %s, as of %s\n\n" |
41603
4c61a8ae179d
Fix indentation of previous change.
Richard M. Stallman <rms@gnu.org>
parents:
41570
diff
changeset
|
1300 (user-full-name) |
4c61a8ae179d
Fix indentation of previous change.
Richard M. Stallman <rms@gnu.org>
parents:
41570
diff
changeset
|
1301 (format-time-string "%B %e, %Y" nil))) |
19345 | 1302 (message "Saving strokes in %s..." strokes-file) |
41570
7456b3a795c4
(strokes-prompt-user-save-strokes): Use insert instead of insert-string.
Pavel Janík <Pavel@Janik.cz>
parents:
31640
diff
changeset
|
1303 (insert (format "(setq strokes-global-map '%s)" |
41603
4c61a8ae179d
Fix indentation of previous change.
Richard M. Stallman <rms@gnu.org>
parents:
41570
diff
changeset
|
1304 (pp current))) |
19345 | 1305 (message "Saving strokes in %s..." strokes-file) |
1306 (indent-region (point-min) (point-max) nil) | |
1307 (write-region (point-min) | |
1308 (point-max) | |
1309 strokes-file)) | |
1310 (message "(no changes need to be saved)"))) | |
1311 ;; protected | |
1312 (if (get-buffer "*saved-strokes*") | |
1313 (kill-buffer (get-buffer "*saved-strokes*"))) | |
1314 (setq strokes-global-map current))))) | |
1315 | |
1316 (defalias 'save-strokes 'strokes-prompt-user-save-strokes) | |
1317 | |
1318 (defun strokes-toggle-strokes-buffer (&optional arg) | |
1319 "Toggle the use of the strokes buffer. | |
1320 In other words, toggle the variabe `strokes-use-strokes-buffer'. | |
1321 With ARG, use strokes buffer if and only if ARG is positive or true. | |
1322 Returns value of `strokes-use-strokes-buffer'." | |
1323 (interactive "P") | |
1324 (setq strokes-use-strokes-buffer | |
1325 (if arg (> (prefix-numeric-value arg) 0) | |
1326 (not strokes-use-strokes-buffer)))) | |
1327 | |
31640
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1328 (defun strokes-xpm-for-stroke (&optional stroke bufname b/w-only) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1329 "Create an xpm pixmap for the given STROKE in buffer ` *strokes-xpm*'. |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1330 If STROKE is not supplied, then `strokes-last-stroke' will be used. |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1331 Optional BUFNAME to name something else. |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1332 The pixmap will contain time information via rainbow dot colors |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1333 where each individual strokes begins. |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1334 Optional B/W-ONLY non-nil will create a mono pixmap, not intended |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1335 for trying to figure out the order of strokes, but rather for reading |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1336 the stroke as a character in some language." |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1337 (interactive) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1338 (save-excursion |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1339 (let ((buf (get-buffer-create (or bufname " *strokes-xpm*"))) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1340 (stroke (strokes-eliminate-consecutive-redundancies |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1341 (strokes-fill-stroke |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1342 (strokes-renormalize-to-grid (or stroke |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1343 strokes-last-stroke) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1344 31)))) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1345 (lift-flag t) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1346 (rainbow-chars (list ?R ?O ?Y ?G ?B ?P))) ; ROYGBIV w/o indigo |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1347 (set-buffer buf) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1348 (erase-buffer) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1349 (insert strokes-xpm-header) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1350 (loop repeat 33 do |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1351 (insert ?\") |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1352 (insert-char ?\ 33) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1353 (insert "\",") |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1354 (newline) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1355 finally |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1356 (forward-line -1) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1357 (end-of-line) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1358 (insert "}\n")) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1359 (loop for point in stroke |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1360 for x = (car-safe point) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1361 for y = (cdr-safe point) do |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1362 (cond ((consp point) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1363 ;; draw a point, and possibly a starting-point |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1364 (if (and lift-flag (not b/w-only)) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1365 ;; mark starting point with the appropriate color |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1366 (let ((char (or (car rainbow-chars) ?\.))) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1367 (loop for i from 0 to 2 do |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1368 (loop for j from 0 to 2 do |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1369 (goto-line (+ 16 i y)) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1370 (forward-char (+ 1 j x)) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1371 (delete-char 1) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1372 (insert char))) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1373 (setq rainbow-chars (cdr rainbow-chars) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1374 lift-flag nil)) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1375 ;; Otherwise, just plot the point... |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1376 (goto-line (+ 17 y)) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1377 (forward-char (+ 2 x)) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1378 (subst-char-in-region (point) (1+ (point)) ?\ ?\*))) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1379 ((strokes-lift-p point) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1380 ;; a lift--tell the loop to X out the next point... |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1381 (setq lift-flag t)))) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1382 (when (interactive-p) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1383 (pop-to-buffer " *strokes-xpm*") |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1384 ;; (xpm-mode 1) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1385 (goto-char (point-min)) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1386 (put-image (create-image (buffer-string) 'xpm t :ascent 100) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1387 (line-end-position)))))) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1388 |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1389 ;;; Strokes Edit stuff... ### NOT IMLEMENTED YET ### |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1390 |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1391 ;;(defun strokes-edit-quit () |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1392 ;; (interactive) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1393 ;; (or (one-window-p t 0) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1394 ;; (delete-window)) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1395 ;; (kill-buffer "*Strokes List*")) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1396 |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1397 ;;(define-derived-mode edit-strokes-mode list-mode |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1398 ;; "Edit-Strokes" |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1399 ;; "Major mode for `edit-strokes' and `list-strokes' buffers. |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1400 |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1401 ;;Editing commands: |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1402 |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1403 ;;\\{edit-strokes-mode-map}" |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1404 ;; (setq truncate-lines nil |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1405 ;; auto-show-mode nil ; don't want problems here either |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1406 ;; mode-popup-menu edit-strokes-menu) ; what about extent-specific stuff? |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1407 ;; (and (featurep 'menubar) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1408 ;; current-menubar |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1409 ;; (set (make-local-variable 'current-menubar) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1410 ;; (copy-sequence current-menubar)) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1411 ;; (add-submenu nil edit-strokes-menu))) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1412 |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1413 ;;(let ((map edit-strokes-mode-map)) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1414 ;; (define-key map "<" 'beginning-of-buffer) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1415 ;; (define-key map ">" 'end-of-buffer) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1416 ;; ;; (define-key map "c" 'strokes-copy-other-face) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1417 ;; ;; (define-key map "C" 'strokes-copy-this-face) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1418 ;; ;; (define-key map "s" 'strokes-smaller) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1419 ;; ;; (define-key map "l" 'strokes-larger) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1420 ;; ;; (define-key map "b" 'strokes-bold) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1421 ;; ;; (define-key map "i" 'strokes-italic) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1422 ;; (define-key map "e" 'strokes-list-edit) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1423 ;; ;; (define-key map "f" 'strokes-font) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1424 ;; ;; (define-key map "u" 'strokes-underline) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1425 ;; ;; (define-key map "t" 'strokes-truefont) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1426 ;; ;; (define-key map "F" 'strokes-foreground) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1427 ;; ;; (define-key map "B" 'strokes-background) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1428 ;; ;; (define-key map "D" 'strokes-doc-string) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1429 ;; (define-key map "a" 'strokes-global-set-stroke) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1430 ;; (define-key map "d" 'strokes-list-delete-stroke) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1431 ;; ;; (define-key map "n" 'strokes-list-next) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1432 ;; ;; (define-key map "p" 'strokes-list-prev) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1433 ;; ;; (define-key map " " 'strokes-list-next) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1434 ;; ;; (define-key map "\C-?" 'strokes-list-prev) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1435 ;; (define-key map "g" 'strokes-list-strokes) ; refresh display |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1436 ;; (define-key map "q" 'strokes-edit-quit) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1437 ;; (define-key map [(control c) (control c)] 'bury-buffer)) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1438 |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1439 ;;;;;###autoload |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1440 ;;(defun strokes-edit-strokes (&optional chronological strokes-map) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1441 ;; ;; ### DEAL WITH THE 2nd ARGUMENT ISSUE! ### |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1442 ;; "Edit strokes in a pop-up buffer containing strokes and their definitions. |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1443 ;;If STROKES-MAP is not given, `strokes-global-map' will be used instead. |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1444 |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1445 ;;Editing commands: |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1446 |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1447 ;;\\{edit-faces-mode-map}" |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1448 ;; (interactive "P") |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1449 ;; (pop-to-buffer (get-buffer-create "*Strokes List*")) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1450 ;; (reset-buffer (current-buffer)) ; handy function from minibuf.el |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1451 ;; (setq strokes-map (or strokes-map |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1452 ;; strokes-global-map |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1453 ;; (progn |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1454 ;; (strokes-load-user-strokes) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1455 ;; strokes-global-map))) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1456 ;; (or chronological |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1457 ;; (setq strokes-map (sort (copy-sequence strokes-map) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1458 ;; 'strokes-alphabetic-lessp))) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1459 ;; ;; (push-window-configuration) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1460 ;; (insert |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1461 ;; "Command Stroke\n" |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1462 ;; "------- ------") |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1463 ;; (loop for def in strokes-map |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1464 ;; for i from 0 to (1- (length strokes-map)) do |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1465 ;; (let ((stroke (car def)) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1466 ;; (command-name (symbol-name (cdr def)))) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1467 ;; (strokes-xpm-for-stroke stroke " *strokes-xpm*") |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1468 ;; (newline 2) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1469 ;; (insert-char ?\ 45) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1470 ;; (beginning-of-line) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1471 ;; (insert command-name) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1472 ;; (beginning-of-line) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1473 ;; (forward-char 45) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1474 ;; (set (intern (format "strokes-list-annotation-%d" i)) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1475 ;; (make-annotation (make-glyph |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1476 ;; (list |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1477 ;; (vector 'xpm |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1478 ;; :data (buffer-substring |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1479 ;; (point-min " *strokes-xpm*") |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1480 ;; (point-max " *strokes-xpm*") |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1481 ;; " *strokes-xpm*")) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1482 ;; [string :data "[Stroke]"])) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1483 ;; (point) 'text)) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1484 ;; (set-annotation-data (symbol-value (intern (format "strokes-list-annotation-%d" i))) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1485 ;; def)) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1486 ;; finally do (kill-region (1+ (point)) (point-max))) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1487 ;; (edit-strokes-mode) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1488 ;; (goto-char (point-min))) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1489 |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1490 ;;;;;###autoload |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1491 ;;(defalias 'edit-strokes 'strokes-edit-strokes) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1492 |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1493 (eval-when-compile (defvar view-mode-map)) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1494 |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1495 ;;;###autoload |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1496 (defun strokes-list-strokes (&optional chronological strokes-map) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1497 "Pop up a buffer containing an alphabetical listing of strokes in STROKES-MAP. |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1498 With CHRONOLOGICAL prefix arg \(\\[universal-argument]\) list strokes |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1499 chronologically by command name. |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1500 If STROKES-MAP is not given, `strokes-global-map' will be used instead." |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1501 (interactive "P") |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1502 (setq strokes-map (or strokes-map |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1503 strokes-global-map |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1504 (progn |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1505 (strokes-load-user-strokes) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1506 strokes-global-map))) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1507 (if (not chronological) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1508 ;; then alphabetize the strokes based on command names... |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1509 (setq strokes-map (sort (copy-sequence strokes-map) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1510 (function strokes-alphabetic-lessp)))) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1511 (let ((config (current-window-configuration))) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1512 (set-buffer (get-buffer-create "*Strokes List*")) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1513 (setq buffer-read-only nil) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1514 (erase-buffer) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1515 (insert |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1516 "Command Stroke\n" |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1517 "------- ------") |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1518 (loop for def in strokes-map do |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1519 (let ((stroke (car def)) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1520 (command-name (symbol-name (cdr def)))) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1521 (strokes-xpm-for-stroke stroke " *strokes-xpm*") |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1522 (newline 2) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1523 (insert-char ?\ 45) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1524 (beginning-of-line) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1525 (insert command-name) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1526 (beginning-of-line) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1527 (forward-char 45) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1528 (insert-image (create-image (with-current-buffer " *strokes-xpm*" |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1529 (buffer-string)) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1530 'xpm t))) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1531 finally do (kill-region (1+ (point)) (point-max))) |
43233
ae3e8c9e9b87
(strokes-do-stroke, strokes-do-complex-stroke): Doc fix.
Pavel Janík <Pavel@Janik.cz>
parents:
41603
diff
changeset
|
1532 (view-buffer "*Strokes List*" nil) |
31640
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1533 (set (make-local-variable 'view-mode-map) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1534 (let ((map (copy-keymap view-mode-map))) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1535 (define-key map "q" `(lambda () |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1536 (interactive) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1537 (View-quit) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1538 (set-window-configuration ,config))) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1539 map)) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1540 (goto-char (point-min)))) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1541 |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1542 (defun strokes-alphabetic-lessp (stroke1 stroke2) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1543 "T iff command name for STROKE1 is less than STROKE2's in lexicographic order." |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1544 (let ((command-name-1 (symbol-name (cdr stroke1))) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1545 (command-name-2 (symbol-name (cdr stroke2)))) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1546 (string-lessp command-name-1 command-name-2))) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1547 |
19345 | 1548 ;;;###autoload |
1549 (defun strokes-mode (&optional arg) | |
1550 "Toggle strokes being enabled. | |
1551 With ARG, turn strokes on if and only if ARG is positive or true. | |
1552 Note that `strokes-mode' is a global mode. Think of it as a minor | |
1553 mode in all buffers when activated. | |
1554 By default, strokes are invoked with mouse button-2. You can define | |
1555 new strokes with | |
1556 | |
1557 > M-x global-set-stroke | |
1558 | |
1559 To use strokes for pictographic editing, such as Chinese/Japanese, use | |
31640
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1560 S-mouse-2, which draws strokes and inserts them. Encode/decode your |
19345 | 1561 strokes with |
1562 | |
1563 > M-x strokes-encode-buffer | |
1564 > M-x strokes-decode-buffer" | |
1565 (interactive "P") | |
1566 (let ((on-p (if arg | |
1567 (> (prefix-numeric-value arg) 0) | |
1568 (not strokes-mode)))) | |
30540
ed5f60298be9
(strokes-file): Run the file name through
Eli Zaretskii <eliz@gnu.org>
parents:
27975
diff
changeset
|
1569 (cond ((not (display-mouse-p)) |
ed5f60298be9
(strokes-file): Run the file name through
Eli Zaretskii <eliz@gnu.org>
parents:
27975
diff
changeset
|
1570 (error "Can't use strokes without a mouse")) |
19345 | 1571 (on-p ; turn on strokes |
31640
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1572 (strokes-insinuate) ; make sure defadvices are set |
19345 | 1573 (and (file-exists-p strokes-file) |
1574 (null strokes-global-map) | |
1575 (strokes-load-user-strokes)) | |
19347 | 1576 (add-hook 'kill-emacs-query-functions |
19345 | 1577 'strokes-prompt-user-save-strokes) |
1578 (add-hook 'select-frame-hook | |
1579 'strokes-update-window-configuration) | |
1580 (strokes-update-window-configuration) | |
19347 | 1581 (define-key global-map [(down-mouse-2)] 'strokes-do-stroke) |
31640
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1582 (define-key global-map [(meta down-mouse-2)] |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1583 'strokes-do-complex-stroke) |
19347 | 1584 ;; (define-key global-map [(control down-mouse-2)] 'strokes-do-complex-stroke) |
19345 | 1585 (ad-activate-regexp "^strokes-") ; advise button2 commands |
1586 (setq strokes-mode t)) | |
1587 (t ; turn off strokes | |
1588 (if (get-buffer strokes-buffer-name) | |
1589 (kill-buffer (get-buffer strokes-buffer-name))) | |
1590 (remove-hook 'select-frame-hook | |
1591 'strokes-update-window-configuration) | |
19347 | 1592 (if (string-match "^strokes-" (symbol-name (key-binding [(down-mouse-2)]))) |
1593 (define-key global-map [(down-mouse-2)] strokes-click-command)) | |
1594 (if (string-match "^strokes-" (symbol-name (key-binding [(meta down-mouse-2)]))) | |
31640
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1595 (global-unset-key [(meta down-mouse-2)])) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1596 (if (string-match "^strokes-" (symbol-name (key-binding [(control down-mouse-2)]))) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1597 (global-unset-key [(control down-mouse-2)])) |
19345 | 1598 ;; (if (string-match "^strokes-" (symbol-name (key-binding [(shift button2)]))) |
1599 ;; (global-unset-key [(shift button2)])) | |
1600 (ad-deactivate-regexp "^strokes-") ; unadvise strokes-button2 commands | |
1601 (setq strokes-mode nil)))) | |
1602 (force-mode-line-update)) | |
1603 | |
31640
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1604 ;;;; strokes-xpm stuff (later may be separate)... |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1605 |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1606 ;; This is the stuff that will eventuall be used for composing letters in |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1607 ;; any language, compression, decompression, graphics, editing, etc. |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1608 |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1609 (defface strokes-char-face '((t (:background "lightgray"))) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1610 "Face for strokes characters." |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1611 :version "21.1" |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1612 :group 'strokes) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1613 |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1614 (put 'strokes 'char-table-extra-slots 0) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1615 (defconst strokes-char-table (make-char-table 'strokes) ; |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1616 "The table which stores values for the character keys.") |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1617 (aset strokes-char-table ?0 0) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1618 (aset strokes-char-table ?1 1) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1619 (aset strokes-char-table ?2 2) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1620 (aset strokes-char-table ?3 3) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1621 (aset strokes-char-table ?4 4) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1622 (aset strokes-char-table ?5 5) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1623 (aset strokes-char-table ?6 6) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1624 (aset strokes-char-table ?7 7) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1625 (aset strokes-char-table ?8 8) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1626 (aset strokes-char-table ?9 9) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1627 (aset strokes-char-table ?a 10) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1628 (aset strokes-char-table ?b 11) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1629 (aset strokes-char-table ?c 12) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1630 (aset strokes-char-table ?d 13) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1631 (aset strokes-char-table ?e 14) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1632 (aset strokes-char-table ?f 15) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1633 (aset strokes-char-table ?g 16) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1634 (aset strokes-char-table ?h 17) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1635 (aset strokes-char-table ?i 18) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1636 (aset strokes-char-table ?j 19) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1637 (aset strokes-char-table ?k 20) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1638 (aset strokes-char-table ?l 21) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1639 (aset strokes-char-table ?m 22) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1640 (aset strokes-char-table ?n 23) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1641 (aset strokes-char-table ?o 24) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1642 (aset strokes-char-table ?p 25) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1643 (aset strokes-char-table ?q 26) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1644 (aset strokes-char-table ?r 27) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1645 (aset strokes-char-table ?s 28) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1646 (aset strokes-char-table ?t 29) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1647 (aset strokes-char-table ?u 30) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1648 (aset strokes-char-table ?v 31) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1649 (aset strokes-char-table ?w 32) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1650 (aset strokes-char-table ?x 33) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1651 (aset strokes-char-table ?y 34) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1652 (aset strokes-char-table ?z 35) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1653 (aset strokes-char-table ?A 36) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1654 (aset strokes-char-table ?B 37) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1655 (aset strokes-char-table ?C 38) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1656 (aset strokes-char-table ?D 39) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1657 (aset strokes-char-table ?E 40) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1658 (aset strokes-char-table ?F 41) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1659 (aset strokes-char-table ?G 42) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1660 (aset strokes-char-table ?H 43) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1661 (aset strokes-char-table ?I 44) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1662 (aset strokes-char-table ?J 45) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1663 (aset strokes-char-table ?K 46) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1664 (aset strokes-char-table ?L 47) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1665 (aset strokes-char-table ?M 48) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1666 (aset strokes-char-table ?N 49) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1667 (aset strokes-char-table ?O 50) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1668 (aset strokes-char-table ?P 51) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1669 (aset strokes-char-table ?Q 52) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1670 (aset strokes-char-table ?R 53) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1671 (aset strokes-char-table ?S 54) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1672 (aset strokes-char-table ?T 55) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1673 (aset strokes-char-table ?U 56) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1674 (aset strokes-char-table ?V 57) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1675 (aset strokes-char-table ?W 58) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1676 (aset strokes-char-table ?X 59) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1677 (aset strokes-char-table ?Y 60) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1678 (aset strokes-char-table ?Z 61) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1679 |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1680 (defconst strokes-base64-chars |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1681 ;; I wanted to make this a vector of individual like (vector ?0 |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1682 ;; ?1 ?2 ...), but `concat' in XEmacs-20.* refuses to accept single |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1683 ;; characters. |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1684 (vector "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1685 "a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l" "m" "n" "o" |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1686 "p" "q" "r" "s" "t" "u" "v" "w" "x" "y" "z" "A" "B" "C" "D" |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1687 "E" "F" "G" "H" "I" "J" "K" "L" "M" "N" "O" "P" "Q" "R" "S" |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1688 "T" "U" "V" "W" "X" "Y" "Z") |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1689 ;; (vector [?0] [?1] [?2] [?3] [?4] [?5] [?6] [?7] [?8] [?9] |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1690 ;; [?a] [?b] [?c] [?d] [?e] [?f] [?g] [?h] [?i] [?j] |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1691 ;; [?k] [?l] [?m] [?n] [?o] [?p] [?q] [?r] [?s] [?t] |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1692 ;; [?u] [?v] [?w] [?x] [?y] [?z] |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1693 ;; [?A] [?B] [?C] [?D] [?E] [?F] [?G] [?H] [?I] [?J] |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1694 ;; [?K] [?L] [?M] [?N] [?O] [?P] [?Q] [?R] [?S] [?T] |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1695 ;; [?U] [?V] [?W] [?X] [?Y] [?Z]) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1696 "Character vector for fast lookup of base-64 encoding of numbers in [0,61].") |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1697 |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1698 (defsubst strokes-xpm-char-on-p (char) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1699 "Non-nil if CHAR represents an `on' bit in the xpm." |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1700 (eq char ?*)) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1701 |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1702 (defsubst strokes-xpm-char-bit-p (char) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1703 "Non-nil if CHAR represents an `on' or `off' bit in the xpm." |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1704 (or (eq char ?\ ) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1705 (eq char ?*))) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1706 |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1707 ;;(defsubst strokes-xor (a b) ### Should I make this an inline function? ### |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1708 ;; "T iff one and only one of A and B is non-nil; otherwise, returns nil. |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1709 ;;NOTE: Don't use this as a numeric xor since it treats all non-nil |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1710 ;; values as t including `0' (zero)." |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1711 ;; (eq (null a) (not (null b)))) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1712 |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1713 (defsubst strokes-xpm-encode-length-as-string (length) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1714 "Given some LENGTH in [0,62) do a fast lookup of it's encoding." |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1715 (aref strokes-base64-chars length)) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1716 |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1717 (defsubst strokes-xpm-decode-char (character) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1718 "Given a CHARACTER, do a fast lookup to find its corresponding integer value." |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1719 (aref strokes-char-table character)) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1720 |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1721 (defun strokes-xpm-to-compressed-string (&optional xpm-buffer) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1722 "Convert the xpm in XPM-BUFFER into a compressed string representing the stroke. |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1723 XPM-BUFFER is an optional argument, and defaults to `*strokes-xpm*'." |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1724 (save-excursion |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1725 (set-buffer (setq xpm-buffer (or xpm-buffer "*strokes-xpm*"))) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1726 (goto-char (point-min)) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1727 (search-forward "/* pixels */") ; skip past header junk |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1728 (forward-char 2) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1729 ;; a note for below: |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1730 ;; the `current-char' is the char being counted -- NOT the char at (point) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1731 ;; which happens to be called `char-at-point' |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1732 (let ((compressed-string "+/") ; initialize the output |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1733 (count 0) ; keep a current count of |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1734 ; `current-char' |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1735 (last-char-was-on-p t) ; last entered stream |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1736 ; represented `on' bits |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1737 (current-char-is-on-p nil) ; current stream represents `on' bits |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1738 (char-at-point (char-after))) ; read the first char |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1739 (while (not (eq char-at-point ?})) ; a `}' denotes the |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1740 ; end of the pixmap |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1741 (cond ((zerop count) ; must restart counting |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1742 ;; check to see if the `char-at-point' is an actual pixmap bit |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1743 (when (strokes-xpm-char-bit-p char-at-point) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1744 (setq count 1 |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1745 current-char-is-on-p (strokes-xpm-char-on-p char-at-point))) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1746 (forward-char 1)) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1747 ((= count 61) ; maximum single char's |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1748 ; encoding length |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1749 (setq compressed-string (concat compressed-string |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1750 ;; add a zero-length |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1751 ;; encoding when |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1752 ;; necessary |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1753 (when (eq last-char-was-on-p |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1754 current-char-is-on-p) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1755 ;; "0" |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1756 (strokes-xpm-encode-length-as-string 0)) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1757 (strokes-xpm-encode-length-as-string 61)) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1758 last-char-was-on-p current-char-is-on-p |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1759 count 0)) ; note that we just set |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1760 ; count=0 and *don't* advance |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1761 ; (point) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1762 ((strokes-xpm-char-bit-p char-at-point) ; an actual xpm bit |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1763 (if (eq current-char-is-on-p |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1764 (strokes-xpm-char-on-p char-at-point)) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1765 ;; yet another of the same bit-type, so we continue |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1766 ;; counting... |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1767 (progn |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1768 (incf count) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1769 (forward-char 1)) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1770 ;; otherwise, it's the opposite bit-type, so we do a |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1771 ;; write and then restart count ### NOTE (for myself |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1772 ;; to be aware of) ### I really should advance |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1773 ;; (point) in this case instead of letting another |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1774 ;; iteration go through and letting the case: count=0 |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1775 ;; take care of this stuff for me. That's why |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1776 ;; there's no (forward-char 1) below. |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1777 (setq compressed-string (concat compressed-string |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1778 ;; add a zero-length |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1779 ;; encoding when |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1780 ;; necessary |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1781 (when (eq last-char-was-on-p |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1782 current-char-is-on-p) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1783 ;; "0" |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1784 (strokes-xpm-encode-length-as-string 0)) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1785 (strokes-xpm-encode-length-as-string count)) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1786 count 0 |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1787 last-char-was-on-p current-char-is-on-p))) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1788 (t ; ELSE it's some other useless |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1789 ; char, like `"' or `,' |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1790 (forward-char 1))) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1791 (setq char-at-point (char-after))) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1792 (concat compressed-string |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1793 (when (> count 0) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1794 (concat (when (eq last-char-was-on-p |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1795 current-char-is-on-p) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1796 ;; "0" |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1797 (strokes-xpm-encode-length-as-string 0)) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1798 (strokes-xpm-encode-length-as-string count))) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1799 "/")))) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1800 |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1801 ;;;###autoload |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1802 (defun strokes-decode-buffer (&optional buffer force) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1803 "Decode stroke strings in BUFFER and display their corresponding glyphs. |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1804 Optional BUFFER defaults to the current buffer. |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1805 Optional FORCE non-nil will ignore the buffer's read-only status." |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1806 (interactive) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1807 ;; (interactive "*bStrokify buffer: ") |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1808 (save-excursion |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1809 (set-buffer (setq buffer (get-buffer (or buffer (current-buffer))))) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1810 (when (or (not buffer-read-only) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1811 force |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1812 inhibit-read-only |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1813 (y-or-n-p |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1814 (format "Buffer %s is read-only. Strokify anyway? " buffer))) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1815 (let ((inhibit-read-only t)) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1816 (message "Strokifying %s..." buffer) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1817 (goto-char (point-min)) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1818 (let (ext string image) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1819 ;; The comment below is what i'd have to do if I wanted to |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1820 ;; deal with random newlines in the midst of the compressed |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1821 ;; strings. If I do this, I'll also have to change |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1822 ;; `strokes-xpm-to-compress-string' to deal with the newline, |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1823 ;; and possibly other whitespace stuff. YUCK! |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1824 ;; (while (re-search-forward "\\+/\\(\\w\\|\\)+/" nil t nil (get-buffer buffer)) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1825 (while (with-current-buffer buffer |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1826 (when (re-search-forward "\\+/\\(\\w+\\)/" nil t nil) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1827 (setq string (match-string 1)) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1828 (goto-char (match-end 0)) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1829 (replace-match " ") |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1830 t)) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1831 (strokes-xpm-for-compressed-string string " *strokes-xpm*") |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1832 (setq image (create-image (with-current-buffer " *strokes-xpm*" |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1833 (buffer-string)) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1834 'xpm t)) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1835 (insert-image image |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1836 (propertize " " |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1837 'type 'stroke-glyph |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1838 'stroke-glyph image |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1839 'data string)))) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1840 (message "Strokifying %s...done" buffer))))) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1841 |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1842 (defun strokes-encode-buffer (&optional buffer force) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1843 "Convert the glyphs in BUFFER to thier base-64 ASCII representations. |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1844 Optional BUFFER defaults to the current buffer. |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1845 Optional FORCE non-nil will ignore the buffer's read-only status." |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1846 ;; ### NOTE !!! ### (for me) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1847 ;; For later on, you can/should make the inserted strings atomic |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1848 ;; extents, so that the users have a clue that they shouldn't be |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1849 ;; editing inside them. Plus, if you make them extents, you can |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1850 ;; very easily just hide the glyphs, so if you unstrokify, and the |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1851 ;; restrokify, then those that already are glyphed don't need to be |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1852 ;; re-calculated, etc. It's just nicer that way. The only things |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1853 ;; to worry about is cleanup (i.e. do the glyphs get gc'd when the |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1854 ;; buffer is killed? |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1855 ;; (interactive "*bUnstrokify buffer: ") |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1856 (interactive) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1857 (save-excursion |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1858 (set-buffer (setq buffer (or buffer (current-buffer)))) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1859 (when (or (not buffer-read-only) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1860 force |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1861 inhibit-read-only |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1862 (y-or-n-p |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1863 (format "Buffer %s is read-only. Encode anyway? " buffer))) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1864 (message "Encoding strokes in %s..." buffer) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1865 ;; (map-extents |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1866 ;; (lambda (ext buf) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1867 ;; (when (eq (extent-property ext 'type) 'stroke-glyph) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1868 ;; (goto-char (extent-start-position ext)) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1869 ;; (delete-char 1) ; ### What the hell do I do here? ### |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1870 ;; (insert "+/" (extent-property ext 'data) "/") |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1871 ;; (delete-extent ext)))))) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1872 (let ((inhibit-read-only t) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1873 (start nil) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1874 glyph) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1875 (while (or (and (bobp) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1876 (get-text-property (point) 'type)) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1877 (setq start (next-single-property-change (point) 'type))) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1878 (when (eq 'stroke-glyph (get-text-property (point) 'type)) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1879 (goto-char start) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1880 (setq start (point-marker) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1881 glyph (get-text-property start 'display)) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1882 (insert "+/" (get-text-property (point) 'data) ?/) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1883 (delete-char 1) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1884 (add-text-properties start (point) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1885 (list 'type 'stroke-string |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1886 'face 'strokes-char-face |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1887 'stroke-glyph glyph |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1888 'display nil)))) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1889 (message "Encoding strokes in %s...done" buffer))))) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1890 |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1891 (defun strokes-xpm-for-compressed-string (compressed-string &optional bufname) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1892 "Convert the stroke represented by COMPRESSED-STRING into an xpm. |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1893 Store xpm in buffer BUFNAME if supplied \(default is `*strokes-xpm*'\)" |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1894 (save-excursion |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1895 (or bufname (setq bufname "*strokes-xpm*")) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1896 (set-buffer (get-buffer-create bufname)) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1897 (erase-buffer) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1898 (insert compressed-string) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1899 (goto-char (point-min)) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1900 (let ((current-char-is-on-p nil)) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1901 (while (not (eobp)) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1902 (insert-char |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1903 (if current-char-is-on-p |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1904 ?* |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1905 ?\ ) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1906 (strokes-xpm-decode-char (char-after))) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1907 (delete-char 1) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1908 (setq current-char-is-on-p (not current-char-is-on-p))) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1909 (goto-char (point-min)) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1910 (loop repeat 33 do |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1911 (insert ?\") |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1912 (forward-char 33) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1913 (insert "\",\n")) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1914 (goto-char (point-min)) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1915 (insert strokes-xpm-header)))) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1916 |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1917 ;;;###autoload |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1918 (defun strokes-compose-complex-stroke () |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1919 ;; ### NOTE !!! ### |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1920 ;; Even though we have lexical scoping, it's somewhat ugly how I |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1921 ;; pass around variables in the global name space. I can/should |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1922 ;; change this. |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1923 "Read a complex stroke and insert its glyph into the current buffer." |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1924 (interactive "*") |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1925 (let ((strokes-grid-resolution 33)) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1926 (strokes-read-complex-stroke) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1927 (strokes-xpm-for-stroke nil " *strokes-xpm*" t) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1928 (insert (strokes-xpm-to-compressed-string " *strokes-xpm*")) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1929 (strokes-decode-buffer) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1930 ;; strokes-decode-buffer does a save-excursion. |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1931 (forward-char))) |
27d41d6ec45d
Sync with maintainer's current version with changes
Dave Love <fx@gnu.org>
parents:
30540
diff
changeset
|
1932 |
19345 | 1933 (or (assq 'strokes-mode minor-mode-alist) |
19347 | 1934 (setq minor-mode-alist (cons (list 'strokes-mode strokes-modeline-string) |
1935 minor-mode-alist))) | |
19345 | 1936 |
1937 (provide 'strokes) | |
1938 (run-hooks 'strokes-load-hook) | |
1939 | |
1940 ;;; strokes.el ends here |