Article View: gnu.emacs.bug
Article #1236Re: shell-mode doesn't grok "pushd +N"
From: Kevin Layer
Date: Wed, 07 Dec 1988 18:51
Date: Wed, 07 Dec 1988 18:51
119 lines
4891 bytes
4891 bytes
>> 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)))
Technical Details
Message-ID:
<8812071851.AA05037@snooze>Path:
arc1-ca.pugleaf.net!utzoo!utgpu!watmath!uunet!tut.cis.ohio-state.edu!UCBARPA.BERKELEY.EDU!franz!snooze!layerReferences:
<8812070041.AA16711@tully.Berkeley.EDU>Show Full Headers
Complete Article Headers
Path: arc1-ca.pugleaf.net!utzoo!utgpu!watmath!uunet!tut.cis.ohio-state.edu!UCBARPA.BERKELEY.EDU!franz!snooze!layer From: franz!snooze!layer@UCBARPA.BERKELEY.EDU (Kevin Layer) Newsgroups: gnu.emacs.bug Subject: Re: shell-mode doesn't grok "pushd +N" Message-ID: <8812071851.AA05037@snooze> Date: 7 Dec 88 18:51:31 GMT References: <8812070041.AA16711@tully.Berkeley.EDU> Sender: daemon@tut.cis.ohio-state.edu Distribution: gnu Organization: GNUs Not Usenet Lines: 119