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