Mercurial > emacs
comparison lisp/emulation/tpu-mapper.el @ 4421:95bb7e28d761
Initial revision
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Mon, 02 Aug 1993 19:11:20 +0000 |
parents | |
children | 325bc5407213 |
comparison
equal
deleted
inserted
replaced
4420:8113d9ba472e | 4421:95bb7e28d761 |
---|---|
1 ;;; tpu-mapper.el --- Create a TPU-edt keymap file for x-windows emacs. | |
2 | |
3 ;; Copyright (C) 1993 Free Software Foundation, Inc. | |
4 | |
5 ;; Author: Rob Riepel <riepel@networking.stanford.edu> | |
6 ;; Maintainer: Rob Riepel <riepel@networking.stanford.edu> | |
7 ;; Keywords: tpu-edt | |
8 | |
9 ;; GNU Emacs is distributed in the hope that it will be useful, | |
10 ;; but WITHOUT ANY WARRANTY. No author or distributor | |
11 ;; accepts responsibility to anyone for the consequences of using it | |
12 ;; or for whether it serves any particular purpose or works at all, | |
13 ;; unless he says so in writing. Refer to the GNU Emacs General Public | |
14 ;; License for full details. | |
15 | |
16 ;; Everyone is granted permission to copy, modify and redistribute | |
17 ;; GNU Emacs, but only under the conditions described in the | |
18 ;; GNU Emacs General Public License. A copy of this license is | |
19 ;; supposed to have been given to you along with GNU Emacs so you | |
20 ;; can know your rights and responsibilities. It should be in a | |
21 ;; file named COPYING. Among other things, the copyright notice | |
22 ;; and this notice must be preserved on all copies. | |
23 ;; | |
24 | |
25 ;;; Revision: $Id: tpu-mapper.el,v 1.1 1993/08/01 21:39:07 riepel Exp $ | |
26 | |
27 ;;; Commentary: | |
28 | |
29 ;; This emacs lisp program can be used to create an emacs lisp file that | |
30 ;; defines the TPU-edt keypad for emacs running on x-windows. Please read | |
31 ;; the "Usage" AND "Known Problems" sections before attempting to run this | |
32 ;; program. | |
33 | |
34 ;;; Usage: | |
35 | |
36 ;; Simply load this file into the X-windows version of emacs (version 19) | |
37 ;; using the following command. | |
38 | |
39 ;; emacs -q -l tpu-mapper.el | |
40 | |
41 ;; The "-q" option prevents loading of your .emacs file (commands therein | |
42 ;; might confuse this program). | |
43 | |
44 ;; An instruction screen showing the TPU-edt keypad will be displayed, and | |
45 ;; you will be prompted to press the TPU-edt editing keys. Tpu-mapper uses | |
46 ;; the keys you press to create an emacs lisp file that will define a | |
47 ;; TPU-edt keypad for your X server. You can even re-arrange the standard | |
48 ;; EDT keypad to suit your tastes (or to cope with those silly Sun and PC | |
49 ;; keypads). | |
50 | |
51 ;; Finally, you will be prompted for the name of the file to store the key | |
52 ;; definitions. If you chose the default, TPU-edt will find it and load it | |
53 ;; automatically. If you specify a different file name, you will need to | |
54 ;; set the variable "tpu-xkeys-file" before loading TPU-edt. Here's how | |
55 ;; you might go about doing that in your .emacs file. | |
56 | |
57 ;; (setq tpu-xkeys-file (expand-file-name "~/.my-emacs-x-keys")) | |
58 ;; (load "tpu-edt") | |
59 | |
60 ;;; Known Problems: | |
61 | |
62 ;; Sometimes, tpu-mapper will ignore a key you press, and just continue to | |
63 ;; prompt for the same key. This can happen when your window manager sucks | |
64 ;; up the key and doesn't pass it on to emacs, or it could be an emacs bug. | |
65 ;; Either way, there's nothing that tpu-mapper can do about it. You must | |
66 ;; press RETURN, to skip the current key and continue. Later, you and/or | |
67 ;; your local X guru can try to figure out why the key is being ignored. | |
68 | |
69 ;;; Code: | |
70 | |
71 ;;; | |
72 ;;; Revision Information | |
73 ;;; | |
74 (defconst tpu-mapper-revision "$Revision: 1.1 $" | |
75 "Revision number of TPU-edt x-windows emacs key mapper.") | |
76 | |
77 | |
78 ;;; | |
79 ;;; Make sure we're running X-windows and Emacs version 19 | |
80 ;;; | |
81 (cond | |
82 ((not (and window-system (not (string-lessp emacs-version "19")))) | |
83 (insert " | |
84 | |
85 Whoa! This isn't going to work... | |
86 | |
87 You must run tpu-mapper.el under X-windows and Emacs version 19. | |
88 | |
89 Press any key to exit. ") | |
90 (sit-for 600) | |
91 (kill-emacs t))) | |
92 | |
93 | |
94 ;;; | |
95 ;;; Decide whether we're running GNU or Lucid emacs. | |
96 ;;; | |
97 (defconst tpu-lucid-emacs19-p (string-match "Lucid" emacs-version) | |
98 "Non-NIL if we are running Lucid Emacs version 19.") | |
99 | |
100 | |
101 ;;; | |
102 ;;; Key variables | |
103 ;;; | |
104 (defvar tpu-key nil) | |
105 (defvar tpu-enter nil) | |
106 (defvar tpu-return nil) | |
107 (defvar tpu-key-seq nil) | |
108 (defvar tpu-enter-seq nil) | |
109 (defvar tpu-return-seq nil) | |
110 | |
111 | |
112 ;;; | |
113 ;;; Make sure the window is big enough to display the instructions | |
114 ;;; | |
115 (if tpu-lucid-emacs19-p (set-screen-size nil 80 36) | |
116 (set-frame-size (selected-frame) 80 36)) | |
117 | |
118 | |
119 ;;; | |
120 ;;; Create buffers - Directions, Keys, Gold-Keys | |
121 ;;; | |
122 (if (not (get-buffer "Directions")) (generate-new-buffer "Directions")) | |
123 (if (not (get-buffer "Keys")) (generate-new-buffer "Keys")) | |
124 (if (not (get-buffer "Gold-Keys")) (generate-new-buffer "Gold-Keys")) | |
125 | |
126 | |
127 ;;; | |
128 ;;; Put headers in the Keys buffer | |
129 ;;; | |
130 (set-buffer "Keys") | |
131 (insert "\ | |
132 ;; Key definitions for TPU-edt | |
133 ;; | |
134 ") | |
135 | |
136 | |
137 ;;; | |
138 ;;; Display directions | |
139 ;;; | |
140 (switch-to-buffer "Directions") | |
141 (insert " | |
142 This program prompts you to press keys to create a custom keymap file | |
143 for use with the x-windows version of emacs and TPU-edt. | |
144 | |
145 Start by pressing the RETURN key, and continue by pressing the keys | |
146 specified in the mini-buffer. You can re-arrange the TPU-edt keypad | |
147 by pressing any key you want at any prompt. If you want to entirely | |
148 omit a key, just press RETURN at the prompt. | |
149 | |
150 Here's a picture of the standard TPU/edt keypad for reference: | |
151 | |
152 _______________________ _______________________________ | |
153 | HELP | Do | | | | | | | |
154 |KeyDefs| | | | | | | | |
155 |_______|_______________| |_______|_______|_______|_______| | |
156 _______________________ _______________________________ | |
157 | Find |Insert |Remove | | Gold | HELP |FndNxt | Del L | | |
158 | | |Sto Tex| | key |E-Help | Find |Undel L| | |
159 |_______|_______|_______| |_______|_______|_______|_______| | |
160 |Select |Pre Scr|Nex Scr| | Page | Sect |Append | Del W | | |
161 | Reset |Pre Win|Nex Win| | Do | Fill |Replace|Undel W| | |
162 |_______|_______|_______| |_______|_______|_______|_______| | |
163 |Move up| |Forward|Reverse|Remove | Del C | | |
164 | Top | |Bottom | Top |Insert |Undel C| | |
165 _______|_______|_______ |_______|_______|_______|_______| | |
166 |Mov Lef|Mov Dow|Mov Rig| | Word | EOL | Char | | | |
167 |StaOfLi|Bottom |EndOfLi| |ChngCas|Del EOL|SpecIns| Enter | | |
168 |_______|_______|_______| |_______|_______|_______| | | |
169 | Line |Select | Subs | | |
170 | Open Line | Reset | | | |
171 |_______________|_______|_______| | |
172 | |
173 | |
174 ") | |
175 (delete-other-windows) | |
176 | |
177 ;;; | |
178 ;;; Save <CR> for future reference | |
179 ;;; | |
180 (setq tpu-return-seq (read-key-sequence "Hit carriage-return <CR> to continue ")) | |
181 (cond | |
182 (tpu-lucid-emacs19-p | |
183 (setq tpu-return (concat "[" (format "%s" (event-key (aref tpu-return-seq 0))) "]"))) | |
184 (t | |
185 (setq tpu-return (format "%s" tpu-return-seq)))) | |
186 | |
187 | |
188 ;;; | |
189 ;;; Key mapping functions | |
190 ;;; | |
191 (defun tpu-lucid-map-key (ident descrip func gold-func) | |
192 (interactive) | |
193 (setq tpu-key-seq (read-key-sequence (format "Press %s%s: " ident descrip))) | |
194 (setq tpu-key (concat "[" (format "%s" (event-key (aref tpu-key-seq 0))) "]")) | |
195 (cond ((not (equal tpu-key tpu-return)) | |
196 (set-buffer "Keys") | |
197 (insert (format"(global-set-key %s %s)\n" tpu-key func)) | |
198 (set-buffer "Gold-Keys") | |
199 (insert (format "(define-key GOLD-map %s %s)\n" tpu-key gold-func)) | |
200 (set-buffer "Directions")) | |
201 ;; bogosity to get next prompt to come up, if the user hits <CR>! | |
202 ;; check periodically to see if this is still needed... | |
203 (t | |
204 (format "%s" tpu-key))) | |
205 tpu-key) | |
206 | |
207 (defun tpu-gnu-map-key (ident descrip func gold-func) | |
208 (interactive) | |
209 (setq tpu-key-seq (read-key-sequence (format "Press %s%s: " ident descrip))) | |
210 (setq tpu-key (format "%s" tpu-key-seq)) | |
211 (cond ((not (equal tpu-key tpu-return)) | |
212 (set-buffer "Keys") | |
213 (insert (format"(global-set-key %s %s)\n" tpu-key func)) | |
214 (set-buffer "Gold-Keys") | |
215 (insert (format "(define-key GOLD-map %s %s)\n" tpu-key gold-func)) | |
216 (set-buffer "Directions")) | |
217 ;; bogosity to get next prompt to come up, if the user hits <CR>! | |
218 ;; check periodically to see if this is still needed... | |
219 (t | |
220 (format "%s" tpu-key))) | |
221 tpu-key) | |
222 | |
223 (fset 'tpu-map-key (if tpu-lucid-emacs19-p 'tpu-lucid-map-key 'tpu-gnu-map-key)) | |
224 | |
225 | |
226 (set-buffer "Keys") | |
227 (insert " | |
228 ;; Arrows | |
229 ;; | |
230 ") | |
231 (set-buffer "Gold-Keys") | |
232 (insert " | |
233 ;; GOLD Arrows | |
234 ;; | |
235 ") | |
236 (set-buffer "Directions") | |
237 | |
238 (tpu-map-key "Up-Arrow" "" "'tpu-previous-line" "'tpu-move-to-beginning") | |
239 (tpu-map-key "Down-arrow" "" "'tpu-next-line" "'tpu-move-to-end") | |
240 (tpu-map-key "Right-arrow" "" "'tpu-forward-char" "'end-of-line") | |
241 (tpu-map-key "Left-arrow" "" "'tpu-backward-char" "'beginning-of-line") | |
242 | |
243 | |
244 (set-buffer "Keys") | |
245 (insert " | |
246 ;; PF keys | |
247 ;; | |
248 ") | |
249 (set-buffer "Gold-Keys") | |
250 (insert " | |
251 ;; GOLD PF keys | |
252 ;; | |
253 ") | |
254 (set-buffer "Directions") | |
255 | |
256 (tpu-map-key "PF1" " - The GOLD key" "GOLD-map" "'keyboard-quit") | |
257 (tpu-map-key "PF2" " - The Keypad Help key" "'tpu-help" "'help-for-help") | |
258 (tpu-map-key "PF3" " - The Find/Find-Next key" "'tpu-search-again" "'tpu-search") | |
259 (tpu-map-key "PF4" " - The Del/Undelete Line key" "'tpu-delete-current-line" "'tpu-undelete-lines") | |
260 | |
261 (set-buffer "Keys") | |
262 (insert " | |
263 ;; KP0-9 KP- KP, KP. and KPenter | |
264 ;; | |
265 ") | |
266 (set-buffer "Gold-Keys") | |
267 (insert " | |
268 ;; GOLD KP0-9 KP- KP, and KPenter | |
269 ;; | |
270 ") | |
271 (set-buffer "Directions") | |
272 | |
273 (tpu-map-key "KP-0" " - The Line/Open-Line key" "'tpu-line" "'open-line") | |
274 (tpu-map-key "KP-1" " - The Word/Change-Case key" "'tpu-word" "'tpu-change-case") | |
275 (tpu-map-key "KP-2" " - The EOL/Delete-EOL key" "'tpu-end-of-line" "'tpu-delete-to-eol") | |
276 (tpu-map-key "KP-3" " - The Character/Special-Insert key" "'tpu-char" "'tpu-special-insert") | |
277 (tpu-map-key "KP-4" " - The Forward/Bottom key" "'tpu-advance-direction" "'tpu-move-to-end") | |
278 (tpu-map-key "KP-5" " - The Reverse/Top key" "'tpu-backup-direction" "'tpu-move-to-beginning") | |
279 (tpu-map-key "KP-6" " - The Remove/Insert key" "'tpu-cut" "'tpu-paste") | |
280 (tpu-map-key "KP-7" " - The Page/Do key" "'tpu-page" "'execute-extended-command") | |
281 (tpu-map-key "KP-8" " - The Section/Fill key" "'tpu-scroll-window" "'tpu-fill") | |
282 (tpu-map-key "KP-9" " - The Append/Replace key" "'tpu-append-region" "'tpu-replace") | |
283 (tpu-map-key "KP--" " - The Delete/Undelete Word key" "'tpu-delete-current-word" "'tpu-undelete-words") | |
284 (tpu-map-key "KP-," " - The Delete/Undelete Character key" "'tpu-delete-current-char" "'tpu-undelete-char") | |
285 (tpu-map-key "KP-." " - The Select/Reset key" "'tpu-select" "'tpu-unselect") | |
286 (tpu-map-key "KP-Enter" " - The Enter key on the numeric keypad" "'newline" "'tpu-substitute") | |
287 ;; Save the enter key | |
288 (setq tpu-enter tpu-key) | |
289 (setq tpu-enter-seq tpu-key-seq) | |
290 | |
291 (set-buffer "Keys") | |
292 (insert " | |
293 ;; Editing keypad (find, insert, remove) | |
294 ;; (select, prev, next) | |
295 ;; | |
296 ") | |
297 (set-buffer "Gold-Keys") | |
298 (insert " | |
299 ;; GOLD Editing keypad (find, insert, remove) | |
300 ;; (select, prev, next) | |
301 ;; | |
302 ") | |
303 (set-buffer "Directions") | |
304 | |
305 (tpu-map-key "Find" " - The Find key on the editing keypad" "'tpu-search" "'nil") | |
306 (tpu-map-key "Insert" " - The Insert key on the editing keypad" "'tpu-paste" "'nil") | |
307 (tpu-map-key "Remove" " - The Remove key on the editing keypad" "'tpu-cut" "'tpu-store-text") | |
308 (tpu-map-key "Select" " - The Select key on the editing keypad" "'tpu-select" "'tpu-unselect") | |
309 (tpu-map-key "Prev Scr" " - The Prev Scr key on the editing keypad" "'tpu-scroll-window-down" "'tpu-previous-window") | |
310 (tpu-map-key "Next Scr" " - The Next Scr key on the editing keypad" "'tpu-scroll-window-up" "'tpu-next-window") | |
311 | |
312 (set-buffer "Keys") | |
313 (insert " | |
314 ;; F10-14 Help Do F17 | |
315 ;; | |
316 ") | |
317 (set-buffer "Gold-Keys") | |
318 (insert " | |
319 ;; GOLD F10-14 Help Do F17 | |
320 ;; | |
321 ") | |
322 (set-buffer "Directions") | |
323 | |
324 (tpu-map-key "F10" " - Invokes the Exit function on VT200+ terminals" "'tpu-exit" "'nil") | |
325 (tpu-map-key "F11" " - Inserts an Escape character into the text" "'tpu-insert-escape" "'nil") | |
326 (tpu-map-key "Backspace" " - Not Delete nor ^H! Sometimes on the F12 key" "'tpu-next-beginning-of-line" "'nil") | |
327 (tpu-map-key "F13" " - Invokes the delete previous word function" "'tpu-delete-previous-word" "'nil") | |
328 (tpu-map-key "F14" " - Toggles insert/overstrike modes" "'tpu-toggle-overwrite-mode" "'nil") | |
329 (tpu-map-key "Help" " - Brings up the help screen, same as PF2" "'tpu-help" "'describe-bindings") | |
330 (tpu-map-key "Do" " - Invokes the COMMAND function" "'execute-extended-command" "'nil") | |
331 (tpu-map-key "F17" "" "'tpu-goto-breadcrumb" "'tpu-drop-breadcrumb") | |
332 | |
333 (set-buffer "Gold-Keys") | |
334 (cond | |
335 ((not (equal tpu-enter tpu-return)) | |
336 (insert " | |
337 ;; Minibuffer map additions to make KP_enter = RET | |
338 ;; | |
339 ") | |
340 | |
341 (insert (format "(define-key minibuffer-local-map %s 'exit-minibuffer)\n" tpu-enter)) | |
342 (insert (format "(define-key minibuffer-local-ns-map %s 'exit-minibuffer)\n" tpu-enter)) | |
343 (insert (format "(define-key minibuffer-local-completion-map %s 'exit-minibuffer)\n" tpu-enter)) | |
344 (insert (format "(define-key minibuffer-local-must-match-map %s 'minibuffer-complete-and-exit)\n" tpu-enter)))) | |
345 | |
346 (insert " | |
347 ;; Define the tpu-help-enter/return symbols | |
348 ;; | |
349 ") | |
350 | |
351 (insert (format "(setq tpu-help-enter \"%s\")\n" tpu-enter-seq)) | |
352 (insert (format "(setq tpu-help-return \"%s\")\n" tpu-return-seq)) | |
353 | |
354 (append-to-buffer "Keys" 1 (point)) | |
355 (set-buffer "Keys") | |
356 | |
357 ;;; | |
358 ;;; Save the key mapping program and blow this pop stand | |
359 ;;; | |
360 (let ((file (if tpu-lucid-emacs19-p "~/.tpu-lucid-keys" "~/.tpu-gnu-keys"))) | |
361 (set-visited-file-name | |
362 (read-file-name (format "Save key mapping to file (default %s): " file) nil file))) | |
363 (save-buffer) | |
364 | |
365 (message "That's it! Press any key to exit") | |
366 (sit-for 600) | |
367 (kill-emacs t) | |
368 | |
369 ;;; tpu-mapper.el ends here |