1;;; tpu-mapper.el --- create a TPU-edt X-windows keymap file 2 3;; Copyright (C) 1993, 1994, 1995, 2001, 2002, 2003, 2004, 4;; 2005, 2006, 2007 Free Software Foundation, Inc. 5 6;; Author: Rob Riepel <riepel@networking.stanford.edu> 7;; Maintainer: Rob Riepel <riepel@networking.stanford.edu> 8;; Keywords: emulations 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 24;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 25;; Boston, MA 02110-1301, USA. 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 using the 37;; following command. 38 39;; emacs -q -l tpu-mapper 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 starting 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;; (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;;; 73;;; Make sure we're running X-windows and Emacs version 19 74;;; 75(cond 76 ((not (and window-system (not (string-lessp emacs-version "19")))) 77 (error "tpu-mapper requires running in Emacs 19, with an X display"))) 78 79 80;;; 81;;; Decide whether we're running Lucid Emacs or Emacs itself. 82;;; 83(defconst tpu-lucid-emacs19-p (string-match "Lucid" emacs-version) 84 "Non-nil if we are running Lucid Emacs version 19.") 85 86 87;;; 88;;; Key variables 89;;; 90(defvar tpu-kp4 nil) 91(defvar tpu-kp5 nil) 92(defvar tpu-key nil) 93(defvar tpu-enter nil) 94(defvar tpu-return nil) 95(defvar tpu-key-seq nil) 96(defvar tpu-enter-seq nil) 97(defvar tpu-return-seq nil) 98 99 100;;; 101;;; Make sure the window is big enough to display the instructions 102;;; 103(if tpu-lucid-emacs19-p (set-screen-size (selected-screen) 80 36) 104 (set-frame-size (selected-frame) 80 36)) 105 106 107;;; 108;;; Create buffers - Directions, Keys, Gold-Keys 109;;; 110(if (not (get-buffer "Directions")) (generate-new-buffer "Directions")) 111(if (not (get-buffer "Keys")) (generate-new-buffer "Keys")) 112(if (not (get-buffer "Gold-Keys")) (generate-new-buffer "Gold-Keys")) 113 114 115;;; 116;;; Put headers in the Keys buffer 117;;; 118(set-buffer "Keys") 119(insert "\ 120;; Key definitions for TPU-edt 121;; 122") 123 124 125;;; 126;;; Display directions 127;;; 128(switch-to-buffer "Directions") 129(insert " 130 This program prompts you to press keys to create a custom keymap file 131 for use with the x-windows version of Emacs and TPU-edt. 132 133 Start by pressing the RETURN key, and continue by pressing the keys 134 specified in the mini-buffer. You can re-arrange the TPU-edt keypad 135 by pressing any key you want at any prompt. If you want to entirely 136 omit a key, just press RETURN at the prompt. 137 138 Here's a picture of the standard TPU/edt keypad for reference: 139 140 _______________________ _______________________________ 141 | HELP | Do | | | | | | 142 |KeyDefs| | | | | | | 143 |_______|_______________| |_______|_______|_______|_______| 144 _______________________ _______________________________ 145 | Find |Insert |Remove | | Gold | HELP |FndNxt | Del L | 146 | | |Sto Tex| | key |E-Help | Find |Undel L| 147 |_______|_______|_______| |_______|_______|_______|_______| 148 |Select |Pre Scr|Nex Scr| | Page | Sect |Append | Del W | 149 | Reset |Pre Win|Nex Win| | Do | Fill |Replace|Undel W| 150 |_______|_______|_______| |_______|_______|_______|_______| 151 |Move up| |Forward|Reverse|Remove | Del C | 152 | Top | |Bottom | Top |Insert |Undel C| 153 _______|_______|_______ |_______|_______|_______|_______| 154 |Mov Lef|Mov Dow|Mov Rig| | Word | EOL | Char | | 155 |StaOfLi|Bottom |EndOfLi| |ChngCas|Del EOL|SpecIns| Enter | 156 |_______|_______|_______| |_______|_______|_______| | 157 | Line |Select | Subs | 158 | Open Line | Reset | | 159 |_______________|_______|_______| 160 161 162") 163(delete-other-windows) 164(goto-char (point-min)) 165 166;;; 167;;; Save <CR> for future reference 168;;; 169(cond 170 (tpu-lucid-emacs19-p 171 (setq tpu-return-seq (read-key-sequence "Hit carriage-return <CR> to continue ")) 172 (setq tpu-return (concat "[" (format "%s" (event-key (aref tpu-return-seq 0))) "]"))) 173 (t 174 (message "Hit carriage-return <CR> to continue ") 175 (setq tpu-return-seq (read-event)) 176 (setq tpu-return (concat "[" (format "%s" tpu-return-seq) "]")))) 177 178 179;;; 180;;; Key mapping functions 181;;; 182(defun tpu-lucid-map-key (ident descrip func gold-func) 183 (interactive) 184 (setq tpu-key-seq (read-key-sequence (format "Press %s%s: " ident descrip))) 185 (setq tpu-key (concat "[" (format "%s" (event-key (aref tpu-key-seq 0))) "]")) 186 (cond ((not (equal tpu-key tpu-return)) 187 (set-buffer "Keys") 188 (insert (format"(global-set-key %s %s)\n" tpu-key func)) 189 (set-buffer "Gold-Keys") 190 (insert (format "(define-key GOLD-map %s %s)\n" tpu-key gold-func)) 191 (set-buffer "Directions")) 192 ;; bogosity to get next prompt to come up, if the user hits <CR>! 193 ;; check periodically to see if this is still needed... 194 (t 195 (format "%s" tpu-key))) 196 tpu-key) 197 198(defun tpu-emacs-map-key (ident descrip func gold-func) 199 (interactive) 200 (message "Press %s%s: " ident descrip) 201 (setq tpu-key-seq (read-event)) 202 (setq tpu-key (concat "[" (format "%s" tpu-key-seq) "]")) 203 (cond ((not (equal tpu-key tpu-return)) 204 (set-buffer "Keys") 205 (insert (format"(global-set-key %s %s)\n" tpu-key func)) 206 (set-buffer "Gold-Keys") 207 (insert (format "(define-key GOLD-map %s %s)\n" tpu-key gold-func)) 208 (set-buffer "Directions")) 209 ;; bogosity to get next prompt to come up, if the user hits <CR>! 210 ;; check periodically to see if this is still needed... 211 (t 212 (format "%s" tpu-key))) 213 tpu-key) 214 215(fset 'tpu-map-key (if tpu-lucid-emacs19-p 'tpu-lucid-map-key 'tpu-emacs-map-key)) 216 217 218(set-buffer "Keys") 219(insert " 220;; Arrows 221;; 222") 223(set-buffer "Gold-Keys") 224(insert " 225;; GOLD Arrows 226;; 227") 228(set-buffer "Directions") 229 230(tpu-map-key "Up-Arrow" "" "'tpu-previous-line" "'tpu-move-to-beginning") 231(tpu-map-key "Down-arrow" "" "'tpu-next-line" "'tpu-move-to-end") 232(tpu-map-key "Right-arrow" "" "'tpu-forward-char" "'end-of-line") 233(tpu-map-key "Left-arrow" "" "'tpu-backward-char" "'beginning-of-line") 234 235 236(set-buffer "Keys") 237(insert " 238;; PF keys 239;; 240") 241(set-buffer "Gold-Keys") 242(insert " 243;; GOLD PF keys 244;; 245") 246(set-buffer "Directions") 247 248(tpu-map-key "PF1" " - The GOLD key" "GOLD-map" "'keyboard-quit") 249(tpu-map-key "PF2" " - The Keypad Help key" "'tpu-help" "'help-for-help") 250(tpu-map-key "PF3" " - The Find/Find-Next key" "'tpu-search-again" "'tpu-search") 251(tpu-map-key "PF4" " - The Del/Undelete Line key" "'tpu-delete-current-line" "'tpu-undelete-lines") 252 253(set-buffer "Keys") 254(insert " 255;; KP0-9 KP- KP, KP. and KPenter 256;; 257") 258(set-buffer "Gold-Keys") 259(insert " 260;; GOLD KP0-9 KP- KP, and KPenter 261;; 262") 263(set-buffer "Directions") 264 265(tpu-map-key "KP-0" " - The Line/Open-Line key" "'tpu-line" "'open-line") 266(tpu-map-key "KP-1" " - The Word/Change-Case key" "'tpu-word" "'tpu-change-case") 267(tpu-map-key "KP-2" " - The EOL/Delete-EOL key" "'tpu-end-of-line" "'tpu-delete-to-eol") 268(tpu-map-key "KP-3" " - The Character/Special-Insert key" "'tpu-char" "'tpu-special-insert") 269(setq tpu-kp4 (tpu-map-key "KP-4" " - The Forward/Bottom key" "'tpu-advance-direction" "'tpu-move-to-end")) 270(setq tpu-kp5 (tpu-map-key "KP-5" " - The Reverse/Top key" "'tpu-backup-direction" "'tpu-move-to-beginning")) 271(tpu-map-key "KP-6" " - The Remove/Insert key" "'tpu-cut" "'tpu-paste") 272(tpu-map-key "KP-7" " - The Page/Do key" "'tpu-page" "'execute-extended-command") 273(tpu-map-key "KP-8" " - The Section/Fill key" "'tpu-scroll-window" "'tpu-fill") 274(tpu-map-key "KP-9" " - The Append/Replace key" "'tpu-append-region" "'tpu-replace") 275(tpu-map-key "KP--" " - The Delete/Undelete Word key" "'tpu-delete-current-word" "'tpu-undelete-words") 276(tpu-map-key "KP-," " - The Delete/Undelete Character key" "'tpu-delete-current-char" "'tpu-undelete-char") 277(tpu-map-key "KP-." " - The Select/Reset key" "'tpu-select" "'tpu-unselect") 278(tpu-map-key "KP-Enter" " - The Enter key on the numeric keypad" "'newline" "'tpu-substitute") 279;; Save the enter key 280(setq tpu-enter tpu-key) 281(setq tpu-enter-seq tpu-key-seq) 282 283(set-buffer "Keys") 284(insert " 285;; Editing keypad (find, insert, remove) 286;; (select, prev, next) 287;; 288") 289(set-buffer "Gold-Keys") 290(insert " 291;; GOLD Editing keypad (find, insert, remove) 292;; (select, prev, next) 293;; 294") 295(set-buffer "Directions") 296 297(tpu-map-key "Find" " - The Find key on the editing keypad" "'tpu-search" "'nil") 298(tpu-map-key "Insert" " - The Insert key on the editing keypad" "'tpu-paste" "'nil") 299(tpu-map-key "Remove" " - The Remove key on the editing keypad" "'tpu-cut" "'tpu-store-text") 300(tpu-map-key "Select" " - The Select key on the editing keypad" "'tpu-select" "'tpu-unselect") 301(tpu-map-key "Prev Scr" " - The Prev Scr key on the editing keypad" "'tpu-scroll-window-down" "'tpu-previous-window") 302(tpu-map-key "Next Scr" " - The Next Scr key on the editing keypad" "'tpu-scroll-window-up" "'tpu-next-window") 303 304(set-buffer "Keys") 305(insert " 306;; F10-14 Help Do F17 307;; 308") 309(set-buffer "Gold-Keys") 310(insert " 311;; GOLD F10-14 Help Do F17 312;; 313") 314(set-buffer "Directions") 315 316(tpu-map-key "F10" " - Invokes the Exit function on VT200+ terminals" "'tpu-exit" "'nil") 317(tpu-map-key "F11" " - Inserts an Escape character into the text" "'tpu-insert-escape" "'nil") 318(tpu-map-key "Backspace" " - Not Delete nor ^H! Sometimes on the F12 key" "'tpu-next-beginning-of-line" "'nil") 319(tpu-map-key "F13" " - Invokes the delete previous word function" "'tpu-delete-previous-word" "'nil") 320(tpu-map-key "F14" " - Toggles insert/overstrike modes" "'tpu-toggle-overwrite-mode" "'nil") 321(tpu-map-key "Help" " - Brings up the help screen, same as PF2" "'tpu-help" "'describe-bindings") 322(tpu-map-key "Do" " - Invokes the COMMAND function" "'execute-extended-command" "'nil") 323(tpu-map-key "F17" "" "'tpu-goto-breadcrumb" "'tpu-drop-breadcrumb") 324 325(set-buffer "Gold-Keys") 326(cond 327 ((not (equal tpu-enter tpu-return)) 328 (insert " 329;; Minibuffer map additions to make KP_enter = RET 330;; 331") 332 333 (insert (format "(define-key minibuffer-local-map %s 'exit-minibuffer)\n" tpu-enter)) 334 (insert (format "(define-key minibuffer-local-ns-map %s 'exit-minibuffer)\n" tpu-enter)) 335 (insert (format "(define-key minibuffer-local-completion-map %s 'exit-minibuffer)\n" tpu-enter)) 336 (insert (format "(define-key minibuffer-local-must-match-map %s 'minibuffer-complete-and-exit)\n" tpu-enter)))) 337 338(cond 339 ((not (or (equal tpu-kp4 tpu-return) (equal tpu-kp5 tpu-return))) 340 (insert " 341;; Minibuffer map additions to allow KP-4/5 termination of search strings. 342;; 343") 344 345 (insert (format "(define-key minibuffer-local-map %s 'tpu-search-forward-exit)\n" tpu-kp4)) 346 (insert (format "(define-key minibuffer-local-map %s 'tpu-search-backward-exit)\n" tpu-kp5)))) 347 348(insert " 349;; Define the tpu-help-enter/return symbols 350;; 351") 352 353(cond (tpu-lucid-emacs19-p 354 (insert (format "(setq tpu-help-enter \"%s\")\n" tpu-enter-seq)) 355 (insert (format "(setq tpu-help-return \"%s\")\n" tpu-return-seq)) 356 (insert "(setq tpu-help-N \"[#<keypress-event N>]\")\n") 357 (insert "(setq tpu-help-n \"[#<keypress-event n>]\")\n") 358 (insert "(setq tpu-help-P \"[#<keypress-event P>]\")\n") 359 (insert "(setq tpu-help-p \"[#<keypress-event p>]\")\n")) 360 (t 361 (insert (format "(setq tpu-help-enter \"%s\")\n" tpu-enter)))) 362 363(append-to-buffer "Keys" 1 (point)) 364(set-buffer "Keys") 365 366;;; 367;;; Save the key mapping program 368;;; 369(let ((file 370 (convert-standard-filename 371 (if tpu-lucid-emacs19-p "~/.tpu-lucid-keys" "~/.tpu-keys")))) 372 (set-visited-file-name 373 (read-file-name (format "Save key mapping to file (default %s): " file) "" file))) 374(save-buffer) 375 376;;; 377;;; Load the newly defined keys and clean up 378;;; 379(eval-buffer) 380(kill-buffer (current-buffer)) 381(kill-buffer "*scratch*") 382(kill-buffer "Gold-Keys") 383 384;;; 385;;; Let them know it worked. 386;;; 387(switch-to-buffer "Directions") 388(erase-buffer) 389(insert " 390 A custom TPU-edt keymap file has been created. 391 392 Press GOLD-k to remove this buffer and continue editing. 393") 394(goto-char (point-min)) 395 396;;; arch-tag: bab5872f-cd3a-4c1c-aedb-047b67646f6c 397;;; tpu-mapper.el ends here 398