1;;; dirtrack.el --- Directory Tracking by watching the prompt 2 3;; Copyright (C) 1996, 2001, 2002, 2003, 2004, 2005, 4;; 2006, 2007 Free Software Foundation, Inc. 5 6;; Author: Peter Breton <pbreton@cs.umb.edu> 7;; Created: Sun Nov 17 1996 8;; Keywords: processes 9 10;; This file is part of GNU Emacs. 11 12;; GNU Emacs is free software; you can redistribute it and/or modify 13;; it under the terms of the GNU General Public License as published by 14;; the Free Software Foundation; either version 2, or (at your option) 15;; any later version. 16 17;; GNU Emacs is distributed in the hope that it will be useful, 18;; but WITHOUT ANY WARRANTY; without even the implied warranty of 19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 20;; GNU General Public License for more details. 21 22;; You should have received a copy of the GNU General Public License 23;; along with GNU Emacs; see the file COPYING. If not, write to the 24;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 25;; Boston, MA 02110-1301, USA. 26 27;;; Commentary: 28 29;; Shell directory tracking by watching the prompt. 30;; 31;; This is yet another attempt at a directory-tracking package for 32;; Emacs shell-mode. However, this package makes one strong assumption: 33;; that you can customize your shell's prompt to contain the 34;; current working directory. Most shells do support this, including 35;; almost every type of Bourne and C shell on Unix, the native shells on 36;; Windows95 (COMMAND.COM) and Windows NT (CMD.EXE), and most 3rd party 37;; Windows shells. If you cannot do this, or do not wish to, this package 38;; will be useless to you. 39;; 40;; Installation: 41;; 42;; 1) Set your shell's prompt to contain the current working directory. 43;; You may need to consult your shell's documentation to find out how to 44;; do this. 45;; 46;; Note that directory tracking is done by matching regular expressions, 47;; therefore it is *VERY IMPORTANT* for your prompt to be easily 48;; distinguishable from other output. If your prompt regexp is too general, 49;; you will see error messages from the dirtrack filter as it attempts to cd 50;; to non-existent directories. 51;; 52;; 2) Set the variable `dirtrack-list' to an appropriate value. This 53;; should be a list of two elements: the first is a regular expression 54;; which matches your prompt up to and including the pathname part. 55;; The second is a number which tells which regular expression group to 56;; match to extract only the pathname. If you use a multi-line prompt, 57;; add 't' as a third element. Note that some of the functions in 58;; 'comint.el' assume a single-line prompt (eg, comint-bol). 59;; 60;; Determining this information may take some experimentation. Setting 61;; the variable `dirtrack-debug' may help; it causes the directory-tracking 62;; filter to log messages to the buffer `dirtrack-debug-buffer'. You can easily 63;; toggle this setting with the `dirtrack-debug-toggle' function. 64;; 65;; 3) Add a hook to shell-mode to enable the directory tracking: 66;; 67;; (add-hook 'shell-mode-hook 68;; (lambda () (add-hook 'comint-preoutput-filter-functions 'dirtrack nil t))) 69;; 70;; You may wish to turn ordinary shell tracking off by calling 71;; `shell-dirtrack-toggle' or setting `shell-dirtrackp'. 72;; 73;; Examples: 74;; 75;; 1) On Windows NT, my prompt is set to emacs$S$P$G. 76;; 'dirtrack-list' is set to (list "^emacs \\([a-zA-Z]:.*\\)>" 1) 77;; 78;; 2) On Solaris running bash, my prompt is set like this: 79;; PS1="\w\012emacs@\h(\!) [\t]% " 80;; 'dirtrack-list' is set to (list "^\\([/~].*\\)\nemacs@[^%]+% *" 1 t) 81;; 82;; I'd appreciate other examples from people who use this package. 83;; 84;; Here's one from Stephen Eglen: 85;; 86;; Running under tcsh: 87;; (setq-default dirtrack-list '("^%E \\([^ ]+\\)" 1)) 88;; 89;; It might be worth mentioning in your file that emacs sources start up 90;; files of the form: ~/.emacs_<SHELL> where <SHELL> is the name of the 91;; shell. So for example, I have the following in ~/.emacs_tcsh: 92;; 93;; set prompt = "%%E %~ %h% " 94;; 95;; This produces a prompt of the form: 96;; %E /var/spool 10% 97;; 98;; This saves me from having to use the %E prefix in other non-emacs 99;; shells. 100;; 101;; A final note: 102;; 103;; I run LOTS of shell buffers through Emacs, sometimes as different users 104;; (eg, when logged in as myself, I'll run a root shell in the same Emacs). 105;; If you do this, and the shell prompt contains a ~, Emacs will interpret 106;; this relative to the user which owns the Emacs process, not the user 107;; who owns the shell buffer. This may cause dirtrack to behave strangely 108;; (typically it reports that it is unable to cd to a directory 109;; with a ~ in it). 110;; 111;; The same behavior can occur if you use dirtrack with remote filesystems 112;; (using telnet, rlogin, etc) as Emacs will be checking the local 113;; filesystem, not the remote one. This problem is not specific to dirtrack, 114;; but also affects file completion, etc. 115 116;;; Code: 117 118(eval-when-compile 119 (require 'comint) 120 (require 'shell)) 121 122;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 123;; Customization Variables 124;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 125 126(defgroup dirtrack nil 127 "Directory tracking by watching the prompt." 128 :prefix "dirtrack-" 129 :group 'shell) 130 131(defcustom dirtrack-list (list "^emacs \\([a-zA-Z]:.*\\)>" 1) 132 "List for directory tracking. 133First item is a regexp that describes where to find the path in a prompt. 134Second is a number, the regexp group to match. Optional third item is 135whether the prompt is multi-line. If nil or omitted, prompt is assumed to 136be on a single line." 137 :group 'dirtrack 138 :type '(sexp (regexp :tag "Prompt Expression") 139 (integer :tag "Regexp Group") 140 (boolean :tag "Multiline Prompt"))) 141 142(make-variable-buffer-local 'dirtrack-list) 143 144(defcustom dirtrack-debug nil 145 "If non-nil, the function `dirtrack' will report debugging info." 146 :group 'dirtrack 147 :type 'boolean) 148 149(defcustom dirtrack-debug-buffer "*Directory Tracking Log*" 150 "Buffer to write directory tracking debug information." 151 :group 'dirtrack 152 :type 'string) 153 154(defcustom dirtrackp t 155 "If non-nil, directory tracking via `dirtrack' is enabled." 156 :group 'dirtrack 157 :type 'boolean) 158 159(make-variable-buffer-local 'dirtrackp) 160 161(defcustom dirtrack-directory-function 162 (if (memq system-type (list 'ms-dos 'windows-nt 'cygwin)) 163 'dirtrack-windows-directory-function 164 'file-name-as-directory) 165 "Function to apply to the prompt directory for comparison purposes." 166 :group 'dirtrack 167 :type 'function) 168 169(defcustom dirtrack-canonicalize-function 170 (if (memq system-type (list 'ms-dos 'windows-nt 'cygwin)) 171 'downcase 'identity) 172 "Function to apply to the default directory for comparison purposes." 173 :group 'dirtrack 174 :type 'function) 175 176(defcustom dirtrack-directory-change-hook nil 177 "Hook that is called when a directory change is made." 178 :group 'dirtrack 179 :type 'hook) 180 181 182;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 183;; Functions 184;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 185 186 187(defun dirtrack-windows-directory-function (dir) 188 "Return a canonical directory for comparison purposes. 189Such a directory is all lowercase, has forward-slashes as delimiters, 190and ends with a forward slash." 191 (file-name-as-directory (downcase (subst-char-in-string ?\\ ?/ dir)))) 192 193(defun dirtrack-cygwin-directory-function (dir) 194 "Return a canonical directory taken from a Cygwin path for comparison purposes." 195 (if (string-match "/cygdrive/\\([A-Z]\\)\\(.*\\)" dir) 196 (concat (match-string 1 dir) ":" (match-string 2 dir)) 197 dir)) 198 199;; Copied from shell.el 200(defun dirtrack-toggle () 201 "Enable or disable Dirtrack directory tracking in a shell buffer." 202 (interactive) 203 (if (setq dirtrackp (not dirtrackp)) 204 (add-hook 'comint-preoutput-filter-functions 'dirtrack nil t) 205 (remove-hook 'comint-preoutput-filter-functions 'dirtrack t)) 206 (message "Directory tracking %s" (if dirtrackp "ON" "OFF"))) 207 208(defun dirtrack-debug-toggle () 209 "Enable or disable Dirtrack debugging." 210 (interactive) 211 (setq dirtrack-debug (not dirtrack-debug)) 212 (message "Directory debugging %s" (if dirtrack-debug "ON" "OFF")) 213 (and dirtrack-debug 214 (display-buffer (get-buffer-create dirtrack-debug-buffer)))) 215 216(defun dirtrack-debug-message (string) 217 (let ((buf (current-buffer)) 218 (debug-buf (get-buffer-create dirtrack-debug-buffer)) 219 ) 220 (set-buffer debug-buf) 221 (goto-char (point-max)) 222 (insert (concat string "\n")) 223 (set-buffer buf) 224 )) 225 226;;;###autoload 227(defun dirtrack (input) 228 "Determine the current directory by scanning the process output for a prompt. 229The prompt to look for is the first item in `dirtrack-list'. 230 231You can toggle directory tracking by using the function `dirtrack-toggle'. 232 233If directory tracking does not seem to be working, you can use the 234function `dirtrack-debug-toggle' to turn on debugging output. 235 236You can enable directory tracking by adding this function to 237`comint-output-filter-functions'." 238 (if (or (null dirtrackp) 239 ;; No output? 240 (eq (point) (point-min))) 241 nil 242 (let (prompt-path 243 (current-dir default-directory) 244 (dirtrack-regexp (nth 0 dirtrack-list)) 245 (match-num (nth 1 dirtrack-list)) 246 ;; Currently unimplemented, it seems. --Stef 247 (multi-line (nth 2 dirtrack-list))) 248 (save-excursion 249 ;; No match 250 (if (null (string-match dirtrack-regexp input)) 251 (and dirtrack-debug 252 (dirtrack-debug-message 253 (format 254 "Input `%s' failed to match `dirtrack-regexp'" input))) 255 (setq prompt-path (match-string match-num input)) 256 ;; Empty string 257 (if (not (> (length prompt-path) 0)) 258 (and dirtrack-debug 259 (dirtrack-debug-message "Match is empty string")) 260 ;; Transform prompts into canonical forms 261 (setq prompt-path (funcall dirtrack-directory-function 262 prompt-path)) 263 (setq current-dir (funcall dirtrack-canonicalize-function 264 current-dir)) 265 (and dirtrack-debug 266 (dirtrack-debug-message 267 (format 268 "Prompt is %s\nCurrent directory is %s" 269 prompt-path current-dir))) 270 ;; Compare them 271 (if (or (string= current-dir prompt-path) 272 (string= current-dir 273 (abbreviate-file-name prompt-path))) 274 (and dirtrack-debug 275 (dirtrack-debug-message 276 (format "Not changing directory"))) 277 ;; It's possible that Emacs will think the directory 278 ;; won't exist (eg, rlogin buffers) 279 (if (file-accessible-directory-p prompt-path) 280 ;; Change directory 281 (and (shell-process-cd prompt-path) 282 (run-hooks 'dirtrack-directory-change-hook) 283 dirtrack-debug 284 (dirtrack-debug-message 285 (format "Changing directory to %s" prompt-path))) 286 (error "Directory %s does not exist" prompt-path))) 287 ))))) 288 input) 289 290(provide 'dirtrack) 291 292;; arch-tag: 168de071-be88-4937-aff6-2aba9f328d5a 293;;; dirtrack.el ends here 294