lisp/dirtrack.el

   1 ;;; dirtrack.el --- Directory Tracking by watching the prompt
   2
   3 ;; Copyright (C) 1996, 2001-2011 Free Software Foundation, Inc.
   4
   5 ;; Author: Peter Breton <pbreton@cs.umb.edu>
   6 ;; Created: Sun Nov 17 1996
   7 ;; Keywords: processes
   8
   9 ;; This file is part of GNU Emacs.
  10
  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.
  15
  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.
  20
  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/>.
  23
  24 ;;; Commentary:
  25
  26 ;; Shell directory tracking by watching the prompt.
  27 ;;
  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.
  36 ;;
  37 ;; Installation:
  38 ;;
  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.
  42 ;;
  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.
  48 ;;
  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).
  56 ;;
  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'.
  60 ;;
  61 ;; 3) Activate `dirtrack-mode'.  You may wish to turn ordinary shell
  62 ;; tracking off by calling `shell-dirtrack-mode'.
  63 ;;
  64 ;; Examples:
  65 ;;
  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)
  68 ;;
  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)
  72 ;;
  73 ;; I'd appreciate other examples from people who use this package.
  74 ;;
  75 ;; Here's one from Stephen Eglen:
  76 ;;
  77 ;;   Running under tcsh:
  78 ;;   (setq-default dirtrack-list '("^%E \\([^ ]+\\)" 1))
  79 ;;
  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:
  83 ;;
  84 ;;   set prompt = "%%E %~ %h% "
  85 ;;
  86 ;;   This produces a prompt of the form:
  87 ;;   %E /var/spool 10%
  88 ;;
  89 ;;   This saves me from having to use the %E prefix in other non-emacs
  90 ;;   shells.
  91 ;;
  92 ;; A final note:
  93 ;;
  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).
 101 ;;
 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.
 106
 107 ;;; Code:
 108
 109 (eval-when-compile
 110   (require 'comint)
 111   (require 'shell))
 112
 113 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 114 ;; Customization Variables
 115 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 116
 117 (defgroup dirtrack nil
 118   "Directory tracking by watching the prompt."
 119   :prefix "dirtrack-"
 120   :group 'shell)
 121
 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.  Optional third item is
 126 whether the prompt is multi-line.  If nil or omitted, prompt is assumed to
 127 be on a single line."
 128   :group 'dirtrack
 129   :type  '(sexp (regexp  :tag "Prompt Expression")
 130                 (integer :tag "Regexp Group")
 131                 (boolean :tag "Multiline Prompt")))
 132
 133 (make-variable-buffer-local 'dirtrack-list)
 134
 135 (defcustom dirtrack-debug nil
 136   "If non-nil, the function `dirtrack' will report debugging info."
 137   :group 'dirtrack
 138   :type  'boolean)
 139
 140 (defcustom dirtrack-debug-buffer "*Directory Tracking Log*"
 141   "Buffer in which to write directory tracking debug information."
 142   :group 'dirtrack
 143   :type  'string)
 144
 145 (defcustom dirtrack-directory-function
 146   (if (memq system-type '(ms-dos windows-nt cygwin))
 147       'dirtrack-windows-directory-function
 148     'file-name-as-directory)
 149   "Function to apply to the prompt directory for comparison purposes."
 150   :group 'dirtrack
 151   :type  'function)
 152
 153 (defcustom dirtrack-canonicalize-function
 154   (if (memq system-type '(ms-dos windows-nt cygwin))
 155       'downcase 'identity)
 156   "Function to apply to the default directory for comparison purposes."
 157   :group 'dirtrack
 158   :type  'function)
 159
 160 (defcustom dirtrack-directory-change-hook nil
 161   "Hook that is called when a directory change is made."
 162   :group 'dirtrack
 163   :type 'hook)
 164
 165
 166 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 167 ;; Functions
 168 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 169
 170
 171 (defun dirtrack-windows-directory-function (dir)
 172   "Return a canonical directory for comparison purposes.
 173 Such a directory is all lowercase, has forward-slashes as delimiters,
 174 and ends with a forward slash."
 175   (file-name-as-directory (downcase (subst-char-in-string ?\\ ?/ dir))))
 176
 177 (defun dirtrack-cygwin-directory-function (dir)
 178   "Return a canonical directory taken from a Cygwin path for comparison purposes."
 179   (if (string-match "/cygdrive/\\([A-Z]\\)\\(.*\\)" dir)
 180       (concat (match-string 1 dir) ":" (match-string 2 dir))
 181     dir))
 182
 183
 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.
 190
 191 This method requires that your shell prompt contain the full
 192 current working directory at all times, and that `dirtrack-list'
 193 is set to match the prompt.  This is an alternative to
 194 `shell-dirtrack-mode', which works differently, by tracking `cd'
 195 and similar commands which change the shell working directory."
 196   nil nil nil
 197   (if dirtrack-mode
 198       (add-hook 'comint-preoutput-filter-functions 'dirtrack nil t)
 199     (remove-hook 'comint-preoutput-filter-functions 'dirtrack t)))
 200
 201 (define-obsolete-function-alias 'dirtrack-toggle 'dirtrack-mode "23.1")
 202 (define-obsolete-variable-alias 'dirtrackp 'dirtrack-mode "23.1")
 203
 204
 205 (define-minor-mode dirtrack-debug-mode
 206   "Toggle Dirtrack debugging."
 207   nil nil nil
 208   (if dirtrack-debug-mode
 209       (display-buffer (get-buffer-create dirtrack-debug-buffer))))
 210
 211 (define-obsolete-function-alias 'dirtrack-debug-toggle 'dirtrack-debug-mode
 212   "23.1")
 213 (define-obsolete-variable-alias 'dirtrack-debug 'dirtrack-debug-mode "23.1")
 214
 215
 216 (defun dirtrack-debug-message (string)
 217   "Insert string 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 (concat string "\n")))))
 222
 223 ;;;###autoload
 224 (defun dirtrack (input)
 225   "Determine the current directory by scanning the process output for a prompt.
 226 The prompt to look for is the first item in `dirtrack-list'.
 227
 228 You can toggle directory tracking by using the function `dirtrack-mode'.
 229
 230 If directory tracking does not seem to be working, you can use the
 231 function `dirtrack-debug-mode' to turn on debugging output."
 232   (unless (or (null dirtrack-mode)
 233               (eq (point) (point-min)))     ; no output?
 234     (let (prompt-path orig-prompt-path
 235           (current-dir default-directory)
 236           (dirtrack-regexp    (nth 0 dirtrack-list))
 237           (match-num          (nth 1 dirtrack-list)))
 238           ;; Currently unimplemented, it seems.  --Stef
 239           ;; (multi-line      (nth 2 dirtrack-list)))
 240       (save-excursion
 241         ;; No match
 242         (if (not (string-match dirtrack-regexp input))
 243             (dirtrack-debug-message
 244              (format "Input `%s' failed to match `dirtrack-list'" input))
 245           (setq prompt-path (match-string match-num input))
 246           ;; Empty string
 247           (if (not (> (length prompt-path) 0))
 248               (dirtrack-debug-message "Match is empty string")
 249             ;; Transform prompts into canonical forms
 250             (setq orig-prompt-path (funcall dirtrack-directory-function
 251                                             prompt-path)
 252                   prompt-path (shell-prefixed-directory-name orig-prompt-path)
 253                   current-dir (funcall dirtrack-canonicalize-function
 254                                        current-dir))
 255             (dirtrack-debug-message
 256              (format "Prompt is %s\nCurrent directory is %s"
 257                      prompt-path current-dir))
 258             ;; Compare them
 259             (if (or (string= current-dir prompt-path)
 260                     (string= current-dir (abbreviate-file-name prompt-path)))
 261                 (dirtrack-debug-message (format "Not changing directory"))
 262               ;; It's possible that Emacs will think the directory
 263               ;; won't exist (eg, rlogin buffers)
 264               (if (file-accessible-directory-p prompt-path)
 265                   ;; Change directory. shell-process-cd adds the prefix, so we
 266                   ;; need to give it the original (un-prefixed) path.
 267                   (and (shell-process-cd orig-prompt-path)
 268                        (run-hooks 'dirtrack-directory-change-hook)
 269                        (dirtrack-debug-message
 270                         (format "Changing directory to %s" prompt-path)))
 271                 (warn "Directory %s does not exist" prompt-path)))
 272             )))))
 273   input)
 274
 275 (provide 'dirtrack)
 276
 277 ;;; dirtrack.el ends here