diff options
| -rw-r--r-- | etc/NEWS | 4 | ||||
| -rw-r--r-- | lisp/ChangeLog | 12 | ||||
| -rw-r--r-- | lisp/dirtrack.el | 126 | ||||
| -rw-r--r-- | lisp/shell.el | 30 |
4 files changed, 77 insertions, 95 deletions
| @@ -749,10 +749,6 @@ Try using `rmail-show-message-hook' instead. | |||
| 749 | directory is a remote file name and neither the environment variable | 749 | directory 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'. | ||
| 753 | If set to an appropriate regexp, Shell mode can track your cwd by | ||
| 754 | reading 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 @@ | |||
| 1 | 2012-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 | |||
| 1 | 2012-01-01 Eli Zaretskii <eliz@gnu.org> | 13 | 2012-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. |
| 124 | First item is a regexp that describes where to find the path in a prompt. | 124 | First item is a regexp that describes where to find the path in a prompt. |
| 125 | Second is a number, the regexp group to match. Optional third item is | 125 | Second is a number, the regexp group to match." |
| 126 | whether the prompt is multi-line. If nil or omitted, prompt is assumed to | ||
| 127 | be 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 | |||
| 188 | positive, and disable it otherwise. If called from Lisp, enable | 186 | positive, and disable it otherwise. If called from Lisp, enable |
| 189 | the mode if ARG is omitted or nil. | 187 | the mode if ARG is omitted or nil. |
| 190 | 188 | ||
| 191 | This method requires that your shell prompt contain the full | 189 | This method requires that your shell prompt contain the current |
| 192 | current working directory at all times, and that `dirtrack-list' | 190 | working directory at all times, and that you set the variable |
| 193 | is 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 | |
| 195 | and similar commands which change the shell working directory." | 193 | This is an alternative to `shell-dirtrack-mode', which works by |
| 194 | tracking `cd' and similar commands which change the shell working | ||
| 195 | directory." | ||
| 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. |
| 226 | The prompt to look for is the first item in `dirtrack-list'. | 226 | This filter function is used by `dirtrack-mode'. It looks for |
| 227 | 227 | the prompt specified by `dirtrack-list', and calls | |
| 228 | You can toggle directory tracking by using the function `dirtrack-mode'. | 228 | `shell-process-cd' if the directory seems to have changed away |
| 229 | 229 | from `default-directory'." | |
| 230 | If directory tracking does not seem to be working, you can use the | 230 | (when (and dirtrack-mode |
| 231 | function `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. | ||
| 377 | If your prompt includes the current directory or the last few elements of it, | ||
| 378 | set this to a pattern that matches your prompt and whose subgroup 1 matches | ||
| 379 | the directory part of it. | ||
| 380 | This is used by `shell-dir-cookie-watcher' to try and use this info | ||
| 381 | to track your current directory. It can be used instead of or in addition | ||
| 382 | to `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. |
| 729 | This function is called on each input passed to the shell. | 699 | This function is called on each input passed to the shell. |