aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorChong Yidong2012-01-02 17:27:32 +0800
committerChong Yidong2012-01-02 17:27:32 +0800
commitf75bfc33d63f5087993e9954a71663287ff6ea5c (patch)
tree929eeeefd7a5bbb0dd30aaa58a65172b021c79f1
parent651e947eb84b9201faa63ff6dc855a8c99ac8018 (diff)
downloademacs-f75bfc33d63f5087993e9954a71663287ff6ea5c.tar.gz
emacs-f75bfc33d63f5087993e9954a71663287ff6ea5c.zip
Move shell-dir-cookie-re feature into Dirtrack mode.
* lisp/dirtrack.el (dirtrack-list): Eliminate unused third element. (dirtrack): Merge code for handling relative filenames in prompt from shell-dir-cookie-watcher. (dirtrack-debug-message): New arg to avoid excess format calls. * lisp/shell.el (shell-dir-cookie-re): Variable deleted. (shell-dir-cookie-watcher): Function deleted. (shell-mode): Don't use shell-dir-cookie-re, since it is redundant with dirtrack-mode.
-rw-r--r--etc/NEWS4
-rw-r--r--lisp/ChangeLog12
-rw-r--r--lisp/dirtrack.el126
-rw-r--r--lisp/shell.el30
4 files changed, 77 insertions, 95 deletions
diff --git a/etc/NEWS b/etc/NEWS
index c0058800919..fc390df7743 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -749,10 +749,6 @@ Try using `rmail-show-message-hook' instead.
749directory is a remote file name and neither the environment variable 749directory is a remote file name and neither the environment variable
750$ESHELL nor the variable `explicit-shell-file-name' is set. 750$ESHELL nor the variable `explicit-shell-file-name' is set.
751 751
752*** New variable `shell-dir-cookie-re'.
753If set to an appropriate regexp, Shell mode can track your cwd by
754reading it from your prompt.
755
756--- 752---
757** SQL Mode enhancements. 753** SQL Mode enhancements.
758 754
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 5c9274fdda5..d5c10373546 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,15 @@
12012-01-02 Chong Yidong <cyd@gnu.org>
2
3 * dirtrack.el (dirtrack-list): Eliminate unused third element.
4 (dirtrack): Merge code for handling relative filenames in prompt
5 from shell-dir-cookie-watcher.
6 (dirtrack-debug-message): New arg to avoid excess format calls.
7
8 * shell.el (shell-dir-cookie-re): Variable deleted.
9 (shell-dir-cookie-watcher): Function deleted.
10 (shell-mode): Don't use shell-dir-cookie-re, since it is redundant
11 with dirtrack-mode.
12
12012-01-01 Eli Zaretskii <eliz@gnu.org> 132012-01-01 Eli Zaretskii <eliz@gnu.org>
2 14
3 * term/w32-win.el (dynamic-library-alist) <gnutls>: Load 15 * term/w32-win.el (dynamic-library-alist) <gnutls>: Load
diff --git a/lisp/dirtrack.el b/lisp/dirtrack.el
index eef8c111da5..d67c8bdb519 100644
--- a/lisp/dirtrack.el
+++ b/lisp/dirtrack.el
@@ -122,13 +122,11 @@
122(defcustom dirtrack-list (list "^emacs \\([a-zA-Z]:.*\\)>" 1) 122(defcustom dirtrack-list (list "^emacs \\([a-zA-Z]:.*\\)>" 1)
123 "List for directory tracking. 123 "List for directory tracking.
124First item is a regexp that describes where to find the path in a prompt. 124First item is a regexp that describes where to find the path in a prompt.
125Second is a number, the regexp group to match. Optional third item is 125Second is a number, the regexp group to match."
126whether the prompt is multi-line. If nil or omitted, prompt is assumed to
127be on a single line."
128 :group 'dirtrack 126 :group 'dirtrack
129 :type '(sexp (regexp :tag "Prompt Expression") 127 :type '(sexp (regexp :tag "Prompt Expression")
130 (integer :tag "Regexp Group") 128 (integer :tag "Regexp Group"))
131 (boolean :tag "Multiline Prompt"))) 129 :version "24.1")
132 130
133(make-variable-buffer-local 'dirtrack-list) 131(make-variable-buffer-local 'dirtrack-list)
134 132
@@ -188,11 +186,13 @@ With a prefix argument ARG, enable Dirtrack mode if ARG is
188positive, and disable it otherwise. If called from Lisp, enable 186positive, and disable it otherwise. If called from Lisp, enable
189the mode if ARG is omitted or nil. 187the mode if ARG is omitted or nil.
190 188
191This method requires that your shell prompt contain the full 189This method requires that your shell prompt contain the current
192current working directory at all times, and that `dirtrack-list' 190working directory at all times, and that you set the variable
193is set to match the prompt. This is an alternative to 191`dirtrack-list' to match the prompt.
194`shell-dirtrack-mode', which works differently, by tracking `cd' 192
195and similar commands which change the shell working directory." 193This is an alternative to `shell-dirtrack-mode', which works by
194tracking `cd' and similar commands which change the shell working
195directory."
196 nil nil nil 196 nil nil nil
197 (if dirtrack-mode 197 (if dirtrack-mode
198 (add-hook 'comint-preoutput-filter-functions 'dirtrack nil t) 198 (add-hook 'comint-preoutput-filter-functions 'dirtrack nil t)
@@ -213,63 +213,67 @@ and similar commands which change the shell working directory."
213(define-obsolete-variable-alias 'dirtrack-debug 'dirtrack-debug-mode "23.1") 213(define-obsolete-variable-alias 'dirtrack-debug 'dirtrack-debug-mode "23.1")
214 214
215 215
216(defun dirtrack-debug-message (string) 216(defun dirtrack-debug-message (msg1 msg2)
217 "Insert string at the end of `dirtrack-debug-buffer'." 217 "Insert strings at the end of `dirtrack-debug-buffer'."
218 (when dirtrack-debug-mode 218 (when dirtrack-debug-mode
219 (with-current-buffer (get-buffer-create dirtrack-debug-buffer) 219 (with-current-buffer (get-buffer-create dirtrack-debug-buffer)
220 (goto-char (point-max)) 220 (goto-char (point-max))
221 (insert (concat string "\n"))))) 221 (insert msg1 msg2 "\n"))))
222 222
223;;;###autoload 223;;;###autoload
224(defun dirtrack (input) 224(defun dirtrack (input)
225 "Determine the current directory by scanning the process output for a prompt. 225 "Determine the current directory from the process output for a prompt.
226The prompt to look for is the first item in `dirtrack-list'. 226This filter function is used by `dirtrack-mode'. It looks for
227 227the prompt specified by `dirtrack-list', and calls
228You can toggle directory tracking by using the function `dirtrack-mode'. 228`shell-process-cd' if the directory seems to have changed away
229 229from `default-directory'."
230If directory tracking does not seem to be working, you can use the 230 (when (and dirtrack-mode
231function `dirtrack-debug-mode' to turn on debugging output." 231 (not (eq (point) (point-min)))) ; there must be output
232 (unless (or (null dirtrack-mode) 232 (save-excursion ; What's this for? -- cyd
233 (eq (point) (point-min))) ; no output? 233 (if (not (string-match (nth 0 dirtrack-list) input))
234 (let (prompt-path orig-prompt-path 234 ;; No match
235 (current-dir default-directory) 235 (dirtrack-debug-message
236 (dirtrack-regexp (nth 0 dirtrack-list)) 236 "Input failed to match `dirtrack-list': " input)
237 (match-num (nth 1 dirtrack-list))) 237 (let ((prompt-path (match-string (nth 1 dirtrack-list) input))
238 ;; Currently unimplemented, it seems. --Stef 238 temp)
239 ;; (multi-line (nth 2 dirtrack-list))) 239 (cond
240 (save-excursion 240 ;; Don't do anything for empty string
241 ;; No match 241 ((string-equal prompt-path "")
242 (if (not (string-match dirtrack-regexp input)) 242 (dirtrack-debug-message "Prompt match gives empty string: " input))
243 (dirtrack-debug-message 243 ;; If the prompt contains an absolute file name, call
244 (format "Input `%s' failed to match `dirtrack-list'" input)) 244 ;; `shell-process-cd' if the directory has changed.
245 (setq prompt-path (match-string match-num input)) 245 ((file-name-absolute-p prompt-path)
246 ;; Empty string 246 ;; Transform prompts into canonical forms
247 (if (not (> (length prompt-path) 0)) 247 (let ((orig-prompt-path (funcall dirtrack-directory-function
248 (dirtrack-debug-message "Match is empty string") 248 prompt-path))
249 ;; Transform prompts into canonical forms 249 (current-dir (funcall dirtrack-canonicalize-function
250 (setq orig-prompt-path (funcall dirtrack-directory-function 250 default-directory)))
251 prompt-path) 251 (setq prompt-path (shell-prefixed-directory-name orig-prompt-path))
252 prompt-path (shell-prefixed-directory-name orig-prompt-path) 252 ;; Compare them
253 current-dir (funcall dirtrack-canonicalize-function 253 (if (or (string-equal current-dir prompt-path)
254 current-dir)) 254 (string-equal (expand-file-name current-dir)
255 (dirtrack-debug-message 255 (expand-file-name prompt-path)))
256 (format "Prompt is %s\nCurrent directory is %s" 256 (dirtrack-debug-message "Not changing directory: " current-dir)
257 prompt-path current-dir)) 257 ;; It's possible that Emacs thinks the directory
258 ;; Compare them 258 ;; doesn't exist (e.g. rlogin buffers)
259 (if (or (string= current-dir prompt-path) 259 (if (file-accessible-directory-p prompt-path)
260 (string= current-dir (abbreviate-file-name prompt-path))) 260 ;; `shell-process-cd' adds the prefix, so we need
261 (dirtrack-debug-message (format "Not changing directory")) 261 ;; to give it the original (un-prefixed) path.
262 ;; It's possible that Emacs will think the directory 262 (progn
263 ;; won't exist (eg, rlogin buffers) 263 (shell-process-cd orig-prompt-path)
264 (if (file-accessible-directory-p prompt-path) 264 (run-hooks 'dirtrack-directory-change-hook)
265 ;; Change directory. shell-process-cd adds the prefix, so we 265 (dirtrack-debug-message "Changing directory to "
266 ;; need to give it the original (un-prefixed) path. 266 prompt-path))
267 (and (shell-process-cd orig-prompt-path) 267 (dirtrack-debug-message "Not changing to non-existent directory: "
268 (run-hooks 'dirtrack-directory-change-hook) 268 prompt-path)))))
269 (dirtrack-debug-message 269 ;; If the file name is non-absolute, try and see if it
270 (format "Changing directory to %s" prompt-path))) 270 ;; seems to be up or down from where we were.
271 (warn "Directory %s does not exist" prompt-path))) 271 ((string-match "\\`\\(.*\\)\\(?:/.*\\)?\n\\(.*/\\)\\1\\(?:/.*\\)?\\'"
272 ))))) 272 (setq temp
273 (concat prompt-path "\n" default-directory)))
274 (shell-process-cd (concat (match-string 2 temp)
275 prompt-path))
276 (run-hooks 'dirtrack-directory-change-hook)))))))
273 input) 277 input)
274 278
275(provide 'dirtrack) 279(provide 'dirtrack)
diff --git a/lisp/shell.el b/lisp/shell.el
index fdfc8b3cf19..7da1add8e9a 100644
--- a/lisp/shell.el
+++ b/lisp/shell.el
@@ -372,18 +372,6 @@ Thus, this does not include the shell's current directory.")
372 372
373;;; Basic Procedures 373;;; Basic Procedures
374 374
375(defcustom shell-dir-cookie-re nil
376 "Regexp matching your prompt, including some part of the current directory.
377If your prompt includes the current directory or the last few elements of it,
378set this to a pattern that matches your prompt and whose subgroup 1 matches
379the directory part of it.
380This is used by `shell-dir-cookie-watcher' to try and use this info
381to track your current directory. It can be used instead of or in addition
382to `dirtrack-mode'."
383 :group 'shell
384 :type '(choice (const nil) regexp)
385 :version "24.1")
386
387(defun shell-parse-pcomplete-arguments () 375(defun shell-parse-pcomplete-arguments ()
388 "Parse whitespace separated arguments in the current region." 376 "Parse whitespace separated arguments in the current region."
389 (let ((begin (save-excursion (shell-backward-command 1) (point))) 377 (let ((begin (save-excursion (shell-backward-command 1) (point)))
@@ -546,10 +534,6 @@ buffer."
546 (when (string-equal shell "bash") 534 (when (string-equal shell "bash")
547 (add-hook 'comint-preoutput-filter-functions 535 (add-hook 'comint-preoutput-filter-functions
548 'shell-filter-ctrl-a-ctrl-b nil t))) 536 'shell-filter-ctrl-a-ctrl-b nil t)))
549 (when shell-dir-cookie-re
550 ;; Watch for magic cookies in the output to track the current dir.
551 (add-hook 'comint-output-filter-functions
552 'shell-dir-cookie-watcher nil t))
553 (comint-read-input-ring t))) 537 (comint-read-input-ring t)))
554 538
555(defun shell-filter-ctrl-a-ctrl-b (string) 539(defun shell-filter-ctrl-a-ctrl-b (string)
@@ -710,20 +694,6 @@ Otherwise, one argument `-i' is passed to the shell.
710;; replace it with a process filter that watches for and strips out 694;; replace it with a process filter that watches for and strips out
711;; these messages. 695;; these messages.
712 696
713(defun shell-dir-cookie-watcher (text)
714 ;; This is fragile: the TEXT could be split into several chunks and we'd
715 ;; miss it. Oh well. It's a best effort anyway. I'd expect that it's
716 ;; rather unusual to have the prompt split into several packets, but
717 ;; I'm sure Murphy will prove me wrong.
718 (when (and shell-dir-cookie-re (string-match shell-dir-cookie-re text))
719 (let ((dir (match-string 1 text)))
720 (cond
721 ((file-name-absolute-p dir) (shell-cd dir))
722 ;; Let's try and see if it seems to be up or down from where we were.
723 ((string-match "\\`\\(.*\\)\\(?:/.*\\)?\n\\(.*/\\)\\1\\(?:/.*\\)?\\'"
724 (setq text (concat dir "\n" default-directory)))
725 (shell-cd (concat (match-string 2 text) dir)))))))
726
727(defun shell-directory-tracker (str) 697(defun shell-directory-tracker (str)
728 "Tracks cd, pushd and popd commands issued to the shell. 698 "Tracks cd, pushd and popd commands issued to the shell.
729This function is called on each input passed to the shell. 699This function is called on each input passed to the shell.