;;   -*- Syntax: Emacs-Lisp; Mode: emacs-lisp -*-
;;; strokes.el -- package for XEmacs to be controled through mouse strokes
;; Copyright 1997 by David Bakhash <dave@teracorp.com>

;; This package is written for for Xemacs v19-14 and up.
;;
;; Author: David Bakhash <dave@teracorp.com>
;; Maintainer: David Bakhash <dave@teracorp.com>
;; Created: 12 March 1997
;; Version: 1.0

;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 2 of the License, or
;;; (at your option) any later version.

;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.

;;; You should have received a copy of the GNU General Public License
;;; along with this program; see the file COPYING.  If not, write to
;;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;;; Boston, MA 02111-1307, USA.

;;; Commentary
;;; This is the strokes package.  It is intended to allow the user to
;;; control XEmacs by means of mouse strokes.  A mouse stroke, for now, can
;;; be defined as holding the middle button, for instance, and then moving
;;; the mouse in whatever pattern you wish, which you have set XEmacs to
;;; understand as mapping to a given command.  For example, you may wish
;;; the have a mouse stroke that looks like a capital `C' which means
;;; `copy-region-as-kill'.  Treat strokes just like you do key bindings.
;;; For example, XEmacs sets key bindings globally with the
;;; `global-set-key' command.  Likewise, you can do

;;; M-x global-set-stroke

;;; to interactively program in a stroke.  It would be wise to set the
;;; first one to this very command, so that from then on, you invoke
;;; `global-set-stroke' with a stroke.  likewise, there is a
;;; `local-set-stroke' command, also analogous to `local-set-key'.

;;; Other analogies between strokes and key bindings are as follows:

;;;    1) to describe a stroke binding, you can type `C-h S' (`S' for
;;;       `stroke') which is bound to `describe-stroke', much like `C-h c'
;;;       to describe key bindings.  It's also wise to have a stroke,
;;;       like an `h', for help, or a `?', mapped to `describe-stroke'.

;;;    2) stroke bindings are set internally through the lisp function
;;;       `define-stroke', similar to the `define-key' function.  some
;;;       examples for a 3x3 stroke grid would be 

;;;       (define-stroke c-mode-stroke-map
;;;                      '((0 . 0) (1 . 1) (2 . 2))
;;;                      'kill-region)
;;;       (define-stroke global-stroke-map
;;;                      '((0 . 0) (0 . 1) (0 . 2) (1 . 2) (2 . 2))
;;;                      'list-buffers)

;;;       however, if you would probably just have the user enter in the
;;;       stroke interactively and then set the stroke to whatever he/she
;;;       entered. The lisp function to interactively read a stroke is
;;;       `read-stroke'.  This is especially helpful when you're on a fast
;;;       computer that can handle a 9x9 stroke grid.  

;;;       NOTE: only global stroke bindings are currently implemented,
;;;       however mode- and buffer-local stroke bindings will be
;;;       implemented in the next version, which should not be too far
;;;       away. 
      
;;; The important variables to be aware of for this package are

;;; `minimum-stroke-match-score' (determines the threshold of error that
;;; makes a stroke acceptable or unacceptable.

;;; `stroke-grid-res' (determines the dimensions of the grid that you use
;;; when defining/reading strokes.  The finer the grid your computer can
;;; handle, the more you can do, but even a 3x3 grid is pretty cool.)

;;; Whenever you load in the strokes package, you will be able to save
;;; what you've done upon exiting XEmacs.  You can also do

;;; M-x save-strokes

;;; and it will save your strokes in ~/.strokes, or you may wish to change
;;; this by setting the variable `strokes-file'.

;;; Note that internally, all of the routines that are part of this package
;;; are able to deal with complex strokes, as they are a superset of simple
;;; strokes.  However, the default of this package will map mouse button2
;;; to the command `do-stroke', and NOT `do-complex-stroke'.  If you wish
;;; to use complex strokes, you will have to override this keymapping.
;;; Complex strokes are terminated with mouse button3.  The strokes
;;; package will not interfere with `mouse-yank', but you may want to
;;; examine how this is done (see the variable `stroke-click-command')

;;; To get strokes to work as part of your your setup, then you'll have 
;;; put the strokes package in your load-path (preferably byte-compiled)
;;; and then add the following to your .xemacs-options file (or wherever
;;; you put XEmacs-specific startup preferences):     

;;; (if window-system
;;;     (require 'strokes))

;;; I am now in the process of porting this package to emacs.  I am also
;;; hoping that, with the help of others, this package will be useful
;;; in entering in pictographic-like language text using the mouse
;;; (i.e. Korean).  Japanese and Chinese are a bit trickier, but I'm sure
;;; that with help it can be done.  The next version will allow the user
;;; to enter strokes which "remove the pencil from the paper" so to speak,
;;; so one character can have multiple strokes.

;;; Great thanks to Rob Ristroph for his generosity in letting me use his
;;; PC to develop this, Jason Johnson for his help in algorithms, and Euna
;;; Kim for her help in Korean.

;;; Tasks: (what I'm getting ready for the next version)...
;;; 1) fix up code for byte-compiling, for MULE, and XEmacs-20
;;; 2) use 'read-complex-stroke for korean, etc.
;;; 4) buffer-local 'local-stroke-map, and mode-stroke-maps would be nice
;;; 5) 'list-strokes (kinda important) and also a 'help-on-strokes thing
;;; 6) add some hooks, like 'post-execute-stroke-hook.
;;; Code

