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

Paul Eggert's avatar
Paul Eggert committed
3
;; Copyright (C) 1996, 2001-2019 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 <https://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
;; 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
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
Second is a number, the regexp group to match."
Richard M. Stallman's avatar
Richard M. Stallman committed
126
  :group 'dirtrack
Juanma Barranquero's avatar
Juanma Barranquero committed
127
  :type  '(sexp (regexp  :tag "Prompt Expression")
128 129
		(integer :tag "Regexp Group"))
  :version "24.1")
Richard M. Stallman's avatar
Richard M. Stallman committed
130 131 132

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

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

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

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

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

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


Richard M. Stallman's avatar
Richard M. Stallman committed
164 165 166
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Richard M. Stallman's avatar
Richard M. Stallman committed
167 168 169 170


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

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

;;;###autoload
(define-minor-mode dirtrack-mode
184 185
  "Toggle directory tracking in shell buffers (Dirtrack mode).

186 187 188 189 190 191 192
This method requires that your shell prompt contain the current
working directory at all times, and that you set the variable
`dirtrack-list' to match the prompt.

This is an alternative to `shell-dirtrack-mode', which works by
tracking `cd' and similar commands which change the shell working
directory."
Glenn Morris's avatar
Glenn Morris committed
193 194
  nil nil nil
  (if dirtrack-mode
195
      (add-hook 'comint-preoutput-filter-functions 'dirtrack nil t)
Glenn Morris's avatar
Glenn Morris committed
196
    (remove-hook 'comint-preoutput-filter-functions 'dirtrack t)))
Richard M. Stallman's avatar
Richard M. Stallman committed
197

Glenn Morris's avatar
Glenn Morris committed
198

199 200 201
(define-obsolete-function-alias 'dirtrack-debug-toggle 'dirtrack-debug-mode
  "23.1")
(define-obsolete-variable-alias 'dirtrack-debug 'dirtrack-debug-mode "23.1")
Glenn Morris's avatar
Glenn Morris committed
202
(define-minor-mode dirtrack-debug-mode
203
  "Toggle Dirtrack debugging."
Glenn Morris's avatar
Glenn Morris committed
204 205 206 207
  nil nil nil
  (if dirtrack-debug-mode
      (display-buffer (get-buffer-create dirtrack-debug-buffer))))

208 209
(defun dirtrack-debug-message (msg1 msg2)
  "Insert strings at the end of `dirtrack-debug-buffer'."
Glenn Morris's avatar
Glenn Morris committed
210 211 212
  (when dirtrack-debug-mode
    (with-current-buffer (get-buffer-create dirtrack-debug-buffer)
      (goto-char (point-max))
213
      (insert (substitute-command-keys msg1) msg2 "\n"))))
Richard M. Stallman's avatar
Richard M. Stallman committed
214

215 216 217
(declare-function shell-prefixed-directory-name "shell" (dir))
(declare-function shell-process-cd "shell" (arg))

Richard M. Stallman's avatar
Richard M. Stallman committed
218 219
;;;###autoload
(defun dirtrack (input)
220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271
  "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)))))))
272
  input)
Richard M. Stallman's avatar
Richard M. Stallman committed
273 274 275 276

(provide 'dirtrack)

;;; dirtrack.el ends here