/[emacs]/emacs/lisp/strokes.el
ViewVC logotype

Diff of /emacs/lisp/strokes.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.10 by rms, Sat May 4 02:45:09 2002 UTC revision 1.10.2.1 by miles, Fri Apr 4 06:20:11 2003 UTC
# Line 32  Line 32 
32  ;; > M-x strokes-help  ;; > M-x strokes-help
33    
34  ;; and you can learn how to use the package.  A mouse stroke, for now,  ;; 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  ;; can be defined as holding the shift key and the middle button, for
36  ;; moving the mouse in whatever pattern you wish, which you have set  ;; instance, and then moving the mouse in whatever pattern you wish,
37  ;; Emacs to understand as mapping to a given command.  For example, you  ;; which you have set Emacs to understand as mapping to a given
38  ;; may wish the have a mouse stroke that looks like a capital `C' which  ;; command.  For example, you may wish the have a mouse stroke that
39  ;; means `copy-region-as-kill'.  Treat strokes just like you do key  ;; looks like a capital `C' which means `copy-region-as-kill'.  Treat
40  ;; bindings.  For example, Emacs sets key bindings globally with the  ;; strokes just like you do key bindings.  For example, Emacs sets key
41  ;; `global-set-key' command.  Likewise, you can do  ;; bindings globally with the `global-set-key' command.  Likewise, you
42    ;; can do
43    
44  ;; > M-x global-set-stroke  ;; > M-x strokes-global-set-stroke
45    
46  ;; to interactively program in a stroke.  It would be wise to set the  ;; 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  ;; first one to this very command, so that from then on, you invoke
48  ;; `global-set-stroke' with a stroke.  likewise, there may eventually  ;; `strokes-global-set-stroke' with a stroke.  Likewise, there may
49  ;; be a `local-set-stroke' command, also analogous to `local-set-key'.  ;; eventually be a `strokes-local-set-stroke' command, also analogous
50    ;; to `local-set-key'.
51    
52  ;; You can always unset the last stroke definition with the command  ;; You can always unset the last stroke definition with the command
53    
# Line 58  Line 60 
60    
61  ;;    1) To describe a stroke binding, you can type  ;;    1) To describe a stroke binding, you can type
62    
63  ;;       > M-x describe-stroke  ;;       > M-x strokes-describe-stroke
64    
65  ;;       analogous to `describe-key'.  It's also wise to have a stroke,  ;;       analogous to `describe-key'.  It's also wise to have a stroke,
66  ;;       like an `h', for help, or a `?', mapped to `describe-stroke'.  ;;       like an `h', for help, or a `?', mapped to `describe-stroke'.
67    
68  ;;    2) stroke bindings are set internally through the Lisp function  ;;    2) stroke bindings are set internally through the Lisp function
69  ;;       `define-stroke', similar to the `define-key' function.  some  ;;       `strokes-define-stroke', similar to the `define-key' function.
70  ;;       examples for a 3x3 stroke grid would be  ;;       some examples for a 3x3 stroke grid would be
71    
72  ;;       (define-stroke c-mode-stroke-map  ;;       (strokes-define-stroke c-mode-stroke-map
73  ;;                      '((0 . 0) (1 . 1) (2 . 2))  ;;                      '((0 . 0) (1 . 1) (2 . 2))
74  ;;                      'kill-region)  ;;                      'kill-region)
75  ;;       (define-stroke strokes-global-map  ;;       (strokes-define-stroke strokes-global-map
76  ;;                      '((0 . 0) (0 . 1) (0 . 2) (1 . 2) (2 . 2))  ;;                      '((0 . 0) (0 . 1) (0 . 2) (1 . 2) (2 . 2))
77  ;;                      'list-buffers)  ;;                      'list-buffers)
78    
# Line 107  Line 109 
109  ;; computers as well as people who don't want to see their strokes.  ;; computers as well as people who don't want to see their strokes.
110    
111  ;; If you find that your mouse is accelerating too fast, you can  ;; If you find that your mouse is accelerating too fast, you can
112  ;; execute the UNIX X command to slow it down.  A good possibility is  ;; execute an X command to slow it down.  A good possibility is
113    
114  ;; % xset m 5/4 8  ;; % xset m 5/4 8
115    
# Line 116  Line 118 
118  ;; Whenever you load in the strokes package, you will be able to save  ;; Whenever you load in the strokes package, you will be able to save
119  ;; what you've done upon exiting Emacs.  You can also do  ;; what you've done upon exiting Emacs.  You can also do
120    
121  ;; > M-x save-strokes  ;; > M-x strokes-prompt-user-save-strokes
122    
123  ;; and it will save your strokes in ~/.strokes, or you may wish to change  ;; and it will save your strokes in ~/.strokes, or you may wish to change
124  ;; this by setting the variable `strokes-file'.  ;; this by setting the variable `strokes-file'.
# Line 124  Line 126 
126  ;; Note that internally, all of the routines that are part of this  ;; Note that internally, all of the routines that are part of this
127  ;; package are able to deal with complex strokes, as they are a superset  ;; package are able to deal with complex strokes, as they are a superset
128  ;; of simple strokes.  However, the default of this package will map  ;; of simple strokes.  However, the default of this package will map
129  ;; mouse button2 to the command `strokes-do-stroke', and NOT  ;; S-mouse-2 to the command `strokes-do-stroke', and M-mouse-2 to
130  ;; `strokes-do-complex-stroke'.  If you wish to use complex strokes, you  ;; `strokes-do-complex-stroke'.  Complex strokes are terminated
131  ;; will have to override this key mapping.  Complex strokes are terminated  ;; with mouse button 3.
 ;; 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 `strokes-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 .emacs file (or wherever  
 ;; you put Emacs-specific startup preferences):  
132    
133  ;;(and window-system  ;; You can also toggle between strokes mode by simple typing
 ;;     (require 'strokes))  
   
 ;; Once loaded, you can start stroking.  You can also toggle between  
 ;; strokes mode by simple typing  
134    
135  ;; > M-x strokes-mode  ;; > M-x strokes-mode
136    
137  ;; I am now in the process of porting this package to Emacs.  I also hope  ;; I hope that, with the help of others, this package will be useful
138  ;; that, with the help of others, this package will be useful in entering  ;; in entering in pictographic-like language text using the mouse
139  ;; in pictographic-like language text using the mouse (i.e. Korean).  ;; (i.e. Korean).  Japanese and Chinese are a bit trickier, but I'm
140  ;; Japanese and Chinese are a bit trickier, but I'm sure that with help  ;; sure that with help it can be done.  The next version will allow
141  ;; it can be done.  The next version will allow the user to enter strokes  ;; the user to enter strokes which "remove the pencil from the paper"
142  ;; which "remove the pencil from the paper" so to speak, so one character  ;; so to speak, so one character can have multiple strokes.
 ;; can have multiple strokes.  
143    
144  ;; You can read more about strokes at:  ;; You can read more about strokes at:
145    
# Line 172  Line 161 
161  ;; macros at (near) max speed.  ;; macros at (near) max speed.
162    
163  ;; Tasks: (what I'm getting ready for future version)...  ;; Tasks: (what I'm getting ready for future version)...
164  ;; 2) use 'strokes-read-complex-stroke for korean, etc.  ;; 2) use 'strokes-read-complex-stroke for Korean, etc.
165  ;; 4) buffer-local 'strokes-local-map, and mode-stroke-maps would be nice  ;; 4) buffer-local 'strokes-local-map, and mode-stroke-maps would be nice
166  ;; 6) add some hooks, like `strokes-read-stroke-hook'  ;; 6) add some hooks, like `strokes-read-stroke-hook'
167  ;; 7) See what people think of the factory settings.  Should I change  ;; 7) See what people think of the factory settings.  Should I change
# Line 193  Line 182 
182    
183  ;;; Constants...  ;;; Constants...
184    
 (defconst strokes-version "2.4-Emacs")  
   
 (defconst strokes-bug-address "cadet@alum.mit.edu")  
   
