dirtrack.el 10.7 KB
Newer Older
Richard M. Stallman's avatar
Richard M. Stallman committed
1 2
;;; dirtrack.el --- Directory Tracking by watching the prompt

3
;; Copyright (C) 1996, 2001-2011 Free Software Foundation, Inc.
Richard M. Stallman's avatar
Richard M. Stallman committed
4

Richard M. Stallman's avatar
Richard M. Stallman committed
5
;; Author: Peter Breton <pbreton@cs.umb.edu>
Richard M. Stallman's avatar
Richard M. Stallman committed
6 7 8 9 10
;; Created: Sun Nov 17 1996
;; Keywords: processes

;; This file is part of GNU Emacs.

11
;; GNU Emacs is free software: you can redistribute it and/or modify
Richard M. Stallman's avatar
Richard M. Stallman committed
12
;; it under the terms of the GNU General Public License as published by
13 14
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
Richard M. Stallman's avatar
Richard M. Stallman committed
15 16 17 18 19 20 21

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; 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/>.
Richard M. Stallman's avatar
Richard M. Stallman committed
23 24 25 26 27 28

;;; Commentary:

;; Shell directory tracking by watching the prompt.
;;
;; This is yet another attempt at a directory-tracking package for
29
;; Emacs shell-mode.  However, this package makes one strong assumption:
Richard M. Stallman's avatar
Richard M. Stallman committed
30
;; that you can customize your shell's prompt to contain the
31
;; current working directory.  Most shells do support this, including
Richard M. Stallman's avatar
Richard M. Stallman committed
32 33
;; almost every type of Bourne and C shell on Unix, the native shells on
;; 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
Richard M. Stallman's avatar
Richard M. Stallman committed
35 36 37 38 39 40 41
;; will be useless to you.
;;
;; Installation:
;;
;; 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.
Juanma Barranquero's avatar
Juanma Barranquero committed
42 43
;;
;; Note that directory tracking is done by matching regular expressions,
Richard M. Stallman's avatar
Richard M. Stallman committed
44
;; therefore it is *VERY IMPORTANT* for your prompt to be easily
45
;; distinguishable from other output.  If your prompt regexp is too general,
Richard M. Stallman's avatar
Richard M. Stallman committed
46 47 48
;; you will see error messages from the dirtrack filter as it attempts to cd
;; to non-existent directories.
;;
49
;; 2) Set the variable `dirtrack-list' to an appropriate value.  This
Richard M. Stallman's avatar
Richard M. Stallman committed
50 51
;; should be a list of two elements: the first is a regular expression
;; which matches your prompt up to and including the pathname part.
Juanma Barranquero's avatar
Juanma Barranquero committed
52
;; The second is a number which tells which regular expression group to
53 54
;; 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
Richard M. Stallman's avatar
Richard M. Stallman committed
55
;; 'comint.el' assume a single-line prompt (eg, comint-bol).
Juanma Barranquero's avatar
Juanma Barranquero committed
56
;;
Glenn Morris's avatar
Glenn Morris committed
57 58 59
;; Determining this information may take some experimentation.  Using
;; `dirtrack-debug-mode' may help; it causes the directory-tracking
;; filter to log messages to the buffer `dirtrack-debug-buffer'.
Juanma Barranquero's avatar
Juanma Barranquero committed
60
;;
Glenn Morris's avatar
Glenn Morris committed
61 62
;; 3) Activate `dirtrack-mode'.  You may wish to turn ordinary shell
;; tracking off by calling `shell-dirtrack-mode'.
Richard M. Stallman's avatar
Richard M. Stallman committed
63 64 65 66 67 68 69 70 71 72 73
;;
;; Examples:
;;
;; 1) On Windows NT, my prompt is set to emacs$S$P$G.
;; 'dirtrack-list' is set to (list "^emacs \\([a-zA-Z]:.*\\)>" 1)
;;
;; 2) On Solaris running bash, my prompt is set like this:
;;    PS1="\w\012emacs@\h(\!) [\t]% "
;;    'dirtrack-list' is set to (list "^\\([/~].*\\)\nemacs@[^%]+% *" 1 t)
;;
;; I'd appreciate other examples from people who use this package.
Juanma Barranquero's avatar
Juanma Barranquero committed
74
;;
Richard M. Stallman's avatar
Richard M. Stallman committed
75 76 77 78
;; Here's one from Stephen Eglen:
;;
;;   Running under tcsh:
;;   (setq-default dirtrack-list '("^%E \\([^ ]+\\)" 1))
Juanma Barranquero's avatar
Juanma Barranquero committed
79
;;
Richard M. Stallman's avatar
Richard M. Stallman committed
80 81 82
;;   It might be worth mentioning in your file that emacs sources start up
;;   files of the form: ~/.emacs_<SHELL> where <SHELL> is the name of the
;;   shell.  So for example, I have the following in ~/.emacs_tcsh:
Juanma Barranquero's avatar
Juanma Barranquero committed
83
;;
Richard M. Stallman's avatar
Richard M. Stallman committed
84
;;   set prompt = "%%E %~ %h% "
Juanma Barranquero's avatar
Juanma Barranquero committed
85
;;
Richard M. Stallman's avatar
Richard M. Stallman committed
86
;;   This produces a prompt of the form:
Juanma Barranquero's avatar
Juanma Barranquero committed
87 88
;;   %E /var/spool 10%
;;
Richard M. Stallman's avatar
Richard M. Stallman committed
89 90
;;   This saves me from having to use the %E prefix in other non-emacs
;;   shells.
91 92
;;
;; A final note:
Juanma Barranquero's avatar
Juanma Barranquero committed
93
;;
94 95 96 97
;;   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
;;   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 101
;;   with a ~ in it).
;;
102 103
;;   The same behavior can occur if you use dirtrack with remote filesystems
;;   (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.
Richard M. Stallman's avatar
Richard M. Stallman committed
106 107 108 109 110 111 112

;;; Code:

(eval-when-compile
  (require 'comint)
  (require 'shell))

Richard M. Stallman's avatar
Richard M. Stallman committed
113 114 115 116 117 118 119 120 121 122
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Customization Variables
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defgroup dirtrack nil
  "Directory tracking by watching the prompt."
  :prefix "dirtrack-"
  :group 'shell)

(defcustom dirtrack-list (list "^emacs \\([a-zA-Z]:.*\\)>" 1)
123
  "List for directory tracking.
Richard M. Stallman's avatar
Richard M. Stallman committed
124
First item is a regexp that describes where to find the path in a prompt.
125 126
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
Richard M. Stallman's avatar
Richard M. Stallman committed
127 128
be on a single line."
  :group 'dirtrack
Juanma Barranquero's avatar
Juanma Barranquero committed
129
  :type  '(sexp (regexp  :tag "Prompt Expression")
Richard M. Stallman's avatar
Richard M. Stallman committed
130
		(integer :tag "Regexp Group")
131
		(boolean :tag "Multiline Prompt")))
Richard M. Stallman's avatar
Richard M. Stallman committed
132 133 134

(make-variable-buffer-local 'dirtrack-list)

Richard M. Stallman's avatar
Richard M. Stallman committed
135
(defcustom dirtrack-debug nil
136
  "If non-nil, the function `dirtrack' will report debugging info."
