X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/8ae3bc9f18081524e493c8d4d23aa9e92137fb9e..3f251fcd3b47a73f14fa0ba17b47a7694b9de436:/lisp/rlogin.el

diff --git a/lisp/rlogin.el b/lisp/rlogin.el
index 79449f50cd..435765f3b4 100644
--- a/lisp/rlogin.el
+++ b/lisp/rlogin.el
@@ -1,217 +1,370 @@
 ;;; rlogin.el --- remote login interface
 
+;; Copyright (C) 1992, 1993, 1994, 1995, 1997 Free Software Foundation, Inc.
+
 ;; Author: Noah Friedman
 ;; Maintainer: Noah Friedman <friedman@prep.ai.mit.edu>
 ;; Keywords: unix, comm
 
-;; Copyright (C) 1992, 1993 Free Software Foundation, Inc.
-;;
-;; This program is free software; you can redistribute it and/or modify
+;; $Id: rlogin.el,v 1.40 1997/06/23 08:22:53 friedman Exp rms $
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
 ;; the Free Software Foundation; either version 2, or (at your option)
 ;; any later version.
-;;
-;; This program is distributed in the hope that it will be useful,
+
+;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 ;; GNU General Public License for more details.
-;;
+
 ;; You should have received a copy of the GNU General Public License
