From f75bfc33d63f5087993e9954a71663287ff6ea5c Mon Sep 17 00:00:00 2001 From: Chong Yidong Date: Mon, 2 Jan 2012 17:27:32 +0800 Subject: [PATCH] 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. --- etc/NEWS | 4 -- lisp/ChangeLog | 12 +++++ lisp/dirtrack.el | 126 ++++++++++++++++++++++++----------------------- lisp/shell.el | 30 ----------- 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. 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. diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 5c9274fdda5..d5c10373546 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,15 @@ +2012-01-02 Chong Yidong + + * 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 * term/w32-win.el (dynamic-library-alist) : 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 @@ (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 @@ With a prefix argument ARG, enable Dirtrack mode if ARG is 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 @@ and similar commands which change the shell working directory." (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) 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.") ;;; 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 @@ buffer." (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 @@ Otherwise, one argument `-i' is passed to the shell. ;; 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. -- 2.39.2