1 ;;; strokes.el -- Control XEmacs through mouse strokes --
2 ;; Thursday September 4 12:40:41 EDT 1997
4 ;; Copyright (C) 1997 Free Software Foundation, Inc.
6 ;; Author: David Bakhash <cadet@mit.edu>
7 ;; Maintainer: David Bakhash <cadet@mit.edu>
9 ;; Created: 12 April 1997
10 ;; Keywords: lisp, mouse, extensions
12 ;; This file is part of XEmacs.
14 ;; XEmacs is free software; you can redistribute it and/or modify it
15 ;; under the terms of the GNU General Public License as published by
16 ;; the Free Software Foundation; either version 2 of the License, or
17 ;; (at your option) any later version.
19 ;; XEmacs program is distributed in the hope that it will be useful,
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
22 ;; General Public License for more details.
24 ;; You should have received a copy of the GNU General Public License
25 ;; along with XEmacs; see the file COPYING. If not, write to the Free
26 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
29 ;;; Synched up with: Not in FSF.
33 ;; This package is written for for XEmacs v20.*. This is the strokes
34 ;; package. It is intended to allow the user to control XEmacs by
35 ;; means of mouse strokes. Once strokes is loaded, you can always get
36 ;; help be invoking `strokes-help':
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
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,
44 ;; you may wish the have a mouse stroke that looks like a capital `C'
45 ;; which means `copy-region-as-kill'. Treat strokes just like you do
46 ;; key bindings. For example, XEmacs sets key bindings globally with
47 ;; the `global-set-key' command. Likewise, you can do
49 ;; > M-x global-set-stroke
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
53 ;; `global-set-stroke' with a stroke. likewise, there may eventually
54 ;; be a `local-set-stroke' command, also analogous to `local-set-key'.
56 ;; You can always unset the last stroke definition with the command
58 ;; > M-x strokes-unset-last-stroke
60 ;; and the last stroke that was added to `strokes-global-map' will be
63 ;; Other analogies between strokes and key bindings are as follows:
65 ;; 1) To describe a stroke binding, you can type
67 ;; > M-x describe-stroke
69 ;; analogous to `describe-key'. It's also wise to have a
70 ;; stroke, like an `h', for help, or a `?', mapped to
73 ;; 2) stroke bindings are set internally through the Lisp function
74 ;; `define-stroke', similar to the `define-key' function. some
75 ;; examples for a 3x3 stroke grid would be
77 ;; (define-stroke c-mode-stroke-map
78 ;; '((0 . 0) (1 . 1) (2 . 2))
80 ;; (define-stroke strokes-global-map
81 ;; '((0 . 0) (0 . 1) (0 . 2) (1 . 2) (2 . 2))
84 ;; however, if you would probably just have the user enter in
85 ;; the stroke interactively and then set the stroke to whatever
86 ;; he/she entered. The Lisp function to interactively read a
87 ;; stroke is `strokes-read-stroke'. This is especially helpful
88 ;; when you're on a fast computer that can handle a 9x9 stroke
91 ;; NOTE: only global stroke bindings are currently implemented,
92 ;; however mode- and buffer-local stroke bindings may eventually
93 ;; be implemented in a future version.
95 ;; The important variables to be aware of for this package are listed
96 ;; below. They can all be altered through the customizing package via
100 ;; and customizing the group named `strokes'. You can also read
101 ;; documentation on the variables there.
103 ;; `strokes-minimum-match-score' (determines the threshold of error
104 ;; that makes a stroke acceptable or unacceptable. If your strokes
105 ;; aren't matching, then you should raise this variable.
107 ;; `strokes-grid-resolution' (determines the grid dimensions that you
108 ;; use when defining/reading strokes. The finer the grid your
109 ;; computer can handle, the more you can do, but even a 3x3 grid is
110 ;; pretty cool.) The default value (7) should be fine for most decent
111 ;; computers. NOTE: This variable should not be set to a number less
114 ;; `strokes-display-strokes-buffer' will allow you to hide the strokes
115 ;; buffer when doing simple strokes. This is a speedup for slow
116 ;; computers as well as people who don't want to see their strokes.
118 ;; If you find that your mouse is accelerating too fast, you can
119 ;; execute the UNIX X command to slow it down. A good possibility is
123 ;; which seems, heuristically, to work okay, without much disruption.
125 ;; Whenever you load in the strokes package, you will be able to save
126 ;; what you've done upon exiting XEmacs. You can also do
128 ;; > M-x save-strokes
130 ;; and it will save your strokes in ~/.strokes, or you may wish to
131 ;; change this by setting the variable `strokes-file'.
133 ;; Note that internally, all of the routines that are part of this
134 ;; package are able to deal with complex strokes, as they are a
135 ;; superset of simple strokes. However, the default of this package
136 ;; will map mouse button2 to the command `strokes-do-stroke', and NOT
137 ;; `strokes-do-complex-stroke'. If you wish to use complex strokes,
138 ;; you will have to override this key mapping. Complex strokes are
139 ;; terminated with mouse button3. The strokes package will not
140 ;; interfere with `mouse-yank', but you may want to examine how this
141 ;; is done (see the variable `strokes-click-command')
143 ;; To get strokes to work as part of your your setup, then you'll have
144 ;; put the strokes package in your load-path (preferably
145 ;; byte-compiled) and then add the following to your .emacs file (or
146 ;; wherever you put XEmacs-specific startup preferences):
148 ;; (and (console-on-window-system-p)
149 ;; (require 'strokes))
151 ;; Once loaded, you can start stroking. You can also toggle between
152 ;; strokes mode by simple typing
154 ;; > M-x strokes-mode
156 ;; I am now in the process of porting this package to Emacs. I also
157 ;; hope that, with the help of others, this package will be useful in
158 ;; entering in pictographic-like language text using the mouse
159 ;; (i.e. Korean). Japanese and Chinese are a bit trickier, but I'm
160 ;; sure that with help it can be done. The next version will allow
161 ;; the user to enter strokes which "remove the pencil from the paper"
162 ;; so to speak, so one character can have multiple strokes.
164 ;; You can read more about strokes at:
166 ;; http://www.mit.edu/people/cadet/strokes-help.html
168 ;; If you're interested in using strokes for writing English into
169 ;; XEmacs using strokes, then you'll want to read about it on the web
170 ;; page above or just download from
171 ;; http://www.mit.edu/people/cadet/strokes-abc.el, which is nothing
172 ;; but a file with some helper commands for inserting alphanumerics
175 ;; Great thanks to Rob Ristroph for his generosity in letting me use
176 ;; his PC to develop this, Jason Johnson for his help in algorithms,
177 ;; Euna Kim for her help in Korean, and massive thanks to the helpful
178 ;; guys on the help instance on athena (zeno, jered, amu, gsstark,
179 ;; ghudson, etc) Special thanks to Steve Baur, Kyle Jones, and Hrvoje
180 ;; Niksic for all their help. And special thanks to Dave Gillespie
181 ;; for all the elisp help--he is responsible for helping me use the cl
182 ;; macros at (near) max speed.
184 ;; Tasks: (what I'm getting ready for future version)...
185 ;; 2) use 'strokes-read-complex-stroke for korean, etc.
186 ;; 4) buffer-local 'strokes-local-map, and mode-stroke-maps would be nice
187 ;; 6) add some hooks, like `strokes-read-stroke-hook'
188 ;; 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
190 ;; should be minimal, but computers are getting lots faster, and
191 ;; if I choose the defaults too conservatively, then strokes will
192 ;; surely disappoint some people on decent machines (until they
193 ;; figure out M-x customize). I need feedback.
194 ;; Other: I always have the most beta version of strokes, so if you
195 ;; want it just let me know.
199 ;; 1.3: provided user variable `strokes-use-strokes-buffer' to let
200 ;; users hide the strokes and strokes buffer when entering simple
202 ;; 1.3: cleaned up most leaks.
203 ;; 1.3: with Jari Aalto's help, cleaned up overall program.
204 ;; 1.3: added `strokes-help' for help on strokes
205 ;; 1.3: fixed 'strokes-load-hook bug
206 ;; 1.3: email address change: now <cadet@mit.edu>
207 ;; 1.3: added `strokes-report-bug' based on efs/dired's
208 ;; `dired-report-bug'
209 ;; 1.3: added more dialog-box queries for mouse-event stuff.
210 ;; 1.4: allowed strokes to invoke kbd macros as well (thanks gsstark!)
211 ;; 2.0: fixed up ordering of certain functions.
212 ;; 2.0: fixed bug applying to strokes in dedicated and minibuffer
214 ;; 2.0: punted the C-h way of invoking strokes help routines.
215 ;; 2.0: fixed `strokes-define-stroke' so it would error check against
216 ;; defining strokes that were too short (really clicks) 2.0:
217 ;; added `strokes-toggle-strokes-buffer' interactive function
218 ;; 2.0: added `customize' support, thanks to patch from Hrvoje
220 ;; 2.1: strokes no longer forces `mouse-yank-at-point' to t on
221 ;; mouse-yank (i.e. `mouse-yank-at-point' is up to you again)
222 ;; 2.1: toggling strokes-mode off and then back on no longer deletes
223 ;; the strokes that you programmed in but didn't save before
224 ;; toggling off strokes-mode.
225 ;; 2.1: advised may functions for modes like VM and w3 so that they
226 ;; too can use strokes, while still maintaining old button2
228 ;; 2.1: with Steve's help, got the autoload for `strokes-mode' and
229 ;; fixed up the package so loading it does not enable strokes
230 ;; until user calls `strokes-mode'.
231 ;; 2.2: made sure that abbrev-mode was off in the ` *strokes*' buffer
232 ;; 2.2: added more dired advice for mouse permissions commands
233 ;; 2.2: added some checks to see if saving strokes is really necessary
234 ;; so the user doesn't get prompted aimlessly.
235 ;; 2.2: change the `strokes-lift' symbol to a keyword of value
236 ;; `:strokes-lift' for legibility. IF YOUR OLD STROKES DON'T
237 ;; WORK, THIS IS PROBABLY WHY.
238 ;; 2.2: I might have to change this back to `'strokes-lift' because
239 ;; the keyword fails in emacs, though I don't know why.
240 ;; 2.2: `strokes-describe-stroke' is nicer during recursive edits
241 ;; 2.2: provided `strokes-fill-stroke' to fill in empty spaces of strokes
242 ;; as an important step towards platform (speed) independence.
243 ;; Because of this, I moved the global setting of
244 ;; `strokes-last-stroke' from
245 ;; `strokes-eliminate-consecutive-redundancies' to
246 ;; `strokes-fill-stroke' since the latter comes later in
247 ;; processing a user stroke.
248 ;; 2.2: Finally changed the defaults, so now `strokes-grid-resolution' is 9
249 ;; and `strokes-minimum-match-score' is 1000 by default. This
250 ;; will surely mess some people up, but if so, just set it back
252 ;; 2.2: Fixed up the mechanism for updating the
253 ;; `strokes-window-configuration'. Now it only uses one function
254 ;; (`strokes-update-window-configuration') which does it all, and
255 ;; much more efficiently (thanks RMS!).
256 ;; 2.2 Fixed up the appearance of the *strokes* buffer so that there
257 ;; are no ugly line truncations, and I got rid of the bug which
258 ;; would draw the stroke on the wrong line. I still wish that
259 ;; `event-closest-point' was smarter. In fact,
260 ;; `event-closest-point' does *not* do what its name suggests.
261 ;; 2.3 Added more to `strokes-update-window-configuration' so it goes
262 ;; to hell less often
263 ;; 2.3 `strokes-mode' no longer will undefined keys unless it's sure
264 ;; that the user had had them mapped to a strokes command.
265 ;; 2.3 Added more magic autoload statements so strokes work more
266 ;; smoothly. similarly, I made strokes-mode turn itself on when
267 ;; the user defines a stroke (thanks Hrvoje).
268 ;; 2.3 Added "Strokes" to the modeline when strokes is on, and allow
269 ;; toggling strokes with mouse button2.
270 ;; 2.3 Added `list-strokes', which is a really nice function which
271 ;; graphically lists all the strokes that the user has defined
272 ;; and their corresponding commands. `list-strokes' will
273 ;; appropriately colorize the pixmaps to display some time info.
274 ;; 2.4 Added all new functionality to strokes by allowing the user to
275 ;; enter strokes in graphically into XEmacs, allowing true graphic
276 ;; editing, Chinese/Japanese, etc. User simply uses C-button2 to
277 ;; draw strokes (function: `strokes-compose-complex-stroke'). Then
278 ;; after the glyph gets inserted into the current buffer at (point),
279 ;; the use can treat that glyph as any other character, and
280 ;; copy/paste/delete/undo, etc. Also, when the user would like to
281 ;; save/send the glyphs (to other XEmacs users, of course), he/she
282 ;; can use the helper functions:
284 ;; i. M-x strokes-encode-buffer -- Ascii-encodes and compresses
285 ;; strokes to base-64.
286 ;; ii. M-x strokes-decode-buffer -- Decodes ascii-encoded strokes
288 ;; 2.4 With help from Kyle fixed the itimer (timeout event) bug, where I
289 ;; forgot to check for timeouts.
290 ;; 2.4 Around this time, made a successful port of strokes.el for emacs.
291 ;; 2.4 Made added `strokes-xpm-header' as a variable.
292 ;; 2.4 Changed the default value of `strokes-character' from `o' to
293 ;; `@' since it looks nicer when drawn.
294 ;; 2.4 Changed `strokes-click-p' so that it considers only a stroke
295 ;; of length <= 1 a click, as opposed to a length 2 being a
297 ;; 2.4 Totally made the the function `strokes-read-stroke' (and a bit
298 ;; on `strokes-read-complex-stroke') more efficient and robust,
299 ;; making the former use the optional event passed to it, and
300 ;; thus not losing the first mouse event position when reading a
301 ;; stroke on the fly.
302 ;; 2.4 Finally fixed the mouse-yank / mouse-yank-at-point bug (after
303 ;; months of struggling with it). I simply inserted a (sit-for 0)
304 ;; before the (command-execute strokes-click-command) and that
305 ;; patched it up. I'd thought that it was a kludge, but I later
306 ;; found out that it wasn't, as redisplay has several states, and
307 ;; command-execute often must decide which of two states must be
308 ;; considered when executing a command. The (sit-for 0) merely
309 ;; allowed redisplay to be sure to wait for the ` *strokes*'
310 ;; buffer to vanish before executing the command (thanks for the
311 ;; explanation of why my frobbing worked Kyle). Fixing this bug
312 ;; also (magically) fixed the bug which prevented strokes from
313 ;; executing a stroke in a mode which had it's own binding for
314 ;; button-2, such as w3 when the variable
315 ;; `strokes-use-strokes-buffer' is non-nil. It used to be that
316 ;; if you chose to view your strokes, then you couldn't use
317 ;; strokes properly in modes like VM or w3. Now you can!
318 ;; 2.4 Replaced `kill-emacs-hook' with `kill-emacs-query-functions'
319 ;; for prompting the user to save his/her strokes, since
320 ;; `kill-emacs-hook' was not the right hook to use.
321 ;; 2.4 Having `strokes-update-window-configuration' bound to
322 ;; `select-frame-hook' was a heavy function for such a commonly
323 ;; run hook -- especially since event-Xt.c (?) will add the
324 ;; eval-event to the event queue. So the effect was that if XEmacs
325 ;; was doing an interpreter-intensive task while the user (re)selected
326 ;; the frame n times, then the intensive window config updating
327 ;; took place n times. So to deal, I put in some extra checks to
328 ;; see if the frame parameters really changed, making an update
329 ;; worthwhile. See `strokes-update-window-configuration-plist'.
330 ;; 2.4 For XEmacs 20.*, all hashtables were changed to char-tables,
331 ;; since this is more modern, more efficient, and faster. God only
332 ;; knows how inefficient the hash function was before the advent of
333 ;; char-tables. I also did this out of necessity since MIT's
334 ;; version of XEmacs-20.2 was hashtable-buggy.
338 ;;; Requirements and provisions...
340 (autoload 'reporter-submit-bug-report "reporter")
341 (autoload 'mail-position-on-field "sendmail")
343 (mapc 'require '(xpm-mode pp annotations reporter advice view-less)))
347 (defconst strokes-version "2.4-beta")
349 (defconst strokes-bug-address "cadet@mit.edu")
351 (defconst strokes-lift :strokes-lift
352 "Symbol representing a stroke lift event for complex strokes.
353 Complex strokes are those which contain two or more simple strokes.
354 This will be useful for when XEmacs understands Chinese.")
356 (defconst strokes-xpm-header "/* XPM */
357 static char * stroke_xpm[] = {
358 /* width height ncolors cpp [x_hot y_hot] */
362 \"* c #000000 s foreground\",
363 \"R c #FFFF00000000\",
364 \"O c #FFFF80000000\",
365 \"Y c #FFFFFFFF0000\",
366 \"G c #0000FFFF0000\",
367 \"B c #00000000FFFF\",
368 \"P c #FFFF0000FFFF\",
369 \". c #45458B8B0000\",
371 "The header to all xpm buffers created by strokes")
373 ;;; user variables...
375 (defgroup strokes nil
376 "Control Emacs through mouse strokes."
381 ;; This is an internal variable, but we defcustom it so Customize can
384 (defcustom strokes-mode nil
385 "Non-nil when `strokes' is globally enabled."
387 :set (lambda (symbol value)
388 (strokes-mode (or value 0)))
389 :initialize 'custom-initialize-default
393 (defcustom strokes-modeline-string " Strokes"
394 "*Modeline identification when strokes are on \(default is \" Strokes\"\)."
398 (defcustom strokes-character ?@
399 "*Character used when drawing strokes in the strokes buffer.
400 \(The default is lower-case `@', which works okay\)."
404 (defcustom strokes-minimum-match-score 1000
405 "*Minimum score for a stroke to be considered a possible match.
406 Requiring a perfect match would set this variable to 0.
407 The default value is 1000, but it's mostly dependent on how precisely
408 you manage to replicate your user-defined strokes. It also depends on
409 the value of `strokes-grid-resolution', since a higher grid resolution
410 will correspond to more sample points, and thus more distance
411 measurements. Usually, this is not a problem since you first set
412 `strokes-grid-resolution' based on what your computer seems to be able
413 to handle (though the defaults are usually more than sufficient), and
414 then you can set `strokes-minimum-match-score' to something that works
415 for you. The only purpose of this variable is to insure that if you
416 do a bogus stroke that really doesn't match any of the predefined
417 ones, then strokes should NOT pick the one that came closest."
421 (defcustom strokes-grid-resolution 9
422 "*Integer defining dimensions of the stroke grid.
423 The grid is a square grid, where STROKES-GRID-RESOLUTION defaults to
424 `9', making a 9x9 grid whose coordinates go from (0 . 0) on the top
425 left to ((STROKES-GRID-RESOLUTION - 1) . (STROKES-GRID-RESOLUTION - 1))
426 on the bottom right. The greater the resolution, the more intricate
428 NOTE: This variable should be odd and MUST NOT be less than 3 and need
429 not be greater than 33, which is the resolution of the pixmaps.
430 WARNING: Changing the value of this variable will gravely affect the
431 strokes you have already programmed in. You should try to
432 figure out what it should be based on your needs and on how
433 quick the particular platform(s) you're operating on, and
434 only then start programming in your custom strokes."
438 (defcustom strokes-file "~/.strokes"
439 "*File containing saved strokes for stroke-mode (default is ~/.strokes)."
443 (defcustom strokes-buffer-name " *strokes*"
444 "The buffer that the strokes take place in (default is ` *strokes*')."
448 (defcustom strokes-use-strokes-buffer t
449 "*If non-nil, the strokes buffer is used and strokes are displayed.
450 If nil, strokes will be read the same, however the user will not be
451 able to see the strokes. This be helpful for people who don't like
452 the delay in switching to the strokes buffer."
456 (defcustom strokes-click-command 'mouse-yank
457 "*Command to execute when stroke is actually a `click' event.
458 This is set to `mouse-yank' by default."
462 ;;; internal variables...
464 (defvar strokes-window-configuration nil
465 "The special window configuration used when entering strokes.
466 This is set properly in the function `strokes-update-window-configuration'.")
468 (defvar strokes-window-configuration-plist
469 (list 'frame nil 'frame-height nil 'frame-width nil)
470 "Plist describing the state of the current strokes-window-configuration.
471 The plist consists of the following keys:
473 'frame Frame to draw strokes in.
474 'frame-height Height of the frame.
475 'frame-width Width of the frame.")
477 (defvar strokes-last-stroke nil
478 "Last stroke entered by the user.
479 Its value gets set every time the function
480 `strokes-fill-stroke' gets called,
481 since that is the best time to set the variable")
483 (defvar strokes-global-map '()
484 "Association list of strokes and their definitions.
485 Each entry is (STROKE . COMMAND) where STROKE is itself a list of
486 coordinates (X . Y) where X and Y are lists of positions on the
487 normalized stroke grid, with the top left at (0 . 0). COMMAND is the
488 corresponding interactive function")
490 (defvar strokes-load-hook nil
491 "Function or functions to be called when `strokes' is loaded.")
493 ;;; ### NOT IMPLEMENTED YET ###
494 ;;(defvar edit-strokes-menu
496 ;; ["Add stroke..." strokes-global-set-stroke t]
497 ;; ["Delete stroke..." strokes-edit-delete-stroke t]
498 ;; ["Change stroke" strokes-smaller t]
499 ;; ["Change definition" strokes-larger t]
500 ;; ["[Re]List Strokes chronologically" strokes-list-strokes t]
501 ;; ["[Re]List Strokes alphabetically" strokes-list-strokes t]
502 ;; ["Quit" strokes-edit-quit t]
507 (defmacro strokes-while-inhibiting-garbage-collector (&rest forms)
508 "Execute FORMS without interference from the garbage collector."
509 `(let ((gc-cons-threshold 134217727))
512 (defsubst strokes-click-p (stroke)
513 "Non-nil if STROKE is really click."
514 (< (length stroke) 2))
516 ;;; old, but worked pretty good (just in case)...
517 ;;(defmacro strokes-define-stroke (stroke-map stroke def)
518 ;; "Add STROKE to STROKE-MAP alist with given command DEF"
519 ;; (list 'if (list '< (list 'length stroke) 3)
521 ;; "That's a click, not a stroke. See `strokes-click-command'")
522 ;; (list 'setq stroke-map (list 'cons (list 'cons stroke def)
523 ;; (list 'remassoc stroke stroke-map)))))
525 (defmacro strokes-define-stroke (stroke-map stroke def)
526 "Add STROKE to STROKE-MAP alist with given command DEF."
527 `(if (strokes-click-p ,stroke)
528 (error "That's a click, not a stroke; see `strokes-click-command'")
529 (setq ,stroke-map (cons (cons ,stroke ,def)
530 (remassoc ,stroke ,stroke-map)))))
532 (defalias 'define-stroke 'strokes-define-stroke)
534 (defsubst strokes-square (x)
535 "Returns the square of the number X"
538 (defsubst strokes-distance-squared (p1 p2)
539 "Gets the distance (squared) between to points P1 and P2.
540 P1 and P2 are cons cells in the form (X . Y)."
545 (+ (strokes-square (- x2 x1))
546 (strokes-square (- y2 y1)))))
548 ;;; Advice for various functions...
550 ;; I'd originally wanted to write a macro that would just take in the
551 ;; generic functions which use mouse button2 in various modes. Most
552 ;; of them are identical in form: they take an event as the single
553 ;; argument and then do their thing. I tried writing a macro that
554 ;; looked something like this, but failed. Advice just ain't that
555 ;; easy. The one that bugged me the most was `Manual-follow-xref',
556 ;; because that had &rest arguments, and I didn't know how to work
557 ;; around it in defadvice. However, I was able to fix up most of the
558 ;; important modes (i.e. the ones I use all the time). One `bug' in
559 ;; the program that I just can't seem to figure out is why I can only
560 ;; advise other button2 functions successfully when the variable
561 ;; `strokes-use-strokes-buffer' is nil. I did all the
562 ;; save-excursion/save-window-excursion stuff SPECIFICALLY so that
563 ;; using the strokes buffer or not would absolutely not affect any
564 ;; other part of the program. If someone can figure out how to make
565 ;; the following advices work w/ regardless of that variable
566 ;; `strokes-use-strokes-buffer', then that would be a great victory.
567 ;; If someone out there would be kind enough to make the commented
568 ;; code below work, I'd be grateful. By the way, I put the `protect'
569 ;; keywords there to insure that if a stroke went bad, then
570 ;; `strokes-click-command' would be set back. If this isn't
571 ;; necessary, then feel free to let me know.
573 ;; For what follows, I really wanted something that would work like this:
575 ;;(strokes-fix-button2 'vm-mouse-button-2)
577 ;; Or even better, I could have simply done something like:
579 ;;(mapcar 'strokes-fix-button2
580 ;; '(vm-mouse-button-2
581 ;; rmail-summary-mouse-goto-msg
584 ;;; With help from Hans (author of advice.el)...
585 (defmacro strokes-fix-button2-command (command)
586 "Fix COMMAND so that it can also work with strokes.
587 COMMAND must take one event argument.
588 Example of how one might fix up a command that's bound to button2
589 and which is an interactive function of one event argument:
591 \(strokes-fix-button2-command 'vm-mouse-button-2)"
592 (let ((command (eval command)))
594 (defadvice ,command (around strokes-fix-button2 compile preactivate)
595 ,(format "Fix %s to work with strokes." command)
596 (let ((strokes-click-command
597 ',(intern (format "ad-Orig-%s" command))))
598 (strokes-do-stroke (ad-get-arg 0)))))))
600 (defvar strokes-insinuated nil)
602 (defun strokes-insinuate ()
603 "Insinuate Emacs with strokes advices."
604 (unless strokes-insinuated
605 (strokes-fix-button2-command 'vm-mouse-button-2)
606 (strokes-fix-button2-command 'rmail-summary-mouse-goto-msg)
607 (strokes-fix-button2-command 'Buffer-menu-mouse-select)
608 (strokes-fix-button2-command 'w3-widget-button-click)
609 (strokes-fix-button2-command 'widget-image-button-press)
610 (strokes-fix-button2-command 'Info-follow-clicked-node)
611 (strokes-fix-button2-command 'compile-mouse-goto-error)
612 (strokes-fix-button2-command 'gdbsrc-select-or-yank)
613 (strokes-fix-button2-command 'hypropos-mouse-get-doc)
614 (strokes-fix-button2-command 'gnus-mouse-pick-group)
615 (strokes-fix-button2-command 'gnus-mouse-pick-article)
616 (strokes-fix-button2-command 'gnus-article-push-button)
617 (strokes-fix-button2-command 'dired-mouse-find-file)
618 (strokes-fix-button2-command 'url-dired-find-file-mouse)
619 (strokes-fix-button2-command 'dired-u-r-mouse-toggle)
620 (strokes-fix-button2-command 'dired-u-w-mouse-toggle)
621 (strokes-fix-button2-command 'dired-u-x-mouse-toggle)
622 (strokes-fix-button2-command 'dired-g-r-mouse-toggle)
623 (strokes-fix-button2-command 'dired-g-w-mouse-toggle)
624 (strokes-fix-button2-command 'dired-g-x-mouse-toggle)
625 (strokes-fix-button2-command 'dired-o-r-mouse-toggle)
626 (strokes-fix-button2-command 'dired-o-w-mouse-toggle)
627 (strokes-fix-button2-command 'isearch-yank-x-selection)
628 (strokes-fix-button2-command 'occur-mode-mouse-goto)
629 (strokes-fix-button2-command 'cvs-mouse-find-file))
630 (setq strokes-insinuated t))
632 ;;; I can fix the customize widget button click, but then
633 ;;; people will get confused when they try to customize
634 ;;; strokes with the mouse and customize tells them that
635 ;;; `strokes-click-command' is mapped to `ad-Orig-widget-button-click'
636 ;;(strokes-fix-button2-command 'widget-button-click)
638 ;;; without the advice, each advised function would look like...
639 ;;(defadvice vm-mouse-button-2 (around vm-strokes activate protect)
640 ;; "Allow strokes to work in VM."
641 ;; (if strokes-use-strokes-buffer
642 ;; ;; then strokes is no good and we'll have to use the original
644 ;; ;; otherwise, we can make strokes work too...
645 ;; (let ((strokes-click-command 'ad-Orig-vm-mouse-button-2))
646 ;; (strokes-do-stroke (ad-get-arg 0)))))
650 (defun strokes-lift-p (object)
651 "Return non-nil if object is a stroke-lift."
652 (eq object strokes-lift))
654 (defun strokes-unset-last-stroke ()
655 "Undo the last stroke definition."
657 (let ((command (cdar strokes-global-map)))
658 (if (y-or-n-p-maybe-dialog-box
659 (format "really delete last stroke definition, defined to `%s'? "
662 (setq strokes-global-map (cdr strokes-global-map))
663 (message "That stroke has been deleted"))
664 (message "Nothing done"))))
667 (defun strokes-global-set-stroke (stroke command)
668 "Interactively give STROKE the global binding as COMMAND.
669 Operated just like `global-set-key', except for strokes.
670 COMMAND is a symbol naming an interactively-callable function. STROKE
671 is a list of sampled positions on the stroke grid as described in the
672 documentation for the `strokes-define-stroke' function."
675 (and (or strokes-mode (strokes-mode t))
676 (strokes-read-complex-stroke
677 "Define a new stroke. Draw with button1 (or 2). End with button3..."))
678 (read-command-or-command-sexp "command to map stroke to: ")))
679 (strokes-define-stroke strokes-global-map stroke command))
682 (defalias 'global-set-stroke 'strokes-global-set-stroke)
684 ;;(defun global-unset-stroke (stroke); FINISH THIS DEFUN!
685 ;; "delete all strokes matching STROKE from `strokes-global-map',
686 ;; letting the user input
687 ;; the stroke with the mouse"
690 ;; (strokes-read-stroke "Enter the stroke you want to delete...")))
691 ;; (strokes-define-stroke 'strokes-global-map stroke command))
693 (defun strokes-get-grid-position (stroke-extent position &optional grid-resolution)
694 "Map POSITION to a new grid position based on its STROKE-EXTENT and GRID-RESOLUTION.
695 STROKE-EXTENT as a list \(\(XMIN . YMIN\) \(XMAX . YMAX\)\).
696 If POSITION is a `strokes-lift', then it is itself returned.
697 Optional GRID-RESOLUTION may be used in place of STROKES-GRID-RESOLUTION.
698 The grid is a square whose dimension is [0,GRID-RESOLUTION)."
699 (cond ((consp position) ; actual pixel location
700 (let ((grid-resolution (or grid-resolution strokes-grid-resolution))
703 (xmin (caar stroke-extent))
704 (ymin (cdar stroke-extent))
705 ;; the `1+' is there to insure that the
706 ;; formula evaluates correctly at the boundaries
707 (xmax (1+ (caadr stroke-extent)))
708 (ymax (1+ (cdadr stroke-extent))))
709 (cons (floor (* grid-resolution
710 (/ (float (- x xmin))
712 (floor (* grid-resolution
713 (/ (float (- y ymin))
715 ((strokes-lift-p position) ; stroke lift
718 (defun strokes-get-stroke-extent (pixel-positions)
719 "From a list of absolute PIXEL-POSITIONS, returns absolute spatial extent.
720 The return value is a list ((XMIN . YMIN) (XMAX . YMAX))."
722 (let ((xmin (caar pixel-positions))
723 (xmax (caar pixel-positions))
724 (ymin (cdar pixel-positions))
725 (ymax (cdar pixel-positions))
726 (rest (cdr pixel-positions)))
728 (if (consp (car rest))
729 (let ((x (caar rest))
739 (setq rest (cdr rest)))
740 (let ((delta-x (- xmax xmin))
741 (delta-y (- ymax ymin)))
742 (if (> delta-x delta-y)
744 (/ (- delta-x delta-y)
747 (/ (- delta-x delta-y)
750 (/ (- delta-y delta-x)
753 (/ (- delta-y delta-x)
755 (list (cons xmin ymin)
759 (defun strokes-eliminate-consecutive-redundancies (entries)
760 "Returns a list with no consecutive redundant entries."
761 ;; defun a grande vitesse grace a Dave G.
762 (loop for element on entries
763 if (not (equal (car element) (cadr element)))
764 collect (car element)))
765 ;; (loop for element on entries
766 ;; nconc (if (not (equal (car el) (cadr el)))
767 ;; (list (car el)))))
768 ;; yet another (orig) way of doing it...
770 ;; (let* ((current (car entries))
771 ;; (rest (cdr entries))
772 ;; (non-redundant-list (list current))
775 ;; (setq next (car rest))
776 ;; (if (equal current next)
777 ;; (setq rest (cdr rest))
778 ;; (setq non-redundant-list (cons next non-redundant-list)
780 ;; rest (cdr rest))))
781 ;; (nreverse non-redundant-list))
784 (defun strokes-renormalize-to-grid (positions &optional grid-resolution)
785 "Map POSITIONS to a new grid whose dimensions are based on GRID-RESOLUTION.
786 POSITIONS is a list of positions and stroke-lifts.
787 Optional GRID-RESOLUTION may be used in place of STROKES-GRID-RESOLUTION.
788 The grid is a square whose dimension is [0,GRID-RESOLUTION)."
789 (or grid-resolution (setq grid-resolution strokes-grid-resolution))
790 (let ((stroke-extent (strokes-get-stroke-extent positions)))
793 (strokes-get-grid-position stroke-extent pos grid-resolution)))
796 (defun strokes-fill-stroke (unfilled-stroke &optional force)
797 "Fill in missing grid locations in the list of UNFILLED-STROKE.
798 If FORCE is non-nil, then fill the stroke even if it's `stroke-click'.
799 NOTE: This is where the global variable `strokes-last-stroke' is set."
800 (setq strokes-last-stroke ; this is global
801 (if (and (strokes-click-p unfilled-stroke)
804 (loop for grid-locs on unfilled-stroke
805 nconc (let* ((current (car grid-locs))
806 (current-is-a-point-p (consp current))
807 (next (cadr grid-locs))
808 (next-is-a-point-p (consp next))
809 (both-are-points-p (and current-is-a-point-p
811 (x1 (and current-is-a-point-p
813 (y1 (and current-is-a-point-p
815 (x2 (and next-is-a-point-p
817 (y2 (and next-is-a-point-p
819 (delta-x (and both-are-points-p
821 (delta-y (and both-are-points-p
823 (slope (and both-are-points-p
825 nil ; undefined vertical slope
828 (cond ((not both-are-points-p)
830 ((null slope) ; undefinded vertical slope
832 (loop for y from y1 below y2
834 (loop for y from y1 above y2
835 collect (cons x1 y))))
836 ((zerop slope) ; (= y1 y2)
838 (loop for x from x1 below x2
840 (loop for x from x1 above x2
841 collect (cons x y1))))
842 ((>= (abs delta-x) (abs delta-y))
844 (loop for x from x1 below x2
849 (loop for x from x1 above x2
854 (t ; (< (abs delta-x) (abs delta-y))
856 (loop for y from y1 below y2
861 (loop for y from y1 above y2
867 (defun strokes-rate-stroke (stroke1 stroke2)
868 "Rates STROKE1 with STROKE2 and returns a score based on a distance metric.
869 Note: the rating is an error rating, and therefore, a return of 0
870 represents a perfect match. Also note that the order of stroke
871 arguments is order-independent for the algorithm used here."
872 (if (and stroke1 stroke2)
873 (let ((rest1 (cdr stroke1))
874 (rest2 (cdr stroke2))
875 (err (strokes-distance-squared (car stroke1)
877 (while (and rest1 rest2)
878 (while (and (consp (car rest1))
881 (strokes-distance-squared (car rest1)
886 rest2 (cdr stroke2)))
887 (cond ((and (strokes-lift-p (car rest1))
888 (strokes-lift-p (car rest2)))
889 (setq rest1 (cdr rest1)
891 ((strokes-lift-p (car rest2))
892 (while (consp (car rest1))
894 (strokes-distance-squared (car rest1)
897 ((strokes-lift-p (car rest1))
898 (while (consp (car rest2))
900 (strokes-distance-squared (car stroke1)
902 rest2 (cdr rest2))))))
904 (while (consp (car rest1))
906 (strokes-distance-squared (car rest1)
910 (while (consp (car rest2))
912 (strokes-distance-squared (car stroke1)
915 (if (or (strokes-lift-p (car rest1))
916 (strokes-lift-p (car rest2)))
921 (defun strokes-match-stroke (stroke stroke-map)
922 "Finds the best matching command of STROKE in STROKE-MAP.
923 Returns the corresponding match as (COMMAND . SCORE)."
924 (if (and stroke stroke-map)
925 (let ((score (strokes-rate-stroke stroke (caar stroke-map)))
926 (command (cdar stroke-map))
927 (map (cdr stroke-map)))
929 (let ((newscore (strokes-rate-stroke stroke (caar map))))
930 (if (or (and newscore score (< newscore score))
931 (and newscore (null score)))
934 (setq map (cdr map))))
941 (defun strokes-read-stroke (&optional prompt event)
942 "Read a simple stroke (interactively) and return the stroke.
943 Optional PROMPT in minibuffer displays before and during stroke reading.
944 This function will display the stroke interactively as it is being
945 entered in the strokes buffer if the variable
946 `strokes-use-strokes-buffer' is non-nil.
947 Optional EVENT is acceptable as the starting event of the stroke"
951 (safe-to-draw-p nil))
952 (strokes-while-inhibiting-garbage-collector
953 (if strokes-use-strokes-buffer
954 ;; switch to the strokes buffer and
955 ;; display the stroke as it's being read
956 (save-window-excursion
957 (set-window-configuration strokes-window-configuration)
959 (setq event (next-command-event event prompt))
960 (or (button-press-event-p event)
961 (error "You must draw with the mouse")))
962 (or event (setq event (next-event nil prompt)
966 (while (not (button-release-event-p event))
967 (if (mouse-event-p event)
968 (let ((point (event-closest-point event)))
969 (if (and point safe-to-draw-p)
970 ;; we can draw that point
973 (subst-char-in-region point (1+ point) ?\ strokes-character))
974 ;; otherwise, we can start drawing the next time...
975 (setq safe-to-draw-p t))
976 (push (cons (event-x-pixel event)
977 (event-y-pixel event))
979 ;; otherwise, if it's not a mouse-event...
980 (dispatch-event event))
981 (setq event (next-event event))))
983 ;; clean up strokes buffer and then bury it.
984 (when (equal (buffer-name) strokes-buffer-name)
985 (subst-char-in-region (point-min) (point-max) strokes-character ?\ )
986 (goto-char (point-min))
988 ;; Otherwise, don't use strokes buffer and read stroke silently
990 (setq event (next-command-event event prompt))
991 (or (button-press-event-p event)
992 (error "You must draw with the mouse")))
993 (or event (setq event (next-event nil prompt)))
994 (while (not (button-release-event-p event))
995 (if (mouse-event-p event)
996 (push (cons (event-x-pixel event)
997 (event-y-pixel event))
999 (dispatch-event event))
1000 (setq event (next-event event)))))
1001 (setq grid-locs (strokes-renormalize-to-grid (nreverse pix-locs)))
1002 (strokes-fill-stroke (strokes-eliminate-consecutive-redundancies grid-locs)))))
1004 (defun strokes-read-complex-stroke (&optional prompt event)
1005 "Read a complex stroke (interactively) and return the stroke.
1006 Optional PROMPT in minibuffer displays before and during stroke reading.
1007 Note that a complex stroke allows the user to pen-up and pen-down. This
1008 is implemented by allowing the user to paint with button1 or button2 and
1009 then complete the stroke with button3.
1010 Optional EVENT is acceptable as the starting event of the stroke"
1012 (save-window-excursion
1013 (strokes-while-inhibiting-garbage-collector
1014 (set-window-configuration strokes-window-configuration)
1015 (let ((pix-locs nil)
1017 (safe-to-draw-p nil))
1019 (setq event (next-command-event event prompt))
1020 (or (button-press-event-p event)
1021 (error "You must draw with the mouse")))
1022 (or event (setq event (next-event nil prompt)
1026 (while (not (and (button-press-event-p event)
1027 (eq (event-button event) 3)))
1028 (while (not (button-release-event-p event))
1029 (if (mouse-event-p event)
1030 (let ((point (event-closest-point event)))
1031 (if (and point safe-to-draw-p)
1032 ;; we can draw that point
1035 (subst-char-in-region point (1+ point) ?\ strokes-character))
1036 ;; otherwise, we can start drawing the next time...
1037 (setq safe-to-draw-p t))
1038 (push (cons (event-x-pixel event)
1039 (event-y-pixel event))
1041 (dispatch-event event))
1042 (setq event (next-event event prompt)))
1043 (push strokes-lift pix-locs)
1044 (while (not (button-press-event-p event))
1045 (dispatch-event event)
1046 (setq event (next-event event prompt))))
1047 (setq pix-locs (nreverse (cdr pix-locs)))
1048 ;; minor bug fix here for when user enters ` *strokes*'
1049 ;; buffer with a click instead of a drag...
1050 (when (strokes-lift-p (car pix-locs))
1051 (setq pix-locs (cdr pix-locs)))
1052 (setq grid-locs (strokes-renormalize-to-grid pix-locs))
1053 (strokes-fill-stroke
1054 (strokes-eliminate-consecutive-redundancies grid-locs)))
1056 (when (equal (buffer-name) strokes-buffer-name)
1057 (subst-char-in-region (point-min) (point-max) strokes-character ?\ )
1058 (goto-char (point-min))
1059 (bury-buffer))))))))
1061 (defun strokes-execute-stroke (stroke)
1062 "Given STROKE, execute the command which corresponds to it.
1063 The command will be executed provided one exists for that stroke,
1064 based on the variable `strokes-minimum-match-score'.
1065 If no stroke matches, nothing is done and return value is nil."
1066 (let* ((match (strokes-match-stroke stroke strokes-global-map))
1067 (command (car match))
1068 (score (cdr match)))
1069 (cond ((strokes-click-p stroke)
1070 ;; This is the case of a `click' type event.
1071 ;; The `sit-for' is a minor frob that has to do with timing
1072 ;; problems. Without the `sit-for', mouse-yank will not
1073 ;; yank at the proper location if the user opted for
1074 ;; mouse-yank-at-point to be nil (i.e. mouse-yank takes
1075 ;; place at pointer position). The sit-for tells redisplay
1076 ;; to be sure to wait for the `*strokes*' buffer to vanish
1077 ;; from consideration when deciding on a point to be used
1080 (command-execute strokes-click-command))
1081 ((and match (<= score strokes-minimum-match-score))
1082 (message "%s" command)
1083 (command-execute command))
1084 ((null strokes-global-map)
1085 (if (file-exists-p strokes-file)
1086 (and (y-or-n-p-maybe-dialog-box
1087 (format "No strokes loaded. Load `%s'? "
1089 (strokes-load-user-strokes))
1090 (error "No strokes defined; use `global-set-stroke'")))
1093 "No stroke matches; see variable `strokes-minimum-match-score'")
1097 (defun strokes-do-stroke (event)
1098 "Read a simple stroke from the user and then execute its command.
1099 This must be bound to a mouse event."
1101 (or strokes-mode (strokes-mode t))
1102 (strokes-execute-stroke (strokes-read-stroke nil event)))
1105 (defun strokes-do-complex-stroke (event)
1106 "Read a complex stroke from the user and then execute its command.
1107 This must be bound to a mouse event."
1109 (or strokes-mode (strokes-mode t))
1110 (strokes-execute-stroke (strokes-read-complex-stroke nil event)))
1113 (defun strokes-describe-stroke (stroke)
1114 "Displays the command which STROKE maps to, reading STROKE interactively."
1117 (strokes-read-complex-stroke
1118 "Enter stroke to describe; end with button3...")))
1119 (let* ((match (strokes-match-stroke stroke strokes-global-map))
1120 (command (or (and (strokes-click-p stroke)
1121 strokes-click-command)
1123 (score (cdr match)))
1125 (<= score strokes-minimum-match-score))
1126 (and (strokes-click-p stroke)
1127 strokes-click-command))
1128 (message "That stroke maps to `%s'" command)
1129 (message "That stroke is undefined"))
1130 (sleep-for 1))) ; helpful for recursive edits
1133 (defalias 'describe-stroke 'strokes-describe-stroke)
1136 (defun strokes-help ()
1137 "Get instructional help on using the the `strokes' package."
1139 (with-displaying-help-buffer
1144 "This is help for the strokes package.
1146 If you find something wrong with strokes, or feel that it can be
1147 improved in some way, then please feel free to email me:
1149 David Bakhash <cadet@mit.edu>
1153 M-x strokes-report-bug
1155 ------------------------------------------------------------
1159 The strokes package allows you to define strokes (that you make with
1160 the mouse or other pointer device) that XEmacs can interpret as
1161 corresponding to commands, and then executes the commands. It does
1162 character recognition, so you don't have to worry about getting it
1165 Strokes also allows you to compose documents graphically. You can
1166 fully edit documents in Chinese, Japanese, etc. based on XEmacs
1167 strokes. Once you've done so, you can ascii compress-and-encode them
1168 and then safely save them for later use, send letters to friends
1169 (using XEmacs, of course). Strokes will later decode these documents,
1170 extracting the strokes for editing use once again, so the editing
1173 Strokes are easy to program and fun to use. To start strokes going,
1174 you'll want to put the following line in your .emacs file:
1179 This will load strokes when and only when you start XEmacs on a window
1180 system (i.e. that has a pointer (mouse) device, etc.).
1182 To toggle strokes-mode, you just do
1186 ** Strokes for controlling the behavior of XEmacs...
1188 When you're ready to start defining strokes, just use the command
1190 > M-x global-set-stroke
1192 You will see a ` *strokes*' buffer which is waiting for you to enter in
1193 your stroke. When you enter in the stroke, you draw with button1 or
1194 button2, and then end with button3. Next, you enter in the command
1195 which will be executed when that stroke is invoked. Simple as that.
1196 For now, try to define a stroke to copy a region. This is a popular
1197 edit command, so type
1199 > M-x global-set-stroke
1201 Then, in the ` *strokes*' buffer, draw the letter `C' (for `copy')
1202 and then, when it asks you to enter the command to map that to, type
1204 > copy-region-as-kill
1206 That's about as hard as it gets.
1207 Remember: paint with button1 or button2 and then end with button3.
1209 If ever you want to know what a certain strokes maps to, then do
1211 > M-x describe-stroke
1213 and you can enter in any arbitrary stroke. Remember: The strokes
1214 package lets you program in simple and complex (multi-lift) strokes.
1215 The only difference is how you *invoke* the two. You will most likely
1216 use simple strokes, as complex strokes were developed for
1217 Chinese/Japanese/Korean. So the middle mouse button (button2) will
1218 invoke the command `strokes-do-stroke' in buffers where button2 doesn't
1219 already have a meaning other than its original, which is `mouse-yank'.
1220 But don't worry: `mouse-yank' will still work with strokes (see the
1221 variable `strokes-click-command').
1223 If ever you define a stroke which you don't like, then you can unset
1226 > M-x strokes-unset-last-stroke
1228 You can always get an idea of what your current strokes look like with
1233 Your strokes will be displayed in alphabetical order (based on command
1234 names) and the beginning of each simple stroke will be marked by a
1235 color dot. Since you may have several simple strokes in a complex
1236 stroke, the dot colors are arranged in the rainbow color sequence,
1237 `ROYGBIV'. If you want a listing of your strokes from most recent
1238 down, then use a prefix argument:
1240 > C-u M-x list-strokes
1242 Your strokes are stored as you enter them. They get saved in a file
1243 called ~/.strokes, along with other strokes configuration variables.
1244 You can change this location by setting the variable `strokes-file'.
1245 You will be prompted to save them when you exit XEmacs, or you can save
1250 Your strokes get loaded automatically when you enable `strokes-mode'.
1251 You can also load in your user-defined strokes with
1253 > M-x load-user-strokes
1255 ** Strokes for pictographic editing...
1257 If you'd like to create graphical files with strokes, you'll have to
1258 be running XEmacs on a window system, with XPM support. You use the
1259 binding C-button2 to start drawing your strokes. These are just
1260 complex strokes, and thus you continue drawing with buttons 1 or 2 and
1261 end with button-3. Then the stroke glyph gets inserted into the
1262 buffer. You treat it like any other character, which you can copy,
1263 paste, delete, move, etc. The command which is bound to C-button2 is
1264 called `strokes-compose-complex-stroke'. When all is done, you may
1265 want to send the file, or save it. This is done with
1267 > M-x strokes-encode-buffer
1269 Likewise, to decode the strokes from a strokes-encoded buffer you do
1271 > M-x strokes-decode-buffer
1273 ** A few more important things...
1275 o The command `strokes-do-complex-stroke' is invoked with M-button2, so that you
1276 can execute complex strokes (i.e. with more than one lift) if preferred.
1278 o Strokes are a bit computer-dependent in that they depend somewhat on
1279 the speed of the computer you're working on. This means that you
1280 may have to tweak some variables. You can read about them in the
1281 commentary of `strokes.el'. Better to just use apropos and read their
1282 docstrings. All variables/functions start with `strokes'. The one
1283 variable which many people wanted to see was
1284 `strokes-use-strokes-buffer' which allows the user to use strokes
1285 silently--without displaying the strokes. All variables can be set
1286 by customizing the group named `strokes' via the customization package:
1289 (princ helpdoc standard-output)))))))
1291 (defun strokes-report-bug ()
1292 "Submit a bug report for strokes."
1294 (let ((reporter-prompt-for-summary-p t))
1295 (or (boundp 'reporter-version)
1296 (setq reporter-version
1297 "Your version of reporter is obsolete. Please upgrade."))
1298 (reporter-submit-bug-report
1299 strokes-bug-address "Strokes"
1306 (let (completion-ignore-case)
1307 (all-completions "strokes-" obarray 'user-variable-p))
1309 (list 'reporter-version)))
1313 (mail-position-on-field "subject")
1315 (skip-chars-forward "^:\n")
1316 (if (looking-at ": Strokes;")
1318 (goto-char (match-end 0))
1320 (insert " " strokes-version " bug:")))))))))
1322 (defsubst strokes-fill-current-buffer-with-whitespace ()
1323 "Erase the contents of the current buffer and fill it with whitespace."
1325 (loop repeat (frame-height) do
1326 (insert-char ?\ (1- (frame-width)))
1328 (goto-char (point-min)))
1330 (defun strokes-window-configuration-changed-p ()
1331 "Non-nil if the `strokes-window-configuration' frame properties changed.
1332 This is based on the last time the `strokes-window-configuration was updated."
1333 (not (and (eq (selected-frame)
1334 (plist-get strokes-window-configuration-plist
1337 (plist-get strokes-window-configuration-plist
1340 (plist-get strokes-window-configuration-plist
1343 (defun strokes-update-window-configuration-plist ()
1344 "Update the `strokes-window-configuration-plist' based on the current state."
1345 (plist-put strokes-window-configuration-plist
1348 (plist-put strokes-window-configuration-plist
1351 (plist-put strokes-window-configuration-plist
1355 (defun strokes-update-window-configuration ()
1356 "Update the `strokes-window-configuration'."
1358 (let ((current-window (selected-window)))
1359 (cond ((or (window-minibuffer-p current-window)
1360 (window-dedicated-p current-window))
1361 ;; don't try to update strokes window configuration
1362 ;; if window is dedicated or a minibuffer
1364 ((or (interactive-p)
1365 (not (buffer-live-p (get-buffer strokes-buffer-name)))
1366 (null strokes-window-configuration))
1367 ;; create `strokes-window-configuration' from scratch...
1369 (save-window-excursion
1370 (get-buffer-create strokes-buffer-name)
1371 (set-window-buffer current-window strokes-buffer-name)
1372 (delete-other-windows)
1375 (if (featurep 'font-lock)
1378 (buffer-disable-undo (current-buffer))
1379 (setq truncate-lines nil)
1380 (strokes-fill-current-buffer-with-whitespace)
1381 (setq strokes-window-configuration (current-window-configuration))
1382 (strokes-update-window-configuration-plist)
1384 ((strokes-window-configuration-changed-p) ; simple update
1385 ;; update the strokes-window-configuration for this
1386 ;; specific frame...
1388 (save-window-excursion
1389 (set-window-buffer current-window strokes-buffer-name)
1390 (delete-other-windows)
1391 (strokes-fill-current-buffer-with-whitespace)
1392 (setq strokes-window-configuration (current-window-configuration))
1393 (strokes-update-window-configuration-plist)
1397 (defun strokes-load-user-strokes ()
1398 "Load user-defined strokes from file named by `strokes-file'."
1400 (cond ((and (file-exists-p strokes-file)
1401 (file-readable-p strokes-file))
1402 (load-file strokes-file))
1404 (error "Trouble loading user-defined strokes; nothing done"))
1406 (message "No user-defined strokes, sorry"))))
1409 (defalias 'load-user-strokes 'strokes-load-user-strokes)
1411 (defun strokes-prompt-user-save-strokes ()
1412 "Save user-defined strokes to file named by `strokes-file'."
1415 (let ((current strokes-global-map))
1418 (setq strokes-global-map nil)
1419 (strokes-load-user-strokes)
1420 (if (and (not (equal current strokes-global-map))
1422 (yes-or-no-p-maybe-dialog-box "save your strokes? ")))
1424 (require 'pp) ; pretty-print variables
1425 (message "Saving strokes in %s..." strokes-file)
1426 (get-buffer-create "*saved-strokes*")
1427 (set-buffer "*saved-strokes*")
1430 (goto-char (point-min))
1432 ";; -*- Syntax: Emacs-Lisp; Mode: emacs-lisp -*-\n")
1433 (insert-string (format ";;; saved strokes for %s, as of %s\n\n"
1435 (format-time-string "%B %e, %Y" nil)))
1436 (message "Saving strokes in %s..." strokes-file)
1437 (insert-string (format "(setq strokes-global-map '%s)"
1439 (message "Saving strokes in %s..." strokes-file)
1440 (indent-region (point-min) (point-max) nil)
1441 (write-region (point-min)
1444 (message "(no changes need to be saved)")))
1446 (if (get-buffer "*saved-strokes*")
1447 (kill-buffer (get-buffer "*saved-strokes*")))
1448 (setq strokes-global-map current)))))
1450 (defalias 'save-strokes 'strokes-prompt-user-save-strokes)
1452 (defun strokes-toggle-strokes-buffer (&optional arg)
1453 "Toggle the use of the strokes buffer.
1454 In other words, toggle the variable `strokes-use-strokes-buffer'.
1455 With ARG, use strokes buffer if and only if ARG is positive or true.
1456 Returns value of `strokes-use-strokes-buffer'."
1458 (setq strokes-use-strokes-buffer
1459 (if arg (> (prefix-numeric-value arg) 0)
1460 (not strokes-use-strokes-buffer))))
1462 (defun strokes-xpm-for-stroke (&optional stroke bufname b/w-only)
1463 "Create an xpm pixmap for the given STROKE in buffer `*strokes-xpm*'.
1464 If STROKE is not supplied, then `strokes-last-stroke' will be used.
1465 Optional BUFNAME to name something else.
1466 The pixmap will contain time information via rainbow dot colors
1467 where each individual strokes begins.
1468 Optional B/W-ONLY non-nil will create a mono pixmap, not intended
1469 for trying to figure out the order of strokes, but rather for reading
1470 the stroke as a character in some language."
1473 (let ((buf (get-buffer-create (or bufname "*strokes-xpm*")))
1474 (stroke (strokes-eliminate-consecutive-redundancies
1475 (strokes-fill-stroke
1476 (strokes-renormalize-to-grid (or stroke
1477 strokes-last-stroke)
1480 (rainbow-chars (list ?R ?O ?Y ?G ?B ?P))) ; ROYGBIV w/o indigo
1483 (insert strokes-xpm-header)
1493 (loop for point in stroke
1494 for x = (car-safe point)
1495 for y = (cdr-safe point) do
1496 (cond ((consp point)
1497 ;; draw a point, and possibly a starting-point
1498 (if (and lift-flag (not b/w-only))
1499 ;; mark starting point with the appropriate color
1500 (let ((char (or (car rainbow-chars) ?\.)))
1501 (loop for i from 0 to 2 do
1502 (loop for j from 0 to 2 do
1503 (goto-line (+ 16 i y))
1504 (forward-char (+ 1 j x))
1506 (insert-char char)))
1507 (setq rainbow-chars (cdr rainbow-chars)
1509 ;; Otherwise, just plot the point...
1510 (goto-line (+ 17 y))
1511 (forward-char (+ 2 x))
1512 (subst-char-in-region (point) (1+ (point)) ?\ ?\*)))
1513 ((strokes-lift-p point)
1514 ;; a lift--tell the loop to X out the next point...
1515 (setq lift-flag t))))
1516 (when (interactive-p)
1518 (pop-to-buffer "*strokes-xpm*")
1521 (goto-char (point-min))))))
1523 ;;; Strokes Edit stuff... ### NOT IMLEMENTED YET ###
1525 ;;(defun strokes-edit-quit ()
1527 ;; (or (one-window-p t 0)
1529 ;; (kill-buffer "*Strokes List*"))
1531 ;;(define-derived-mode edit-strokes-mode list-mode
1533 ;; "Major mode for `edit-strokes' and `list-strokes' buffers.
1537 ;;\\{edit-strokes-mode-map}"
1538 ;; (setq truncate-lines nil
1539 ;; auto-show-mode nil ; don't want problems here either
1540 ;; mode-popup-menu edit-strokes-menu) ; what about extent-specific stuff?
1541 ;; (and (featurep 'menubar)
1543 ;; (set (make-local-variable 'current-menubar)
1544 ;; (copy-sequence current-menubar))
1545 ;; (add-submenu nil edit-strokes-menu)))
1547 ;;(let ((map edit-strokes-mode-map))
1548 ;; (define-key map "<" 'beginning-of-buffer)
1549 ;; (define-key map ">" 'end-of-buffer)
1550 ;; ;; (define-key map "c" 'strokes-copy-other-face)
1551 ;; ;; (define-key map "C" 'strokes-copy-this-face)
1552 ;; ;; (define-key map "s" 'strokes-smaller)
1553 ;; ;; (define-key map "l" 'strokes-larger)
1554 ;; ;; (define-key map "b" 'strokes-bold)
1555 ;; ;; (define-key map "i" 'strokes-italic)
1556 ;; (define-key map "e" 'strokes-list-edit)
1557 ;; ;; (define-key map "f" 'strokes-font)
1558 ;; ;; (define-key map "u" 'strokes-underline)
1559 ;; ;; (define-key map "t" 'strokes-truefont)
1560 ;; ;; (define-key map "F" 'strokes-foreground)
1561 ;; ;; (define-key map "B" 'strokes-background)
1562 ;; ;; (define-key map "D" 'strokes-doc-string)
1563 ;; (define-key map "a" 'strokes-global-set-stroke)
1564 ;; (define-key map "d" 'strokes-list-delete-stroke)
1565 ;; ;; (define-key map "n" 'strokes-list-next)
1566 ;; ;; (define-key map "p" 'strokes-list-prev)
1567 ;; ;; (define-key map " " 'strokes-list-next)
1568 ;; ;; (define-key map "\C-?" 'strokes-list-prev)
1569 ;; (define-key map "g" 'strokes-list-strokes) ; refresh display
1570 ;; (define-key map "q" 'strokes-edit-quit)
1571 ;; (define-key map [(control c) (control c)] 'bury-buffer))
1574 ;;(defun strokes-edit-strokes (&optional chronological strokes-map)
1575 ;; ;; ### DEAL WITH THE 2nd ARGUMENT ISSUE! ###
1576 ;; "Edit strokes in a pop-up buffer containing strokes and their definitions.
1577 ;;If STROKES-MAP is not given, `strokes-global-map' will be used instead.
1581 ;;\\{edit-faces-mode-map}"
1582 ;; (interactive "P")
1583 ;; (pop-to-buffer (get-buffer-create "*Strokes List*"))
1584 ;; (reset-buffer (current-buffer)) ; handy function from minibuf.el
1585 ;; (setq strokes-map (or strokes-map
1586 ;; strokes-global-map
1588 ;; (strokes-load-user-strokes)
1589 ;; strokes-global-map)))
1590 ;; (or chronological
1591 ;; (setq strokes-map (sort (copy-sequence strokes-map)
1592 ;; 'strokes-alphabetic-lessp)))
1593 ;; ;; (push-window-configuration)
1595 ;; "Command Stroke\n"
1596 ;; "------- ------")
1597 ;; (loop for def in strokes-map
1598 ;; for i from 0 to (1- (length strokes-map)) do
1599 ;; (let ((stroke (car def))
1600 ;; (command-name (symbol-name (cdr def))))
1601 ;; (strokes-xpm-for-stroke stroke " *strokes-xpm*")
1603 ;; (insert-char ?\ 45)
1604 ;; (beginning-of-line)
1605 ;; (insert command-name)
1606 ;; (beginning-of-line)
1607 ;; (forward-char 45)
1608 ;; (set (intern (format "strokes-list-annotation-%d" i))
1609 ;; (make-annotation (make-glyph
1612 ;; :data (buffer-substring
1613 ;; (point-min " *strokes-xpm*")
1614 ;; (point-max " *strokes-xpm*")
1615 ;; " *strokes-xpm*"))
1616 ;; [string :data "[Stroke]"]))
1618 ;; (set-annotation-data (symbol-value (intern (format "strokes-list-annotation-%d" i)))
1620 ;; finally do (kill-region (1+ (point)) (point-max)))
1621 ;; (edit-strokes-mode)
1622 ;; (goto-char (point-min)))
1625 ;;(defalias 'edit-strokes 'strokes-edit-strokes)
1628 (defun strokes-list-strokes (&optional chronological strokes-map)
1629 "Pop up a buffer containing an alphabetical listing of strokes in STROKES-MAP.
1630 With CHRONOLOGICAL prefix arg \(\\[universal-argument]\) list strokes
1631 chronologically by command name.
1632 If STROKES-MAP is not given, `strokes-global-map' will be used instead."
1634 (setq strokes-map (or strokes-map
1637 (strokes-load-user-strokes)
1638 strokes-global-map)))
1639 (if (not chronological)
1640 ;; then alphabetize the strokes based on command names...
1641 (setq strokes-map (sort (copy-sequence strokes-map)
1642 'strokes-alphabetic-lessp)))
1643 (push-window-configuration)
1644 (set-buffer (get-buffer-create "*Strokes List*"))
1645 (setq buffer-read-only nil)
1650 (loop for def in strokes-map do
1651 (let ((stroke (car def))
1652 (command-name (symbol-name (cdr def))))
1653 (strokes-xpm-for-stroke stroke " *strokes-xpm*")
1657 (insert command-name)
1660 (make-annotation (make-glyph
1663 :data (buffer-substring
1664 (point-min " *strokes-xpm*")
1665 (point-max " *strokes-xpm*")
1667 [string :data "[Image]"]))
1669 finally do (kill-region (1+ (point)) (point-max)))
1670 (view-buffer "*Strokes List*" t)
1671 (goto-char (point-min))
1672 (define-key view-minor-mode-map [(q)] (lambda ()
1675 (pop-window-configuration)
1676 ;; (bury-buffer "*Strokes List*")
1677 (define-key view-minor-mode-map [(q)] 'view-quit))))
1679 (defun strokes-alphabetic-lessp (stroke1 stroke2)
1680 "T iff command name for STROKE1 is less than STROKE2's in lexicographic order."
1681 (let ((command-name-1 (symbol-name (cdr stroke1)))
1682 (command-name-2 (symbol-name (cdr stroke2))))
1683 (string-lessp command-name-1 command-name-2)))
1686 (defalias 'list-strokes 'strokes-list-strokes)
1689 (defun strokes-mode (&optional arg)
1690 "Toggle strokes being enabled.
1691 With ARG, turn strokes on if and only if ARG is positive or true.
1692 Note that `strokes-mode' is a global mode. Think of it as a minor
1693 mode in all buffers when activated.
1694 By default, strokes are invoked with mouse button-2. You can define
1697 > M-x global-set-stroke
1699 To use strokes for pictographic editing, such as Chinese/Japanese, use
1700 Sh-button-2, which draws strokes and inserts them. Encode/decode your
1703 > M-x strokes-encode-buffer
1704 > M-x strokes-decode-buffer"
1707 (> (prefix-numeric-value arg) 0)
1708 (not strokes-mode))))
1709 (cond ((not (device-on-window-system-p))
1710 (warn "Can't use strokes without windows"))
1711 (on-p ; turn on strokes
1713 (and (file-exists-p strokes-file)
1714 (null strokes-global-map)
1715 (strokes-load-user-strokes))
1716 (add-hook 'kill-emacs-query-functions
1717 'strokes-prompt-user-save-strokes)
1718 (add-hook 'select-frame-hook
1719 'strokes-update-window-configuration)
1720 (strokes-update-window-configuration)
1721 (define-key global-map [(button2)] 'strokes-do-stroke)
1722 (define-key global-map [(meta button2)] 'strokes-do-complex-stroke)
1723 ;; (define-key global-map [(control button2)] 'strokes-do-complex-stroke)
1724 (define-key global-map [(control button2)]
1725 'strokes-compose-complex-stroke)
1726 (ad-activate-regexp "^strokes-") ; advise button2 commands
1727 (setq strokes-mode t))
1728 (t ; turn off strokes
1729 (if (get-buffer strokes-buffer-name)
1730 (kill-buffer (get-buffer strokes-buffer-name)))
1731 (remove-hook 'select-frame-hook
1732 'strokes-update-window-configuration)
1733 (if (string-match "^strokes-" (symbol-name (key-binding [(button2)])))
1734 (define-key global-map [(button2)] strokes-click-command))
1735 (if (string-match "^strokes-" (symbol-name (key-binding [(meta button2)])))
1736 (global-unset-key [(meta button2)]))
1737 (if (string-match "^strokes-" (symbol-name (key-binding [(control button2)])))
1738 (global-unset-key [(control button2)]))
1739 ;; (if (string-match "^strokes-" (symbol-name (key-binding [(shift button2)])))
1740 ;; (global-unset-key [(shift button2)]))
1741 (ad-deactivate-regexp "^strokes-") ; unadvise strokes-button2 commands
1742 (setq strokes-mode nil))))
1745 (add-minor-mode 'strokes-mode strokes-modeline-string nil nil 'strokes-mode)
1747 ;;;; strokes-xpm stuff (later may be separate)...
1749 ;; This is the stuff that will eventuall be used for composing letters in
1750 ;; any language, compression, decompression, graphics, editing, etc.
1752 (require 'atomic-extents) ; might as well say
1753 ; (require 'not-so-atomic-extents)
1754 ; but what can you do?
1756 ;;(unless (find-face 'strokes-char-face)
1758 (defface strokes-char-face '((t (:background "lightgray")))
1759 "Face for strokes characters."
1762 (defconst strokes-char-table (make-char-table 'generic) ;
1763 "The table which stores values for the character keys.")
1764 (put-char-table ?0 0 strokes-char-table)
1765 (put-char-table ?1 1 strokes-char-table)
1766 (put-char-table ?2 2 strokes-char-table)
1767 (put-char-table ?3 3 strokes-char-table)
1768 (put-char-table ?4 4 strokes-char-table)
1769 (put-char-table ?5 5 strokes-char-table)
1770 (put-char-table ?6 6 strokes-char-table)
1771 (put-char-table ?7 7 strokes-char-table)
1772 (put-char-table ?8 8 strokes-char-table)
1773 (put-char-table ?9 9 strokes-char-table)
1774 (put-char-table ?a 10 strokes-char-table)
1775 (put-char-table ?b 11 strokes-char-table)
1776 (put-char-table ?c 12 strokes-char-table)
1777 (put-char-table ?d 13 strokes-char-table)
1778 (put-char-table ?e 14 strokes-char-table)
1779 (put-char-table ?f 15 strokes-char-table)
1780 (put-char-table ?g 16 strokes-char-table)
1781 (put-char-table ?h 17 strokes-char-table)
1782 (put-char-table ?i 18 strokes-char-table)
1783 (put-char-table ?j 19 strokes-char-table)
1784 (put-char-table ?k 20 strokes-char-table)
1785 (put-char-table ?l 21 strokes-char-table)
1786 (put-char-table ?m 22 strokes-char-table)
1787 (put-char-table ?n 23 strokes-char-table)
1788 (put-char-table ?o 24 strokes-char-table)
1789 (put-char-table ?p 25 strokes-char-table)
1790 (put-char-table ?q 26 strokes-char-table)
1791 (put-char-table ?r 27 strokes-char-table)
1792 (put-char-table ?s 28 strokes-char-table)
1793 (put-char-table ?t 29 strokes-char-table)
1794 (put-char-table ?u 30 strokes-char-table)
1795 (put-char-table ?v 31 strokes-char-table)
1796 (put-char-table ?w 32 strokes-char-table)
1797 (put-char-table ?x 33 strokes-char-table)
1798 (put-char-table ?y 34 strokes-char-table)
1799 (put-char-table ?z 35 strokes-char-table)
1800 (put-char-table ?A 36 strokes-char-table)
1801 (put-char-table ?B 37 strokes-char-table)
1802 (put-char-table ?C 38 strokes-char-table)
1803 (put-char-table ?D 39 strokes-char-table)
1804 (put-char-table ?E 40 strokes-char-table)
1805 (put-char-table ?F 41 strokes-char-table)
1806 (put-char-table ?G 42 strokes-char-table)
1807 (put-char-table ?H 43 strokes-char-table)
1808 (put-char-table ?I 44 strokes-char-table)
1809 (put-char-table ?J 45 strokes-char-table)
1810 (put-char-table ?K 46 strokes-char-table)
1811 (put-char-table ?L 47 strokes-char-table)
1812 (put-char-table ?M 48 strokes-char-table)
1813 (put-char-table ?N 49 strokes-char-table)
1814 (put-char-table ?O 50 strokes-char-table)
1815 (put-char-table ?P 51 strokes-char-table)
1816 (put-char-table ?Q 52 strokes-char-table)
1817 (put-char-table ?R 53 strokes-char-table)
1818 (put-char-table ?S 54 strokes-char-table)
1819 (put-char-table ?T 55 strokes-char-table)
1820 (put-char-table ?U 56 strokes-char-table)
1821 (put-char-table ?V 57 strokes-char-table)
1822 (put-char-table ?W 58 strokes-char-table)
1823 (put-char-table ?X 59 strokes-char-table)
1824 (put-char-table ?Y 60 strokes-char-table)
1825 (put-char-table ?Z 61 strokes-char-table)
1827 (defconst strokes-base64-chars
1828 ;; I can easily have made this a vector of single-character strings,
1829 ;; like (vector "0" "1" "2" ...), and then the program would run
1830 ;; faster since it wouldn't then have to call `char-to-string' when it
1831 ;; did the `concat'. I left them as chars here because I want
1832 ;; *them* to change `concat' so that it accepts chars and deals with
1833 ;; them properly. i.e. the form: (concat "abc" ?T "xyz") should
1834 ;; return "abcTxyz" NOT "abc84xyz" (XEmacs 19.*) and NOT an error
1836 ;; (vector "0" "1" "2" "3" "4" "5" "6" "7" "8" "9"
1837 ;; "a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l" "m" "n" "o"
1838 ;; "p" "q" "r" "s" "t" "u" "v" "w" "x" "y" "z" "A" "B" "C" "D"
1839 ;; "E" "F" "G" "H" "I" "J" "K" "L" "M" "N" "O" "P" "Q" "R" "S"
1840 ;; "T" "U" "V" "W" "X" "Y" "Z")
1841 (vector ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9
1842 ?a ?b ?c ?d ?e ?f ?g ?h ?i ?j ?k ?l ?m ?n ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x ?y ?z
1843 ?A ?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M ?N ?O ?P ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z)
1844 "Character vector for fast lookup of base-64 encoding of numbers in [0,61].")
1846 (defsubst strokes-xpm-char-on-p (char)
1847 "Non-nil if CHAR represents an `on' bit in the xpm."
1850 (defsubst strokes-xpm-char-bit-p (char)
1851 "Non-nil if CHAR represents an `on' or `off' bit in the xpm."
1852 (or (char= char ?\ )
1855 ;;(defsubst strokes-xor (a b) ### Should I make this an inline function? ###
1856 ;; "T iff one and only one of A and B is non-nil; otherwise, returns nil.
1857 ;;NOTE: Don't use this as a numeric xor since it treats all non-nil
1858 ;; values as t including `0' (zero)."
1859 ;; (eq (null a) (not (null b))))
1861 (defsubst strokes-xpm-encode-length-as-string (length)
1862 "Given some LENGTH in [0,62) do a fast lookup of it's encoding."
1863 (char-to-string (aref strokes-base64-chars length)))
1865 (defsubst strokes-xpm-decode-char (character)
1866 "Given a CHARACTER, do a fast lookup to find its corresponding integer value."
1867 (get-char-table character strokes-char-table))
1869 (defun strokes-xpm-to-compressed-string (&optional xpm-buffer)
1870 "Convert the xpm in XPM-BUFFER into a compressed string representing the stroke.
1871 XPM-BUFFER is an optional argument, and defaults to `*strokes-xpm*'."
1873 (set-buffer (setq xpm-buffer (or xpm-buffer "*strokes-xpm*")))
1874 (goto-char (point-min))
1875 (search-forward "/* pixels */") ; skip past header junk
1877 ;; a note for below:
1878 ;; the `current-char' is the char being counted -- NOT the char at (point)
1879 ;; which happens to be called `char-at-point'
1880 (let ((compressed-string "+/") ; initialize the output
1881 (count 0) ; keep a current count of
1883 (last-char-was-on-p t) ; last entered stream
1884 ; represented `on' bits
1885 (current-char-is-on-p nil) ; current stream represents `on' bits
1886 (char-at-point (char-after))) ; read the first char
1887 (while (not (char= char-at-point ?})) ; a `}' denotes the
1889 (cond ((zerop count) ; must restart counting
1890 ;; check to see if the `char-at-point' is an actual pixmap bit
1891 (when (strokes-xpm-char-bit-p char-at-point)
1893 current-char-is-on-p (strokes-xpm-char-on-p char-at-point)))
1895 ((= count 61) ; maximum single char's
1897 (setq compressed-string (concat compressed-string
1898 ;; add a zero-length
1901 (when (eq last-char-was-on-p
1902 current-char-is-on-p)
1904 (strokes-xpm-encode-length-as-string 0))
1905 (strokes-xpm-encode-length-as-string 61))
1906 last-char-was-on-p current-char-is-on-p
1907 count 0)) ; note that we just set
1908 ; count=0 and *don't* advance
1910 ((strokes-xpm-char-bit-p char-at-point) ; an actual xpm bit
1911 (if (eq current-char-is-on-p
1912 (strokes-xpm-char-on-p char-at-point))
1913 ;; yet another of the same bit-type, so we continue
1918 ;; otherwise, it's the opposite bit-type, so we do a
1919 ;; write and then restart count ### NOTE (for myself
1920 ;; to be aware of) ### I really should advance
1921 ;; (point) in this case instead of letting another
1922 ;; iteration go through and letting the case: count=0
1923 ;; take care of this stuff for me. That's why
1924 ;; there's no (forward-char 1) below.
1925 (setq compressed-string (concat compressed-string
1926 ;; add a zero-length
1929 (when (eq last-char-was-on-p
1930 current-char-is-on-p)
1932 (strokes-xpm-encode-length-as-string 0))
1933 (strokes-xpm-encode-length-as-string count))
1935 last-char-was-on-p current-char-is-on-p)))
1936 (t ; ELSE it's some other useless
1937 ; char, like `"' or `,'
1939 (setq char-at-point (char-after)))
1940 (concat compressed-string
1942 (concat (when (eq last-char-was-on-p
1943 current-char-is-on-p)
1945 (strokes-xpm-encode-length-as-string 0))
1946 (strokes-xpm-encode-length-as-string count)))
1950 (defun strokes-decode-buffer (&optional buffer force)
1951 "Decode stroke strings in BUFFER and display their corresponding glyphs.
1952 Optional BUFFER defaults to the current buffer.
1953 Optional FORCE non-nil will ignore the buffer's read-only status."
1955 ;; (interactive "*bStrokify buffer: ")
1957 (set-buffer (setq buffer (get-buffer (or buffer (current-buffer)))))
1958 (when (or (not buffer-read-only)
1961 (y-or-n-p-maybe-dialog-box
1962 (format "Buffer %s is read-only. Strokify anyway? " buffer)))
1963 (let ((inhibit-read-only t))
1964 (message "Strokifying %s..." buffer)
1965 (goto-char (point-min))
1967 ;; The comment below is what i'd have to do if I wanted to
1968 ;; deal with random newlines in the midst of the compressed
1969 ;; strings. If I do this, I'll also have to change
1970 ;; `strokes-xpm-to-compress-string' to deal with the newline,
1971 ;; and possibly other whitespace stuff. YUCK!
1972 ;; (while (re-search-forward "\\+/\\(\\w\\|\\)+/" nil t nil (get-buffer buffer))
1973 (while (re-search-forward "\\+/\\w+/" nil t nil buffer)
1974 (setq string (buffer-substring (+ 2 (match-beginning 0))
1975 (1- (match-end 0))))
1976 (strokes-xpm-for-compressed-string string " *strokes-xpm*")
1978 (setq ext (make-extent (1- (point)) (point)))
1979 (set-extent-property ext 'type 'stroke-glyph)
1980 (set-extent-property ext 'start-open t)
1981 (set-extent-property ext 'end-open t)
1982 (set-extent-property ext 'detachable t)
1983 (set-extent-property ext 'duplicable t)
1984 (set-extent-property ext 'data string)
1985 (set-extent-face ext 'default)
1986 (set-extent-end-glyph ext (make-glyph
1989 :data (buffer-substring
1990 (point-min " *strokes-xpm*")
1991 (point-max " *strokes-xpm*")
1993 [string :data "[Stroke]"])))))
1994 (message "Strokifying %s...done" buffer)))))
1996 (defun strokes-encode-buffer (&optional buffer force)
1997 "Convert the glyphs in BUFFER to their base-64 ASCII representations.
1998 Optional BUFFER defaults to the current buffer.
1999 Optional FORCE non-nil will ignore the buffer's read-only status."
2000 ;; ### NOTE !!! ### (for me)
2001 ;; For later on, you can/should make the inserted strings atomic
2002 ;; extents, so that the users have a clue that they shouldn't be
2003 ;; editing inside them. Plus, if you make them extents, you can
2004 ;; very easily just hide the glyphs, so if you unstrokify, and the
2005 ;; restrokify, then those that already are glyphed don't need to be
2006 ;; re-calculated, etc. It's just nicer that way. The only things
2007 ;; to worry about is cleanup (i.e. do the glyphs get gc'd when the
2008 ;; buffer is killed?
2009 ;; (interactive "*bUnstrokify buffer: ")
2012 (set-buffer (setq buffer (or buffer (current-buffer))))
2013 (when (or (not buffer-read-only)
2016 (y-or-n-p-maybe-dialog-box
2017 (format "Buffer %s is read-only. Encode anyway? " buffer)))
2018 (message "Encoding strokes in %s..." buffer)
2020 ;; (lambda (ext buf)
2021 ;; (when (eq (extent-property ext 'type) 'stroke-glyph)
2022 ;; (goto-char (extent-start-position ext))
2023 ;; (delete-char 1) ; ### What the hell do I do here? ###
2024 ;; (insert "+/" (extent-property ext 'data) "/")
2025 ;; (delete-extent ext))))))
2026 (let ((inhibit-read-only t)
2028 (loop repeat 2 do ; ### KLUDGE!!! This it pure crap! ###
2031 (when (eq (extent-property ext 'type) 'stroke-glyph)
2032 (setq start (goto-char (extent-start-position ext)))
2033 ;; (insert "+/" (extent-property ext 'data) "/")
2034 (insert-string "+/")
2035 (insert-string (extent-property ext 'data))
2038 (set-extent-endpoints ext start (point))
2039 (set-extent-property ext 'type 'stroke-string)
2040 (set-extent-property ext 'atomic t)
2041 ;; (set-extent-property ext 'read-only t)
2042 (set-extent-face ext 'strokes-char-face)
2043 (set-extent-property ext 'stroke-glyph (extent-end-glyph ext))
2044 (set-extent-end-glyph ext nil))))))
2045 (message "Encoding strokes in %s...done" buffer))))
2047 (defun strokes-xpm-for-compressed-string (compressed-string &optional bufname)
2048 "Convert the stroke represented by COMPRESSED-STRING into an xpm.
2049 Store xpm in buffer BUFNAME if supplied \(default is `*strokes-xpm*'\)"
2051 (or bufname (setq bufname "*strokes-xpm*"))
2052 (erase-buffer (set-buffer (get-buffer-create bufname)))
2053 (insert compressed-string)
2054 (goto-char (point-min))
2055 (let ((current-char-is-on-p nil))
2058 (if current-char-is-on-p
2061 (strokes-xpm-decode-char (char-after)))
2063 (setq current-char-is-on-p (not current-char-is-on-p)))
2064 (goto-char (point-min))
2069 (goto-char (point-min))
2070 (insert strokes-xpm-header))))
2073 (defun strokes-compose-complex-stroke ()
2075 ;; Even though we have lexical scoping, it's somewhat ugly how I
2076 ;; pass around variables in the global name space. I can/should
2078 "Read a complex stroke and insert its glyph into the current buffer."
2080 (let ((strokes-grid-resolution 33))
2081 (strokes-read-complex-stroke)
2082 (strokes-xpm-for-stroke nil " *strokes-xpm*" t)
2083 (insert (strokes-xpm-to-compressed-string " *strokes-xpm*"))
2084 (strokes-decode-buffer)))
2087 (run-hooks 'strokes-load-hook)
2089 ;;; strokes.el ends here