home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / terms / vt200-esc-fix.el < prev    next >
Encoding:
Text File  |  1993-03-27  |  12.6 KB  |  336 lines
  1. ; From: "Jeff Morgenthaler" <jpmorgen@wisp4.physics.wisc.edu>
  2. ; Subject: stand alone vt200-esc-fix.el
  3. ; Date: Fri, 26 Mar 93 23:53:11 -0600
  4. ; 
  5. ;;; File:  vt200-esc-fix.el, v 4.0a (emacs 18[.58] version)
  6. ;;;
  7. ;;;               -----------   -----   -----
  8. ;;;               E s c a p e   K e y   F i x
  9. ;;;               -----------   -----   -----
  10. ;;;
  11. ;;;
  12. ;;; Copyright (C) 1990 Free Software Foundation, Inc.
  13. ;;; Copyright (C) 1993 Jeff Morgenthaler
  14. ;;; Thanks to Joe Wells for encouragement to code everything right.  
  15.  
  16.  
  17. ;; LCD Archive Entry:
  18. ;; vt200-esc-fix|Jeff Morgenthaler|jpmorgen@wisp4.physics.wisc.edu|
  19. ;; Fixes:  flow control, arrow keys, and vt200 function keys|
  20. ;; 23-Mar-1993|1.0|~/terms/vt200-esc-fix.el.Z|
  21.  
  22. ;; Archived at archive.cis.ohio-state.edu
  23.  
  24. ;;;
  25. ;;; GNU Emacs is distributed in the hope that it will be useful, but
  26. ;;; WITHOUT ANY WARRANTY.  No author or distributor accepts
  27. ;;; RESPONSIBILITY TO anyone for the consequences of using it or for
  28. ;;; whether it serves any particular purpose or works at all, unless 
  29. ;;; he says so in writing.  Refer to the GNU Emacs General Public
  30. ;;; License for full details.
  31. ;;;
  32. ;;;  Send bug reports and suggestions for improvement to Jeff Morgenthaler
  33. ;;;  (jpmorgen@wisp4.physics.wisc.edu).
  34. ;;;
  35. ;;; Everyone is granted permission to copy, modify and redistribute
  36. ;;; GNU Emacs, but only under the conditions described in the GNU
  37. ;;; Emacs General Public License.  A copy of this license is supposed
  38. ;;; to have been given to you along with GNU Emacs so you can know
  39. ;;; your rights and responsibilities.  It should be in a file named
  40. ;;; COPYING.  Among other things, the Copyright notice and this notice
  41. ;;; must be preserved on all copies.
  42. ;;;
  43.  
  44. ;;;; VT200 type terminals have no escape key. This causes great
  45. ;;;; trouble for emacs and another well known UNIX editor.  The most
  46. ;;;; popular solution to this problem is to run the terminal in vt100
  47. ;;;; mode (if possible).  This unfortunately makes the function keys
  48. ;;;; inaccessible (including "do," "find," etc) and puts the ESC key
  49. ;;;; in a rather inconvenient place (F11).  Another solution is to run
  50. ;;;; the terminal in vt200 mode and use M-x enable-arrow-keys.  This
  51. ;;;; maps F11 (which is really ESC[23~) to ESC-prefix.  Unfortunately,
  52. ;;;; ESC-prefix is not really ESC and some parts of emacs (like
  53. ;;;; isearch) have troubles with it (try to terminate an isearch with
  54. ;;;; F11 and you will get a [23~ in your buffer).
  55.  
  56. ;;;; The best solution is to get the terminal to remap some keys
  57. ;;;; (vt300s and xterms do this).  The usual remapping is to put the
  58. ;;;; ~/` key down on the </> key and put the < and > above the , and .
  59. ;;;; where they belong.  Also, F11 can sometimes be made to send a
  60. ;;;; real ESC, not an ESC[23~.
  61.  
  62. ;;;; This code simulates the above remappings as best as emacs allows.
  63. ;;;; First of all, there is no way software can tell the difference
  64. ;;;; between , and shift-, if the terminal sends the same character
  65. ;;;; for both.  This means that something is going to get lost.  Since
  66. ;;;; only one key is being remapped to ESC (` by default), I have
  67. ;;;; chosen to lose it.  
  68.  
  69. ;;;; You can probably see what's going to happen when you run this
  70. ;;;; code: everything is the same on the keyboard, except that when
  71. ;;;; you press ` you get ESC instead.  How will you get `?  This is
  72. ;;;; where the fun begins.  
  73.  
  74. ;;;; Earlier versions of this code assumed that you would just turn
  75. ;;;; escape-key-fix off whenever you wanted `.  You can still do this,
  76. ;;;; and in many respects this is the least confusing thing to do.
  77.  
  78. ;;;; In order to achieve easier access to the ` key, I have mapped
  79. ;;;; C-c-ESC to ` (this will actually look like C-c ` on your
  80. ;;;; keyboard).  You can also make the F11 key send ` with the code:
  81.  
  82. ;;;; (setq term-setup-hook
  83. ;;;;     (function
  84. ;;;;       (lambda ()
  85. ;;;;      (and (fboundp 'enable-arrow-keys)
  86. ;;;;           (progn
  87. ;;;;         (enable-arrow-keys)
  88. ;;;;         (define-key CSI-map "23~" 'type-escape-key-replacement)   ; F11
  89. ;;;;           ))
  90. ;;;;      ))
  91. ;;;; )
  92.  
  93. ;;;; Unfortunately, this is not good enough.  When processing C-x and
  94. ;;;; C-c events, emacs looks for literal keystrokes.  So, you cannot
  95. ;;;; use "C-x F11" for "C-x `."  Nor can you use C-x C-c ` (you will
  96. ;;;; be popped out of emacs).  Therefore, more keys have to be
  97. ;;;; remapped!  
  98.  
  99. ;;;; Again, since the ` key is the only messed up key, I have remapped
  100. ;;;; only the key bindings that use it (and that I know about).  So
  101. ;;;; far, I've remapped C-x ` (next-error) to C-x ~.  The binding of
  102. ;;;; C-x ~ (nil) is saved so that it can be restored when
  103. ;;;; escape-key-fix is turned off.  Tell me if there are any other
  104. ;;;; bindings that are effected and I will add them to
  105. ;;;; escape-key-fix-rebind-list.
  106.  
  107. ;;;; Unfortunately, there will be a fundamental problem if any local
  108. ;;;; modes remap these keys.  Code will have to be added to each of
  109. ;;;; these modes to remap things out of the way of `.  
  110.  
  111.  
  112. ;;;; Installation:
  113.  
  114. ;;;; To make this facility available for all users, place this file,
  115. ;;;; vt200-esc-fix.el, into your site's public emacs/lisp directory
  116. ;;;; and add the following command to your site's default.el file:
  117.  
  118. ;;;;        (require 'vt200-esc-fix)
  119. ;;;;            (auto-escape-key-fix)
  120.  
  121.  
  122. ;;;; This code can either be called interactively with "M-x escape-key-fix"
  123. ;;;; or started automatically with the code:
  124.  
  125. ;;;;  (setq terminal-needs-escape-key
  126. ;;;;        '("vt200" "vt201" "vt220" "vt240"))
  127.  
  128. ;;;; in the user's .emacs file.  To turn it off, just use "M-x
  129. ;;;; escape-key-fix" again.  
  130.  
  131. ;;;; The ESC key can be remapped to another key on the keyboard that
  132. ;;;; sends a single character (not the function keys, sorry) with the
  133. ;;;; code:
  134.  
  135. ;;;; (setq escape-key-replacement ?<)
  136. ;;;; (setq escape-key-fix-rebind-alist '(("\C-c\e" . "\C-c\e") 
  137. ;;;;                          ("\C-x<" . "\C-xl")))
  138.  
  139. ;;;; You can bind type-escape-key-replacement to any key.  For
  140. ;;;; instance, if you wanted C-t to send ` (or your customized
  141. ;;;; escape-key-replacement), you would use the code:
  142.  
  143. ;;;; (global-set-key "\C-t" 'type-escape-key-replacement)
  144.  
  145. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  146.  
  147. (provide 'vt200-esc-fix)
  148.  
  149.  
  150. ;; Define default ESC replacement and associated work arounds.  Tell me if 
  151. ;; there are any more conflicts.
  152.  
  153. (defvar escape-key-replacement ?`
  154.   "*Ascii code of escape key replacement.  Example of setting this variable: 
  155. (setq escape-key-replacement ?<).")
  156.  
  157. (defvar escape-key-fix-rebind-alist '(("\C-c\e" . "\C-c\e") 
  158.                      ("\C-x`" . "\C-x~"))
  159.   "*List containing pairs of key sequences.  The first element of each pair 
  160. is the key sequence messed up by escape-key-fix, the second is the key 
  161. sequence which replaces it.  If the key sequence is repeated, that key
  162. sequence is bound to type-escape-key-replacement.  Example of setting
  163. this variable: 
  164. \(setq escape-key-fix-rebind-alist '((""\\C-c\\e"" . ""\\C-c\\e"") 
  165.                      (""\\C-x<"" . ""\\C-xl""))).")
  166.  
  167. (defvar escape-key-fix-overmapped-complex-keys nil
  168.   "*List of cons cells.  The first element of each cell is a key sequence,
  169. the second is its binding when escape-key-fix is not active.")
  170.  
  171. (defvar escape-key-fix-remap-message nil
  172.   "*Message informing users of control sequence remappings.")
  173.  
  174.  
  175. (defun init-keyboard-translate-table ()
  176.   "Initialize translate table, saving previous mappings, if any."
  177.   (let ((the-table (make-string 256 0)))
  178.     ;; Some users of PC and DEMACS need a large keyboard-translate-table
  179.     (let ((i 0)
  180.       (j (length keyboard-translate-table)))
  181.       (while (< i j)
  182.     (aset the-table i (elt keyboard-translate-table i))
  183.     (setq i (1+ i)))
  184.       (while (< i 256)
  185.     (aset the-table i i)
  186.     (setq i (1+ i))))
  187.     (setq keyboard-translate-table the-table)))
  188.  
  189. (defun TERM-in-list (term-list)
  190.   "Returns t if the current terminal \(TERM\) is in term-list.  Drops 
  191. everything in TERM past the first hyphen. Example of term-list:
  192.   '\(""vt52"" ""vt100"" ""vt200""\)"
  193.   (let ((term (getenv "TERM"))
  194.     hyphend
  195.     TERM-in-list)
  196.     ;; Make sure TERM is set. Some people start emacs from their 
  197.     ;; .xinitrc or .xsession file, in which case TERM is not set
  198.     (if term
  199.     (progn
  200.       ;; Strip off hyphen and what follows
  201.       (while (setq hyphend (string-match "[-_][^-_]+$" term))
  202.         (setq term (substring term 0 hyphend)))
  203.       (let ((len (length term-list))
  204.         (idx 0)
  205.         (temp-term nil))
  206.         (while (and (< idx len)
  207.             (not temp-term))
  208.           (if (string-equal term 
  209.                 (nth idx term-list))
  210.           (progn
  211.             (setq TERM-in-list t)
  212.             (setq temp-term term))
  213.         (setq idx (1+ idx)))))))
  214.     TERM-in-list))
  215.  
  216.  
  217. (defun escape-key-fix-remap-complex-keys (rebind-alist)
  218.   "Remaps complex key sequences (like C-x `) for escape-key-fix.
  219. Creates escape-key-fix-overmapped-complex-keys and
  220. escape-key-fix-remap-message."
  221.   (while rebind-alist 
  222.     ;; Unpack rebind-alist.
  223.     (let ((old-key (car (car rebind-alist)))
  224.       (new-key (cdr (car rebind-alist))))
  225.       ;; Make a list of overmapped keys so they can be restored later
  226.       (setq escape-key-fix-overmapped-complex-keys 
  227.         (cons (cons new-key (key-binding new-key))
  228.           escape-key-fix-overmapped-complex-keys))
  229.       (if (string-equal new-key old-key)
  230.       ;; Signal to bind this key sequence to type-escape-key-replacemant
  231.       (progn
  232.         (global-set-key new-key 'type-escape-key-replacement)
  233.         (setq escape-key-fix-remap-message 
  234.           (concat escape-key-fix-remap-message 
  235.               (key-description new-key)
  236.               " is now " 
  237.               (single-key-description escape-key-replacement)
  238.               ".  ")))
  239.     (progn
  240.       (global-set-key new-key (key-binding old-key))
  241.       (setq escape-key-fix-remap-message 
  242.         (concat escape-key-fix-remap-message "Use "
  243.             (key-description new-key)
  244.             " for " 
  245.             (key-description old-key)
  246.             ".  "))))
  247.       (setq rebind-alist (cdr rebind-alist)))))
  248.  
  249.  
  250. (defun escape-key-fix-restore-complex-keys (overmapped-list)
  251.     (while overmapped-list 
  252.       (let ((restore-key (car (car overmapped-list)))
  253.         (displaced-function (cdr (car overmapped-list))))
  254.     (global-set-key restore-key displaced-function)
  255.     (setq overmapped-list (cdr overmapped-list))
  256.     )))
  257.  
  258.  
  259. (defun type-escape-key-replacement (arg)
  260.   "Inserts the character escape-key-replacement, since it is overwritten
  261. by escape-key-fix."
  262.   (interactive "p")
  263.   (insert-char escape-key-replacement arg))
  264.  
  265. (defvar escape-key-fix-flag nil
  266.   "*Flag to indicate if escape is remapped.")
  267.  
  268.  
  269. (defun escape-key-fix (arg)
  270.   "A quick fix for vt200 type keyboards which have no escape key.
  271. This function remaps escape-key-replacement \(` by default\) to ESC
  272. and provides hooks for remapping all other effected keys and key
  273. sequences \(escape-key-fix-rebind-alist\) for remaping effected complex
  274. control character sequences \(like C-x `\).  ALL remappings are
  275. restored when escape-key-fix is called again \(it toggles\).
  276.  
  277. This function is not intended for permanent use.  The best solution to
  278. the problem of the vt200 escape key is to fix your hardware.  In X
  279. windows, you can use xmodmap, on vt300s, you can remap keys in the
  280. setup menu."
  281.  
  282.   (interactive
  283.    (list
  284.     (if current-prefix-arg
  285.     ;; If an argument is specified, then turn on if non-negative else
  286.     ;; turn off if negative.
  287.     (>= (prefix-numeric-value current-prefix-arg) 0)
  288.       ;; If no argument is specified, then toggle.
  289.       'toggle)))
  290.  
  291.   (setq escape-key-fix-flag
  292.     (if (eq arg 'toggle)
  293.         (not escape-key-fix-flag)
  294.      arg))
  295.   ;; Thanks to the elisp prowess of jbw for the above sequence!
  296.  
  297.   (if escape-key-fix-flag
  298.       (progn
  299.     ;; Make the "escape-key-replacement" key send ESC.
  300.     ;; Can't swap them directly, since that messes up arrow/function keys.
  301.     (init-keyboard-translate-table)
  302.     (aset keyboard-translate-table  escape-key-replacement ?\e)
  303.     (setq escape-key-fix-remap-message nil)
  304.     (escape-key-fix-remap-complex-keys escape-key-fix-rebind-alist)
  305.     (message (concat "The "(single-key-description escape-key-replacement)
  306.              " key now sends ESC.  "
  307.              escape-key-fix-remap-message))
  308.     (sleep-for 1) ; Give user a chance to see message.
  309.       )
  310.     ;; reset ESC, escape-key-replacement, and the list of keys in 
  311.     ;; escape-key-fix-overmapped-complex-keys
  312.     (progn
  313.       (init-keyboard-translate-table)
  314.       (aset keyboard-translate-table ?\e ?\e)
  315.       (aset keyboard-translate-table 
  316.         escape-key-replacement escape-key-replacement)
  317.       (escape-key-fix-restore-complex-keys 
  318.        escape-key-fix-overmapped-complex-keys)
  319.       (setq escape-key-fix-overmapped-complex-keys nil)
  320.       (message 
  321.        (concat "The " (single-key-description escape-key-replacement)
  322.            " key is no longer ESC.  All associated bindings are reset."))
  323.       )
  324.     )
  325.   )
  326.  
  327. (defun auto-escape-key-fix ()
  328.   "Assigns the ESC key to the key named in escape-key-replacement using 
  329. escape-key-fix if the current terminal is is the list terminal-needs-escape.  
  330. Drops everthing in TERM past the first hyphen."
  331.   (if (boundp 'terminal-needs-escape-key)
  332.       (if (TERM-in-list terminal-needs-escape-key)
  333.       (escape-key-fix t))
  334.     )
  335.   )
  336.