comparison lisp/rlogin.el @ 2387:cb44857cab89

moby rlogin-filter fixes

2386:ded35864afbe

;;; rlogin.el --- remote login interface

;; Maintainer: Noah Friedman <[e-mail]>
;; Keywords: unix, comm

;; Copyright (C) 1992 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
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;;              Cambridge, MA 02139, USA. 
;;

;;; Commentary:

;; Support for remote login over Internet using rlogin(1).
;;
;; Todo: add directory tracking using ange-ftp style patchnames for the cwd.

;;; Code:

       (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)))

(defun rlogin (host)
  (interactive "sOpen rlogin connection to host: ")
  (let* ((buffer-name (concat "rlogin-" host))
         (*buffer-name* (concat "*" buffer-name "*")))
    (cond ((not (comint-check-proc *buffer-name*))

             (if xargs
                 (setq xargs (append xargs host))
               (setq xargs (list host)))
             (set-buffer (apply 'make-comint buffer-name rlogin-program nil xargs))
             (setq proc (get-process buffer-name))
             (set-process-filter proc 'rlogin-filter)
             (rlogin-mode))))
    (switch-to-buffer *buffer-name*)))

(defun rlogin-mode ()
  (interactive)
  (comint-mode)
  (setq comint-prompt-regexp shell-prompt-pattern)
  (setq major-mode 'rlogin-mode)
  (setq mode-name "Rlogin")
  (use-local-map rlogin-mode-map)
  (run-hooks 'rlogin-mode-hook))

(defun rlogin-filter (proc string)
  (let ((process-buffer (process-buffer proc))
        (at-eobp (eobp)))
    (save-excursion
      (set-buffer process-buffer)
      (goto-char (point-max))
      (let ((now (point))
            process-mark)
        (insert string)
        (subst-char-in-region now (point) ?\C-m ?\ )
        (subst-char-in-region now (point) ?\M-r ?\ )
        (setq process-mark (process-mark proc))
        (and process-mark
            (set-marker process-mark (point)))))
    (and at-eobp
         (eq process-buffer (current-buffer))
         (goto-char (point-max)))))

(defun rlogin-send-Ctrl-C ()
  (interactive)
  (send-string nil "\C-c"))

2387:cb44857cab89

;;; rlogin.el --- remote login interface

;; Maintainer: Noah Friedman <[e-mail]>
;; Keywords: unix, comm

;; Copyright (C) 1992, 1993 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
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;;              Cambridge, MA 02139, USA. 
;;

;;; Commentary:

;; Support for remote logins using `rlogin'.
;;
;; Todo: add directory tracking using ange-ftp style patchnames for the cwd.

;;; Code:

       (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)))

;;;###autoload
(defun rlogin (host)
  (interactive "sOpen rlogin connection to host: ")
  (let* ((buffer-name (concat "rlogin-" host))
         (*buffer-name* (concat "*" buffer-name "*")))
    (cond ((not (comint-check-proc *buffer-name*))

             (if xargs
                 (setq xargs (append xargs host))
               (setq xargs (list host)))
             (set-buffer (apply 'make-comint buffer-name rlogin-program nil xargs))
             (setq proc (get-process buffer-name))
             (set-marker (process-mark proc) (point-min))
             (set-process-filter proc 'rlogin-filter)
             (rlogin-mode))))
    (switch-to-buffer *buffer-name*)))

;;;###autoload
(defun rlogin-mode ()
  (interactive)
  (comint-mode)
  (setq comint-prompt-regexp shell-prompt-pattern)
  (setq major-mode 'rlogin-mode)
  (setq mode-name "Rlogin")
  (use-local-map rlogin-mode-map)
  (run-hooks 'rlogin-mode-hook))

(defun rlogin-filter (proc string)
  (let ((old-buffer (current-buffer))
        (old-match-data (match-data))
        at-max-pos
        moving)
    (unwind-protect
        (progn
          (set-buffer (process-buffer proc))
          (setq moving (= (point) (process-mark proc)))
          (save-excursion
            (goto-char (process-mark proc))
            (save-restriction
              (let ((beg (point)))
                (insert-before-markers string)
                (narrow-to-region beg (point))
                (goto-char (point-min))
                (while (search-forward "\C-m" nil t)
                  (delete-char -1))
                (setq string (buffer-substring (point-min) (point-max)))
                (goto-char (point-max))))
            (set-marker (process-mark proc) (point)))
          (and moving 
               (goto-char (process-mark proc))))
      (set-buffer old-buffer)
      (store-match-data old-match-data))))

(defun rlogin-send-Ctrl-C ()
  (interactive)
  (send-string nil "\C-c"))