Xref: utzoo comp.emacs:6864 gnu.emacs:1605
Path: utzoo!utgpu!jarvis.csri.toronto.edu!mailrus!uwm.edu!gem.mps.ohio-state.edu!ginosko!uunet!cme!durer!warsaw
From: warsaw@cme.nist.gov (Barry A. Warsaw)
Newsgroups: comp.emacs,gnu.emacs
Subject: shell-set-directory.el -- better shell-mode directory tracking
Message-ID: <WARSAW.89Sep14165444@rtg.cme.nist.gov>
Date: 14 Sep 89 20:54:44 GMT
Sender: news@cme.nbs.gov
Organization: National Institute of Standards and Technology
Lines: 235


A couple of weeks ago, I posted a message outlining a problem with
tracking /bin/csh builtin commands `cd', `pushd' and `popd' in
shell-mode.  I asked if anyone had already written a better tracker
for csh.  While I did get some suggestions to try other shells or
shell-modes (cmushell), I didn't get any code that fixes the described
problem, so I went ahead and hacked out shell-set-directory.el.

The code here correctly tracks those three builtin commands (plus
`dirs') with or without arguments. While its not totally perfect, it
seems to be much better than what is provided in emacs/lisp/shell.el;
normal use of shell-mode should not be able to confuse it.  The only
shell I use is /bin/csh so error messages and functionality are
patterned after it. Play with it and as always, feel free to
comment/enjoy/deride/abuse/improve/modify/whatever.

-Barry

--cut here-------------------------------------------------------
;; shell-set-directory.el

;; Does a better, but not perfect job of tracking csh builtin commands
;; that modify the directory and directory stack.  Correctly tracks
;; commands `cd', `pushd', `popd' and `dirs' with arguments.
;; Correctly expands paths containing environment variables, `~', `.'
;; and `..'.  Still can't track paths which contain shell variables,
;; execs, etc.

;; Builtins recognized:
;;
;; cd [path]
;; pushd [+n | path]
;; popd [+n]
;; dirs [-l]
;;
;; path can be either absolute or relative, n must be > 0, [] means
;; optional argument, | means one or the other.

;; To use, put file where it can be reached via  your load-path and
;; *add* this to your shell-mode-hook (probably in ~/.emacs):
;;
;; (load "shell-set-directory")

;; This file is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY.  No author or distributor accepts
;; responsibility to anyone for the consequences of using it or for
;; whether it serves any particular purpose or works at all, unless
;; s/he says so in writing.

;; This software was written as part of the author's official duty as
;; an employee of the United States Government and is thus in the
;; public domain.  You are free to use this software as you wish, but
;; WITHOUT ANY WARRANTY WHATSOEVER.  It would be nice, though if when
;; you use this code, you give due credit to the author.

;; ======================================================================
;; Author:
;;
;; NAME: Barry A. Warsaw                USMAIL: National Institute of Standards
;; TELE: (301) 975-3460                         and Technology (formerly NBS)
;; UUCP: {...}!uunet!cme-durer!warsaw           Rm. B-124, Bldg. 220
;; ARPA: warsaw@cme.nist.gov                    Gaithersburg, MD 20899

;; ======================================================================
;; Modification history:
;;
;; posted  : 14-Sep-1989 baw (comp.emacs, gnu.emacs)
;; modified: 14-Sep-1989 baw (cleaned up for posting)
;; modified: 11-Sep-1989 baw (fixed regexps)
;; created :  8-Sep-1989 baw

;; ======================================================================
;; Wish list:
;;
;; 1) glob directory better to find actual directory cd'd to in the case
;;    of shell vars, execs, etc.
;;
;; 2) ftp inside of shell-mode, then cd-ing confuses it


(defvar shell-eos-re "\\s *\\([\n;]\\|$\\)"
  "*What the end of a shell builtin command looks like.  eos stands for
`end-of-statement'.  This correctly finds ; terminated commands.")

(defvar shell-arg-re (concat "\\s +.+" shell-eos-re)
  "*What a shell builtin command looks like to the eos, when an
argument is present.")

(defvar shell-dirs-regexp "dirs"
  "Shell builtin `dirs' command.  Change if you alias dirs.")


(defun shell-snag-arg (command-re)
  "Snag the arg after COMMAND-RE in current buffer, return arg string.
Assumes buffer is narrowed to just the command.  Returns nil if not
argumented."
  (and (looking-at (concat "\\(" command-re "\\)" shell-arg-re))
       (let ((arg-start (save-excursion
			  (re-search-forward (concat "\\("
						     command-re
						     "\\)\\s +"))
			  (match-end 0)))
	     (arg-end (save-excursion
			(end-of-line)
			(re-search-backward shell-eos-re)
			(match-beginning 0))))
	 (buffer-substring arg-start arg-end))))
		      

(defun shell-set-directory ()
  "Correctly manipulate shell directory stack for handling shell commands
`cd', `pushd', `popd', and `dirs'."
  ;; save end-of-statement [eos] marker
  ;; narrow to region of just the command
  (save-restriction
    (let ((eos (save-excursion (skip-chars-forward "^;\n") (point)))
	  arg
	  dir
	  ind
	  (dir0 default-directory))
      (narrow-to-region (point) eos)
      
      (cond
       ((looking-at shell-cd-regexp)
	;; perhaps looking at cd command
	(cond
	 ((looking-at (concat "\\(" shell-cd-regexp "\\)" shell-eos-re))
	  ;; looking at a no argument cd command
	  ;; means cd to home directory
	  (setq arg "$HOME")
	  (setq dir (expand-file-name (substitute-in-file-name arg)))
	  (cd dir))
	 ((setq arg (shell-snag-arg shell-cd-regexp))
	  ;; looking at an arg'd cd, possibly legal directory
	  (setq dir (expand-file-name (substitute-in-file-name arg)))
	  (cd dir))))

       ((looking-at shell-popd-regexp)
	;; perhaps looking at popd command
	(cond
	 ((looking-at (concat "\\(" shell-popd-regexp "\\)" shell-eos-re))
	  ;; looking at a no arg popd command
	  ;; pop "top" directory from stack
	  (or (setq dir (car shell-directory-stack))
	      (error "popd: Directory stack empty."))
	  (cd dir)
	  (setq shell-directory-stack (cdr shell-directory-stack)))
	 ((setq arg (shell-snag-arg shell-popd-regexp))
	  ;; looking at arg'd popd command
	  (setq ind (string-to-int arg))
	  ;; check for legal argument value
	  (or (and (string-match "^\\+[1-9]+[0-9]*$" arg)
		   (> ind 0))
	      (error "popd: Invalid argument: %d" arg))
	  ;; check to be sure there *is* an nth dir on shell-directory-stack
	  ;; remember first dir on s-d-s is indexed +1
	  (or (nth (1- ind) shell-directory-stack)
	      (error "popd: Directory stack not that deep."))
	  ;; pop the nth directory off the stack, don't need to cd
	  (let ((tcdr (nthcdr ind shell-directory-stack)))
	    (cond
	     ((null tcdr)
	      (setq shell-directory-stack nil))
	     ((= ind 1)
	      (setcar shell-directory-stack (car tcdr))
	      (setcdr shell-directory-stack (cdr tcdr)))
	     (t
	      (setcdr (nthcdr (- ind 2) shell-directory-stack) tcdr)))))))
       
       ((looking-at shell-pushd-regexp)
	;; perhaps looking at a pushd command
	(cond
	 ((looking-at (concat "\\(" shell-pushd-regexp "\\)" shell-eos-re))
	  ;; looking at a no arg pushd command
	  ;; exchange top two directories
	  (or (setq dir (car shell-directory-stack))
	      (error "pushd: No other directory."))
	  (cd dir)
	  (setq shell-directory-stack (append (list dir0)
					      (cdr shell-directory-stack))))
	 ((and (progn (setq arg (shell-snag-arg shell-pushd-regexp))
		      (setq ind (string-to-int arg))
		      (string-match "^\\+[1-9]+[0-9]*$" arg))
	       (> ind 0))
	  ;; looking at an numerically arg'd pushd command
	  (or (setq dir (nth (1- ind) shell-directory-stack))
	      (error "pushd: Directory stack not that deep."))
	  (cd dir)
	  (while (< 0 ind)
	    (setq shell-directory-stack (append shell-directory-stack
						(list dir0)))
	    (setq dir0 (car shell-directory-stack))
	    (setq shell-directory-stack (cdr shell-directory-stack))
	    (setq ind (1- ind))))
	 (t
	  ;; must be looking at a directory
	  (setq dir (expand-file-name (substitute-in-file-name arg)))
	  (cd dir)
	  (setq shell-directory-stack (append (list dir0)
					      shell-directory-stack)))))

       ((looking-at shell-dirs-regexp)
	;; perhaps looking at dirs command
	(cond
	 ((looking-at (concat "\\(" shell-dirs-regexp "\\)" shell-eos-re))
	  ;; looking at a no arg'd dirs command
	  ;; print out directory stack
	  (let ((dirs ""))
	    (mapcar
	     (function
	      (lambda (dir)
		(and (string-match (concat "^"
					   (substitute-in-file-name "$HOME"))
				   dir)
		     (setq dir (concat "~" (substring dir (match-end 0)))))
		(setq dirs (concat dirs
				   (if (string-match "^~/$" dir)
				       "~"
				     (directory-file-name dir))
				   " "))))
	     (append (list default-directory) shell-directory-stack))
	    (message "%s" dirs)))
	 ((setq arg (shell-snag-arg shell-dirs-regexp))
	  ;; must be an arg'd dirs command
	  ;; check for valid arg
	  (or (string-match "^-l$" arg)
	      (error "Usage: dirs [ -l ]."))
	  (let ((dirs ""))
	    (mapcar
	     (function
	      (lambda (dir)
		(setq dirs (concat dirs (directory-file-name dir) " "))))
	     (append (list default-directory) shell-directory-stack))
	    (message "%s" dirs)))))
       ))))