Commit | Line | Data |
---|---|---|
e8af40ee | 1 | ;;; tpu-mapper.el --- create a TPU-edt X-windows keymap file |
522f9216 | 2 | |
d59c3137 | 3 | ;; Copyright (C) 1993, 1994, 1995, 2001, 2002, 2003, 2004, |
f33e2ef1 | 4 | ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. |
522f9216 RS |
5 | |
6 | ;; Author: Rob Riepel <riepel@networking.stanford.edu> | |
7 | ;; Maintainer: Rob Riepel <riepel@networking.stanford.edu> | |
b7f66977 | 8 | ;; Keywords: emulations |
522f9216 | 9 | |
75993094 RS |
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 | |
e0085d62 | 14 | ;; the Free Software Foundation; either version 3, or (at your option) |
75993094 RS |
15 | ;; any later version. |
16 | ||
522f9216 | 17 | ;; GNU Emacs is distributed in the hope that it will be useful, |
75993094 RS |
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 | |
b578f267 | 23 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
3a35cf56 LK |
24 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
25 | ;; Boston, MA 02110-1301, USA. | |
522f9216 | 26 | |
522f9216 RS |
27 | ;;; Commentary: |
28 | ||
f33e2ef1 SM |
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. | |
522f9216 RS |
31 | |
32 | ;;; Code: | |
33 | ||
522f9216 RS |
34 | ;;; |
35 | ;;; Key variables | |
36 | ;;; | |
18376c7c RS |
37 | (defvar tpu-kp4 nil) |
38 | (defvar tpu-kp5 nil) | |
522f9216 RS |
39 | (defvar tpu-key nil) |
40 | (defvar tpu-enter nil) | |
41 | (defvar tpu-return nil) | |
42 | (defvar tpu-key-seq nil) | |
43 | (defvar tpu-enter-seq nil) | |
44 | (defvar tpu-return-seq nil) | |
45 | ||
522f9216 | 46 | ;;; |
f33e2ef1 | 47 | ;;; Key mapping function |
522f9216 | 48 | ;;; |
f33e2ef1 SM |
49 | (defun tpu-map-key (ident descrip func gold-func) |
50 | (interactive) | |
51 | (if (featurep 'xemacs) | |
52 | (progn | |
53 | (setq tpu-key-seq (read-key-sequence | |
54 | (format "Press %s%s: " ident descrip)) | |
55 | tpu-key (format "[%s]" (event-key (aref tpu-key-seq 0)))) | |
56 | (unless (equal tpu-key tpu-return) | |
57 | (set-buffer "Keys") | |
58 | (insert (format"(global-set-key %s %s)\n" tpu-key func)) | |
59 | (set-buffer "Gold-Keys") | |
60 | (insert (format "(define-key GOLD-map %s %s)\n" tpu-key gold-func)))) | |
61 | (message "Press %s%s: " ident descrip) | |
62 | (setq tpu-key-seq (read-event) | |
63 | tpu-key (format "[%s]" tpu-key-seq)) | |
64 | (unless (equal tpu-key tpu-return) | |
65 | (set-buffer "Keys") | |
66 | (insert (format"(define-key tpu-global-map %s %s)\n" tpu-key func)) | |
67 | (set-buffer "Gold-Keys") | |
68 | (insert (format "(define-key tpu-gold-map %s %s)\n" tpu-key gold-func)))) | |
69 | (set-buffer "Directions") | |
70 | tpu-key) | |
522f9216 | 71 | |
f33e2ef1 SM |
72 | ;;;###autoload |
73 | (defun tpu-mapper () | |
74 | "Create an Emacs lisp file defining the TPU-edt keypad for X-windows. | |
75 | ||
76 | This command displays an instruction screen showing the TPU-edt keypad | |
77 | and asks you to press the TPU-edt editing keys. It uses the keys you | |
78 | press to create an Emacs Lisp file that will define a TPU-edt keypad | |
79 | for your X server. You can even re-arrange the standard EDT keypad to | |
80 | suit your tastes (or to cope with those silly Sun and PC keypads). | |
81 | ||
82 | Finally, you will be prompted for the name of the file to store the key | |
83 | definitions. If you chose the default, TPU-edt will find it and load it | |
84 | automatically. If you specify a different file name, you will need to | |
85 | set the variable ``tpu-xkeys-file'' before starting TPU-edt. Here's how | |
86 | you might go about doing that in your .emacs file. | |
87 | ||
88 | (setq tpu-xkeys-file (expand-file-name \"~/.my-emacs-x-keys\")) | |
89 | (tpu-edt) | |
90 | ||
91 | Known Problems: | |
92 | ||
93 | Sometimes, tpu-mapper will ignore a key you press, and just continue to | |
94 | prompt for the same key. This can happen when your window manager sucks | |
95 | up the key and doesn't pass it on to Emacs, or it could be an Emacs bug. | |
96 | Either way, there's nothing that tpu-mapper can do about it. You must | |
97 | press RETURN, to skip the current key and continue. Later, you and/or | |
98 | your local X guru can try to figure out why the key is being ignored." | |
99 | (interactive) | |
522f9216 | 100 | |
f33e2ef1 | 101 | ;; Make sure we're running X-windows |
522f9216 | 102 | |
f33e2ef1 SM |
103 | (if (not window-system) |
104 | (error "tpu-mapper requires running Emacs with an X display")) | |
522f9216 | 105 | |
f33e2ef1 SM |
106 | ;; Make sure the window is big enough to display the instructions |
107 | ||
108 | (if (featurep 'xemacs) (set-screen-size (selected-screen) 80 36) | |
109 | (set-frame-size (selected-frame) 80 36)) | |
110 | ||
111 | ;; Create buffers - Directions, Keys, Gold-Keys | |
112 | ||
113 | (if (not (get-buffer "Directions")) (generate-new-buffer "Directions")) | |
114 | (if (not (get-buffer "Keys")) (generate-new-buffer "Keys")) | |
115 | (if (not (get-buffer "Gold-Keys")) (generate-new-buffer "Gold-Keys")) | |
116 | ||
117 | ;; Put headers in the Keys buffer | |
118 | ||
119 | (set-buffer "Keys") | |
120 | (insert "\ | |
522f9216 RS |
121 | ;; Key definitions for TPU-edt |
122 | ;; | |
123 | ") | |
124 | ||
f33e2ef1 | 125 | ;; Display directions |
522f9216 | 126 | |
f33e2ef1 SM |
127 | (switch-to-buffer "Directions") |
128 | (insert " | |
522f9216 | 129 | This program prompts you to press keys to create a custom keymap file |
23e16ac4 | 130 | for use with the x-windows version of Emacs and TPU-edt. |
522f9216 RS |
131 | |
132 | Start by pressing the RETURN key, and continue by pressing the keys | |
133 | specified in the mini-buffer. You can re-arrange the TPU-edt keypad | |
134 | by pressing any key you want at any prompt. If you want to entirely | |
135 | omit a key, just press RETURN at the prompt. | |
136 | ||
137 | Here's a picture of the standard TPU/edt keypad for reference: | |
138 | ||
139 | _______________________ _______________________________ | |
140 | | HELP | Do | | | | | | | |
141 | |KeyDefs| | | | | | | | |
142 | |_______|_______________| |_______|_______|_______|_______| | |
143 | _______________________ _______________________________ | |
144 | | Find |Insert |Remove | | Gold | HELP |FndNxt | Del L | | |
145 | | | |Sto Tex| | key |E-Help | Find |Undel L| | |
146 | |_______|_______|_______| |_______|_______|_______|_______| | |
147 | |Select |Pre Scr|Nex Scr| | Page | Sect |Append | Del W | | |
148 | | Reset |Pre Win|Nex Win| | Do | Fill |Replace|Undel W| | |
149 | |_______|_______|_______| |_______|_______|_______|_______| | |
150 | |Move up| |Forward|Reverse|Remove | Del C | | |
151 | | Top | |Bottom | Top |Insert |Undel C| | |
152 | _______|_______|_______ |_______|_______|_______|_______| | |
153 | |Mov Lef|Mov Dow|Mov Rig| | Word | EOL | Char | | | |
154 | |StaOfLi|Bottom |EndOfLi| |ChngCas|Del EOL|SpecIns| Enter | | |
155 | |_______|_______|_______| |_______|_______|_______| | | |
156 | | Line |Select | Subs | | |
157 | | Open Line | Reset | | | |
158 | |_______________|_______|_______| | |
159 | ||
160 | ||
161 | ") | |
f33e2ef1 SM |
162 | (delete-other-windows) |
163 | (goto-char (point-min)) | |
522f9216 | 164 | |
f33e2ef1 | 165 | ;; Save <CR> for future reference |
522f9216 | 166 | |
f33e2ef1 SM |
167 | (cond |
168 | ((featurep 'xemacs) | |
169 | (setq tpu-return-seq (read-key-sequence "Hit carriage-return <CR> to continue ")) | |
170 | (setq tpu-return (concat "[" (format "%s" (event-key (aref tpu-return-seq 0))) "]"))) | |
171 | (t | |
172 | (message "Hit carriage-return <CR> to continue ") | |
173 | (setq tpu-return-seq (read-event)) | |
174 | (setq tpu-return (concat "[" (format "%s" tpu-return-seq) "]")))) | |
522f9216 | 175 | |
f33e2ef1 | 176 | ;; Build the keymap file |
522f9216 | 177 | |
f33e2ef1 SM |
178 | (set-buffer "Keys") |
179 | (insert " | |
522f9216 RS |
180 | ;; Arrows |
181 | ;; | |
182 | ") | |
f33e2ef1 SM |
183 | (set-buffer "Gold-Keys") |
184 | (insert " | |
522f9216 RS |
185 | ;; GOLD Arrows |
186 | ;; | |
187 | ") | |
f33e2ef1 | 188 | (set-buffer "Directions") |
522f9216 | 189 | |
f33e2ef1 SM |
190 | (tpu-map-key "Up-Arrow" "" "'tpu-previous-line" "'tpu-move-to-beginning") |
191 | (tpu-map-key "Down-arrow" "" "'tpu-next-line" "'tpu-move-to-end") | |
192 | (tpu-map-key "Right-arrow" "" "'tpu-forward-char" "'end-of-line") | |
193 | (tpu-map-key "Left-arrow" "" "'tpu-backward-char" "'beginning-of-line") | |
522f9216 | 194 | |
f33e2ef1 SM |
195 | (set-buffer "Keys") |
196 | (insert " | |
522f9216 RS |
197 | ;; PF keys |
198 | ;; | |
199 | ") | |
f33e2ef1 SM |
200 | (set-buffer "Gold-Keys") |
201 | (insert " | |
522f9216 RS |
202 | ;; GOLD PF keys |
203 | ;; | |
204 | ") | |
f33e2ef1 | 205 | (set-buffer "Directions") |
522f9216 | 206 | |
f33e2ef1 SM |
207 | (tpu-map-key "PF1" " - The GOLD key" "GOLD-map" "'keyboard-quit") |
208 | (tpu-map-key "PF2" " - The Keypad Help key" "'tpu-help" "'help-for-help") | |
209 | (tpu-map-key "PF3" " - The Find/Find-Next key" "'tpu-search-again" "'tpu-search") | |
210 | (tpu-map-key "PF4" " - The Del/Undelete Line key" "'tpu-delete-current-line" "'tpu-undelete-lines") | |
522f9216 | 211 | |
f33e2ef1 SM |
212 | (set-buffer "Keys") |
213 | (insert " | |
522f9216 RS |
214 | ;; KP0-9 KP- KP, KP. and KPenter |
215 | ;; | |
216 | ") | |
f33e2ef1 SM |
217 | (set-buffer "Gold-Keys") |
218 | (insert " | |
522f9216 RS |
219 | ;; GOLD KP0-9 KP- KP, and KPenter |
220 | ;; | |
221 | ") | |
f33e2ef1 SM |
222 | (set-buffer "Directions") |
223 | ||
224 | (tpu-map-key "KP-0" " - The Line/Open-Line key" "'tpu-line" "'open-line") | |
225 | (tpu-map-key "KP-1" " - The Word/Change-Case key" "'tpu-word" "'tpu-change-case") | |
226 | (tpu-map-key "KP-2" " - The EOL/Delete-EOL key" "'tpu-end-of-line" "'tpu-delete-to-eol") | |
227 | (tpu-map-key "KP-3" " - The Character/Special-Insert key" "'tpu-char" "'tpu-special-insert") | |
228 | (setq tpu-kp4 (tpu-map-key "KP-4" " - The Forward/Bottom key" "'tpu-advance-direction" "'tpu-move-to-end")) | |
229 | (setq tpu-kp5 (tpu-map-key "KP-5" " - The Reverse/Top key" "'tpu-backup-direction" "'tpu-move-to-beginning")) | |
230 | (tpu-map-key "KP-6" " - The Remove/Insert key" "'tpu-cut" "'tpu-paste") | |
231 | (tpu-map-key "KP-7" " - The Page/Do key" "'tpu-page" "'execute-extended-command") | |
232 | (tpu-map-key "KP-8" " - The Section/Fill key" "'tpu-scroll-window" "'tpu-fill") | |
233 | (tpu-map-key "KP-9" " - The Append/Replace key" "'tpu-append-region" "'tpu-replace") | |
234 | (tpu-map-key "KP--" " - The Delete/Undelete Word key" "'tpu-delete-current-word" "'tpu-undelete-words") | |
235 | (tpu-map-key "KP-," " - The Delete/Undelete Character key" "'tpu-delete-current-char" "'tpu-undelete-char") | |
236 | (tpu-map-key "KP-." " - The Select/Reset key" "'tpu-select" "'tpu-unselect") | |
237 | (tpu-map-key "KP-Enter" " - The Enter key on the numeric keypad" "'newline" "'tpu-substitute") | |
238 | ;; Save the enter key | |
239 | (setq tpu-enter tpu-key) | |
240 | (setq tpu-enter-seq tpu-key-seq) | |
241 | ||
242 | (set-buffer "Keys") | |
243 | (insert " | |
522f9216 RS |
244 | ;; Editing keypad (find, insert, remove) |
245 | ;; (select, prev, next) | |
246 | ;; | |
247 | ") | |
f33e2ef1 SM |
248 | (set-buffer "Gold-Keys") |
249 | (insert " | |
522f9216 RS |
250 | ;; GOLD Editing keypad (find, insert, remove) |
251 | ;; (select, prev, next) | |
252 | ;; | |
253 | ") | |
f33e2ef1 | 254 | (set-buffer "Directions") |
522f9216 | 255 | |
f33e2ef1 SM |
256 | (tpu-map-key "Find" " - The Find key on the editing keypad" "'tpu-search" "'nil") |
257 | (tpu-map-key "Insert" " - The Insert key on the editing keypad" "'tpu-paste" "'nil") | |
258 | (tpu-map-key "Remove" " - The Remove key on the editing keypad" "'tpu-cut" "'tpu-store-text") | |
259 | (tpu-map-key "Select" " - The Select key on the editing keypad" "'tpu-select" "'tpu-unselect") | |
260 | (tpu-map-key "Prev Scr" " - The Prev Scr key on the editing keypad" "'tpu-scroll-window-down" "'tpu-previous-window") | |
261 | (tpu-map-key "Next Scr" " - The Next Scr key on the editing keypad" "'tpu-scroll-window-up" "'tpu-next-window") | |
522f9216 | 262 | |
f33e2ef1 SM |
263 | (set-buffer "Keys") |
264 | (insert " | |
522f9216 RS |
265 | ;; F10-14 Help Do F17 |
266 | ;; | |
267 | ") | |
f33e2ef1 SM |
268 | (set-buffer "Gold-Keys") |
269 | (insert " | |
522f9216 RS |
270 | ;; GOLD F10-14 Help Do F17 |
271 | ;; | |
272 | ") | |
f33e2ef1 SM |
273 | (set-buffer "Directions") |
274 | ||
275 | (tpu-map-key "F10" " - Invokes the Exit function on VT200+ terminals" "'tpu-exit" "'nil") | |
276 | (tpu-map-key "F11" " - Inserts an Escape character into the text" "'tpu-insert-escape" "'nil") | |
277 | (tpu-map-key "Backspace" " - Not Delete nor ^H! Sometimes on the F12 key" "'tpu-next-beginning-of-line" "'nil") | |
278 | (tpu-map-key "F13" " - Invokes the delete previous word function" "'tpu-delete-previous-word" "'nil") | |
279 | (tpu-map-key "F14" " - Toggles insert/overstrike modes" "'tpu-toggle-overwrite-mode" "'nil") | |
280 | (tpu-map-key "Help" " - Brings up the help screen, same as PF2" "'tpu-help" "'describe-bindings") | |
281 | (tpu-map-key "Do" " - Invokes the COMMAND function" "'execute-extended-command" "'nil") | |
282 | (tpu-map-key "F17" "" "'tpu-goto-breadcrumb" "'tpu-drop-breadcrumb") | |
283 | ||
284 | (set-buffer "Gold-Keys") | |
285 | (cond | |
286 | ((not (equal tpu-enter tpu-return)) | |
287 | (insert " | |
522f9216 RS |
288 | ;; Minibuffer map additions to make KP_enter = RET |
289 | ;; | |
290 | ") | |
291 | ||
f33e2ef1 SM |
292 | (insert (format "(define-key minibuffer-local-map %s 'exit-minibuffer)\n" tpu-enter)) |
293 | ;; These are not necessary because they are inherited. | |
294 | ;; (insert (format "(define-key minibuffer-local-ns-map %s 'exit-minibuffer)\n" tpu-enter)) | |
295 | ;; (insert (format "(define-key minibuffer-local-completion-map %s 'exit-minibuffer)\n" tpu-enter)) | |
296 | (insert (format "(define-key minibuffer-local-must-match-map %s 'minibuffer-complete-and-exit)\n" tpu-enter)))) | |
522f9216 | 297 | |
f33e2ef1 SM |
298 | (cond |
299 | ((not (or (equal tpu-kp4 tpu-return) (equal tpu-kp5 tpu-return))) | |
300 | (insert " | |
18376c7c RS |
301 | ;; Minibuffer map additions to allow KP-4/5 termination of search strings. |
302 | ;; | |
303 | ") | |
304 | ||
f33e2ef1 SM |
305 | (insert (format "(define-key minibuffer-local-map %s 'tpu-search-forward-exit)\n" tpu-kp4)) |
306 | (insert (format "(define-key minibuffer-local-map %s 'tpu-search-backward-exit)\n" tpu-kp5)))) | |
18376c7c | 307 | |
f33e2ef1 | 308 | (insert " |
522f9216 RS |
309 | ;; Define the tpu-help-enter/return symbols |
310 | ;; | |
311 | ") | |
312 | ||
f33e2ef1 SM |
313 | (cond ((featurep 'xemacs) |
314 | (insert (format "(setq tpu-help-enter \"%s\")\n" tpu-enter-seq)) | |
315 | (insert (format "(setq tpu-help-return \"%s\")\n" tpu-return-seq)) | |
316 | (insert "(setq tpu-help-N \"[#<keypress-event N>]\")\n") | |
317 | (insert "(setq tpu-help-n \"[#<keypress-event n>]\")\n") | |
318 | (insert "(setq tpu-help-P \"[#<keypress-event P>]\")\n") | |
319 | (insert "(setq tpu-help-p \"[#<keypress-event p>]\")\n")) | |
320 | (t | |
321 | (insert (format "(setq tpu-help-enter \"%s\")\n" tpu-enter)))) | |
522f9216 | 322 | |
f33e2ef1 SM |
323 | (append-to-buffer "Keys" 1 (point)) |
324 | (set-buffer "Keys") | |
522f9216 | 325 | |
f33e2ef1 | 326 | ;; Save the key mapping program |
522f9216 | 327 | |
f33e2ef1 SM |
328 | (let ((file |
329 | (convert-standard-filename | |
330 | (if (featurep 'xemacs) "~/.tpu-lucid-keys" "~/.tpu-keys")))) | |
331 | (set-visited-file-name | |
332 | (read-file-name (format "Save key mapping to file (default %s): " file) "" file))) | |
333 | (save-buffer) | |
06bc58d8 | 334 | |
f33e2ef1 SM |
335 | ;; Load the newly defined keys and clean up |
336 | ||
337 | (require 'tpu-edt) | |
338 | (eval-buffer) | |
339 | (kill-buffer (current-buffer)) | |
340 | (kill-buffer "*scratch*") | |
341 | (kill-buffer "Gold-Keys") | |
342 | ||
343 | ;; Let them know it worked. | |
344 | ||
345 | (switch-to-buffer "Directions") | |
346 | (erase-buffer) | |
347 | (insert " | |
06bc58d8 RS |
348 | A custom TPU-edt keymap file has been created. |
349 | ||
350 | Press GOLD-k to remove this buffer and continue editing. | |
351 | ") | |
f33e2ef1 | 352 | (goto-char (point-min))) |
522f9216 | 353 | |
c8791c6a | 354 | ;; arch-tag: bab5872f-cd3a-4c1c-aedb-047b67646f6c |
522f9216 | 355 | ;;; tpu-mapper.el ends here |