Mercurial > emacs
annotate lisp/net/rlogin.el @ 110858:a6ae19bc27ec
* net/browse-url.el (browse-url-xdg-open): Remove use of /bin/sh.
author | Andreas Schwab <schwab@linux-m68k.org> |
---|---|
date | Fri, 08 Oct 2010 19:32:14 +0200 |
parents | 7c4da622f181 |
children | 417b1e4d63cd |
rev | line source |
---|---|
28210 | 1 ;;; rlogin.el --- remote login interface |
2 | |
74509 | 3 ;; Copyright (C) 1992, 1993, 1994, 1995, 1997, 1998, 2001, 2002, 2003, |
110494
7c4da622f181
Remove leading `*' from docs of some defcustoms etc.
Glenn Morris <rgm@gnu.org>
parents:
108243
diff
changeset
|
4 ;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 |
7c4da622f181
Remove leading `*' from docs of some defcustoms etc.
Glenn Morris <rgm@gnu.org>
parents:
108243
diff
changeset
|
5 ;; Free Software Foundation, Inc. |
28210 | 6 |
7 ;; Author: Noah Friedman | |
8 ;; Maintainer: Noah Friedman <friedman@splode.com> | |
9 ;; Keywords: unix, comm | |
10 | |
11 ;; This file is part of GNU Emacs. | |
12 | |
94677
91e5880a36c1
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
13 ;; GNU Emacs is free software: you can redistribute it and/or modify |
28210 | 14 ;; it under the terms of the GNU General Public License as published by |
94677
91e5880a36c1
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
15 ;; the Free Software Foundation, either version 3 of the License, or |
91e5880a36c1
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
16 ;; (at your option) any later version. |
28210 | 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 | |
94677
91e5880a36c1
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
24 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
28210 | 25 |
26 ;;; Commentary: | |
27 | |
28 ;; Support for remote logins using `rlogin'. | |
29 ;; This program is layered on top of shell.el; the code here only accounts | |
30 ;; for the variations needed to handle a remote process, e.g. directory | |
31 ;; tracking and the sending of some special characters. | |
32 | |
33 ;; If you wish for rlogin mode to prompt you in the minibuffer for | |
34 ;; passwords when a password prompt appears, just enter m-x send-invisible | |
35 ;; and type in your line, or add `comint-watch-for-password-prompt' to | |
36 ;; `comint-output-filter-functions'. | |
37 | |
38 ;;; Code: | |
39 | |
40 (require 'comint) | |
41 (require 'shell) | |
42 | |
43 (defgroup rlogin nil | |
64039
bcd433d85e62
(rlogin): Finish `defgroup' description with period.
Juanma Barranquero <lekktu@gmail.com>
parents:
62437
diff
changeset
|
44 "Remote login interface." |
28210 | 45 :group 'processes |
46 :group 'unix) | |
47 | |
48 (defcustom rlogin-program "rlogin" | |
110494
7c4da622f181
Remove leading `*' from docs of some defcustoms etc.
Glenn Morris <rgm@gnu.org>
parents:
108243
diff
changeset
|
49 "Name of program to invoke rlogin" |
28210 | 50 :type 'string |
51 :group 'rlogin) | |
52 | |
53 (defcustom rlogin-explicit-args nil | |
110494
7c4da622f181
Remove leading `*' from docs of some defcustoms etc.
Glenn Morris <rgm@gnu.org>
parents:
108243
diff
changeset
|
54 "List of arguments to pass to rlogin on the command line." |
28210 | 55 :type '(repeat (string :tag "Argument")) |
56 :group 'rlogin) | |
57 | |
58 (defcustom rlogin-mode-hook nil | |
110494
7c4da622f181
Remove leading `*' from docs of some defcustoms etc.
Glenn Morris <rgm@gnu.org>
parents:
108243
diff
changeset
|
59 "Hooks to run after setting current buffer to rlogin-mode." |
28210 | 60 :type 'hook |
61 :group 'rlogin) | |
62 | |
63 (defcustom rlogin-process-connection-type | |
64 (save-match-data | |
65 ;; Solaris 2.x `rlogin' will spew a bunch of ioctl error messages if | |
66 ;; stdin isn't a tty. | |
67 (cond ((and (boundp 'system-configuration) | |
68 (stringp system-configuration) | |
69 (string-match "-solaris2" system-configuration)) | |
70 t) | |
71 (t nil))) | |
110494
7c4da622f181
Remove leading `*' from docs of some defcustoms etc.
Glenn Morris <rgm@gnu.org>
parents:
108243
diff
changeset
|
72 "If non-nil, use a pty for the local rlogin process. |
50863
414ce630df1e
(rlogin-process-connection-type): Don't quote nil and t in docstrings.
Juanma Barranquero <lekktu@gmail.com>
parents:
43915
diff
changeset
|
73 If nil, use a pipe (if pipes are supported on the local system). |
28210 | 74 |
75 Generally it is better not to waste ptys on systems which have a static | |
76 number of them. On the other hand, some implementations of `rlogin' assume | |
77 a pty is being used, and errors will result from using a pipe instead." | |
78 :type '(choice (const :tag "pipes" nil) | |
79 (other :tag "ptys" t)) | |
80 :group 'rlogin) | |
81 | |
82 (defcustom rlogin-directory-tracking-mode 'local | |
110494
7c4da622f181
Remove leading `*' from docs of some defcustoms etc.
Glenn Morris <rgm@gnu.org>
parents:
108243
diff
changeset
|
83 "Control whether and how to do directory tracking in an rlogin buffer. |
28210 | 84 |
85 nil means don't do directory tracking. | |
86 | |
87 t means do so using an ftp remote file name. | |
88 | |
89 Any other value means do directory tracking using local file names. | |
90 This works only if the remote machine and the local one | |
91 share the same directories (through NFS). This is the default. | |
92 | |
93 This variable becomes local to a buffer when set in any fashion for it. | |
94 | |
95 It is better to use the function of the same name to change the behavior of | |
96 directory tracking in an rlogin session once it has begun, rather than | |
97 simply setting this variable, since the function does the necessary | |
98 re-synching of directories." | |
99 :type '(choice (const :tag "off" nil) | |
100 (const :tag "ftp" t) | |
101 (other :tag "local" local)) | |
102 :group 'rlogin) | |
103 | |
104 (make-variable-buffer-local 'rlogin-directory-tracking-mode) | |
105 | |
106 (defcustom rlogin-host nil | |
110494
7c4da622f181
Remove leading `*' from docs of some defcustoms etc.
Glenn Morris <rgm@gnu.org>
parents:
108243
diff
changeset
|
107 "The name of the remote host. This variable is buffer-local." |
28210 | 108 :type '(choice (const nil) string) |
109 :group 'rlogin) | |
110 | |
111 (defcustom rlogin-remote-user nil | |
110494
7c4da622f181
Remove leading `*' from docs of some defcustoms etc.
Glenn Morris <rgm@gnu.org>
parents:
108243
diff
changeset
|
112 "The username used on the remote host. |
28210 | 113 This variable is buffer-local and defaults to your local user name. |
114 If rlogin is invoked with the `-l' option to specify the remote username, | |
115 this variable is set from that." | |
116 :type '(choice (const nil) string) | |
117 :group 'rlogin) | |
118 | |
119 ;; Initialize rlogin mode map. | |
120 (defvar rlogin-mode-map '()) | |
121 (cond | |
122 ((null rlogin-mode-map) | |
123 (setq rlogin-mode-map (if (consp shell-mode-map) | |
124 (cons 'keymap shell-mode-map) | |
125 (copy-keymap shell-mode-map))) | |
126 (define-key rlogin-mode-map "\C-c\C-c" 'rlogin-send-Ctrl-C) | |
127 (define-key rlogin-mode-map "\C-c\C-d" 'rlogin-send-Ctrl-D) | |
128 (define-key rlogin-mode-map "\C-c\C-z" 'rlogin-send-Ctrl-Z) | |
129 (define-key rlogin-mode-map "\C-c\C-\\" 'rlogin-send-Ctrl-backslash) | |
130 (define-key rlogin-mode-map "\C-d" 'rlogin-delchar-or-send-Ctrl-D) | |
131 (define-key rlogin-mode-map "\C-i" 'rlogin-tab-or-complete))) | |
132 | |
133 | |
105939
a0f778f4a995
* term/x-win.el (x-gtk-stock-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
100908
diff
changeset
|
134 ;;;###autoload (add-hook 'same-window-regexps (purecopy "^\\*rlogin-.*\\*\\(\\|<[0-9]+>\\)")) |
28210 | 135 |
136 (defvar rlogin-history nil) | |
137 | |
138 ;;;###autoload | |
139 (defun rlogin (input-args &optional buffer) | |
140 "Open a network login connection via `rlogin' with args INPUT-ARGS. | |
141 INPUT-ARGS should start with a host name; it may also contain | |
142 other arguments for `rlogin'. | |
143 | |
144 Input is sent line-at-a-time to the remote connection. | |
145 | |
146 Communication with the remote host is recorded in a buffer `*rlogin-HOST*' | |
147 \(or `*rlogin-USER@HOST*' if the remote username differs\). | |
148 If a prefix argument is given and the buffer `*rlogin-HOST*' already exists, | |
149 a new buffer with a different connection will be made. | |
150 | |
151 When called from a program, if the optional second argument BUFFER is | |
152 a string or buffer, it specifies the buffer to use. | |
153 | |
154 The variable `rlogin-program' contains the name of the actual program to | |
155 run. It can be a relative or absolute path. | |
156 | |
157 The variable `rlogin-explicit-args' is a list of arguments to give to | |
158 the rlogin when starting. They are added after any arguments given in | |
159 INPUT-ARGS. | |
160 | |
161 If the default value of `rlogin-directory-tracking-mode' is t, then the | |
162 default directory in that buffer is set to a remote (FTP) file name to | |
163 access your home directory on the remote machine. Occasionally this causes | |
164 an error, if you cannot access the home directory on that machine. This | |
165 error is harmless as long as you don't try to use that default directory. | |
166 | |
167 If `rlogin-directory-tracking-mode' is neither t nor nil, then the default | |
168 directory is initially set up to your (local) home directory. | |
169 This is useful if the remote machine and your local machine | |
170 share the same files via NFS. This is the default. | |
171 | |
172 If you wish to change directory tracking styles during a session, use the | |
173 function `rlogin-directory-tracking-mode' rather than simply setting the | |
174 variable." | |
175 (interactive (list | |
176 (read-from-minibuffer "rlogin arguments (hostname first): " | |
177 nil nil nil 'rlogin-history) | |
178 current-prefix-arg)) | |
179 | |
180 (let* ((process-connection-type rlogin-process-connection-type) | |
181 (args (if rlogin-explicit-args | |
62016
ffdffaf33258
(rlogin-parse-words): Delete func.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
54770
diff
changeset
|
182 (append (split-string input-args) |
28210 | 183 rlogin-explicit-args) |
62016
ffdffaf33258
(rlogin-parse-words): Delete func.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
54770
diff
changeset
|
184 (split-string input-args))) |
62017
10e0cd55b339
(rlogin): If there are option-like elements in the parsed args,
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
62016
diff
changeset
|
185 (host (let ((tail args)) |
10e0cd55b339
(rlogin): If there are option-like elements in the parsed args,
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
62016
diff
changeset
|
186 ;; Find first arg that doesn't look like an option. |
10e0cd55b339
(rlogin): If there are option-like elements in the parsed args,
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
62016
diff
changeset
|
187 ;; This still loses for args that take values, feh. |
10e0cd55b339
(rlogin): If there are option-like elements in the parsed args,
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
62016
diff
changeset
|
188 (while (and tail (= ?- (aref (car tail) 0))) |
10e0cd55b339
(rlogin): If there are option-like elements in the parsed args,
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
62016
diff
changeset
|
189 (setq tail (cdr tail))) |
10e0cd55b339
(rlogin): If there are option-like elements in the parsed args,
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
62016
diff
changeset
|
190 (car tail))) |
28210 | 191 (user (or (car (cdr (member "-l" args))) |
192 (user-login-name))) | |
193 (buffer-name (if (string= user (user-login-name)) | |
194 (format "*rlogin-%s*" host) | |
43900
59bea220f067
(rlogin-carriage-filter): Function removed.
Miles Bader <miles@gnu.org>
parents:
28210
diff
changeset
|
195 (format "*rlogin-%s@%s*" user host)))) |
28210 | 196 |
197 (cond ((null buffer)) | |
198 ((stringp buffer) | |
199 (setq buffer-name buffer)) | |
200 ((bufferp buffer) | |
201 (setq buffer-name (buffer-name buffer))) | |
202 ((numberp buffer) | |
203 (setq buffer-name (format "%s<%d>" buffer-name buffer))) | |
204 (t | |
205 (setq buffer-name (generate-new-buffer-name buffer-name)))) | |
206 | |
207 (setq buffer (get-buffer-create buffer-name)) | |
208 (pop-to-buffer buffer-name) | |
209 | |
43900
59bea220f067
(rlogin-carriage-filter): Function removed.
Miles Bader <miles@gnu.org>
parents:
28210
diff
changeset
|
210 (unless (comint-check-proc buffer-name) |
28210 | 211 (comint-exec buffer buffer-name rlogin-program nil args) |
212 | |
213 (rlogin-mode) | |
214 | |
215 (make-local-variable 'rlogin-host) | |
216 (setq rlogin-host host) | |
217 (make-local-variable 'rlogin-remote-user) | |
218 (setq rlogin-remote-user user) | |
219 | |
220 (condition-case () | |
221 (cond ((eq rlogin-directory-tracking-mode t) | |
222 ;; Do this here, rather than calling the tracking mode | |
223 ;; function, to avoid a gratuitous resync check; the default | |
224 ;; should be the user's home directory, be it local or remote. | |
225 (setq comint-file-name-prefix | |
226 (concat "/" rlogin-remote-user "@" rlogin-host ":")) | |
227 (cd-absolute comint-file-name-prefix)) | |
228 ((null rlogin-directory-tracking-mode)) | |
229 (t | |
230 (cd-absolute (concat comint-file-name-prefix "~/")))) | |
43900
59bea220f067
(rlogin-carriage-filter): Function removed.
Miles Bader <miles@gnu.org>
parents:
28210
diff
changeset
|
231 (error nil))))) |
28210 | 232 |
233 (put 'rlogin-mode 'mode-class 'special) | |
234 | |
43915
47fa5e2f85ab
(rlogin-mode): Use `define-derived-mode'.
Miles Bader <miles@gnu.org>
parents:
43900
diff
changeset
|
235 (define-derived-mode rlogin-mode shell-mode "Rlogin" |
28210 | 236 (setq shell-dirtrackp rlogin-directory-tracking-mode) |
43915
47fa5e2f85ab
(rlogin-mode): Use `define-derived-mode'.
Miles Bader <miles@gnu.org>
parents:
43900
diff
changeset
|
237 (make-local-variable 'comint-file-name-prefix)) |
28210 | 238 |
239 (defun rlogin-directory-tracking-mode (&optional prefix) | |
240 "Do remote or local directory tracking, or disable entirely. | |
241 | |
242 If called with no prefix argument or a unspecified prefix argument (just | |
243 ``\\[universal-argument]'' with no number) do remote directory tracking via | |
244 ange-ftp. If called as a function, give it no argument. | |
245 | |
246 If called with a negative prefix argument, disable directory tracking | |
247 entirely. | |
248 | |
249 If called with a positive, numeric prefix argument, e.g. | |
250 ``\\[universal-argument] 1 M-x rlogin-directory-tracking-mode\'', | |
251 then do directory tracking but assume the remote filesystem is the same as | |
252 the local system. This only works in general if the remote machine and the | |
108243
be3f6d650654
Minor cleanups.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
106815
diff
changeset
|
253 local one share the same directories (e.g. through NFS)." |
28210 | 254 (interactive "P") |
255 (cond | |
256 ((or (null prefix) | |
257 (consp prefix)) | |
258 (setq rlogin-directory-tracking-mode t) | |
259 (setq shell-dirtrackp t) | |
260 (setq comint-file-name-prefix | |
261 (concat "/" rlogin-remote-user "@" rlogin-host ":"))) | |
262 ((< prefix 0) | |
263 (setq rlogin-directory-tracking-mode nil) | |
264 (setq shell-dirtrackp nil)) | |
265 (t | |
266 (setq rlogin-directory-tracking-mode 'local) | |
267 (setq comint-file-name-prefix "") | |
268 (setq shell-dirtrackp t))) | |
269 (cond | |
270 (shell-dirtrackp | |
271 (let* ((proc (get-buffer-process (current-buffer))) | |
272 (proc-mark (process-mark proc)) | |
273 (current-input (buffer-substring proc-mark (point-max))) | |
274 (orig-point (point)) | |
275 (offset (and (>= orig-point proc-mark) | |
276 (- (point-max) orig-point)))) | |
277 (unwind-protect | |
278 (progn | |
279 (delete-region proc-mark (point-max)) | |
280 (goto-char (point-max)) | |
281 (shell-resync-dirs)) | |
282 (goto-char proc-mark) | |
283 (insert current-input) | |
284 (if offset | |
285 (goto-char (- (point-max) offset)) | |
286 (goto-char orig-point))))))) | |
287 | |
288 | |
289 (defun rlogin-send-Ctrl-C () | |
290 (interactive) | |
291 (process-send-string nil "\C-c")) | |
292 | |
293 (defun rlogin-send-Ctrl-D () | |
294 (interactive) | |
295 (process-send-string nil "\C-d")) | |
296 | |
297 (defun rlogin-send-Ctrl-Z () | |
298 (interactive) | |
299 (process-send-string nil "\C-z")) | |
300 | |
301 (defun rlogin-send-Ctrl-backslash () | |
302 (interactive) | |
303 (process-send-string nil "\C-\\")) | |
304 | |
305 (defun rlogin-delchar-or-send-Ctrl-D (arg) | |
306 "\ | |
307 Delete ARG characters forward, or send a C-d to process if at end of buffer." | |
308 (interactive "p") | |
309 (if (eobp) | |
310 (rlogin-send-Ctrl-D) | |
311 (delete-char arg))) | |
312 | |
313 (defun rlogin-tab-or-complete () | |
314 "Complete file name if doing directory tracking, or just insert TAB." | |
315 (interactive) | |
316 (if rlogin-directory-tracking-mode | |
317 (comint-dynamic-complete) | |
318 (insert "\C-i"))) | |
319 | |
320 (provide 'rlogin) | |
321 | |
93975
1e3a407766b9
Fix up comment convention on the arch-tag lines.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
79714
diff
changeset
|
322 ;; arch-tag: 6e20eabf-feda-40fa-ab40-0d156db447e4 |
28210 | 323 ;;; rlogin.el ends here |