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