| 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, 1994, 2002, 2003, 2004, |
| 4 | ;; 2005, 2006 Free Software Foundation, Inc. |
| 5 | |
| 6 | ;; Author Kevin Gallagher |
| 7 | ;; Maintainer: FSF |
| 8 | ;; Adapted-By: ESR |
| 9 | ;; Keywords: hardware |
| 10 | |
| 11 | ;; This file is part of GNU Emacs. |
| 12 | |
| 13 | ;; GNU Emacs is free software; you can redistribute it and/or modify |
| 14 | ;; it under the terms of the GNU General Public License as published by |
| 15 | ;; the Free Software Foundation; either version 2, or (at your option) |
| 16 | ;; any later version. |
| 17 | |
| 18 | ;; GNU Emacs is distributed in the hope that it will be useful, |
| 19 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 20 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 21 | ;; GNU General Public License for more details. |
| 22 | |
| 23 | ;; You should have received a copy of the GNU General Public License |
| 24 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
| 25 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
| 26 | ;; Boston, MA 02110-1301, USA. |
| 27 | |
| 28 | ;;; Commentary: |
| 29 | |
| 30 | ;; Terminals that use XON/XOFF flow control can cause problems with |
| 31 | ;; GNU Emacs users. This file contains Emacs Lisp code that makes it |
| 32 | ;; easy for a user to deal with this problem, when using such a |
| 33 | ;; terminal. |
| 34 | ;; |
| 35 | ;; To invoke these adjustments, a user need only invoke the function |
| 36 | ;; enable-flow-control-on with a list of terminal types in his/her own |
| 37 | ;; .emacs file. As arguments, give it the names of one or more terminal |
| 38 | ;; types in use by that user which require flow control adjustments. |
| 39 | ;; Here's an example: |
| 40 | ;; |
| 41 | ;; (enable-flow-control-on "vt200" "vt300" "vt101" "vt131") |
| 42 | |
| 43 | ;; Portability note: This uses (getenv "TERM"), and therefore probably |
| 44 | ;; won't work outside of UNIX-like environments. |
| 45 | |
| 46 | ;;; Code: |
| 47 | |
| 48 | (defvar flow-control-c-s-replacement ?\034 |
| 49 | "Character that replaces C-s, when flow control handling is enabled.") |
| 50 | (defvar flow-control-c-q-replacement ?\036 |
| 51 | "Character that replaces C-q, when flow control handling is enabled.") |
| 52 | |
| 53 | (put 'keyboard-translate-table 'char-table-extra-slots 0) |
| 54 | |
| 55 | ;;;###autoload |
| 56 | (defun enable-flow-control (&optional argument) |
| 57 | "Toggle flow control handling. |
| 58 | When handling is enabled, user can type C-s as C-\\, and C-q as C-^. |
| 59 | With arg, enable flow control mode if arg is positive, otherwise disable." |
| 60 | (interactive "P") |
| 61 | (if (if argument |
| 62 | ;; Argument means enable if arg is positive. |
| 63 | (<= (prefix-numeric-value argument) 0) |
| 64 | ;; No arg means toggle. |
| 65 | (nth 1 (current-input-mode))) |
| 66 | (progn |
| 67 | ;; Turn flow control off, and stop exchanging chars. |
| 68 | (set-input-mode t nil (nth 2 (current-input-mode))) |
| 69 | (if keyboard-translate-table |
| 70 | (progn |
| 71 | (aset keyboard-translate-table flow-control-c-s-replacement nil) |
| 72 | (aset keyboard-translate-table ?\^s nil) |
| 73 | (aset keyboard-translate-table flow-control-c-q-replacement nil) |
| 74 | (aset keyboard-translate-table ?\^q nil)))) |
| 75 | ;; Turn flow control on. |
| 76 | ;; Tell emacs to pass C-s and C-q to OS. |
| 77 | (set-input-mode nil t (nth 2 (current-input-mode))) |
| 78 | ;; Initialize translate table, saving previous mappings, if any. |
| 79 | (cond ((null keyboard-translate-table) |
| 80 | (setq keyboard-translate-table |
| 81 | (make-char-table 'keyboard-translate-table nil))) |
| 82 | ((char-table-p keyboard-translate-table) |
| 83 | (setq keyboard-translate-table |
| 84 | (copy-sequence keyboard-translate-table))) |
| 85 | (t |
| 86 | (let ((the-table (make-char-table 'keyboard-translate-table nil))) |
| 87 | (let ((i 0) |
| 88 | (j (length keyboard-translate-table))) |
| 89 | (while (< i j) |
| 90 | (aset the-table i (elt keyboard-translate-table i)) |
| 91 | (setq i (1+ i)))) |
| 92 | (setq keyboard-translate-table the-table)))) |
| 93 | ;; Swap C-s and C-\ |
| 94 | (aset keyboard-translate-table flow-control-c-s-replacement ?\^s) |
| 95 | (aset keyboard-translate-table ?\^s flow-control-c-s-replacement) |
| 96 | ;; Swap C-q and C-^ |
| 97 | (aset keyboard-translate-table flow-control-c-q-replacement ?\^q) |
| 98 | (aset keyboard-translate-table ?\^q flow-control-c-q-replacement) |
| 99 | (message "XON/XOFF adjustment for %s: use %s for C-s, and use %s for C-q" |
| 100 | (getenv "TERM") |
| 101 | (single-key-description flow-control-c-s-replacement) |
| 102 | (single-key-description flow-control-c-q-replacement)) |
| 103 | (sleep-for 2))) ; Give user a chance to see message. |
| 104 | |
| 105 | ;;;###autoload |
| 106 | (defun enable-flow-control-on (&rest losing-terminal-types) |
| 107 | "Enable flow control if using one of a specified set of terminal types. |
| 108 | Use `(enable-flow-control-on \"vt100\" \"h19\")' to enable flow control |
| 109 | on VT-100 and H19 terminals. When flow control is enabled, |
| 110 | you must type C-\\ to get the effect of a C-s, and type C-^ |
| 111 | to get the effect of a C-q." |
| 112 | (let ((term (getenv "TERM")) |
| 113 | hyphend) |
| 114 | ;; Look for TERM in LOSING-TERMINAL-TYPES. |
| 115 | ;; If we don't find it literally, try stripping off words |
| 116 | ;; from the end, one by one. |
| 117 | (while (and term (not (member term losing-terminal-types))) |
| 118 | ;; Strip off last hyphen and what follows, then try again. |
| 119 | (if (setq hyphend (string-match "[-_][^-_]+$" term)) |
| 120 | (setq term (substring term 0 hyphend)) |
| 121 | (setq term nil))) |
| 122 | (if term |
| 123 | (enable-flow-control)))) |
| 124 | |
| 125 | (provide 'flow-ctrl) |
| 126 | |
| 127 | ;;; arch-tag: 0eb7b19e-0d93-4e0b-9ea2-72b574076a56 |
| 128 | ;;; flow-ctrl.el ends here |