(memory_warning_signal): Call force_auto_save_soon.
[bpt/emacs.git] / lisp / rlogin.el
1 ;;; rlogin.el --- remote login interface
2
3 ;; Author: Noah Friedman
4 ;; Maintainer: Noah Friedman <friedman@prep.ai.mit.edu>
5 ;; Keywords: unix, comm
6
7 ;; Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc.
8 ;;
9 ;; This program is free software; you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation; either version 2, or (at your option)
12 ;; any later version.
13 ;;
14 ;; This program is distributed in the hope that it will be useful,
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;; GNU General Public License for more details.
18 ;;
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with this program; if not, write to: The Free Software Foundation,
21 ;; Inc.; 675 Massachusetts Avenue.; Cambridge, MA 02139, USA.
22
23 ;;; Commentary:
24
25 ;; Support for remote logins using `rlogin'.
26 ;; $Id: rlogin.el,v 1.16 1994/02/05 21:00:13 roland Exp roland $
27
28 ;;; Todo:
29
30 ;; Make this mode deal with comint-last-input-end properly.
31
32 ;;; Code:
33
34 (require 'comint)
35 (require 'shell)
36
37 ;;;###autoload
38 (defvar rlogin-program "rlogin"
39 "*Name of program to invoke rlogin")
40
41 ;;;###autoload
42 (defvar rlogin-explicit-args nil
43 "*List of arguments to pass to rlogin on the command line.")
44
45 ;;;###autoload
46 (defvar rlogin-mode-hook nil
47 "*Hooks to run after setting current buffer to rlogin-mode.")
48
49 ;;;###autoload
50 (defvar rlogin-process-connection-type nil
51 "*If non-`nil', use a pty for the local rlogin process.
52 If `nil', use a pipe (if pipes are supported on the local system).
53
54 Generally it is better not to waste ptys on systems which have a static
55 number of them. On the other hand, some implementations of `rlogin' assume
56 a pty is being used, and errors will result from using a pipe instead.")
57
58 ;;;###autoload
59 (defvar rlogin-initially-track-cwd t
60 "*If non-`nil', do remote directory tracking via ange-ftp right away.
61 If `nil', you can still enable directory tracking by doing
62 `M-x dirtrack-toggle'.")
63
64 ;; Leave this nil because it makes rlogin-filter a tiny bit faster. Plus
65 ;; you can still call rlogin-password by hand.
66 ;;;###autoload
67 (defvar rlogin-password-paranoia nil
68 "*If non-`nil', query user for a password in the minibuffer when a Password: prompt appears.
69 It's also possible to selectively enter passwords without echoing them in
70 the minibuffer using the command `rlogin-password' explicitly.")
71
72 ;; Initialize rlogin mode map.
73 (defvar rlogin-mode-map '())
74 (cond ((not rlogin-mode-map)
75 (setq rlogin-mode-map (cons 'keymap shell-mode-map))
76 (define-key rlogin-mode-map "\C-c\C-c" 'rlogin-send-Ctrl-C)
77 (define-key rlogin-mode-map "\C-c\C-d" 'rlogin-send-Ctrl-D)
78 (define-key rlogin-mode-map "\C-c\C-z" 'rlogin-send-Ctrl-Z)
79 (define-key rlogin-mode-map "\C-c\C-\\" 'rlogin-send-Ctrl-backslash)
80 (define-key rlogin-mode-map "\C-d" 'rlogin-delchar-or-send-Ctrl-D)))
81
82 ;;;###autoload
83 (defun rlogin (input-args &optional prefix)
84 "Open a network login connection to HOST via the `rlogin' program.
85 Input is sent line-at-a-time to the remote connection.
86
87 Communication with the remote host is recorded in a buffer *rlogin-HOST*,
88 where HOST is the first word in the string ARGS. If a prefix argument is
89 given and the buffer *rlogin-HOST* already exists, a new buffer with a
90 different connection will be made.
91
92 The variable `rlogin-program' contains the name of the actual program to
93 run. It can be a relative or absolute path.
94
95 The variable `rlogin-explicit-args' is a list of arguments to give to
96 the rlogin when starting. They are added after any arguments given in ARGS."
97 (interactive (list (read-from-minibuffer "rlogin arguments (hostname first): ")
98 current-prefix-arg))
99 (let* ((process-connection-type rlogin-process-connection-type)
100 (buffer-name (format "*rlogin-%s*" input-args))
101 args
102 proc
103 (old-match-data (match-data)))
104 (while (string-match "[ \t]*\\([^ \t]+\\)$" input-args)
105 (setq args
106 (cons (substring input-args (match-beginning 1) (match-end 1))
107 args)
108 input-args (substring input-args 0 (match-beginning 0))))
109 (store-match-data old-match-data)
110 (setq buffer-name (format "*rlogin-%s*" (car args))
111 args (append args rlogin-explicit-args))
112 (and prefix (setq buffer-name
113 (buffer-name (generate-new-buffer buffer-name))))
114 (switch-to-buffer buffer-name)
115 (or (comint-check-proc buffer-name)
116 (progn
117 (comint-mode)
118 (comint-exec (current-buffer) buffer-name rlogin-program nil args)
119 (setq proc (get-process buffer-name))
120 ;; Set process-mark to point-max in case there is text in the
121 ;; buffer from a previous exited process.
122 (set-marker (process-mark proc) (point-max))
123 (rlogin-mode)
124 ;; Set this *after* running rlogin-mode because rlogin-mode calls
125 ;; shell-mode, which munges the process filter.
126 (set-process-filter proc 'rlogin-filter)
127 ;; Set the prefix for filename completion and directory tracking
128 ;; to find the remote machine's files by ftp.
129 (setq comint-file-name-prefix (concat "/" (car args) ":"))
130 (and rlogin-initially-track-cwd
131 ;; Presume the user will start in his remote home directory.
132 ;; If this is wrong, M-x dirs will fix it.
133 (cd-absolute (concat "/" (car args) ":~/")))))))
134
135 (defun rlogin-password (&optional proc)
136 "Read a password and send it to an rlogin session.
137 For each character typed, a `*' is echoed in the minibuffer.
138 End with RET, LFD, or ESC. DEL or C-h rubs out. C-u kills line.
139 C-g aborts attempt to read and send password.
140
141 Optional argument PROC is the process to which the password should be sent.
142 If not provided, send to the process in the current buffer. This argument
143 is intended primarily for use by `rlogin-filter'."
144 (interactive)
145 (or proc (setq proc (get-buffer-process (current-buffer))))
146 (let* ((buffer-name (buffer-name (process-buffer proc)))
147 (pass (comint-read-noecho (format "Password for buffer \"%s\": "
148 buffer-name)
149 'stars)))
150 (and pass
151 (save-excursion
152 (set-buffer buffer-name)
153 (insert-before-markers "\n")
154 (comint-send-string proc (format "%s\n" pass))))))
155
156 (defun rlogin-mode ()
157 "Set major-mode for rlogin sessions.
158 If `rlogin-mode-hook' is set, run it."
159 (interactive)
160 (kill-all-local-variables)
161 (shell-mode)
162 (setq major-mode 'rlogin-mode)
163 (setq mode-name "rlogin")
164 (use-local-map rlogin-mode-map)
165 (setq shell-dirtrackp rlogin-initially-track-cwd)
166 (make-local-variable 'comint-file-name-prefix)
167 (run-hooks 'rlogin-mode-hook))
168
169 \f
170 (defun rlogin-filter (proc string)
171 (let (proc-mark region-begin window)
172 (save-excursion
173 (set-buffer (process-buffer proc))
174 (setq proc-mark (process-mark proc))
175 (setq region-begin (marker-position proc-mark))
176 ;; If process mark is at window start, insert-before-markers will
177 ;; insert text off-window since it's also inserting before the start
178 ;; window mark. Make sure we can see the most recent text.
179 (setq window (and (= proc-mark (window-start))
180 (get-buffer-window (current-buffer))))
181 (goto-char proc-mark)
182 (insert-before-markers string)
183 (goto-char region-begin)
184 (while (search-forward "\C-m" proc-mark 'goto-end)
185 (delete-char -1)))
186 ;; Frob window-start outside of save-excursion so it works whether the
187 ;; current buffer is the process buffer or not.
188 (and window
189 (>= (window-start window) region-begin)
190 (set-window-start window region-begin 'noforce)))
191 (and rlogin-password-paranoia
192 (string= "Password:" string)
193 (rlogin-password proc)))
194
195 (defun rlogin-send-Ctrl-C ()
196 (interactive)
197 (send-string nil "\C-c"))
198
199 (defun rlogin-send-Ctrl-D ()
200 (interactive)
201 (send-string nil "\C-d"))
202
203 (defun rlogin-send-Ctrl-Z ()
204 (interactive)
205 (send-string nil "\C-z"))
206
207 (defun rlogin-send-Ctrl-backslash ()
208 (interactive)
209 (send-string nil "\C-\\"))
210
211 (defun rlogin-delchar-or-send-Ctrl-D (arg)
212 "\
213 Delete ARG characters forward, or send a C-d to process if at end of buffer."
214 (interactive "p")
215 (if (eobp)
216 (rlogin-send-Ctrl-D)
217 (delete-char arg)))
218
219 ;;; rlogin.el ends here