[Emacs-diffs] /srv/bzr/emacs/trunk r106760: Move shell-dir-cookie-re feature into Dirtrack mode.

[Chong Yidong]

------------------------------------------------------------
revno: 106760
committer: Chong Yidong <address@hidden>
branch nick: trunk
timestamp: Mon 2012-01-02 17:27:32 +0800
message:
  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.
modified:
  etc/NEWS
  lisp/ChangeLog
  lisp/dirtrack.el
  lisp/shell.el

=== modified file 'etc/NEWS'
--- a/etc/NEWS  2011-12-30 10:19:42 +0000
+++ b/etc/NEWS  2012-01-02 09:27:32 +0000
@@ -749,10 +749,6 @@
 directory is a remote file name and neither the environment variable
 $ESHELL nor the variable `explicit-shell-file-name' is set.
 
-*** New variable `shell-dir-cookie-re'.
-If set to an appropriate regexp, Shell mode can track your cwd by
-reading it from your prompt.
-
 ---
 ** SQL Mode enhancements.
 

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2012-01-01 16:26:51 +0000
+++ b/lisp/ChangeLog    2012-01-02 09:27:32 +0000
@@ -1,3 +1,15 @@
+2012-01-02  Chong Yidong  <address@hidden>
+
+       * 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.
+
+       * 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.
+
 2012-01-01  Eli Zaretskii  <address@hidden>
 
        * term/w32-win.el (dynamic-library-alist) <gnutls>: Load

