home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / emacs-19.28-src.tgz / tar.out / fsf / emacs / lisp / tpu-mapper.el < prev    next >
Lisp/Scheme  |  1996-09-28  |  15KB  |  384 lines
  1. ;;; tpu-mapper.el  ---  Create a TPU-edt keymap file for x-windows emacs.
  2.  
  3. ;; Copyright (C) 1993, 1994 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 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.  
  16. ;; GNU Emacs is distributed in the hope that it will be useful,
  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.
  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.  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.  
  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. ;;;
  95. (defvar tpu-kp4 nil)
  96. (defvar tpu-kp5 nil)
  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. ;;;
  108. (if tpu-lucid-emacs19-p (set-screen-size (selected-screen) 80 36)
  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)
  169. (goto-char (point-min))
  170.  
  171. ;;;
  172. ;;;  Save <CR> for future reference
  173. ;;;
  174. (cond
  175.  (tpu-lucid-emacs19-p
  176.   (setq tpu-return-seq (read-key-sequence "Hit carriage-return <CR> to continue "))
  177.   (setq tpu-return (concat "[" (format "%s" (event-key (aref tpu-return-seq 0))) "]")))
  178.  (t
  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) "]")))) 
  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)
  205.   (message "Press %s%s: " ident descrip)
  206.   (setq tpu-key-seq (read-event))
  207.   (setq tpu-key (concat "[" (format "%s" tpu-key-seq) "]"))
  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")
  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"))
  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.  
  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.  
  353. (insert "
  354. ;;  Define the tpu-help-enter/return symbols
  355. ;;
  356. ")
  357.  
  358. (cond (tpu-lucid-emacs19-p
  359.        (insert (format "(setq tpu-help-enter \"%s\")\n" tpu-enter-seq))
  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"))
  365.       (t
  366.        (insert (format "(setq tpu-help-enter \"%s\")\n" tpu-enter))))
  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
  376.    (read-file-name (format "Save key mapping to file (default %s): " file) "" file)))
  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
  384.