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