X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/4dfb07fd3252bf91cb18e8058341e879d2fefa5e..937640a621a4ce2e5e56eaecca37a2a28a584318:/lisp/dirtrack.el diff --git a/lisp/dirtrack.el b/lisp/dirtrack.el index 572435d357..41aea04988 100644 --- a/lisp/dirtrack.el +++ b/lisp/dirtrack.el @@ -5,7 +5,6 @@ ;; Author: Peter Breton ;; Created: Sun Nov 17 1996 ;; Keywords: processes -;; Time-stamp: <1999-02-21 01:27:24 pbreton> ;; This file is part of GNU Emacs. @@ -42,8 +41,8 @@ ;; 1) Set your shell's prompt to contain the current working directory. ;; You may need to consult your shell's documentation to find out how to ;; do this. -;; -;; Note that directory tracking is done by matching regular expressions, +;; +;; Note that directory tracking is done by matching regular expressions, ;; therefore it is *VERY IMPORTANT* for your prompt to be easily ;; distinguishable from other output. If your prompt regexp is too general, ;; you will see error messages from the dirtrack filter as it attempts to cd @@ -52,16 +51,16 @@ ;; 2) Set the variable `dirtrack-list' to an appropriate value. This ;; should be a list of two elements: the first is a regular expression ;; which matches your prompt up to and including the pathname part. -;; The second is a number which tells which regular expression group to +;; The second is a number which tells which regular expression group to ;; match to extract only the pathname. If you use a multi-line prompt, ;; add 't' as a third element. Note that some of the functions in ;; 'comint.el' assume a single-line prompt (eg, comint-bol). -;; +;; ;; Determining this information may take some experimentation. Setting ;; the variable `dirtrack-debug' may help; it causes the directory-tracking ;; filter to log messages to the buffer `dirtrack-debug-buffer'. You can easily ;; toggle this setting with the `dirtrack-debug-toggle' function. -;; +;; ;; 3) Add a hook to shell-mode to enable the directory tracking: ;; ;; (add-hook 'shell-mode-hook @@ -83,26 +82,26 @@ ;; 'dirtrack-list' is set to (list "^\\([/~].*\\)\nemacs@[^%]+% *" 1 t) ;; ;; I'd appreciate other examples from people who use this package. -;; +;; ;; Here's one from Stephen Eglen: ;; ;; Running under tcsh: ;; (setq-default dirtrack-list '("^%E \\([^ ]+\\)" 1)) -;; +;; ;; It might be worth mentioning in your file that emacs sources start up ;; files of the form: ~/.emacs_ where is the name of the ;; shell. So for example, I have the following in ~/.emacs_tcsh: -;; +;; ;; set prompt = "%%E %~ %h% " -;; +;; ;; This produces a prompt of the form: -;; %E /var/spool 10% -;; +;; %E /var/spool 10% +;; ;; This saves me from having to use the %E prefix in other non-emacs ;; shells. ;; ;; A final note: -;; +;; ;; I run LOTS of shell buffers through Emacs, sometimes as different users ;; (eg, when logged in as myself, I'll run a root shell in the same Emacs). ;; If you do this, and the shell prompt contains a ~, Emacs will interpret @@ -134,11 +133,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 +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." :group 'dirtrack - :type '(sexp (regexp :tag "Prompt Expression") + :type '(sexp (regexp :tag "Prompt Expression") (integer :tag "Regexp Group") (boolean :tag "Multiline Prompt") ) @@ -166,8 +165,8 @@ be on a single line." (make-variable-buffer-local 'dirtrackp) -(defcustom dirtrack-directory-function - (if (memq system-type (list 'ms-dos 'windows-nt)) +(defcustom dirtrack-directory-function + (if (memq system-type (list 'ms-dos 'windows-nt 'cygwin)) 'dirtrack-windows-directory-function 'dirtrack-default-directory-function) "*Function to apply to the prompt directory for comparison purposes." @@ -175,8 +174,8 @@ be on a single line." :type 'function ) -(defcustom dirtrack-canonicalize-function - (if (memq system-type (list 'ms-dos 'windows-nt)) +(defcustom dirtrack-canonicalize-function + (if (memq system-type (list 'ms-dos 'windows-nt 'cygwin)) 'downcase 'identity) "*Function to apply to the default directory for comparison purposes." :group 'dirtrack @@ -204,7 +203,7 @@ Such a directory ends with a forward slash." (defun dirtrack-windows-directory-function (dir) "Return a canonical directory for comparison purposes. -Such a directory is all lowercase, has forward-slashes as delimiters, +Such a directory is all lowercase, has forward-slashes as delimiters, and ends with a forward slash." (let ((directory dir)) (setq directory (downcase (dirtrack-replace-slash directory t))) @@ -212,18 +211,24 @@ and ends with a forward slash." (concat directory "/") directory))) +(defun dirtrack-cygwin-directory-function (dir) + "Return a canonical directory taken from a Cygwin path for comparison purposes." + (if (string-match "/cygdrive/\\([A-Z]\\)\\(.*\\)" dir) + (concat (match-string 1 dir) ":" (match-string 2 dir)) + dir)) + (defconst dirtrack-forward-slash (regexp-quote "/")) (defconst dirtrack-backward-slash (regexp-quote "\\")) (defun dirtrack-replace-slash (string &optional opposite) "Replace forward slashes with backwards ones. -If additional argument is non-nil, replace backwards slashes with +If additional argument is non-nil, replace backwards slashes with forward ones." - (let ((orig (if opposite - dirtrack-backward-slash + (let ((orig (if opposite + dirtrack-backward-slash dirtrack-forward-slash)) - (replace (if opposite - dirtrack-forward-slash + (replace (if opposite + dirtrack-forward-slash dirtrack-backward-slash)) (newstring string) ) @@ -266,7 +271,7 @@ You can toggle directory tracking by using the function `dirtrack-toggle'. If directory tracking does not seem to be working, you can use the function `dirtrack-debug-toggle' to turn on debugging output. -You can enable directory tracking by adding this function to +You can enable directory tracking by adding this function to `comint-output-filter-functions'. " (if (null dirtrackp) @@ -286,33 +291,33 @@ You can enable directory tracking by adding this function to ;; No match (if (null matched) (and dirtrack-debug - (dirtrack-debug-message - (format - "Input `%s' failed to match regexp: %s" + (dirtrack-debug-message + (format + "Input `%s' failed to match regexp: %s" input dirtrack-regexp))) - (setq prompt-path + (setq prompt-path (substring input (match-beginning match-num) (match-end match-num))) ;; Empty string (if (not (> (length prompt-path) 0)) (and dirtrack-debug - (dirtrack-debug-message "Match is empty string")) + (dirtrack-debug-message "Match is empty string")) ;; Transform prompts into canonical forms (setq prompt-path (funcall dirtrack-directory-function prompt-path)) (setq current-dir (funcall dirtrack-canonicalize-function current-dir)) (and dirtrack-debug - (dirtrack-debug-message + (dirtrack-debug-message (format "Prompt is %s\nCurrent directory is %s" - prompt-path current-dir))) + prompt-path current-dir))) ;; Compare them (if (or (string= current-dir prompt-path) - (string= current-dir + (string= current-dir (abbreviate-file-name prompt-path))) (and dirtrack-debug - (dirtrack-debug-message + (dirtrack-debug-message (format "Not changing directory"))) ;; It's possible that Emacs will think the directory ;; won't exist (eg, rlogin buffers) @@ -321,7 +326,7 @@ You can enable directory tracking by adding this function to (and (shell-process-cd prompt-path) (run-hooks 'dirtrack-directory-change-hook) dirtrack-debug - (dirtrack-debug-message + (dirtrack-debug-message (format "Changing directory to %s" prompt-path))) (error "Directory %s does not exist" prompt-path))) ))))) @@ -329,4 +334,5 @@ You can enable directory tracking by adding this function to (provide 'dirtrack) +;;; arch-tag: 168de071-be88-4937-aff6-2aba9f328d5a ;;; dirtrack.el ends here