home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / gnu / lucid / lemacs-19.6 / lisp / comint / telnet.el < prev    next >
Encoding:
Text File  |  1992-12-28  |  9.0 KB  |  237 lines
  1. ;; Copyright (C) 1985, 1988, 1992 Free Software Foundation, Inc.
  2.  
  3. ;; This file is part of GNU Emacs.
  4.  
  5. ;; GNU Emacs is free software; you can redistribute it and/or modify
  6. ;; it under the terms of the GNU General Public License as published by
  7. ;; the Free Software Foundation; either version 2, or (at your option)
  8. ;; any later version.
  9.  
  10. ;; GNU Emacs is distributed in the hope that it will be useful,
  11. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13. ;; GNU General Public License for more details.
  14.  
  15. ;; You should have received a copy of the GNU General Public License
  16. ;; along with GNU Emacs; see the file COPYING.  If not, write to
  17. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  18.  
  19. ;; Author William F. Schelter
  20. ;; Hacked for lemacs and comint by Jamie Zawinski
  21.  
  22. ;;to do fix software types for lispm:
  23. ;;to eval current expression.  Also to try to send escape keys correctly.
  24. ;;essentially we'll want the rubout-handler off.
  25.  
  26. ;; filter is simplistic but should be okay for typical shell usage.
  27. ;; needs hacking if it is going to deal with asynchronous output in a sane
  28. ;; manner
  29.  
  30. (require 'comint)
  31.  
  32. (defvar telnet-mode-map nil)
  33.  
  34. (if telnet-mode-map
  35.     nil
  36.   (setq telnet-mode-map (make-sparse-keymap))
  37.   (set-keymap-name telnet-mode-map 'telnet-mode-map)
  38.   (set-keymap-parent telnet-mode-map comint-mode-map)
  39.   (define-key telnet-mode-map "\C-m" 'telnet-send-input)
  40. ;  (define-key telnet-mode-map "\C-j" 'telnet-send-input)
  41.   (define-key telnet-mode-map "\C-c\C-q" 'telnet-send-process-next-char)
  42.   (define-key telnet-mode-map "\C-c\C-c" 'telnet-interrupt-subjob) 
  43.   (define-key telnet-mode-map "\C-c\C-z" 'telnet-c-z))
  44.  
  45. (defvar telnet-new-line "\r")                ; buffer-local
  46. (defvar telnet-replace-c-g nil)                ; buffer-local
  47. (defvar telnet-prompt-pattern "^[^#$%>]*[#$%>] *")    ; buffer-local
  48. (defvar telnet-remote-echoes t                ; buffer-local
  49.    "True if the telnet process will echo input.")
  50. (defvar telnet-interrupt-string "\C-c"            ; buffer-local
  51.   "String sent by C-c.")
  52.  
  53. (defvar telnet-count 0                    ; buffer-local
  54.   "Number of output strings read from the telnet process
  55. while looking for the initial password.")
  56.  
  57. (defvar telnet-initial-count -50
  58.   "Initial value of telnet-count.  Should be set to the negative of the
  59. number of terminal writes telnet will make setting up the host connection.")
  60.  
  61. (defvar telnet-maximum-count 4
  62.   "Maximum value telnet-count can have.
  63. After this many passes, we stop looking for initial setup data.
  64. Should be set to the number of terminal writes telnet will make
  65. rejecting one login and prompting for the again for a username and password.")
  66.  
  67. (defun telnet-interrupt-subjob ()
  68.   (interactive)
  69.   "Interrupt the program running through telnet on the remote host."
  70.   (send-string nil telnet-interrupt-string))
  71.  
  72. (defun telnet-c-z ()
  73.   (interactive)
  74.   (send-string nil "\C-z"))
  75.  
  76. (defun telnet-send-process-next-char ()
  77.   (interactive)
  78.   (send-string nil
  79.            (char-to-string
  80.         (let ((inhibit-quit t))
  81.           (prog1 (read-char)
  82.             (setq quit-flag nil))))))
  83.  
  84. ;;maybe should have a flag for when have found type
  85. (defun telnet-check-software-type-initialize (string)
  86.   "Tries to put correct initializations in.  Needs work."
  87.   (let ((case-fold-search t))
  88.     (cond ((string-match "unix" string)
  89.        ;;(setq telnet-prompt-pattern comint-prompt-regexp)
  90.        (setq telnet-prompt-pattern shell-prompt-pattern)
  91.        (setq telnet-new-line "\n"))
  92.       ((string-match "tops-20" string);;maybe add telnet-replace-c-g
  93.        (setq telnet-prompt-pattern  "[@>]*"))
  94.       ((string-match "its" string)
  95.        (setq telnet-prompt-pattern  "^[^*>]*[*>] *"))
  96.       ((string-match "explorer" string);;explorer telnet needs work
  97.        (setq telnet-replace-c-g ?\n))))
  98.   (set (make-local-variable 'comint-prompt-regexp)
  99.        telnet-prompt-pattern))
  100.  
  101. (defun telnet-initial-filter (proc string)
  102.   ;For reading up to and including password; also will get machine type.
  103.   (cond ((string-match "No such host" string)
  104.      (kill-buffer (process-buffer proc))
  105.      (error "No such host."))
  106.     ((string-match "passw" string)
  107.      (telnet-filter proc string)
  108.      (let* ((echo-keystrokes 0)
  109.         (password (telnet-read-password)))
  110.        (setq telnet-count 0)
  111.        (send-string proc (concat password telnet-new-line))))
  112.     (t (telnet-check-software-type-initialize string)
  113.        (telnet-filter proc string)
  114.        (cond ((> telnet-count telnet-maximum-count)
  115.           (set-process-filter proc 'telnet-filter))
  116.          (t (setq telnet-count (1+ telnet-count)))))))
  117.  
  118. (defun telnet-filter (proc string)
  119.   (save-excursion
  120.     (set-buffer (process-buffer proc))
  121.     (save-match-data
  122.      (let* ((last-insertion (marker-position (process-mark proc)))
  123.         (delta (- last-insertion (point)))
  124.         (ie (and comint-last-input-end
  125.              (marker-position comint-last-input-end)))
  126.         (w (get-buffer-window (current-buffer)))
  127.         (ws (and w (window-start w))))
  128.        (goto-char last-insertion)
  129.        (insert-before-markers string)
  130.        (set-marker (process-mark proc) (point))
  131.        ;; the insert-before-markers may have screwed window-start
  132.        ;; and likely moved comint-last-input-end.  This is why the
  133.        ;; insertion-reaction should be a property of markers, not
  134.        ;; of the function which does the inserting.
  135.        (if ws (set-window-start w ws t))
  136.        (if ie (set-marker comint-last-input-end ie))
  137.        (while (search-backward "\C-m" last-insertion t)
  138.      (delete-char 1))
  139.        (goto-char (process-mark proc))
  140.        (and telnet-replace-c-g
  141.         (subst-char-in-region last-insertion (point) ?\C-g
  142.                   telnet-replace-c-g t))
  143.        (goto-char (+ (process-mark proc) delta))
  144.        (if (fboundp 'shell-hack-prompt-font) ; from shell-font.el
  145.        (shell-hack-prompt-font last-insertion))
  146.        ))))
  147.  
  148. (defun telnet-read-password ()
  149.   (let ((answ "") tem)
  150.     (message "Reading password...")
  151.     (while (not (or (= (setq tem (read-char)) ?\^m)
  152.             (= tem ?\n)))
  153.       (setq answ (concat answ (char-to-string tem))))
  154.     (message "")
  155.     answ))
  156.  
  157. (defun telnet-send-input ()
  158.   (interactive)
  159.   (let ((proc (get-buffer-process (current-buffer)))
  160.     p1 p2)
  161.     (if (and telnet-remote-echoes
  162.          (>= (point) (process-mark proc)))
  163.     (save-excursion
  164.       (if comint-eol-on-send (end-of-line))
  165.       (setq p1 (marker-position (process-mark proc))
  166.         p2 (point))))
  167.     (prog1
  168.     (comint-send-input)
  169.       ;; at this point, comint-send-input has moved the process mark, inserted
  170.       ;; a newline, and possibly inserted the (echoed) output.  If the host is
  171.       ;; in remote-echo mode, then delete our local copy of the command, and
  172.       ;; the newline that comint-send-input sent.
  173.       (if p1
  174.       (delete-region p1 (1+ p2))))))
  175.  
  176. (defun telnet-input-sender (proc string)
  177.   (comint-send-string proc string)
  178.   (comint-send-string proc telnet-new-line))
  179.  
  180. (defun telnet (hostname)
  181.   "Open a network login connection to host named HOST (a string).
  182. Communication with HOST is recorded in a buffer *HOST-telnet*.
  183. Normally input is edited in Emacs and sent a line at a time.
  184. See also `\\[rsh]'."
  185.   (interactive "sOpen telnet connection to host: ")
  186.   (let ((name (concat hostname "-telnet")))
  187.     (switch-to-buffer (make-comint name "telnet"))
  188.     (set-process-filter (get-process name) 'telnet-initial-filter)
  189.     (erase-buffer)
  190.     (send-string  name (concat "open " hostname "\n"))
  191.     (telnet-mode)
  192.     (setq telnet-count telnet-initial-count)))
  193.  
  194. (defun rsh (hostname)
  195.   "Open a network login connection to host named HOST (a string).
  196. Communication with HOST is recorded in a buffer *HOST-rsh*.
  197. Normally input is edited in Emacs and sent a line at a time.
  198. See also `\\[telnet]'."
  199.   (interactive "sOpen rsh connection to host: ")
  200.   (let ((name (concat hostname "-rsh")))
  201.     (switch-to-buffer (make-comint name "rsh" nil hostname))
  202.     (set-process-filter (get-process name) 'telnet-initial-filter)
  203.     (telnet-mode)
  204.     ;; SunOS doesn't print "unix" in its rsh login banner, so let's get a
  205.     ;; reasonable default here.  There do exist non-Unix machines which
  206.     ;; speak the rsh protocol, but let's hope they print their OS name
  207.     ;; when one connects.
  208.     (telnet-check-software-type-initialize "unix")
  209.     (setq telnet-count telnet-initial-count)))
  210.  
  211. (defun telnet-mode ()
  212.   "This mode is for use during telnet or rsh from a buffer to another
  213. host. It has most of the same commands as comint-mode.
  214. There is a variable ``telnet-interrupt-string'' which is the character
  215. sent to try to stop execution of a job on the remote host.
  216. Data is sent to the remote host when RET is typed.
  217. \\{telnet-mode-map}
  218.  
  219. Bugs:
  220. --Replaces \C-m by a space, really should remove."
  221.   (interactive)
  222.   (comint-mode)                        ; runs comint-mode-hook
  223.   (setq major-mode 'telnet-mode)
  224.   (setq mode-name "Telnet")
  225.   (setq comint-prompt-regexp telnet-prompt-pattern) ; local via comint-mode
  226.   (setq comint-input-sender 'telnet-input-sender)   ; local via comint-mode
  227.   (make-local-variable 'telnet-prompt-pattern)
  228.   (make-local-variable 'telnet-new-line)
  229.   (make-local-variable 'telnet-replace-c-g)
  230.   (make-local-variable 'telnet-remote-echoes)
  231.   (make-local-variable 'telnet-interrupt-string)
  232.   (make-local-variable 'telnet-count)
  233.   (use-local-map telnet-mode-map)
  234.   (run-hooks 'telnet-mode-hook))
  235.  
  236. (provide 'telnet)
  237.