(defconst strokes-version "1.0")

;;; user variables...

(defvar minimum-stroke-match-score 150
  "*Minimum score for a stroke to be considered as a possible match.
Requiring a perfect match would set this variable to 0.")

(defvar stroke-grid-res 6
  "*Integer defining stroke grid resolution such that the grid is
STROKE-GRID-RES square grid defaults to `6', making a 6x6
grid whose coordinates go from (0 . 0) on the top left to
((STROKE-GRID-RES - 1) . (STROKE-GRID-RES - 1)) on the bottom
right.")

(defvar strokes-file "~/.strokes"
  "*File containing saved strokes for stroke-mode (default is ~/.strokes")

(defvar stroke-buffer-name "*strokes*"
  "The buffer that the strokes take place in (default is `*strokes*')")

(defvar stroke-click-command 'mouse-yank
  "*Command to execute when stroke is too short to be considered a
real stroke and is more likely meant to be a `click' event.  If set
to 'mouse-yank (the default), then the variable
`mouse-yank-at-point' is set to t, so that mouse-yank will work.")

;;; other variables...

(defvar strokes-enabled t
  "Variable determining whether strokes are globally enabled")

(defconst stroke-window-configuration nil
  "The special window configuration used when entering strokes.  This
will be set properly in the function `make-window-buffer'")

(defvar last-stroke nil
  "This is the stroke (string) representing the last stroke entered by
the user.  Its value gets set every time the function
`eliminate-consecutive-redundancies' gets called, since that is the
best time to set the variable")

(defconst LIFT 'LIFT
  "This is the symbol which denotes a stroke lift event for complex
strokes which contain two or more strokes, such as a Chinese character")

(defvar global-stroke-map '()
  "Association list of stroke definitions where each entry is 
(STROKE . COMMAND) where STROKE is itself a list of coordinates 
(X . Y) where X and Y are lists of positions on the normalized
stroke grid, with the top left at (0 . 0).  COMMAND is the
corresponding interactive function")

;;(defun stroke-map-p (object)		; ovbiously an oversimlification
;;  "returns t if OBJECT is a stroke-map, and `nil' otherwise A stroke
;;map is defined as an association list where each element is a cons
;;cell specifying a STROKE and its corresponding COMMAND"
;;  (listp object))
  
(defun stroke-lift-p (object)
  (eq object 'LIFT))

(defun xor (a b)
  (or (and a (not b))
      (and b (not a))))

(defmacro define-stroke (stroke-map stroke def)
  "add STROKE to STROKE-MAP alist with given command DEF"
  (list 'setq stroke-map (list 'cons (list 'cons stroke def)
			       (list 'remassoc stroke stroke-map))))
(defun unset-last-stroke ()
  "Undo the last stroke definition done."
  (interactive)
  (let ((command (cdar global-stroke-map)))
    (if (y-or-n-p-minibuf
	 (format "really delete last stroke definition, defined to `%s'? "
		 command))
	(progn
	  (setq global-stroke-map (cdr global-stroke-map))
	  (message "that stroke has been deleted"))
      (message "nothing done."))))

(defun global-set-stroke (stroke command)
  "add STROKE to `global-stroke-map' alist with given DEF, letting the
user input the stroke with the mouse"
  (interactive
   (list
    (read-complex-stroke
     "define a new stroke (with the mouse).  end by pressing button3")
    (read-command "command to map stroke to: ")))
  (define-stroke global-stroke-map stroke command))

;;(defun global-unset-stroke (stroke)	; FINISH THIS DEFUN!
;;  "delete all strokes matching STROKE from `global-stroke-map',
;; letting the user input
;; the stroke with the mouse"
;;  (interactive
;;   (list
;;    (read-stroke "Enter the stroke you want to delete...")))
;;  (define-stroke 'global-stroke-map stroke command))

(defsubst square (x)
  "returns the square of the number X"
  (* x x))

(defsubst distance-squared (p1 p2)
  "Gets the distance (squared) between to points P1 and P2,
where the points are cons cells \\(X . Y\\)"
  (let ((x1 (car p1))
	(y1 (cdr p1))
	(x2 (car p2))
	(y2 (cdr p2)))
    (+ (square (- x2 x1))
       (square (- y2 y1)))))

(defun read-stroke (&optional prompt)
  "Wait for the user to enter in a stroke.  Optional PROMPT in
minibuffer while waiting"
  (save-excursion
    (save-window-excursion
      (setq pix-locs nil
	    stroke nil)
      (set-window-configuration stroke-window-configuration)
      (if prompt
	  (progn
	    (setq event (next-event nil prompt))
	    (while (not (button-press-event-p event))
	      (dispatch-event event)
	      (setq event (next-event event)))))
      (unwind-protect
	  (progn
	    (setq event (next-event))
	    (while (not (button-release-event-p event))
	      (if (mouse-event-p event)
		  (progn
		    (goto-char (event-closest-point event))
		    (delete-char 1)
		    (insert-char 111)
		    (setq pix-locs (cons (cons (event-x-pixel event)
					       (event-y-pixel event))
					 pix-locs))))
	      (setq event (next-event event)))
	    (setq grid-locs (reduce-stroke-pixels-to-grid
			     (nreverse pix-locs))
		  stroke (eliminate-consecutive-redundancies grid-locs)))
	;; protected
	(goto-char (point-min))
	(while (search-forward "o" nil t)
	  (replace-match " " nil t))
	(goto-char (point-min))
	(bury-buffer)
	stroke))))

(defun read-complex-stroke (&optional prompt)
  "Wait for the user to enter in a stroke.  Optional PROMPT in
minibuffer while waiting"
  (save-excursion
    (save-window-excursion
      (setq pix-locs nil
	    stroke nil)
      (set-window-configuration stroke-window-configuration)
      (setq event (next-event nil prompt))
      (if prompt
	  (while (not (button-press-event-p event))
	    (dispatch-event event)
	    (setq event (next-event event prompt))))
      (unwind-protect
	  (progn
	    (while (not (and (button-press-event-p event)
			     (eq (event-button event) 3)))
	      (while (not (button-release-event-p event))
		(if (mouse-event-p event)
		    (progn
		      (goto-char (event-closest-point event))
		      (delete-char 1)
		      (insert-char 111)
		      (setq pix-locs (cons (cons (event-x-pixel event)
						 (event-y-pixel event))
					   pix-locs))))
		(setq event (next-event event prompt)))
	      (setq pix-locs (cons LIFT pix-locs))
	      (while (not (button-press-event-p event))
		(dispatch-event event)
		(setq event (next-event event prompt))))
	    (setq pix-locs (cdr (nreverse (cdr pix-locs)))
		  grid-locs (reduce-stroke-pixels-to-grid pix-locs)
		  stroke (eliminate-consecutive-redundancies grid-locs)))
	;; protected
	(goto-char (point-min))
	(while (search-forward "o" nil t)
	  (replace-match " " nil t))
	(goto-char (point-min))
	(bury-buffer)
	stroke))))

(defun describe-stroke (stroke)
  "let user interactively enter a stroke and then describe it"
  (interactive
   (list
    (read-complex-stroke "enter stroke to describe.  end with button3...")))
  (let* ((match (match-stroke stroke global-stroke-map))
	 (command (car match))
	 (score (cdr match)))
    (if (and match (<= score minimum-stroke-match-score))
	(message "that stroke maps to `%s'" command)
      (message "that stroke is undefined."))))

;;; some unimportant junk left over from initial ideas...
;;(defun stroke-p (stroke)
;;  (or nil ;(assoc stroke stroke-mode-map) how will I ever implement this???
;;      (assoc stroke global-stroke-map)))
  
(defun reduce-stroke-pixels-to-grid (pixel-positions)
  "Changes the pixel positions of the trajectory of the stroke into
positions on a grid defined by the variable STROKE-GRID-RES"
  (let ((stroke-extent (get-stroke-extent pixel-positions))) 
    (mapcar (lambda (pix-pos)
	      (get-grid-position stroke-extent pix-pos))
	    pixel-positions)))

(defun get-grid-position (stroke-extent pix-pos)
  "Given STROKE-EXTENT as a list \\(\\(xmin . ymin\\) \\(xmax . ymax\\)\\)
and a particular pixel position \\(or LIFT\\), find the corresponding
grid position \\(based on `stroke-grid-res'\\) for the PIX-POS."
  (cond ((consp pix-pos)		; actual pixel location
	 (let ((x (car pix-pos))
	       (y (cdr pix-pos))
	       (xmin (caar stroke-extent))
	       (ymin (cdar stroke-extent))
	       ;; the `1+' is there to insure guarantee that the
	       ;; formula evaluates correctly at the boundaries
	       (xmax (1+ (caadr stroke-extent))) 
	       (ymax (1+ (cdadr stroke-extent)))) 
	   (cons (floor (* stroke-grid-res
			   (/ (float (- x xmin))
			      (float (- xmax xmin)))))
		 (floor (* stroke-grid-res
			   (/ (float (- y ymin))
			      (float (- ymax ymin))))))))
	((stroke-lift-p pix-pos)	; stroke lift
	 LIFT)))

(defun get-stroke-extent (pixel-positions)
  "From a list of PIXEL-POSITIONS, return the spatial pixel extent of
the stroke as a list ((xmin . ymin) (xmax . ymax))"
  (if pixel-positions
      (let ((xmin (caar pixel-positions))
	    (xmax (caar pixel-positions))
	    (ymin (cdar pixel-positions))
	    (ymax (cdar pixel-positions))
	    (rest (cdr pixel-positions)))
	(while rest
	  (if (consp (car rest))
	      (let ((x (caar rest))
		    (y (cdar rest)))
		(if (< x xmin)
		    (setq xmin x))
		(if (> x xmax)
		    (setq xmax x))
		(if (< y ymin)
		    (setq ymin y))
		(if (> y ymax)
		    (setq ymax y))))
	  (setq rest (cdr rest)))
	(let ((delta-x (- xmax xmin))
	      (delta-y (- ymax ymin)))
	  (if (> delta-x delta-y)
	      (setq ymin (- ymin
			    (/ (- delta-x delta-y)
			       2))
		    ymax (+ ymax
			    (/ (- delta-x delta-y)
			       2)))
	    (setq xmin (- xmin
			  (/ (- delta-y delta-x)
			     2))
		  xmax (+ xmax
			  (/ (- delta-y delta-x)
			     2))))
	  (list (cons xmin ymin)
		(cons xmax ymax))))
    nil))

(defun eliminate-consecutive-redundancies (entries)
  "Returns a list with no consecutive redundant entries."
  (if entries
      (let ((current (car entries))
	    (rest (cdr entries)))
	(setq non-redundant-list (list current))
	(while rest
	  (setq next (car rest))
	  (if (equal current next)
	      (setq rest (cdr rest))
	    (setq non-redundant-list (cons next non-redundant-list)
		  current next
		  rest (cdr rest))))
	(setq last-stroke (nreverse non-redundant-list)))
    nil))

(defun do-stroke (event)
  "Read a simple stroke from the user and then exectute the
corresponding command.  This should be bound to a mouse event."
  (interactive "e")
  (execute-stroke (read-stroke)))

(defun do-complex-stroke (event)
  "Read a complex stroke from the user and then exectute the
corresponding command.  This should be bound to a mouse event."
  (interactive "e")
  (execute-stroke (read-complex-stroke)))

(defun execute-stroke (stroke)
  "Given STROKE, execute the command which corresponds to it, provided
that one exists.  Returns nil otherwise."
  (let* ((match (match-stroke stroke global-stroke-map))
	 (command (car match))
	 (score (cdr match)))
    (cond ((< (length stroke) 2)
	   ;; This is the case of a `click' type event
	   ;; If people were really using button2 for strokes
	   ;; and wanted the best way to keep mouse-yank functionality,
	   ;; then in place of what follows you would probably put:
	   ;; (funcall mouse-yank-command)
	   ;; but the way it is now, you can just set the variable
	   ;; 'stroke-click-command however you want, at the small price
	   ;; of making sure that if it's set to 'mouse-yank, then you 
	   ;; also set mouse-yank-at-point to be true, which most people
	   ;; prefer anyway.  If all this stuff is just too heinus to
	   ;; think about, just forget about it and leave the default
	   ;; as is.  This package will automatically set
	   ;; 'mouse-yank-at-point if need be, so all you really care about
	   ;; is deciding what command to execute when the stroke is more
	   ;; like a click.  It works fine.
	   (call-interactively stroke-click-command))
	  ((and match (<= score minimum-stroke-match-score))
	   (message "%s" command)
	   (call-interactively command))
	  (t
	   (cerror
	    "No stroke matches. see variable `minimum-stroke-match-score'"
	    minimum-stroke-match-score)
	   nil))))

(defun match-stroke (stroke stroke-map)
  "Finds the best match of STROKE in STROKE-MAP and returns the
corresponding match as (COMMAND . SCORE)."
  (if (and stroke stroke-map)
      (let ((score (rate-stroke stroke (caar stroke-map)))
	    (command (cdar stroke-map))
	    (map (cdr stroke-map)))
	(while map
	  (let ((newscore (rate-stroke stroke (caar map))))
	    (if (or (and newscore score (< newscore score))
		    (and newscore (null score)))
		(setq score newscore
		      command (cdar map)))
	    (setq map (cdr map))))
	(if score
	    (cons command score)
	  nil))
    nil))

(defun rate-stroke (stroke1 stroke2)
  "Computes the distances between corresponding grid points of strokes
and then rates the strokes accordingly.  Note: the rating is an error
rating, and therefore, a return of 0 represents a perfect match.  Also
note that the order of stroke arguments is order-independent for the
algorithm used here."
  (if (and stroke1 stroke2)
      (let ((rest1 (cdr stroke1))
	    (rest2 (cdr stroke2))
	    (err (distance-squared (car stroke1) (car stroke2))))
	(while (and rest1 rest2)
	  ;; both are non-lifts
	  (while (and (consp (car rest1)) (consp (car rest2))) 
	    (setq err (+ err
			 (distance-squared (car rest1) (car rest2)))
		  stroke1 rest1
		  stroke2 rest2
		  rest1 (cdr stroke1)
		  rest2 (cdr stroke2)))
	  (cond ((and (stroke-lift-p (car rest1))
		      (stroke-lift-p (car rest2)))
		 (setq rest1 (cdr rest1)
		       rest2 (cdr rest2)))
		((stroke-lift-p (car rest2))
		 (while (consp (car rest1))
		   (setq err (+ err
				(distance-squared (car rest1) (car stroke2)))
			 rest1 (cdr rest1))))
		((stroke-lift-p (car rest1))
		 (while (consp (car rest2))
		   (setq err (+ err
				(distance-squared (car stroke1) (car rest2)))
			 rest2 (cdr rest2))))))
	(if (null rest2)
	    (while (consp (car rest1))
	      (setq err (+ err
			   (distance-squared (car rest1) (car stroke2)))
		    rest1 (cdr rest1))))
	(if (null rest1)
	    (while (consp (car rest2))
	      (setq err (+ err
			   (distance-squared (car stroke1) (car rest2)))
		    rest2 (cdr rest2))))
	(if (or (stroke-lift-p (car rest1)) (stroke-lift-p (car rest2)))
	    (setq err nil)
	  err))
    nil))

;;; this is the old rate-stroke--good enough for simple strokes,
;;; but not for complex ones...
;;(defun rate-stroke (stroke1 stroke2)
;;  "Computes the distances between corresponding grid points of strokes
;;  and then rates the strokes accordingly.  Note: the rating is an
;;  error rating, and therefore, a return of 0 represents a perfect
;;  match.  Also note that the order of stroke arguments is
;;  order-independent for the algorithm used here."
;;  (if (and stroke1 stroke2)
;;      (progn
;;	(let ((rest1 (cdr stroke1))
;;	      (rest2 (cdr stroke2))
;;	      (err (distance-squared (car stroke1) (car stroke2))))
;;	  (while (and rest1 rest2)
;;	    (setq err (+ err
;;			 (distance-squared (car rest1) (car rest2)))
;;		  stroke1 rest1
;;		  stroke2 rest2
;;		  rest1 (cdr stroke1)
;;		  rest2 (cdr stroke2)))
;;	  (while rest1
;;	    (setq err (+ err
;;			 (distance-squared (car rest1) (car stroke2)))
;;		  rest1 (cdr rest1)))
;;	  (while rest2
;;	    (setq err (+ err
;;			 (distance-squared (car stroke1) (car rest2)))
;;		  rest2 (cdr rest2)))
;;	  err))
;;    nil))

(defun make-stroke-window-configuration ()
  "Prepare the window and buffer in which the strokes will take place"
  (interactive)
  (save-excursion
    (save-window-excursion
      (message "buffer `%s' being created..." stroke-buffer-name)
      (switch-to-buffer stroke-buffer-name)
      (delete-other-windows)
      (fundamental-mode)
      (erase-buffer)
      (auto-save-mode 0)
      (font-lock-mode 0)
      (buffer-disable-undo (current-buffer))
      (setq truncate-lines nil)
      (setq stroke-window-configuration (current-window-configuration))
      (let ((max (* 1 (frame-width) (frame-width)))
	    (count 0))
	(while (< count max)
	  (insert-string " ")
	  (setq count (1+ count)))
	(goto-char (point-min))
	(bury-buffer (current-buffer))
	(message "done")))))

(defun update-stroke-window-configuration ()
  "Update stroke window when other frames are selected"
  (save-excursion
    (save-window-excursion
      (switch-to-buffer stroke-buffer-name)
      (delete-other-windows)
      (setq stroke-window-configuration (current-window-configuration))
      (bury-buffer))))

(add-hook 'select-frame-hook 'update-stroke-window-configuration)

(add-hook 'kill-emacs-hook 'prompt-user-save-strokes)

(defun prompt-user-save-strokes ()
  "save user-defined strokes to file named by `strokes-file'"
  (interactive)
  (save-excursion
    (if (or (interactive-p)
	    (y-or-n-p-minibuf "save your strokes?"))
	(progn
	  (require 'pp)			; pretty-print variables
	  (message "saving strokes...")
	  (get-buffer-create "*saved-strokes*")
	  (set-buffer "*saved-strokes*")
	  (erase-buffer)
	  (emacs-lisp-mode)
	  (goto-char (point-min))
	  (insert-string ";;   -*- Syntax: Emacs-Lisp; Mode: emacs-lisp -*-")
	  (newline)
	  (insert-string (format ";;; saved strokes for %s, as of %s"
				 (user-full-name)
				 (format-time-string "%B %e, %Y" nil)))
	  (newline)
	  (newline-and-indent)
	  (insert-string (format "(setq stroke-buffer-name %S"
				 stroke-buffer-name))
	  (newline-and-indent)
	  (insert-string (format "stroke-click-command '%s"
				 stroke-click-command))
	  (newline-and-indent)
	  (if (eq stroke-click-command 'mouse-yank)
	      ;; make sure that if 'stroke-click-command is set to
	      ;; 'mouse-yank, then mouse-yank will work properly.
	      ;; This is kludgy, but it works...
	      (progn
		(insert-string "mouse-yank-at-point t")
		(lisp-indent-for-comment)
		(insert-string " make 'mouse-yank work with strokes")
		(newline-and-indent)))
	  (insert-string (format "minimum-stroke-match-score %s"
				 minimum-stroke-match-score))
	  (newline-and-indent)
	  (insert-string (format "stroke-grid-res %s"
				 stroke-grid-res))
	  (newline-and-indent)
	  (insert-string (format "minimum-stroke-match-score %s"
				 minimum-stroke-match-score))
	  (newline-and-indent)
	  (message "saving strokes...")
	  (insert-string (format "global-stroke-map '%s)"
				 (pp global-stroke-map)))
	  (message "saving strokes...")
	  (indent-region (point-min) (point-max) nil)
	  (write-file strokes-file)
	  (kill-this-buffer)))))

(defalias 'save-strokes 'prompt-user-save-strokes)

(defun load-strokes ()
  "Load user-defined strokes from file named by `strokes-file'"
  (interactive)
  (cond ((and (file-exists-p strokes-file)
	      (file-readable-p strokes-file))
	 (load-file strokes-file))
	((interactive-p)
	 (error "trouble loading user-defined strokes. nothing done."))
	(t
	 (message "no user-defined strokes, sorry"))))

(defun enable-strokes ()
  "Turn on strokes"
  (interactive)
  (load-strokes)
  (make-stroke-window-configuration)
  (global-set-key [(button2)] 'do-stroke)
  (global-set-key [(control button2)] 'do-stroke)
  (define-key global-map [(shift button2)] 'do-complex-stroke)
  (define-key global-map [(control h) S] 'describe-stroke)
  (setq strokes-enabled t))

(defun disable-strokes ()
  "Turn off strokes"
  (interactive)
  (if (get-buffer stroke-buffer-name)
      (kill-buffer (get-buffer stroke-buffer-name)))
  (global-unset-key [(button2)])
  (global-unset-key [(control button2)])
  (global-unset-key [(shift button2)])
  (global-unset-key [(control h) S])
  (setq strokes-enabled nil))

(enable-strokes)

;;; eventually, I plan to have a sophisticated routine
;;; called 'help-on-strokes
;;(define-key global-map [(control h) (control s)] 'help-on-strokes)
;;(defun help-on-strokes ()
;;  (interactive)
;;  ...)

(provide 'strokes)

;;; strokes.el ends here