home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / misc / flow-ctrl.el < prev    next >
Encoding:
Text File  |  1993-06-22  |  11.1 KB  |  275 lines
  1. ;;; File:  flow-ctrl.el, v 3.1 (emacs 18/19 version)
  2. ;;;
  3. ;;;               -------   -------------   ---------------------
  4. ;;;               F l o w   C o n t r o l   A d j u s t m e n t s
  5. ;;;               -------   -------------   ---------------------
  6. ;;;
  7. ;;;
  8. ;;; Copyright (C) 1990 Free Software Foundation, Inc.
  9. ;;; Copyright (C) 1993 Jeff Morgenthaler
  10. ;;; Thanks to Kevin Gallagher for TERM-in-list and Joe Wells for
  11. ;;; encouragement to code everything right.  
  12. ;;;
  13.  
  14. ;; LCD Archive Entry:
  15. ;; flow-ctrl.el|Jeff Morgenthaler|jpmorgen@wisp4.physics.wisc.edu|
  16. ;; A better wrapper for remapping C-s and C-q for XON-XOFF hobbled terms.|
  17. ;; 9-Jun-1993|3.1|~/misc/flow-ctrl.el.Z|
  18.  
  19. ;; Archived at archive.cis.ohio-state.edu
  20.  
  21.  
  22. ;;; GNU Emacs is distributed in the hope that it will be useful, but
  23. ;;; WITHOUT ANY WARRANTY.  No author or distributor accepts
  24. ;;; RESPONSIBILITY TO anyone for the consequences of using it or for
  25. ;;; whether it serves any particular purpose or works at all, unless 
  26. ;;; he says so in writing.  Refer to the GNU Emacs General Public
  27. ;;; License for full details.
  28. ;;;
  29. ;;;  Send bug reports and suggestions for improvement to Jeff Morgenthaler
  30. ;;;  (jpmorgen@wisp4.physics.wisc.edu).
  31. ;;;
  32. ;;; Everyone is granted permission to copy, modify and redistribute
  33. ;;; GNU Emacs, but only under the conditions described in the GNU
  34. ;;; Emacs General Public License.  A copy of this license is supposed
  35. ;;; to have been given to you along with GNU Emacs so you can know
  36. ;;; your rights and responsibilities.  It should be in a file named
  37. ;;; COPYING.  Among other things, the Copyright notice and this notice
  38. ;;; must be preserved on all copies.
  39. ;;;
  40.  
  41. ;;;; XON/XOFF flow control is a primitive user interface scheme 
  42. ;;;; employed by most terminals, terminal servers, modems, and
  43. ;;;; operating systems.  XON/XOFF flow control allows the user,
  44. ;;;; terminal, modem, etc. to pause the data stream at any time for
  45. ;;;; whatever reason.  The standard flow control commands are C-s for
  46. ;;;; stop and C-q for "quontinue" (at least that's how I remember it).
  47.  
  48. ;;;; Users of GNU emacs will recognize C-s and C-q as the commands
  49. ;;;; isearch-forward and quote-insert, and part of the commands
  50. ;;;; save-buffer and toggle-read-only.  It does not take very long to
  51. ;;;; recognize the usefulness of these bindings in emacs (and the
  52. ;;;; emacs model in general--mnemonic key bindings) over any
  53. ;;;; usefulness that XON/XOFF flow control had or will ever had.
  54.  
  55. ;;;; Emacs does the best it can to turn XON/XOFF flow control off.
  56. ;;;; Unfortunately, due to poor planing on the part of the inventors
  57. ;;;; of XON/XOFF flow control, it is only possible to disable flow
  58. ;;;; control on the machine that is running emacs: there is no
  59. ;;;; standard sequence of characters that a remote terminal, modem,
  60. ;;;; operating system, etc. will interpret to mean "disable flow
  61. ;;;; control."
  62.  
  63. ;;;; Thus, it is up to each user to make sure that XON/XOFF flow
  64. ;;;; control is disabled at all hardware between the user and the
  65. ;;;; machine running emacs.  Terminals usually have an item in their
  66. ;;;; setup menu for flow control or "hsk."  Modems using the Hayes
  67. ;;;; standard "at" commands should respond to at&k0.  Terminal or
  68. ;;;; modem servers will often have a command such as "set port flow
  69. ;;;; control disable" to be issued an the "local" prompt.  In VMS, you
  70. ;;;; can issue the command SET TERM/PASSALL.  In UNIX, you can try
  71. ;;;; "stty start u stop u," rlogin -8, or use telnet....
  72.  
  73. ;;;; Unfortunately (and you probably wouldn't be reading this if this
  74. ;;;; wasn't the case for you) it is sometimes impossible or
  75. ;;;; inconvenient at the moment to disable flow control.  Emacs has
  76. ;;;; always had a solution for this: the C-\ and C-^ keys are not
  77. ;;;; bound to anything (unlike all the other control characters in
  78. ;;;; emacs).  Following the emacs model, these keys are fairly
  79. ;;;; mnemonic: C-\ (that is back-Slash) resembles / which is search in
  80. ;;;; more/vi/ed) and C-^ can clearly be associated with the ^ produced
  81. ;;;; by C-q C-w.  Also, emacs has a function (set-input-mode) which
  82. ;;;; allows the C-s and C-q characters to be passed to the machine on
  83. ;;;; which emacs is running in case the terminal, modem, server, etc.,
  84. ;;;; really can't handle the rate of data flow and has no other means
  85. ;;;; of flow control.
  86.  
  87. ;;;; What has been missing up to now has been a decent wrapper for
  88. ;;;; these already existing features so that users can function in
  89. ;;;; emacs even when they are stuck on broken hardware without
  90. ;;;; becoming expert emacs code writers.  By "decent wrapper" I mean a
  91. ;;;; function that can be called interactively (with M-x) that is
  92. ;;;; sensibly named.  The function should not interfere with other
  93. ;;;; functions which remap the keys and it should toggle, cleaning up
  94. ;;;; completely after itself.  Variables for customizing the key
  95. ;;;; remappings and an auto-start feature should also be included.
  96.  
  97. ;;;; flow-control-fix is such a function.
  98.  
  99. ;;;; The variables C-s-replacement, C-q-replacement and
  100. ;;;; terminal-uses-flow-control-chars are available for customization
  101. ;;;; of flow-control-fix.  Here are some examples of how to set them
  102. ;;;; (you would put these in your .emacs file):
  103.  
  104. ;;;; (setq C-s-replacement ?\C-t)
  105. ;;;; (setq terminal-uses-flow-control-chars 
  106. ;;;;   '("vt52" "vt100" "vt200"))
  107.  
  108. ;;;; TERM-in-list and init-keyboard-translate-table, which are useful
  109. ;;;; functions for further user customizations are also also defined.
  110.  
  111. ;;;; To make this facility available for use to all users, place this file
  112. ;;;; (flow-ctrl.el) into your site's public emacs/lisp directory and
  113. ;;;; add the following lines to your site's default.el file:
  114.  
  115. ;;;; (require 'flow-ctrl)
  116. ;;;; (auto-flow-control-fix)
  117.  
  118. ;;;; You may also want to preload flow-ctrl into emacs by putting the
  119. ;;;; code:
  120.  
  121. ;;;; (load "flow-ctrl")
  122.  
  123. ;;;; in your site-init.el file.  This will allow the functions
  124. ;;;; TERM-in-list and init-keyboard-translate-table to be called in
  125. ;;;; the user's .emacs file outside of their term-setup-hook.
  126.  
  127. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  128.  
  129. (provide 'flow-ctrl)
  130.  
  131. ;; default C-s, C-q replacements
  132. (defvar C-s-replacement ?\C-\\
  133.   "*Ascii version of character to substitute for Control-S.  Example of 
  134. setting this variable: (setq C-s-replacement ?\\C-t).")
  135.  
  136. (defvar C-q-replacement ?\C-^
  137.   "*Ascii version of character to substitute for Control-Q.  Example of 
  138. setting this variable: (setq C-q-replacement ?\\C-]).")
  139.  
  140. (defvar terminal-uses-flow-control-chars nil
  141.   "*List of general terminal types used by the user which are often 
  142. flow-control hobbled.  Used by auto-flow-control-fix.  Example of setting 
  143. this variable:
  144. (setq terminal-uses-flow-control-chars 
  145.    '(""vt52"" ""vt100"" ""vt200""))")
  146.  
  147. (defvar flow-control-fix-flag nil
  148.   "*Flag to indicate if flow control avoidance is in effect.")
  149.  
  150. (defun init-keyboard-translate-table ()
  151.   "Initialize translate table, saving previous mappings, if any."
  152.   (let ((the-table (make-string 256 0)))
  153.     ;; Some users of PC and DEMACS need a large keyboard-translate-table
  154.     (let ((i 0)
  155.       (j (length keyboard-translate-table)))
  156.       (while (< i j)
  157.     (aset the-table i (elt keyboard-translate-table i))
  158.     (setq i (1+ i)))
  159.       (while (< i 256)
  160.     (aset the-table i i)
  161.     (setq i (1+ i))))
  162.     (setq keyboard-translate-table the-table)))
  163.  
  164. (defun TERM-in-list (term-list)
  165.   "Returns t if the current terminal \(TERM\) is in term-list.  Drops 
  166. everything in TERM past the first hyphen. Example of term-list:
  167.   '\(""vt52"" ""vt100"" ""vt200""\)"
  168.   (let ((term (getenv "TERM"))
  169.     hyphend
  170.     TERM-in-list)
  171.     ;; Make sure TERM is set. Some people start emacs from their 
  172.     ;; .xinitrc or .xsession file, in which case TERM is not set
  173.     (if term
  174.     (progn
  175.       ;; Strip off hyphen and what follows
  176.       (while (setq hyphend (string-match "[-_][^-_]+$" term))
  177.         (setq term (substring term 0 hyphend)))
  178.       (let ((len (length term-list))
  179.         (idx 0)
  180.         (temp-term nil))
  181.         (while (and (< idx len)
  182.             (not temp-term))
  183.           (if (string-equal term 
  184.                 (nth idx term-list))
  185.           (progn
  186.             (setq TERM-in-list t)
  187.             (setq temp-term term))
  188.         (setq idx (1+ idx)))))))
  189.     TERM-in-list))
  190.  
  191. (defun flow-control-fix (arg)
  192.   "Replaces C-s with C-s-replacement, C-q with C-q-replacement \(C-\\
  193. and C-^ by default\) and tells emacs to pass C-s and C-q on to the
  194. operating system.  Gets around XON/XOFF flow control.  This is a last
  195. resort fix!  First try turning off flow control at your terminal \(with
  196. the setup menu\), modem \(at&k0\), terminal server \(set port flow
  197. control disable\), machine you are logging in through \(SET TERM/PASSALL
  198. or rlogin -8\), etc.  Turns on with an argument of t or a positive
  199. argument, off with an argument of nil or negative argument, and toggles 
  200. with no argument."
  201.  
  202.   (interactive
  203.    (list
  204.     (if current-prefix-arg
  205.     ;; If an argument is specified, then turn on if non-negative else
  206.     ;; turn off if negative.
  207.     (>= (prefix-numeric-value current-prefix-arg) 0)
  208.       ;; If no argument is specified, then toggle.
  209.       'toggle)))
  210.  
  211.   (setq flow-control-fix-flag
  212.     (if (eq arg 'toggle)
  213.         (not flow-control-fix-flag)
  214.      arg))
  215.   ;; Thanks to the elisp prowess of jbw for the above sequence!
  216.  
  217.  
  218.   (if flow-control-fix-flag
  219.     ;; Tell emacs to pass C-s and C-q to OS and swap out C-s and C-q.
  220.     (progn
  221.       (if (string-match "^19" emacs-version)
  222.       (set-input-mode nil t nil)
  223.     (set-input-mode nil t))
  224.       (init-keyboard-translate-table)
  225.       ;; Swap C-s and C-s-replacement
  226.       (aset keyboard-translate-table C-s-replacement ?\^s)
  227.       (aset keyboard-translate-table ?\^s C-s-replacement)
  228.       ;; Swap C-q and C-q-replacement
  229.       (aset keyboard-translate-table C-q-replacement ?\^q)
  230.       (aset keyboard-translate-table ?\^q C-q-replacement)
  231.       (message (concat "XON/XOFF adjustment for " 
  232.                  (getenv "TERM") 
  233.                ":  use "(single-key-description C-s-replacement)
  234.                " for C-s  and  use  "
  235.                (single-key-description C-q-replacement)
  236.                " for C-q."))
  237.       (sleep-for 1) ; Give user a chance to see message.
  238.       )
  239.     ;; Tell emacs to not pass C-s and C-q to OS and reset keys.
  240.     (progn
  241.       (if (string-match "^19" emacs-version)
  242.       (set-input-mode nil nil nil)
  243.     (set-input-mode nil nil))
  244.       ;; Restore C-s and C-s-replacement
  245.       (init-keyboard-translate-table)
  246.       (aset keyboard-translate-table ?\^s ?\^s)
  247.       (aset keyboard-translate-table C-s-replacement C-s-replacement)
  248.       ;; Restore C-q and C-q-replacement
  249.       (aset keyboard-translate-table ?\^q ?\^q)
  250.       (aset keyboard-translate-table C-q-replacement C-q-replacement)
  251.       (message "C-s and C-q restored.")
  252.       )
  253.     )
  254.   )
  255.  
  256. (defun auto-flow-control-fix ()
  257.   "Enables flow control avoidance using flow-control-fix if the user is
  258. not using X windows and the current terminal (TERM) is in the
  259. terminal-uses-flow-control-chars list.  Drops everything in TERM past
  260. the first hyphen."
  261.  
  262.   (if (or 
  263.        ;; invoked from a shell directly under an xterm:
  264.        (and (getenv "DISPLAY")
  265.         (getenv "WINDOWID")
  266.         (equal (getenv "TERM") "xterm"))
  267.        ;; this is a direct X client:
  268.        (eq 'x window-system))
  269.       ;; Never enable flow control avoidance if you are running X, no
  270.       ;; matter what the TERM variable is set to. (Thanks Joe).
  271.       nil
  272.     (if (TERM-in-list terminal-uses-flow-control-chars)
  273.     (flow-control-fix t)))
  274. )
  275.