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