Mercurial > hg > xemacs-beta

comparison lisp/modes/strokes.el @ 185:3d6bfa290dbd r20-3b19

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b19
author cvs
date Mon, 13 Aug 2007 09:55:28 +0200
parents 6075d714658b
children b405438285a2
comparison
equal deleted inserted replaced
184:bcd2674570bf 185:3d6bfa290dbd
1 ;;; strokes.el -- Control XEmacs through mouse strokes -- 1 ;;; strokes.el -- Control XEmacs through mouse strokes --
2 ;; Mon Jun 2 12:40:41 EDT 1997 2 ;; Mon Jul 25 12:40:41 EDT 1997
3 3
4 ;; Copyright (C) 1997 Free Software Foundation, Inc. 4 ;; Copyright (C) 1997 Free Software Foundation, Inc.
5 5
6 ;; Author: David Bakhash <cadet@mit.edu> 6 ;; Author: David Bakhash <cadet@mit.edu>
7 ;; Maintainer: David Bakhash <cadet@mit.edu> 7 ;; Maintainer: David Bakhash <cadet@mit.edu>
8 ;; Version: 2.3 8 ;; Version: 2.4-beta
9 ;; Created: 12 April 1997 9 ;; Created: 12 April 1997
10 ;; Keywords: lisp, mouse, extensions 10 ;; Keywords: lisp, mouse, extensions
11 11
12 ;; This file is part of XEmacs. 12 ;; This file is part of XEmacs.
13 13
28 28
29 ;;; Synched up with: Not in FSF. 29 ;;; Synched up with: Not in FSF.
30 30
31 ;;; Commentary: 31 ;;; Commentary:
32 32
33 ;; This package is written for for XEmacs v19.14 and up. 33 ;; This package is written for for XEmacs v19.15 and up. This is the
34 ;; This is the strokes package. It is intended to allow the user to 34 ;; strokes package. It is intended to allow the user to control
35 ;; control XEmacs by means of mouse strokes. Once strokes is loaded, you 35 ;; XEmacs by means of mouse strokes. Once strokes is loaded, you can
36 ;; can always get help be invoking `strokes-help': 36 ;; always get help be invoking `strokes-help':
37 37
38 ;; > M-x strokes-help 38 ;; > M-x strokes-help
39 39
40 ;; and you can learn how to use the package. A mouse stroke, for now, 40 ;; and you can learn how to use the package. A mouse stroke, for now,
41 ;; can be defined as holding the middle button, for instance, and then 41 ;; can be defined as holding the middle button, for instance, and then
42 ;; moving the mouse in whatever pattern you wish, which you have set 42 ;; moving the mouse in whatever pattern you wish, which you have set
43 ;; XEmacs to understand as mapping to a given command. For example, you 43 ;; XEmacs to understand as mapping to a given command. For example,
44 ;; may wish the have a mouse stroke that looks like a capital `C' which 44 ;; you may wish the have a mouse stroke that looks like a capital `C'
45 ;; means `copy-region-as-kill'. Treat strokes just like you do key 45 ;; which means `copy-region-as-kill'. Treat strokes just like you do
46 ;; bindings. For example, XEmacs sets key bindings globally with the 46 ;; key bindings. For example, XEmacs sets key bindings globally with
47 ;; `global-set-key' command. Likewise, you can do 47 ;; the `global-set-key' command. Likewise, you can do
48 48
49 ;; > M-x global-set-stroke 49 ;; > M-x global-set-stroke
50 50
51 ;; to interactively program in a stroke. It would be wise to set the 51 ;; to interactively program in a stroke. It would be wise to set the
52 ;; first one to this very command, so that from then on, you invoke 52 ;; first one to this very command, so that from then on, you invoke
64 64
65 ;; 1) To describe a stroke binding, you can type 65 ;; 1) To describe a stroke binding, you can type
66 66
67 ;; > M-x describe-stroke 67 ;; > M-x describe-stroke
68 68
69 ;; analogous to `describe-key'. It's also wise to have a stroke, 69 ;; analogous to `describe-key'. It's also wise to have a
70 ;; like an `h', for help, or a `?', mapped to `describe-stroke'. 70 ;; stroke, like an `h', for help, or a `?', mapped to
71 71 ;; `describe-stroke'.
72 ;; 2) stroke bindings are set internally through the lisp function 72
73 ;; 2) stroke bindings are set internally through the Lisp function
73 ;; `define-stroke', similar to the `define-key' function. some 74 ;; `define-stroke', similar to the `define-key' function. some
74 ;; examples for a 3x3 stroke grid would be 75 ;; examples for a 3x3 stroke grid would be
75 76
76 ;; (define-stroke c-mode-stroke-map 77 ;; (define-stroke c-mode-stroke-map
77 ;; '((0 . 0) (1 . 1) (2 . 2)) 78 ;; '((0 . 0) (1 . 1) (2 . 2))
78 ;; 'kill-region) 79 ;; 'kill-region)
79 ;; (define-stroke strokes-global-map 80 ;; (define-stroke strokes-global-map
80 ;; '((0 . 0) (0 . 1) (0 . 2) (1 . 2) (2 . 2)) 81 ;; '((0 . 0) (0 . 1) (0 . 2) (1 . 2) (2 . 2))
81 ;; 'list-buffers) 82 ;; 'list-buffers)
82 83
83 ;; however, if you would probably just have the user enter in the 84 ;; however, if you would probably just have the user enter in
84 ;; stroke interactively and then set the stroke to whatever he/she 85 ;; the stroke interactively and then set the stroke to whatever
85 ;; entered. The lisp function to interactively read a stroke is 86 ;; he/she entered. The Lisp function to interactively read a
86 ;; `strokes-read-stroke'. This is especially helpful when you're 87 ;; stroke is `strokes-read-stroke'. This is especially helpful
87 ;; on a fast computer that can handle a 9x9 stroke grid. 88 ;; when you're on a fast computer that can handle a 9x9 stroke
89 ;; grid.
88 90
89 ;; NOTE: only global stroke bindings are currently implemented, 91 ;; NOTE: only global stroke bindings are currently implemented,
90 ;; however mode- and buffer-local stroke bindings may eventually 92 ;; however mode- and buffer-local stroke bindings may eventually
91 ;; be implemented in a future version. 93 ;; be implemented in a future version.
92 94
96 ;; > M-x customize 98 ;; > M-x customize
97 99
98 ;; and customizing the group named `strokes'. You can also read 100 ;; and customizing the group named `strokes'. You can also read
99 ;; documentation on the variables there. 101 ;; documentation on the variables there.
100 102
101 ;; `strokes-minimum-match-score' (determines the threshold of error that 103 ;; `strokes-minimum-match-score' (determines the threshold of error
102 ;; makes a stroke acceptable or unacceptable. If your strokes arn't 104 ;; that makes a stroke acceptable or unacceptable. If your strokes
103 ;; matching, then you should raise this variable. 105 ;; aren't matching, then you should raise this variable.
104 106
105 ;; `strokes-grid-resolution' (determines the grid dimensions that you use 107 ;; `strokes-grid-resolution' (determines the grid dimensions that you
106 ;; when defining/reading strokes. The finer the grid your computer can 108 ;; use when defining/reading strokes. The finer the grid your
107 ;; handle, the more you can do, but even a 3x3 grid is pretty cool.) 109 ;; computer can handle, the more you can do, but even a 3x3 grid is
108 ;; The default value (7) should be fine for most decent computers. 110 ;; pretty cool.) The default value (7) should be fine for most decent
109 ;; NOTE: This variable should not be set to a number less than 3. 111 ;; computers. NOTE: This variable should not be set to a number less
112 ;; than 3.
110 113
111 ;; `strokes-display-strokes-buffer' will allow you to hide the strokes 114 ;; `strokes-display-strokes-buffer' will allow you to hide the strokes
112 ;; buffer when doing simple strokes. This is a speedup for slow 115 ;; buffer when doing simple strokes. This is a speedup for slow
113 ;; computers as well as people who don't want to see their strokes. 116 ;; computers as well as people who don't want to see their strokes.
114 117
122 ;; Whenever you load in the strokes package, you will be able to save 125 ;; Whenever you load in the strokes package, you will be able to save
123 ;; what you've done upon exiting XEmacs. You can also do 126 ;; what you've done upon exiting XEmacs. You can also do
124 127
125 ;; > M-x save-strokes 128 ;; > M-x save-strokes
126 129
127 ;; and it will save your strokes in ~/.strokes, or you may wish to change 130 ;; and it will save your strokes in ~/.strokes, or you may wish to
128 ;; this by setting the variable `strokes-file'. 131 ;; change this by setting the variable `strokes-file'.
129 132
130 ;; Note that internally, all of the routines that are part of this 133 ;; Note that internally, all of the routines that are part of this
131 ;; package are able to deal with complex strokes, as they are a superset 134 ;; package are able to deal with complex strokes, as they are a
132 ;; of simple strokes. However, the default of this package will map 135 ;; superset of simple strokes. However, the default of this package
133 ;; mouse button2 to the command `strokes-do-stroke', and NOT 136 ;; will map mouse button2 to the command `strokes-do-stroke', and NOT
134 ;; `strokes-do-complex-stroke'. If you wish to use complex strokes, you 137 ;; `strokes-do-complex-stroke'. If you wish to use complex strokes,
135 ;; will have to override this key mapping. Complex strokes are terminated 138 ;; you will have to override this key mapping. Complex strokes are
136 ;; with mouse button3. The strokes package will not interfere with 139 ;; terminated with mouse button3. The strokes package will not
137 ;; `mouse-yank', but you may want to examine how this is done (see the 140 ;; interfere with `mouse-yank', but you may want to examine how this
138 ;; variable `strokes-click-command') 141 ;; is done (see the variable `strokes-click-command')
139 142
140 ;; To get strokes to work as part of your your setup, then you'll have 143 ;; To get strokes to work as part of your your setup, then you'll have
141 ;; put the strokes package in your load-path (preferably byte-compiled) 144 ;; put the strokes package in your load-path (preferably
142 ;; and then add the following to your .xemacs-options file (or wherever 145 ;; byte-compiled) and then add the following to your .emacs file (or
143 ;; you put XEmacs-specific startup preferences): 146 ;; wherever you put XEmacs-specific startup preferences):
144 147
145 ;;(and (fboundp 'device-on-window-system-p) 148 ;; (if window-system (require 'strokes))
146 ;; (device-on-window-system-p)
147 ;; (require 'strokes))
148 149
149 ;; Once loaded, you can start stroking. You can also toggle between 150 ;; Once loaded, you can start stroking. You can also toggle between
150 ;; strokes mode by simple typing 151 ;; strokes mode by simple typing
151 152
152 ;; > M-x strokes-mode 153 ;; > M-x strokes-mode
153 154
154 ;; I am now in the process of porting this package to emacs. I also hope 155 ;; I am now in the process of porting this package to Emacs. I also
155 ;; that, with the help of others, this package will be useful in entering 156 ;; hope that, with the help of others, this package will be useful in
156 ;; in pictographic-like language text using the mouse (i.e. Korean). 157 ;; entering in pictographic-like language text using the mouse
157 ;; Japanese and Chinese are a bit trickier, but I'm sure that with help 158 ;; (i.e. Korean). Japanese and Chinese are a bit trickier, but I'm
158 ;; it can be done. The next version will allow the user to enter strokes 159 ;; sure that with help it can be done. The next version will allow
159 ;; which "remove the pencil from the paper" so to speak, so one character 160 ;; the user to enter strokes which "remove the pencil from the paper"
160 ;; can have multiple strokes. 161 ;; so to speak, so one character can have multiple strokes.
161 162
162 ;; You can read more about strokes at: 163 ;; You can read more about strokes at:
163 164
164 ;; http://www.mit.edu/people/cadet/strokes-help.html 165 ;; http://www.mit.edu/people/cadet/strokes-help.html
165 166
166 ;; If you're interested in using strokes for writing English into XEmacs 167 ;; If you're interested in using strokes for writing English into
167 ;; using strokes, then you'll want to read about it on the web page above 168 ;; XEmacs using strokes, then you'll want to read about it on the web
168 ;; or just download from http://www.mit.edu/people/cadet/strokes-abc.el, 169 ;; page above or just download from
169 ;; which is nothing but a file with some helper commands for inserting 170 ;; http://www.mit.edu/people/cadet/strokes-abc.el, which is nothing
170 ;; alphanumerics and punctuation. 171 ;; but a file with some helper commands for inserting alphanumerics
171 172 ;; and punctuation.
172 ;; Great thanks to Rob Ristroph for his generosity in letting me use his 173
173 ;; PC to develop this, Jason Johnson for his help in algorithms, Euna 174 ;; Great thanks to Rob Ristroph for his generosity in letting me use
174 ;; Kim for her help in Korean, and massive thanks to the helpful guys 175 ;; his PC to develop this, Jason Johnson for his help in algorithms,
175 ;; on the help instance on athena (zeno, jered, amu, gsstark, ghudson, etc) 176 ;; Euna Kim for her help in Korean, and massive thanks to the helpful
176 ;; Special thanks to Steve Baur and Hrvoje Niksic for all their help. 177 ;; guys on the help instance on athena (zeno, jered, amu, gsstark,
177 ;; And even more thanks to Dave Gillespie for all the elisp help--he 178 ;; ghudson, etc) Special thanks to Steve Baur, Kyle Jones, and Hrvoje
178 ;; is responsible for helping me use the cl macros at (near) max speed. 179 ;; Niksic for all their help. And special thanks to Dave Gillespie
180 ;; for all the elisp help--he is responsible for helping me use the cl
181 ;; macros at (near) max speed.
179 182
180 ;; Tasks: (what I'm getting ready for future version)... 183 ;; Tasks: (what I'm getting ready for future version)...
181 ;; 2) use 'strokes-read-complex-stroke for korean, etc. 184 ;; 2) use 'strokes-read-complex-stroke for korean, etc.
182 ;; 4) buffer-local 'strokes-local-map, and mode-stroke-maps would be nice 185 ;; 4) buffer-local 'strokes-local-map, and mode-stroke-maps would be nice
183 ;; 5) 'list-strokes (kinda important). What do people want?
184 ;; How about an optional docstring for each stroke so that a person
185 ;; can examine the strokes-file and actually make sense of it?
186 ;; (e.g. "This stroke is a pentagram")
187 ;; 6) add some hooks, like `strokes-read-stroke-hook' 186 ;; 6) add some hooks, like `strokes-read-stroke-hook'
188 ;; 7) See what people think of the factory settings. Should I change 187 ;; 7) See what people think of the factory settings. Should I change
189 ;; them? They're all pretty arbitrary in a way. I guess they 188 ;; them? They're all pretty arbitrary in a way. I guess they
190 ;; should be minimal, but computers are getting lots faster, and 189 ;; should be minimal, but computers are getting lots faster, and
191 ;; if I choose the defaults too conservatively, then strokes will 190 ;; if I choose the defaults too conservatively, then strokes will
192 ;; surely dissapoint some people on decent machines (until they 191 ;; surely disappoint some people on decent machines (until they
193 ;; figure out M-x customize). I need feedback. 192 ;; figure out M-x customize). I need feedback.
194 ;; Other: I always have the most beta version of strokes, so if you 193 ;; Other: I always have the most beta version of strokes, so if you
195 ;; want it just let me know. 194 ;; want it just let me know.
196 195
197 ;;; Change Log: 196 ;;; Change Log:
198 197
199 ;; 1.3: provided user variable `strokes-use-strokes-buffer' to let users 198 ;; 1.3: provided user variable `strokes-use-strokes-buffer' to let
200 ;; hide the strokes and strokes buffer when entering simple strokes. 199 ;; users hide the strokes and strokes buffer when entering simple
200 ;; strokes.
201 ;; 1.3: cleaned up most leaks. 201 ;; 1.3: cleaned up most leaks.
202 ;; 1.3: with Jari Aalto's help, cleaned up overall program. 202 ;; 1.3: with Jari Aalto's help, cleaned up overall program.
203 ;; 1.3: added `strokes-help' for help on strokes 203 ;; 1.3: added `strokes-help' for help on strokes
204 ;; 1.3: fixed 'strokes-load-hook bug 204 ;; 1.3: fixed 'strokes-load-hook bug
205 ;; 1.3: email address change: now <cadet@mit.edu> 205 ;; 1.3: email address change: now <cadet@mit.edu>
206 ;; 1.3: added `strokes-report-bug' based on efs/dired's `dired-report-bug' 206 ;; 1.3: added `strokes-report-bug' based on efs/dired's
207 ;; `dired-report-bug'
207 ;; 1.3: added more dialog-box queries for mouse-event stuff. 208 ;; 1.3: added more dialog-box queries for mouse-event stuff.
208 ;; 1.4: allowed strokes to invoke kbd macros as well (thanks gsstark!) 209 ;; 1.4: allowed strokes to invoke kbd macros as well (thanks gsstark!)
209 ;; 2.0: fixed up ordering of certain functions. 210 ;; 2.0: fixed up ordering of certain functions.
210 ;; 2.0: fixed bug applying to strokes in dedicated and minibuffer windows. 211 ;; 2.0: fixed bug applying to strokes in dedicated and minibuffer
212 ;; windows.
211 ;; 2.0: punted the C-h way of invoking strokes help routines. 213 ;; 2.0: punted the C-h way of invoking strokes help routines.
212 ;; 2.0: fixed `strokes-define-stroke' so it would error check against 214 ;; 2.0: fixed `strokes-define-stroke' so it would error check against
213 ;; defining strokes that were too short (really clicks) 215 ;; defining strokes that were too short (really clicks) 2.0:
214 ;; 2.0: added `strokes-toggle-strokes-buffer' interactive function 216 ;; added `strokes-toggle-strokes-buffer' interactive function
215 ;; 2.0: added `customize' support, thanks to patch from Hrvoje (thanks) 217 ;; 2.0: added `customize' support, thanks to patch from Hrvoje
216 ;; 2.1: strokes no longer forces `mouse-yank-at-point' to t on mouse-yank 218 ;; (thanks)
217 ;; (i.e. `mouse-yank-at-point' is up to you again) 219 ;; 2.1: strokes no longer forces `mouse-yank-at-point' to t on
220 ;; mouse-yank (i.e. `mouse-yank-at-point' is up to you again)
218 ;; 2.1: toggling strokes-mode off and then back on no longer deletes 221 ;; 2.1: toggling strokes-mode off and then back on no longer deletes
219 ;; the strokes that you programmed in but didn't save before 222 ;; the strokes that you programmed in but didn't save before
220 ;; toggling off strokes-mode. 223 ;; toggling off strokes-mode.
221 ;; 2.1: advised may functions for modes like VM and w3 so that they too 224 ;; 2.1: advised may functions for modes like VM and w3 so that they
222 ;; can use strokes, while still mantaining old button2 functionality. 225 ;; too can use strokes, while still maintaining old button2
223 ;; 2.1: with steve's help, got the autoload for `strokes-mode' and 226 ;; functionality.
227 ;; 2.1: with Steve's help, got the autoload for `strokes-mode' and
224 ;; fixed up the package so loading it does not enable strokes 228 ;; fixed up the package so loading it does not enable strokes
225 ;; until user calls `strokes-mode'. 229 ;; until user calls `strokes-mode'.
226 ;; 2.2: made sure that abbrev-mode was off in the ` *strokes*' buffer 230 ;; 2.2: made sure that abbrev-mode was off in the ` *strokes*' buffer
227 ;; 2.2: added more dired advice for mouse permissions commands 231 ;; 2.2: added more dired advice for mouse permissions commands
228 ;; 2.2: added some checks to see if saving strokes is really necessary so 232 ;; 2.2: added some checks to see if saving strokes is really necessary
229 ;; the user doesn't get promped aimlessly. 233 ;; so the user doesn't get prompted aimlessly.
230 ;; 2.2: change the `strokes-lift' symbol to a keyword of value `:strokes-lift' 234 ;; 2.2: change the `strokes-lift' symbol to a keyword of value
231 ;; for legibility. IF YOUR OLD STROKES DON'T WORK, THIS IS PROBABLY WHY. 235 ;; `:strokes-lift' for legibility. IF YOUR OLD STROKES DON'T
232 ;; 2.2: I might have to change this back to `'strokes-lift' because the keyword 236 ;; WORK, THIS IS PROBABLY WHY.
233 ;; fails in emacs, though I don't know why. 237 ;; 2.2: I might have to change this back to `'strokes-lift' because
238 ;; the keyword fails in emacs, though I don't know why.
234 ;; 2.2: `strokes-describe-stroke' is nicer during recursive edits 239 ;; 2.2: `strokes-describe-stroke' is nicer during recursive edits
235 ;; 2.2: provided `strokes-fill-stroke' to fill in empty spaces of strokes 240 ;; 2.2: provided `strokes-fill-stroke' to fill in empty spaces of strokes
236 ;; as an important step towards platform (speed) independence. 241 ;; as an important step towards platform (speed) independence.
237 ;; Because of this, I moved the global setting of `strokes-last-stroke' 242 ;; Because of this, I moved the global setting of
238 ;; from `strokes-eliminate-consecutive-redundancies' to 243 ;; `strokes-last-stroke' from
239 ;; `strokes-fill-stroke' since the latter comes later in processing 244 ;; `strokes-eliminate-consecutive-redundancies' to
240 ;; a user stroke. 245 ;; `strokes-fill-stroke' since the latter comes later in
246 ;; processing a user stroke.
241 ;; 2.2: Finally changed the defaults, so now `strokes-grid-resolution' is 9 247 ;; 2.2: Finally changed the defaults, so now `strokes-grid-resolution' is 9
242 ;; and `strokes-minimum-match-score' is 1000 by default. This will surely 248 ;; and `strokes-minimum-match-score' is 1000 by default. This
243 ;; mess some people up, but if so, just set it back w/ M-x customize. 249 ;; will surely mess some people up, but if so, just set it back
244 ;; 2.2: Fixed up the mechanism for updating the `strokes-window-configuration'. 250 ;; w/ M-x customize.
245 ;; Now it only uses one function (`strokes-update-window-configuration') 251 ;; 2.2: Fixed up the mechanism for updating the
246 ;; which does it all, and much more efficiently (thanks RMS!). 252 ;; `strokes-window-configuration'. Now it only uses one function
247 ;; 2.2 Fixed up the appearance of the *strokes* buffer so that there are no 253 ;; (`strokes-update-window-configuration') which does it all, and
248 ;; ugly line truncations, and I got rid of the bug which would draw the stroke 254 ;; much more efficiently (thanks RMS!).
249 ;; on the wrong line. I still wish that `event-closest-point' was smarter. 255 ;; 2.2 Fixed up the appearance of the *strokes* buffer so that there
250 ;; In fact, `event-closest-point' does *not* do what its name suggests. 256 ;; are no ugly line truncations, and I got rid of the bug which
251 ;; 2.3 Added more to `strokes-update-window-configuration' so it goes to hell less often 257 ;; would draw the stroke on the wrong line. I still wish that
252 ;; 2.3 `strokes-mode' no longer will undefine keys unless it's sure that the user had 258 ;; `event-closest-point' was smarter. In fact,
253 ;; had them mapped to a strokes command. 259 ;; `event-closest-point' does *not* do what its name suggests.
254 ;; 2.3 added more magic autoload statements so strokes work more smoothly. 260 ;; 2.3 Added more to `strokes-update-window-configuration' so it goes
255 ;; similarly, I made strokes-mode turn itself on when the user defines a stroke 261 ;; to hell less often
256 ;; (thanks Hrvoje). 262 ;; 2.3 `strokes-mode' no longer will undefined keys unless it's sure
257 ;; 2.3 Added "Strokes" to the modeline when strokes is on, and allow toggling strokes 263 ;; that the user had had them mapped to a strokes command.
258 ;; with mouse button2. 264 ;; 2.3 Added more magic autoload statements so strokes work more
259 ;; 2.3 Added `list-strokes', which is a really nice function which graphically lists 265 ;; smoothly. similarly, I made strokes-mode turn itself on when
260 ;; all the strokes that the user has defined and their corresponding commands. 266 ;; the user defines a stroke (thanks Hrvoje).
261 ;; `list-strokes' will appropriately colorize the pixmaps to display some time info. 267 ;; 2.3 Added "Strokes" to the modeline when strokes is on, and allow
268 ;; toggling strokes with mouse button2.
269 ;; 2.3 Added `list-strokes', which is a really nice function which
270 ;; graphically lists all the strokes that the user has defined
271 ;; and their corresponding commands. `list-strokes' will
272 ;; appropriately colorize the pixmaps to display some time info.
273 ;; 2.4 Added all new functionality to strokes by allowing the user to
274 ;; enter strokes in graphically into XEmacs, allowing true graphic
275 ;; editing, Chinese/Japanese, etc. User simply uses C-button2 to
276 ;; draw strokes (function: `strokes-compose-complex-stroke'). Then
277 ;; after the glyph gets inserted into the current buffer at (point),
278 ;; the use can treat that glyph as any other character, and
279 ;; copy/paste/delete/undo, etc. Also, when the user would like to
280 ;; save/send the glyphs (to other XEmacs users, of course), he/she
281 ;; can use the helper functions:
282 ;;
283 ;; i. M-x strokes-encode-buffer -- Ascii-encodes and compresses
284 ;; strokes to base-64.
285 ;; ii. M-x strokes-decode-buffer -- Decodes ascii-encoded strokes
286 ;; back into glyphs.
287 ;; 2.4 With help from Kyle fixed the itimer (timeout event) bug, where I
288 ;; forgot to check for timeouts.
289 ;; 2.4 Around this time, made a successful port of strokes.el for emacs.
290 ;; 2.4 Made added `strokes-xpm-header' as a variable.
291 ;; 2.4 Changed the default value of `strokes-character' from `o' to
292 ;; `@' since it looks nicer when drawn.
293 ;; 2.4 Changed `strokes-click-p' so that it considers only a stroke
294 ;; of length <= 1 a click, as opposed to a length 2 being a
295 ;; click.
296 ;; 2.4 Totally made the the function `strokes-read-stroke' (and a bit
297 ;; on `strokes-read-complex-stroke') more efficient and robust,
298 ;; making the former use the optional event passed to it, and
299 ;; thus not losing the first mouse event position when reading a
300 ;; stroke on the fly.
301 ;; 2.4 Finally fixed the mouse-yank / mouse-yank-at-point bug (after
302 ;; months of struggling with it). I simply inserted a (sit-for 0)
303 ;; before the (command-execute strokes-click-command) and that
304 ;; patched it up. I'd thought that it was a kludge, but I later
305 ;; found out that it wasn't, as redisplay has several states, and
306 ;; command-execute often must decide which of two states must be
307 ;; considered when executing a command. The (sit-for 0) merely
308 ;; allowed redisplay to be sure to wait for the ` *strokes*'
309 ;; buffer to vanish before executing the command (thanks for the
310 ;; explanation of why my frobbing worked Kyle). Fixing this bug
311 ;; also (magically) fixed the bug which prevented strokes from
312 ;; executing a stroke in a mode which had it's own binding for
313 ;; button-2, such as w3 when the variable
314 ;; `strokes-use-strokes-buffer' is non-nil. It used to be that
315 ;; if you chose to view your strokes, then you couldn't use
316 ;; strokes properly in modes like VM or w3. Now you can!
317 ;; 2.4 Replaced `kill-emacs-hook' with `kill-emacs-query-functions'
318 ;; for prompting the user to save his/her strokes, since
319 ;; `kill-emacs-hook' was not the right hook to use.
320 ;; 2.4 Having `strokes-update-window-configuration' bound to
321 ;; `select-frame-hook' was a heavy function for such a commonly
322 ;; run hook -- especially since event-Xt.c (?) will add the
323 ;; eval-event to the event queue. So the effect was that if XEmacs
324 ;; was doing an interpreter-intensive task while the user (re)selected
325 ;; the frame n times, then the intensive window config updating
326 ;; took place n times. So to deal, I put in some extra checks to
327 ;; see if the frame parameters really changed, making an update
328 ;; worthwhile. See `strokes-update-window-configuration-plist'.
262 329
263 ;;; Code: 330 ;;; Code:
264 331
265 ;;; Requirements and provisions... 332 ;;; Requirements and provisions...
266 333
267 (autoload 'reporter-submit-bug-report "reporter") 334 (autoload 'reporter-submit-bug-report "reporter")
268 (autoload 'mail-position-on-field "sendmail") 335 (autoload 'mail-position-on-field "sendmail")
269 (eval-when-compile 336 (eval-when-compile
270 (mapc 'require '(xpm-mode pp annotations reporter advice))) 337 (mapc 'require '(xpm-mode pp annotations reporter advice view-less)))
271 338
272 ;;; Constants... 339 ;;; Constants...
273 340
274 (defconst strokes-version "2.3") 341 (defconst strokes-version "2.4-beta")
275 342
276 (defconst strokes-bug-address "cadet@mit.edu") 343 (defconst strokes-bug-address "cadet@mit.edu")
277 344
278 (defconst strokes-lift :strokes-lift 345 (defconst strokes-lift :strokes-lift
279 "Symbol representing a stroke lift event for complex strokes. 346 "Symbol representing a stroke lift event for complex strokes.
283 (defconst strokes-xpm-header "/* XPM */ 350 (defconst strokes-xpm-header "/* XPM */
284 static char * stroke_xpm[] = { 351 static char * stroke_xpm[] = {
285 /* width height ncolors cpp [x_hot y_hot] */ 352 /* width height ncolors cpp [x_hot y_hot] */
286 \"33 33 9 1 26 23\", 353 \"33 33 9 1 26 23\",
287 /* colors */ 354 /* colors */
288 \" c #D9D9D9D9D9D9\", 355 \" c none s none\",
289 \"* s iconColor1 m black c black\", 356 \"* c #000000 s foreground\",
290 \"R c #FFFF00000000\", 357 \"R c #FFFF00000000\",
291 \"O c #FFFF80000000\", 358 \"O c #FFFF80000000\",
292 \"Y c #FFFFFFFF0000\", 359 \"Y c #FFFFFFFF0000\",
293 \"G c #0000FFFF0000\", 360 \"G c #0000FFFF0000\",
294 \"B c #00000000FFFF\", 361 \"B c #00000000FFFF\",
298 "The header to all xpm buffers created by strokes") 365 "The header to all xpm buffers created by strokes")
299 366
300 ;;; user variables... 367 ;;; user variables...
301 368
302 (defgroup strokes nil 369 (defgroup strokes nil
303 "Control Emacs through mouse strokes" 370 "Control Emacs through mouse strokes."
304 :group 'mouse) 371 :group 'mouse)
305 372
306 (defcustom strokes-modeline-string " Strokes" 373 (defcustom strokes-modeline-string " Strokes"
307 "*Modeline identification when strokes are on \(default is \" Strokes\"\)." 374 "*Modeline identification when strokes are on \(default is \" Strokes\"\)."
308 :type 'string 375 :type 'string
309 :group 'strokes) 376 :group 'strokes)
310 377
311 (defcustom strokes-character ?o 378 (defcustom strokes-character ?@
312 "*Character used when drawing strokes in the strokes buffer. 379 "*Character used when drawing strokes in the strokes buffer.
313 \(The default is lower-case `o', which works okay\)." 380 \(The default is lower-case `@', which works okay\)."
314 :type 'character 381 :type 'character
315 :group 'strokes) 382 :group 'strokes)
316 383
317 (defcustom strokes-minimum-match-score 1000 384 (defcustom strokes-minimum-match-score 1000
318 "*Minimum score for a stroke to be considered a possible match. 385 "*Minimum score for a stroke to be considered a possible match.
336 The grid is a square grid, where STROKES-GRID-RESOLUTION defaults to 403 The grid is a square grid, where STROKES-GRID-RESOLUTION defaults to
337 `9', making a 9x9 grid whose coordinates go from (0 . 0) on the top 404 `9', making a 9x9 grid whose coordinates go from (0 . 0) on the top
338 left to ((STROKES-GRID-RESOLUTION - 1) . (STROKES-GRID-RESOLUTION - 1)) 405 left to ((STROKES-GRID-RESOLUTION - 1) . (STROKES-GRID-RESOLUTION - 1))
339 on the bottom right. The greater the resolution, the more intricate 406 on the bottom right. The greater the resolution, the more intricate
340 your strokes can be. 407 your strokes can be.
341 NOTE: This variable should be odd and MUST NOT be less than 3. 408 NOTE: This variable should be odd and MUST NOT be less than 3 and need
409 not be greater than 33, which is the resolution of the pixmaps.
342 WARNING: Changing the value of this variable will gravely affect the 410 WARNING: Changing the value of this variable will gravely affect the
343 strokes you have already programmed in. You should try to 411 strokes you have already programmed in. You should try to
344 figure out what it should be based on your needs and on how 412 figure out what it should be based on your needs and on how
345 quick the particular platform(s) you're operating on, and 413 quick the particular platform(s) you're operating on, and
346 only then start programming in your custom strokes." 414 only then start programming in your custom strokes."
379 447
380 (defvar strokes-window-configuration nil 448 (defvar strokes-window-configuration nil
381 "The special window configuration used when entering strokes. 449 "The special window configuration used when entering strokes.
382 This is set properly in the function `strokes-update-window-configuration'.") 450 This is set properly in the function `strokes-update-window-configuration'.")
383 451
452 (defvar strokes-window-configuration-plist
453 (list 'frame nil 'frame-height nil 'frame-width nil)
454 "Plist describing the state of the current strokes-window-configuration.
455 The plist consists of the following keys:
456
457 'frame Frame to draw strokes in.
458 'frame-height Height of the frame.
459 'frame-width Width of the frame.")
460
384 (defvar strokes-last-stroke nil 461 (defvar strokes-last-stroke nil
385 "Last stroke entered by the user. 462 "Last stroke entered by the user.
386 Its value gets set every time the function 463 Its value gets set every time the function
387 `strokes-fill-stroke' gets called, 464 `strokes-fill-stroke' gets called,
388 since that is the best time to set the variable") 465 since that is the best time to set the variable")
395 corresponding interactive function") 472 corresponding interactive function")
396 473
397 (defvar strokes-load-hook nil 474 (defvar strokes-load-hook nil
398 "Function or functions to be called when `strokes' is loaded.") 475 "Function or functions to be called when `strokes' is loaded.")
399 476
400 (defvar edit-strokes-menu 477 ;;; ### NOT IMPLEMENTED YET ###
401 '("Edit-Strokes" 478 ;;(defvar edit-strokes-menu
402 ["Add stroke..." strokes-global-set-stroke t] 479 ;; '("Edit-Strokes"
403 ["Delete stroke..." strokes-edit-delete-stroke t] 480 ;; ["Add stroke..." strokes-global-set-stroke t]
404 ["Change stroke" strokes-smaller t] 481 ;; ["Delete stroke..." strokes-edit-delete-stroke t]
405 ["Change definition" strokes-larger t] 482 ;; ["Change stroke" strokes-smaller t]
406 ["[Re]List Strokes chronologically" strokes-list-strokes t] 483 ;; ["Change definition" strokes-larger t]
407 ["[Re]List Strokes alphabetically" strokes-list-strokes t] 484 ;; ["[Re]List Strokes chronologically" strokes-list-strokes t]
408 ["Quit" strokes-edit-quit t] 485 ;; ["[Re]List Strokes alphabetically" strokes-list-strokes t]
409 )) 486 ;; ["Quit" strokes-edit-quit t]
487 ;; ))
410 488
411 ;;; Macros... 489 ;;; Macros...
490
491 (defmacro strokes-while-inhibiting-garbage-collector (&rest forms)
492 "Execute FORMS without interference from the garbage collector."
493 `(let ((gc-cons-threshold 134217727))
494 ,@forms))
412 495
413 (defsubst strokes-click-p (stroke) 496 (defsubst strokes-click-p (stroke)
414 "Non-nil if STROKE is really click." 497 "Non-nil if STROKE is really click."
415 (< (length stroke) 3)) 498 (< (length stroke) 2))
416 499
417 ;;; old, but worked pretty good (just in case)... 500 ;;; old, but worked pretty good (just in case)...
418 ;;(defmacro strokes-define-stroke (stroke-map stroke def) 501 ;;(defmacro strokes-define-stroke (stroke-map stroke def)
419 ;; "Add STROKE to STROKE-MAP alist with given command DEF" 502 ;; "Add STROKE to STROKE-MAP alist with given command DEF"
420 ;; (list 'if (list '< (list 'length stroke) 3) 503 ;; (list 'if (list '< (list 'length stroke) 3)
422 ;; "That's a click, not a stroke. See `strokes-click-command'") 505 ;; "That's a click, not a stroke. See `strokes-click-command'")
423 ;; (list 'setq stroke-map (list 'cons (list 'cons stroke def) 506 ;; (list 'setq stroke-map (list 'cons (list 'cons stroke def)
424 ;; (list 'remassoc stroke stroke-map))))) 507 ;; (list 'remassoc stroke stroke-map)))))
425 508
426 (defmacro strokes-define-stroke (stroke-map stroke def) 509 (defmacro strokes-define-stroke (stroke-map stroke def)
427 "Add STROKE to STROKE-MAP alist with given command DEF" 510 "Add STROKE to STROKE-MAP alist with given command DEF."
428 `(if (strokes-click-p ,stroke) 511 `(if (strokes-click-p ,stroke)
429 (error "That's a click, not a stroke; see `strokes-click-command'") 512 (error "That's a click, not a stroke; see `strokes-click-command'")
430 (setq ,stroke-map (cons (cons ,stroke ,def) 513 (setq ,stroke-map (cons (cons ,stroke ,def)
431 (remassoc ,stroke ,stroke-map))))) 514 (remassoc ,stroke ,stroke-map)))))
432 515
436 "Returns the square of the number X" 519 "Returns the square of the number X"
437 (* x x)) 520 (* x x))
438 521
439 (defsubst strokes-distance-squared (p1 p2) 522 (defsubst strokes-distance-squared (p1 p2)
440 "Gets the distance (squared) between to points P1 and P2. 523 "Gets the distance (squared) between to points P1 and P2.
441 Each point is a cons cells (X . Y)" 524 P1 and P2 are cons cells in the form (X . Y)."
442 (let ((x1 (car p1)) 525 (let ((x1 (car p1))
443 (y1 (cdr p1)) 526 (y1 (cdr p1))
444 (x2 (car p2)) 527 (x2 (car p2))
445 (y2 (cdr p2))) 528 (y2 (cdr p2)))
446 (+ (strokes-square (- x2 x1)) 529 (+ (strokes-square (- x2 x1))
447 (strokes-square (- y2 y1))))) 530 (strokes-square (- y2 y1)))))
448 531
449 ;;; Advice for various functions... 532 ;;; Advice for various functions...
450 533
451 ;; I'd originally wanted to write a macro that would just take in the 534 ;; I'd originally wanted to write a macro that would just take in the
452 ;; generic functions which use mouse button2 in various modes. Most of 535 ;; generic functions which use mouse button2 in various modes. Most
453 ;; them are identical in form: they take an event as the single argument 536 ;; of them are identical in form: they take an event as the single
454 ;; and then do their thing. I tried writing a macro that looked 537 ;; argument and then do their thing. I tried writing a macro that
455 ;; something like this, but failed. Advice just ain't that easy. The 538 ;; looked something like this, but failed. Advice just ain't that
456 ;; one that bugged me the most was `Manual-follow-xref', because that had 539 ;; easy. The one that bugged me the most was `Manual-follow-xref',
457 ;; &rest arguments, and I didn't know how to work around it in defadvice. 540 ;; because that had &rest arguments, and I didn't know how to work
458 ;; However, I was able to fix up most of the important modes (i.e. the 541 ;; around it in defadvice. However, I was able to fix up most of the
459 ;; ones I use all the time). One `bug' in the program that I just can't 542 ;; important modes (i.e. the ones I use all the time). One `bug' in
460 ;; seem to figure out is why I can only advise other button2 functions 543 ;; the program that I just can't seem to figure out is why I can only
461 ;; successfully when the variable `strokes-use-strokes-buffer' is nil. I 544 ;; advise other button2 functions successfully when the variable
462 ;; did all the save-excursion/save-window-excursion stuff SPECIFICALLY so 545 ;; `strokes-use-strokes-buffer' is nil. I did all the
463 ;; that using the strokes buffer or not would absolutely not affect any 546 ;; save-excursion/save-window-excursion stuff SPECIFICALLY so that
464 ;; other part of the program. If someone can figure out how to make the 547 ;; using the strokes buffer or not would absolutely not affect any
465 ;; following advices work w/ regardless of that variable 548 ;; other part of the program. If someone can figure out how to make
466 ;; `strokes-use-strokes-buffer', then that would be a great victory. If 549 ;; the following advices work w/ regardless of that variable
467 ;; someone out there would be kind enough to make the commented code 550 ;; `strokes-use-strokes-buffer', then that would be a great victory.
468 ;; below work, I'd be grateful. By the way, I put the `protect' keywords 551 ;; If someone out there would be kind enough to make the commented
469 ;; there to insure that if a stroke went bad, then 552 ;; code below work, I'd be grateful. By the way, I put the `protect'
470 ;; `strokes-click-command' would be set back. If this isn't necessary, 553 ;; keywords there to insure that if a stroke went bad, then
471 ;; then feel free to let me know. 554 ;; `strokes-click-command' would be set back. If this isn't
555 ;; necessary, then feel free to let me know.
472 556
473 ;; For what follows, I really wanted something that would work like this: 557 ;; For what follows, I really wanted something that would work like this:
474 558
475 ;;(strokes-fix-button2 'vm-mouse-button-2) 559 ;;(strokes-fix-button2 'vm-mouse-button-2)
476 560
491 (strokes-fix-button2-command 'vm-mouse-button-2)" 575 (strokes-fix-button2-command 'vm-mouse-button-2)"
492 (let ((command (eval command))) 576 (let ((command (eval command)))
493 `(progn 577 `(progn
494 (defadvice ,command (around strokes-fix-button2 compile preactivate) 578 (defadvice ,command (around strokes-fix-button2 compile preactivate)
495 ,(format "Fix %s to work with strokes." command) 579 ,(format "Fix %s to work with strokes." command)
496 (if strokes-use-strokes-buffer 580 (let ((strokes-click-command
497 ;; then strokes is no good and we'll have to use the original
498 ad-do-it
499 ;; otherwise, we can make strokes work too...
500 (let ((strokes-click-command
501 ',(intern (format "ad-Orig-%s" command)))) 581 ',(intern (format "ad-Orig-%s" command))))
502 (strokes-do-stroke (ad-get-arg 0)))))))) 582 (strokes-do-stroke (ad-get-arg 0)))))))
503 583
504 (strokes-fix-button2-command 'vm-mouse-button-2) 584 (strokes-fix-button2-command 'vm-mouse-button-2)
505 (strokes-fix-button2-command 'rmail-summary-mouse-goto-msg) 585 (strokes-fix-button2-command 'rmail-summary-mouse-goto-msg)
506 (strokes-fix-button2-command 'Buffer-menu-mouse-select) 586 (strokes-fix-button2-command 'Buffer-menu-mouse-select)
507 (strokes-fix-button2-command 'w3-widget-button-click) 587 (strokes-fix-button2-command 'w3-widget-button-click)
544 ;; (strokes-do-stroke (ad-get-arg 0))))) 624 ;; (strokes-do-stroke (ad-get-arg 0)))))
545 625
546 ;;; Functions... 626 ;;; Functions...
547 627
548 (defun strokes-lift-p (object) 628 (defun strokes-lift-p (object)
549 "Return non-nil if object is a stroke-lift" 629 "Return non-nil if object is a stroke-lift."
550 (eq object strokes-lift)) 630 (eq object strokes-lift))
551 631
552 (defun strokes-unset-last-stroke () 632 (defun strokes-unset-last-stroke ()
553 "Undo the last stroke definition." 633 "Undo the last stroke definition."
554 (interactive) 634 (interactive)
571 (interactive 651 (interactive
572 (list 652 (list
573 (and (or strokes-mode (strokes-mode t)) 653 (and (or strokes-mode (strokes-mode t))
574 (strokes-read-complex-stroke 654 (strokes-read-complex-stroke
575 "Define a new stroke. Draw with button1 (or 2). End with button3...")) 655 "Define a new stroke. Draw with button1 (or 2). End with button3..."))
576 (read-command "command to map stroke to: "))) 656 (read-command-or-command-sexp "command to map stroke to: ")))
577 (strokes-define-stroke strokes-global-map stroke command)) 657 (strokes-define-stroke strokes-global-map stroke command))
578 658
579 ;;;###autoload 659 ;;;###autoload
580 (defalias 'global-set-stroke 'strokes-global-set-stroke) 660 (defalias 'global-set-stroke 'strokes-global-set-stroke)
581 661
588 ;; (strokes-read-stroke "Enter the stroke you want to delete..."))) 668 ;; (strokes-read-stroke "Enter the stroke you want to delete...")))
589 ;; (strokes-define-stroke 'strokes-global-map stroke command)) 669 ;; (strokes-define-stroke 'strokes-global-map stroke command))
590 670
591 (defun strokes-get-grid-position (stroke-extent position &optional grid-resolution) 671 (defun strokes-get-grid-position (stroke-extent position &optional grid-resolution)
592 "Map POSITION to a new grid position based on its STROKE-EXTENT and GRID-RESOLUTION. 672 "Map POSITION to a new grid position based on its STROKE-EXTENT and GRID-RESOLUTION.
593 STROKE-EXTENT as a list \(\(xmin . ymin\) \(xmax . ymax\)\). 673 STROKE-EXTENT as a list \(\(XMIN . YMIN\) \(XMAX . YMAX\)\).
594 If POSITION is a `strokes-lift', then it is itself returned. 674 If POSITION is a `strokes-lift', then it is itself returned.
595 Optional GRID-RESOLUTION may be used in place of STROKES-GRID-RESOLUTION. 675 Optional GRID-RESOLUTION may be used in place of STROKES-GRID-RESOLUTION.
596 The grid is a square whose dimesion is [0,GRID-RESOLUTION)." 676 The grid is a square whose dimesion is [0,GRID-RESOLUTION)."
597 (cond ((consp position) ; actual pixel location 677 (cond ((consp position) ; actual pixel location
598 (let ((grid-resolution (or grid-resolution strokes-grid-resolution)) 678 (let ((grid-resolution (or grid-resolution strokes-grid-resolution))
611 (/ (float (- y ymin)) 691 (/ (float (- y ymin))
612 (- ymax ymin))))))) 692 (- ymax ymin)))))))
613 ((strokes-lift-p position) ; stroke lift 693 ((strokes-lift-p position) ; stroke lift
614 strokes-lift))) 694 strokes-lift)))
615 695
616 ;;(defun strokes-get-grid-position (stroke-extent pix-pos)
617 ;; "Return the stroke-grid position for PIX-POS given the total STROKE-EXTENT.
618 ;;STROKE-EXTENT as a list \(\(xmin . ymin\) \(xmax . ymax\)\) and a particular
619 ;;pixel position or `strokes-lift', find the corresponding grid position
620 ;;\(based on `strokes-grid-resolution'\) for the PIX-POS."
621 ;; (cond ((consp pix-pos) ; actual pixel location
622 ;; (let ((x (car pix-pos))
623 ;; (y (cdr pix-pos))
624 ;; (xmin (caar stroke-extent))
625 ;; (ymin (cdar stroke-extent))
626 ;; ;; the `1+' is there to insure that the
627 ;; ;; formula evaluates correctly at the boundaries
628 ;; (xmax (1+ (caadr stroke-extent)))
629 ;; (ymax (1+ (cdadr stroke-extent))))
630 ;; (cons (floor (* strokes-grid-resolution
631 ;; (/ (float (- x xmin))
632 ;; (- xmax xmin))))
633 ;; (floor (* strokes-grid-resolution
634 ;; (/ (float (- y ymin))
635 ;; (- ymax ymin)))))))
636 ;; ((strokes-lift-p pix-pos) ; stroke lift
637 ;; strokes-lift)))
638
639 (defun strokes-get-stroke-extent (pixel-positions) 696 (defun strokes-get-stroke-extent (pixel-positions)
640 "From a list of absolute PIXEL-POSITIONS, returns absolute spatial extent. 697 "From a list of absolute PIXEL-POSITIONS, returns absolute spatial extent.
641 The return value is a list ((xmin . ymin) (xmax . ymax))." 698 The return value is a list ((XMIN . YMIN) (XMAX . YMAX))."
642 (if pixel-positions 699 (if pixel-positions
643 (let ((xmin (caar pixel-positions)) 700 (let ((xmin (caar pixel-positions))
644 (xmax (caar pixel-positions)) 701 (xmax (caar pixel-positions))
645 (ymin (cdar pixel-positions)) 702 (ymin (cdar pixel-positions))
646 (ymax (cdar pixel-positions)) 703 (ymax (cdar pixel-positions))
711 (let ((stroke-extent (strokes-get-stroke-extent positions))) 768 (let ((stroke-extent (strokes-get-stroke-extent positions)))
712 (mapcar (function 769 (mapcar (function
713 (lambda (pos) 770 (lambda (pos)
714 (strokes-get-grid-position stroke-extent pos grid-resolution))) 771 (strokes-get-grid-position stroke-extent pos grid-resolution)))
715 positions))) 772 positions)))
716
717 ;;(defun strokes-normalize-pixels-to-grid (pixel-positions)
718 ;; "Map PIXEL-POSITIONS to the stroke grid.
719 ;;PIXEL-POSITIONS is a list of pixel-positions and stroke-lifts. The
720 ;;normalized stroke grid is defined by the variable STROKES-GRID-RESOLUTION"
721 ;; (let ((stroke-extent (strokes-get-stroke-extent pixel-positions)))
722 ;; (mapcar (function
723 ;; (lambda (pix-pos)
724 ;; (strokes-get-grid-position stroke-extent pix-pos)))
725 ;; pixel-positions)))
726 773
727 (defun strokes-fill-stroke (unfilled-stroke &optional force) 774 (defun strokes-fill-stroke (unfilled-stroke &optional force)
728 "Fill in missing grid locations in the list of UNFILLED-STROKE. 775 "Fill in missing grid locations in the list of UNFILLED-STROKE.
729 If FORCE is non-nil, then fill the stroke even if it's `stroke-click'. 776 If FORCE is non-nil, then fill the stroke even if it's `stroke-click'.
730 NOTE: This is where the global variable `strokes-last-stroke' is set." 777 NOTE: This is where the global variable `strokes-last-stroke' is set."
873 "Read a simple stroke (interactively) and return the stroke. 920 "Read a simple stroke (interactively) and return the stroke.
874 Optional PROMPT in minibuffer displays before and during stroke reading. 921 Optional PROMPT in minibuffer displays before and during stroke reading.
875 This function will display the stroke interactively as it is being 922 This function will display the stroke interactively as it is being
876 entered in the strokes buffer if the variable 923 entered in the strokes buffer if the variable
877 `strokes-use-strokes-buffer' is non-nil. 924 `strokes-use-strokes-buffer' is non-nil.
878 Optional EVENT is currently not used, but hopefully will be soon." 925 Optional EVENT is acceptable as the starting event of the stroke"
879 (save-excursion 926 (save-excursion
880 (let ((pix-locs nil) 927 (let ((pix-locs nil)
881 (grid-locs nil) 928 (grid-locs nil)
882 (event (or event (make-event)))) 929 (safe-to-draw-p nil))
883 (if strokes-use-strokes-buffer 930 (strokes-while-inhibiting-garbage-collector
884 ;; switch to the strokes buffer and 931 (if strokes-use-strokes-buffer
885 ;; display the stroke as it's being read 932 ;; switch to the strokes buffer and
886 (save-window-excursion 933 ;; display the stroke as it's being read
887 (set-window-configuration strokes-window-configuration) 934 (save-window-excursion
888 (if prompt 935 (set-window-configuration strokes-window-configuration)
889 (progn 936 (when prompt
890 (setq event (next-event event prompt)) 937 (setq event (next-command-event event prompt))
891 (while (not (button-press-event-p event)) 938 (or (button-press-event-p event)
892 (dispatch-event event) 939 (error "You must draw with the mouse")))
893 (setq event (next-event event))))) 940 (or event (setq event (next-event nil prompt)
894 (unwind-protect 941 safe-to-draw-p t))
895 (progn 942 (unwind-protect
896 (setq event (next-event event)) 943 (progn
897 (while (not (button-release-event-p event)) 944 (while (not (button-release-event-p event))
898 (if (mouse-event-p event) 945 (if (mouse-event-p event)
899 (let ((point (event-closest-point event))) 946 (let ((point (event-closest-point event)))
900 (when point 947 (if (and point safe-to-draw-p)
901 (goto-char point) 948 ;; we can draw that point
902 (subst-char-in-region point (1+ point) ?\ strokes-character)) 949 (progn
903 (push (cons (event-x-pixel event) 950 (goto-char point)
904 (event-y-pixel event)) 951 (subst-char-in-region point (1+ point) ?\ strokes-character))
905 pix-locs))) 952 ;; otherwise, we can start drawing the next time...
906 (setq event (next-event event)))) 953 (setq safe-to-draw-p t))
907 ;; protected 954 (push (cons (event-x-pixel event)
908 ;; clean up strokes buffer and then bury it. 955 (event-y-pixel event))
909 (when (equal (buffer-name) strokes-buffer-name) 956 pix-locs))
910 (subst-char-in-region (point-min) (point-max) strokes-character ?\ ) 957 ;; otherwise, if it's not a mouse-event...
911 (goto-char (point-min)) 958 (dispatch-event event))
912 (bury-buffer)))) 959 (setq event (next-event event))))
913 ;; Otherwise, don't use strokes buffer and read stroke silently 960 ;; protected
914 (if prompt 961 ;; clean up strokes buffer and then bury it.
915 (progn 962 (when (equal (buffer-name) strokes-buffer-name)
916 (setq event (next-event event prompt)) 963 (subst-char-in-region (point-min) (point-max) strokes-character ?\ )
917 (while (not (button-press-event-p event)) 964 (goto-char (point-min))
918 (dispatch-event event) 965 (bury-buffer))))
919 (setq event (next-event event))))) 966 ;; Otherwise, don't use strokes buffer and read stroke silently
920 (setq event (next-event)) 967 (when prompt
921 (while (not (button-release-event-p event)) 968 (setq event (next-command-event event prompt))
922 (if (mouse-event-p event) 969 (or (button-press-event-p event)
923 (push (cons (event-x-pixel event) 970 (error "You must draw with the mouse")))
924 (event-y-pixel event)) 971 (or event (setq event (next-event nil prompt)))
925 pix-locs)) 972 (while (not (button-release-event-p event))
926 (setq event (next-event event)))) 973 (if (mouse-event-p event)
974 (push (cons (event-x-pixel event)
975 (event-y-pixel event))
976 pix-locs)
977 (dispatch-event event))
978 (setq event (next-event event)))))
927 (setq grid-locs (strokes-renormalize-to-grid (nreverse pix-locs))) 979 (setq grid-locs (strokes-renormalize-to-grid (nreverse pix-locs)))
928 (strokes-fill-stroke (strokes-eliminate-consecutive-redundancies grid-locs))))) 980 (strokes-fill-stroke (strokes-eliminate-consecutive-redundancies grid-locs)))))
929 981
930 ;;;###autoload 982 ;;; This version of `strokes-read-stroke' is not broken, but pathetic.
983 ;;(defun strokes-read-stroke (&optional prompt event)
984 ;; "Read a simple stroke (interactively) and return the stroke.
985 ;;Optional PROMPT in minibuffer displays before and during stroke reading.
986 ;;This function will display the stroke interactively as it is being
987 ;;entered in the strokes buffer if the variable
988 ;;`strokes-use-strokes-buffer' is non-nil.
989 ;;Optional EVENT is currently not used, but hopefully will be soon."
990 ;; (save-excursion
991 ;; (strokes-while-inhibiting-garbage-collector
992 ;; (let ((pix-locs nil)
993 ;; (grid-locs nil)
994 ;; (event (or event (make-event))))
995 ;; (if strokes-use-strokes-buffer
996 ;; ;; switch to the strokes buffer and
997 ;; ;; display the stroke as it's being read
998 ;; (save-window-excursion
999 ;; (set-window-configuration strokes-window-configuration)
1000 ;; (if prompt
1001 ;; (progn
1002 ;; (setq event (next-event event prompt))
1003 ;; (while (not (button-press-event-p event))
1004 ;; (dispatch-event event)
1005 ;; (setq event (next-event event)))))
1006 ;; (unwind-protect
1007 ;; (progn
1008 ;; (setq event (next-event event))
1009 ;; (while (not (button-release-event-p event))
1010 ;; (if (mouse-event-p event)
1011 ;; (let ((point (event-closest-point event)))
1012 ;; (when point
1013 ;; (goto-char point)
1014 ;; (subst-char-in-region point (1+ point) ?\ strokes-character))
1015 ;; (push (cons (event-x-pixel event)
1016 ;; (event-y-pixel event))
1017 ;; pix-locs)))
1018 ;; (setq event (next-event event))))
1019 ;; ;; protected
1020 ;; ;; clean up strokes buffer and then bury it.
1021 ;; (when (equal (buffer-name) strokes-buffer-name)
1022 ;; (subst-char-in-region (point-min) (point-max) strokes-character ?\ )
1023 ;; (goto-char (point-min))
1024 ;; (bury-buffer))))
1025 ;; ;; Otherwise, don't use strokes buffer and read stroke silently
1026 ;; (if prompt
1027 ;; (progn
1028 ;; (setq event (next-event event prompt))
1029 ;; (while (not (button-press-event-p event))
1030 ;; (dispatch-event event)
1031 ;; (setq event (next-event event)))))
1032 ;; (setq event (next-event))
1033 ;; (while (not (button-release-event-p event))
1034 ;; (if (mouse-event-p event)
1035 ;; (push (cons (event-x-pixel event)
1036 ;; (event-y-pixel event))
1037 ;; pix-locs))
1038 ;; (setq event (next-event event))))
1039 ;; (setq grid-locs (strokes-renormalize-to-grid (nreverse pix-locs)))
1040 ;; (strokes-fill-stroke (strokes-eliminate-consecutive-redundancies grid-locs))))))
1041
931 (defun strokes-read-complex-stroke (&optional prompt event) 1042 (defun strokes-read-complex-stroke (&optional prompt event)
932 "Read a complex stroke (interactively) and return the stroke. 1043 "Read a complex stroke (interactively) and return the stroke.
933 Optional PROMPT in minibuffer displays before and during stroke reading. 1044 Optional PROMPT in minibuffer displays before and during stroke reading.
934 Note that a complex stroke allows the user to pen-up and pen-down. This 1045 Note that a complex stroke allows the user to pen-up and pen-down. This
935 is implemented by allowing the user to paint with button1 or button2 and 1046 is implemented by allowing the user to paint with button1 or button2 and
936 then complete the stroke with button3. 1047 then complete the stroke with button3.
937 Optional EVENT is currently not used, but hopefully will be soon." 1048 Optional EVENT is acceptable as the starting event of the stroke"
938 (save-excursion 1049 (save-excursion
939 (save-window-excursion 1050 (save-window-excursion
940 (set-window-configuration strokes-window-configuration) 1051 (strokes-while-inhibiting-garbage-collector
941 (let ((pix-locs nil) 1052 (set-window-configuration strokes-window-configuration)
942 (grid-locs nil) 1053 (let ((pix-locs nil)
943 (event (or event (next-event nil prompt)))) 1054 (grid-locs nil)
944 (if prompt 1055 (safe-to-draw-p nil))
945 (while (not (button-press-event-p event)) 1056 (when prompt
946 (dispatch-event event) 1057 (setq event (next-command-event event prompt))
947 (setq event (next-event event)))) 1058 (or (button-press-event-p event)
948 (unwind-protect 1059 (error "You must draw with the mouse")))
949 (progn 1060 (or event (setq event (next-event nil prompt)
950 (setq event (next-event event prompt)) 1061 safe-to-draw-p t))
951 (while (not (and (button-press-event-p event) 1062 (unwind-protect
952 (eq (event-button event) 3))) 1063 (progn
953 (while (not (button-release-event-p event)) 1064 (while (not (and (button-press-event-p event)
954 (if (mouse-event-p event) 1065 (eq (event-button event) 3)))
955 (let ((point (event-closest-point event))) 1066 (while (not (button-release-event-p event))
956 (when point 1067 (if (mouse-event-p event)
957 (goto-char point) 1068 (let ((point (event-closest-point event)))
958 (subst-char-in-region point (1+ point) ?\ strokes-character)) 1069 (if (and point safe-to-draw-p)
959 (push (cons (event-x-pixel event) 1070 ;; we can draw that point
960 (event-y-pixel event)) 1071 (progn
961 pix-locs))) 1072 (goto-char point)
962 (setq event (next-event event prompt))) 1073 (subst-char-in-region point (1+ point) ?\ strokes-character))
963 (push strokes-lift pix-locs) 1074 ;; otherwise, we can start drawing the next time...
964 (while (not (button-press-event-p event)) 1075 (setq safe-to-draw-p t))
965 (dispatch-event event) 1076 (push (cons (event-x-pixel event)
966 (setq event (next-event event prompt)))) 1077 (event-y-pixel event))
967 (setq pix-locs (nreverse (cdr pix-locs)) 1078 pix-locs))
968 grid-locs (strokes-renormalize-to-grid pix-locs)) 1079 (dispatch-event event))
969 (strokes-fill-stroke 1080 (setq event (next-event event prompt)))
970 (strokes-eliminate-consecutive-redundancies grid-locs))) 1081 (push strokes-lift pix-locs)
971 ;; protected 1082 (while (not (button-press-event-p event))
972 (when (equal (buffer-name) strokes-buffer-name) 1083 (dispatch-event event)
973 (subst-char-in-region (point-min) (point-max) strokes-character ?\ ) 1084 (setq event (next-event event prompt))))
974 (goto-char (point-min)) 1085 (setq pix-locs (nreverse (cdr pix-locs)))
975 (bury-buffer))))))) 1086 ;; minor bug fix here for when user enters ` *strokes*'
1087 ;; buffer with a click instead of a drag...
1088 (when (strokes-lift-p (car pix-locs))
1089 (setq pix-locs (cdr pix-locs)))
1090 (setq grid-locs (strokes-renormalize-to-grid pix-locs))
1091 (strokes-fill-stroke
1092 (strokes-eliminate-consecutive-redundancies grid-locs)))
1093 ;; protected
1094 (when (equal (buffer-name) strokes-buffer-name)
1095 (subst-char-in-region (point-min) (point-max) strokes-character ?\ )
1096 (goto-char (point-min))
1097 (bury-buffer))))))))
976 1098
977 (defun strokes-execute-stroke (stroke) 1099 (defun strokes-execute-stroke (stroke)
978 "Given STROKE, execute the command which corresponds to it. 1100 "Given STROKE, execute the command which corresponds to it.
979 The command will be executed provided one exists for that stroke, 1101 The command will be executed provided one exists for that stroke,
980 based on the variable `strokes-minimum-match-score'. 1102 based on the variable `strokes-minimum-match-score'.
981 If no stroke matches, nothing is done and return value is nil." 1103 If no stroke matches, nothing is done and return value is nil."
982 (let* ((match (strokes-match-stroke stroke strokes-global-map)) 1104 (let* ((match (strokes-match-stroke stroke strokes-global-map))
983 (command (car match)) 1105 (command (car match))
984 (score (cdr match))) 1106 (score (cdr match)))
985 (cond ((strokes-click-p stroke) 1107 (cond ((strokes-click-p stroke)
986 ;; This is the case of a `click' type event 1108 ;; This is the case of a `click' type event.
1109 ;; The `sit-for' is a minor frob that has to do with timing
1110 ;; problems. Without the `sit-for', mouse-yank will not
1111 ;; yank at the proper location if the user opted for
1112 ;; mouse-yank-at-point to be nil (i.e. mouse-yank takes
1113 ;; place at pointer position). The sit-for tells redisplay
1114 ;; to be sure to wait for the `*strokes*' buffer to vanish
1115 ;; from consideration when deciding on a point to be used
1116 ;; for mouse-yank.
1117 (sit-for 0)
987 (command-execute strokes-click-command)) 1118 (command-execute strokes-click-command))
988 ((and match (<= score strokes-minimum-match-score)) 1119 ((and match (<= score strokes-minimum-match-score))
989 (message "%s" command) 1120 (message "%s" command)
990 (command-execute command)) 1121 (command-execute command))
991 ((null strokes-global-map) 1122 ((null strokes-global-map)
1000 "No stroke matches; see variable `strokes-minimum-match-score'") 1131 "No stroke matches; see variable `strokes-minimum-match-score'")
1001 nil)))) 1132 nil))))
1002 1133
1003 ;;;###autoload 1134 ;;;###autoload
1004 (defun strokes-do-stroke (event) 1135 (defun strokes-do-stroke (event)
1005 "Read a simple stroke from the user and then exectute its comand. 1136 "Read a simple stroke from the user and then exectute its command.
1006 This must be bound to a mouse event." 1137 This must be bound to a mouse event."
1007 (interactive "e") 1138 (interactive "e")
1008 (or strokes-mode (strokes-mode t)) 1139 (or strokes-mode (strokes-mode t))
1009 (strokes-execute-stroke (strokes-read-stroke nil event))) 1140 (strokes-execute-stroke (strokes-read-stroke nil event)))
1010 1141
1048 (lambda () 1179 (lambda ()
1049 (save-excursion 1180 (save-excursion
1050 (let ((helpdoc 1181 (let ((helpdoc
1051 "This is help for the strokes package. 1182 "This is help for the strokes package.
1052 1183
1053 If you find something wrong with it, or feel that it can be improved 1184 If you find something wrong with strokes, or feel that it can be
1054 in some way, then please feel free to email me: 1185 improved in some way, then please feel free to email me:
1055 1186
1056 David Bakhash <cadet@mit.edu> 1187 David Bakhash <cadet@mit.edu>
1057 1188
1058 or just do 1189 or just do
1059 1190
1060 M-x strokes-report-bug 1191 M-x strokes-report-bug
1061 1192
1062 ------------------------------------------------------------ 1193 ------------------------------------------------------------
1194
1195 ** Strokes...
1063 1196
1064 The strokes package allows you to define strokes (that you make with 1197 The strokes package allows you to define strokes (that you make with
1065 the mouse or other pointer device) that XEmacs can interpret as 1198 the mouse or other pointer device) that XEmacs can interpret as
1066 corresponding to commands, and then executes the commands. It does 1199 corresponding to commands, and then executes the commands. It does
1067 character recognition, so you don't have to worry about getting it 1200 character recognition, so you don't have to worry about getting it
1068 right every time. 1201 right every time.
1069 1202
1203 Strokes also allows you to compose documents graphically. You can
1204 fully edit documents in Chinese, Japanese, etc. based on XEmacs
1205 strokes. Once you've done so, you can ascii compress-and-encode them
1206 and then safely save them for later use, send letters to friends
1207 (using XEmacs, of course). Strokes will later decode these documents,
1208 extracting the strokes for editing use once again, so the editing
1209 cycle can continue.
1210
1070 Strokes are easy to program and fun to use. To start strokes going, 1211 Strokes are easy to program and fun to use. To start strokes going,
1071 you'll want to put the following line in your .emacs file: 1212 you'll want to put the following line in your .emacs file:
1072 1213
1073 (and (fboundp 'device-on-window-system-p) 1214 (if window-system
1074 (device-on-window-system-p) 1215 (require 'strokes))
1075 (require 'strokes))
1076 1216
1077 This will load strokes when and only when you start XEmacs on a window 1217 This will load strokes when and only when you start XEmacs on a window
1078 system (i.e. that has a pointer (mouse) device, etc.). 1218 system (i.e. that has a pointer (mouse) device, etc.).
1079 1219
1080 To toggle strokes-mode, you just do 1220 To toggle strokes-mode, you just do
1081 1221
1082 > M-x strokes-mode 1222 > M-x strokes-mode
1223
1224 ** Strokes for controlling the behavior of XEmacs...
1083 1225
1084 When you're ready to start defining strokes, just use the command 1226 When you're ready to start defining strokes, just use the command
1085 1227
1086 > M-x global-set-stroke 1228 > M-x global-set-stroke
1087 1229
1146 Your strokes get loaded automatically when you enable `strokes-mode'. 1288 Your strokes get loaded automatically when you enable `strokes-mode'.
1147 You can also load in your user-defined strokes with 1289 You can also load in your user-defined strokes with
1148 1290
1149 > M-x load-user-strokes 1291 > M-x load-user-strokes
1150 1292
1151 A few more important things: 1293 ** Strokes for pictographic editing...
1152 1294
1153 o The command `strokes-do-stroke' is also invoked with C-button2, so that you 1295 If you'd like to create graphical files with strokes, you'll have to
1154 can still enter a stroke in modes which use button2 for other things, 1296 be running XEmacs on a window system, with XPM support. You use the
1155 such as cross-referencing. 1297 binding C-button2 to start drawing your strokes. These are just
1156 1298 complex strokes, and thus you continue drawing with buttons 1 or 2 and
1157 o Complex strokes (i.e. `strokes-do-complex-stroke'), by default, use 1299 end with button-3. Then the stroke glyph gets inserted into the
1158 Sh-button2. 1300 buffer. You treat it like any other character, which you can copy,
1301 paste, delete, move, etc. The command which is bound to C-button2 is
1302 called `strokes-compose-complex-stroke'. When all is done, you may
1303 want to send the file, or save it. This is done with
1304
1305 > M-x strokes-encode-buffer
1306
1307 Likewise, to decode the strokes from a strokes-encoded buffer you do
1308
1309 > M-x strokes-decode-buffer
1310
1311 ** A few more important things...
1312
1313 o The command `strokes-do-complex-stroke' is invoked with M-button2, so that you
1314 can execute complex strokes (i.e. with more than one lift) if preferred.
1159 1315
1160 o Strokes are a bit computer-dependent in that they depend somewhat on 1316 o Strokes are a bit computer-dependent in that they depend somewhat on
1161 the speed of the computer you're working on. This means that you 1317 the speed of the computer you're working on. This means that you
1162 may have to tweak some variables. You can read about them in the 1318 may have to tweak some variables. You can read about them in the
1163 commentary of `strokes.el'. Better to just use apropos and read their 1319 commentary of `strokes.el'. Better to just use apropos and read their
1165 variable which many people wanted to see was 1321 variable which many people wanted to see was
1166 `strokes-use-strokes-buffer' which allows the user to use strokes 1322 `strokes-use-strokes-buffer' which allows the user to use strokes
1167 silently--without displaying the strokes. All variables can be set 1323 silently--without displaying the strokes. All variables can be set
1168 by customizing the group named `strokes' via the customization package: 1324 by customizing the group named `strokes' via the customization package:
1169 1325
1170 > M-x customize 1326 > M-x customize"))
1171
1172 o A problem with strokes happens when you resize windows. If you
1173 enlarge your XEmacs window a lot and realize that your strokes
1174 buffer is not big enough, you may need to fix it with
1175
1176 > M-x strokes-update-window-configuration."))
1177 (princ helpdoc standard-output))))))) 1327 (princ helpdoc standard-output)))))))
1178 1328
1179 (defun strokes-report-bug () 1329 (defun strokes-report-bug ()
1180 "Submit a bug report for strokes." 1330 "Submit a bug report for strokes."
1181 (interactive) 1331 (interactive)
1206 (goto-char (match-end 0)) 1356 (goto-char (match-end 0))
1207 (delete-char -1) 1357 (delete-char -1)
1208 (insert " " strokes-version " bug:"))))))))) 1358 (insert " " strokes-version " bug:")))))))))
1209 1359
1210 (defsubst strokes-fill-current-buffer-with-whitespace () 1360 (defsubst strokes-fill-current-buffer-with-whitespace ()
1211 "Erase the contents of the current buffer and fill it with whitespace" 1361 "Erase the contents of the current buffer and fill it with whitespace."
1212 (erase-buffer) 1362 (erase-buffer)
1213 (loop repeat (frame-height) do 1363 (loop repeat (frame-height) do
1214 (insert-char ?\ (1- (frame-width))) 1364 (insert-char ?\ (1- (frame-width)))
1215 (newline)) 1365 (newline))
1216 (goto-char (point-min))) 1366 (goto-char (point-min)))
1217 1367
1368 (defun strokes-window-configuration-changed-p ()
1369 "Non-nil if the `strokes-window-configuration' frame properties changed.
1370 This is based on the last time the `strokes-window-configuration was updated."
1371 (not (and (eq (selected-frame)
1372 (plist-get strokes-window-configuration-plist
1373 'frame))
1374 (eq (frame-height)
1375 (plist-get strokes-window-configuration-plist
1376 'frame-height))
1377 (eq (frame-width)
1378 (plist-get strokes-window-configuration-plist
1379 'frame-width)))))
1380
1381 (defun strokes-update-window-configuration-plist ()
1382 "Update the `strokes-window-configuration-plist' based on the current state."
1383 (plist-put strokes-window-configuration-plist
1384 'frame
1385 (selected-frame))
1386 (plist-put strokes-window-configuration-plist
1387 'frame-height
1388 (frame-height))
1389 (plist-put strokes-window-configuration-plist
1390 'frame-width
1391 (frame-width)))
1392
1218 (defun strokes-update-window-configuration () 1393 (defun strokes-update-window-configuration ()
1219 "Insure that `strokes-window-configuration' is up-to-date." 1394 "Update the `strokes-window-configuration'."
1220 (interactive) 1395 (interactive)
1221 (let ((current-window (selected-window))) 1396 (let ((current-window (selected-window)))
1222 (cond ((or (window-minibuffer-p current-window) 1397 (cond ((or (window-minibuffer-p current-window)
1223 (window-dedicated-p current-window)) 1398 (window-dedicated-p current-window))
1224 ;; don't try to update strokes window configuration 1399 ;; don't try to update strokes window configuration
1240 (abbrev-mode 0) 1415 (abbrev-mode 0)
1241 (buffer-disable-undo (current-buffer)) 1416 (buffer-disable-undo (current-buffer))
1242 (setq truncate-lines nil) 1417 (setq truncate-lines nil)
1243 (strokes-fill-current-buffer-with-whitespace) 1418 (strokes-fill-current-buffer-with-whitespace)
1244 (setq strokes-window-configuration (current-window-configuration)) 1419 (setq strokes-window-configuration (current-window-configuration))
1420 (strokes-update-window-configuration-plist)
1245 (bury-buffer)))) 1421 (bury-buffer))))
1246 (t ; `strokes buffer' still exists... 1422 ((strokes-window-configuration-changed-p) ; simple update
1247 ;; update the strokes-window-configuration for this specific frame... 1423 ;; update the strokes-window-configuration for this
1424 ;; specific frame...
1248 (save-excursion 1425 (save-excursion
1249 (save-window-excursion 1426 (save-window-excursion
1250 (set-window-buffer current-window strokes-buffer-name) 1427 (set-window-buffer current-window strokes-buffer-name)
1251 (delete-other-windows) 1428 (delete-other-windows)
1252 (strokes-fill-current-buffer-with-whitespace) 1429 (strokes-fill-current-buffer-with-whitespace)
1253 (setq strokes-window-configuration (current-window-configuration)) 1430 (setq strokes-window-configuration (current-window-configuration))
1431 (strokes-update-window-configuration-plist)
1254 (bury-buffer))))))) 1432 (bury-buffer)))))))
1255 1433
1256 ;;;###autoload 1434 ;;;###autoload
1257 (defun strokes-load-user-strokes () 1435 (defun strokes-load-user-strokes ()
1258 "Load user-defined strokes from file named by `strokes-file'." 1436 "Load user-defined strokes from file named by `strokes-file'."
1378 (pop-to-buffer "*strokes-xpm*") 1556 (pop-to-buffer "*strokes-xpm*")
1379 ;; (xpm-mode 1) 1557 ;; (xpm-mode 1)
1380 (xpm-show-image) 1558 (xpm-show-image)
1381 (goto-char (point-min)))))) 1559 (goto-char (point-min))))))
1382 1560
1383 ;;; Strokes Edit stuff... 1561 ;;; Strokes Edit stuff... ### NOT IMLEMENTED YET ###
1384 1562
1385 (defun strokes-edit-quit () 1563 ;;(defun strokes-edit-quit ()
1386 (interactive) 1564 ;; (interactive)
1387 (or (one-window-p t 0) 1565 ;; (or (one-window-p t 0)
1388 (delete-window)) 1566 ;; (delete-window))
1389 (kill-buffer "*Strokes List*")) 1567 ;; (kill-buffer "*Strokes List*"))
1390 1568
1391 (define-derived-mode edit-strokes-mode list-mode 1569 ;;(define-derived-mode edit-strokes-mode list-mode
1392 "Edit-Strokes" 1570 ;; "Edit-Strokes"
1393 "Major mode for `edit-strokes' and `list-strokes' buffers. 1571 ;; "Major mode for `edit-strokes' and `list-strokes' buffers.
1394 1572
1395 Editing commands: 1573 ;;Editing commands:
1396 1574
1397 \\{edit-strokes-mode-map}" 1575 ;;\\{edit-strokes-mode-map}"
1398 (setq truncate-lines nil 1576 ;; (setq truncate-lines nil
1399 auto-show-mode nil ; don't want problems here either 1577 ;; auto-show-mode nil ; don't want problems here either
1400 mode-popup-menu edit-strokes-menu) ; what about extent-specific stuff? 1578 ;; mode-popup-menu edit-strokes-menu) ; what about extent-specific stuff?
1401 (and (featurep 'menubar) 1579 ;; (and (featurep 'menubar)
1402 current-menubar 1580 ;; current-menubar
1403 (set (make-local-variable 'current-menubar) 1581 ;; (set (make-local-variable 'current-menubar)
1404 (copy-sequence current-menubar)) 1582 ;; (copy-sequence current-menubar))
1405 (add-submenu nil edit-strokes-menu))) 1583 ;; (add-submenu nil edit-strokes-menu)))
1406 1584
1407 (let ((map edit-strokes-mode-map)) 1585 ;;(let ((map edit-strokes-mode-map))
1408 (define-key map "<" 'beginning-of-buffer) 1586 ;; (define-key map "<" 'beginning-of-buffer)
1409 (define-key map ">" 'end-of-buffer) 1587 ;; (define-key map ">" 'end-of-buffer)
1410 ;; (define-key map "c" 'strokes-copy-other-face) 1588 ;; ;; (define-key map "c" 'strokes-copy-other-face)
1411 ;; (define-key map "C" 'strokes-copy-this-face) 1589 ;; ;; (define-key map "C" 'strokes-copy-this-face)
1412 ;; (define-key map "s" 'strokes-smaller) 1590 ;; ;; (define-key map "s" 'strokes-smaller)
1413 ;; (define-key map "l" 'strokes-larger) 1591 ;; ;; (define-key map "l" 'strokes-larger)
1414 ;; (define-key map "b" 'strokes-bold) 1592 ;; ;; (define-key map "b" 'strokes-bold)
1415 ;; (define-key map "i" 'strokes-italic) 1593 ;; ;; (define-key map "i" 'strokes-italic)
1416 (define-key map "e" 'strokes-list-edit) 1594 ;; (define-key map "e" 'strokes-list-edit)
1417 ;; (define-key map "f" 'strokes-font) 1595 ;; ;; (define-key map "f" 'strokes-font)
1418 ;; (define-key map "u" 'strokes-underline) 1596 ;; ;; (define-key map "u" 'strokes-underline)
1419 ;; (define-key map "t" 'strokes-truefont) 1597 ;; ;; (define-key map "t" 'strokes-truefont)
1420 ;; (define-key map "F" 'strokes-foreground) 1598 ;; ;; (define-key map "F" 'strokes-foreground)
1421 ;; (define-key map "B" 'strokes-background) 1599 ;; ;; (define-key map "B" 'strokes-background)
1422 ;; (define-key map "D" 'strokes-doc-string) 1600 ;; ;; (define-key map "D" 'strokes-doc-string)
1423 (define-key map "a" 'strokes-global-set-stroke) 1601 ;; (define-key map "a" 'strokes-global-set-stroke)
1424 (define-key map "d" 'strokes-list-delete-stroke) 1602 ;; (define-key map "d" 'strokes-list-delete-stroke)
1425 ;; (define-key map "n" 'strokes-list-next) 1603 ;; ;; (define-key map "n" 'strokes-list-next)
1426 ;; (define-key map "p" 'strokes-list-prev) 1604 ;; ;; (define-key map "p" 'strokes-list-prev)
1427 ;; (define-key map " " 'strokes-list-next) 1605 ;; ;; (define-key map " " 'strokes-list-next)
1428 ;; (define-key map "\C-?" 'strokes-list-prev) 1606 ;; ;; (define-key map "\C-?" 'strokes-list-prev)
1429 (define-key map "g" 'strokes-list-strokes) ; refresh display 1607 ;; (define-key map "g" 'strokes-list-strokes) ; refresh display
1430 (define-key map "q" 'strokes-edit-quit) 1608 ;; (define-key map "q" 'strokes-edit-quit)
1431 (define-key map [(control c) (control c)] 'bury-buffer)) 1609 ;; (define-key map [(control c) (control c)] 'bury-buffer))
1432 1610
1433 ;;;###autoload 1611 ;;;;;###autoload
1434 (defun strokes-edit-strokes (&optional chronological strokes-map) 1612 ;;(defun strokes-edit-strokes (&optional chronological strokes-map)
1435 ;; ### DEAL WITH THE 2nd ARGUMENT ISSUE! ### 1613 ;; ;; ### DEAL WITH THE 2nd ARGUMENT ISSUE! ###
1436 "Edit strokes in a pop-up buffer containing strokes and their definitions. 1614 ;; "Edit strokes in a pop-up buffer containing strokes and their definitions.
1437 If STROKES-MAP is not given, `strokes-global-map' will be used instead. 1615 ;;If STROKES-MAP is not given, `strokes-global-map' will be used instead.
1438 1616
1439 Editing commands: 1617 ;;Editing commands:
1440 1618
1441 \\{edit-faces-mode-map}" 1619 ;;\\{edit-faces-mode-map}"
1442 (interactive "P") 1620 ;; (interactive "P")
1443 (pop-to-buffer (get-buffer-create "*Strokes List*")) 1621 ;; (pop-to-buffer (get-buffer-create "*Strokes List*"))
1444 (reset-buffer (current-buffer)) ; handy function from minibuf.el 1622 ;; (reset-buffer (current-buffer)) ; handy function from minibuf.el
1445 (setq strokes-map (or strokes-map 1623 ;; (setq strokes-map (or strokes-map
1446 strokes-global-map 1624 ;; strokes-global-map
1447 (progn 1625 ;; (progn
1448 (strokes-load-user-strokes) 1626 ;; (strokes-load-user-strokes)
1449 strokes-global-map))) 1627 ;; strokes-global-map)))
1450 (or chronological 1628 ;; (or chronological
1451 (setq strokes-map (sort (copy-sequence strokes-map) 1629 ;; (setq strokes-map (sort (copy-sequence strokes-map)
1452 'strokes-alphabetic-lessp))) 1630 ;; 'strokes-alphabetic-lessp)))
1453 ;; (push-window-configuration) 1631 ;; ;; (push-window-configuration)
1454 (insert 1632 ;; (insert
1455 "Command Stroke\n" 1633 ;; "Command Stroke\n"
1456 "------- ------") 1634 ;; "------- ------")
1457 (loop for def in strokes-map 1635 ;; (loop for def in strokes-map
1458 for i from 0 to (1- (length strokes-map)) do 1636 ;; for i from 0 to (1- (length strokes-map)) do
1459 (let ((stroke (car def)) 1637 ;; (let ((stroke (car def))
1460 (command-name (symbol-name (cdr def)))) 1638 ;; (command-name (symbol-name (cdr def))))
1461 (strokes-xpm-for-stroke stroke " *strokes-xpm*") 1639 ;; (strokes-xpm-for-stroke stroke " *strokes-xpm*")
1462 (newline 2) 1640 ;; (newline 2)
1463 (insert-char ?\ 45) 1641 ;; (insert-char ?\ 45)
1464 (beginning-of-line) 1642 ;; (beginning-of-line)
1465 (insert command-name) 1643 ;; (insert command-name)
1466 (beginning-of-line) 1644 ;; (beginning-of-line)
1467 (forward-char 45) 1645 ;; (forward-char 45)
1468 (set (intern (format "strokes-list-annotation-%d" i)) 1646 ;; (set (intern (format "strokes-list-annotation-%d" i))
1469 (make-annotation (make-glyph 1647 ;; (make-annotation (make-glyph
1470 (list 1648 ;; (list
1471 (vector 'xpm 1649 ;; (vector 'xpm
1472 :data (buffer-substring 1650 ;; :data (buffer-substring
1473 (point-min " *strokes-xpm*") 1651 ;; (point-min " *strokes-xpm*")
1474 (point-max " *strokes-xpm*") 1652 ;; (point-max " *strokes-xpm*")
1475 " *strokes-xpm*")) 1653 ;; " *strokes-xpm*"))
1476 [string :data "[Stroke]"])) 1654 ;; [string :data "[Stroke]"]))
1477 (point) 'text)) 1655 ;; (point) 'text))
1478 (set-annotation-data (symbol-value (intern (format "strokes-list-annotation-%d" i))) 1656 ;; (set-annotation-data (symbol-value (intern (format "strokes-list-annotation-%d" i)))
1479 def)) 1657 ;; def))
1480 finally do (kill-region (1+ (point)) (point-max))) 1658 ;; finally do (kill-region (1+ (point)) (point-max)))
1481 (edit-strokes-mode) 1659 ;; (edit-strokes-mode)
1482 (goto-char (point-min))) 1660 ;; (goto-char (point-min)))
1483 1661
1484 ;;;###autoload 1662 ;;;;;###autoload
1485 (defalias 'edit-strokes 'strokes-edit-strokes) 1663 ;;(defalias 'edit-strokes 'strokes-edit-strokes)
1486 1664
1487 ;;;###autoload 1665 ;;;###autoload
1488 (defun strokes-list-strokes (&optional chronological strokes-map) 1666 (defun strokes-list-strokes (&optional chronological strokes-map)
1489 "Pop up a buffer containing an alphabetical listing of strokes in STROKES-MAP. 1667 "Pop up a buffer containing an alphabetical listing of strokes in STROKES-MAP.
1490 With CHRONOLOGICAL prefix arg \(\\[universal-argument]\) list strokes 1668 With CHRONOLOGICAL prefix arg \(\\[universal-argument]\) list strokes
1510 (loop for def in strokes-map do 1688 (loop for def in strokes-map do
1511 (let ((stroke (car def)) 1689 (let ((stroke (car def))
1512 (command-name (symbol-name (cdr def)))) 1690 (command-name (symbol-name (cdr def))))
1513 (strokes-xpm-for-stroke stroke " *strokes-xpm*") 1691 (strokes-xpm-for-stroke stroke " *strokes-xpm*")
1514 (newline 2) 1692 (newline 2)
1515 (insert-char ?\ 45) 1693 (insert-char ?\ 45)
1516 (beginning-of-line) 1694 (beginning-of-line)
1517 (insert command-name) 1695 (insert command-name)
1518 (beginning-of-line) 1696 (beginning-of-line)
1519 (forward-char 45) 1697 (forward-char 45)
1520 (make-annotation (make-glyph 1698 (make-annotation (make-glyph
1552 Note that `strokes-mode' is a global mode. Think of it as a minor 1730 Note that `strokes-mode' is a global mode. Think of it as a minor
1553 mode in all buffers when activated. 1731 mode in all buffers when activated.
1554 By default, strokes are invoked with mouse button-2. You can define 1732 By default, strokes are invoked with mouse button-2. You can define
1555 new strokes with 1733 new strokes with
1556 1734
1557 > M-x global-set-stroke" 1735 > M-x global-set-stroke
1736
1737 To use strokes for pictographic editing, such as Chinese/Japanese, use
1738 Sh-button-2, which draws strokes and inserts them. Encode/decode your
1739 strokes with
1740
1741 > M-x strokes-encode-buffer
1742 > M-x strokes-decode-buffer"
1558 (interactive "P") 1743 (interactive "P")
1559 (let ((on-p (if arg 1744 (let ((on-p (if arg
1560 (> (prefix-numeric-value arg) 0) 1745 (> (prefix-numeric-value arg) 0)
1561 (not strokes-mode)))) 1746 (not strokes-mode))))
1562 (cond ((not (device-on-window-system-p)) 1747 (cond ((not (device-on-window-system-p))
1563 (error "Can't use strokes without windows")) 1748 (error "Can't use strokes without windows"))
1564 (on-p ; turn on strokes 1749 (on-p ; turn on strokes
1565 (and (file-exists-p strokes-file) 1750 (and (file-exists-p strokes-file)
1566 (null strokes-global-map) 1751 (null strokes-global-map)
1567 (strokes-load-user-strokes)) 1752 (strokes-load-user-strokes))
1568 (add-hook 'kill-emacs-hook 1753 (add-hook 'kill-emacs-query-functions
1569 'strokes-prompt-user-save-strokes) 1754 'strokes-prompt-user-save-strokes)
1570 (add-hook 'select-frame-hook 1755 (add-hook 'select-frame-hook
1571 'strokes-update-window-configuration) 1756 'strokes-update-window-configuration)
1572 (strokes-update-window-configuration) 1757 (strokes-update-window-configuration)
1573 (define-key global-map [(button2)] 'strokes-do-stroke) 1758 (define-key global-map [(button2)] 'strokes-do-stroke)
1574 (define-key global-map [(control button2)] 'strokes-do-stroke) 1759 (define-key global-map [(meta button2)] 'strokes-do-complex-stroke)
1575 (define-key global-map [(shift button2)] 1760 ;; (define-key global-map [(control button2)] 'strokes-do-complex-stroke)
1576 'strokes-do-complex-stroke) 1761 (define-key global-map [(control button2)]
1762 'strokes-compose-complex-stroke)
1577 (ad-activate-regexp "^strokes-") ; advise button2 commands 1763 (ad-activate-regexp "^strokes-") ; advise button2 commands
1578 (setq strokes-mode t)) 1764 (setq strokes-mode t))
1579 (t ; turn off strokes 1765 (t ; turn off strokes
1580 (if (get-buffer strokes-buffer-name) 1766 (if (get-buffer strokes-buffer-name)
1581 (kill-buffer (get-buffer strokes-buffer-name))) 1767 (kill-buffer (get-buffer strokes-buffer-name)))
1582 (remove-hook 'select-frame-hook 1768 (remove-hook 'select-frame-hook
1583 'strokes-update-window-configuration) 1769 'strokes-update-window-configuration)
1584 (if (string-match "^strokes-" (symbol-name (key-binding [(button2)]))) 1770 (if (string-match "^strokes-" (symbol-name (key-binding [(button2)])))
1585 (define-key global-map [(button2)] strokes-click-command)) 1771 (define-key global-map [(button2)] strokes-click-command))
1772 (if (string-match "^strokes-" (symbol-name (key-binding [(meta button2)])))
1773 (global-unset-key [(meta button2)]))
1586 (if (string-match "^strokes-" (symbol-name (key-binding [(control button2)]))) 1774 (if (string-match "^strokes-" (symbol-name (key-binding [(control button2)])))
1587 (global-unset-key [(control button2)])) 1775 (global-unset-key [(control button2)]))
1588 (if (string-match "^strokes-" (symbol-name (key-binding [(shift button2)]))) 1776 ;; (if (string-match "^strokes-" (symbol-name (key-binding [(shift button2)])))
1589 (global-unset-key [(shift button2)])) 1777 ;; (global-unset-key [(shift button2)]))
1590 (ad-deactivate-regexp "^strokes-") ; unadvise strokes-button2 commands 1778 (ad-deactivate-regexp "^strokes-") ; unadvise strokes-button2 commands
1591 (setq strokes-mode nil)))) 1779 (setq strokes-mode nil))))
1592 (redraw-modeline)) 1780 (redraw-modeline))
1593 1781
1594 (add-minor-mode 'strokes-mode strokes-modeline-string nil nil 'strokes-mode) 1782 (add-minor-mode 'strokes-mode strokes-modeline-string nil nil 'strokes-mode)
1595 1783
1596 (unless (find-face 'strokes-char-face) 1784 ;;;; strokes-xpm stuff (later may be separate)...
1597 (copy-face 'default 'strokes-char-face) 1785
1598 (set-face-background 'strokes-char-face "lightgray")) 1786 ;; This is the stuff that will eventuall be used for composing letters in
1787 ;; any language, compression, decompression, graphics, editing, etc.
1788
1789 (require 'atomic-extents) ; might as well say
1790 ; (require 'not-so-atomic-extents)
1791 ; but what can you do?
1792
1793 ;;(unless (find-face 'strokes-char-face)
1794 (copy-face 'default 'strokes-char-face)
1795 (set-face-background 'strokes-char-face "lightgray") ; I should really
1796 ; make this a
1797 ; user-option,
1798 ; but I'm too
1799 ; lazy right now.
1800 ; In a few days.
1599 1801
1600 (defconst strokes-char-value-hashtable (make-hashtable 62) ; 1802 (defconst strokes-char-value-hashtable (make-hashtable 62) ;
1601 ; (make-char-table 1803 ; (make-char-table
1602 ; 'syntax) 1804 ; 'syntax)
1603 ; in 20.* 1805 ; in 20.*
1604 ;; ### This will become a char-table for XEmacs-20 !!! ### 1806 ;; ### This will/should become a char-table for XEmacs-20 !!! ###
1605 "The table which stores values for the character keys.") 1807 "The table which stores values for the character keys.")
1606 (puthash ?0 0 strokes-char-value-hashtable) ; (put-char-table ?0 0 1808 (puthash ?0 0 strokes-char-value-hashtable) ; (put-char-table ?0 0
1607 ; strokes-value-chartable) 1809 ; strokes-value-chartable)
1608 ; in 20.* 1810 ; in 20.*
1609 (puthash ?1 1 strokes-char-value-hashtable) 1811 (puthash ?1 1 strokes-char-value-hashtable)
1794 ;; "0" 1996 ;; "0"
1795 (strokes-xpm-encode-length-as-string 0)) 1997 (strokes-xpm-encode-length-as-string 0))
1796 (strokes-xpm-encode-length-as-string count))) 1998 (strokes-xpm-encode-length-as-string count)))
1797 "/")))) 1999 "/"))))
1798 2000
1799 (defun strokes-strokify-buffer (&optional buffer) 2001 ;;;###autoload
2002 (defun strokes-decode-buffer (&optional buffer force)
1800 "Decode stroke strings in BUFFER and display their corresponding glyphs. 2003 "Decode stroke strings in BUFFER and display their corresponding glyphs.
1801 BUFFER defaults to the current buffer." 2004 Optional BUFFER defaults to the current buffer.
2005 Optional FORCE non-nil will ignore the buffer's read-only status."
1802 (interactive) 2006 (interactive)
1803 ;; (interactive "*bStrokify buffer: ") 2007 ;; (interactive "*bStrokify buffer: ")
1804 (save-excursion 2008 (save-excursion
1805 (set-buffer (or buffer (setq buffer (current-buffer)))) 2009 (set-buffer (setq buffer (get-buffer (or buffer (current-buffer)))))
1806 (if (interactive-p) 2010 (when (or (not buffer-read-only)
1807 (message "Strokifying %s..." buffer)) 2011 force
1808 (goto-char (point-min)) 2012 inhibit-read-only
1809 (let (ext string) 2013 (y-or-n-p-maybe-dialog-box
1810 ;; The comment below is what i'd have to do if I wanted to deal with 2014 (format "Buffer %s is read-only. Strokify anyway? " buffer)))
1811 ;; random newlines in the midst of the compressed strings. 2015 (let ((inhibit-read-only t))
1812 ;; If I do this, I'll also have to change `strokes-xpm-to-compress-string' 2016 (message "Strokifying %s..." buffer)
1813 ;; to deal with the newline, and possibly other whitespace stuff. YUCK! 2017 (goto-char (point-min))
1814 ;; (while (re-search-forward "\\+/\\(\\w\\| 2018 (let (ext string)
1815 ;;\\)+/" nil t nil (get-buffer buffer)) 2019 ;; The comment below is what i'd have to do if I wanted to
1816 (while (re-search-forward "\\+/\\w+/" nil t nil (get-buffer buffer)) 2020 ;; deal with random newlines in the midst of the compressed
1817 (setq string (buffer-substring (+ 2 (match-beginning 0)) 2021 ;; strings. If I do this, I'll also have to change
1818 (1- (match-end 0)))) 2022 ;; `strokes-xpm-to-compress-string' to deal with the newline,
1819 (strokes-xpm-for-compressed-string string " *strokes-xpm*") 2023 ;; and possibly other whitespace stuff. YUCK!
1820 (replace-match " ") 2024 ;; (while (re-search-forward "\\+/\\(\\w\\|\\)+/" nil t nil (get-buffer buffer))
1821 (setq ext (make-extent (1- (point)) (point))) 2025 (while (re-search-forward "\\+/\\w+/" nil t nil buffer)
1822 (set-extent-property ext 'type 'stroke-glyph) 2026 (setq string (buffer-substring (+ 2 (match-beginning 0))
1823 (set-extent-property ext 'start-open t) 2027 (1- (match-end 0))))
1824 (set-extent-property ext 'end-open t) 2028 (strokes-xpm-for-compressed-string string " *strokes-xpm*")
1825 (set-extent-property ext 'detachable t) 2029 (replace-match " ")
1826 (set-extent-property ext 'duplicable t) 2030 (setq ext (make-extent (1- (point)) (point)))
1827 (set-extent-property ext 'data string) 2031 (set-extent-property ext 'type 'stroke-glyph)
1828 (set-extent-face ext 'strokes-char-face) 2032 (set-extent-property ext 'start-open t)
1829 (set-extent-end-glyph ext (make-glyph 2033 (set-extent-property ext 'end-open t)
1830 (list 2034 (set-extent-property ext 'detachable t)
1831 (vector 'xpm 2035 (set-extent-property ext 'duplicable t)
1832 :data (buffer-substring 2036 (set-extent-property ext 'data string)
1833 (point-min " *strokes-xpm*") 2037 (set-extent-face ext 'default)
1834 (point-max " *strokes-xpm*") 2038 (set-extent-end-glyph ext (make-glyph
1835 " *strokes-xpm*")) 2039 (list
1836 [string :data "[Stroke]"]))))) 2040 (vector 'xpm
1837 (if (interactive-p) 2041 :data (buffer-substring
1838 (message "Strokifying %s...done" buffer)))) 2042 (point-min " *strokes-xpm*")
1839 2043 (point-max " *strokes-xpm*")
1840 (defun strokes-unstrokify-buffer (&optional buffer) 2044 " *strokes-xpm*"))
2045 [string :data "[Stroke]"])))))
2046 (message "Strokifying %s...done" buffer)))))
2047
2048 (defun strokes-encode-buffer (&optional buffer force)
1841 "Convert the glyphs in BUFFER to thier base-64 ASCII representations. 2049 "Convert the glyphs in BUFFER to thier base-64 ASCII representations.
1842 BUFFER defaults to the current buffer" 2050 Optional BUFFER defaults to the current buffer.
2051 Optional FORCE non-nil will ignore the buffer's read-only status."
1843 ;; ### NOTE !!! ### (for me) 2052 ;; ### NOTE !!! ### (for me)
1844 ;; For later on, you can/should make the inserted strings atomic 2053 ;; For later on, you can/should make the inserted strings atomic
1845 ;; extents, so that the users have a clue that they shouldn't be 2054 ;; extents, so that the users have a clue that they shouldn't be
1846 ;; editing inside them. Plus, if you make them extents, you can 2055 ;; editing inside them. Plus, if you make them extents, you can
1847 ;; very easily just hide the glyphs, so if you unstrokify, and the 2056 ;; very easily just hide the glyphs, so if you unstrokify, and the
1851 ;; buffer is killed? 2060 ;; buffer is killed?
1852 ;; (interactive "*bUnstrokify buffer: ") 2061 ;; (interactive "*bUnstrokify buffer: ")
1853 (interactive) 2062 (interactive)
1854 (save-excursion 2063 (save-excursion
1855 (set-buffer (setq buffer (or buffer (current-buffer)))) 2064 (set-buffer (setq buffer (or buffer (current-buffer))))
1856 ;; (map-extents 2065 (when (or (not buffer-read-only)
1857 ;; (lambda (ext buf) 2066 force
1858 ;; (when (eq (extent-property ext 'type) 'stroke-glyph) 2067 inhibit-read-only
1859 ;; (goto-char (extent-start-position ext)) 2068 (y-or-n-p-maybe-dialog-box
1860 ;; (delete-char 1) ; ### What the hell do I do here? ### 2069 (format "Buffer %s is read-only. Encode anyway? " buffer)))
1861 ;; (insert "+/" (extent-property ext 'data) "/") 2070 (message "Encoding strokes in %s..." buffer)
1862 ;; (delete-extent ext)))))) 2071 ;; (map-extents
1863 (let (start) 2072 ;; (lambda (ext buf)
1864 (map-extents 2073 ;; (when (eq (extent-property ext 'type) 'stroke-glyph)
1865 (lambda (ext buf) 2074 ;; (goto-char (extent-start-position ext))
1866 (when (eq (extent-property ext 'type) 'stroke-glyph) 2075 ;; (delete-char 1) ; ### What the hell do I do here? ###
1867 (setq start (goto-char (extent-start-position ext))) 2076 ;; (insert "+/" (extent-property ext 'data) "/")
1868 ;; (insert "+/" (extent-property ext 'data) "/") 2077 ;; (delete-extent ext))))))
1869 (insert-string "+/") 2078 (let ((inhibit-read-only t)
1870 (insert-string (extent-property ext 'data)) 2079 (start nil))
1871 (insert-string "/") 2080 (loop repeat 2 do ; ### KLUDGE!!! This it pure crap! ###
1872 (delete-char 1) 2081 (map-extents
1873 (set-extent-endpoints ext start (point)) 2082 (lambda (ext buf)
1874 (set-extent-property ext 'type 'stroke-string) 2083 (when (eq (extent-property ext 'type) 'stroke-glyph)
1875 (set-extent-property ext 'atomic t) 2084 (setq start (goto-char (extent-start-position ext)))
1876 ;; (set-extent-property ext 'read-only t) 2085 ;; (insert "+/" (extent-property ext 'data) "/")
1877 (set-extent-face ext 'strokes-char-face) 2086 (insert-string "+/")
1878 (set-extent-property ext 'stroke-glyph (extent-end-glyph ext)) 2087 (insert-string (extent-property ext 'data))
1879 (set-extent-end-glyph ext nil))))))) 2088 (insert-string "/")
2089 (delete-char 1)
2090 (set-extent-endpoints ext start (point))
2091 (set-extent-property ext 'type 'stroke-string)
2092 (set-extent-property ext 'atomic t)
2093 ;; (set-extent-property ext 'read-only t)
2094 (set-extent-face ext 'strokes-char-face)
2095 (set-extent-property ext 'stroke-glyph (extent-end-glyph ext))
2096 (set-extent-end-glyph ext nil))))))
2097 (message "Encoding strokes in %s...done" buffer))))
1880 2098
1881 (defun strokes-xpm-for-compressed-string (compressed-string &optional bufname) 2099 (defun strokes-xpm-for-compressed-string (compressed-string &optional bufname)
1882 "Convert the stroke represented by COMPRESSED-STRING into an xpm. 2100 "Convert the stroke represented by COMPRESSED-STRING into an xpm.
1883 Store xpm in buffer BUFNAME if supplied \(default is `*strokes-xpm*'\)" 2101 Store xpm in buffer BUFNAME if supplied \(default is `*strokes-xpm*'\)"
1884 (save-excursion 2102 (save-excursion
1901 (forward-char 33) 2119 (forward-char 33)
1902 (insert "\",\n")) 2120 (insert "\",\n"))
1903 (goto-char (point-min)) 2121 (goto-char (point-min))
1904 (insert strokes-xpm-header)))) 2122 (insert strokes-xpm-header))))
1905 2123
2124 ;;;###autoload
1906 (defun strokes-compose-complex-stroke () 2125 (defun strokes-compose-complex-stroke ()
2126 ;; ### NOTE !!! ###
2127 ;; Even though we have lexical scoping, it's somewhat ugly how I
2128 ;; pass around variables in the global name space. I can/should
2129 ;; change this.
2130 "Read a complex stroke and insert its glyph into the current buffer."
1907 (interactive "*") 2131 (interactive "*")
1908 (let ((strokes-grid-resolution 33)) 2132 (let ((strokes-grid-resolution 33))
1909 (strokes-read-complex-stroke) 2133 (strokes-read-complex-stroke)
1910 (strokes-xpm-for-stroke nil nil t) 2134 (strokes-xpm-for-stroke nil " *strokes-xpm*" t)
1911 (insert (strokes-xpm-to-compressed-string)) 2135 (insert (strokes-xpm-to-compressed-string " *strokes-xpm*"))
1912 (strokes-strokify-buffer))) 2136 (strokes-decode-buffer)))
1913 2137
1914 (provide 'strokes) 2138 (provide 'strokes)
1915 (run-hooks 'strokes-load-hook) 2139 (run-hooks 'strokes-load-hook)
1916 2140
1917 ;;; strokes.el ends here 2141 ;;; strokes.el ends here