home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / modes / J-Shell-1.1 / j-shell.el < prev    next >
Encoding:
Text File  |  1993-04-03  |  39.0 KB  |  1,208 lines
  1. ;; -*-Emacs-Lisp-*-
  2. ;; $Id: j-shell.el,v 1.1 1993/04/03 23:49:55 jct Exp $
  3.  
  4. ;; Jim's Pretty-Good Shell Mode for GNU Emacs (J-Shell)
  5. ;; Copyright (C) 1992, 1993 James C. Thompson, jimt@sugar.neosoft.com
  6.  
  7. ;; J-Shell is free software; you can redistribute it and/or modify
  8. ;; it under the terms of the GNU General Public License as published by
  9. ;; the Free Software Foundation; either version 2, or (at your option)
  10. ;; any later version.
  11.  
  12. ;; J-Shell is distributed in the hope that it will be useful,
  13. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15. ;; GNU General Public License for more details.
  16.  
  17. ;; You should have received a copy of the GNU General Public License
  18. ;; along with GNU Emacs; see the file COPYING.  If not, write to
  19. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  20.  
  21. ;; -----------------------------------------------------------
  22. ;;        ***  CAUTION  ***  CAUTION  ***  CAUTION  ***
  23. ;; This package redefines the Emacs functions view-lossage and
  24. ;; recent-keys, as a means of protecting passwords entered in
  25. ;; jsh-mode.  Any packages or lisp code that depends on these
  26. ;; functions will probably lose.  This feature may be disabled
  27. ;; at the user's option; see the variable jsh-secure-mode.
  28. ;; -----------------------------------------------------------
  29.  
  30. (defconst jsh-version  (substring "$Revision: 1.1 $" 11 -2)
  31.   "$Id: j-shell.el,v 1.1 1993/04/03 23:49:55 jct Exp $
  32.  
  33. Report bugs to: James C. Thompson <jimt@neosoft.com>")
  34.  
  35. (defconst jsh-version-string (concat "J-Shell, version " jsh-version))
  36.  
  37. (defvar jsh-prompt-pattern "[>%\\$][ \t]*"
  38.   "*Matches the user's prompt.")
  39.  
  40. (defvar jsh-greeting-file "/etc/motd"
  41.   "*Specifies the file to be inserted at the top of the jsh buffer.
  42. If nil, no file is inserted.")
  43.  
  44. (defvar jsh-password-pattern "[Pp]assword: *$"
  45.   "*The pattern that invokes password-parsing.")
  46.  
  47. (defvar jsh-use-alternate-modeline nil
  48.   "*Non-nil means use mode-line containing host and directory.")
  49.  
  50. (defvar jsh-alternate-modeline '("--%b--  " global-mode-string "  " jsh-default-dir)
  51.   "*A modeline to display buffer name and default directory.")
  52.  
  53. (defvar jsh-modeline-dir-len 64
  54.   "*How much of the current directory to display in the mode line.")
  55.  
  56. (defvar jsh-message-intro-pattern "\033EmAcS"
  57.   "Matches the first part of any message from the shell to Emacs")
  58.  
  59. (defvar jsh-chdir-message-pattern "\\(\033EmAcScd \\(.*\\)\n\\)"
  60.   "*Matches shell message to indicate a new working directory.
  61. This regular expression should have two levels of escaped parentheses:
  62. the outer enclosing the whole expression, the inner enclosing the
  63. expression that matches the directory name.")
  64.  
  65. (defvar jsh-rlogin-message-pattern "\\(\033EmAcShost \\(.*\\)\n\\)"
  66.   "*Matches shell message to indicate a new host.
  67. This regular expression should have two levels of escaped parentheses:
  68. the outer enclosing the whole expression, the inner enclosing the
  69. expression that matches the host name.")
  70.  
  71. (defvar jsh-eval-message-pattern "\\(\033EmAcSeval \\(.*\\)\n\\)"
  72.   "*Matches shell message indicating a lisp exression to evaluate.
  73. This regular expression should have two levels of escaped parentheses:
  74. the outer enclosing the whole expression, the inner enclosing the
  75. expression to evaluate.")
  76.  
  77. (defvar jsh-chop-keep-beginning t
  78.   "*Non-nil means keep initial \"/\" or \"~/\" in chopping directory names,
  79. as a cue to whether the directory is beneath $HOME.")
  80.  
  81. (defvar jsh-chop-at-slash t
  82.   "*Non-nil means chop directory names at \"/\" boundaries.")
  83.  
  84. (defvar jsh-home (concat "\\(" (getenv "HOME") "\\)")
  85.   "*If non-nil, indicates string to substitute with ~ in mode-line dir.")
  86.  
  87. (defvar jsh-history-stack-size 256
  88.   "*The number of commands to save in the history stack.")
  89.  
  90. (defvar jsh-buffer-base-name "j-shell"
  91.   "*The name used for jsh buffers.")
  92.  
  93. (defvar explicit-shell-file-name nil
  94.   "*If non-nil, is file name to use for explicitly requested inferior shell.")
  95.  
  96. (defvar jsh-send-char-signals t
  97.   "*If non-nil, send characters instead of signals to the shell;
  98. for example, send C-c for interrupt instead of SIGINT.
  99.  
  100. If you prefer to run inferior shells via a pipe rather than a pty,
  101. (that is, you set process-connection-type nil), or your system's ptys
  102. are in short supply, then you should set this variable to nil so that
  103. key bindings such as C-c C-c will work correctly.
  104.  
  105. If you prefer ptys, and they are in good supply on your system, then
  106. the default value (t) is best.  Sending characters works correctly
  107. with remote logins, whereas signals cannot be sent to remote shells.")
  108.  
  109. (defvar jsh-interrupt-char "\C-c"
  110.   "*Character to send for interrupt.")
  111.  
  112. (defvar jsh-stop-char "\C-z"
  113.   "*Character to send for stop")
  114.  
  115. (defvar jsh-quit-char "\C-\\"
  116.   "*Character to send for quit")
  117.  
  118. (defvar jsh-eof-char "\C-d"
  119.   "*Character to send for end-of-file")
  120.  
  121. (defvar jsh-regurgitate-bang-commands t
  122.   "*Non-nil means replace ! commands in the command history
  123. with the next line of shell output.")
  124.  
  125. (defvar jsh-dont-regurg-regex "\\([Ee]vent not found\\)\\|\\([Nn]o such event\\)"
  126.   "*Shell output matching this expression is not regurgitated, even
  127. though the previous input may have contained a shell-history character
  128. (hard-coded for now to the bang character, '!').")
  129.  
  130. (defvar jsh-secure-mode t
  131.   "*Non-nil means disable view-lossage function to hide passwords")
  132.  
  133. (defvar jsh-secure-message
  134.   "The functions which allow you to view recent keystrokes have been
  135. hidden by j-shell, to protect passwords entered in shell buffers."
  136.   "The message printed for view-lossage in \"secure\" mode.")
  137.  
  138. (defun j-shell (shell-program-name &optional new-buffer-name)
  139.   "Run a shell inside a new J-Shell buffer.
  140.  
  141. Optional argument PROGRAM specifies name of shell or program to run.
  142. Argument NAME specifies name of new buffer.  For example,
  143.  
  144.    (j-shell \"/usr/local/bin/tcsh\" \"tcsh\")
  145.  
  146. will run tcsh inside a new j-shell buffer named \"tcsh\".
  147.  
  148. If PROGRAM is nil or not specified, then the user is prompted for
  149. a shell to run.  The default value for the prompt is determined by
  150. evaluating the following, in order, until one evaluates non-nil:
  151. explicit-shell-file-name, the environment variable ESHELL, and the
  152. environment variable SHELL; if none of these is non-nil, then
  153. \"/bin/csh\" is the default.
  154.  
  155. If NAME is nil or not specified, then jsh-buffer-base-name is used as
  156. follows to determine the name of the buffer:  if jsh-buffer-base-name
  157. is t, then the buffer name is taken from the name of the shell (using
  158. file-name-nondirectory); if jsh-buffer-base-name is a string, then its
  159. value is the name of the new buffer; if jsh-buffer-base-name is nil,
  160. then the name of the new shell is \"j-shell\"."
  161.  
  162.   (interactive "P")
  163.  
  164.   (setq default-program
  165.     (or explicit-shell-file-name
  166.         (getenv "ESHELL")
  167.         (getenv "SHELL")
  168.         "/bin/csh"))
  169.   
  170.   ;; Pick the program to run
  171.   (setq program-name
  172.     (if shell-program-name
  173.         (if (stringp shell-program-name)
  174.         shell-program-name
  175.           (let ((prompt (format "Start shell: (default %s) "
  176.                     (file-name-nondirectory default-program))))
  177.         (read-file-name prompt (file-name-directory default-program)
  178.                 default-program t)))
  179.       default-program))
  180.           
  181.  
  182.   (setq temp-program-name (expand-file-name program-name))
  183.   (if (file-exists-p temp-program-name)
  184.       (setq program-name temp-program-name))
  185.  
  186.   ;; Pick the name of the new buffer.
  187.   (setq buffer-name
  188.     (if new-buffer-name
  189.         new-buffer-name
  190.       (if jsh-buffer-base-name
  191.           (if (eq jsh-buffer-base-name t)
  192.           (file-name-nondirectory program-name)
  193.         jsh-buffer-base-name)
  194.         "j-shell")))
  195.         
  196.  
  197.  
  198.   ;; Generate a new buffer
  199.   (setq jshell (generate-new-buffer buffer-name))
  200.   (switch-to-buffer jshell)
  201.  
  202.   ;; Insert the greeting file if it's readable
  203.   (if (and jsh-greeting-file (file-readable-p jsh-greeting-file))
  204.       (progn
  205.     (insert-file-contents jsh-greeting-file)
  206.     (goto-char (point-max))))
  207.   
  208.   (jsh-mode program-name)
  209.  
  210.   (message jsh-version-string))
  211.  
  212. (defun jsh-mode (program-name &rest args)
  213.   "Jim's Pretty-Good Shell Mode, a major mode for running shells.
  214.  
  215. The following commands are available:
  216. C-a        jsh-beginning-of-line
  217. TAB        jsh-complete
  218. LFD        jsh-edit
  219. RET        jsh-send-input
  220.  
  221. C-c TAB        jsh-expand
  222. C-c ?        jsh-completion-help
  223. C-c C-\        jsh-send-quit
  224. C-c C-a        jsh-beginning-of-command
  225. C-c C-c        jsh-send-interrupt
  226. C-c C-d        jsh-send-eof
  227. C-c C-o        jsh-kill-output
  228. C-c C-p        jsh-password
  229. C-c C-r        jsh-show-output
  230. C-c C-s        jsh-start-program
  231. C-c C-u        jsh-kill-input
  232. C-c C-z        jsh-send-stop
  233.  
  234. ESC n        jsh-hist-next
  235. ESC p        jsh-hist-prev
  236. ESC N        jsh-move-next
  237. ESC P        jsh-move-prev
  238. ESC RET        jsh-send-input
  239.  
  240. Entry to this mode calls the functions in jsh-mode-hooks.
  241.  
  242. J-Shell expects the shell to send strings specifying what working
  243. directory the shell is in.  J-Shell tracks these strings to update the
  244. buffer's default directory.  Example scripts are distributed with
  245. J-Shell for ksh, csh, tcsh, bash, zsh, and the tcl shell.
  246.  
  247. Also see the function j-shell."
  248.  
  249.  
  250.   (interactive)
  251.   (kill-all-local-variables)
  252.  
  253.   (setq major-mode 'jsh-mode)
  254.   (setq mode-name "J-Shell")
  255.  
  256.   ;; Setup the mode-line
  257.   (if jsh-use-alternate-modeline
  258.       (setq mode-line-format jsh-alternate-modeline))
  259.  
  260.   ;; Make all the local variables...
  261.   (make-local-variable 'jsh-program-name)
  262.   (setq jsh-program-name program-name)
  263.  
  264.   (make-local-variable 'jsh-host)
  265.                     ;  (setq jsh-host (getenv "HOST"))
  266.   (setq jsh-host (system-name))
  267.  
  268.   (make-local-variable 'jsh-host)
  269.   (setq jsh-host (system-name))
  270.  
  271.   (make-local-variable 'jsh-dir)
  272.   (setq jsh-dir default-directory)
  273.  
  274.   (make-local-variable 'jsh-default-dir)
  275.   (update-jsh-dir default-directory)
  276.  
  277.   (make-local-variable 'jsh-grab-history)
  278.   (setq jsh-grab-history nil)
  279.  
  280.   (make-local-variable 'jshmark)
  281.   (setq jshmark (make-marker))        ;jshmark's position will get
  282.                     ;set in jsh-start-program.
  283.  
  284.   (make-local-variable 'jsh-history)
  285.   (setq jsh-history (make-vector jsh-history-stack-size nil))
  286.  
  287.   (make-local-variable 'jsh-hist-tos)
  288.   (setq jsh-hist-tos (- jsh-history-stack-size 1))
  289.  
  290.   (make-local-variable 'jsh-hist-bos)
  291.   (setq jsh-hist-bos 0)
  292.  
  293.   (make-local-variable 'jsh-hist-sp)
  294.   (setq jsh-hist-sp jsh-hist-tos)
  295.  
  296.   (make-local-variable 'jsh-hist-interact)
  297.   (setq jsh-hist-interact 0)
  298.  
  299.   (make-local-variable 'jsh-hist-at-tos)
  300.   (setq jsh-hist-at-tos t)
  301.   (make-local-variable 'jsh-hist-at-bos)
  302.   (setq jsh-hist-at-bos t)
  303.  
  304.   (make-local-variable 'jsh-parsing-password)
  305.   (setq jsh-parsing-password nil)
  306.  
  307.   (jsh-setup-keymap)
  308.  
  309.   (run-hooks 'jsh-mode-hooks)
  310.  
  311.   (jsh-start-program))
  312.  
  313. (defun jsh-start-program ()
  314.   "Start or restart the shell program in the current buffer.  Called
  315. automatically by jsh-mode to start the first shell; may be called
  316. manually through C-c C-s to restart the shell if it dies or you kill
  317. it accidentally.  Runs the hooks in jsh-start-hooks."
  318.  
  319.   (interactive)
  320.  
  321.   (make-local-variable 'jshproc)
  322.  
  323.   (if (and (setq jshproc (get-buffer-process (current-buffer)))
  324.        (setq jsh-status (process-status jshproc))
  325.        (or (eq jsh-status 'run) (eq jsh-status 'stop)))
  326.       (error "A process is already running (or runnable) in this buffer.")
  327.  
  328.     ;; If a processs was running in this buffer, clean it up...
  329.     (if jshproc (delete-process jshproc))
  330.  
  331.     ;; Start the new process
  332.     (setq buff-name (buffer-name))
  333.     (setq jshproc (start-process buff-name jshell
  334.                  (concat exec-directory "env")
  335.                  (setq termcap
  336.                        (format"TERMCAP=emacs:co#%d:tc=unknown:"
  337.                           (screen-width)))
  338.                  "TERM=emacs"
  339.                  "JSHELL=t"
  340.                  jsh-program-name "-i"))
  341.  
  342.     ;; I cannot explain why the following call is necessary, unless it
  343.     ;; is because there is an error in Emacs.  If two buffers, named
  344.     ;; "tcsh" and "tcsh<2>", are present and we attempt to restart the
  345.     ;; shell in the first buffer, the process will magically get
  346.     ;; associated with the second, even though the call to start-
  347.     ;; process explicitly specified the first.  This call negates that
  348.     ;; odd behavior.
  349.     (set-process-buffer jshproc (current-buffer))
  350.  
  351.     (set-process-filter jshproc 'jsh-filter)
  352.     (set-marker jshmark (point))
  353.     (run-hooks 'jst-start-hooks))
  354.   jshproc)
  355.  
  356. (defun jsh-setup-keymap ()
  357.   ;; Set up the keyboard map for jsh mode.
  358.   (if (and (boundp 'jsh-mode-map) jsh-mode-map)
  359.       nil
  360.  
  361.     ;;Make a copy of the global map and make substitutions for all the
  362.     ;;"printing" keys and for Del.  The substituted functions handle
  363.     ;;the reading of passwords.
  364.     (setq jsh-mode-map (copy-keymap global-map))
  365.     (substitute-key-definition 'self-insert-command 'jsh-self-insert
  366.                    jsh-mode-map)
  367.     (substitute-key-definition 'delete-backward-char 'jsh-del-back
  368.                    jsh-mode-map)
  369.  
  370.     ;;Install new keymaps into the mode map; this is necessary because
  371.     ;;copy-keymap isn't fully recursive.  If we didn't make these
  372.     ;;substitutions, our C-c and Meta (ESC) key definitions would
  373.     ;;"leak" into other buffers.
  374.     (define-key jsh-mode-map "\C-c" (make-sparse-keymap))
  375.     (define-key jsh-mode-map "\C-[" (make-sparse-keymap))
  376.  
  377.     ;;Fill out the Control-C map
  378.     (define-key jsh-mode-map "\C-c\?"   'jsh-completion-help)
  379.     (define-key jsh-mode-map "\C-c\C-\\" 'jsh-send-quit)
  380.     (define-key jsh-mode-map "\C-c\C-a" 'jsh-beginning-of-command)
  381.     (define-key jsh-mode-map "\C-c\C-c" 'jsh-send-interrupt)
  382.     (define-key jsh-mode-map "\C-c\C-d" 'jsh-send-eof)
  383.     (define-key jsh-mode-map "\C-c\C-o"    'jsh-kill-output)
  384.     (define-key jsh-mode-map "\C-c\C-p" 'jsh-password)
  385.     (define-key jsh-mode-map "\C-c\C-r"    'jsh-show-output)
  386.     (define-key jsh-mode-map "\C-c\C-s" 'jsh-start-program)
  387.     (define-key jsh-mode-map "\C-c\C-u" 'jsh-kill-input)
  388.     (define-key jsh-mode-map "\C-c\C-w" 'backward-kill-word)
  389.     (define-key jsh-mode-map "\C-c\C-z" 'jsh-send-stop)
  390.     (define-key jsh-mode-map "\C-c\t"   'jsh-expand)
  391.  
  392.     ;;Fill out the Escape map
  393.     (define-key jsh-mode-map "\M-\C-m" 'jsh-send-input)
  394.     (define-key jsh-mode-map "\M-P" 'jsh-move-prev)
  395.     (define-key jsh-mode-map "\M-N" 'jsh-move-next)
  396.     (define-key jsh-mode-map "\M-p" 'jsh-hist-prev)
  397.     (define-key jsh-mode-map "\M-n" 'jsh-hist-next)
  398.  
  399.     ;;Fill out the rest of the mode map
  400.     (define-key jsh-mode-map "\C-m" 'jsh-send-input)
  401.     (define-key jsh-mode-map "\t"   'jsh-complete)
  402.     (define-key jsh-mode-map "\C-a" 'jsh-beginning-of-line)
  403.     (define-key jsh-mode-map "\C-j" 'jsh-edit))
  404.   (use-local-map jsh-mode-map))
  405.  
  406. (defun jsh-output (output)
  407.   (save-excursion
  408.     (goto-char (marker-position jshmark))
  409.     (insert-before-markers output)))
  410.  
  411. (defun jsh-filter (process output)
  412.  
  413.   (if (= (length output) 0)        ;Skip empty strings
  414.       nil
  415.  
  416.     ;; Set to nil the string to read and evaluate
  417.     (setq jsh-eval-string nil)
  418.     
  419.     ;; Make a record of what the current buffer and case-fold are, so we
  420.     ;; can set them back after this function is done.
  421.     (setq current (current-buffer))
  422.     (setq jsh-case-fold-search case-fold-search)
  423.  
  424.     ;; Use an unwind-protect form to ensure that we set the buffer and
  425.     ;; search mode back when we're done.
  426.     (unwind-protect
  427.     (progn
  428.  
  429.       ;; Set the buffer to the buffer that jsh is running in, and
  430.       ;; make searches case-sensitive
  431.       (set-buffer (process-buffer process))
  432.  
  433.       (setq case-fold-search nil)
  434.  
  435.       ;; All non-empty output turns off password mode (it keeps us
  436.       ;; from erroneously going into password mode); the
  437.       ;; exception, of course, is output that ends with the
  438.       ;; password pattern.  We check for that later.
  439.       (jsh-unpassword)
  440.  
  441.       ;; Commands with ! in them are regurgitated by some shells
  442.       ;; before executing them; we grab such commands and place
  443.       ;; the regurgitated form into the history stack in place of
  444.       ;; the original form.
  445.       (if (and jsh-regurgitate-bang-commands jsh-grab-history)
  446.           (progn            ;We're expecting a
  447.                     ;regurgitation
  448.  
  449.         ;; Before proceeding, attempt to avoid false
  450.         ;; regurgitations by comparing the last recorded
  451.         ;; command with the current line of output.  If they
  452.         ;; match up to the position of the bang, then do the
  453.         ;; regurgitation.  This won't catch all false matches,
  454.         ;; but ought to catch most.
  455.         (setq last-command
  456.               (aref jsh-history (jsh-hist-inc jsh-hist-tos)))
  457.         (setq bang-pos (string-match "!" last-command))
  458.         (if (and bang-pos
  459.              (< bang-pos (length output))
  460.              (string= (substring last-command 0 bang-pos)
  461.                   (substring output 0 bang-pos))
  462.  
  463.              ;; This last clause is a bit of hackage for
  464.              ;; [t]csh, bash, and zsh 
  465.              (not (string-match jsh-dont-regurg-regex output)))
  466.             (progn
  467.               ;; Match the first line of shell output--it's the
  468.               ;; reguritation.
  469.               (string-match "^.*$" output)
  470.               (jsh-output (setq regurgitated-command
  471.                     (substring output
  472.                            (match-beginning 0)
  473.                            (match-end 0))))
  474.  
  475.               ;; pop the last command off the stack and push the
  476.               ;; regurgitated command in its place
  477.               (setq jsh-hist-tos (jsh-hist-inc jsh-hist-tos))
  478.               (jsh-hist-push regurgitated-command)
  479.               (setq output (substring output (match-end 0)))))
  480.         (setq jsh-grab-history nil)))
  481.       
  482.       ;; Look for any strings in the output indicating that the
  483.       ;; shell has changed its host or working directory, or that
  484.       ;; it has an expression to evaluate.
  485.       (if (string-match jsh-message-intro-pattern output)
  486.           (progn
  487.         (while (string-match jsh-eval-message-pattern output)
  488.           (let* ((eval-expr (substring output (match-beginning 2)
  489.                            (match-end 2))))
  490.             (setq output (concat (substring output 0
  491.                             (match-beginning 1))
  492.                      (substring output (match-end 1))))
  493.             (setq jsh-eval-string (concat jsh-eval-string eval-expr))
  494.           ))
  495.         (while (string-match jsh-rlogin-message-pattern output)
  496.           (let* ((new-host (substring output (match-beginning 2)
  497.                           (match-end 2))))
  498.             (setq output (concat (substring output 0
  499.                             (match-beginning 1))
  500.                      (substring output (match-end 1))))
  501.             (setq jsh-host new-host)
  502.             (jsh-set-default-dir jsh-host jsh-dir)
  503.             (update-jsh-dir default-directory)))
  504.         
  505.         (while (string-match jsh-chdir-message-pattern output)
  506.           (let* ((newdir (substring output (match-beginning 2)
  507.                         (match-end 2))))
  508.             
  509.             (setq output (concat (substring output 0
  510.                             (match-beginning 1))
  511.                      (substring output (match-end 1))))
  512.             (setq jsh-dir newdir)
  513.             (jsh-set-default-dir jsh-host jsh-dir)
  514.             (update-jsh-dir default-directory)))))
  515.       
  516.       (jsh-output output)
  517.  
  518.       ;; Check to see whether the buffer contents now end with a
  519.       ;; string matching the password pattern (bound the search
  520.       ;; with the beginning of the line, to keep things from
  521.       ;; getting too slow); if they do, then enter password minor-
  522.       ;; mode.
  523.       ;; tcsh test: echo -n pass ; sleep 2 ; echo -n word: ; echo `line`
  524.       (setq pass-search-bound (save-excursion (beginning-of-line) (point)))
  525.       (if (and
  526.            (save-excursion
  527.          (re-search-backward jsh-password-pattern pass-search-bound t))
  528.            (= (match-end 0) (point)))
  529.           (jsh-password)))
  530.  
  531.       ;; Set the buffer and search folding back to what they were when
  532.       ;; we entered the filter function.
  533.       (set-buffer current)
  534.       (setq case-fold-search jsh-case-fold-search))
  535.  
  536.     (if jsh-eval-string
  537.     (unwind-protect
  538.         (let ((read-at 0)
  539.           (read-limit (length jsh-eval-string)))
  540.           (while (< read-at read-limit)
  541.         (setq read-cons (read-from-string jsh-eval-string read-at))
  542.         (eval (car read-cons))
  543.         (setq read-at (cdr read-cons))
  544.         ))
  545.       (setq jsh-eval-string nil)))))
  546.  
  547. (defun jsh-set-default-dir (host dir)
  548.   (if (string= host (system-name))
  549.       (setq default-directory dir)
  550.     (setq default-directory (concat "/" host ":" dir)))
  551.  
  552.   (if (string= (substring default-directory -1 nil) "/")
  553.       nil
  554.     (setq default-directory (concat default-directory "/"))))
  555.  
  556. (defun update-jsh-dir (dir)
  557.  
  558.   (setq targlen jsh-modeline-dir-len)
  559.  
  560.   (if jsh-home
  561.       (if (string-match jsh-home dir)
  562.       (if (= (match-beginning 0) 0)
  563.           (setq dir (concat "~" (substring dir (match-end 0)))))))
  564.  
  565.   (setq jsh-default-dir (jsh-shorten-dir dir))
  566.   (setq jsh-default-dir
  567.     (concat jsh-default-dir
  568.         (make-string (- targlen (length jsh-default-dir)) ? )))
  569.  
  570.   (save-excursion (set-buffer (other-buffer)))) ;force mode-line update
  571.  
  572. (defun jsh-shorten-dir (dir)
  573.   (if (< (length dir) targlen)        ;If the string doesn't need
  574.       dir                ;shortening, don't try
  575.  
  576.     ;; Determine how many characters to keep from the beginning
  577.     (if jsh-chop-keep-beginning
  578.     (if (string= "~/" (substring dir 0 2))
  579.         (setq start 2)
  580.       (if (string= "/" (substring dir 0 1))
  581.           (setq start 1)
  582.         (setq start 0)))
  583.       (setq start 0))
  584.     
  585.     ;; Determine the point at which to start searching for a "/"
  586.     (setq hack (- (length dir) (- targlen 3 start)))
  587.  
  588.     ;; Look for a "/" at which to chop the string; if there isn't one,
  589.     ;; return as many characters as possible
  590.     (if (and jsh-chop-at-slash (string-match "/" dir hack))
  591.     (if (< (setq chop-from (match-beginning 0)) (- (length dir) 1))
  592.         nil
  593.       (setq chop-from hack))
  594.       (setq chop-from hack))
  595.     (concat (substring dir 0 start) "..." (substring dir chop-from))))
  596.  
  597. (defun jsh-hist-push (command)
  598.   ;; If the command to push is the same as the command that's already
  599.   ;; on the top of the stack, don't push it again.
  600.   (if (string= command (aref jsh-history (jsh-hist-inc jsh-hist-tos)))
  601.       nil                ;Don't push
  602.  
  603.     ;; Push the command onto the stack, and adjust the top- and
  604.     ;; bottom-of-stack values.
  605.     (aset jsh-history jsh-hist-tos command)
  606.     (setq jsh-hist-tos (jsh-hist-dec jsh-hist-tos))
  607.     (aset jsh-history jsh-hist-tos "")
  608.     (if (= (jsh-hist-inc jsh-hist-tos) jsh-hist-bos)
  609.     (setq jsh-hist-bos jsh-hist-tos)))
  610.  
  611.   ;; Strictly speaking, this doesn't belong here, but we always do it
  612.   ;; after a push, so for now it stays
  613.   (setq jsh-hist-sp jsh-hist-tos)
  614.   (setq jsh-hist-at-tos t)
  615.   (setq jsh-hist-at-bos (= (jsh-hist-inc jsh-hist-sp)
  616.                jsh-hist-bos))
  617.  
  618.   ;; Return top-of-stack
  619.   jsh-hist-tos)
  620.  
  621. (defun jsh-hist-dec (arg)
  622.   (if (= 0 arg)
  623.       (- jsh-history-stack-size 1)
  624.     (- arg 1)))
  625.  
  626. (defun jsh-hist-inc (arg)
  627.   (setq arg (+ 1 arg))
  628.   (if (= arg jsh-history-stack-size)
  629.       0
  630.     arg))
  631.  
  632. (defun hist-find-prev (s)
  633.   (setq sp (jsh-hist-inc jsh-hist-sp))
  634.   (setq targ (concat "^" (regexp-quote s)))
  635.   (setq hist-current (aref jsh-history jsh-hist-sp))
  636.  
  637.   (catch 'found                ;Catch 'found as a means of
  638.                     ;breaking out of the loop
  639.  
  640.     ;; search down through the stack looking for a history that
  641.     ;; matches the target regex *and* is different from the current
  642.     ;; history
  643.     (while (not (= sp jsh-hist-bos))
  644.       (if (string-match targ        ;Matches regex?
  645.             (setq hist-at-sp (aref jsh-history sp)))
  646.  
  647.       (if (string= hist-current hist-at-sp)    ;Yes, different?
  648.           nil            ;No, keep going...
  649.  
  650.         ;;We've found a history that meets both criteria--break
  651.         ;;the loop by throwing 'found.  The value that we throw
  652.         ;;will end up as this function's return value.
  653.         (throw 'found sp)))
  654.  
  655.       (setq sp (jsh-hist-inc sp)))    ;increment the stack-pointer
  656.                     ;(bump down in the stack).
  657.  
  658.     ;; If we reach this point, then the loop has terminated without
  659.     ;; finding a history that meets our criteria--leave nil as our
  660.     ;; return value
  661.     nil))
  662.     
  663.  
  664. (defun hist-find-next (s)
  665.   ;; This function is just like hist-find-prev except that it searches
  666.   ;; in the opposite direction.
  667.   (setq sp (jsh-hist-dec jsh-hist-sp))
  668.   (setq targ (concat "^" (regexp-quote s)))
  669.   (setq hist-current (aref jsh-history jsh-hist-sp))
  670.  
  671.   (catch 'found
  672.     (while (not (= sp jsh-hist-tos))
  673.       (if (string-match targ
  674.             (setq hist-at-sp (aref jsh-history sp)))
  675.       (if (string= hist-current hist-at-sp)
  676.           nil
  677.         (throw 'found sp)))
  678.       (setq sp (jsh-hist-dec sp)))
  679.     nil)
  680.   )
  681.  
  682. (defun jsh-hist-prev ()
  683.   "Get and insert prev shell command"
  684.   (interactive)
  685.  
  686.   (if jsh-hist-at-bos
  687.       (error "No more history for this jsh.")
  688.     
  689.     (save-excursion
  690.       (goto-char (point-max))
  691.       (setq key (buffer-substring (marker-position jshmark) (point)))
  692.       (if jsh-hist-at-tos
  693.       (aset jsh-history jsh-hist-tos key)
  694.     (setq last-key  (aref jsh-history jsh-hist-sp))
  695.     (if (string= last-key key)
  696.         nil
  697.       (setq jsh-hist-sp jsh-hist-tos)
  698.       (setq jsh-hist-at-tos t)
  699.       (aset jsh-history jsh-hist-tos key)))
  700.  
  701.       (setq tos (aref jsh-history jsh-hist-tos))
  702.       (if (string= tos "")
  703.       (setq jsh-hist-sp (jsh-hist-inc jsh-hist-sp))
  704.     (if (setq sp (hist-find-prev tos))
  705.         (setq jsh-hist-sp sp)
  706.       (error "No more history matching \"%s\"." tos)))
  707.  
  708.       (delete-region (marker-position jshmark) (point))
  709.       (insert (aref jsh-history jsh-hist-sp))
  710.       (setq jsh-hist-at-bos (= (jsh-hist-inc jsh-hist-sp) jsh-hist-bos)))
  711.  
  712.     (goto-char (point-max))
  713.     (setq jsh-hist-at-tos (= jsh-hist-sp jsh-hist-tos))))
  714.  
  715. (defun jsh-hist-next ()
  716.   "Get and insert next shell command"
  717.   (interactive)
  718.  
  719.   (if jsh-hist-at-tos
  720.       (error "No more recent history for this jsh.")
  721.  
  722.     (save-excursion
  723.       (goto-char (point-max))
  724.  
  725.       (setq tos (aref jsh-history jsh-hist-tos))
  726.       (if (string= tos "")
  727.       (setq jsh-hist-sp (jsh-hist-dec jsh-hist-sp))
  728.     (if (setq sp (hist-find-next tos))
  729.         (setq jsh-hist-sp sp)
  730.       (message "No more recent history matching \"%s\"." tos)
  731.       (setq jsh-hist-sp jsh-hist-tos)))
  732.  
  733.       (delete-region (marker-position jshmark) (point))
  734.       (insert (aref jsh-history jsh-hist-sp))
  735.       (setq jsh-hist-at-tos (= jsh-hist-sp jsh-hist-tos)))
  736.     (goto-char (point-max))
  737.     (setq jsh-hist-at-bos nil)))
  738.  
  739. (defun jsh-send-input ()
  740.   "Send a line of input to the shell."
  741.   (interactive)
  742.   
  743.   (if (and others-at-completion (other-windows))
  744.       (if (eq others-at-completion 'no)
  745.       (delete-windows-on (get-buffer " *Completions*"))
  746.     (other-window 1)
  747.     (switch-to-buffer others-at-completion)
  748.     (other-window -1)))
  749.   (setq others-at-completion nil)
  750.   
  751.   (or (get-buffer-process (current-buffer))
  752.       (error "Current buffer has no process"))
  753.  
  754.   (if jsh-parsing-password
  755.       (progn
  756.     (goto-char (point-max))
  757.     (move-marker jshmark (point))
  758.     (process-send-string jshproc jsh-password)
  759.     (process-send-string jshproc "\n")
  760.     (jsh-unpassword))
  761.  
  762.     ;; We're not parsing a password; what we do next depends on
  763.     ;; whether the point is in the input-editing area or above it.
  764.     (if (>= (point) (marker-position jshmark))
  765.     (progn
  766.       (goto-char (point-max))
  767.       (setq preceding (char-after (- (point) 1)))
  768.       (insert ?\n)
  769.  
  770.       ;;If the character before the \n is a backslash \, don't
  771.       ;;actually send anything to the shell, and don't move the
  772.       ;;marker. 
  773.       (if (and preceding (= ?\\ preceding))
  774.           nil
  775.         (setq from (marker-position jshmark))
  776.         (move-marker jshmark (point))
  777.         (jsh-send-region jshproc from (point))))
  778.  
  779.       ;; Exclude the shell prompts, if any.
  780.       (beginning-of-line)
  781.       (while
  782.       (re-search-forward jsh-prompt-pattern
  783.                  (save-excursion (end-of-line) (point))
  784.                  t))
  785.  
  786.       (let ((copy (buffer-substring (point)
  787.                     (progn (forward-line 1) (point)))))
  788.     (goto-char (point-max))
  789.     (delete-region (marker-position jshmark) (point))
  790.     (insert copy)
  791.     (setq from (marker-position jshmark))
  792.     (move-marker jshmark (point))
  793.     (jsh-send-region jshproc from (point))))))
  794.  
  795. (defun jsh-send-region (process from to)
  796.   ;; Push the region onto the command history
  797.   (save-excursion
  798.     (progn
  799.       (goto-char from)
  800.       (if (re-search-forward "[^ \t\n]" to t)
  801.       (jsh-hist-push
  802.        (buffer-substring from (- to 1))))))    ;Don't save the linefeed!
  803.  
  804.   ;; If there's an unescaped ! in the region, set a flag so the filter
  805.   ;; function can replace the command history when it's regurgitated
  806.   ;; by the shell.
  807.   (save-excursion
  808.     (goto-char from)
  809.     (if (or (looking-at "!") (re-search-forward "[^\\]!" to t))
  810.     (setq jsh-grab-history t)))
  811.  
  812.   ;; Rule 42: all persons more than a mile high to leave the court.
  813.   ;; This loop does away with the ^G problem by sending user input to
  814.   ;; the shell in chunks of 250 characters.  The ^G problem occurs
  815.   ;; when shell modes send more than 256 characters to the shell, thus
  816.   ;; overrunning the shell's input buffer; the shell complains by
  817.   ;; sending ^G (the bell character).
  818.   (while (> (- to from) 250)
  819.  
  820.     (process-send-region process from (+ from 250))
  821.     (setq from (+ from 250))
  822.  
  823.     ;; Make sure the output buffer gets flushed;  what we really need
  824.     ;; is to change its buffering--currently it's line-buffered; we
  825.     ;; need to make it unbuffered (Emacs is actually the buffer).
  826.     (if (= (char-after from) ?\n)
  827.     nil
  828.       (process-send-eof)));;Flushes IO buffered for process.  What a travesty!
  829.  
  830.   (process-send-region process from to)) ;Send whatever's left
  831.  
  832. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  833. ;;; Functions for parsing passwords
  834.  
  835. (defun jsh-password ()
  836.   (interactive)
  837.   (jsh-hide-lossage)
  838.   (setq jsh-parsing-password t)
  839.   (make-local-variable 'jsh-password)
  840.   (setq jsh-password "")
  841.   )
  842.  
  843. (defun jsh-self-insert (arg)
  844.   (interactive "P")
  845.   (setq number (prefix-numeric-value arg))
  846.   (if jsh-parsing-password
  847.       (setq jsh-password
  848.         (concat jsh-password (make-string number last-input-char)))
  849.     (self-insert-command number))
  850.   )
  851.  
  852. (defun jsh-del-back (arg)
  853.   (interactive "P")
  854.   (if jsh-parsing-password
  855.       (if (string= "" jsh-password)
  856.       (beep)
  857.     (setq jsh-password
  858.           (substring jsh-password 0 -1)))
  859.     (backward-delete-char (prefix-numeric-value arg)))
  860.   )
  861.  
  862. (defun jsh-unpassword ()
  863.   (interactive)
  864.   (setq jsh-parsing-password nil))
  865.  
  866. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  867. ;;; Functions for making passwords a little bit more secure.
  868.  
  869. (defvar jsh-view-lossage
  870.   '(lambda ()
  871.      (interactive)
  872.      (with-output-to-temp-buffer "*Help*"
  873.        (princ jsh-secure-message)
  874.        (print-help-return-message))))
  875.  
  876. (defvar jsh-recent-keys
  877.   '(lambda ()
  878.      (interactive)
  879.      jsh-secure-message))
  880.  
  881. (defun jsh-hide-lossage ()
  882.   (if jsh-secure-mode
  883.       (let ((rk (intern-soft "recent-keys"))
  884.         (vl (intern-soft "view-lossage")))
  885.  
  886.     (if (and rk (not (eq (symbol-function rk)
  887.                  jsh-recent-keys)))
  888.         (progn
  889.           (set rk jsh-secure-message)
  890.           (fset rk jsh-recent-keys)))
  891.  
  892.     (if (and vl (not (eq (symbol-function vl)
  893.                  jsh-view-lossage)))
  894.         (progn
  895.                 (set vl jsh-secure-message)
  896.           (fset vl jsh-view-lossage)))
  897.  
  898.     ;; Close the dribble file--wouldn't want to record a password
  899.     (if (string-lessp emacs-version "18.58")
  900.         (if (string-match "unix" (symbol-name system-type))
  901.         ;; Emacs 18.57 and earlier versions don't like nil as a
  902.         ;; way to close the dribble file, so on unix systems, open
  903.         ;; /dev/null instead.
  904.         (open-dribble-file "/dev/null")
  905.           (beep)
  906.           (message "*** Security risk: your password may be written into the dribble file"))
  907.       (open-dribble-file nil)))))    ;nil means close
  908.  
  909. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  910. ;;; Some miscellaneous functions
  911.  
  912. (defun jsh-edit ()
  913.   "Copy a line to the input area for editing."
  914.   (interactive)
  915.   (save-excursion
  916.     (end-of-line)
  917.     (setq jsh-end (point))
  918.     (jsh-beginning-of-line)
  919.     (copy-region-as-kill (point) jsh-end))
  920.   (goto-char (point-max))
  921.   (yank))
  922.  
  923. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  924. ;;; This section implements some commands for campatibility with
  925. ;;; Emacs's shell mode.
  926.  
  927. (defun jsh-kill-output ()
  928.   "Kill the output of the previous shell command."
  929.   (interactive)
  930.  
  931.   ;; Search backward for a shell prompt; if we find one that's
  932.   ;; different from the one we might happen to be on, then there's
  933.   ;; output to flush
  934.   (setq top (jsh-prev-command (point-min) (point)))
  935.   (if (< top (point))
  936.       (progn
  937.     
  938.     ;; Find the output associated with this prompt, and delete it
  939.     (save-excursion
  940.       (goto-char top)
  941.       (end-of-line)
  942.       (forward-char 1)
  943.       (setq from (point))
  944.       (if (re-search-forward jsh-prompt-pattern (point-max) t)
  945.           (progn
  946.         (goto-char (match-beginning 0))
  947.         (if (= from (point))
  948.             nil
  949.           (kill-region from (point))
  950.           (insert "*** output flushed ***\n")))))
  951.  
  952.     ;; If the prompt that we deleted from is not visible in the
  953.     ;; window, make it visible by moving the window start to the
  954.     ;; beginning of the line that contains the prompt 
  955.     (save-excursion
  956.       (goto-char top)
  957.       (beginning-of-line)
  958.       (setq start (window-start (selected-window)))
  959.       (if (< (point) start)
  960.           (set-window-start (selected-window) (point)))))))
  961.  
  962. (defun jsh-show-output ()
  963.   "Search backward for and show the previous shell prompt."
  964.   (interactive)
  965.   (jsh-move-prev)
  966.   (setq show-at (save-excursion (beginning-of-line) (point)))
  967.   (set-window-start (selected-window) show-at))
  968.         
  969. (defun jsh-kill-input ()
  970.   "Kill pending shell input."
  971.   (interactive)
  972.   (jsh-beginning-of-command)
  973.   (kill-region (point) (point-max)))
  974.  
  975. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  976. ;;; This section implements some commands for moving about with the shell
  977.  
  978. (defun jsh-move-prev ()
  979.   "Search backwards through the buffer for the previous shell command."
  980.   (interactive)
  981.   (goto-char
  982.    (jsh-prev-command (point-min) (point)))
  983.   (end-of-line))
  984.  
  985. (defun jsh-move-next ()
  986.   "Search forward through the buffer for the next shell command"
  987.   (interactive)
  988.   (goto-char
  989.    (jsh-next-command (point) (point-max)))
  990.   (end-of-line))
  991.  
  992. (defun jsh-prev-command (min max)
  993.   (save-excursion
  994.     (setq from (point))
  995.     (goto-char max)
  996.     (beginning-of-line)
  997.  
  998.     (setq done nil)
  999.     (while (not done)
  1000.       (if (re-search-backward jsh-prompt-pattern min t)
  1001.       (progn
  1002.         (goto-char (match-end 0))
  1003.         (if (looking-at "\n")
  1004.         (beginning-of-line)
  1005.           (setq done t)))
  1006.     (setq done t)
  1007.     (end-of-line)))
  1008.     (if (looking-at "$")
  1009.     from
  1010.       (point))))
  1011.  
  1012. (defun jsh-next-command (min max)
  1013.   (save-excursion
  1014.     (goto-char min)
  1015.     (while (and (looking-at jsh-prompt-pattern) (< (point) max))
  1016.       (forward-char 1))
  1017.     (setq done nil)
  1018.     (while (not done)
  1019.       (if (re-search-forward jsh-prompt-pattern max t)
  1020.       (progn
  1021.         (goto-char (match-end 0))
  1022.         (if (looking-at "\n")
  1023.         nil
  1024.           (setq done t)))
  1025.     (setq done t)))
  1026.     (point)))
  1027.  
  1028. (defun jsh-beginning-of-line ()
  1029.   "Go to beginning of line, skipping over any prompt."
  1030.   (interactive)
  1031.   (setq limit (point))
  1032.   (beginning-of-line)
  1033.   (if (looking-at jsh-prompt-pattern)
  1034.       (goto-char (match-end 0)))
  1035.   (if (= limit (point))
  1036.       (beginning-of-line)))
  1037.  
  1038. (defun jsh-beginning-of-command ()
  1039.   "Go to beginning of command."
  1040.   (interactive)
  1041.   (goto-char (marker-position jshmark)))
  1042.  
  1043. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1044. ;;; This section is related to signals.
  1045.  
  1046. (defun jsh-send-eof ()
  1047.   "Send EOF (end-of-file) to the shell"
  1048.   (interactive)
  1049.   (if jsh-send-char-signals
  1050.       (process-send-string jshproc jsh-eof-char)
  1051.     (process-send-eof)))
  1052.  
  1053. (defun jsh-send-interrupt ()
  1054.   "Send an INT (interrupt) signal or character to the shell"
  1055.   (interactive)
  1056.   (if jsh-send-char-signals
  1057.       (process-send-string jshproc jsh-interrupt-char)
  1058.     (interrupt-process nil t)))
  1059.  
  1060. (defun jsh-send-stop ()
  1061.   "Send a STOP signal or character to the shell"
  1062.   (interactive)
  1063.   (if jsh-send-char-signals
  1064.       (process-send-string jshproc jsh-stop-char)
  1065.     (stop-process nil t)))
  1066.  
  1067. (defun jsh-send-quit ()
  1068.   "Send a QUIT signal or character to the shell"
  1069.   (interactive)
  1070.   (if jsh-send-char-signals
  1071.       (process-send-string jshproc jsh-quit-char)
  1072.     (quit-process nil t)))
  1073.  
  1074. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1075. ;;; This section implements filename completion.
  1076. ;;;
  1077. ;;; Filename completion is based almost entirely upon the package
  1078. ;;; written by Shinichirou Sugou.  The changes that have been added
  1079. ;;; allow j-shell to remove the completion buffer upon sending input
  1080. ;;; to the shell.  The rationale for this modification is that, having
  1081. ;;; given jsh a command, the user no longer needs to see the
  1082. ;;; completions.
  1083.  
  1084. ;;; The logic for removing the completion buffer attempts to restore
  1085. ;;; the windows to the way they were before displaying the completion
  1086. ;;; buffer.  If the jsh window was the only window displayed when the
  1087. ;;; completion window appeared, the the completion window is deleted;
  1088. ;;; if some window was already displaying another buffer, the
  1089. ;;; completions buffer is replaced with the original.
  1090.  
  1091. (defvar others-at-completion nil)
  1092. (defvar no nil)
  1093. (defvar yes nil)
  1094.  
  1095. (defun other-windows ()
  1096.   (setq this-window (get-buffer-window (current-buffer)))
  1097.   (not (eq (next-window this-window) this-window)))
  1098.  
  1099. ;; File-completion-in-shell-mode by Shinichirou Sugou 90/6/8
  1100. ;;        shin%sgtp.apple.juice.or.jp@uunet.uu.net
  1101.  
  1102. (defun jsh-complete ()
  1103.   (interactive)
  1104.  
  1105.   ;; The following if-construct and its contents have been added for
  1106.   ;; j-shell.
  1107.   (if others-at-completion        ;If others-at-completion
  1108.       nil                ;already has a value, do
  1109.                     ;nothing.
  1110.  
  1111.     ;; If there are other windows, set others-at-completion to the
  1112.     ;; buffer in the other window, the one that will be supplanted by
  1113.     ;; the completions buffer.  If there are no other windows, set
  1114.     ;; others-at-completion to 'no.
  1115.     (if (other-windows)            
  1116.     (progn                   
  1117.       (other-window 1)
  1118.       (setq others-at-completion (current-buffer))
  1119.       (other-window -1))
  1120.       (setq others-at-completion 'no)))
  1121.  
  1122.   (let* ((beg  (save-excursion
  1123.                  (re-search-backward "\\s ")
  1124.                  (1+ (point))))
  1125.          (end (point))
  1126.          (file (file-name-nondirectory (buffer-substring beg end)))
  1127.          (dir (or (file-name-directory (buffer-substring beg end)) ""))
  1128.          (lpc (file-name-completion file dir))
  1129.          (akin (file-name-all-completions file dir)))
  1130.     (cond ((eq lpc t)
  1131.            (message "[Sole completion]")
  1132.            (sit-for 2))
  1133.           ((eq lpc nil)
  1134.            (ding t)
  1135.            (message "[No match]")
  1136.            (sit-for 2))
  1137.           ((and (string= lpc file) (my-member lpc akin))
  1138.            (message "[Complete, but not unique]")
  1139.            (sit-for 2))
  1140.           ((string= lpc file)
  1141.            (jsh-completion-help akin))
  1142.           (t
  1143.            (delete-region beg end)
  1144.            (insert dir lpc)))))
  1145.  
  1146. (defun my-member (item list &optional testf)
  1147.   "Compare using TESTF predicate, or use 'eql' if TESTF is nil."
  1148.   (setq testf (or testf 'eql))
  1149.   (catch 'bye
  1150.     (while (not (null list))
  1151.       (if (funcall testf item (car list))
  1152.           (throw 'bye list))
  1153.       (setq list (cdr list)))
  1154.     nil))
  1155.  
  1156. (defun jsh-show (buf)
  1157. ;  (if others-at-completion
  1158. ;      nil
  1159. ;    (if (other-windows)
  1160. ;    (progn
  1161. ;      (setq others-at-completion (current-buffer))
  1162. ;      (message "Saving buffer %s" (buffer-name)))
  1163. ;      (setq others-at-completion 'no)))
  1164.  
  1165.   (if (other-windows)
  1166.       nil
  1167.     (split-window-vertically))
  1168.   (other-window 1)
  1169.   (switch-to-buffer buf t)
  1170.   (other-window -1))
  1171.  
  1172.  
  1173. (defun jsh-completion-help (&optional akin)
  1174.   (interactive)
  1175.   (make-local-variable 'temp-buffer-show-hook)
  1176.   (setq temp-buffer-show-hook 'jsh-show)
  1177.   (if (null akin)
  1178.       (let* ((beg  (save-excursion
  1179.                      (re-search-backward "\\s ")
  1180.                      (1+ (point))))
  1181.              (end (point))
  1182.              (file (file-name-nondirectory (buffer-substring beg end)))
  1183.              (dir (or (file-name-directory (buffer-substring beg end)) "")))
  1184.         (message "Making completion list...")
  1185.         (setq akin (file-name-all-completions file dir))))
  1186.   (if akin
  1187.       (with-output-to-temp-buffer " *Completions*"
  1188.         (display-completion-list (sort akin 'string-lessp)))
  1189.     (ding t)
  1190.     (message "[No completion]")))
  1191.  
  1192. ;; Expand-file-name
  1193. (defun jsh-expand ()
  1194.   (interactive)
  1195.   (let*
  1196.       ((beg  (save-excursion
  1197.            (re-search-backward "\\s ")
  1198.            (1+ (point))))
  1199.        (end (point))
  1200.        (filename (buffer-substring beg end)))
  1201.     (setq filename (expand-file-name (substitute-in-file-name filename)))
  1202.     (if (file-exists-p filename)
  1203.     (progn
  1204.       (delete-region beg end)
  1205.       (insert filename)))))
  1206.  
  1207. (provide 'j-shell)
  1208.