Fix instructions for MSDOG.
[bpt/emacs.git] / lisp / strokes.el
CommitLineData
aea01cd7
RS
1;;; strokes.el -- Control Emacs through mouse strokes --
2
3;; Copyright (C) 1997 Free Software Foundation, Inc.
4
5;; Author: David Bakhash <cadet@mit.edu>
6;; Maintainer: David Bakhash <cadet@mit.edu>
7;; Created: 12 April 1997
8;; Keywords: lisp, mouse, extensions
9
10;; This file is part of GNU Emacs.
11
12;; GNU Emacs is free software; you can redistribute it and/or modify
13;; it under the terms of the GNU General Public License as published by
14;; the Free Software Foundation; either version 2, or (at your option)
15;; any later version.
16
17;; GNU Emacs is distributed in the hope that it will be useful,
18;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20;; GNU General Public License for more details.
21
22;; You should have received a copy of the GNU General Public License
23;; along with GNU Emacs; see the file COPYING. If not, write to the
24;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25;; Boston, MA 02111-1307, USA.
26
27;;; Commentary:
28
29;; This is the strokes package. It is intended to allow the user to
30;; control Emacs by means of mouse strokes. Once strokes is loaded, you
31;; can always get help be invoking `strokes-help':
32
33;; > M-x strokes-help
34
35;; and you can learn how to use the package. A mouse stroke, for now,
36;; can be defined as holding the middle button, for instance, and then
37;; moving the mouse in whatever pattern you wish, which you have set
38;; Emacs to understand as mapping to a given command. For example, you
39;; may wish the have a mouse stroke that looks like a capital `C' which
40;; means `copy-region-as-kill'. Treat strokes just like you do key
41;; bindings. For example, Emacs sets key bindings globally with the
42;; `global-set-key' command. Likewise, you can do
43
44;; > M-x global-set-stroke
45
46;; to interactively program in a stroke. It would be wise to set the
47;; first one to this very command, so that from then on, you invoke
48;; `global-set-stroke' with a stroke. likewise, there may eventually
49;; be a `local-set-stroke' command, also analogous to `local-set-key'.
50
51;; You can always unset the last stroke definition with the command
52
53;; > M-x strokes-unset-last-stroke
54
55;; and the last stroke that was added to `strokes-global-map' will be
56;; removed.
57
58;; Other analogies between strokes and key bindings are as follows:
59
60;; 1) To describe a stroke binding, you can type
61
62;; > M-x describe-stroke
63
64;; analogous to `describe-key'. It's also wise to have a stroke,
65;; like an `h', for help, or a `?', mapped to `describe-stroke'.
66
67;; 2) stroke bindings are set internally through the Lisp function
68;; `define-stroke', similar to the `define-key' function. some
69;; examples for a 3x3 stroke grid would be
70
71;; (define-stroke c-mode-stroke-map
72;; '((0 . 0) (1 . 1) (2 . 2))
73;; 'kill-region)
74;; (define-stroke strokes-global-map
75;; '((0 . 0) (0 . 1) (0 . 2) (1 . 2) (2 . 2))
76;; 'list-buffers)
77
78;; however, if you would probably just have the user enter in the
79;; stroke interactively and then set the stroke to whatever he/she
80;; entered. The Lisp function to interactively read a stroke is
81;; `strokes-read-stroke'. This is especially helpful when you're
82;; on a fast computer that can handle a 9x9 stroke grid.
83
84;; NOTE: only global stroke bindings are currently implemented,
85;; however mode- and buffer-local stroke bindings may eventually
86;; be implemented in a future version.
87
88;; The important variables to be aware of for this package are listed
89;; below. They can all be altered through the customizing package via
90
91;; > M-x customize
92
93;; and customizing the group named `strokes'. You can also read
94;; documentation on the variables there.
95
96;; `strokes-minimum-match-score' (determines the threshold of error that
97;; makes a stroke acceptable or unacceptable. If your strokes arn't
98;; matching, then you should raise this variable.
99
100;; `strokes-grid-resolution' (determines the grid dimensions that you use
101;; when defining/reading strokes. The finer the grid your computer can
102;; handle, the more you can do, but even a 3x3 grid is pretty cool.)
103;; The default value (7) should be fine for most decent computers.
104;; NOTE: This variable should not be set to a number less than 3.
105
106;; `strokes-display-strokes-buffer' will allow you to hide the strokes
107;; buffer when doing simple strokes. This is a speedup for slow
108;; computers as well as people who don't want to see their strokes.
109
110;; If you find that your mouse is accelerating too fast, you can
111;; execute the UNIX X command to slow it down. A good possibility is
112
113;; % xset m 5/4 8
114
115;; which seems, heuristically, to work okay, without much disruption.
116
117;; Whenever you load in the strokes package, you will be able to save
118;; what you've done upon exiting Emacs. You can also do
119
120;; > M-x save-strokes
121
122;; and it will save your strokes in ~/.strokes, or you may wish to change
123;; this by setting the variable `strokes-file'.
124
125;; Note that internally, all of the routines that are part of this
126;; package are able to deal with complex strokes, as they are a superset
127;; of simple strokes. However, the default of this package will map
128;; mouse button2 to the command `strokes-do-stroke', and NOT
129;; `strokes-do-complex-stroke'. If you wish to use complex strokes, you
130;; will have to override this key mapping. Complex strokes are terminated
131;; with mouse button3. The strokes package will not interfere with
132;; `mouse-yank', but you may want to examine how this is done (see the
133;; variable `strokes-click-command')
134
135;; To get strokes to work as part of your your setup, then you'll have
136;; put the strokes package in your load-path (preferably byte-compiled)
137;; and then add the following to your .emacs file (or wherever
138;; you put Emacs-specific startup preferences):
139
140;;(and (fboundp 'device-on-window-system-p)
141;; (device-on-window-system-p)
142;; (require 'strokes))
143
144;; Once loaded, you can start stroking. You can also toggle between
145;; strokes mode by simple typing
146
147;; > M-x strokes-mode
148
149;; I am now in the process of porting this package to Emacs. I also hope
150;; that, with the help of others, this package will be useful in entering
151;; in pictographic-like language text using the mouse (i.e. Korean).
152;; Japanese and Chinese are a bit trickier, but I'm sure that with help
153;; it can be done. The next version will allow the user to enter strokes
154;; which "remove the pencil from the paper" so to speak, so one character
155;; can have multiple strokes.
156
157;; You can read more about strokes at:
158
159;; http://www.mit.edu/people/cadet/strokes-help.html
160
161;; If you're interested in using strokes for writing English into Emacs
162;; using strokes, then you'll want to read about it on the web page above
163;; or just download from http://www.mit.edu/people/cadet/strokes-abc.el,
164;; which is nothing but a file with some helper commands for inserting
165;; alphanumerics and punctuation.
166
167;; Great thanks to Rob Ristroph for his generosity in letting me use his
168;; PC to develop this, Jason Johnson for his help in algorithms, Euna
169;; Kim for her help in Korean, and massive thanks to the helpful guys
170;; on the help instance on athena (zeno, jered, amu, gsstark, ghudson, etc)
171;; Special thanks to Steve Baur and Hrvoje Niksic for all their help.
172;; And even more thanks to Dave Gillespie for all the elisp help--he
173;; is responsible for helping me use the cl macros at (near) max speed.
174
175;; Tasks: (what I'm getting ready for future version)...
176;; 2) use 'strokes-read-complex-stroke for korean, etc.
177;; 4) buffer-local 'strokes-local-map, and mode-stroke-maps would be nice
178;; 5) 'list-strokes (kinda important). What do people want?
179;; How about an optional docstring for each stroke so that a person
180;; can examine the strokes-file and actually make sense of it?
181;; (e.g. "This stroke is a pentagram")
182;; 6) add some hooks, like `strokes-read-stroke-hook'
183;; 7) See what people think of the factory settings. Should I change
184;; them? They're all pretty arbitrary in a way. I guess they
185;; should be minimal, but computers are getting lots faster, and
186;; if I choose the defaults too conservatively, then strokes will
187;; surely dissapoint some people on decent machines (until they
188;; figure out M-x customize). I need feedback.
189;; Other: I always have the most beta version of strokes, so if you
190;; want it just let me know.
191
192;;; Code:
193
194;;; Requirements and provisions...
195
196(autoload 'reporter-submit-bug-report "reporter")
197(autoload 'mail-position-on-field "sendmail")
198(eval-when-compile
199 (mapcar 'require '(pp reporter advice)))
200
201(require 'levents)
202
203;;; Constants...
204
205(defconst strokes-version "0.0-beta")
206
207(defconst strokes-bug-address "cadet@mit.edu")
208
209(defconst strokes-lift 'strokes-lift
210 "Symbol representing a stroke lift event for complex strokes.
211Complex strokes are those which contain two or more simple strokes.
212This will be useful for when Emacs understands Chinese.")
213
214;;; user variables...
215
216(defgroup strokes nil
217 "Control Emacs through mouse strokes"
218 :group 'mouse)
219
220(defcustom strokes-modeline-string " Strokes"
221 "*Modeline identification when strokes are on \(default is \" Strokes\"\)."
222 :type 'string
223 :group 'strokes)
224
225(defcustom strokes-character ?@
226 "*Character used when drawing strokes in the strokes buffer.
227\(The default is lower-case `o', which works okay\)."
228 :type 'character
229 :group 'strokes)
230
231(defcustom strokes-minimum-match-score 1000
232 "*Minimum score for a stroke to be considered a possible match.
233Requiring a perfect match would set this variable to 0.
234The default value is 1000, but it's mostly dependent on how precisely
235you manage to replicate your user-defined strokes. It also depends on
236the value of `strokes-grid-resolution', since a higher grid resolution
237will correspond to more sample points, and thus more distance
238measurements. Usually, this is not a problem since you first set
239`strokes-grid-resolution' based on what your computer seems to be able
240to handle (though the defaults are usually more than sufficent), and
241then you can set `strokes-minimum-match-score' to something that works
242for you. The only purpose of this variable is to insure that if you
243do a bogus stroke that really doesn't match any of the predefined
244ones, then strokes should NOT pick the one that came closest."
245 :type 'integer
246 :group 'strokes)
247
248(defcustom strokes-grid-resolution 9
249 "*Integer defining dimensions of the stroke grid.
250The grid is a square grid, where STROKES-GRID-RESOLUTION defaults to
251`9', making a 9x9 grid whose coordinates go from (0 . 0) on the top
252left to ((STROKES-GRID-RESOLUTION - 1) . (STROKES-GRID-RESOLUTION - 1))
253on the bottom right. The greater the resolution, the more intricate
254your strokes can be.
255NOTE: This variable should be odd and MUST NOT be less than 3 and need
256 not be greater than 33, which is the resolution of the pixmaps.
257WARNING: Changing the value of this variable will gravely affect the
258 strokes you have already programmed in. You should try to
259 figure out what it should be based on your needs and on how
260 quick the particular platform(s) you're operating on, and
261 only then start programming in your custom strokes."
262 :type 'integer
263 :group 'strokes)
264
265(defcustom strokes-file "~/.strokes"
266 "*File containing saved strokes for stroke-mode (default is ~/.strokes)."
267 :type 'file
268 :group 'strokes)
269
270(defcustom strokes-buffer-name " *strokes*"
271 "The buffer that the strokes take place in (default is ` *strokes*')."
272 :type 'string
273 :group 'strokes)
274
275(defcustom strokes-use-strokes-buffer t
276 "*If non-nil, the strokes buffer is used and strokes are displayed.
277If nil, strokes will be read the same, however the user will not be
278able to see the strokes. This be helpful for people who don't like
279the delay in switching to the strokes buffer."
280 :type 'boolean
281 :group 'strokes)
282
283(defcustom strokes-click-command 'mouse-yank-at-click
284 "*Command to execute when stroke is actually a `click' event.
285This is set to `mouse-yank' by default."
286 :type 'function
287 :group 'strokes)
288
289;;; internal variables...
290
291;;;###autoload
292(defvar strokes-mode nil
293 "Non-nil when `strokes' is globally enabled")
294
295(defvar strokes-window-configuration nil
296 "The special window configuration used when entering strokes.
297This is set properly in the function `strokes-update-window-configuration'.")
298
299(defvar strokes-last-stroke nil
300 "Last stroke entered by the user.
301Its value gets set every time the function
302`strokes-fill-stroke' gets called,
303since that is the best time to set the variable")
304
305(defvar strokes-global-map '()
306 "Association list of strokes and their definitions.
307Each entry is (STROKE . COMMAND) where STROKE is itself a list of
308coordinates (X . Y) where X and Y are lists of positions on the
309normalized stroke grid, with the top left at (0 . 0). COMMAND is the
310corresponding interactive function")
311
312(defvar strokes-load-hook nil
313 "Function or functions to be called when `strokes' is loaded.")
314
315;;; Macros...
316
317(defsubst strokes-click-p (stroke)
318 "Non-nil if STROKE is really click."
319 (< (length stroke) 3))
320
321;;; old, but worked pretty good (just in case)...
322;;(defmacro strokes-define-stroke (stroke-map stroke def)
323;; "Add STROKE to STROKE-MAP alist with given command DEF"
324;; (list 'if (list '< (list 'length stroke) 3)
325;; (list 'error
326;; "That's a click, not a stroke. See `strokes-click-command'")
327;; (list 'setq stroke-map (list 'cons (list 'cons stroke def)
328;; (list 'remassoc stroke stroke-map)))))
329
330(defsubst strokes-remassoc (key list)
331 (remove-if
332 (lambda (element)
333 (equal key (car element)))
334 list))
335
336(defmacro strokes-define-stroke (stroke-map stroke def)
337 "Add STROKE to STROKE-MAP alist with given command DEF."
338 `(if (strokes-click-p ,stroke)
339 (error "That's a click, not a stroke; see `strokes-click-command'")
340 (setq ,stroke-map (cons (cons ,stroke ,def)
341 (strokes-remassoc ,stroke ,stroke-map)))))
342
343(defalias 'define-stroke 'strokes-define-stroke)
344
345(defsubst strokes-square (x)
346 "Returns the square of the number X"
347 (* x x))
348
349(defsubst strokes-distance-squared (p1 p2)
350 "Gets the distance (squared) between to points P1 and P2.
351P1 and P2 are cons cells in the form (X . Y)."
352 (let ((x1 (car p1))
353 (y1 (cdr p1))
354 (x2 (car p2))
355 (y2 (cdr p2)))
356 (+ (strokes-square (- x2 x1))
357 (strokes-square (- y2 y1)))))
358
359;;; Advice for various functions...
360
361;; I'd originally wanted to write a macro that would just take in the
362;; generic functions which use mouse button2 in various modes. Most of
363;; them are identical in form: they take an event as the single argument
364;; and then do their thing. I tried writing a macro that looked
365;; something like this, but failed. Advice just ain't that easy. The
366;; one that bugged me the most was `Manual-follow-xref', because that had
367;; &rest arguments, and I didn't know how to work around it in defadvice.
368;; However, I was able to fix up most of the important modes (i.e. the
369;; ones I use all the time). One `bug' in the program that I just can't
370;; seem to figure out is why I can only advise other button2 functions
371;; successfully when the variable `strokes-use-strokes-buffer' is nil. I
372;; did all the save-excursion/save-window-excursion stuff SPECIFICALLY so
373;; that using the strokes buffer or not would absolutely not affect any
374;; other part of the program. If someone can figure out how to make the
375;; following advices work w/ regardless of that variable
376;; `strokes-use-strokes-buffer', then that would be a great victory. If
377;; someone out there would be kind enough to make the commented code
378;; below work, I'd be grateful. By the way, I put the `protect' keywords
379;; there to insure that if a stroke went bad, then
380;; `strokes-click-command' would be set back. If this isn't necessary,
381;; then feel free to let me know.
382
383;; For what follows, I really wanted something that would work like this:
384
385;;(strokes-fix-button2 'vm-mouse-button-2)
386
387;; Or even better, I could have simply done something like:
388
389;;(mapcar 'strokes-fix-button2
390;; '(vm-mouse-button-2
391;; rmail-summary-mouse-goto-msg
392;; <rest of them>))
393
394;;; With help from Hans (author of advice.el)...
395(defmacro strokes-fix-button2-command (command)
396 "Fix COMMAND so that it can also work with strokes.
397COMMAND must take one event argument.
398Example of how one might fix up a command that's bound to button2
399and which is an interactive funcion of one event argument:
400
401\(strokes-fix-button2-command 'rmail-summary-mouse-goto-msg)"
402 (let ((command (eval command)))
403 `(progn
404 (defadvice ,command (around strokes-fix-button2 compile preactivate)
405 ,(format "Fix %s to work with strokes." command)
406 (if strokes-use-strokes-buffer
407 ;; then strokes is no good and we'll have to use the original
408 ad-do-it
409 ;; otherwise, we can make strokes work too...
410 (let ((strokes-click-command
411 ',(intern (format "ad-Orig-%s" command))))
412 (strokes-do-stroke (ad-get-arg 0))))))))
413
414(strokes-fix-button2-command 'vm-mouse-button-2)
415(strokes-fix-button2-command 'rmail-summary-mouse-goto-msg)
416(strokes-fix-button2-command 'Buffer-menu-mouse-select)
417(strokes-fix-button2-command 'w3-widget-button-click)
418(strokes-fix-button2-command 'widget-image-button-press)
419(strokes-fix-button2-command 'Info-follow-clicked-node)
420(strokes-fix-button2-command 'compile-mouse-goto-error)
421(strokes-fix-button2-command 'gdbsrc-select-or-yank)
422(strokes-fix-button2-command 'hypropos-mouse-get-doc)
423(strokes-fix-button2-command 'gnus-mouse-pick-group)
424(strokes-fix-button2-command 'gnus-mouse-pick-article)
425(strokes-fix-button2-command 'gnus-article-push-button)
426(strokes-fix-button2-command 'dired-mouse-find-file)
427(strokes-fix-button2-command 'url-dired-find-file-mouse)
428(strokes-fix-button2-command 'dired-u-r-mouse-toggle)
429(strokes-fix-button2-command 'dired-u-w-mouse-toggle)
430(strokes-fix-button2-command 'dired-u-x-mouse-toggle)
431(strokes-fix-button2-command 'dired-g-r-mouse-toggle)
432(strokes-fix-button2-command 'dired-g-w-mouse-toggle)
433(strokes-fix-button2-command 'dired-g-x-mouse-toggle)
434(strokes-fix-button2-command 'dired-o-r-mouse-toggle)
435(strokes-fix-button2-command 'dired-o-w-mouse-toggle)
436(strokes-fix-button2-command 'isearch-yank-x-selection)
437(strokes-fix-button2-command 'occur-mode-mouse-goto)
438(strokes-fix-button2-command 'cvs-mouse-find-file)
439
440;;; I can fix the customize widget button click, but then
441;;; people will get confused when they try to customize
442;;; strokes with the mouse and customize tells them that
443;;; `strokes-click-command' is mapped to `ad-Orig-widget-button-click'
444;;(strokes-fix-button2-command 'widget-button-click)
445
446;;; without the advice, each advised function would look like...
447;;(defadvice vm-mouse-button-2 (around vm-strokes activate protect)
448;; "Allow strokes to work in VM."
449;; (if strokes-use-strokes-buffer
450;; ;; then strokes is no good and we'll have to use the original
451;; ad-do-it
452;; ;; otherwise, we can make strokes work too...
453;; (let ((strokes-click-command 'ad-Orig-vm-mouse-button-2))
454;; (strokes-do-stroke (ad-get-arg 0)))))
455
456;;; Functions...
457
458(defsubst strokes-mouse-event-p (event)
459 (or (motion-event-p event)
460 (button-press-event-p event)
461 (button-release-event-p event)))
462
463(defun strokes-event-closest-point-1 (window &optional line)
464 "Return position of start of line LINE in WINDOW.
465If LINE is nil, return the last position visible in WINDOW."
466 (let* ((total (- (window-height window)
467 (if (window-minibuffer-p window)
468 0 1)))
469 (distance (or line total)))
470 (save-excursion
471 (goto-char (window-start window))
472 (if (= (vertical-motion distance) distance)
473 (if (not line)
474 (forward-char -1)))
475 (point))))
476
477(defun strokes-event-closest-point (event &optional start-window)
478 "Return the nearest position to where EVENT ended its motion.
479This is computed for the window where EVENT's motion started,
480or for window WINDOW if that is specified."
481 (or start-window (setq start-window (posn-window (event-start event))))
482 (if (eq start-window (posn-window (event-end event)))
483 (if (eq (event-point event) 'vertical-line)
484 (strokes-event-closest-point-1 start-window
485 (cdr (posn-col-row (event-end event))))
486 (if (eq (event-point event) 'mode-line)
487 (strokes-event-closest-point-1 start-window)
488 (event-point event)))
489 ;; EVENT ended in some other window.
490 (let* ((end-w (posn-window (event-end event)))
491 (end-w-top)
492 (w-top (nth 1 (window-edges start-window))))
493 (setq end-w-top
494 (if (windowp end-w)
495 (nth 1 (window-edges end-w))
496 (/ (cdr (posn-x-y (event-end event)))
497 ((frame-char-height end-w)))))
498 (if (>= end-w-top w-top)
499 (strokes-event-closest-point-1 start-window)
500 (window-start start-window)))))
501
502(defun strokes-lift-p (object)
503 "Return non-nil if object is a stroke-lift."
504 (eq object strokes-lift))
505
506(defun strokes-unset-last-stroke ()
507 "Undo the last stroke definition."
508 (interactive)
509 (let ((command (cdar strokes-global-map)))
510 (if (y-or-n-p-maybe-dialog-box
511 (format "really delete last stroke definition, defined to `%s'? "
512 command))
513 (progn
514 (setq strokes-global-map (cdr strokes-global-map))
515 (message "That stroke has been deleted"))
516 (message "Nothing done"))))
517
518;;;###autoload
519(defun strokes-global-set-stroke (stroke command)
520 "Interactively give STROKE the global binding as COMMAND.
521Operated just like `global-set-key', except for strokes.
522COMMAND is a symbol naming an interactively-callable function. STROKE
523is a list of sampled positions on the stroke grid as described in the
524documentation for the `strokes-define-stroke' function."
525 (interactive
526 (list
527 (and (or strokes-mode (strokes-mode t))
528 (strokes-read-complex-stroke
529 "Define a new stroke. Draw with button1 (or 2). End with button3..."))
530 (read-command "command to map stroke to: ")))
531 (strokes-define-stroke strokes-global-map stroke command))
532
533;;;###autoload
534(defalias 'global-set-stroke 'strokes-global-set-stroke)
535
536;;(defun global-unset-stroke (stroke); FINISH THIS DEFUN!
537;; "delete all strokes matching STROKE from `strokes-global-map',
538;; letting the user input
539;; the stroke with the mouse"
540;; (interactive
541;; (list
542;; (strokes-read-stroke "Enter the stroke you want to delete...")))
543;; (strokes-define-stroke 'strokes-global-map stroke command))
544
545(defun strokes-get-grid-position (stroke-extent position &optional grid-resolution)
546 "Map POSITION to a new grid position based on its STROKE-EXTENT and GRID-RESOLUTION.
547STROKE-EXTENT as a list \(\(XMIN . YMIN\) \(XMAX . YMAX\)\).
548If POSITION is a `strokes-lift', then it is itself returned.
549Optional GRID-RESOLUTION may be used in place of STROKES-GRID-RESOLUTION.
550The grid is a square whose dimesion is [0,GRID-RESOLUTION)."
551 (cond ((consp position) ; actual pixel location
552 (let ((grid-resolution (or grid-resolution strokes-grid-resolution))
553 (x (car position))
554 (y (cdr position))
555 (xmin (caar stroke-extent))
556 (ymin (cdar stroke-extent))
557 ;; the `1+' is there to insure that the
558 ;; formula evaluates correctly at the boundaries
559 (xmax (1+ (caadr stroke-extent)))
560 (ymax (1+ (cdadr stroke-extent))))
561 (cons (floor (* grid-resolution
562 (/ (float (- x xmin))
563 (- xmax xmin))))
564 (floor (* grid-resolution
565 (/ (float (- y ymin))
566 (- ymax ymin)))))))
567 ((strokes-lift-p position) ; stroke lift
568 strokes-lift)))
569
570;;(defun strokes-get-grid-position (stroke-extent pix-pos)
571;; "Return the stroke-grid position for PIX-POS given the total STROKE-EXTENT.
572;;STROKE-EXTENT as a list \(\(xmin . ymin\) \(xmax . ymax\)\) and a particular
573;;pixel position or `strokes-lift', find the corresponding grid position
574;;\(based on `strokes-grid-resolution'\) for the PIX-POS."
575;; (cond ((consp pix-pos) ; actual pixel location
576;; (let ((x (car pix-pos))
577;; (y (cdr pix-pos))
578;; (xmin (caar stroke-extent))
579;; (ymin (cdar stroke-extent))
580;; ;; the `1+' is there to insure that the
581;; ;; formula evaluates correctly at the boundaries
582;; (xmax (1+ (caadr stroke-extent)))
583;; (ymax (1+ (cdadr stroke-extent))))
584;; (cons (floor (* strokes-grid-resolution
585;; (/ (float (- x xmin))
586;; (- xmax xmin))))
587;; (floor (* strokes-grid-resolution
588;; (/ (float (- y ymin))
589;; (- ymax ymin)))))))
590;; ((strokes-lift-p pix-pos) ; stroke lift
591;; strokes-lift)))
592
593(defun strokes-get-stroke-extent (pixel-positions)
594 "From a list of absolute PIXEL-POSITIONS, returns absolute spatial extent.
595The return value is a list ((XMIN . YMIN) (XMAX . YMAX))."
596 (if pixel-positions
597 (let ((xmin (caar pixel-positions))
598 (xmax (caar pixel-positions))
599 (ymin (cdar pixel-positions))
600 (ymax (cdar pixel-positions))
601 (rest (cdr pixel-positions)))
602 (while rest
603 (if (consp (car rest))
604 (let ((x (caar rest))
605 (y (cdar rest)))
606 (if (< x xmin)
607 (setq xmin x))
608 (if (> x xmax)
609 (setq xmax x))
610 (if (< y ymin)
611 (setq ymin y))
612 (if (> y ymax)
613 (setq ymax y))))
614 (setq rest (cdr rest)))
615 (let ((delta-x (- xmax xmin))
616 (delta-y (- ymax ymin)))
617 (if (> delta-x delta-y)
618 (setq ymin (- ymin
619 (/ (- delta-x delta-y)
620 2))
621 ymax (+ ymax
622 (/ (- delta-x delta-y)
623 2)))
624 (setq xmin (- xmin
625 (/ (- delta-y delta-x)
626 2))
627 xmax (+ xmax
628 (/ (- delta-y delta-x)
629 2))))
630 (list (cons xmin ymin)
631 (cons xmax ymax))))
632 nil))
633
634(defun strokes-eliminate-consecutive-redundancies (entries)
635 "Returns a list with no consecutive redundant entries."
636 ;; defun a grande vitesse grace a Dave G.
637 (loop for element on entries
638 if (not (equal (car element) (cadr element)))
639 collect (car element)))
640;; (loop for element on entries
641;; nconc (if (not (equal (car el) (cadr el)))
642;; (list (car el)))))
643;; yet another (orig) way of doing it...
644;; (if entries
645;; (let* ((current (car entries))
646;; (rest (cdr entries))
647;; (non-redundant-list (list current))
648;; (next nil))
649;; (while rest
650;; (setq next (car rest))
651;; (if (equal current next)
652;; (setq rest (cdr rest))
653;; (setq non-redundant-list (cons next non-redundant-list)
654;; current next
655;; rest (cdr rest))))
656;; (nreverse non-redundant-list))
657;; nil))
658
659(defun strokes-renormalize-to-grid (positions &optional grid-resolution)
660 "Map POSITIONS to a new grid whose dimensions are based on GRID-RESOLUTION.
661POSITIONS is a list of positions and stroke-lifts.
662Optional GRID-RESOLUTION may be used in place of STROKES-GRID-RESOLUTION.
663The grid is a square whose dimesion is [0,GRID-RESOLUTION)."
664 (or grid-resolution (setq grid-resolution strokes-grid-resolution))
665 (let ((stroke-extent (strokes-get-stroke-extent positions)))
666 (mapcar (function
667 (lambda (pos)
668 (strokes-get-grid-position stroke-extent pos grid-resolution)))
669 positions)))
670
671;;(defun strokes-normalize-pixels-to-grid (pixel-positions)
672;; "Map PIXEL-POSITIONS to the stroke grid.
673;;PIXEL-POSITIONS is a list of pixel-positions and stroke-lifts. The
674;;normalized stroke grid is defined by the variable STROKES-GRID-RESOLUTION"
675;; (let ((stroke-extent (strokes-get-stroke-extent pixel-positions)))
676;; (mapcar (function
677;; (lambda (pix-pos)
678;; (strokes-get-grid-position stroke-extent pix-pos)))
679;; pixel-positions)))
680
681(defun strokes-fill-stroke (unfilled-stroke &optional force)
682 "Fill in missing grid locations in the list of UNFILLED-STROKE.
683If FORCE is non-nil, then fill the stroke even if it's `stroke-click'.
684NOTE: This is where the global variable `strokes-last-stroke' is set."
685 (setq strokes-last-stroke ; this is global
686 (if (and (strokes-click-p unfilled-stroke)
687 (not force))
688 unfilled-stroke
689 (loop for grid-locs on unfilled-stroke
690 nconc (let* ((current (car grid-locs))
691 (current-is-a-point-p (consp current))
692 (next (cadr grid-locs))
693 (next-is-a-point-p (consp next))
694 (both-are-points-p (and current-is-a-point-p
695 next-is-a-point-p))
696 (x1 (and current-is-a-point-p
697 (car current)))
698 (y1 (and current-is-a-point-p
699 (cdr current)))
700 (x2 (and next-is-a-point-p
701 (car next)))
702 (y2 (and next-is-a-point-p
703 (cdr next)))
704 (delta-x (and both-are-points-p
705 (- x2 x1)))
706 (delta-y (and both-are-points-p
707 (- y2 y1)))
708 (slope (and both-are-points-p
709 (if (zerop delta-x)
710 nil ; undefined vertical slope
711 (/ (float delta-y)
712 delta-x)))))
713 (cond ((not both-are-points-p)
714 (list current))
715 ((null slope) ; undefinded vertical slope
716 (if (>= delta-y 0)
717 (loop for y from y1 below y2
718 collect (cons x1 y))
719 (loop for y from y1 above y2
720 collect (cons x1 y))))
721 ((zerop slope) ; (= y1 y2)
722 (if (>= delta-x 0)
723 (loop for x from x1 below x2
724 collect (cons x y1))
725 (loop for x from x1 above x2
726 collect (cons x y1))))
727 ((>= (abs delta-x) (abs delta-y))
728 (if (> delta-x 0)
729 (loop for x from x1 below x2
730 collect (cons x
731 (+ y1
732 (round (* slope
733 (- x x1))))))
734 (loop for x from x1 above x2
735 collect (cons x
736 (+ y1
737 (round (* slope
738 (- x x1))))))))
739 (t ; (< (abs delta-x) (abs delta-y))
740 (if (> delta-y 0)
741 (loop for y from y1 below y2
742 collect (cons (+ x1
743 (round (/ (- y y1)
744 slope)))
745 y))
746 (loop for y from y1 above y2
747 collect (cons (+ x1
748 (round (/ (- y y1)
749 slope)))
750 y))))))))))
751
752(defun strokes-rate-stroke (stroke1 stroke2)
753 "Rates STROKE1 with STROKE2 and returns a score based on a distance metric.
754Note: the rating is an error rating, and therefore, a return of 0
755represents a perfect match. Also note that the order of stroke
756arguments is order-independent for the algorithm used here."
757 (if (and stroke1 stroke2)
758 (let ((rest1 (cdr stroke1))
759 (rest2 (cdr stroke2))
760 (err (strokes-distance-squared (car stroke1)
761 (car stroke2))))
762 (while (and rest1 rest2)
763 (while (and (consp (car rest1))
764 (consp (car rest2)))
765 (setq err (+ err
766 (strokes-distance-squared (car rest1)
767 (car rest2)))
768 stroke1 rest1
769 stroke2 rest2
770 rest1 (cdr stroke1)
771 rest2 (cdr stroke2)))
772 (cond ((and (strokes-lift-p (car rest1))
773 (strokes-lift-p (car rest2)))
774 (setq rest1 (cdr rest1)
775 rest2 (cdr rest2)))
776 ((strokes-lift-p (car rest2))
777 (while (consp (car rest1))
778 (setq err (+ err
779 (strokes-distance-squared (car rest1)
780 (car stroke2)))
781 rest1 (cdr rest1))))
782 ((strokes-lift-p (car rest1))
783 (while (consp (car rest2))
784 (setq err (+ err
785 (strokes-distance-squared (car stroke1)
786 (car rest2)))
787 rest2 (cdr rest2))))))
788 (if (null rest2)
789 (while (consp (car rest1))
790 (setq err (+ err
791 (strokes-distance-squared (car rest1)
792 (car stroke2)))
793 rest1 (cdr rest1))))
794 (if (null rest1)
795 (while (consp (car rest2))
796 (setq err (+ err
797 (strokes-distance-squared (car stroke1)
798 (car rest2)))
799 rest2 (cdr rest2))))
800 (if (or (strokes-lift-p (car rest1))
801 (strokes-lift-p (car rest2)))
802 (setq err nil)
803 err))
804 nil))
805
806(defun strokes-match-stroke (stroke stroke-map)
807 "Finds the best matching command of STROKE in STROKE-MAP.
808Returns the corresponding match as (COMMAND . SCORE)."
809 (if (and stroke stroke-map)
810 (let ((score (strokes-rate-stroke stroke (caar stroke-map)))
811 (command (cdar stroke-map))
812 (map (cdr stroke-map)))
813 (while map
814 (let ((newscore (strokes-rate-stroke stroke (caar map))))
815 (if (or (and newscore score (< newscore score))
816 (and newscore (null score)))
817 (setq score newscore
818 command (cdar map)))
819 (setq map (cdr map))))
820 (if score
821 (cons command score)
822 nil))
823 nil))
824
825;;;###autoload
826(defun strokes-read-stroke (&optional prompt event)
827 "Read a simple stroke (interactively) and return the stroke.
828Optional PROMPT in minibuffer displays before and during stroke reading.
829This function will display the stroke interactively as it is being
830entered in the strokes buffer if the variable
831`strokes-use-strokes-buffer' is non-nil.
832Optional EVENT is currently not used, but hopefully will be soon."
833 (save-excursion
834 (track-mouse
835 (let ((pix-locs nil)
836 (grid-locs nil)
837 (event nil))
838 (if strokes-use-strokes-buffer
839 ;; switch to the strokes buffer and
840 ;; display the stroke as it's being read
841 (save-window-excursion
842 (set-window-configuration strokes-window-configuration)
843 (if prompt
844 (progn
845 (message prompt)
846 (setq event (read-event))
847 (while (not (button-press-event-p event))
848 (setq event (read-event)))))
849 (unwind-protect
850 (progn
851 (setq event (read-event))
852 (while (not (button-release-event-p event))
853 (if (strokes-mouse-event-p event)
854 (let ((point (strokes-event-closest-point event)))
855 (when point
856 (goto-char point)
857 (subst-char-in-region point (1+ point) ?\ strokes-character))
858 (push (cons (event-x-pixel event)
859 (event-y-pixel event))
860 pix-locs)))
861 (setq event (read-event))))
862 ;; protected
863 ;; clean up strokes buffer and then bury it.
864 (when (equal (buffer-name) strokes-buffer-name)
865 (subst-char-in-region (point-min) (point-max) strokes-character ?\ )
866 (goto-char (point-min))
867 (bury-buffer))))
868 ;; Otherwise, don't use strokes buffer and read stroke silently
869 (if prompt
870 (progn
871 (message prompt)
872 (setq event (read-event))
873 (while (not (button-press-event-p event))
874 (setq event (read-event)))))
875 (setq event (read-event))
876 (while (not (button-release-event-p event))
877 (if (strokes-mouse-event-p event)
878 (push (cons (event-x-pixel event)
879 (event-y-pixel event))
880 pix-locs))
881 (setq event (read-event))))
882 (setq grid-locs (strokes-renormalize-to-grid (nreverse pix-locs)))
883 (strokes-fill-stroke (strokes-eliminate-consecutive-redundancies grid-locs))))))
884
885;;;###autoload
886(defun strokes-read-complex-stroke (&optional prompt event)
887 "Read a complex stroke (interactively) and return the stroke.
888Optional PROMPT in minibuffer displays before and during stroke reading.
889Note that a complex stroke allows the user to pen-up and pen-down. This
890is implemented by allowing the user to paint with button1 or button2 and
891then complete the stroke with button3.
892Optional EVENT is currently not used, but hopefully will be soon."
893 (save-excursion
894 (save-window-excursion
895 (track-mouse
896 (set-window-configuration strokes-window-configuration)
897 (let ((pix-locs nil)
898 (grid-locs nil)
899 (event (or event (read-event))))
900 (if prompt
901 (while (not (button-press-event-p event))
902 (message prompt)
903 (setq event (read-event))))
904 (unwind-protect
905 (progn
906 (setq event (read-event))
907 (while (not (and (button-press-event-p event)
908 (eq (event-button event) 3)))
909 (while (not (button-release-event-p event))
910 (if (strokes-mouse-event-p event)
911 (let ((point (strokes-event-closest-point event)))
912 (when point
913 (goto-char point)
914 (subst-char-in-region point (1+ point) ?\ strokes-character))
915 (push (cons (event-x-pixel event)
916 (event-y-pixel event))
917 pix-locs)))
918 (setq event (read-event)))
919 (push strokes-lift pix-locs)
920 (while (not (button-press-event-p event))
921 (setq event (read-event))))
922 ;; ### KLUDGE! ### sit and wait
923 ;; for some useless event to
924 ;; happen to fix the minibuffer bug.
925 (while (not (button-release-event-p (read-event))))
926 (setq pix-locs (nreverse (cdr pix-locs))
927 grid-locs (strokes-renormalize-to-grid pix-locs))
928 (strokes-fill-stroke
929 (strokes-eliminate-consecutive-redundancies grid-locs)))
930 ;; protected
931 (when (equal (buffer-name) strokes-buffer-name)
932 (subst-char-in-region (point-min) (point-max) strokes-character ?\ )
933 (goto-char (point-min))
934 (bury-buffer))))))))
935
936(defun strokes-execute-stroke (stroke)
937 "Given STROKE, execute the command which corresponds to it.
938The command will be executed provided one exists for that stroke,
939based on the variable `strokes-minimum-match-score'.
940If no stroke matches, nothing is done and return value is nil."
941 (let* ((match (strokes-match-stroke stroke strokes-global-map))
942 (command (car match))
943 (score (cdr match)))
944 (cond ((strokes-click-p stroke)
945 ;; This is the case of a `click' type event
946 (command-execute strokes-click-command))
947 ((and match (<= score strokes-minimum-match-score))
948 (message "%s" command)
949 (command-execute command))
950 ((null strokes-global-map)
951 (if (file-exists-p strokes-file)
952 (and (y-or-n-p-maybe-dialog-box
953 (format "No strokes loaded. Load `%s'? "
954 strokes-file))
955 (strokes-load-user-strokes))
956 (error "No strokes defined; use `global-set-stroke'")))
957 (t
958 (error
959 "No stroke matches; see variable `strokes-minimum-match-score'")
960 nil))))
961
962;;;###autoload
963(defun strokes-do-stroke (event)
964 "Read a simple stroke from the user and then exectute its comand.
965This must be bound to a mouse event."
966 (interactive "e")
967 (or strokes-mode (strokes-mode t))
968 (strokes-execute-stroke (strokes-read-stroke nil event)))
969
970;;;###autoload
971(defun strokes-do-complex-stroke (event)
972 "Read a complex stroke from the user and then exectute its command.
973This must be bound to a mouse event."
974 (interactive "e")
975 (or strokes-mode (strokes-mode t))
976 (strokes-execute-stroke (strokes-read-complex-stroke nil event)))
977
978;;;###autoload
979(defun strokes-describe-stroke (stroke)
980 "Displays the command which STROKE maps to, reading STROKE interactively."
981 (interactive
982 (list
983 (strokes-read-complex-stroke
984 "Enter stroke to describe; end with button3...")))
985 (let* ((match (strokes-match-stroke stroke strokes-global-map))
986 (command (or (and (strokes-click-p stroke)
987 strokes-click-command)
988 (car match)))
989 (score (cdr match)))
990 (if (or (and match
991 (<= score strokes-minimum-match-score))
992 (and (strokes-click-p stroke)
993 strokes-click-command))
994 (message "That stroke maps to `%s'" command)
995 (message "That stroke is undefined"))
996 (sleep-for 1))) ; helpful for recursive edits
997
998;;;###autoload
999(defalias 'describe-stroke 'strokes-describe-stroke)
1000
1001;;; ### FORGET IT! I COULN'T GET THE EMACS READER TO PARSE THIS FUNCTION ###
1002;;;###autoload
1003;;(defun strokes-help ()
1004;; "Get instructional help on using the the `strokes' package."
1005;; (interactive)
1006;; (with-output-to-temp-buffer "*Help with Strokes*"
1007;; (let ((helpdoc
1008;; "This is help for the strokes package.
1009
1010;;If you find something wrong with strokes, or feel that it can be
1011;;improved in some way, then please feel free to email me:
1012
1013;;David Bakhash <cadet@mit.edu>
1014
1015;;or just do
1016
1017;;M-x strokes-report-bug
1018
1019;;------------------------------------------------------------
1020
1021;;** Strokes...
1022
1023;;The strokes package allows you to define strokes, made with
1024;;the mouse or other pointer device, that Emacs can interpret as
1025;;corresponding to commands, and then executes the commands. It does
1026;;character recognition, so you don't have to worry about getting it
1027;;right every time.
1028
1029;;Strokes are easy to program and fun to use. To start strokes going,
1030;;you'll want to put the following line in your .emacs file as mentioned
1031;;in the commentary to strokes.el.
1032
1033;;This will load strokes when and only when you start Emacs on a window
1034;;system, with a mouse or other pointer device defined.
1035
1036;;To toggle strokes-mode, you just do
1037
1038;;> M-x strokes-mode
1039
1040;;** Strokes for controling the behavior of Emacs...
1041
1042;;When you're ready to start defining strokes, just use the command
1043
1044;;> M-x global-set-stroke
1045
1046;;You will see a ` *strokes*' buffer which is waiting for you to enter in
1047;;your stroke. When you enter in the stroke, you draw with button1 or
1048;;button2, and then end with button3. Next, you enter in the command
1049;;which will be executed when that stroke is invoked. Simple as that.
1050;;For now, try to define a stroke to copy a region. This is a popular
1051;;edit command, so type
1052
1053;;> M-x global-set-stroke
1054
1055;;Then, in the ` *strokes*' buffer, draw the letter `C' (for `copy'\)
1056;;and then, when it asks you to enter the command to map that to, type
1057
1058;;> copy-region-as-kill
1059
1060;;That's about as hard as it gets.
1061;;Remember: paint with button1 or button2 and then end with button3.
1062
1063;;If ever you want to know what a certain strokes maps to, then do
1064
1065;;> M-x describe-stroke
1066
1067;;and you can enter in any arbitrary stroke. Remember: The strokes
1068;;package lets you program in simple and complex, or multi-lift, strokes.
1069;;The only difference is how you *invoke* the two. You will most likely
1070;;use simple strokes, as complex strokes were developed for
1071;;Chinese/Japanese/Korean. So the middle mouse button, button2, will
1072;;invoke the command `strokes-do-stroke' in buffers where button2 doesn't
1073;;already have a meaning other than its original, which is `mouse-yank'.
1074;;But don't worry: `mouse-yank' will still work with strokes. See the
1075;;variable `strokes-click-command'.
1076
1077;;If ever you define a stroke which you don't like, then you can unset
1078;;it with the command
1079
1080;;> M-x strokes-unset-last-stroke
1081
1082;;Your strokes are stored as you enter them. They get saved in a file
1083;;called ~/.strokes, along with other strokes configuration variables.
1084;;You can change this location by setting the variable `strokes-file'.
1085;;You will be prompted to save them when you exit Emacs, or you can save
1086;;them with
1087
1088;;> M-x save-strokes
1089
1090;;Your strokes get loaded automatically when you enable `strokes-mode'.
1091;;You can also load in your user-defined strokes with
1092
1093;;> M-x load-user-strokes
1094
1095;;** A few more important things...
1096
1097;;o The command `strokes-do-stroke' is also invoked with M-button2, so that you
1098;; can still enter a stroke in modes which use button2 for other things,
1099;; such as cross-referencing.
1100
1101;;o Strokes are a bit computer-dependent in that they depend somewhat on
1102;; the speed of the computer you're working on. This means that you
1103;; may have to tweak some variables. You can read about them in the
1104;; commentary of `strokes.el'. Better to just use apropos and read their
1105;; docstrings. All variables/functions start with `strokes'. The one
1106;; variable which many people wanted to see was
1107;; `strokes-use-strokes-buffer' which allows the user to use strokes
1108;; silently--without displaying the strokes. All variables can be set
1109;; by customizing the group named `strokes' via the customization package:
1110
1111;; > M-x customize"))
1112;; (save-excursion
1113;; (princ helpdoc)
1114;; (set-buffer standard-output)
1115;; (help-mode))
1116;; (print-help-return-message)))))
1117
1118(defun strokes-report-bug ()
1119 "Submit a bug report for strokes."
1120 (interactive)
1121 (let ((reporter-prompt-for-summary-p t))
1122 (or (boundp 'reporter-version)
1123 (setq reporter-version
1124 "Your version of reporter is obsolete. Please upgrade."))
1125 (reporter-submit-bug-report
1126 strokes-bug-address "Strokes"
1127 (cons
1128 'strokes-version
1129 (nconc
1130 (mapcar
1131 'intern
1132 (sort
1133 (let (completion-ignore-case)
1134 (all-completions "strokes-" obarray 'user-variable-p))
1135 'string-lessp))
1136 (list 'reporter-version)))
1137 (function
1138 (lambda ()
1139 (save-excursion
1140 (mail-position-on-field "subject")
1141 (beginning-of-line)
1142 (skip-chars-forward "^:\n")
1143 (if (looking-at ": Strokes;")
1144 (progn
1145 (goto-char (match-end 0))
1146 (delete-char -1)
1147 (insert " " strokes-version " bug:")))))))))
1148
1149(defsubst strokes-fill-current-buffer-with-whitespace ()
1150 "Erase the contents of the current buffer and fill it with whitespace"
1151 (erase-buffer)
1152 (loop repeat (frame-height) do
1153 (insert-char ?\ (1- (frame-width)))
1154 (newline))
1155 (goto-char (point-min)))
1156
1157(defun strokes-update-window-configuration ()
1158 "Insure that `strokes-window-configuration' is up-to-date."
1159 (interactive)
1160 (let ((current-window (selected-window)))
1161 (cond ((or (window-minibuffer-p current-window)
1162 (window-dedicated-p current-window))
1163 ;; don't try to update strokes window configuration
1164 ;; if window is dedicated or a minibuffer
1165 nil)
1166 ((or (interactive-p)
1167 (not (buffer-live-p (get-buffer strokes-buffer-name)))
1168 (null strokes-window-configuration))
1169 ;; create `strokes-window-configuration' from scratch...
1170 (save-excursion
1171 (save-window-excursion
1172 (get-buffer-create strokes-buffer-name)
1173 (set-window-buffer current-window strokes-buffer-name)
1174 (delete-other-windows)
1175 (fundamental-mode)
1176 (auto-save-mode 0)
1177 (if (featurep 'font-lock)
1178 (font-lock-mode 0))
1179 (abbrev-mode 0)
1180 (buffer-disable-undo (current-buffer))
1181 (setq truncate-lines nil)
1182 (strokes-fill-current-buffer-with-whitespace)
1183 (setq strokes-window-configuration (current-window-configuration))
1184 (bury-buffer))))
1185 (t ; `strokes buffer' still exists...
1186 ;; update the strokes-window-configuration for this specific frame...
1187 (save-excursion
1188 (save-window-excursion
1189 (set-window-buffer current-window strokes-buffer-name)
1190 (delete-other-windows)
1191 (strokes-fill-current-buffer-with-whitespace)
1192 (setq strokes-window-configuration (current-window-configuration))
1193 (bury-buffer)))))))
1194
1195;;;###autoload
1196(defun strokes-load-user-strokes ()
1197 "Load user-defined strokes from file named by `strokes-file'."
1198 (interactive)
1199 (cond ((and (file-exists-p strokes-file)
1200 (file-readable-p strokes-file))
1201 (load-file strokes-file))
1202 ((interactive-p)
1203 (error "Trouble loading user-defined strokes; nothing done"))
1204 (t
1205 (message "No user-defined strokes, sorry"))))
1206
1207;;;###autoload
1208(defalias 'load-user-strokes 'strokes-load-user-strokes)
1209
1210(defun strokes-prompt-user-save-strokes ()
1211 "Save user-defined strokes to file named by `strokes-file'."
1212 (interactive)
1213 (save-excursion
1214 (let ((current strokes-global-map))
1215 (unwind-protect
1216 (progn
1217 (setq strokes-global-map nil)
1218 (strokes-load-user-strokes)
1219 (if (and (not (equal current strokes-global-map))
1220 (or (interactive-p)
1221 (yes-or-no-p-maybe-dialog-box "save your strokes? ")))
1222 (progn
1223 (require 'pp) ; pretty-print variables
1224 (message "Saving strokes in %s..." strokes-file)
1225 (get-buffer-create "*saved-strokes*")
1226 (set-buffer "*saved-strokes*")
1227 (erase-buffer)
1228 (emacs-lisp-mode)
1229 (goto-char (point-min))
1230 (insert-string
1231 ";; -*- Syntax: Emacs-Lisp; Mode: emacs-lisp -*-\n")
1232 (insert-string (format ";;; saved strokes for %s, as of %s\n\n"
1233 (user-full-name)
1234 (format-time-string "%B %e, %Y" nil)))
1235 (message "Saving strokes in %s..." strokes-file)
1236 (insert-string (format "(setq strokes-global-map '%s)"
1237 (pp current)))
1238 (message "Saving strokes in %s..." strokes-file)
1239 (indent-region (point-min) (point-max) nil)
1240 (write-region (point-min)
1241 (point-max)
1242 strokes-file))
1243 (message "(no changes need to be saved)")))
1244 ;; protected
1245 (if (get-buffer "*saved-strokes*")
1246 (kill-buffer (get-buffer "*saved-strokes*")))
1247 (setq strokes-global-map current)))))
1248
1249(defalias 'save-strokes 'strokes-prompt-user-save-strokes)
1250
1251(defun strokes-toggle-strokes-buffer (&optional arg)
1252 "Toggle the use of the strokes buffer.
1253In other words, toggle the variabe `strokes-use-strokes-buffer'.
1254With ARG, use strokes buffer if and only if ARG is positive or true.
1255Returns value of `strokes-use-strokes-buffer'."
1256 (interactive "P")
1257 (setq strokes-use-strokes-buffer
1258 (if arg (> (prefix-numeric-value arg) 0)
1259 (not strokes-use-strokes-buffer))))
1260
1261;;;###autoload
1262(defun strokes-mode (&optional arg)
1263 "Toggle strokes being enabled.
1264With ARG, turn strokes on if and only if ARG is positive or true.
1265Note that `strokes-mode' is a global mode. Think of it as a minor
1266mode in all buffers when activated.
1267By default, strokes are invoked with mouse button-2. You can define
1268new strokes with
1269
1270> M-x global-set-stroke
1271
1272To use strokes for pictographic editing, such as Chinese/Japanese, use
1273Sh-button-2, which draws strokes and inserts them. Encode/decode your
1274strokes with
1275
1276> M-x strokes-encode-buffer
1277> M-x strokes-decode-buffer"
1278 (interactive "P")
1279 (let ((on-p (if arg
1280 (> (prefix-numeric-value arg) 0)
1281 (not strokes-mode))))
1282 (cond ((not window-system)
1283 (error "Can't use strokes without windows"))
1284 (on-p ; turn on strokes
1285 (and (file-exists-p strokes-file)
1286 (null strokes-global-map)
1287 (strokes-load-user-strokes))
1288 (add-hook 'kill-emacs-hook
1289 'strokes-prompt-user-save-strokes)
1290 (add-hook 'select-frame-hook
1291 'strokes-update-window-configuration)
1292 (strokes-update-window-configuration)
1293 (define-key global-map [(button2)] 'strokes-do-stroke)
1294 (define-key global-map [(meta button2)] 'strokes-do-stroke)
1295 ;; (define-key global-map [(control button2)] 'strokes-do-complex-stroke)
1296 (ad-activate-regexp "^strokes-") ; advise button2 commands
1297 (setq strokes-mode t))
1298 (t ; turn off strokes
1299 (if (get-buffer strokes-buffer-name)
1300 (kill-buffer (get-buffer strokes-buffer-name)))
1301 (remove-hook 'select-frame-hook
1302 'strokes-update-window-configuration)
1303 (if (string-match "^strokes-" (symbol-name (key-binding [(button2)])))
1304 (define-key global-map [(button2)] strokes-click-command))
1305 (if (string-match "^strokes-" (symbol-name (key-binding [(meta button2)])))
1306 (global-unset-key [(meta button2)]))
1307 ;; (if (string-match "^strokes-" (symbol-name (key-binding [(shift button2)])))
1308 ;; (global-unset-key [(shift button2)]))
1309 (ad-deactivate-regexp "^strokes-") ; unadvise strokes-button2 commands
1310 (setq strokes-mode nil))))
1311 (force-mode-line-update))
1312
1313(or (assq 'strokes-mode minor-mode-alist)
1314(setq minor-mode-alist (cons (list 'strokes-mode strokes-modeline-string)
1315 minor-mode-alist)))
1316
1317(provide 'strokes)
1318(run-hooks 'strokes-load-hook)
1319
1320;;; strokes.el ends here
1321
1322