home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / packages / shell-filt.el < prev    next >
Encoding:
Text File  |  1990-07-22  |  5.0 KB  |  105 lines
  1. ;From ark1!uakari.primate.wisc.edu!zaphod.mps.ohio-state.edu!swrinde!cs.utexas.edu!sun-barr!rutgers!aramis.rutgers.edu!paul.rutgers.edu!gaynor Sun Dec 17 22:38:33 EST 1989
  2. ;Article 1076 of comp.emacs:
  3. ;Path: ark1!uakari.primate.wisc.edu!zaphod.mps.ohio-state.edu!swrinde!cs.utexas.edu!sun-barr!rutgers!aramis.rutgers.edu!paul.rutgers.edu!gaynor
  4. ;From: gaynor@paul.rutgers.edu (Silver)
  5. ;Newsgroups: comp.emacs
  6. ;Subject: Giving shell filters one last kick...
  7. ;Message-ID: <Dec.15.18.22.35.1989.22370@paul.rutgers.edu>
  8. ;Date: 15 Dec 89 23:22:36 GMT
  9. ;Reply-To: gaynor@topaz.rutgers.edu
  10. ;Organization: Rutgers Univ., New Brunswick, N.J.
  11. ;Lines: 90
  12. ;
  13. ;I've got something that works fairly well.  Reconfigurable to some extent on a
  14. ;character by character basis, sends passwords without echo (sorry, no fix for
  15. ;the recent-keys problem).
  16. ;
  17. ;Regards, [Ag]
  18. ;_______________________________________________________________________________
  19.  
  20. (provide 'shell-filter)
  21.  
  22. ;; When logging in remotely, you might want to give the command "stty -echo" to
  23. ;; suppress the echoing of commands as they're executed.  For tcsh, you may
  24. ;; also want to unset editmode and/or filec.  Up to you, though...
  25.  
  26. ;; The regexp is a little convoluted, but I think it covers most of the bases.
  27. (defvar shell-filter-password-prompt "\\<passw\\(or\\)?d[\ \t]*[:>][\ \t]*\\'"
  28. "Regular expression used to determine whether shell output contains a request
  29. for a password.  The successful candidate will match the end of the buffer,
  30. handle whitespace appropriately, and various convolutions of `password'.  The
  31. ambient value of case-fold-search is non-nil during matching.")
  32.  
  33. (defun read-string-no-echo (&optional prompt)
  34. "Read and return a string without echoing it.  Newline and return characters
  35. terminate input.  If optional PROMPT is non-nil, it is displayed and the cursor
  36. placed in the minibuffer while reading.  \(Warning: view-lossage/recent-keys
  37. can access the last 100 characters typed.\)"
  38.   (interactive)
  39.   (save-window-excursion
  40.     (let ((echo-keystrokes 0)
  41.           (string "")
  42.           char)
  43.       (if prompt
  44.         (progn (select-window (minibuffer-window))
  45.                (set-window-buffer (selected-window)
  46.                                   (get-buffer-create " *Temporary*"))
  47.                (erase-buffer)
  48.                (insert prompt)))
  49.       ;; Grossly inefficient.  BFD.
  50.       (while (not (memq (setq char (read-char)) '(?\r ?\n)))
  51.         (setq string (concat string (char-to-string char))))
  52.       string)))
  53.  
  54. (defun shell-filter-read-password ()
  55. "Read a password in-line (without display, of course) and return it."
  56.   (read-string-no-echo))
  57.  
  58. (defun shell-filter-nuke-1    () (delete-char 1))
  59. (defun shell-filter-ding      () (delete-char 1) (ding 'continue))
  60. (defun shell-filter-backspace () (delete-char 1) (delete-char (if (eq ?_ (preceding-char)) -1 1)))
  61.  
  62. ;; I would have done this by regexp instead of character, but I think that this
  63. ;; would be putting more computation and effort than the task warrants.
  64. (defvar shell-filter-specials-alist
  65.   '((?\C-m . shell-filter-nuke-1)
  66.     (?\C-l . shell-filter-nuke-1)
  67.     (?\C-g . shell-filter-ding)
  68.     (?\C-h . shell-filter-backspace))
  69. "Alist of (CHARACTER . ACTION).  When CHARACTER is encountered in shell output,
  70. call ACTION with no parameters.")
  71.  
  72. (defun shell-filter (process string)
  73. "Output filter for shell-mode buffers.  See shell-filter-specials-alist for
  74. information about special character handling.  See shell-filter-password-prompt
  75. and shell-filter-read-password for information about password handling."
  76.   (save-excursion
  77.     (set-buffer (process-buffer process))
  78.     (goto-char (marker-position (process-mark process)))
  79.     (let ((begin (point))
  80.           (end (progn (insert-before-markers string) (point)))
  81.           (case-fold-search t)
  82.           (specials (concat "^" (mapconcat (function (lambda (el)
  83.                                                        (char-to-string (car el))))
  84.                                            shell-filter-specials-alist ""))))
  85.       (goto-char begin)
  86.       ;; Alternatively, things could be based around re-search-foward.  There's
  87.       ;; no need for the added overhead, imho.
  88.       (while (progn (skip-chars-forward specials end) (< (point) end))
  89.         (funcall (cdr (assoc (following-char) shell-filter-specials-alist))))
  90.       ;; It might be more `correct' to match against string instead of the buffer.
  91.       (if (re-search-backward shell-filter-password-prompt begin t)
  92.         (progn (goto-char (match-end 0))
  93.                (process-send-string process (concat (shell-filter-read-password) "\n")))))))
  94.  
  95. ;; RU's site-init contains a function named add-hook.  I don't know if it's
  96. ;; standard, but its intent is fairly obvious.
  97. (add-hook 'shell-mode-hook
  98.           (function (lambda ()
  99.                       ;; Uncomment this if you want shells to die easily.
  100.                       ;; (process-kill-without-query (get-buffer-process (current-buffer)))
  101.                       (set-process-filter (get-buffer-process (current-buffer))
  102.                                           (function shell-filter)))))
  103.  
  104.  
  105.