procyberian/emacs
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Move shell-dir-cookie-re feature into Dirtrack mode.

Browse source 
* 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.
This commit is contained in:
Chong Yidong 2012-01-02 17:27:32 +08:00
parent 651e947eb8
commit f75bfc33d6
4 changed files with 77 additions and 95 deletions
Download patch file Download diff file Expand all files Collapse all files

4
etc/NEWS
View file

@ -749,10 +749,6 @@ Try using `rmail-show-message-hook' instead.
directory is a remote file name and neither the environment variable directory is a remote file name and neither the environment variable
$ESHELL nor the variable `explicit-shell-file-name' is set. $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. ** SQL Mode enhancements.

12
lisp/ChangeLog
View file

@ -1,3 +1,15 @@
2012-01-02 Chong Yidong <cyd@gnu.org>
* 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 <eliz@gnu.org> 2012-01-01 Eli Zaretskii <eliz@gnu.org>
* term/w32-win.el (dynamic-library-alist) <gnutls>: Load * term/w32-win.el (dynamic-library-alist) <gnutls>: Load

114
lisp/dirtrack.el
View file

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

30
lisp/shell.el
View file

@ -372,18 +372,6 @@ Thus, this does not include the shell's current directory.")
;;; Basic Procedures ;;; 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 () (defun shell-parse-pcomplete-arguments ()
"Parse whitespace separated arguments in the current region." "Parse whitespace separated arguments in the current region."
(let ((begin (save-excursion (shell-backward-command 1) (point))) (let ((begin (save-excursion (shell-backward-command 1) (point)))
@ -546,10 +534,6 @@ buffer."
(when (string-equal shell "bash") (when (string-equal shell "bash")
(add-hook 'comint-preoutput-filter-functions (add-hook 'comint-preoutput-filter-functions
'shell-filter-ctrl-a-ctrl-b nil t))) '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))) (comint-read-input-ring t)))
(defun shell-filter-ctrl-a-ctrl-b (string) (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 ;; replace it with a process filter that watches for and strips out
;; these messages. ;; 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) (defun shell-directory-tracker (str)
"Tracks cd, pushd and popd commands issued to the shell. "Tracks cd, pushd and popd commands issued to the shell.
This function is called on each input passed to the shell. This function is called on each input passed to the shell.