code.delx.au - gnu-emacs/blob - lisp/flow-ctrl.el

   1 ;;; flow-ctrl.el --- help for lusers on cu(1) or ttys with wired-in ^S/^Q flow control
   2
   3 ;;; Copyright (C) 1990, 1991 Free Software Foundation, Inc.
   4
   5 ;; Author Kevin Gallagher
   6 ;; Maintainer: FSF
   7 ;; Adapted-By: ESR
   8 ;; Keywords: hardware
   9
  10 ;;; This file is part of GNU Emacs.
  11 ;;;
  12 ;;; GNU Emacs is distributed in the hope that it will be useful, but
  13 ;;; WITHOUT ANY WARRANTY.  No author or distributor accepts
  14 ;;; RESPONSIBILITY TO anyone for the consequences of using it or for
  15 ;;; whether it serves any particular purpose or works at all, unless
  16 ;;; he says so in writing.  Refer to the GNU Emacs General Public
  17 ;;; License for full details.
  18 ;;;
  19 ;;; Everyone is granted permission to copy, modify and redistribute
  20 ;;; GNU Emacs, but only under the conditions described in the GNU
  21 ;;; Emacs General Public License.  A copy of this license is supposed
  22 ;;; to have been given to you along with GNU Emacs so you can know
  23 ;;; your rights and responsibilities.  It should be in a file named
  24 ;;; COPYING.  Among other things, the Copyright notice and this notice
  25 ;;; must be preserved on all copies.
  26
  27 ;;; Commentary:
  28
  29 ;;;; Terminals that use XON/XOFF flow control can cause problems with
  30 ;;;; GNU Emacs users.  This file contains Emacs Lisp code that makes it
  31 ;;;; easy for a user to deal with this problem, when using such a
  32 ;;;; terminal.
  33 ;;;;
  34 ;;;; To invoke these adjustments, a user need only invoke the function
  35 ;;;; enable-flow-control-on with a list of terminal types in his/her own
  36 ;;;; .emacs file.  As arguments, give it the names of one or more terminal
  37 ;;;; types in use by that user which require flow control adjustments.
  38 ;;;; Here's an example:
  39 ;;;;
  40 ;;;;    (enable-flow-control-on "vt200" "vt300" "vt101" "vt131")
  41
  42 ;;; Portability note: This uses (getenv "TERM"), and therefore probably
  43 ;;; won't work outside of UNIX-like environments.
  44
  45 ;;; Code:
  46
  47 (defvar flow-control-c-s-replacement ?\034
  48   "Character that replaces C-s, when flow control handling is enabled.")
  49 (defvar flow-control-c-q-replacement ?\036
  50   "Character that replaces C-q, when flow control handling is enabled.")
  51
  52 ;;;###autoload
  53 (defun enable-flow-control (&optional argument)
  54   "Toggle flow control handling.
  55 When handling is enabled, user can type C-s as C-\\, and C-q as C-^.
  56 With arg, enable flow control mode if arg is positive, otherwise disable."
  57   (interactive "P")
  58   (if (if argument
  59           ;; Argument means enable if arg is positive.
  60           (<= (prefix-numeric-value argument) 0)
  61         ;; No arg means toggle.
  62         (nth 1 (current-input-mode)))
  63       (progn
  64         ;; Turn flow control off, and stop exchanging chars.
  65         (set-input-mode t nil (nth 2 (current-input-mode)))
  66         (aset keyboard-translate-table flow-control-c-s-replacement nil)
  67         (aset keyboard-translate-table ?\^s nil)
  68         (aset keyboard-translate-table flow-control-c-q-replacement nil)
  69         (aset keyboard-translate-table ?\^q nil))
  70     ;; Turn flow control on.
  71     ;; Tell emacs to pass C-s and C-q to OS.
  72     (set-input-mode nil t (nth 2 (current-input-mode)))
  73     ;; Initialize translate table, saving previous mappings, if any.
  74     (let ((the-table (make-string 128 0)))
  75       (let ((i 0)
  76             (j (length keyboard-translate-table)))
  77         (while (< i j)
  78           (aset the-table i (elt keyboard-translate-table i))
  79           (setq i (1+ i)))
  80         (while (< i 128)
  81           (aset the-table i i)
  82           (setq i (1+ i))))
  83       (setq keyboard-translate-table the-table))
  84     ;; Swap C-s and C-\
  85     (aset keyboard-translate-table flow-control-c-s-replacement ?\^s)
  86     (aset keyboard-translate-table ?\^s flow-control-c-s-replacement)
  87     ;; Swap C-q and C-^
  88     (aset keyboard-translate-table flow-control-c-q-replacement ?\^q)
  89     (aset keyboard-translate-table ?\^q flow-control-c-q-replacement)
  90     (message (concat
  91               "XON/XOFF adjustment for "
  92               (getenv "TERM")
  93               ":  use C-\\ for C-s  and  use C-^ for C-q."))
  94     (sleep-for 2)))                     ; Give user a chance to see message.
  95
  96 ;;;###autoload
  97 (defun enable-flow-control-on (&rest losing-terminal-types)
  98   "Enable flow control if using one of a specified set of terminal types.
  99 Use `(enable-flow-control-on \"vt100\" \"h19\")' to enable flow control
 100 on VT-100 and H19 terminals.  When flow control is enabled,
 101 you must type C-\\ to get the effect of a C-s, and type C-^
 102 to get the effect of a C-q."
 103   (let ((term (getenv "TERM"))
 104         hyphend)
 105     (if term
 106         (progn
 107           ;; Strip off hyphen and what follows
 108           (while (setq hyphend (string-match "[-_][^-_]+$" term))
 109             (setq term (substring term 0 hyphend)))
 110           (and (member term losing-terminal-types)
 111                (enable-flow-control))))))
 112
 113 (provide 'flow-ctrl)
 114
 115 ;;; flow-ctrl.el ends here