[gnu.emacs.bug] shell-mode doesn't grok "pushd +N"

mcgrath%tully.Berkeley.EDU@GINGER.BERKELEY.EDU (Roland McGrath) (12/07/88)

shell-mode recognition of csh directory stack commands
doesn't take into account that `pushd +N' will juggle
the stack so the Nth member is 1st.

layer@UCBARPA.BERKELEY.EDU (Kevin Layer) (12/08/88)

>> shell-mode recognition of csh directory stack commands
>> doesn't take into account that `pushd +N' will juggle
>> the stack so the Nth member is 1st.

Franz Inc.'s enhanced shell mode (which we distribute free, of course)
does this.  The following snippet of code should be easily usable,
after removing the packagification stuff (fi: and fi:: before symbol
names, which are there so our shell mode is orthogonal to the standard
one).

Enjoy.

(defun fi::subprocess-watch-for-special-commands ()
  "Watch for special commands like, for example, `cd' in a shell."
  (if (null fi::shell-directory-stack)
      (setq fi::shell-directory-stack (list default-directory)))
  (condition-case ()
      (save-excursion
	(goto-char fi::last-input-start)
	(cond
	  ((and fi::cl-package-regexp (looking-at fi::cl-package-regexp))
	   (goto-char (match-end 0))
	   (cond
	     ((or (looking-at "[ \t]*[':]\\(.*\\)[ \t]*)")
		  (looking-at "[ \t]*\"\\(.*\\)\"[ \t]*)"))
	      ;; (in-package foo)
	      (setq fi:package
		(buffer-substring (match-beginning 1) (match-end 1))))
	     ((looking-at "[ \t]+\\(.*\\)[ \t]*$")
	      ;; :pa foo
	      (setq fi:package
		(buffer-substring (match-beginning 1) (match-end 1)))))
	   ;; need to do something here to force the minibuffer to
	   ;; redisplay:
	   (set-buffer-modified-p (buffer-modified-p)))
	  ((and fi:shell-popd-regexp (looking-at fi:shell-popd-regexp))
	   (goto-char (match-end 0))
	   (cond
	     ((looking-at ".*&[ \t]*$")
	      ;; "popd ... &" executes in a subshell!
	      )
	     (t
	      (let ((n (if (looking-at "[ \t]+\\+\\([0-9]*\\)")
			   (car
			    (read-from-string
			     (buffer-substring (match-beginning 1)
					       (match-end 1)))))))
		(if (null n)
		    (cd (car (setq fi::shell-directory-stack
			       (cdr fi::shell-directory-stack))))
		  ;; pop n'th entry
		  (if (> n (length fi::shell-directory-stack))
		      (message "Directory stack not that deep.")
		    (let ((tail (nthcdr (+ n 1) fi::shell-directory-stack)))
		      (rplacd (nthcdr (- n 1) fi::shell-directory-stack)
			      nil)
		      (setq fi::shell-directory-stack
			(append fi::shell-directory-stack tail)))))))))
	  ((and fi:shell-pushd-regexp (looking-at fi:shell-pushd-regexp))
	   (goto-char (match-end 0))
	   (cond
	     ((looking-at ".*&[ \t]*$")
	      ;; "pushd ... &" executes in a subshell!
	      )
	     ((looking-at "[ \t]+\\+\\([0-9]+\\)[ \t]*[;\n]")
	      ;; pushd +n
	      (let ((n (car (read-from-string
			     (buffer-substring (match-beginning 1)
					       (match-end 1))))))
		(if (< n 1)
		    (message "Illegal stack element: %s" n)
		  (if (> n (length fi::shell-directory-stack))
		      (message "Directory stack not that deep.")
		    (let ((head (nthcdr n fi::shell-directory-stack)))
		      (rplacd (nthcdr (- n 1) fi::shell-directory-stack)
			      nil)
		      (setq fi::shell-directory-stack
			(append head fi::shell-directory-stack))
		      (cd (car head)))))))
	     ((looking-at "[ \t]+\\([^ \t]+\\)[;\n]")
	      ;; pushd dir
	      (let ((dir (expand-file-name
			  (substitute-in-file-name
			   (buffer-substring (match-beginning 1)
					     (match-end 1))))))
		(if (file-directory-p dir)
		    (progn
		      (setq fi::shell-directory-stack
			(cons dir fi::shell-directory-stack))
		      (cd dir)))))
	     ((looking-at "[ \t]*[;\n]")
	      ;; pushd
	      (if (< (length fi::shell-directory-stack) 2)
		  (message "Directory stack not that deep.")
		(setq fi::shell-directory-stack
		  (append (list (car (cdr fi::shell-directory-stack))
				(car fi::shell-directory-stack))
			  (cdr (cdr fi::shell-directory-stack))))
		(cd (car fi::shell-directory-stack))))))
	  ((and fi:shell-cd-regexp (looking-at fi:shell-cd-regexp))
	   (goto-char (match-end 0))
	   (cond
	     ((looking-at ".*&[ \t]*$")
	      ;; "cd foo &" executes in a subshell!
	      )
	     ((looking-at "[ \t]*[;\n]")
	      ;; cd
	      (cd (rplaca fi::shell-directory-stack (getenv "HOME"))))
	     ((looking-at "[ \t]+\\([^ \t]+\\)[ \t]*[;\n]")
	      ;; cd dir
	      (let ((dir (expand-file-name
			  (substitute-in-file-name
			   (buffer-substring (match-beginning 1)
					     (match-end 1))))))
		(if (file-directory-p dir)
		    (progn
		      (rplaca fi::shell-directory-stack dir)
		      (cd dir)))))))))
    (error nil)))