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