warsaw@cme.nist.gov (Barry A. Warsaw) (09/15/89)
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)))))
))))