Mercurial > hg > xemacs-beta

comparison lisp/utils/flow-ctrl.el @ 4:b82b59fe008d r19-15b3

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b3
author cvs
date Mon, 13 Aug 2007 08:46:56 +0200
parents ac2d302a0011
children 131b0175ea99
comparison
equal deleted inserted replaced
3:30df88044ec6 4:b82b59fe008d
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 Free
24 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 24 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
25 ;; 02111-1307, USA.
25 26
26 ;;; Synched up with: FSF 19.28. 27 ;;; Synched up with: FSF 19.34.
27 28
28 ;;; Commentary: 29 ;;; Commentary:
29 30
30 ;;;; Terminals that use XON/XOFF flow control can cause problems with 31 ;; 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 ;; 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 ;; easy for a user to deal with this problem, when using such a
33 ;;;; terminal. 34 ;; terminal.
34 ;;;; 35 ;;
35 ;;;; To invoke these adjustments, a user need only invoke the function 36 ;; 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 ;; 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 ;; .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 ;; types in use by that user which require flow control adjustments.
39 ;;;; Here's an example: 40 ;; Here's an example:
40 ;;;; 41 ;;
41 ;;;; (enable-flow-control-on "vt200" "vt300" "vt101" "vt131") 42 ;; (enable-flow-control-on "vt200" "vt300" "vt101" "vt131")
42 43
43 ;;; Portability note: This uses (getenv "TERM"), and therefore probably 44 ;; Portability note: This uses (getenv "TERM"), and therefore probably
44 ;;; won't work outside of UNIX-like environments. 45 ;; won't work outside of UNIX-like environments.
45 46
46 ;;; Code: 47 ;;; Code:
47 48
48 (defvar flow-control-c-s-replacement ?\034 49 (defvar flow-control-c-s-replacement ?\034
49 "Character that replaces C-s, when flow control handling is enabled.") 50 "Character that replaces C-s, when flow control handling is enabled.")
50 (defvar flow-control-c-q-replacement ?\036 51 (defvar flow-control-c-q-replacement ?\036
51 "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)
52 55
53 ;;;###autoload 56 ;;;###autoload
54 (defun enable-flow-control (&optional argument) 57 (defun enable-flow-control (&optional argument)
55 "Toggle flow control handling. 58 "Toggle flow control handling.
56 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-^.
62 ;; No arg means toggle. 65 ;; No arg means toggle.
63 (nth 1 (current-input-mode))) 66 (nth 1 (current-input-mode)))
64 (progn 67 (progn
65 ;; Turn flow control off, and stop exchanging chars. 68 ;; Turn flow control off, and stop exchanging chars.
66 (set-input-mode t nil (nth 2 (current-input-mode))) 69 (set-input-mode t nil (nth 2 (current-input-mode)))
70 ;; XEmacs
67 (keyboard-translate flow-control-c-s-replacement nil) 71 (keyboard-translate flow-control-c-s-replacement nil)
68 (keyboard-translate ?\^s nil) 72 (keyboard-translate ?\^s nil)
69 (keyboard-translate flow-control-c-q-replacement nil) 73 (keyboard-translate flow-control-c-q-replacement nil)
70 (keyboard-translate ?\^q nil)) 74 (keyboard-translate ?\^q nil))
71 ;; Turn flow control on. 75 ;; Turn flow control on.
72 ;; Tell emacs to pass C-s and C-q to OS. 76 ;; Tell emacs to pass C-s and C-q to OS.
73 (set-input-mode nil t (nth 2 (current-input-mode))) 77 (set-input-mode nil t (nth 2 (current-input-mode)))
74 ;; Initialize translate table, saving previous mappings, if any. 78 ;; Initialize translate table, saving previous mappings, if any.
75 ;; Swap C-s and C-\ 79 ;; Swap C-s and C-\
80 ;; XEmacs
76 (keyboard-translate flow-control-c-s-replacement ?\^s) 81 (keyboard-translate flow-control-c-s-replacement ?\^s)
77 (keyboard-translate ?\^s flow-control-c-s-replacement) 82 (keyboard-translate ?\^s flow-control-c-s-replacement)
78 ;; Swap C-q and C-^ 83 ;; Swap C-q and C-^
79 (keyboard-translate flow-control-c-q-replacement ?\^q) 84 (keyboard-translate flow-control-c-q-replacement ?\^q)
80 (keyboard-translate ?\^q flow-control-c-q-replacement) 85 (keyboard-translate ?\^q flow-control-c-q-replacement)
95 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.
96 101
97 The tty terminal type is determined from the TERM environment variable. 102 The tty terminal type is determined from the TERM environment variable.
98 Trailing hyphens and everything following is stripped, so a TERM 103 Trailing hyphens and everything following is stripped, so a TERM
99 value of \"vt100-nam\" is treated the same as \"vt100\"." 104 value of \"vt100-nam\" is treated the same as \"vt100\"."
100 (and 105 (let ((term (getenv "TERM"))
101 (eq (device-type) 'tty) 106 hyphend)
102 (getenv "TERM") 107 ;; Look for TERM in LOSING-TERMINAL-TYPES.
103 (member (replace-in-string (getenv "TERM") "[-_].*$" "") 108 ;; If we don't find it literally, try stripping off words
104 losing-terminal-types) 109 ;; from the end, one by one.
105 (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))))
106 117
107 (provide 'flow-ctrl) 118 (provide 'flow-ctrl)
108 119
109 ;;; flow-ctrl.el ends here 120 ;;; flow-ctrl.el ends here