-;; along with this program; if not, write to: The Free Software Foundation,
-;; Inc.; 675 Massachusetts Avenue.; Cambridge, MA 02139, USA.
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
 
 ;;; Commentary:
 
 ;; Support for remote logins using `rlogin'.
-;;
-;; Todo: add directory tracking using ange-ftp style patchnames for the cwd.
+;; 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
+;; and type in your line, or add `comint-watch-for-password-prompt' to
+;; `comint-output-filter-functions'.
 
 ;;; Code:
 
 (require 'comint)
+(require 'shell)
 
-;;;###autoload
-(defvar rlogin-program "rlogin"
-  "*Name of program to invoke rlogin")
+(defgroup rlogin nil
+  "Remote login interface"
+  :group 'processes
+  :group 'unix)
 
-;;;###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.")
+(defcustom rlogin-program "rlogin"
+  "*Name of program to invoke rlogin"
+  :type 'string
+  :group 'rlogin)
 
-;;;###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).  
+(defcustom rlogin-explicit-args nil
+  "*List of arguments to pass to rlogin on the command line."
+  :type '(repeat (string :tag "Argument"))
+  :group 'rlogin)
+
+(defcustom rlogin-mode-hook nil
+  "*Hooks to run after setting current buffer to rlogin-mode."
+  :type 'hook
+  :group 'rlogin)
+
+(defcustom rlogin-process-connection-type
+  (save-match-data
+    ;; Solaris 2.x `rlogin' will spew a bunch of ioctl error messages if
+    ;; stdin isn't a tty.
+    (cond ((and (boundp 'system-configuration)
+                (stringp system-configuration)
+                (string-match "-solaris2" system-configuration))
+           t)
+          (t 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).
 
 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.")
+a pty is being used, and errors will result from using a pipe instead."
+  :type '(choice (const :tag "ptys" t)
+		 (const :tag "pipes" nil))
+  :group 'rlogin)
 
-;; Leave this nil because it makes rlogin-filter a tiny bit faster.  Plus
-;; you can still call rlogin-password by hand.
-;;;###autoload
-(defvar rlogin-password-paranoia nil
-  "*If non-`nil', query user for a password in the minibuffer when a Password: prompt appears.
-It's also possible to selectively enter passwords without echoing them in
-the minibuffer using the command `rlogin-password' explicitly.")
+(defcustom 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).  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."
+  :type '(choice (const :tag "off" nil)
+		 (const :tag "ftp" t)
+		 (const :tag "local" local))
+  :group 'rlogin)
+
+(make-variable-buffer-local 'rlogin-directory-tracking-mode)
+
+(defcustom rlogin-host nil
+  "*The name of the remote host.  This variable is buffer-local."
+  :type '(choice (const nil) string)
+  :group 'rlogin)
+
+(defcustom 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."
+  :type '(choice (const nil) string)
+  :group 'rlogin)
 
 ;; Initialize rlogin mode map.
-;;;###autoload
 (defvar rlogin-mode-map '())
-(cond ((not rlogin-mode-map)
-       (setq rlogin-mode-map (full-copy-sparse-keymap comint-mode-map))
-       ;(define-key rlogin-mode-map "\M-\t" 'comint-dynamic-complete)
-       ;(define-key rlogin-mode-map "\M-?"  'comint-dynamic-list-completions)
-       (define-key rlogin-mode-map "\C-c\C-c" 'rlogin-send-Ctrl-C)
-       (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 (add-hook 'same-window-regexps "^\\*rlogin-.*\\*\\(\\|<[0-9]+>\\)")
+
+(defvar rlogin-history nil)
 
 ;;;###autoload
-(defun rlogin (&optional prefix host)
-  "Open a network login connection to HOST via the `rlogin' program.
+(defun rlogin (input-args &optional buffer)
+  "Open a network login connection via `rlogin' with args INPUT-ARGS.
+INPUT-ARGS should start with a host name; it may also contain
+other arguments for `rlogin'.
+
 Input is sent line-at-a-time to the remote connection.
 
-Communication with HOST is recorded in a buffer *rlogin-HOST*.
-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.
+
+When called from a program, if the optional second argument BUFFER is
+a string or buffer, it specifies the buffer to use.
 
 The variable `rlogin-program' contains the name of the actual program to
-run.  It can be a relative or absolute path. 
+run.  It can be a relative or absolute path.
 
 The variable `rlogin-explicit-args' is a list of arguments to give to
-the rlogin when starting."
-  (interactive (list current-prefix-arg
-                     (read-from-minibuffer "Open rlogin connection to host: ")))
+the rlogin when starting.  They are added after any arguments given in
+INPUT-ARGS.
+
+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-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.  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): "
+				      nil nil nil 'rlogin-history)
+		current-prefix-arg))
+
   (let* ((process-connection-type rlogin-process-connection-type)
-         (buffer-name (format "*rlogin-%s*" host))
-         (args (if (and rlogin-explicit-args (listp rlogin-explicit-args))
-                   (cons host rlogin-explicit-args)
-                 (list host)))
+         (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)
-    (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))
-          (set-process-filter proc 'rlogin-filter)
-          (rlogin-mode)))))
 
-;;;###autoload
-(defun rlogin-with-args (host args)
-  "Open a new rlogin connection to HOST, even if one already exists. 
-String ARGS is given as arguments to the `rlogin' program, overriding the
-value of `rlogin-explicit-args'."
-  (interactive (list (read-from-minibuffer "Open rlogin connection to host: ")
-                     (read-from-minibuffer "with arguments: ")))
-  (let ((old-match-data (match-data))
-        (rlogin-explicit-args nil))
-    (unwind-protect
-        (progn
-          (while (string-match "[ \t]*\\([^ \t]+\\)$" args)
-            (setq rlogin-explicit-args 
-                  (cons (substring args 
-                                   (match-beginning 1)
-                                   (match-end 1))
-                        rlogin-explicit-args)
-                  args (substring args 0 (match-beginning 0)))))
-      (store-match-data old-match-data))
-    (rlogin 1 host)))
+    (cond ((null buffer))
+	  ((stringp buffer)
+	   (setq buffer-name buffer))
+          ((bufferp buffer)
+           (setq buffer-name (buffer-name buffer)))
+          ((numberp buffer)
+           (setq buffer-name (format "%s<%d>" buffer-name buffer)))
+          (t
+           (setq buffer-name (generate-new-buffer-name buffer-name))))
 
-;;;###autoload
-(defun rlogin-password (&optional proc)
-  "Read a password and send it to an rlogin session.
-For each character typed, a `*' is echoed in the minibuffer.
-End with RET, LFD, or ESC.  DEL or C-h rubs out.  C-u kills line.
-C-g aborts attempt to read and send password. 
-
-Optional argument PROC is the process to which the password should be sent.
-If not provided, send to the process in the current buffer.  This argument
-is intended primarily for use by `rlogin-filter'."
-  (interactive)
-  (or proc (setq proc (get-buffer-process (current-buffer))))
-  (let* ((buffer-name (buffer-name (process-buffer proc)))
-         (pass (comint-read-noecho (format "Password for buffer \"%s\": " 
-                                           buffer-name)
-                                   'stars)))
-    (and pass
-         (save-excursion
-           (set-buffer buffer-name)
-           (insert-before-markers "\n")
-           (comint-send-string proc (format "%s\n" pass))))))
+    (setq buffer (get-buffer-create buffer-name))
+    (pop-to-buffer buffer-name)
+
+    (cond
+     ((comint-check-proc buffer-name))
+     (t
+      (comint-exec buffer buffer-name rlogin-program nil args)
+      (setq proc (get-buffer-process buffer))
+      ;; 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))
+
+      ;; 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.
+      ;; comint-output-filter-functions should already have a
+      ;; permanent-local property, at least in emacs 19.27 or later.
+      (if (fboundp 'make-local-hook)
+          (make-local-hook 'comint-output-filter-functions)
+        (make-local-variable 'comint-output-filter-functions))
+      (add-hook 'comint-output-filter-functions 'rlogin-carriage-filter)
+
+      (rlogin-mode)
+
+      (make-local-variable 'rlogin-host)
+      (setq rlogin-host host)
+      (make-local-variable 'rlogin-remote-user)
+      (setq rlogin-remote-user user)
+
+      (condition-case ()
+          (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-remote-user "@" rlogin-host ":"))
+                 (cd-absolute comint-file-name-prefix))
+                ((null rlogin-directory-tracking-mode))
+                (t
+                 (cd-absolute (concat comint-file-name-prefix "~/"))))
+        (error nil))))))
+
+(put 'rlogin-mode 'mode-class 'special)
 
-;;;###autoload
 (defun rlogin-mode ()
-  "Set major-mode for rlogin sessions. 
+  "Set major-mode for rlogin sessions.
 If `rlogin-mode-hook' is set, run it."
   (interactive)
   (kill-all-local-variables)
-  (comint-mode)
-  (setq comint-prompt-regexp shell-prompt-pattern)
+  (shell-mode)
   (setq major-mode 'rlogin-mode)
   (setq mode-name "rlogin")
   (use-local-map rlogin-mode-map)
+  (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-dirtrackp t)
+    (setq comint-file-name-prefix
+          (concat "/" rlogin-remote-user "@" rlogin-host ":")))
+   ((< prefix 0)
+    (setq rlogin-directory-tracking-mode nil)
+    (setq shell-dirtrackp nil))
+   (t
+    (setq rlogin-directory-tracking-mode 'local)
+    (setq comint-file-name-prefix "")
+    (setq shell-dirtrackp t)))
+  (cond
+   (shell-dirtrackp
+    (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)))))))
+
 
