Function: dirtrack

dirtrack is an autoloaded and byte-compiled function defined in dirtrack.el.gz.

Signature

(dirtrack INPUT)

Documentation

Determine the current directory from the process output for a prompt.

This filter function is used by dirtrack-mode(var)/dirtrack-mode(fun). 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.

Probably introduced at or before Emacs version 20.1.

Source Code

;; Defined in /usr/src/emacs/lisp/dirtrack.el.gz
;;;###autoload
(defun dirtrack (input)
  "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)