185  (defconst strokes-lift :strokes-lift  (defconst strokes-lift :strokes-lift
186    "Symbol representing a stroke lift event for complex strokes.    "Symbol representing a stroke lift event for complex strokes.
187  Complex strokes are those which contain two or more simple strokes.")  Complex strokes are those which contain two or more simple strokes.")
# Line 216  static char * stroke_xpm[] = { Line 201  static char * stroke_xpm[] = {
201  \"P     c #FFFF0000FFFF\",  \"P     c #FFFF0000FFFF\",
202  \".     c #45458B8B0000\",  \".     c #45458B8B0000\",
203  /* pixels */\n"  /* pixels */\n"
204    "The header to all xpm buffers created by strokes")    "The header to all xpm buffers created by strokes.")
205    
206  ;;; user variables...  ;;; user variables...
207    
208  (defgroup strokes nil  (defgroup strokes nil
209    "Control Emacs through mouse strokes"    "Control Emacs through mouse strokes"
210      :link '(emacs-commentary-link "strokes")
211    :link '(url-link "http://www.mit.edu/people/cadet/strokes-help.html")    :link '(url-link "http://www.mit.edu/people/cadet/strokes-help.html")
212    :group 'mouse)    :group 'mouse)
213    
214  (defcustom strokes-modeline-string " Strokes"  (defcustom strokes-modeline-string " Strokes"
215    "*Modeline identification when strokes-mode is on \(default is \" Strokes\"\)."    "*Modeline identification when Strokes mode is on \(default is \" Strokes\"\)."
216    :type 'string    :type 'string
217    :group 'strokes)    :group 'strokes)
218    
# Line 245  the value of `strokes-grid-resolution', Line 231  the value of `strokes-grid-resolution',
231  will correspond to more sample points, and thus more distance  will correspond to more sample points, and thus more distance
232  measurements.  Usually, this is not a problem since you first set  measurements.  Usually, this is not a problem since you first set
233  `strokes-grid-resolution' based on what your computer seems to be able  `strokes-grid-resolution' based on what your computer seems to be able
234  to handle (though the defaults are usually more than sufficent), and  to handle (though the defaults are usually more than sufficient), and
235  then you can set `strokes-minimum-match-score' to something that works  then you can set `strokes-minimum-match-score' to something that works
236  for you.  The only purpose of this variable is to insure that if you  for you.  The only purpose of this variable is to insure that if you
237  do a bogus stroke that really doesn't match any of the predefined  do a bogus stroke that really doesn't match any of the predefined
# Line 275  WARNING: Changing the value of this vari Line 261  WARNING: Changing the value of this vari
261    :type 'file    :type 'file
262    :group 'strokes)    :group 'strokes)
263    
264  (defcustom strokes-buffer-name " *strokes*"  (defvar strokes-buffer-name " *strokes*"
265    "The buffer that the strokes take place in (default is ` *strokes*')."    "The name of the buffer that the strokes take place in.")
   :type 'string  
   :group 'strokes)  
266    
267  (defcustom strokes-use-strokes-buffer t  (defcustom strokes-use-strokes-buffer t
268    "*If non-nil, the strokes buffer is used and strokes are displayed.    "*If non-nil, the strokes buffer is used and strokes are displayed.
# Line 288  the delay in switching to the strokes bu Line 272  the delay in switching to the strokes bu
272    :type 'boolean    :type 'boolean
273    :group 'strokes)    :group 'strokes)
274    
 (defcustom strokes-click-command 'mouse-yank-at-click  
   "*Command to execute when stroke is actually a `click' event.  
 This is set to `mouse-yank-at-click' by default."  
   :type 'function  
   :group 'strokes)  
   
275  ;;; internal variables...  ;;; internal variables...
276    
 ;; This is an internal variable, but we defcustom it so Customize can  
 ;; use it.  
 ;;;###autoload  
 (defcustom strokes-mode nil  
   "Non-nil when `strokes' is globally enabled.  
 Setting this variable directly does not take effect.  Use either Customize  
 or M-x strokes-mode."  
   :type 'boolean  
   :set (lambda (symbol value)  
          (strokes-mode (or value 0)))  
   :initialize 'custom-initialize-default  
   :require 'strokes  
   :version "21.1"  
   :group 'strokes)  
   
277  (defvar strokes-window-configuration nil  (defvar strokes-window-configuration nil
278    "The special window configuration used when entering strokes.    "The special window configuration used when entering strokes.
279  This is set properly in the function `strokes-update-window-configuration'.")  This is set properly in the function `strokes-update-window-configuration'.")
# Line 345  corresponding interactive function") Line 308  corresponding interactive function")
308    
309  ;;; Macros...  ;;; Macros...
310    
311  (defmacro strokes-while-inhibiting-garbage-collector (&rest forms)  ;; unused
312    "Execute FORMS without interference from the garbage collector."  ;; (defmacro strokes-while-inhibiting-garbage-collector (&rest forms)
313    `(let ((gc-cons-threshold 134217727))  ;;   "Execute FORMS without interference from the garbage collector."
314       ,@forms))  ;;   `(let ((gc-cons-threshold 134217727))
315    ;;      ,@forms))
316    
317  (defsubst strokes-click-p (stroke)  (defsubst strokes-click-p (stroke)
318    "Non-nil if STROKE is really click."    "Non-nil if STROKE is really click."
# Line 372  corresponding interactive function") Line 336  corresponding interactive function")
336  (defmacro strokes-define-stroke (stroke-map stroke def)  (defmacro strokes-define-stroke (stroke-map stroke def)
337    "Add STROKE to STROKE-MAP alist with given command DEF."    "Add STROKE to STROKE-MAP alist with given command DEF."
338    `(if (strokes-click-p ,stroke)    `(if (strokes-click-p ,stroke)
339         (error "That's a click, not a stroke; see `strokes-click-command'")         (error "That's a click, not a stroke")
340       (setq ,stroke-map (cons (cons ,stroke ,def)       (setq ,stroke-map (cons (cons ,stroke ,def)
341                               (strokes-remassoc ,stroke ,stroke-map)))))                               (strokes-remassoc ,stroke ,stroke-map)))))
342    
 (defalias 'define-stroke 'strokes-define-stroke)  
   
343  (defsubst strokes-square (x)  (defsubst strokes-square (x)
344    "Returns the square of the number X"    "Return the square of the number X."
345    (* x x))    (* x x))
346    
347  (defsubst strokes-distance-squared (p1 p2)  (defsubst strokes-distance-squared (p1 p2)
# Line 392  P1 and P2 are cons cells in the form (X Line 354  P1 and P2 are cons cells in the form (X
354      (+ (strokes-square (- x2 x1))      (+ (strokes-square (- x2 x1))
355         (strokes-square (- y2 y1)))))         (strokes-square (- y2 y1)))))
356    
 ;;; Advice for various functions...  
   
 ;; I'd originally wanted to write a macro that would just take in the  
 ;; generic functions which use mouse button2 in various modes.  Most of  
 ;; them are identical in form: they take an event as the single argument  
 ;; and then do their thing.  I tried writing a macro that looked  
 ;; something like this, but failed.  Advice just ain't that easy.  The  
 ;; one that bugged me the most was `Manual-follow-xref', because that had  
 ;; &rest arguments, and I didn't know how to work around it in defadvice.  
 ;; However, I was able to fix up most of the important modes (i.e. the  
 ;; ones I use all the time).  One `bug' in the program that I just can't  
 ;; seem to figure out is why I can only advise other button2 functions  
 ;; successfully when the variable `strokes-use-strokes-buffer' is nil.  I  
 ;; did all the save-excursion/save-window-excursion stuff SPECIFICALLY so  
 ;; that using the strokes buffer or not would absolutely not affect any  
 ;; other part of the program.  If someone can figure out how to make the  
 ;; following advices work w/ regardless of that variable  
 ;; `strokes-use-strokes-buffer', then that would be a great victory.  If  
 ;; someone out there would be kind enough to make the commented code  
 ;; below work, I'd be grateful.  By the way, I put the `protect' keywords  
 ;; there to insure that if a stroke went bad, then  
 ;; `strokes-click-command' would be set back.  If this isn't necessary,  
 ;; then feel free to let me know.  
   
 ;; For what follows, I really wanted something that would work like this:  
   
 ;;(strokes-fix-button2 'vm-mouse-button-2)  
   
 ;; Or even better, I could have simply done something like:  
   
 ;;(mapcar 'strokes-fix-button2  
 ;;        '(vm-mouse-button-2  
 ;;          rmail-summary-mouse-goto-msg  
 ;;          <rest of them>))  
   
 ;;; With help from Hans (author of advice.el)...  
 (defmacro strokes-fix-button2-command (command)  
   "Fix COMMAND so that it can also work with strokes.  
 COMMAND must take one event argument.  
 Example of how one might fix up a command that's bound to button2  
 and which is an interactive funcion of one event argument:  
   
 \(strokes-fix-button2-command 'rmail-summary-mouse-goto-msg)"  
   (let ((command (eval command)))  
     `(progn  
        (defadvice ,command (around strokes-fix-button2 compile preactivate)  
          ,(format "Fix %s to work with strokes." command)  
          (let ((strokes-click-command  
                   ',(intern (format "ad-Orig-%s" command))))  
              (strokes-do-stroke (ad-get-arg 0)))))))  
   
 (defvar strokes-insinuated nil)  
   
 (defun strokes-insinuate ()  
   "Insinuate Emacs with strokes advices."  
   (unless strokes-insinuated  
     (strokes-fix-button2-command 'vm-mouse-button-2)  
     (strokes-fix-button2-command 'rmail-summary-mouse-goto-msg)  
     (strokes-fix-button2-command 'Buffer-menu-mouse-select)  
     (strokes-fix-button2-command 'w3-widget-button-click)  
     (strokes-fix-button2-command 'widget-image-button-press)  
     (strokes-fix-button2-command 'Info-follow-clicked-node)  
     (strokes-fix-button2-command 'compile-mouse-goto-error)  
     (strokes-fix-button2-command 'gdbsrc-select-or-yank)  
     (strokes-fix-button2-command 'hypropos-mouse-get-doc)  
     (strokes-fix-button2-command 'gnus-mouse-pick-group)  
     (strokes-fix-button2-command 'gnus-mouse-pick-article)  
     (strokes-fix-button2-command 'gnus-article-push-button)  
     (strokes-fix-button2-command 'dired-mouse-find-file)  
     (strokes-fix-button2-command 'url-dired-find-file-mouse)  
     (strokes-fix-button2-command 'dired-u-r-mouse-toggle)  
     (strokes-fix-button2-command 'dired-u-w-mouse-toggle)  
     (strokes-fix-button2-command 'dired-u-x-mouse-toggle)  
     (strokes-fix-button2-command 'dired-g-r-mouse-toggle)  
     (strokes-fix-button2-command 'dired-g-w-mouse-toggle)  
     (strokes-fix-button2-command 'dired-g-x-mouse-toggle)  
     (strokes-fix-button2-command 'dired-o-r-mouse-toggle)  
     (strokes-fix-button2-command 'dired-o-w-mouse-toggle)  
     (strokes-fix-button2-command 'isearch-yank-x-selection)  
     (strokes-fix-button2-command 'occur-mode-mouse-goto)  
     (strokes-fix-button2-command 'cvs-mouse-find-file)  
     (setq strokes-insinuated t)))  
   
 ;;; I can fix the customize widget button click, but then  
 ;;; people will get confused when they try to customize  
 ;;; strokes with the mouse and customize tells them that  
 ;;; `strokes-click-command' is mapped to `ad-Orig-widget-button-click'  
 ;;(strokes-fix-button2-command 'widget-button-click)  
   
 ;;; without the advice, each advised function would look like...  
 ;;(defadvice vm-mouse-button-2 (around vm-strokes activate protect)  
 ;;  "Allow strokes to work in VM."  
 ;;  (if strokes-use-strokes-buffer  
 ;;      ;; then strokes is no good and we'll have to use the original  
 ;;      ad-do-it  
 ;;    ;; otherwise, we can make strokes work too...  
 ;;    (let ((strokes-click-command 'ad-Orig-vm-mouse-button-2))  
 ;;      (strokes-do-stroke (ad-get-arg 0)))))  
   
357  ;;; Functions...  ;;; Functions...
358    
359  (defsubst strokes-mouse-event-p (event)  (defsubst strokes-mouse-event-p (event)
# Line 526  If LINE is nil, return the last position Line 389  If LINE is nil, return the last position
389  (defun strokes-event-closest-point (event &optional start-window)  (defun strokes-event-closest-point (event &optional start-window)
390    "Return the nearest position to where EVENT ended its motion.    "Return the nearest position to where EVENT ended its motion.
391  This is computed for the window where EVENT's motion started,  This is computed for the window where EVENT's motion started,
392  or for window WINDOW if that is specified."  or for window START-WINDOW if that is specified."
393    (or start-window (setq start-window (posn-window (event-start event))))    (or start-window (setq start-window (posn-window (event-start event))))
394    (if (eq start-window (posn-window (event-end event)))    (if (eq start-window (posn-window (event-end event)))
395        (if (eq (posn-point (event-end event)) 'vertical-line)        (if (eq (posn-point (event-end event)) 'vertical-line)
# Line 557  or for window WINDOW if that is specifie Line 420  or for window WINDOW if that is specifie
420    (interactive)    (interactive)
421    (let ((command (cdar strokes-global-map)))    (let ((command (cdar strokes-global-map)))
422      (if (y-or-n-p      (if (y-or-n-p
423           (format "really delete last stroke definition, defined to `%s'? "           (format "Really delete last stroke definition, defined to `%s'? "
424                   command))                   command))
425          (progn          (progn
426            (setq strokes-global-map (cdr strokes-global-map))            (setq strokes-global-map (cdr strokes-global-map))
# Line 575  documentation for the `strokes-define-st Line 438  documentation for the `strokes-define-st
438     (list     (list
439      (and (or strokes-mode (strokes-mode t))      (and (or strokes-mode (strokes-mode t))
440           (strokes-read-complex-stroke           (strokes-read-complex-stroke
441            "Define a new stroke.  Draw with button1 (or 2).  End with button3..."))            "Draw with mouse button 1 (or 2).  End with button 3..."))
442      (read-command "command to map stroke to: ")))      (read-command "Command to map stroke to: ")))
443    (strokes-define-stroke strokes-global-map stroke command))    (strokes-define-stroke strokes-global-map stroke command))
444    
 ;;;###autoload  
 (defalias 'global-set-stroke 'strokes-global-set-stroke)  
   
445  ;;(defun global-unset-stroke (stroke); FINISH THIS DEFUN!  ;;(defun global-unset-stroke (stroke); FINISH THIS DEFUN!
446  ;;  "delete all strokes matching STROKE from `strokes-global-map',  ;;  "delete all strokes matching STROKE from `strokes-global-map',
447  ;; letting the user input  ;; letting the user input
# Line 592  documentation for the `strokes-define-st Line 452  documentation for the `strokes-define-st
452  ;;  (strokes-define-stroke 'strokes-global-map stroke command))  ;;  (strokes-define-stroke 'strokes-global-map stroke command))
453    
454  (defun strokes-get-grid-position (stroke-extent position &optional grid-resolution)  (defun strokes-get-grid-position (stroke-extent position &optional grid-resolution)
455    "Map POSITION to a new grid position based on its STROKE-EXTENT and GRID-RESOLUTION.    "Map POSITION to a new grid position.
456    Do so  based on its STROKE-EXTENT and GRID-RESOLUTION.
457  STROKE-EXTENT as a list \(\(XMIN . YMIN\) \(XMAX . YMAX\)\).  STROKE-EXTENT as a list \(\(XMIN . YMIN\) \(XMAX . YMAX\)\).
458  If POSITION is a `strokes-lift', then it is itself returned.  If POSITION is a `strokes-lift', then it is itself returned.
459  Optional GRID-RESOLUTION may be used in place of STROKES-GRID-RESOLUTION.  Optional GRID-RESOLUTION may be used in place of STROKES-GRID-RESOLUTION.
460  The grid is a square whose dimesion is [0,GRID-RESOLUTION)."  The grid is a square whose dimension is [0,GRID-RESOLUTION)."
461    (cond ((consp position)               ; actual pixel location    (cond ((consp position)               ; actual pixel location
462           (let ((grid-resolution (or grid-resolution strokes-grid-resolution))           (let ((grid-resolution (or grid-resolution strokes-grid-resolution))
463                 (x (car position))                 (x (car position))
# Line 617  The grid is a square whose dimesion is [ Line 478  The grid is a square whose dimesion is [
478           strokes-lift)))           strokes-lift)))
479    
480  (defun strokes-get-stroke-extent (pixel-positions)  (defun strokes-get-stroke-extent (pixel-positions)
481    "From a list of absolute PIXEL-POSITIONS, returns absolute spatial extent.    "From a list of absolute PIXEL-POSITIONS, return absolute spatial extent.
482  The return value is a list ((XMIN . YMIN) (XMAX . YMAX))."  The return value is a list ((XMIN . YMIN) (XMAX . YMAX))."
483    (if pixel-positions    (if pixel-positions
484        (let ((xmin (caar pixel-positions))        (let ((xmin (caar pixel-positions))
# Line 658  The return value is a list ((XMIN . YMIN Line 519  The return value is a list ((XMIN . YMIN
519      nil))      nil))
520    
521  (defun strokes-eliminate-consecutive-redundancies (entries)  (defun strokes-eliminate-consecutive-redundancies (entries)
522    "Returns a list with no consecutive redundant entries."    "Return a list with no consecutive redundant entries."
523    ;; defun a grande vitesse grace a Dave G.    ;; defun a grande vitesse grace a Dave G.
524    (loop for element on entries    (loop for element on entries
525          if (not (equal (car element) (cadr element)))          if (not (equal (car element) (cadr element)))
# Line 686  The return value is a list ((XMIN . YMIN Line 547  The return value is a list ((XMIN . YMIN
547    "Map POSITIONS to a new grid whose dimensions are based on GRID-RESOLUTION.    "Map POSITIONS to a new grid whose dimensions are based on GRID-RESOLUTION.
548  POSITIONS is a list of positions and stroke-lifts.  POSITIONS is a list of positions and stroke-lifts.
549  Optional GRID-RESOLUTION may be used in place of STROKES-GRID-RESOLUTION.  Optional GRID-RESOLUTION may be used in place of STROKES-GRID-RESOLUTION.
550  The grid is a square whose dimesion is [0,GRID-RESOLUTION)."  The grid is a square whose dimension is [0,GRID-RESOLUTION)."
551    (or grid-resolution (setq grid-resolution strokes-grid-resolution))    (or grid-resolution (setq grid-resolution strokes-grid-resolution))
552    (let ((stroke-extent (strokes-get-stroke-extent positions)))    (let ((stroke-extent (strokes-get-stroke-extent positions)))
553      (mapcar (function      (mapcar (function
# Line 728  NOTE: This is where the global variable Line 589  NOTE: This is where the global variable
589                                                delta-x)))))                                                delta-x)))))
590                          (cond ((not both-are-points-p)                          (cond ((not both-are-points-p)
591                                 (list current))                                 (list current))
592                                ((null slope) ; undefinded vertical slope                                ((null slope) ; undefined vertical slope
593                                 (if (>= delta-y 0)                                 (if (>= delta-y 0)
594                                     (loop for y from y1 below y2                                     (loop for y from y1 below y2
595                                           collect (cons x1 y))                                           collect (cons x1 y))
# Line 766  NOTE: This is where the global variable Line 627  NOTE: This is where the global variable
627                                                       y))))))))))                                                       y))))))))))
628    
629  (defun strokes-rate-stroke (stroke1 stroke2)  (defun strokes-rate-stroke (stroke1 stroke2)
630    "Rates STROKE1 with STROKE2 and returns a score based on a distance metric.    "Rates STROKE1 with STROKE2 and return a score based on a distance metric.
631  Note: the rating is an error rating, and therefore, a return of 0  Note: the rating is an error rating, and therefore, a return of 0
632  represents a perfect match.  Also note that the order of stroke  represents a perfect match.  Also note that the order of stroke
633  arguments is order-independent for the algorithm used here."  arguments is order-independent for the algorithm used here."
# Line 820  arguments is order-independent for the a Line 681  arguments is order-independent for the a
681      nil))      nil))
682    
683  (defun strokes-match-stroke (stroke stroke-map)  (defun strokes-match-stroke (stroke stroke-map)
684    "Finds the best matching command of STROKE in STROKE-MAP.    "Find the best matching command of STROKE in STROKE-MAP.
685  Returns the corresponding match as (COMMAND . SCORE)."  Returns the corresponding match as (COMMAND . SCORE)."
686    (if (and stroke stroke-map)    (if (and stroke stroke-map)
687        (let ((score (strokes-rate-stroke stroke (caar stroke-map)))        (let ((score (strokes-rate-stroke stroke (caar stroke-map)))
# Line 871  Optional EVENT is acceptable as the star Line 732  Optional EVENT is acceptable as the star
732                                ;; we can draw that point                                ;; we can draw that point
733                                (progn                                (progn
734                                  (goto-char point)                                  (goto-char point)
735                                  (subst-char-in-region point (1+ point) ?\  strokes-character))                                  (subst-char-in-region point (1+ point)
736                                                          ?\  strokes-character))
737                              ;; otherwise, we can start drawing the next time...                              ;; otherwise, we can start drawing the next time...
738                              (setq safe-to-draw-p t))                              (setq safe-to-draw-p t))
739                            (push (cdr (mouse-pixel-position))                            (push (cdr (mouse-pixel-position))
# Line 880  Optional EVENT is acceptable as the star Line 742  Optional EVENT is acceptable as the star
742              ;; protected              ;; protected
743              ;; clean up strokes buffer and then bury it.              ;; clean up strokes buffer and then bury it.
744              (when (equal (buffer-name) strokes-buffer-name)              (when (equal (buffer-name) strokes-buffer-name)
745                (subst-char-in-region (point-min) (point-max) strokes-character ?\ )                (subst-char-in-region (point-min) (point-max)
746                                        strokes-character ?\ )
747                (goto-char (point-min))                (goto-char (point-min))
748                (bury-buffer))))                (bury-buffer))))
749        ;; Otherwise, don't use strokes buffer and read stroke silently        ;; Otherwise, don't use strokes buffer and read stroke silently
# Line 897  Optional EVENT is acceptable as the star Line 760  Optional EVENT is acceptable as the star
760                      pix-locs))                      pix-locs))
761            (setq event (read-event))))            (setq event (read-event))))
762        (setq grid-locs (strokes-renormalize-to-grid (nreverse pix-locs)))        (setq grid-locs (strokes-renormalize-to-grid (nreverse pix-locs)))
763        (strokes-fill-stroke (strokes-eliminate-consecutive-redundancies grid-locs)))))        (strokes-fill-stroke
764           (strokes-eliminate-consecutive-redundancies grid-locs)))))
765    
766  ;;;###autoload  ;;;###autoload
767  (defun strokes-read-complex-stroke (&optional prompt event)  (defun strokes-read-complex-stroke (&optional prompt event)
768    "Read a complex stroke (interactively) and return the stroke.    "Read a complex stroke (interactively) and return the stroke.
769  Optional PROMPT in minibuffer displays before and during stroke reading.  Optional PROMPT in minibuffer displays before and during stroke reading.
770  Note that a complex stroke allows the user to pen-up and pen-down.  This  Note that a complex stroke allows the user to pen-up and pen-down.  This
771  is implemented by allowing the user to paint with button1 or button2 and  is implemented by allowing the user to paint with button 1 or button 2 and
772  then complete the stroke with button3.  then complete the stroke with button 3.
773  Optional EVENT is acceptable as the starting event of the stroke"  Optional EVENT is acceptable as the starting event of the stroke"
774    (save-excursion    (save-excursion
775      (save-window-excursion      (save-window-excursion
# Line 928  Optional EVENT is acceptable as the star Line 792  Optional EVENT is acceptable as the star
792                        (let ((point (strokes-event-closest-point event)))                        (let ((point (strokes-event-closest-point event)))
793                          (when point                          (when point
794                            (goto-char point)                            (goto-char point)
795                            (subst-char-in-region point (1+ point) ?\ strokes-character))                            (subst-char-in-region point (1+ point)
796                                                    ?\  strokes-character))
797                          (push (cdr (mouse-pixel-position))                          (push (cdr (mouse-pixel-position))
798                                pix-locs)))                                pix-locs)))
799                    (setq event (read-event)))                    (setq event (read-event)))
# Line 945  Optional EVENT is acceptable as the star Line 810  Optional EVENT is acceptable as the star
810                 (strokes-eliminate-consecutive-redundancies grid-locs)))                 (strokes-eliminate-consecutive-redundancies grid-locs)))
811            ;; protected            ;; protected
812            (when (equal (buffer-name) strokes-buffer-name)            (when (equal (buffer-name) strokes-buffer-name)
813              (subst-char-in-region (point-min) (point-max) strokes-character ?\ )              (subst-char-in-region (point-min) (point-max)
814                                      strokes-character ?\ )
815              (goto-char (point-min))              (goto-char (point-min))
816              (bury-buffer)))))))              (bury-buffer)))))))
817    
# Line 957  If no stroke matches, nothing is done an Line 823  If no stroke matches, nothing is done an
823    (let* ((match (strokes-match-stroke stroke strokes-global-map))    (let* ((match (strokes-match-stroke stroke strokes-global-map))
824           (command (car match))           (command (car match))
825           (score (cdr match)))           (score (cdr match)))
826      (cond ((strokes-click-p stroke)      (cond ((and match (<= score strokes-minimum-match-score))
            ;; This is the case of a `click' type event.  
            ;; The `sit-for' is a minor frob that has to do with timing  
            ;; problems.  Without the `sit-for', mouse-yank will not  
            ;; yank at the proper location if the user opted for  
            ;; mouse-yank-at-point to be nil (i.e. mouse-yank takes  
            ;; place at pointer position).  The sit-for tells redisplay  
            ;; to be sure to wait for the `*strokes*' buffer to vanish  
            ;; from consideration when deciding on a point to be used  
            ;; for mouse-yank.  
            (sit-for 0)  
            (command-execute strokes-click-command))  
           ((and match (<= score strokes-minimum-match-score))  
827             (message "%s" command)             (message "%s" command)
828             (command-execute command))             (command-execute command))
829            ((null strokes-global-map)            ((null strokes-global-map)
# Line 978  If no stroke matches, nothing is done an Line 832  If no stroke matches, nothing is done an
832                       (format "No strokes loaded.  Load `%s'? "                       (format "No strokes loaded.  Load `%s'? "
833                               strokes-file))                               strokes-file))
834                      (strokes-load-user-strokes))                      (strokes-load-user-strokes))
835               (error "No strokes defined; use `global-set-stroke'")))               (error "No strokes defined; use `strokes-global-set-stroke'")))
836            (t            (t
837             (error             (error
838              "No stroke matches; see variable `strokes-minimum-match-score'")              "No stroke matches; see variable `strokes-minimum-match-score'")
# Line 1006  This must be bound to a mouse event." Line 860  This must be bound to a mouse event."
860    (interactive    (interactive
861     (list     (list
862      (strokes-read-complex-stroke      (strokes-read-complex-stroke
863       "Enter stroke to describe; end with button3...")))       "Enter stroke to describe; end with button 3...")))
864    (let* ((match (strokes-match-stroke stroke strokes-global-map))    (let* ((match (strokes-match-stroke stroke strokes-global-map))
865           (command (or (and (strokes-click-p stroke)           (command (car match))
                            strokes-click-command)  
                       (car match)))  
866           (score (cdr match)))           (score (cdr match)))
867      (if (or (and match      (if (and match
868                   (<= score strokes-minimum-match-score))               (<= score strokes-minimum-match-score))
             (and (strokes-click-p stroke)  
                  strokes-click-command))  
869          (message "That stroke maps to `%s'" command)          (message "That stroke maps to `%s'" command)
870        (message "That stroke is undefined"))        (message "That stroke is undefined"))
871      (sleep-for 1)))                     ; helpful for recursive edits      (sleep-for 1)))                     ; helpful for recursive edits
872    
873  ;;;###autoload  ;;;###autoload
 (defalias 'describe-stroke 'strokes-describe-stroke)  
   
 ;;;###autoload  
874  (defun strokes-help ()  (defun strokes-help ()
875    "Get instructional help on using the `strokes' package."    "Get instruction on using the `strokes' package."
876    (interactive)    (interactive)
877    (let ((helpdoc    (with-output-to-temp-buffer "*Help with Strokes*"
878           "This is help for the strokes package.      (princ
879         "This is help for the strokes package.
 If you find something wrong with strokes, or feel that it can be  
 improved in some way, then please feel free to email me:  
   
 David Bakhash <cadet@mit.edu>  
   
 or just do  
   
 M-x strokes-report-bug  
880    
881  ------------------------------------------------------------  ------------------------------------------------------------
882    
# Line 1051  right every time. Line 890  right every time.
890    
891  Strokes also allows you to compose documents graphically.  You can  Strokes also allows you to compose documents graphically.  You can
892  fully edit documents in Chinese, Japanese, etc. based on Emacs  fully edit documents in Chinese, Japanese, etc. based on Emacs
893  strokes.  Once you've done so, you can ascii compress-and-encode them  strokes.  Once you've done so, you can ASCII compress-and-encode them
894  and then safely save them for later use, send letters to friends  and then safely save them for later use, send letters to friends
895  \(using Emacs, of course).  Strokes will later decode these documents,  \(using Emacs, of course).  Strokes will later decode these documents,
896  extracting the strokes for editing use once again, so the editing  extracting the strokes for editing use once again, so the editing
# Line 1072  To toggle strokes-mode, you just do Line 911  To toggle strokes-mode, you just do
911    
912  When you're ready to start defining strokes, just use the command  When you're ready to start defining strokes, just use the command
913    
914  > M-x global-set-stroke  > M-x strokes-global-set-stroke
915    
916  You will see a ` *strokes*' buffer which is waiting for you to enter in  You will see a ` *strokes*' buffer which is waiting for you to enter in
917  your stroke.  When you enter in the stroke, you draw with button1 or  your stroke.  When you enter in the stroke, you draw with button 1 or
918  button2, and then end with button3.  Next, you enter in the command  button 2, and then end with button 3.  Next, you enter in the command
919  which will be executed when that stroke is invoked.  Simple as that.  which will be executed when that stroke is invoked.  Simple as that.
920  For now, try to define a stroke to copy a region.  This is a popular  For now, try to define a stroke to copy a region.  This is a popular
921  edit command, so type  edit command, so type
922    
923  > M-x global-set-stroke  > M-x strokes-global-set-stroke
924    
925  Then, in the ` *strokes*' buffer, draw the letter `C' (for `copy')  Then, in the ` *strokes*' buffer, draw the letter `C' (for `copy')
926  and then, when it asks you to enter the command to map that to, type  and then, when it asks you to enter the command to map that to, type
# Line 1089  and then, when it asks you to enter the Line 928  and then, when it asks you to enter the
928  > copy-region-as-kill  > copy-region-as-kill
929    
930  That's about as hard as it gets.  That's about as hard as it gets.
931  Remember: paint with button1 or button2 and then end with button3.  Remember: paint with button 1 or button 2 and then end with button 3.
932    
933  If ever you want to know what a certain strokes maps to, then do  If ever you want to know what a certain strokes maps to, then do
934    
935  > M-x describe-stroke  > M-x strokes-describe-stroke
936    
937  and you can enter in any arbitrary stroke.  Remember: The strokes  and you can enter in any arbitrary stroke.  Remember: The strokes
938  package lets you program in simple and complex (multi-lift) strokes.  package lets you program in simple and complex (multi-lift) strokes.
939  The only difference is how you *invoke* the two.  You will most likely  The only difference is how you *invoke* the two.  You will most likely
940  use simple strokes, as complex strokes were developed for  use simple strokes, as complex strokes were developed for
941  Chinese/Japanese/Korean.  So the middle mouse button (mouse-2) will  Chinese/Japanese/Korean.  So the shifted middle mouse button (S-mouse-2) will
942  invoke the command `strokes-do-stroke' in buffers where button2 doesn't  invoke the command `strokes-do-stroke'.
 already have a meaning other than its original, which is `mouse-yank'.  
 But don't worry: `mouse-yank' will still work with strokes.  See the  
 variable `strokes-click-command'.  
943    
944  If ever you define a stroke which you don't like, then you can unset  If ever you define a stroke which you don't like, then you can unset
945  it with the command  it with the command
# Line 1130  You can change this location by setting Line 966  You can change this location by setting
966  You will be prompted to save them when you exit Emacs, or you can save  You will be prompted to save them when you exit Emacs, or you can save
967  them with  them with
968    
969  > M-x save-strokes  > M-x strokes-save-strokes
970    
971  Your strokes get loaded automatically when you enable `strokes-mode'.  Your strokes get loaded automatically when you enable `strokes-mode'.
972  You can also load in your user-defined strokes with  You can also load in your user-defined strokes with
973    
974  > M-x load-user-strokes  > M-x strokes-load-user-strokes
975    
976  ** Strokes for pictographic editing...  ** Strokes for pictographic editing...
977    
978  If you'd like to create graphical files with strokes, you'll have to  If you'd like to create graphical files with strokes, you'll have to
979  be running a version of Emacs with XPM support.  You use the  be running a version of Emacs with XPM support.  You use the binding
980  binding C-mouse-2 to start drawing your strokes.  These are just  to `strokes-compose-complex-stroke' to start drawing your strokes.
981  complex strokes, and thus you continue drawing with mouse-1 or mouse-2 and  These are just complex strokes, and thus continue drawing with mouse-1
982  end with mouse-3-3.  Then the stroke image gets inserted into the  or mouse-2 and end with mouse-3.  Then the stroke image gets inserted
983  buffer.  You treat it like any other character, which you can copy,  into the buffer.  You treat it somewhat like any other character,
984  paste, delete, move, etc.  The command which is bound to C-mouse-2 is  which you can copy, paste, delete, move, etc.  When all is done, you
985  called `strokes-compose-complex-stroke'.  When all is done, you may  may want to send the file, or save it.  This is done with
 want to send the file, or save it.  This is done with  
986    
987  > M-x strokes-encode-buffer  > M-x strokes-encode-buffer
988    
# Line 1164  o The command `strokes-do-complex-stroke Line 999  o The command `strokes-do-complex-stroke
999  o Strokes are a bit computer-dependent in that they depend somewhat on  o Strokes are a bit computer-dependent in that they depend somewhat on
1000    the speed of the computer you're working on.  This means that you    the speed of the computer you're working on.  This means that you
1001    may have to tweak some variables.  You can read about them in the    may have to tweak some variables.  You can read about them in the
1002    commentary of `strokes.el'.  Better to just use apropos and read their    commentary of `strokes.el'.  Better to just use \\[apropos] and read their
1003    docstrings.  All variables/functions start with `strokes'.  The one    docstrings.  All variables/functions start with `strokes'.  The one
1004    variable which many people wanted to see was    variable which many people wanted to see was
1005    `strokes-use-strokes-buffer' which allows the user to use strokes    `strokes-use-strokes-buffer' which allows the user to use strokes
1006    silently--without displaying the strokes.  All variables can be set    silently--without displaying the strokes.  All variables can be set
1007    by customizing the group named `strokes' via the customization package:    by customizing the group `strokes' via \[customize-group].")
1008        (set-buffer standard-output)
1009        (help-mode)
1010        (print-help-return-message)))
1011    
1012    > M-x customize"))  (defalias 'strokes-report-bug 'report-emacs-bug)
     (with-output-to-temp-buffer "*Help with Strokes*"  
       (princ helpdoc)  
       (set-buffer standard-output)  
       (help-mode)  
       (print-help-return-message))))  
   
 (defun strokes-report-bug ()  
   "Submit a bug report for strokes."  
   (interactive)  
   (let ((reporter-prompt-for-summary-p t))  
     (reporter-submit-bug-report  
      strokes-bug-address "Strokes"  
      (cons  
       'strokes-version  
       (nconc  
        (mapcar  
         'intern  
         (sort  
          (let (completion-ignore-case)  
            (all-completions "strokes-" obarray 'user-variable-p))  
          'string-lessp))  
        (list 'reporter-version)))  
      (function  
       (lambda ()  
         (save-excursion  
           (mail-position-on-field "subject")  
           (beginning-of-line)  
           (skip-chars-forward "^:\n")  
           (if (looking-at ": Strokes;")  
               (progn  
                 (goto-char (match-end 0))  
                 (delete-char -1)  
                 (insert " " strokes-version " bug:")))))))))  
1013    
1014  (defsubst strokes-fill-current-buffer-with-whitespace ()  (defsubst strokes-fill-current-buffer-with-whitespace ()
1015    "Erase the contents of the current buffer and fill it with whitespace."    "Erase the contents of the current buffer and fill it with whitespace."
# Line 1216  o Strokes are a bit computer-dependent i Line 1021  o Strokes are a bit computer-dependent i
1021    
1022  (defun strokes-window-configuration-changed-p ()  (defun strokes-window-configuration-changed-p ()
1023    "Non-nil if the `strokes-window-configuration' frame properties changed.    "Non-nil if the `strokes-window-configuration' frame properties changed.
1024  This is based on the last time the `strokes-window-configuration was updated."  This is based on the last time `strokes-window-configuration' was updated."
1025    (compare-window-configurations (current-window-configuration)    (compare-window-configurations (current-window-configuration)
1026                                   strokes-window-configuration))                                   strokes-window-configuration))
1027    
# Line 1271  This is based on the last time the `stro Line 1076  This is based on the last time the `stro
1076          (t          (t
1077           (message "No user-defined strokes, sorry"))))           (message "No user-defined strokes, sorry"))))
1078    
 ;;;###autoload  
 (defalias 'load-user-strokes 'strokes-load-user-strokes)  
   
1079  (defun strokes-prompt-user-save-strokes ()  (defun strokes-prompt-user-save-strokes ()
1080    "Save user-defined strokes to file named by `strokes-file'."    "Save user-defined strokes to file named by `strokes-file'."
1081    (interactive)    (interactive)
# Line 1295  This is based on the last time the `stro Line 1097  This is based on the last time the `stro
1097                    (emacs-lisp-mode)                    (emacs-lisp-mode)
1098                    (goto-char (point-min))                    (goto-char (point-min))
1099                    (insert                    (insert
1100                     ";;   -*- Syntax: Emacs-Lisp; Mode: emacs-lisp -*-\n")                     ";;   -*- emacs-lisp -*-\n")
1101                    (insert (format ";;; saved strokes for %s, as of %s\n\n"                    (insert (format ";;; saved strokes for %s, as of %s\n\n"
1102                                    (user-full-name)                                    (user-full-name)
1103                                    (format-time-string "%B %e, %Y" nil)))                                    (format-time-string "%B %e, %Y" nil)))
1104                    (message "Saving strokes in %s..." strokes-file)                    (message "Saving strokes in %s..." strokes-file)
1105                    (insert (format "(setq strokes-global-map '%s)"                    (insert (format "(setq strokes-global-map\n'%s)"
1106                                    (pp current)))                                    (pp current)))
1107                    (message "Saving strokes in %s..." strokes-file)                    (message "Saving strokes in %s..." strokes-file)
1108                    (indent-region (point-min) (point-max) nil)                    (indent-region (point-min) (point-max) nil)
# Line 1313  This is based on the last time the `stro Line 1115  This is based on the last time the `stro
1115              (kill-buffer (get-buffer "*saved-strokes*")))              (kill-buffer (get-buffer "*saved-strokes*")))
1116          (setq strokes-global-map current)))))          (setq strokes-global-map current)))))
1117    
 (defalias 'save-strokes 'strokes-prompt-user-save-strokes)  
   
1118  (defun strokes-toggle-strokes-buffer (&optional arg)  (defun strokes-toggle-strokes-buffer (&optional arg)
1119    "Toggle the use of the strokes buffer.    "Toggle the use of the strokes buffer.
1120  In other words, toggle the variabe `strokes-use-strokes-buffer'.  In other words, toggle the variable `strokes-use-strokes-buffer'.
1121  With ARG, use strokes buffer if and only if ARG is positive or true.  With ARG, use strokes buffer if and only if ARG is positive or true.
1122  Returns value of `strokes-use-strokes-buffer'."  Returns value of `strokes-use-strokes-buffer'."
1123    (interactive "P")    (interactive "P")
# Line 1326  Returns value of `strokes-use-strokes-bu Line 1126  Returns value of `strokes-use-strokes-bu
1126            (not strokes-use-strokes-buffer))))            (not strokes-use-strokes-buffer))))
1127    
1128  (defun strokes-xpm-for-stroke (&optional stroke bufname b/w-only)  (defun strokes-xpm-for-stroke (&optional stroke bufname b/w-only)
1129    "Create an xpm pixmap for the given STROKE in buffer ` *strokes-xpm*'.    "Create an XPM pixmap for the given STROKE in buffer ` *strokes-xpm*'.
1130  If STROKE is not supplied, then `strokes-last-stroke' will be used.  If STROKE is not supplied, then `strokes-last-stroke' will be used.
1131  Optional BUFNAME to name something else.  Optional BUFNAME to name something else.
1132  The pixmap will contain time information via rainbow dot colors  The pixmap will contain time information via rainbow dot colors
# Line 1366  the stroke as a character in some langua Line 1166  the stroke as a character in some langua
1166                         (let ((char (or (car rainbow-chars) ?\.)))                         (let ((char (or (car rainbow-chars) ?\.)))
1167                           (loop for i from 0 to 2 do                           (loop for i from 0 to 2 do
1168                                 (loop for j from 0 to 2 do                                 (loop for j from 0 to 2 do
1169                                       (goto-line (+ 16 i y))                                           (goto-line (+ 16 i y))
1170                                       (forward-char (+ 1 j x))                                       (forward-char (+ 1 j x))
1171                                       (delete-char 1)                                       (delete-char 1)
1172                                       (insert char)))                                       (insert char)))
1173                           (setq rainbow-chars (cdr rainbow-chars)                           (setq rainbow-chars (cdr rainbow-chars)
1174                                 lift-flag nil))                                 lift-flag nil))
1175                       ;; Otherwise, just plot the point...                       ;; Otherwise, just plot the point...
1176                       (goto-line (+ 17 y))                             (goto-line (+ 17 y))
1177                       (forward-char (+ 2 x))                           (forward-char (+ 2 x))
1178                       (subst-char-in-region (point) (1+ (point)) ?\  ?\*)))                       (subst-char-in-region (point) (1+ (point)) ?\  ?\*)))
1179                    ((strokes-lift-p point)                    ((strokes-lift-p point)
1180                     ;; a lift--tell the loop to X out the next point...                     ;; a lift--tell the loop to X out the next point...
# Line 1386  the stroke as a character in some langua Line 1186  the stroke as a character in some langua
1186          (put-image (create-image (buffer-string) 'xpm t :ascent 100)          (put-image (create-image (buffer-string) 'xpm t :ascent 100)
1187                     (line-end-position))))))                     (line-end-position))))))
1188    
1189  ;;; Strokes Edit stuff... ### NOT IMLEMENTED YET ###  ;;; Strokes Edit stuff... ### NOT IMPLEMENTED YET ###
1190    
1191  ;;(defun strokes-edit-quit ()  ;;(defun strokes-edit-quit ()
1192  ;;  (interactive)  ;;  (interactive)
# Line 1545  If STROKES-MAP is not given, `strokes-gl Line 1345  If STROKES-MAP is not given, `strokes-gl
1345          (command-name-2 (symbol-name (cdr stroke2))))          (command-name-2 (symbol-name (cdr stroke2))))
1346      (string-lessp command-name-1 command-name-2)))      (string-lessp command-name-1 command-name-2)))
1347    
1348  ;;;###autoload  (defvar strokes-mode-map
1349  (defun strokes-mode (&optional arg)    (let ((map (make-sparse-keymap)))
1350    "Toggle strokes being enabled.      (define-key map [(shift down-mouse-2)] 'strokes-do-stroke)
1351  With ARG, turn strokes on if and only if ARG is positive or true.      (define-key map [(meta down-mouse-2)] 'strokes-do-complex-stroke)
1352  Note that `strokes-mode' is a global mode.  Think of it as a minor      map))
 mode in all buffers when activated.  
 By default, strokes are invoked with mouse button-2.  You can define  
 new strokes with  
1353    
1354  > M-x global-set-stroke  ;;;###autoload
1355    (define-minor-mode strokes-mode
1356      "Toggle Strokes global minor mode.\\<strokes-mode-map>
1357    With ARG, turn strokes on if and only if ARG is positive.
1358    Strokes are pictographic mouse gestures which invoke commands.
1359    Strokes are invoked with \\[strokes-do-stroke].  You can define
1360    new strokes with \\[strokes-global-set-stroke].  See also
1361    \\[strokes-do-complex-stroke] for `complex' strokes.
1362    
1363  To use strokes for pictographic editing, such as Chinese/Japanese, use  To use strokes for pictographic editing, such as Chinese/Japanese, use
1364  S-mouse-2, which draws strokes and inserts them.  Encode/decode your  \\[strokes-compose-complex-stroke], which draws strokes and inserts them.
1365  strokes with  Encode/decode your strokes with \\[strokes-encode-buffer],
1366    \\[strokes-decode-buffer].
1367    
1368    \\{strokes-mode-map}"
1369      nil strokes-modeline-string strokes-mode-map
1370      :group 'strokes :global t
1371      (cond ((not (display-mouse-p))
1372             (error "Can't use Strokes without a mouse"))
1373            (strokes-mode                   ; turn on strokes
1374             (and (file-exists-p strokes-file)
1375                  (null strokes-global-map)
1376                  (strokes-load-user-strokes))
1377             (add-hook 'kill-emacs-query-functions
1378                       'strokes-prompt-user-save-strokes)
1379             (add-hook 'select-frame-hook
1380                       'strokes-update-window-configuration)
1381             (strokes-update-window-configuration))
1382            (t                              ; turn off strokes
1383             (if (get-buffer strokes-buffer-name)
1384                 (kill-buffer (get-buffer strokes-buffer-name)))
1385             (remove-hook 'select-frame-hook
1386                          'strokes-update-window-configuration))))
1387    
 > M-x strokes-encode-buffer  
 > M-x strokes-decode-buffer"  
   (interactive "P")  
   (let ((on-p (if arg  
                   (> (prefix-numeric-value arg) 0)  
                 (not strokes-mode))))  
     (cond ((not (display-mouse-p))  
            (error "Can't use strokes without a mouse"))  
           (on-p                         ; turn on strokes  
            (strokes-insinuate)          ; make sure defadvices are set  
            (and (file-exists-p strokes-file)  
                 (null strokes-global-map)  
                 (strokes-load-user-strokes))  
            (add-hook 'kill-emacs-query-functions  
                      'strokes-prompt-user-save-strokes)  
            (add-hook 'select-frame-hook  
                      'strokes-update-window-configuration)  
            (strokes-update-window-configuration)  
            (define-key global-map [(down-mouse-2)] 'strokes-do-stroke)  
            (define-key global-map [(meta down-mouse-2)]  
              'strokes-do-complex-stroke)  
            ;;      (define-key global-map [(control down-mouse-2)] 'strokes-do-complex-stroke)  
            (ad-activate-regexp "^strokes-") ; advise button2 commands  
            (setq strokes-mode t))  
           (t                            ; turn off strokes  
            (if (get-buffer strokes-buffer-name)  
                (kill-buffer (get-buffer strokes-buffer-name)))  
            (remove-hook 'select-frame-hook  
                         'strokes-update-window-configuration)  
            (if (string-match "^strokes-" (symbol-name (key-binding [(down-mouse-2)])))  
                (define-key global-map [(down-mouse-2)] strokes-click-command))  
            (if (string-match "^strokes-" (symbol-name (key-binding [(meta down-mouse-2)])))  
                (global-unset-key [(meta down-mouse-2)]))  
            (if (string-match "^strokes-" (symbol-name (key-binding [(control down-mouse-2)])))  
                (global-unset-key [(control down-mouse-2)]))  
            ;;      (if (string-match "^strokes-" (symbol-name (key-binding [(shift button2)])))  
            ;;          (global-unset-key [(shift button2)]))  
            (ad-deactivate-regexp "^strokes-") ; unadvise strokes-button2 commands  
            (setq strokes-mode nil))))  
   (force-mode-line-update))  
1388    
1389  ;;;; strokes-xpm stuff (later may be separate)...  ;;;; strokes-xpm stuff (later may be separate)...
1390    
1391  ;; This is the stuff that will eventuall be used for composing letters in  ;; This is the stuff that will eventually be used for composing letters in
1392  ;; any language, compression, decompression, graphics, editing, etc.  ;; any language, compression, decompression, graphics, editing, etc.
1393    
1394  (defface strokes-char-face '((t (:background "lightgray")))  (defface strokes-char-face '((t (:background "lightgray")))
# Line 1679  strokes with Line 1464  strokes with
1464    
1465  (defconst strokes-base64-chars  (defconst strokes-base64-chars
1466    ;; I wanted to make this a vector of individual like (vector ?0    ;; I wanted to make this a vector of individual like (vector ?0
1467    ;; ?1 ?2 ...), but `concat' in XEmacs-20.* refuses to accept single    ;; ?1 ?2 ...), but `concat' refuses to accept single
1468    ;; characters.    ;; characters.
1469    (vector "0" "1" "2" "3" "4" "5" "6" "7" "8" "9"    (vector "0" "1" "2" "3" "4" "5" "6" "7" "8" "9"
1470            "a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l" "m" "n" "o"            "a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l" "m" "n" "o"
# Line 1696  strokes with Line 1481  strokes with
1481    "Character vector for fast lookup of base-64 encoding of numbers in [0,61].")    "Character vector for fast lookup of base-64 encoding of numbers in [0,61].")
1482    
1483  (defsubst strokes-xpm-char-on-p (char)  (defsubst strokes-xpm-char-on-p (char)
1484    "Non-nil if CHAR represents an `on' bit in the xpm."    "Non-nil if CHAR represents an `on' bit in the XPM."
1485    (eq char ?*))    (eq char ?*))
1486    
1487  (defsubst strokes-xpm-char-bit-p (char)  (defsubst strokes-xpm-char-bit-p (char)
1488    "Non-nil if CHAR represents an `on' or `off' bit in the xpm."    "Non-nil if CHAR represents an `on' or `off' bit in the XPM."
1489    (or (eq char ?\ )    (or (eq char ?\ )
1490        (eq char ?*)))        (eq char ?*)))
1491    
# Line 1711  strokes with Line 1496  strokes with
1496  ;;  (eq (null a) (not (null b))))  ;;  (eq (null a) (not (null b))))
1497    
1498  (defsubst strokes-xpm-encode-length-as-string (length)  (defsubst strokes-xpm-encode-length-as-string (length)
1499    "Given some LENGTH in [0,62) do a fast lookup of it's encoding."    "Given some LENGTH in [0,62) do a fast lookup of its encoding."
1500    (aref strokes-base64-chars length))    (aref strokes-base64-chars length))
1501                      
1502  (defsubst strokes-xpm-decode-char (character)  (defsubst strokes-xpm-decode-char (character)
1503    "Given a CHARACTER, do a fast lookup to find its corresponding integer value."    "Given a CHARACTER, do a fast lookup to find its corresponding integer value."
1504    (aref strokes-char-table character))    (aref strokes-char-table character))
1505                      
1506  (defun strokes-xpm-to-compressed-string (&optional xpm-buffer)  (defun strokes-xpm-to-compressed-string (&optional xpm-buffer)
1507    "Convert the xpm in XPM-BUFFER into a compressed string representing the stroke.    "Convert XPM in XPM-BUFFER to compressed string representing the stroke.
1508  XPM-BUFFER is an optional argument, and defaults to `*strokes-xpm*'."  XPM-BUFFER defaults to ` *strokes-xpm*'."
1509    (save-excursion    (save-excursion
1510      (set-buffer (setq xpm-buffer (or xpm-buffer "*strokes-xpm*")))      (set-buffer (setq xpm-buffer (or xpm-buffer " *strokes-xpm*")))
1511      (goto-char (point-min))      (goto-char (point-min))
1512      (search-forward "/* pixels */")     ; skip past header junk      (search-forward "/* pixels */")     ; skip past header junk
1513      (forward-char 2)      (forward-char 2)
# Line 1742  XPM-BUFFER is an optional argument, and Line 1527  XPM-BUFFER is an optional argument, and
1527                 ;; check to see if the `char-at-point' is an actual pixmap bit                 ;; check to see if the `char-at-point' is an actual pixmap bit
1528                 (when (strokes-xpm-char-bit-p char-at-point)                 (when (strokes-xpm-char-bit-p char-at-point)
1529                   (setq count 1                   (setq count 1
1530                         current-char-is-on-p (strokes-xpm-char-on-p char-at-point)))                                     current-char-is-on-p (strokes-xpm-char-on-p char-at-point)))
1531                 (forward-char 1))                 (forward-char 1))
1532                ((= count 61)             ; maximum single char's                ((= count 61)             ; maximum single char's
1533                                          ; encoding length                                          ; encoding length
1534                 (setq compressed-string (concat compressed-string                 (setq compressed-string
1535                                                 ;; add a zero-length                       (concat compressed-string
1536                                                 ;; encoding when                               ;; add a zero-length encoding when
1537                                                 ;; necessary                               ;; necessary
1538                                                 (when (eq last-char-was-on-p                               (when (eq last-char-was-on-p
1539                                                           current-char-is-on-p)                                         current-char-is-on-p)
1540                                                   ;; "0"                                 ;; "0"
1541                                                   (strokes-xpm-encode-length-as-string 0))                                 (strokes-xpm-encode-length-as-string 0))
1542                                                 (strokes-xpm-encode-length-as-string 61))                               (strokes-xpm-encode-length-as-string 61))
1543                       last-char-was-on-p current-char-is-on-p                       last-char-was-on-p current-char-is-on-p
1544                       count 0))          ; note that we just set                       count 0))          ; note that we just set
1545                                          ; count=0 and *don't* advance                                          ; count=0 and *don't* advance
# Line 1774  XPM-BUFFER is an optional argument, and Line 1559  XPM-BUFFER is an optional argument, and
1559                   ;; iteration go through and letting the case: count=0                   ;; iteration go through and letting the case: count=0
1560                   ;; take care of this stuff for me.  That's why                   ;; take care of this stuff for me.  That's why
1561                   ;; there's no (forward-char 1) below.                   ;; there's no (forward-char 1) below.
1562                   (setq compressed-string (concat compressed-string                   (setq compressed-string
1563                                                   ;; add a zero-length                         (concat compressed-string
1564                                                   ;; encoding when                                 ;; add a zero-length encoding when
1565                                                   ;; necessary                                 ;; necessary
1566                                                   (when (eq last-char-was-on-p                                 (when (eq last-char-was-on-p
1567                                                             current-char-is-on-p)                                           current-char-is-on-p)
1568                                                     ;; "0"                                   ;; "0"
1569                                                     (strokes-xpm-encode-length-as-string 0))                                   (strokes-xpm-encode-length-as-string 0))
1570                                                   (strokes-xpm-encode-length-as-string count))                                 (strokes-xpm-encode-length-as-string count))
1571                         count 0                         count 0
1572                         last-char-was-on-p current-char-is-on-p)))                         last-char-was-on-p current-char-is-on-p)))
1573                (t                        ; ELSE it's some other useless                (t                        ; ELSE it's some other useless
# Line 1816  Optional FORCE non-nil will ignore the b Line 1601  Optional FORCE non-nil will ignore the b
1601          (message "Strokifying %s..." buffer)          (message "Strokifying %s..." buffer)
1602          (goto-char (point-min))          (goto-char (point-min))
1603          (let (ext string image)          (let (ext string image)
1604            ;; The comment below is what i'd have to do if I wanted to            ;; The comment below is what I'd have to do if I wanted to
1605            ;; deal with random newlines in the midst of the compressed            ;; deal with random newlines in the midst of the compressed
1606            ;; strings.  If I do this, I'll also have to change            ;; strings.  If I do this, I'll also have to change
1607            ;; `strokes-xpm-to-compress-string' to deal with the newline,            ;; `strokes-xpm-to-compress-string' to deal with the newline,
# Line 1840  Optional FORCE non-nil will ignore the b Line 1625  Optional FORCE non-nil will ignore the b
1625          (message "Strokifying %s...done" buffer)))))          (message "Strokifying %s...done" buffer)))))
1626    
1627  (defun strokes-encode-buffer (&optional buffer force)  (defun strokes-encode-buffer (&optional buffer force)
1628    "Convert the glyphs in BUFFER to thier base-64 ASCII representations.    "Convert the glyphs in BUFFER to their base-64 ASCII representations.
1629  Optional BUFFER defaults to the current buffer.  Optional BUFFER defaults to the current buffer.
1630  Optional FORCE non-nil will ignore the buffer's read-only status."  Optional FORCE non-nil will ignore the buffer's read-only status."
1631    ;; ### NOTE !!! ### (for me)    ;; ### NOTE !!! ### (for me)
# Line 1889  Optional FORCE non-nil will ignore the b Line 1674  Optional FORCE non-nil will ignore the b
1674          (message "Encoding strokes in %s...done" buffer)))))          (message "Encoding strokes in %s...done" buffer)))))
1675    
1676  (defun strokes-xpm-for-compressed-string (compressed-string &optional bufname)  (defun strokes-xpm-for-compressed-string (compressed-string &optional bufname)
1677    "Convert the stroke represented by COMPRESSED-STRING into an xpm.    "Convert the stroke represented by COMPRESSED-STRING into an XPM.
1678  Store xpm in buffer BUFNAME if supplied \(default is `*strokes-xpm*'\)"  Store XPM in buffer BUFNAME if supplied \(default is ` *strokes-xpm*'\)"
1679    (save-excursion    (save-excursion
1680      (or bufname (setq bufname "*strokes-xpm*"))      (or bufname (setq bufname " *strokes-xpm*"))
1681      (set-buffer (get-buffer-create bufname))      (set-buffer (get-buffer-create bufname))
1682      (erase-buffer)      (erase-buffer)
1683      (insert compressed-string)      (insert compressed-string)
# Line 1917  Store xpm in buffer BUFNAME if supplied Line 1702  Store xpm in buffer BUFNAME if supplied
1702  ;;;###autoload  ;;;###autoload
1703  (defun strokes-compose-complex-stroke ()  (defun strokes-compose-complex-stroke ()
1704    ;; ### NOTE !!! ###    ;; ### NOTE !!! ###
1705    ;; Even though we have lexical scoping, it's somewhat ugly how I    ;; Even though we don't have lexical scoping, it's somewhat ugly how I
1706    ;; pass around variables in the global name space.  I can/should    ;; pass around variables in the global name space.  I can/should
1707    ;; change this.    ;; change this.
1708    "Read a complex stroke and insert its glyph into the current buffer."    "Read a complex stroke and insert its glyph into the current buffer."
# Line 1930  Store xpm in buffer BUFNAME if supplied Line 1715  Store xpm in buffer BUFNAME if supplied
1715      ;; strokes-decode-buffer does a save-excursion.      ;; strokes-decode-buffer does a save-excursion.
1716      (forward-char)))      (forward-char)))
1717    
1718  (or (assq 'strokes-mode minor-mode-alist)  (defun strokes-unload-hook ()
1719      (setq minor-mode-alist (cons (list 'strokes-mode strokes-modeline-string)    (strokes-mode -1)
1720                                   minor-mode-alist)))    (remove-hook 'kill-emacs-query-functions 'strokes-prompt-user-save-strokes))
1721    
 (provide 'strokes)  
1722  (run-hooks 'strokes-load-hook)  (run-hooks 'strokes-load-hook)
1723    (provide 'strokes)
1724    
1725  ;;; strokes.el ends here  ;;; strokes.el ends here

Legend:
Removed from v.1.10  
changed lines
  Added in v.1.10.2.1

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26