diff options
| -rw-r--r-- | lisp/rlogin.el | 265 |
1 files changed, 195 insertions, 70 deletions
diff --git a/lisp/rlogin.el b/lisp/rlogin.el index 1c09d65bbb0..6aaaf31614c 100644 --- a/lisp/rlogin.el +++ b/lisp/rlogin.el @@ -4,7 +4,7 @@ ;; Maintainer: Noah Friedman <friedman@prep.ai.mit.edu> ;; Keywords: unix, comm -;; Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc. +;; Copyright (C) 1992, 1993, 1994, 1995 Free Software Foundation, Inc. ;; ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by @@ -20,9 +20,14 @@ ;; along with this program; if not, write to: The Free Software Foundation, ;; Inc.; 675 Massachusetts Avenue.; Cambridge, MA 02139, USA. +;; $Id$ + ;;; Commentary: ;; Support for remote logins using `rlogin'. +;; This program is layered on top of shell.el; the code here only accounts +;; for the variations needed to handle a remote process, e.g. directory +;; tracking and the sending of some special characters. ;; If you wish for rlogin mode to prompt you in the minibuffer for ;; passwords when a password prompt appears, just enter m-x send-invisible @@ -34,19 +39,15 @@ (require 'comint) (require 'shell) -;;;###autoload (defvar rlogin-program "rlogin" "*Name of program to invoke rlogin") -;;;###autoload (defvar rlogin-explicit-args nil "*List of arguments to pass to rlogin on the command line.") -;;;###autoload (defvar rlogin-mode-hook nil "*Hooks to run after setting current buffer to rlogin-mode.") -;;;###autoload (defvar rlogin-process-connection-type nil "*If non-`nil', use a pty for the local rlogin process. If `nil', use a pipe (if pipes are supported on the local system). @@ -55,34 +56,59 @@ Generally it is better not to waste ptys on systems which have a static number of them. On the other hand, some implementations of `rlogin' assume a pty is being used, and errors will result from using a pipe instead.") -;;;###autoload -(defvar rlogin-initially-track-cwd t +(defvar rlogin-directory-tracking-mode 'local "*Control whether and how to do directory tracking in an rlogin buffer. + nil means don't do directory tracking. + t means do so using an ftp remote file name. + Any other value means do directory tracking using local file names. This works only if the remote machine and the local one -share the same directories (through NFS).") +share the same directories (through NFS). This is the default. + +This variable becomes local to a buffer when set in any fashion for it. + +It is better to use the function of the same name to change the behavior of +directory tracking in an rlogin session once it has begun, rather than +simply setting this variable, since the function does the necessary +re-synching of directories.") + +(make-variable-buffer-local 'rlogin-directory-tracking-mode) + +(defvar rlogin-host nil + "*The name of the remote host. This variable is buffer-local.") + +(defvar rlogin-remote-user nil + "*The username used on the remote host. +This variable is buffer-local and defaults to your local user name. +If rlogin is invoked with the `-l' option to specify the remote username, +this variable is set from that.") ;; Initialize rlogin mode map. (defvar rlogin-mode-map '()) -(cond ((not rlogin-mode-map) - (setq rlogin-mode-map (cons 'keymap shell-mode-map)) - (define-key rlogin-mode-map "\C-c\C-c" 'rlogin-send-Ctrl-C) - (define-key rlogin-mode-map "\C-c\C-d" 'rlogin-send-Ctrl-D) - (define-key rlogin-mode-map "\C-c\C-z" 'rlogin-send-Ctrl-Z) - (define-key rlogin-mode-map "\C-c\C-\\" 'rlogin-send-Ctrl-backslash) - (define-key rlogin-mode-map "\C-d" 'rlogin-delchar-or-send-Ctrl-D))) +(cond + ((null rlogin-mode-map) + (setq rlogin-mode-map (if (consp shell-mode-map) + (cons 'keymap shell-mode-map) + (copy-keymap shell-mode-map))) + (define-key rlogin-mode-map "\C-c\C-c" 'rlogin-send-Ctrl-C) + (define-key rlogin-mode-map "\C-c\C-d" 'rlogin-send-Ctrl-D) + (define-key rlogin-mode-map "\C-c\C-z" 'rlogin-send-Ctrl-Z) + (define-key rlogin-mode-map "\C-c\C-\\" 'rlogin-send-Ctrl-backslash) + (define-key rlogin-mode-map "\C-d" 'rlogin-delchar-or-send-Ctrl-D) + (define-key rlogin-mode-map "\C-i" 'rlogin-tab-or-complete))) + ;;;###autoload (defun rlogin (input-args &optional prefix) "Open a network login connection to HOST via the `rlogin' program. Input is sent line-at-a-time to the remote connection. -Communication with the remote host is recorded in a buffer *rlogin-HOST*, -where HOST is the first word in the string INPUT-ARGS. If a prefix argument is -given and the buffer *rlogin-HOST* already exists, a new buffer with a -different connection will be made. +Communication with the remote host is recorded in a buffer *rlogin-HOST* +\(or *rlogin-USER@HOST* if the remote username differs\). +If a prefix argument is given and the buffer *rlogin-HOST* already exists, +a new buffer with a different connection will be made. The variable `rlogin-program' contains the name of the actual program to run. It can be a relative or absolute path. @@ -91,63 +117,83 @@ The variable `rlogin-explicit-args' is a list of arguments to give to the rlogin when starting. They are added after any arguments given in INPUT-ARGS. -If `rlogin-initially-track-cwd' is t (which is true by default), -then the default directory in that buffer is set to a remote (FTP) file name -to access your home directory on the remote machine. Occasionally -this causes an error, if you cannot access the home directory on that -machine. This error is harmless as long as you don't try to use -that default directory. +If the default value of `rlogin-directory-tracking-mode' is t, then the +default directory in that buffer is set to a remote (FTP) file name to +access your home directory on the remote machine. Occasionally this causes +an error, if you cannot access the home directory on that machine. This +error is harmless as long as you don't try to use that default directory. -If `rlogin-initially-track-cwd' is neither t nor nil, then the default +If `rlogin-directory-tracking-mode' is neither t nor nil, then the default directory is initially set up to your (local) home directory. This is useful if the remote machine and your local machine -share the same files via NFS." +share the same files via NFS. This is the default. + +If you wish to change directory tracking styles during a session, use the +function `rlogin-directory-tracking-mode' rather than simply setting the +variable." (interactive (list (read-from-minibuffer "rlogin arguments (hostname first): ") current-prefix-arg)) + (let* ((process-connection-type rlogin-process-connection-type) - (buffer-name (format "*rlogin-%s*" input-args)) - args - host - user - proc - (old-match-data (match-data))) - (while (string-match "[ \t]*\\([^ \t]+\\)$" input-args) - (setq args (cons (substring input-args - (match-beginning 1) (match-end 1)) - args) - input-args (substring input-args 0 (match-beginning 0)))) - (store-match-data old-match-data) - (setq args (append args rlogin-explicit-args)) - (setq host (car args)) - (let ((tmpargs (cdr args))) - (while (and tmpargs - (not (string= (car tmpargs) "-l"))) - (setq tmpargs (cdr tmpargs))) - (setq user (car (cdr tmpargs)))) - (setq buffer-name (format "*rlogin-%s*" host)) - (and prefix (setq buffer-name - (buffer-name (generate-new-buffer buffer-name)))) - (switch-to-buffer buffer-name) - (or (comint-check-proc buffer-name) - (progn - (comint-mode) - (comint-exec (current-buffer) buffer-name rlogin-program nil args) - (setq proc (get-process buffer-name)) - ;; Set process-mark to point-max in case there is text in the - ;; buffer from a previous exited process. - (set-marker (process-mark proc) (point-max)) - (rlogin-mode) - ;; Set the prefix for filename completion and directory tracking - ;; to find the remote machine's files by ftp. - (if (eq rlogin-initially-track-cwd t) - (setq comint-file-name-prefix (concat "/" - (and user (concat user "@")) - host ":"))) - (and rlogin-initially-track-cwd - ;; Presume the user will start in his remote home directory. - ;; If this is wrong, M-x dirs will fix it. - (cd-absolute comint-file-name-prefix)))))) + (args (if rlogin-explicit-args + (append (rlogin-parse-words input-args) + rlogin-explicit-args) + (rlogin-parse-words input-args))) + (host (car args)) + (user (or (car (cdr (member "-l" args))) + (user-login-name))) + (buffer-name (if (string= user (user-login-name)) + (format "*rlogin-%s*" host) + (format "*rlogin-%s@%s*" user host))) + proc) + + (cond + ((and (null prefix) + (comint-check-proc buffer-name)) + (switch-to-buffer buffer-name)) + ;; This next case is done all in the predicate (including side effects + ;; like switch-to-buffer) to avoid extra string consing via multiple + ;; concats. + ((and (numberp prefix) + (let ((bufname (concat buffer-name "<" prefix ">"))) + (and (comint-check-proc bufname) + (switch-to-buffer bufname))))) + (t + (cond + ((numberp prefix) + (setq buffer-name (concat buffer-name "<" prefix ">"))) + (t + (setq buffer-name (generate-new-buffer-name buffer-name)))) + (switch-to-buffer buffer-name) + (comint-exec (current-buffer) buffer-name rlogin-program nil args) + (setq proc (get-process buffer-name)) + ;; Set process-mark to point-max in case there is text in the + ;; buffer from a previous exited process. + (set-marker (process-mark proc) (point-max)) + (rlogin-mode) + + ;; comint-output-filter-functions is just like a hook, except that the + ;; functions in that list are passed arguments. add-hook serves well + ;; enough for modifying it. + (add-hook 'comint-output-filter-functions 'rlogin-carriage-filter) + + (make-local-variable 'rlogin-host) + (setq rlogin-host host) + (make-local-variable 'rlogin-user) + (setq rlogin-user user) + + (cond + ((eq rlogin-directory-tracking-mode t) + ;; Do this here, rather than calling the tracking mode function, to + ;; avoid a gratuitous resync check; the default should be the + ;; user's home directory, be it local or remote. + (setq comint-file-name-prefix + (concat "/" rlogin-user "@" rlogin-host ":")) + (cd-absolute comint-file-name-prefix)) + ((null rlogin-directory-tracking-mode)) + (t + (cd-absolute (concat comint-file-name-prefix "~/")))))))) (defun rlogin-mode () "Set major-mode for rlogin sessions. @@ -158,11 +204,83 @@ If `rlogin-mode-hook' is set, run it." (setq major-mode 'rlogin-mode) (setq mode-name "rlogin") (use-local-map rlogin-mode-map) - (setq shell-dirtrackp rlogin-initially-track-cwd) + (setq shell-dirtrackp rlogin-directory-tracking-mode) (make-local-variable 'comint-file-name-prefix) (run-hooks 'rlogin-mode-hook)) +(defun rlogin-directory-tracking-mode (&optional prefix) + "Do remote or local directory tracking, or disable entirely. + +If called with no prefix argument or a unspecified prefix argument (just +``\\[universal-argument]'' with no number) do remote directory tracking via +ange-ftp. If called as a function, give it no argument. + +If called with a negative prefix argument, disable directory tracking +entirely. + +If called with a positive, numeric prefix argument, e.g. +``\\[universal-argument] 1 M-x rlogin-directory-tracking-mode\'', +then do directory tracking but assume the remote filesystem is the same as +the local system. This only works in general if the remote machine and the +local one share the same directories (through NFS)." + (interactive "P") + (cond + ((or (null prefix) + (consp prefix)) + (setq rlogin-directory-tracking-mode t) + (setq shell-dirtrack-p t) + (setq comint-file-name-prefix + (concat "/" rlogin-user "@" rlogin-host ":"))) + ((< prefix 0) + (setq rlogin-directory-tracking-mode nil) + (setq shell-dirtrack-p nil)) + (t + (setq rlogin-directory-tracking-mode 'local) + (setq comint-file-name-prefix "") + (setq shell-dirtrack-p t))) + (cond + (shell-dirtrack-p + (let* ((proc (get-buffer-process (current-buffer))) + (proc-mark (process-mark proc)) + (current-input (buffer-substring proc-mark (point-max))) + (orig-point (point)) + (offset (and (>= orig-point proc-mark) + (- (point-max) orig-point)))) + (unwind-protect + (progn + (delete-region proc-mark (point-max)) + (goto-char (point-max)) + (shell-resync-dirs)) + (goto-char proc-mark) + (insert current-input) + (if offset + (goto-char (- (point-max) offset)) + (goto-char orig-point))))))) + +;; Parse a line into its constituent parts (words separated by +;; whitespace). Return a list of the words. +(defun rlogin-parse-words (line) + (let ((list nil) + (posn 0) + (match-data (match-data))) + (while (string-match "[^ \t\n]+" line posn) + (setq list (cons (substring line (match-beginning 0) (match-end 0)) + list)) + (setq posn (match-end 0))) + (store-match-data (match-data)) + (nreverse list))) + +(defun rlogin-carriage-filter (&rest ignored) + ;; When this function is called, the buffer will already have been + ;; narrowed to the region containing the most recently-inserted text. + ;; (See `comint-output-filter' in comint.el.) + (let ((point-marker (point-marker))) + (goto-char (point-min)) + (while (search-forward "\C-m" (point-max) t) + (delete-char -1)) + (goto-char point-marker))) + (defun rlogin-send-Ctrl-C () (interactive) (send-string nil "\C-c")) @@ -187,4 +305,11 @@ Delete ARG characters forward, or send a C-d to process if at end of buffer." (rlogin-send-Ctrl-D) (delete-char arg))) +(defun rlogin-tab-or-complete () + "Complete file name if doing directory tracking, or just send TAB." + (interactive) + (if rlogin-directory-tracking-mode + (comint-dynamic-complete) + (send-string nil "\C-i"))) + ;;; rlogin.el ends here |