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