;;; msdos-shell-fix.el --- MS-DOS shell support.

;; Author: Francis Wright <F.J.Wright@QMW.ac.uk>
;; Time-stamp: <06 September 2000>

;; Patch the standard comint-mode IF NECESSARY to work with the MS-DOS
;; COMMAND.COM shell, either via cmdproxy or directly, in GNU Emacs
;; 20.3 under Windows 95.  It avoids leaving a disconnected shell
;; process if the buffer or emacs is killed, and it arranges for tidy
;; output.  It is intended to work for both command shell buffers and
;; TeX shell buffers (which is the reason for some of the apparent
;; redundancy in the initialization code at the end of this file!)

;; I suggest that you put this library somewhere in your `load-path',
;; compile it and hang it on `comint-exec-hook' by putting this in
;; `.emacs', so that it is loaded only if necessary:

;; (add-hook 'comint-exec-hook
;;           (function (lambda () (require 'msdos-shell-fix))))

;; instead of

;; (setq comint-process-echoes t)
;; (add-hook 'comint-output-filter-functions 'comint-strip-ctrl-m nil t)

;; which it automates.

;; Note that there is a small bug in the standard 20.3 comint.el that
;; prevents comint-exec-hook (and hence this patch) working properly.
;; If this patch does not work properly then try making the following
;; change to comint.el.

;; Change  (make-local-variable 'comint-exec-hook)
;; to      (make-local-hook 'comint-exec-hook)


(defun msdos-shell-processp (proc)
  "True if PROC is an MS-DOS shell process running cmdproxy or command."
  (and (processp proc)
       (let ((case-fold-search t)
	     (cmd (process-command proc)))
	 (and cmd
	      (string-match "cmdproxy\\|command" (car cmd))))
       ))

(defun msdos-shell-send-exit (proc)
  "If PROC is an MS-DOS shell process then send it the string `exit'."
  (if (msdos-shell-processp proc)
      (process-send-string proc "exit\n")))

(defun msdos-shell-send-exit-and-pause (proc)
  "If PROC is an MS-DOS shell process then send it the string `exit'
and pause to allow it to take effect (before Emacs dies)."
  (cond ((msdos-shell-processp proc)
	 (process-send-string proc "exit\n")
	 ;; The time may need tuning on different systems.
	 ;; For me, anything less than 1 second is unreliable.
	 (sit-for 1 nil t)		; no redisplay
	 )))

(defun msdos-shell-kill-buffer ()
  "Hang on `kill-buffer-hook' to exit from an MS-DOS shell process."
  (msdos-shell-send-exit (get-buffer-process (current-buffer))))

(defun msdos-shell-kill-emacs ()
  "Hang on `kill-emacs-hook' to exit from all MS-DOS shell processes."
  (mapcar 'msdos-shell-send-exit-and-pause (process-list)))

(defsubst msdos-shell-bufferp ()
  "True if current buffer has a process running an MS-DOS shell process."
  (msdos-shell-processp (get-buffer-process (current-buffer))))

(defun msdos-shell-fix ()
  "Install MS-DOS shell support if appropriate."
  (cond ((msdos-shell-bufferp)
	 (add-hook 'kill-buffer-hook 'msdos-shell-kill-buffer)
	 (add-hook 'kill-emacs-hook 'msdos-shell-kill-emacs)
	 (add-hook 'comint-output-filter-functions
		   'shell-strip-ctrl-m nil t)
	 ;; The following is done in comint-mode but not in tex-mode:
	 (set (make-local-variable 'comint-process-echoes) t)
	 ;; MS-DOS assumes the following, and it is needed for shell
	 ;; completion.  Should really be done locally within an
	 ;; MS-DOS shell buffer, I suppose!
	 (or (member "." exec-path)
	     (setq exec-path (cons "." exec-path)))
	 )))

(msdos-shell-fix)			; run now and also later!
(add-hook 'comint-exec-hook 'msdos-shell-fix)

(add-hook 'comint-mode-hook 'msdos-shell-fix)
;; ... for shell mode, which declares comint-process-echoes local in
;; comint-mode AFTER running comint-exec


; It would be much better if the local binding to argpart in
; comint-arguments were replaced by a binding to a global variable,
; called e.g. comint-argpart, which could then be cleanly rebound when
; necessary.

(defadvice comint-arguments		; (string nth mth)
  (around msdos-comint-arguments activate)
  "For MS-DOS shells, only \" quotes arguments."
  (setq
   ad-return-value
   ;; Otherwise ...
   ;; The first line handles ordinary characters and backslash-sequences.
   ;; The second matches "-quoted strings.
   ;; The third matches '-quoted strings.
   ;; The fourth matches `-quoted strings.
   ;; This seems to fit the syntax of BASH 2.0.
   (let ((argpart			; FJW
	  (if (and (eq major-mode 'shell-mode)
		   (string-match "cmdproxy\\|command" shell-file-name))
	      "[^ \n\t\"]+\\|\\(\"[^\"]*\"\\)"
	    "[^ \n\t\"'`\\]+\\|\\\\[\"'`\\]+\\|\
\\(\"\\([^\"\\]\\|\\\\.\\)*\"\\|\
'[^']*'\\|\
`[^`]*`\\)"))
	 (args ()) (pos 0)
	 (count 0)
	 beg str value quotes)
     ;; Build a list of all the args until we have as many as we want.
     (while (and (or (null mth) (<= count mth))
		 (string-match argpart string pos))
       (if (and beg (= pos (match-beginning 0)))
	   ;; It's contiguous, part of the same arg.
	   (setq pos (match-end 0)
		 quotes (or quotes (match-beginning 1)))
	 ;; It's a new separate arg.
	 (if beg
	     ;; Put the previous arg, if there was one, onto ARGS.
	     (setq str (substring string beg pos)
		   args (if quotes (cons str args)
			  (nconc (comint-delim-arg str) args))
		   count (1+ count)))
	 (setq quotes (match-beginning 1))
	 (setq beg (match-beginning 0))
	 (setq pos (match-end 0))))
     (if beg
	 (setq str (substring string beg pos)
	       args (if quotes (cons str args)
		      (nconc (comint-delim-arg str) args))
	       count (1+ count)))
     (let ((n (or nth (1- count)))
	   (m (if mth (1- (- count mth)) 0)))
       (mapconcat
	(function (lambda (a) a)) (nthcdr n (nreverse (nthcdr m args))) " ")))))


(provide 'msdos-shell-fix)

;;; msdos-shell-fix.el ends here