-(defun rlogin-filter (proc string)
-  (save-excursion
-    (set-buffer (process-buffer proc))
-    (let ((proc-mark (process-mark proc))
-          (region-begin (point)))
-      (goto-char proc-mark)
-      (insert-before-markers string)
-      (goto-char region-begin)
-      (while (search-forward "\C-m" proc-mark t)
-        (delete-char -1))))
-  ;; Kludgy workaround for scroll-step bug in emacs.  If point is at the
-  ;; top of the window, scroll step is nonzero, and you call
-  ;; insert-before-markers, the text is inserted off-screen.  If
-  ;; scroll-step is 0, this doesn't happen. 
-  (and (/= scroll-step 0)
-       (eq (process-buffer proc) (window-buffer (selected-window)))
-       (eq (point) (window-start))
-       (set-window-start (selected-window) 
-                         (save-excursion
-                           (beginning-of-line)
-                           (point)) 
-                         'noforce))
-  (and rlogin-password-paranoia 
-       (string= "Password:" string)
-       (rlogin-password proc)))
+;; 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)))
+    (set-match-data (match-data))
+    (nreverse list)))
+
+(defun rlogin-carriage-filter (string)
+  (let* ((point-marker (point-marker))
+         (end (process-mark (get-buffer-process (current-buffer))))
+         (beg (or (and (boundp 'comint-last-output-start)
+                       comint-last-output-start)
+                  (- end (length string)))))
+    (goto-char beg)
+    (while (search-forward "\C-m" end t)
+      (delete-char -1))
+    (goto-char point-marker)))
 
-;;;###autoload
 (defun rlogin-send-Ctrl-C ()
   (interactive)
   (send-string nil "\C-c"))
 
-;;;###autoload
+(defun rlogin-send-Ctrl-D ()
+  (interactive)
+  (send-string nil "\C-d"))
+
 (defun rlogin-send-Ctrl-Z ()
   (interactive)
   (send-string nil "\C-z"))
 
-;;;###autoload
 (defun rlogin-send-Ctrl-backslash ()
   (interactive)
   (send-string nil "\C-\\"))
 
-;;;###autoload
 (defun rlogin-delchar-or-send-Ctrl-D (arg)
-  "Delete ARG characters forward, or send a C-d to process if at end of
-buffer."  
-  (interactive "p") 
+  "\
+Delete ARG characters forward, or send a C-d to process if at end of buffer."
+  (interactive "p")
   (if (eobp)
-      (send-string nil "\C-d")
+      (rlogin-send-Ctrl-D)
     (delete-char arg)))
 
+(defun rlogin-tab-or-complete ()
+  "Complete file name if doing directory tracking, or just insert TAB."
+  (interactive)
+  (if rlogin-directory-tracking-mode
+      (comint-dynamic-complete)
+    (insert "\C-i")))
+
+(provide 'rlogin)
+
 ;;; rlogin.el ends here