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 |
|
|
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 |
|
|
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 |
|
|
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'. |
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 |
|
|
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 |
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.") |
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 |
|
|
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 |
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. |
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'.") |
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." |
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) |
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) |
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) |
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)) |
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 |
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)) |
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)) |
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))) |
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 |
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)) |
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." |
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))) |
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)) |
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 |
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 |
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))) |
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 |
|
|
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) |
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'") |
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 |
|
|
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 |
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 |
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 |
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 |
|
|
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." |
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 |
|
|
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) |
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) |
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") |
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 |
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... |
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) |
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"))) |
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" |
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 |
|
|
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) |
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 |
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 |
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, |
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) |
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) |
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." |
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 |