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