Richard M. Stallman's avatar
Richard M. Stallman committed
137
  :group 'dirtrack
138
  :type  'boolean)
Richard M. Stallman's avatar
Richard M. Stallman committed
139

Richard M. Stallman's avatar
Richard M. Stallman committed
140
(defcustom dirtrack-debug-buffer "*Directory Tracking Log*"
Glenn Morris's avatar
Glenn Morris committed
141
  "Buffer in which to write directory tracking debug information."
Richard M. Stallman's avatar
Richard M. Stallman committed
142
  :group 'dirtrack
143
  :type  'string)
Richard M. Stallman's avatar
Richard M. Stallman committed
144

Juanma Barranquero's avatar
Juanma Barranquero committed
145
(defcustom dirtrack-directory-function
Glenn Morris's avatar
Glenn Morris committed
146
  (if (memq system-type '(ms-dos windows-nt cygwin))
Richard M. Stallman's avatar
Richard M. Stallman committed
147
      'dirtrack-windows-directory-function
148 149
    'file-name-as-directory)
  "Function to apply to the prompt directory for comparison purposes."
Richard M. Stallman's avatar
Richard M. Stallman committed
150
  :group 'dirtrack
151
  :type  'function)
Richard M. Stallman's avatar
Richard M. Stallman committed
152

Juanma Barranquero's avatar
Juanma Barranquero committed
153
(defcustom dirtrack-canonicalize-function
Glenn Morris's avatar
Glenn Morris committed
154
  (if (memq system-type '(ms-dos windows-nt cygwin))
Richard M. Stallman's avatar
Richard M. Stallman committed
155
      'downcase 'identity)
156
  "Function to apply to the default directory for comparison purposes."
Richard M. Stallman's avatar
Richard M. Stallman committed
157
  :group 'dirtrack
158
  :type  'function)
Richard M. Stallman's avatar
Richard M. Stallman committed
159

160 161 162
(defcustom dirtrack-directory-change-hook nil
  "Hook that is called when a directory change is made."
  :group 'dirtrack
163
  :type 'hook)
164 165


Richard M. Stallman's avatar
Richard M. Stallman committed
166 167 168
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Richard M. Stallman's avatar
Richard M. Stallman committed
169 170 171 172


(defun dirtrack-windows-directory-function (dir)
  "Return a canonical directory for comparison purposes.
Juanma Barranquero's avatar
Juanma Barranquero committed
173
Such a directory is all lowercase, has forward-slashes as delimiters,
Richard M. Stallman's avatar
Richard M. Stallman committed
174
and ends with a forward slash."
175
  (file-name-as-directory (downcase (subst-char-in-string ?\\ ?/ dir))))
Richard M. Stallman's avatar
Richard M. Stallman committed
176

Peter Breton's avatar
Peter Breton committed
177 178 179 180 181 182
(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))

Glenn Morris's avatar
Glenn Morris committed
183 184 185 186

;;;###autoload
(define-minor-mode dirtrack-mode
  "Enable or disable Dirtrack directory tracking in a shell buffer.
Glenn Morris's avatar
Glenn Morris committed
187 188 189 190 191
This method requires that your shell prompt contain the full
current working directory at all times, and that `dirtrack-list'
is set to match the prompt.  This is an alternative to
`shell-dirtrack-mode', which works differently, by tracking `cd'
and similar commands which change the shell working directory."
Glenn Morris's avatar
Glenn Morris committed
192 193
  nil nil nil
  (if dirtrack-mode
194
      (add-hook 'comint-preoutput-filter-functions 'dirtrack nil t)
Glenn Morris's avatar
Glenn Morris committed
195
    (remove-hook 'comint-preoutput-filter-functions 'dirtrack t)))
Richard M. Stallman's avatar
Richard M. Stallman committed
196

Glenn Morris's avatar
Glenn Morris committed
197 198 199 200 201
(define-obsolete-function-alias 'dirtrack-toggle 'dirtrack-mode "23.1")
(define-obsolete-variable-alias 'dirtrackp 'dirtrack-mode "23.1")


(define-minor-mode dirtrack-debug-mode
202
  "Enable or disable Dirtrack debugging."
Glenn Morris's avatar
Glenn Morris committed
203 204 205 206 207 208 209 210
  nil nil nil
  (if dirtrack-debug-mode
      (display-buffer (get-buffer-create dirtrack-debug-buffer))))

(define-obsolete-function-alias 'dirtrack-debug-toggle 'dirtrack-debug-mode
  "23.1")
(define-obsolete-variable-alias 'dirtrack-debug 'dirtrack-debug-mode "23.1")

211

Richard M. Stallman's avatar
Richard M. Stallman committed
212
(defun dirtrack-debug-message (string)
Glenn Morris's avatar
Glenn Morris committed
213 214 215 216 217
  "Insert string at the end of `dirtrack-debug-buffer'."
  (when dirtrack-debug-mode
    (with-current-buffer (get-buffer-create dirtrack-debug-buffer)
      (goto-char (point-max))
      (insert (concat string "\n")))))
Richard M. Stallman's avatar
Richard M. Stallman committed
218 219 220

;;;###autoload
(defun dirtrack (input)
221 222 223
  "Determine the current directory by scanning the process output for a prompt.
The prompt to look for is the first item in `dirtrack-list'.

Glenn Morris's avatar
Glenn Morris committed
224
You can toggle directory tracking by using the function `dirtrack-mode'.
225 226

If directory tracking does not seem to be working, you can use the
Glenn Morris's avatar
Glenn Morris committed
227 228 229
function `dirtrack-debug-mode' to turn on debugging output."
  (unless (or (null dirtrack-mode)
              (eq (point) (point-min)))     ; no output?
230
    (let (prompt-path orig-prompt-path
Richard M. Stallman's avatar
Richard M. Stallman committed
231
	  (current-dir default-directory)
232
	  (dirtrack-regexp    (nth 0 dirtrack-list))
233
	  (match-num	      (nth 1 dirtrack-list)))
234
          ;; Currently unimplemented, it seems.  --Stef
235
	  ;; (multi-line      (nth 2 dirtrack-list)))
236 237
      (save-excursion
        ;; No match
Glenn Morris's avatar
Glenn Morris committed
238 239
        (if (not (string-match dirtrack-regexp input))
            (dirtrack-debug-message
Chong Yidong's avatar
Chong Yidong committed
240
             (format "Input `%s' failed to match `dirtrack-list'" input))
241 242 243
          (setq prompt-path (match-string match-num input))
          ;; Empty string
          (if (not (> (length prompt-path) 0))
Glenn Morris's avatar
Glenn Morris committed
244
              (dirtrack-debug-message "Match is empty string")
245
            ;; Transform prompts into canonical forms
246 247 248
            (setq orig-prompt-path (funcall dirtrack-directory-function
                                            prompt-path)
                  prompt-path (shell-prefixed-directory-name orig-prompt-path)
Glenn Morris's avatar
Glenn Morris committed
249
                  current-dir (funcall dirtrack-canonicalize-function
250
                                       current-dir))
Glenn Morris's avatar
Glenn Morris committed
251 252 253
            (dirtrack-debug-message
             (format "Prompt is %s\nCurrent directory is %s"
                     prompt-path current-dir))
254 255
            ;; Compare them
            (if (or (string= current-dir prompt-path)
Glenn Morris's avatar
Glenn Morris committed
256 257
                    (string= current-dir (abbreviate-file-name prompt-path)))
                (dirtrack-debug-message (format "Not changing directory"))
258 259 260
              ;; It's possible that Emacs will think the directory
              ;; won't exist (eg, rlogin buffers)
              (if (file-accessible-directory-p prompt-path)
261 262 263
                  ;; Change directory. shell-process-cd adds the prefix, so we
                  ;; need to give it the original (un-prefixed) path.
                  (and (shell-process-cd orig-prompt-path)
264 265 266
                       (run-hooks 'dirtrack-directory-change-hook)
                       (dirtrack-debug-message
                        (format "Changing directory to %s" prompt-path)))
267
                (warn "Directory %s does not exist" prompt-path)))
268
            )))))
269
  input)
Richard M. Stallman's avatar
Richard M. Stallman committed
270 271 272 273

(provide 'dirtrack)

;;; dirtrack.el ends here