=== modified file 'lisp/dirtrack.el'
--- a/lisp/dirtrack.el  2011-10-19 12:54:24 +0000
+++ b/lisp/dirtrack.el  2012-01-02 09:27:32 +0000
@@ -122,13 +122,11 @@
 (defcustom dirtrack-list (list "^emacs \\([a-zA-Z]:.*\\)>" 1)
   "List for directory tracking.
 First item is a regexp that describes where to find the path in a prompt.
-Second is a number, the regexp group to match.  Optional third item is
-whether the prompt is multi-line.  If nil or omitted, prompt is assumed to
-be on a single line."
+Second is a number, the regexp group to match."
   :group 'dirtrack
   :type  '(sexp (regexp  :tag "Prompt Expression")
-               (integer :tag "Regexp Group")
-               (boolean :tag "Multiline Prompt")))
+               (integer :tag "Regexp Group"))
+  :version "24.1")
 
 (make-variable-buffer-local 'dirtrack-list)
 
@@ -188,11 +186,13 @@
 positive, and disable it otherwise.  If called from Lisp, enable
 the mode if ARG is omitted or nil.
 
-This method requires that your shell prompt contain the full
-current working directory at all times, and that `dirtrack-list'
-is set to match the prompt.  This is an alternative to
-`shell-dirtrack-mode', which works differently, by tracking `cd'
-and similar commands which change the shell working directory."
+This method requires that your shell prompt contain the current
+working directory at all times, and that you set the variable
+`dirtrack-list' to match the prompt.
+
+This is an alternative to `shell-dirtrack-mode', which works by
+tracking `cd' and similar commands which change the shell working
+directory."
   nil nil nil
   (if dirtrack-mode
       (add-hook 'comint-preoutput-filter-functions 'dirtrack nil t)
@@ -213,63 +213,67 @@
 (define-obsolete-variable-alias 'dirtrack-debug 'dirtrack-debug-mode "23.1")
 
 
-(defun dirtrack-debug-message (string)
-  "Insert string at the end of `dirtrack-debug-buffer'."
+(defun dirtrack-debug-message (msg1 msg2)
+  "Insert strings at the end of `dirtrack-debug-buffer'."
   (when dirtrack-debug-mode
     (with-current-buffer (get-buffer-create dirtrack-debug-buffer)
       (goto-char (point-max))
-      (insert (concat string "\n")))))
+      (insert msg1 msg2 "\n"))))
 
 ;;;###autoload
 (defun dirtrack (input)
-  "Determine the current directory by scanning the process output for a prompt.
-The prompt to look for is the first item in `dirtrack-list'.
-
-You can toggle directory tracking by using the function `dirtrack-mode'.
-
-If directory tracking does not seem to be working, you can use the
-function `dirtrack-debug-mode' to turn on debugging output."
-  (unless (or (null dirtrack-mode)
-              (eq (point) (point-min)))     ; no output?
-    (let (prompt-path orig-prompt-path
-         (current-dir default-directory)
-         (dirtrack-regexp    (nth 0 dirtrack-list))
-         (match-num          (nth 1 dirtrack-list)))
-          ;; Currently unimplemented, it seems.  --Stef
-         ;; (multi-line      (nth 2 dirtrack-list)))
-      (save-excursion
-        ;; No match
-        (if (not (string-match dirtrack-regexp input))
-            (dirtrack-debug-message
-             (format "Input `%s' failed to match `dirtrack-list'" input))
-          (setq prompt-path (match-string match-num input))
-          ;; Empty string
-          (if (not (> (length prompt-path) 0))
-              (dirtrack-debug-message "Match is empty string")
-            ;; Transform prompts into canonical forms
-            (setq orig-prompt-path (funcall dirtrack-directory-function
-                                            prompt-path)
-                  prompt-path (shell-prefixed-directory-name orig-prompt-path)
-                  current-dir (funcall dirtrack-canonicalize-function
-                                       current-dir))
-            (dirtrack-debug-message
-             (format "Prompt is %s\nCurrent directory is %s"
-                     prompt-path current-dir))
-            ;; Compare them
-            (if (or (string= current-dir prompt-path)
-                    (string= current-dir (abbreviate-file-name prompt-path)))
-                (dirtrack-debug-message (format "Not changing directory"))
-              ;; It's possible that Emacs will think the directory
-              ;; won't exist (eg, rlogin buffers)
-              (if (file-accessible-directory-p prompt-path)
-                  ;; Change directory. shell-process-cd adds the prefix, so we
-                  ;; need to give it the original (un-prefixed) path.
-                  (and (shell-process-cd orig-prompt-path)
-                       (run-hooks 'dirtrack-directory-change-hook)
-                       (dirtrack-debug-message
-                        (format "Changing directory to %s" prompt-path)))
-                (warn "Directory %s does not exist" prompt-path)))
-            )))))
+  "Determine the current directory from the process output for a prompt.
+This filter function is used by `dirtrack-mode'.  It looks for
+the prompt specified by `dirtrack-list', and calls
+`shell-process-cd' if the directory seems to have changed away
+from `default-directory'."
+  (when (and dirtrack-mode
+            (not (eq (point) (point-min)))) ; there must be output
+    (save-excursion ; What's this for? -- cyd
+      (if (not (string-match (nth 0 dirtrack-list) input))
+         ;; No match
+         (dirtrack-debug-message
+          "Input failed to match `dirtrack-list': " input)
+       (let ((prompt-path (match-string (nth 1 dirtrack-list) input))
+             temp)
+         (cond
+          ;; Don't do anything for empty string
+          ((string-equal prompt-path "")
+           (dirtrack-debug-message "Prompt match gives empty string: " input))
+          ;; If the prompt contains an absolute file name, call
+          ;; `shell-process-cd' if the directory has changed.
+          ((file-name-absolute-p prompt-path)
+           ;; Transform prompts into canonical forms
+           (let ((orig-prompt-path (funcall dirtrack-directory-function
+                                            prompt-path))
+                 (current-dir      (funcall dirtrack-canonicalize-function
+                                            default-directory)))
+             (setq prompt-path (shell-prefixed-directory-name 
orig-prompt-path))
+             ;; Compare them
+             (if (or (string-equal current-dir prompt-path)
+                     (string-equal (expand-file-name current-dir)
+                                   (expand-file-name prompt-path)))
+                 (dirtrack-debug-message "Not changing directory: " 
current-dir)
+               ;; It's possible that Emacs thinks the directory
+               ;; doesn't exist (e.g. rlogin buffers)
+               (if (file-accessible-directory-p prompt-path)
+                   ;; `shell-process-cd' adds the prefix, so we need
+                   ;; to give it the original (un-prefixed) path.
+                   (progn
+                     (shell-process-cd orig-prompt-path)
+                     (run-hooks 'dirtrack-directory-change-hook)
+                     (dirtrack-debug-message "Changing directory to "
+                                             prompt-path))
+                 (dirtrack-debug-message "Not changing to non-existent 
directory: "
+                                         prompt-path)))))
+          ;; If the file name is non-absolute, try and see if it
+          ;; seems to be up or down from where we were.
+          ((string-match "\\`\\(.*\\)\\(?:/.*\\)?\n\\(.*/\\)\\1\\(?:/.*\\)?\\'"
+                         (setq temp
+                               (concat prompt-path "\n" default-directory)))
+           (shell-process-cd (concat (match-string 2 temp)
+                                     prompt-path))
+           (run-hooks 'dirtrack-directory-change-hook)))))))
   input)
 
 (provide 'dirtrack)

=== modified file 'lisp/shell.el'
--- a/lisp/shell.el     2011-12-12 05:32:49 +0000
+++ b/lisp/shell.el     2012-01-02 09:27:32 +0000
@@ -372,18 +372,6 @@
 
 ;;; Basic Procedures
 
-(defcustom shell-dir-cookie-re nil
-  "Regexp matching your prompt, including some part of the current directory.
-If your prompt includes the current directory or the last few elements of it,
-set this to a pattern that matches your prompt and whose subgroup 1 matches
-the directory part of it.
-This is used by `shell-dir-cookie-watcher' to try and use this info
-to track your current directory.  It can be used instead of or in addition
-to `dirtrack-mode'."
-  :group 'shell
-  :type '(choice (const nil) regexp)
-  :version "24.1")
-
 (defun shell-parse-pcomplete-arguments ()
   "Parse whitespace separated arguments in the current region."
   (let ((begin (save-excursion (shell-backward-command 1) (point)))
@@ -546,10 +534,6 @@
       (when (string-equal shell "bash")
         (add-hook 'comint-preoutput-filter-functions
                   'shell-filter-ctrl-a-ctrl-b nil t)))
-    (when shell-dir-cookie-re
-      ;; Watch for magic cookies in the output to track the current dir.
-      (add-hook 'comint-output-filter-functions
-               'shell-dir-cookie-watcher nil t))
     (comint-read-input-ring t)))
 
 (defun shell-filter-ctrl-a-ctrl-b (string)
@@ -710,20 +694,6 @@
 ;; replace it with a process filter that watches for and strips out
 ;; these messages.
 
-(defun shell-dir-cookie-watcher (text)
-  ;; This is fragile: the TEXT could be split into several chunks and we'd
-  ;; miss it.  Oh well.  It's a best effort anyway.  I'd expect that it's
-  ;; rather unusual to have the prompt split into several packets, but
-  ;; I'm sure Murphy will prove me wrong.
-  (when (and shell-dir-cookie-re (string-match shell-dir-cookie-re text))
-    (let ((dir (match-string 1 text)))
-      (cond
-       ((file-name-absolute-p dir) (shell-cd dir))
-       ;; Let's try and see if it seems to be up or down from where we were.
-       ((string-match "\\`\\(.*\\)\\(?:/.*\\)?\n\\(.*/\\)\\1\\(?:/.*\\)?\\'"
-                     (setq text (concat dir "\n" default-directory)))
-       (shell-cd (concat (match-string 2 text) dir)))))))
-
 (defun shell-directory-tracker (str)
   "Tracks cd, pushd and popd commands issued to the shell.
 This function is called on each input passed to the shell.