Mercurial > hg > xemacs-beta

comparison lisp/utils/flow-ctrl.el @ 72:b9518feda344 r20-0b31

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b31
author cvs
date Mon, 13 Aug 2007 09:03:46 +0200
parents 131b0175ea99
children
comparison
equal deleted inserted replaced
71:bae944334fa4 72:b9518feda344
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 23 ;; along with XEmacs; see the file COPYING. If not, write to the Free
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 24 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
25 ;; Boston, MA 02111-1307, USA. 25 ;; 02111-1307, USA.
26 26
27 ;;; Synched up with: FSF 19.28. 27 ;;; Synched up with: FSF 19.34.
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)
53 55
54 ;;;###autoload 56 ;;;###autoload
55 (defun enable-flow-control (&optional argument) 57 (defun enable-flow-control (&optional argument)
56 "Toggle flow control handling. 58 "Toggle flow control handling.
57 When handling is enabled, user can type C-s as C-\\, and C-q as C-^. 59 When handling is enabled, user can type C-s as C-\\, and C-q as C-^.
63 ;; No arg means toggle. 65 ;; No arg means toggle.
64 (nth 1 (current-input-mode))) 66 (nth 1 (current-input-mode)))
65 (progn 67 (progn
66 ;; Turn flow control off, and stop exchanging chars. 68 ;; Turn flow control off, and stop exchanging chars.
67 (set-input-mode t nil (nth 2 (current-input-mode))) 69 (set-input-mode t nil (nth 2 (current-input-mode)))
70 ;; XEmacs
68 (keyboard-translate flow-control-c-s-replacement nil) 71 (keyboard-translate flow-control-c-s-replacement nil)
69 (keyboard-translate ?\^s nil) 72 (keyboard-translate ?\^s nil)
70 (keyboard-translate flow-control-c-q-replacement nil) 73 (keyboard-translate flow-control-c-q-replacement nil)
71 (keyboard-translate ?\^q nil)) 74 (keyboard-translate ?\^q nil))
72 ;; Turn flow control on. 75 ;; Turn flow control on.
73 ;; Tell emacs to pass C-s and C-q to OS. 76 ;; Tell emacs to pass C-s and C-q to OS.
74 (set-input-mode nil t (nth 2 (current-input-mode))) 77 (set-input-mode nil t (nth 2 (current-input-mode)))
75 ;; Initialize translate table, saving previous mappings, if any. 78 ;; Initialize translate table, saving previous mappings, if any.
76 ;; Swap C-s and C-\ 79 ;; Swap C-s and C-\
80 ;; XEmacs
77 (keyboard-translate flow-control-c-s-replacement ?\^s) 81 (keyboard-translate flow-control-c-s-replacement ?\^s)
78 (keyboard-translate ?\^s flow-control-c-s-replacement) 82 (keyboard-translate ?\^s flow-control-c-s-replacement)
79 ;; Swap C-q and C-^ 83 ;; Swap C-q and C-^
80 (keyboard-translate flow-control-c-q-replacement ?\^q) 84 (keyboard-translate flow-control-c-q-replacement ?\^q)
81 (keyboard-translate ?\^q flow-control-c-q-replacement) 85 (keyboard-translate ?\^q flow-control-c-q-replacement)
96 This function has no effect unless the current device is a tty. 100 This function has no effect unless the current device is a tty.
97 101
98 The tty terminal type is determined from the TERM environment variable. 102 The tty terminal type is determined from the TERM environment variable.
99 Trailing hyphens and everything following is stripped, so a TERM 103 Trailing hyphens and everything following is stripped, so a TERM
100 value of \"vt100-nam\" is treated the same as \"vt100\"." 104 value of \"vt100-nam\" is treated the same as \"vt100\"."
101 (and 105 (let ((term (getenv "TERM"))
102 (eq (device-type) 'tty) 106 hyphend)
103 (getenv "TERM") 107 ;; Look for TERM in LOSING-TERMINAL-TYPES.
104 (member (replace-in-string (getenv "TERM") "[-_].*$" "") 108 ;; If we don't find it literally, try stripping off words
105 losing-terminal-types) 109 ;; from the end, one by one.
106 (enable-flow-control))) 110 (while (and term (not (member term losing-terminal-types)))
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))))
107 117
108 (provide 'flow-ctrl) 118 (provide 'flow-ctrl)
109 119
110 ;;; flow-ctrl.el ends here 120 ;;; flow-ctrl.el ends here