lisp/desktop.el (desktop-clear): Fix previous change.
[emacs.git] / lisp / dirtrack.el
blobe73cf279e510a72a41befe0f997c7dfbcc97aa39
1 ;;; dirtrack.el --- Directory Tracking by watching the prompt
3 ;; Copyright (C) 1996, 2001-2013 Free Software Foundation, Inc.
5 ;; Author: Peter Breton <pbreton@cs.umb.edu>
6 ;; Created: Sun Nov 17 1996
7 ;; Keywords: processes
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software: you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation, either version 3 of the License, or
14 ;; (at your option) any later version.
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
24 ;;; Commentary:
26 ;; Shell directory tracking by watching the prompt.
28 ;; This is yet another attempt at a directory-tracking package for
29 ;; Emacs shell-mode. However, this package makes one strong assumption:
30 ;; that you can customize your shell's prompt to contain the
31 ;; current working directory. Most shells do support this, including
32 ;; almost every type of Bourne and C shell on Unix, the native shells on
33 ;; Windows95 (COMMAND.COM) and Windows NT (CMD.EXE), and most 3rd party
34 ;; Windows shells. If you cannot do this, or do not wish to, this package
35 ;; will be useless to you.
37 ;; Installation:
39 ;; 1) Set your shell's prompt to contain the current working directory.
40 ;; You may need to consult your shell's documentation to find out how to
41 ;; do this.
43 ;; Note that directory tracking is done by matching regular expressions,
44 ;; therefore it is *VERY IMPORTANT* for your prompt to be easily
45 ;; distinguishable from other output. If your prompt regexp is too general,
46 ;; you will see error messages from the dirtrack filter as it attempts to cd
47 ;; to non-existent directories.
49 ;; 2) Set the variable `dirtrack-list' to an appropriate value. This
50 ;; should be a list of two elements: the first is a regular expression
51 ;; which matches your prompt up to and including the pathname part.
52 ;; The second is a number which tells which regular expression group to
53 ;; match to extract only the pathname. If you use a multi-line prompt,
54 ;; add 't' as a third element. Note that some of the functions in
55 ;; 'comint.el' assume a single-line prompt (eg, comint-bol).
57 ;; Determining this information may take some experimentation. Using
58 ;; `dirtrack-debug-mode' may help; it causes the directory-tracking
59 ;; filter to log messages to the buffer `dirtrack-debug-buffer'.
61 ;; 3) Activate `dirtrack-mode'. You may wish to turn ordinary shell
62 ;; tracking off by calling `shell-dirtrack-mode'.
64 ;; Examples:
66 ;; 1) On Windows NT, my prompt is set to emacs$S$P$G.
67 ;; 'dirtrack-list' is set to (list "^emacs \\([a-zA-Z]:.*\\)>" 1)
69 ;; 2) On Solaris running bash, my prompt is set like this:
70 ;; PS1="\w\012emacs@\h(\!) [\t]% "
71 ;; 'dirtrack-list' is set to (list "^\\([/~].*\\)\nemacs@[^%]+% *" 1 t)
73 ;; I'd appreciate other examples from people who use this package.
75 ;; Here's one from Stephen Eglen:
77 ;; Running under tcsh:
78 ;; (setq-default dirtrack-list '("^%E \\([^ ]+\\)" 1))
80 ;; It might be worth mentioning in your file that emacs sources start up
81 ;; files of the form: ~/.emacs_<SHELL> where <SHELL> is the name of the
82 ;; shell. So for example, I have the following in ~/.emacs_tcsh:
84 ;; set prompt = "%%E %~ %h% "
86 ;; This produces a prompt of the form:
87 ;; %E /var/spool 10%
89 ;; This saves me from having to use the %E prefix in other non-emacs
90 ;; shells.
92 ;; A final note:
94 ;; I run LOTS of shell buffers through Emacs, sometimes as different users
95 ;; (eg, when logged in as myself, I'll run a root shell in the same Emacs).
96 ;; If you do this, and the shell prompt contains a ~, Emacs will interpret
97 ;; this relative to the user which owns the Emacs process, not the user
98 ;; who owns the shell buffer. This may cause dirtrack to behave strangely
99 ;; (typically it reports that it is unable to cd to a directory
100 ;; with a ~ in it).
102 ;; The same behavior can occur if you use dirtrack with remote filesystems
103 ;; (using telnet, rlogin, etc) as Emacs will be checking the local
104 ;; filesystem, not the remote one. This problem is not specific to dirtrack,
105 ;; but also affects file completion, etc.
107 ;;; Code:
109 (eval-when-compile
110 (require 'comint)
111 (require 'shell))
113 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
114 ;; Customization Variables
115 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
117 (defgroup dirtrack nil
118 "Directory tracking by watching the prompt."
119 :prefix "dirtrack-"
120 :group 'shell)
122 (defcustom dirtrack-list (list "^emacs \\([a-zA-Z]:.*\\)>" 1)
123 "List for directory tracking.
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."
126 :group 'dirtrack
127 :type '(sexp (regexp :tag "Prompt Expression")
128 (integer :tag "Regexp Group"))
129 :version "24.1")
131 (make-variable-buffer-local 'dirtrack-list)
133 (defcustom dirtrack-debug nil
134 "If non-nil, the function `dirtrack' will report debugging info."
135 :group 'dirtrack
136 :type 'boolean)
138 (defcustom dirtrack-debug-buffer "*Directory Tracking Log*"
139 "Buffer in which to write directory tracking debug information."
140 :group 'dirtrack
141 :type 'string)
143 (defcustom dirtrack-directory-function
144 (if (memq system-type '(ms-dos windows-nt cygwin))
145 'dirtrack-windows-directory-function
146 'file-name-as-directory)
147 "Function to apply to the prompt directory for comparison purposes."
148 :group 'dirtrack
149 :type 'function)
151 (defcustom dirtrack-canonicalize-function
152 (if (memq system-type '(ms-dos windows-nt cygwin))
153 'downcase 'identity)
154 "Function to apply to the default directory for comparison purposes."
155 :group 'dirtrack
156 :type 'function)
158 (defcustom dirtrack-directory-change-hook nil
159 "Hook that is called when a directory change is made."
160 :group 'dirtrack
161 :type 'hook)
164 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
165 ;; Functions
166 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
169 (defun dirtrack-windows-directory-function (dir)
170 "Return a canonical directory for comparison purposes.
171 Such a directory is all lowercase, has forward-slashes as delimiters,
172 and ends with a forward slash."
173 (file-name-as-directory (downcase (subst-char-in-string ?\\ ?/ dir))))
175 (defun dirtrack-cygwin-directory-function (dir)
176 "Return a canonical directory taken from a Cygwin path for comparison purposes."
177 (if (string-match "/cygdrive/\\([A-Z]\\)\\(.*\\)" dir)
178 (concat (match-string 1 dir) ":" (match-string 2 dir))
179 dir))
182 (define-obsolete-function-alias 'dirtrack-toggle 'dirtrack-mode "23.1")
183 (define-obsolete-variable-alias 'dirtrackp 'dirtrack-mode "23.1")
184 ;;;###autoload
185 (define-minor-mode dirtrack-mode
186 "Toggle directory tracking in shell buffers (Dirtrack mode).
187 With a prefix argument ARG, enable Dirtrack mode if ARG is
188 positive, and disable it otherwise. If called from Lisp, enable
189 the mode if ARG is omitted or nil.
191 This method requires that your shell prompt contain the current
192 working directory at all times, and that you set the variable
193 `dirtrack-list' to match the prompt.
195 This is an alternative to `shell-dirtrack-mode', which works by
196 tracking `cd' and similar commands which change the shell working
197 directory."
198 nil nil nil
199 (if dirtrack-mode
200 (add-hook 'comint-preoutput-filter-functions 'dirtrack nil t)
201 (remove-hook 'comint-preoutput-filter-functions 'dirtrack t)))
204 (define-obsolete-function-alias 'dirtrack-debug-toggle 'dirtrack-debug-mode
205 "23.1")
206 (define-obsolete-variable-alias 'dirtrack-debug 'dirtrack-debug-mode "23.1")
207 (define-minor-mode dirtrack-debug-mode
208 "Toggle Dirtrack debugging.
209 With a prefix argument ARG, enable Dirtrack debugging if ARG is
210 positive, and disable it otherwise. If called from Lisp, enable
211 the mode if ARG is omitted or nil."
212 nil nil nil
213 (if dirtrack-debug-mode
214 (display-buffer (get-buffer-create dirtrack-debug-buffer))))
216 (defun dirtrack-debug-message (msg1 msg2)
217 "Insert strings at the end of `dirtrack-debug-buffer'."
218 (when dirtrack-debug-mode
219 (with-current-buffer (get-buffer-create dirtrack-debug-buffer)
220 (goto-char (point-max))
221 (insert msg1 msg2 "\n"))))
223 (declare-function shell-prefixed-directory-name "shell" (dir))
224 (declare-function shell-process-cd "shell" (arg))
226 ;;;###autoload
227 (defun dirtrack (input)
228 "Determine the current directory from the process output for a prompt.
229 This filter function is used by `dirtrack-mode'. It looks for
230 the prompt specified by `dirtrack-list', and calls
231 `shell-process-cd' if the directory seems to have changed away
232 from `default-directory'."
233 (when (and dirtrack-mode
234 (not (eq (point) (point-min)))) ; there must be output
235 (save-excursion ; What's this for? -- cyd
236 (if (not (string-match (nth 0 dirtrack-list) input))
237 ;; No match
238 (dirtrack-debug-message
239 "Input failed to match `dirtrack-list': " input)
240 (let ((prompt-path (match-string (nth 1 dirtrack-list) input))
241 temp)
242 (cond
243 ;; Don't do anything for empty string
244 ((string-equal prompt-path "")
245 (dirtrack-debug-message "Prompt match gives empty string: " input))
246 ;; If the prompt contains an absolute file name, call
247 ;; `shell-process-cd' if the directory has changed.
248 ((file-name-absolute-p prompt-path)
249 ;; Transform prompts into canonical forms
250 (let ((orig-prompt-path (funcall dirtrack-directory-function
251 prompt-path))
252 (current-dir (funcall dirtrack-canonicalize-function
253 default-directory)))
254 (setq prompt-path (shell-prefixed-directory-name orig-prompt-path))
255 ;; Compare them
256 (if (or (string-equal current-dir prompt-path)
257 (string-equal (expand-file-name current-dir)
258 (expand-file-name prompt-path)))
259 (dirtrack-debug-message "Not changing directory: " current-dir)
260 ;; It's possible that Emacs thinks the directory
261 ;; doesn't exist (e.g. rlogin buffers)
262 (if (file-accessible-directory-p prompt-path)
263 ;; `shell-process-cd' adds the prefix, so we need
264 ;; to give it the original (un-prefixed) path.
265 (progn
266 (shell-process-cd orig-prompt-path)
267 (run-hooks 'dirtrack-directory-change-hook)
268 (dirtrack-debug-message "Changing directory to "
269 prompt-path))
270 (dirtrack-debug-message "Not changing to non-existent directory: "
271 prompt-path)))))
272 ;; If the file name is non-absolute, try and see if it
273 ;; seems to be up or down from where we were.
274 ((string-match "\\`\\(.*\\)\\(?:/.*\\)?\n\\(.*/\\)\\1\\(?:/.*\\)?\\'"
275 (setq temp
276 (concat prompt-path "\n" default-directory)))
277 (shell-process-cd (concat (match-string 2 temp)
278 prompt-path))
279 (run-hooks 'dirtrack-directory-change-hook)))))))
280 input)
282 (provide 'dirtrack)
284 ;;; dirtrack.el ends here