Newsgroups: fj.editor.emacs
Path: galaxy.trc.rwcp.or.jp!jaist-news!cs.titech!nirvana.cs.titech!wnoc-tyo-news!sh.wide!wnoc-kyo-news!kuis-news!kurims!tatuya
From: tatuya@kurims.kyoto-u.ac.jp (Jinmei Tatuya)
Subject: j-rlogin.el
Message-ID: <TATUYA.94May10195330@pepper.kurims.kyoto-u.ac.jp>
Sender: news@kurims.kurims.kyoto-u.ac.jp
Nntp-Posting-Host: pepper
Organization: Research Institute for Mathematical Sciences, Kyoto, Japan.
Distribution: fj
Date: Tue, 10 May 1994 10:53:30 GMT
Lines: 533
Xref: galaxy.trc.rwcp.or.jp fj.editor.emacs:4669
X-originally-archived-at: http://galaxy.rwcp.or.jp/text/cgi-bin/newsarticle2?ng=fj.editor.emacs&nb=4669&hd=a
X-reformat-date: Mon, 18 Oct 2004 15:18:22 +0900
X-reformat-comment: Tabs were expanded into 4 column tabstops by the Galaxy's archiver. See http://katsu.watanabe.name/ancientfj/galaxy-format.html for more info.

  $B5~ETBg3X$N?@L@$H?=$7$^$9!#(B

  $B@hF|(B j-shell 2.0 $B$,=P$^$7$?$,!"$3$l$H(Brlogin.el$B$r%I%C%-%s%0$5$;$?$b$N(B
$B$r:n$C$F%m!<%+%k$K;H$C$F$$$?$i!"$H$"$k;v>p$K$h$j8x3+$9$k$3$H$K$J$C$F$7(B
$B$^$$$^$7$?!#(B

  $B0l1~(B

$B!&(Bange-ftp $B$K$h$k(B remote completion $B$,2DG=(B
$B!&(BNemacs $B$d(B Mule $B$G$b(Bpassword hiding$B$,$A$c$s$H5!G=$9$k(B

$B$N$h$&$JFCD'!J(B?$B!K$,$"$j$^$9$,!"$O$C$-$j8@$C$F%3!<%I<+BN$O(Bj-shell.el$B$H(B
rlogin.el$B$r$A$g$C$H=q$-49$($?DxEY$N>iD9$J$b$N$G$9!#(B

  $B$3$N$h$&$JCU@[$J$b$N$r8x3+$9$k$N$O@5D>$J$H$3$mHs>o$KCQ$:$+$7$$$N$G$9(B
$B$,!"$b$7>/$7$G$bM-MQ@-$r8+$$=P$;$k$h$&$G$7$?$i;H$C$F$_$F2<$5$$!#$=$7$F(B
$B8f<+M3$K2~B$$7$F$b$C$HNI$$$b$N$K$7$F$$$?$@$1$l$P9,$$$G$9!#(B

-------------------$B$3$3$+$i(B---$B$3$3$+$i(B--------------------------------
;;
;; j-rlogin.el
;; an rlogin mode which is based on rlogin.el and j-shell.el
;; version 0.11   94/05/02
;;

;; Copyright (C) 1994 JINMEI, Tatuya: tatuya@kurims.kyoto-u.ac.jp

;; 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
;; 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,
;; 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 GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.

;;
;; Japanese Document
;;
;; [Description]
;;   j-rlogin.el $B$O!"(BEmacs $B$NCf$+$i(B remote host $B$K(B login $B$9$k$?$a$N%W%m%0(B
;; $B%i%`$G!"(Brlogin.el $B$H(B j-shell.el $B$r%Y!<%9$K$7$F$$$^$9!#(Bj-shell $B$NKX$s$I(B
;; $B$N5!G=$r$=$N$^$^;HMQ$G$-$^$9!#(B
;; 
;;   j-shell $B$NCf$+$i$G$b(B rlogin $B$9$k$3$H$O2DG=$G$9$,!"(BNemacs $B$d(B Mule $B$N(B
;; $B>e$+$i$3$l$r9T$J$&$H!"(Bpassword hiding $B$N5!G=$,$&$^$/F/$-$^$;$s!#$^$?!"(B 
;; j-shell.el $B$O(B ange-ftp $BBP1~$K$J$C$F$O$$$^$9$,!"(Bremote file $B$N%3%s%W%j!<(B
;; $B%7%g%s$OIT2DG=$G$9!#(B
;; 
;;   j-rlogin.el $B$G$O!"%Q%9%o!<%IF~NO;~$N%$%s%?!<%U%'!<%9$K$O(B rlogin.el 
;; $B$N$b$N$rMQ$$$F$$$^$9$N$G!"(B password $BF~NO$,8+$($F$7$^$&$3$H$O$"$j$^$;$s!#(B
;; $B$^$?!"(Bj-rlogin.el $B$G$O!"(Bange-ftp $B$rMQ$$$?(B remote file $B$N%3%s%W%j!<%7%g(B
;; $B%s$,2DG=$K$J$C$F$$$^$9!#(B
;; 
;; [Installation]
;;   j-rlogin.el $B$r!JI,MW$J$i%P%$%H%3%s%Q%$%k$7$F!K(Bload-path $B$KF~$C$F$$$k(B
;; directory $B$KCV$-$^$9!#(B
;;   $B$5$i$K!"0J2<$r(B ~/.emacs $B$KDI2C$7$^$9!#(B
;; 
;; (autoload 'rlogin "j-rlogin"
;;                "Open a network login connection to host named HOST (a string). " t)
;;
;;   $B$^$?!"(Bdirectory tracking $BEy$N(B j-shell $B$N5!G=$r;HMQ$9$k$?$a$K$O!"(B
;; remote machine $B$N(B shell $B$N(B setup file (e.g. .cshrc) $B$r!"(B j-shell $B$N%$(B
;; $B%s%9%H!<%k$N;~$HF1$8$h$&$KJQ99$7$F$*$/I,MW$,$"$j$^$9!#(B
;; 
;;   $B$J$*!"(Bj-rlogin.el $B$r;H$&$?$a$K$O!"(Bj-shell.el $B$H(B ange-ftp.el $B$,I,MW(B
;; $B$G$9!#(B
;;
;; [Invocation]
;; j-rlogin $B$r5/F0$9$k$?$a$K$O!"(B
;; 
;; M-x rlogin
;; 
;; $B$H$7$^$9!#$9$k$H!"%_%K%P%C%U%!$G(B remote host $B$rJ9$$$F$-$^$9$N$GF~NO$7(B
;; $B$^$9!#$=$N8e!"I,MW$J$i%Q%9%o!<%I$rF~NO$9$l$P(B rlogin $B40N;$G$9!#(B
;; 
;; [Key Bindings]
;; rlogin mode $B$G$N%-!<%P%$%s%G%#%s%0$O!"(Bj-shell $B$N$b$N$H$[$\F1$8$G$9!#$?(B
;; $B$@$7!"(Bcompletion$B!J(BTAB$B!K$O!"(Bange-ftp $B$rMQ$$$F(B $B%j%b!<%HB&$G9T$J$$$^$9!#(B
;; 
;; [Customization]
;; j-shell $B$K$"$k(B customizable variable $B$O!"$[$\$=$N$^$^;HMQ$G$-$^$9!#(B
;; j-rlogin $B$KFCM-$N$b$N$G!"$+$D=EMW$J$b$N$O0J2<$NFs$D$G$9!#(B
;; 
;; rlogin-complete-files (default: t)
;;   nil $B$K$9$k$H(B ange-ftp $B$rMQ$$$?(B remote file $B$N(B completion $B$r9T$J$o$J(B
;; $B$/$J$j$^$9!#$?$@$7!"(Bcompletion $B$,A4$/$G$-$J$/$J$k$o$1$G$O$J$/!"(Blocal
;; file system $B>e$G$N(B completion $B$r9T$J$$$^$9!#(B
;;   $BDL?.%3%9%H$,Hs>o$K9b$$>l9g$d!"5U$K%U%!%$%k%7%9%F%`$N$[$H$s$I$,Hs>o$K(B
;; $B;wDL$C$?9=B$$K$J$C$F$$$k!J(BNFS$B$G6&M-$5$l$F$$$k>l9g$J$I!K;~$K$O(B nil $B$K$9(B
;; $B$kJ}$,M-8z$J$3$H$b$"$k$G$7$g$&!#(B
;; 
;; rlogin-complete-commands (default: nil)
;;   t $B$K$9$k$H(B remote host $B$N(B executable PATH $B$r(B ange-ftp $B$G%5!<%A$7$F(B 
;; remote command $B$N(B completion $B$r9T$J$$$^$9!#(Bfile name $B$N(B completion
;; $B$H0c$C$F!"(BPATH $B$K@_Dj$7$F$"$kA4$F$N(B directory $B$rD4$Y$k$N$G!":G=i$N0l2s(B
;; $B$OHs>o$K;~4V$,$+$+$j$^$9!#(Bdefault $B$NCM$,(B nil $B$K$J$C$F$$$k$N$O$=$N$?$a(B
;; $B$G$9!#(B
;;   nil $B$N>l9g$G$b!"(Blocal machine $B$HF1$8(B directory $B$K$"$kF1L>$N%3%^%s%I(B
;; $B$O(B completion $B2DG=$G$9!#(B

;;
;; Constants
;;
(defconst rlogin-version "0.11") 

(defconst rlogin-help-address "tatuya@kurims.kyoto-u.ac.jp")

;;
;; User customizable variables
;; (you can also use almost all the variables defined in j-shell.el)
;;
(defvar rlogin-default-host ""
  "*The default host name when rlogin.") 

(defvar rlogin-new-line "\r"
  "*The string which follows the password.")

(defvar rlogin-count 0)

(defvar rlogin-program-name "rlogin"
  "*Name of program to spawn a shell on the remote machine*")

(defvar rlogin-mode-hooks nil
  "*The hooks that are called when a buffer enters rlogin-mode.")

(defvar rlogin-start-hooks nil
  "*The hooks that are called when j-rlogin starts the shell program.")

(defvar rlogin-complete-files t
  "*Non-nil means try to complete files on the remote host (by using ange-ftp).")

(defvar rlogin-complete-commands nil
  "*Non-nil means try to complete commands on the remote host (by using ange-ftp).")

;;
;; Required packages
;;
(require 'j-shell)
(require 'ange-ftp)

;;
;; Functions
;;

(defun rlogin (rlogin-hostname &optional shell-program-name new-buffer-name)
  "Open a network login connection to host named RLOGIN-HOSTNAME (a string).
Communication with HOST is recorded in a buffer *RLOGIN-HOSTNAME-rlogin*.
Normally input is edited in Emacs and sent a line at a time."
  
  (interactive (read-rlogin-host "Open rlogin connection to host "))

  ;; Pick the name of the new buffer.
  (setq buffer-name
(if new-buffer-name
    new-buffer-name
  (if jsh-buffer-base-name
      (if (eq jsh-buffer-base-name t)
  (file-name-nondirectory rlogin-program-name)
jsh-buffer-base-name)
    "rlogin")))
  
  ;; Generate a new buffer
  (setq jshell (generate-new-buffer (concat "*" rlogin-hostname "-rlogin*")))
  (switch-to-buffer jshell)
  
  (rlogin-mode rlogin-program-name rlogin-hostname)
  
  (message jsh-version-string))

(defun read-rlogin-host (prompt)
  (interactive)
  (let* ((host (read-string
(concat prompt "[" rlogin-default-host "]: "))))
    (list (if (equal host "") rlogin-default-host host))))

(defun rlogin-mode (program-name hostname &rest args)
  (interactive)
  (kill-all-local-variables)

  (setq major-mode 'rlogin-mode)
  (setq mode-name "rlogin")
  
  ;; Setup the mode-line
  (if jsh-use-alternate-modeline
      (setq mode-line-format jsh-alternate-modeline))
  
  ;; Make all the local variables...
  (make-local-variable 'jsh-program-name)
  (setq jsh-program-name program-name)
  
  (make-local-variable 'jsh-host)
  (setq jsh-host hostname)
  
  (make-local-variable 'jsh-host)
  (setq jsh-host (system-name))
  
  (make-local-variable 'jsh-dir)
  (setq jsh-dir default-directory)
  
  (make-local-variable 'jsh-default-dir)
  (update-jsh-dir default-directory)
  
  (make-local-variable 'jsh-grab-history)
  (setq jsh-grab-history nil)
  
  (make-local-variable 'jshmark)
  (setq jshmark (make-marker));jshmark's position will get
;set in jsh-start-program.
  
  (make-local-variable 'jsh-history)
  (setq jsh-history (make-vector jsh-history-stack-size nil))
  
  (make-local-variable 'jsh-hist-tos)
  (setq jsh-hist-tos (- jsh-history-stack-size 1))
  
  (make-local-variable 'jsh-hist-bos)
  (setq jsh-hist-bos 0)
  
  (make-local-variable 'jsh-hist-sp)
  (setq jsh-hist-sp jsh-hist-tos)
  
  (make-local-variable 'jsh-hist-interact)
  (setq jsh-hist-interact 0)
  
  (make-local-variable 'jsh-hist-at-tos)
  (setq jsh-hist-at-tos t)
  (make-local-variable 'jsh-hist-at-bos)
  (setq jsh-hist-at-bos t)
  
  (make-local-variable 'jsh-parsing-password)
  (setq jsh-parsing-password nil)
  
  (make-local-variable 'jsh-environment)
  (setq jsh-environment (jsh-make-environment))
  
  (make-local-variable 'jsh-message)
  (setq jsh-message nil)
  
  ;; PATH isn't cumulative, so it probably needs to be buffer-local
  (make-local-variable 'jsh-exec-path)
  (setq jsh-exec-path (jsh-make-exec-path (jsh-getenv "PATH")))
  
  ;; setup the keymap
  (rlogin-setup-keymap)
  
  (run-hooks 'rlogin-mode-hooks)
  
  (if (and (featurep 'dir-hist)
   (not (dirhist-p 'jsh-dirhist)))
      (dh-make-dirhist 'jsh-dirhist))
  
  (rlogin-start-program hostname))

(defun rlogin-setup-keymap ()
  ;; Set up the keyboard map for rlogin mode.
  (if (and (boundp 'rlogin-mode-map) rlogin-mode-map)
      nil

    ;;Make a copy of the global map and make substitutions for all the
    ;;"printing" keys and for Del.  The substituted functions handle
    ;;the reading of passwords.
    (setq jsh-mode-map (copy-keymap global-map))
    (substitute-key-definition 'self-insert-command 'jsh-self-insert
       jsh-mode-map)
    (substitute-key-definition 'delete-backward-char 'jsh-del-back
       jsh-mode-map)

    ;;Install new keymaps into the mode map; this is necessary because
    ;;copy-keymap isn't fully recursive.  If we didn't make these
    ;;substitutions, our C-c and Meta (ESC) key definitions would
    ;;"leak" into other buffers.
    (define-key jsh-mode-map "\C-c" (make-sparse-keymap))
    (define-key jsh-mode-map "\C-[" (make-sparse-keymap))

    (fill-out-keymap);defined in j-shell.el
    (setq rlogin-mode-map (copy-keymap jsh-mode-map))
    (define-key rlogin-mode-map "\t" 'rlogin-complete) ;modify some of the original settings
    (define-key rlogin-mode-map "\C-c\C-b" 'rlogin-submit-bug-report))
  (use-local-map rlogin-mode-map))

(defun rlogin-start-program (hostname)
  "Start or restart the shell program in the current buffer.  Called
automatically by jsh-mode to start the first shell; may be called
manually through C-c C-s to restart the shell if it dies or you kill
it accidentally.  Runs the hooks in rlogin-start-hooks."
  
  (interactive)
  
  (make-local-variable 'jshproc)
  
  (if (and (setq jshproc (get-buffer-process (current-buffer)))
   (setq jsh-status (process-status jshproc))
   (or (eq jsh-status 'run) (eq jsh-status 'stop)))
      (error "A process is already running (or runnable) in this buffer.")
    
    ;; If a processs was running in this buffer, clean it up...
    (if jshproc (delete-process jshproc))
    
    ;; Start the new process
    (setq buff-name (buffer-name))
    (setq jshproc (start-process buff-name jshell
 (concat exec-directory "env")
 (setq termcap
       (format"TERMCAP=emacs:co#%d:tc=unknown:"
      (screen-width)))
 "TERM=emacs"
 "JSHELL=t"
 rlogin-program-name hostname))

    ;; I cannot explain why the following call is necessary, unless it
    ;; is because there is an error in Emacs.  If two buffers, named
    ;; "tcsh" and "tcsh<2>", are present and we attempt to restart the
    ;; shell in the first buffer, the process will magically get
    ;; associated with the second, even though the call to start-
    ;; process explicitly specified the first.  This call negates that
    ;; odd behavior.
    (set-process-buffer jshproc (current-buffer))

    (set-process-filter jshproc 'rlogin-initial-filter);read password, if necessary.
    (set-marker jshmark (point))
    (run-hooks 'rlogin-start-hooks))
  jshproc)

(defun rlogin-initial-filter (proc string)
  ;For reading up to and including password
  (cond ((or (string-match "No such host" string)
     (string-match "unknown host" string))
 (kill-buffer (process-buffer proc))
 (error "No such host."))
((string-match "[Pp]assw" string)
 (jsh-filter proc string)
 (let ((echo-keystrokes 0))
   (setq password (read-password))
   (setq rlogin-count 0)
   (send-string proc (concat password  rlogin-new-line))))
(t (rlogin-check-software-type-initialize string)
   (jsh-filter proc string)
   (cond ((> rlogin-count 4)
  (set-process-filter proc 'jsh-filter))
 (t (setq rlogin-count (1+ rlogin-count)))))))

;;maybe should have a flag for when have found type
(defun rlogin-check-software-type-initialize (string)
  "Tries to put correct initializations in.  Needs work."
  (cond ((string-match "unix" string)
 (setq rlogin-prompt-pattern jsh-prompt-pattern)
 (setq rlogin-new-line "\n"))
((string-match "tops-20" string) ;;maybe add rlogin-replace-c-g
 (setq rlogin-prompt-pattern  "[@>]*"))
((string-match "its" string)
 (setq rlogin-prompt-pattern  "^[^*>]*[*>] *"))
((string-match "explorer" string)  ;;explorer rlogin needs work
 (setq rlogin-replace-c-g ?\n))
))

(defun read-password ()
  (let ((answ "") tem)
    (while (not(or  (= (setq tem (read-char)) ?\^m)
    (= tem ?\n)))
      (setq answ (concat answ (char-to-string tem))))
    answ))

;; the following functions are for completing on the remote machine.
;; these are quite similar to ones defined in j-shell.el
(defun rlogin-complete ()
  "Perform completion on the preceding string (in the remote host).

The string may be a filename, environment variable, or (depending on
context) a command."

  (interactive)

  ;; The following if-construct and its contents have been added for
  ;; j-shell.
  (if others-at-completion;If others-at-completion
      nil;already has a value, do
;nothing.

    ;; If there are other windows, set others-at-completion to the
    ;; buffer in the other window, the one that will be supplanted by
    ;; the completions buffer.  If there are no other windows, set
    ;; others-at-completion to 'no.
    (if (other-windows)
(progn       
  (other-window 1)
  (setq others-at-completion (current-buffer))
  (other-window -1))
      (setq others-at-completion 'no)))

  (let* ((beg  (save-excursion
                 (re-search-backward jsh-completion-separator)
                 (1+ (point))))
         (end (point))
 (jsh-at-command (jsh-at-command (marker-position jshmark) beg))
         (file (file-name-nondirectory (buffer-substring beg end)))
 (dir (file-name-directory (buffer-substring beg end)))
 (remote-dir (if dir (concat "/" jsh-host ":" (rlogin-make-full-path dir)) ""))
         (akin (rlogin-all-completions file
       (if rlogin-complete-files remote-dir dir)))
 (lpc (new-try-completion file (jsh-make-alist-from-list 
    (append akin nil)))))
    (cond ((eq lpc t)
           (message "[Sole completion]")
   (if (and jsh-expand-environment
    (= (char-after (setq from (- beg 1))) ?$)
    (setq expansion (jsh-getenv file)))
       (progn
 (message "[Sole completion--expanded]")
 (delete-region (- beg 1) end)
 (insert expansion))
     (sit-for 2)))
          ((eq lpc nil)
           (ding t)
           (message "[No match]")
           (sit-for 2))
          ((and (string= lpc file) (my-member lpc akin))
           (message "[Complete, but not unique]")
           (sit-for 2))
          ((string= lpc file)
           (jsh-completion-help akin))
          (t
           (delete-region beg end)
           (insert (or dir "") lpc)))))

(defun rlogin-all-command-completions (file)
  (let (commands
(path jsh-exec-path))
    (while path
      (let ((dir (if rlogin-complete-commands
     (concat "/" jsh-host ":" (file-name-as-directory (car path)))
   (file-name-as-directory (car path)))))
(if (file-exists-p dir)
    (if (string= dir ".")
nil
      (setq files (file-name-all-completions file dir))
      (while files
(setq filename (concat dir (car files)))
;never mind whether FILENMAE is executable or not
;(if (file-executable-p filename)
    ;(setq commands (cons (car files) commands)))
(setq commands (cons (car files) commands))
(setq files (cdr files))))))
      (setq path (cdr path)))
    commands))

(defun rlogin-all-completions (file dir)

  (let (completions)

    (if (and jsh-complete-commands
     (string= dir "")
     jsh-at-command)
(if (and (boundp 'jsh-complete-command-threshold)
 jsh-complete-command-threshold
 (<= (length file) jsh-complete-command-threshold))
    nil
  (setq completions (append (rlogin-all-command-completions file)
    completions))
  (if (and (boundp 'jsh-builtin-commands)
   jsh-builtin-commands)
      (setq completions (append (new-all-completions
 file jsh-builtin-commands)
completions)))))

    (if (and jsh-complete-environment
     (string= dir ""))
(if (and (and (boundp 'jsh-complete-env-threshold)
      jsh-complete-env-threshold
      (<= (length file) jsh-complete-env-threshold)))
    nil 
  (setq completions (append (new-all-completions file jsh-environment)
    completions))))

    (setq completions (append (file-name-all-completions file dir) completions))
    
    completions))

(defun rlogin-make-full-path (dir)
  "Make the full directory of DIR."
  (if (eq (string-match "/" dir) 0);if DIR is already a full path, then do nothing
      dir
    (concat jsh-dir "/" dir)))

;; the function for bug-report
(defun rlogin-submit-bug-report ()
  "Submit via mail a bug report on j-rlogin."
  (interactive)
  (require 'reporter)
  (let ((curbuf (current-buffer)))
    (reporter-submit-bug-report
     rlogin-help-address
     (concat "j-rlogin.el " rlogin-version " running "
     rlogin-program-name "\nin " (pwd) "\non system " (system-name))
     (append
      (list
       'default-directory
       'case-fold-search)
      (list-vars-matching "^jsh-\\|^rlogin-"))
     nil
     (function
      (lambda ()
(insert
 (save-excursion
   (set-buffer curbuf)
   (goto-char (point-max))
   (forward-line -100)
   (concat "\nLast "
   (count-lines (point) (point-max))
   " lines of buffer\n"
   "=========================\n"
   (buffer-substring (point) (point-max))
   "\n=========================\n"))))))))

;; to be comaptible with Emacs 18.55(Nemacs)
(defun new-try-completion (string alist &optional pred)
  (if (null alist) nil
    (try-completion string alist pred)))

(defun new-all-completions (string alist &optional pred)
  (if (null alist) nil
    (all-completions string alist pred)))

-------------------$B$3$3$^$G(B---$B$3$3$^$G(B--------------------------------
--
 $B?@L@(B $BC#:H(B (tatuya@kurims.kyoto-u.ac.jp)
 $B5~ETBg3XM}3XIt?tM}2r@O8&5f=j#M#2(B
