cgit.sxemacs.org Git - packages/blob - xemacs-packages/tpu/tpu-mapper.el

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