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