Mercurial > hg > xemacs-beta

comparison lisp/utils/flow-ctrl.el @ 70:131b0175ea99 r20-0b30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents b82b59fe008d
children b9518feda344
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of 18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
20 ;; General Public License for more details. 20 ;; General Public License for more details.
21 21
22 ;; You should have received a copy of the GNU General Public License 22 ;; You should have received a copy of the GNU General Public License
23 ;; along with XEmacs; see the file COPYING. If not, write to the Free 23 ;; along with XEmacs; see the file COPYING. If not, write to the
24 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25 ;; 02111-1307, USA. 25 ;; Boston, MA 02111-1307, USA.
26 26
27 ;;; Synched up with: FSF 19.34. 27 ;;; Synched up with: FSF 19.28.
28 28
29 ;;; Commentary: 29 ;;; Commentary:
30 30
31 ;; Terminals that use XON/XOFF flow control can cause problems with 31 ;;;; Terminals that use XON/XOFF flow control can cause problems with
32 ;; GNU Emacs users. This file contains Emacs Lisp code that makes it 32 ;;;; GNU Emacs users. This file contains Emacs Lisp code that makes it
33 ;; easy for a user to deal with this problem, when using such a 33 ;;;; easy for a user to deal with this problem, when using such a
34 ;; terminal. 34 ;;;; terminal.
35 ;; 35 ;;;;
36 ;; To invoke these adjustments, a user need only invoke the function 36 ;;;; To invoke these adjustments, a user need only invoke the function
37 ;; enable-flow-control-on with a list of terminal types in his/her own 37 ;;;; enable-flow-control-on with a list of terminal types in his/her own
38 ;; .emacs file. As arguments, give it the names of one or more terminal 38 ;;;; .emacs file. As arguments, give it the names of one or more terminal
39 ;; types in use by that user which require flow control adjustments. 39 ;;;; types in use by that user which require flow control adjustments.
40 ;; Here's an example: 40 ;;;; Here's an example:
41 ;; 41 ;;;;
42 ;; (enable-flow-control-on "vt200" "vt300" "vt101" "vt131") 42 ;;;; (enable-flow-control-on "vt200" "vt300" "vt101" "vt131")
43 43
44 ;; Portability note: This uses (getenv "TERM"), and therefore probably 44 ;;; Portability note: This uses (getenv "TERM"), and therefore probably
45 ;; won't work outside of UNIX-like environments. 45 ;;; won't work outside of UNIX-like environments.
46 46
47 ;;; Code: 47 ;;; Code:
48 48
49 (defvar flow-control-c-s-replacement ?\034 49 (defvar flow-control-c-s-replacement ?\034
50 "Character that replaces C-s, when flow control handling is enabled.") 50 "Character that replaces C-s, when flow control handling is enabled.")
51 (defvar flow-control-c-q-replacement ?\036 51 (defvar flow-control-c-q-replacement ?\036
52 "Character that replaces C-q, when flow control handling is enabled.") 52 "Character that replaces C-q, when flow control handling is enabled.")
53
54 ;(put 'keyboard-translate-table 'char-table-extra-slots 0)
55 53
56 ;;;###autoload 54 ;;;###autoload
57 (defun enable-flow-control (&optional argument) 55 (defun enable-flow-control (&optional argument)
58 "Toggle flow control handling. 56 "Toggle flow control handling.
59 When handling is enabled, user can type C-s as C-\\, and C-q as C-^. 57 When handling is enabled, user can type C-s as C-\\, and C-q as C-^.
65 ;; No arg means toggle. 63 ;; No arg means toggle.
66 (nth 1 (current-input-mode))) 64 (nth 1 (current-input-mode)))
67 (progn 65 (progn
68 ;; Turn flow control off, and stop exchanging chars. 66 ;; Turn flow control off, and stop exchanging chars.
69 (set-input-mode t nil (nth 2 (current-input-mode))) 67 (set-input-mode t nil (nth 2 (current-input-mode)))
70 ;; XEmacs
71 (keyboard-translate flow-control-c-s-replacement nil) 68 (keyboard-translate flow-control-c-s-replacement nil)
72 (keyboard-translate ?\^s nil) 69 (keyboard-translate ?\^s nil)
73 (keyboard-translate flow-control-c-q-replacement nil) 70 (keyboard-translate flow-control-c-q-replacement nil)
74 (keyboard-translate ?\^q nil)) 71 (keyboard-translate ?\^q nil))
75 ;; Turn flow control on. 72 ;; Turn flow control on.
76 ;; Tell emacs to pass C-s and C-q to OS. 73 ;; Tell emacs to pass C-s and C-q to OS.
77 (set-input-mode nil t (nth 2 (current-input-mode))) 74 (set-input-mode nil t (nth 2 (current-input-mode)))
78 ;; Initialize translate table, saving previous mappings, if any. 75 ;; Initialize translate table, saving previous mappings, if any.
79 ;; Swap C-s and C-\ 76 ;; Swap C-s and C-\
80 ;; XEmacs
81 (keyboard-translate flow-control-c-s-replacement ?\^s) 77 (keyboard-translate flow-control-c-s-replacement ?\^s)
82 (keyboard-translate ?\^s flow-control-c-s-replacement) 78 (keyboard-translate ?\^s flow-control-c-s-replacement)
83 ;; Swap C-q and C-^ 79 ;; Swap C-q and C-^
84 (keyboard-translate flow-control-c-q-replacement ?\^q) 80 (keyboard-translate flow-control-c-q-replacement ?\^q)
85 (keyboard-translate ?\^q flow-control-c-q-replacement) 81 (keyboard-translate ?\^q flow-control-c-q-replacement)
100 This function has no effect unless the current device is a tty. 96 This function has no effect unless the current device is a tty.
101 97
102 The tty terminal type is determined from the TERM environment variable. 98 The tty terminal type is determined from the TERM environment variable.
103 Trailing hyphens and everything following is stripped, so a TERM 99 Trailing hyphens and everything following is stripped, so a TERM
104 value of \"vt100-nam\" is treated the same as \"vt100\"." 100 value of \"vt100-nam\" is treated the same as \"vt100\"."
105 (let ((term (getenv "TERM")) 101 (and
106 hyphend) 102 (eq (device-type) 'tty)
107 ;; Look for TERM in LOSING-TERMINAL-TYPES. 103 (getenv "TERM")
108 ;; If we don't find it literally, try stripping off words 104 (member (replace-in-string (getenv "TERM") "[-_].*$" "")
109 ;; from the end, one by one. 105 losing-terminal-types)
110 (while (and term (not (member term losing-terminal-types))) 106 (enable-flow-control)))
111 ;; Strip off last hyphen and what follows, then try again.
112 (if (setq hyphend (string-match "[-_][^-_]+$" term))
113 (setq term (substring term 0 hyphend))
114 (setq term nil)))
115 (if term
116 (enable-flow-control))))
117 107
118 (provide 'flow-ctrl) 108 (provide 'flow-ctrl)
119 109
120 ;;; flow-ctrl.el ends here 110 ;;; flow-ctrl.el ends here