view lisp/dirtrack.el @ 73331:f21883dcffa9

Merge from upstream, upto version 5.22. After 5.0: `cperl-add-tags-recurse-noxs-fullpath': new function (for -batch mode) After 5.1: ;; Major edit. Summary of most visible changes: ;; a) Multiple <<HERE per line allowed. ;; b) Handles multiline subroutine declaration headers (with comments). ;; (The exception is `cperl-etags' - but it is not used in the rest ;; of the mode.) ;; c) Fontifies multiline my/our declarations (even with comments, ;; and with legacy `font-lock'). ;; d) Major speedup of syntaxification, both immediate and postponed ;; (3.5x to 15x [for different CPUs and versions of Emacs] on the ;; huge real-life document I tested). ;; e) New bindings, edits to imenu. ;; f) "_" is made into word-char during fontification/syntaxification; ;; some attempts to recognize non-word "_" during other operations too. ;; g) Detect bug in Emacs with `looking-at' inside `narrow' and bulk out. ;; h) autoload some more perldoc-related stuff ;; i) Some new convenience features: ISpell POD/HEREDOCs, narrow-to-HEREDOC ;; j) Attempt to incorporate XEmacs edits which reached me Fine-grained changelog: `cperl-hook-after-change': New configuration variable `cperl-vc-sccs-header': Likewise. `cperl-vc-sccs-header': Likewise. `cperl-vc-header-alist': Default via two preceding variables `cperl-invalid-face': Remove double quoting under XEmacs (still needed under 21.2) `cperl-tips': Update URLs for resources `cperl-problems': Likewise. `cperl-praise': Mention new features New C-c key bindings: for `cperl-find-bad-style', `cperl-pod-spell', `cperl-here-doc-spell', `cperl-narrow-to-here-doc', `cperl-perdoc', `cperl-perldoc-at-point' CPerl Mode menu changes: "Fix style by spaces", "Imenu on Perl Info" moved, new submenu of Tools with Ispell entries and narrowing. `cperl-after-sub-regexp': New defsubst `cperl-imenu--function-name-regexp-perl': Use `cperl-after-sub-regexp', Allows heads up to head4 Allow "package;" `defun-prompt-regexp': Use `cperl-after-sub-regexp', `paren-backwards-message': ??? Something for XEmacs??? `cperl-mode': Never auto-switch abbrev-mode off Try to allow '_' be non-word char Do not use `font-lock-unfontify-region-function' on XEmacs Reset syntax cache on mode start Support multiline facification (even on legacy `font-lock') `cperl-facemenu-add-face-function': ??? Some contributed code ??? `cperl-after-change-function': Since `font-lock' and `lazy-lock' refuse to inform us whether the fontification is due to lazy calling or due to edit to a buffer, install our own hook (controlled by `cperl-hook-after-change') `cperl-electric-pod': =cut may have been recognized as start `cperl-block-p': Moved, updated for attributes `cperl-calculate-indent': Try to allow '_' be non-word char Support subs with attributes `cperl-where-am-i': Queit (?) a warning `cperl-cached-syntax-table' New function `cperl-forward-re': Use `cperl-cached-syntax-table' `cperl-unwind-to-safe': Recognize `syntax-type' property changing in a middle of line `cperl-find-sub-attrs': New function `cperl-find-pods-heres': Allow many <<EOP per line Allow subs with attributes Major speedups (3.5x..15x on a real-life test file nph-proxy.pl) Recognize "extproc " (OS/2) case-folded and only at start /x on s///x with empty replacement was not recognized Better comments `cperl-after-block-p': Remarks on diff with `cperl-block-p' Allow subs with attributes, labels Do not confuse "else::foo" with "else" Minor optimizations... `cperl-after-expr-p': Try to allow '_' be non-word char `cperl-fill-paragraph': Try to detect a major bug in Emacs with `looking-at' inside `narrow' and bulk out if found `cperl-imenu--create-perl-index': Updates for new `cperl-imenu--function-name-regexp-perl' `cperl-outline-level': Likewise. `cperl-init-faces': Allow multiline subroutine headers and my/our declarations, and ones with comments Allow subroutine attributes `cperl-imenu-on-info': Better docstring. `cperl-etags' Rudimentary support for attributes Support for packages and "package;" `cperl-add-tags-recurse-noxs': Better (?) docstring `cperl-add-tags-recurse-noxs-fullpath': Likewise. `cperl-tags-hier-init': Misprint for `fboundp' fixed `cperl-not-bad-style-regexp': Try to allow '_' be non-word char `cperl-perldoc': Add autoload `cperl-perldoc-at-point': Likewise. `cperl-here-doc-spell': New function `cperl-pod-spell': Likewise. `cperl-map-pods-heres': Likewise. `cperl-get-here-doc-region': Likewise. `cperl-font-lock-fontify-region-function': Likewise (backward compatibility for legacy `font-lock') `cperl-font-lock-unfontify-region-function': Fix style `cperl-fontify-syntaxically': Recognize and optimize away deferred calls with no-change. Governed by `cperl-hook-after-change' `cperl-fontify-update': Recognize that syntaxification region can be larger than fontification one. XXXX we leave `cperl-postpone' property, so this is quadratic... `cperl-fontify-update-bad': Temporary placeholder until it is clear how to implement `cperl-fontify-update'. `cperl-time-fontification': New function `attrib-group': New text attribute `multiline': New value: `syntax-type' text attribute After 5.2: `cperl-emulate-lazy-lock': New function `cperl-fontify-syntaxically': Would skip large regions Add `cperl-time-fontification', `cperl-emulate-lazy-lock' to menu Some globals were declared, but uninitialized After 5.3, 5.4: `cperl-facemenu-add-face-function': Add docs, fix U<> Copyright message updated. `cperl-init-faces': Work around a bug in `font-lock'. May slow facification down a bit. Misprint for my|our|local for old `font-lock' "our" was not fontified same as "my|local" Highlight variables after "my" etc even in a middle of an expression Do not facify multiple variables after my etc unless parentheses are present After 5.5, 5.6 `cperl-fontify-syntaxically': after-change hook could reset `cperl-syntax-done-to' to a middle of line; unwind to BOL. After 5.7: `cperl-init-faces': Allow highlighting of local ($/) `cperl-problems-old-emaxen': New variable (for the purpose of DOCSTRING). `cperl-problems': Remove fixed problems. `cperl-find-pods-heres': Recognize #-comments in m##x too Recognize charclasses (unless delimiter is \). `cperl-fontify-syntaxically': Unwinding to safe was done in wrong order `cperl-regexp-scan': Update docs `cperl-beautify-regexp-piece': use information got from regexp scan After 5.8: Major user visible changes: Recognition and fontification of character classes in RExen. Variable indentation of RExen according to groups `cperl-find-pods-heres': Recognize POSIX classes in REx charclasses Fontify REx charclasses in variable-name face Fontify POSIX charclasses in "type" face Fontify unmatched "]" in function-name face Mark first-char of HERE-doc as `front-sticky' Reset `front-sticky' property when needed `cperl-calculate-indent': Indents //x -RExen accordning to parens level `cperl-to-comment-or-eol': Recognize ends of `syntax-type' constructs `cperl-backward-to-noncomment': Recognize stringy `syntax-type' constructs Support `narrow'ed buffers. `cperl-praise': Remove a reservation `cperl-make-indent': New function `cperl-indent-for-comment': Use `cperl-make-indent' `cperl-indent-line': Likewise. `cperl-lineup': Likewise. `cperl-beautify-regexp-piece': Likewise. `cperl-contract-level': Likewise. `cperl-toggle-set-debug-unwind': New function New menu entry for this `fill-paragraph-function': Use when `boundp' `cperl-calculate-indent': Take into account groups when indenting RExen `cperl-to-comment-or-eol': Recognize # which end a string `cperl-modify-syntax-type': Make only syntax-table property non-sticky `cperl-fill-paragraph': Return t: needed for `fill-paragraph-function' `cperl-fontify-syntaxically': More clear debugging message `cperl-pod2man-build-command': XEmacs portability: check `Man-filter-list' `cperl-init-faces': More complicated highlight even on XEmacs (new) Merge cosmetic changes from XEmacs After 5.9: `cperl-1+': Moved to before the first use `cperl-1-': Likewise. After 5.10: This code may lock Emacs hard!!! Use on your own risk! `cperl-font-locking': New internal variable `cperl-beginning-of-property': New function `cperl-calculate-indent': Use `cperl-beginning-of-property' instead of `previous-single-property-change' `cperl-unwind-to-safe': Likewise. `cperl-after-expr-p': Likewise. `cperl-get-here-doc-region': Likewise. `cperl-font-lock-fontify-region-function': Likewise. `cperl-to-comment-or-eol': Do not call `cperl-update-syntaxification' recursively Bound `next-single-property-change' via `point-max' `cperl-unwind-to-safe': Bound likewise `cperl-font-lock-fontify-region-function': Likewise. `cperl-find-pods-heres': Mark as recursive for `cperl-to-comment-or-eol' Initialization of `cperl-font-lock-multiline-start' could be missed if the "main" fontification did not run due to the keyword being already fontified. `cperl-pod-spell': Return t from do-one-chunk function `cperl-map-pods-heres': Stop when the worker returns nil Call `cperl-update-syntaxification' `cperl-get-here-doc-region': Call `cperl-update-syntaxification' `cperl-get-here-doc-delim': Remove unused function After 5.11: The possible lockup of Emacs (introduced in 5.10) fixed `cperl-unwind-to-safe': `cperl-beginning-of-property' won't return nil `cperl-syntaxify-for-menu': New customization variable `cperl-select-this-pod-or-here-doc': New function `cperl-get-here-doc-region': Extra argument Do not adjust pos by 1 New menu entries (Perl/Tools): Selection of current POD or HERE-DOC section (Debugging CPerl:) backtrace on fontification After 5.12: `cperl-cached-syntax-table': use `car-safe' `cperl-forward-re': Remove spurious argument SET-ST Add documentation `cperl-forward-group-in-re': New function `cperl-find-pods-heres': Find and highlight (?{}) blocks in RExen (XXXX Temporary (?) hack is to syntax-mark them as comment) After 5.13: `cperl-string-syntax-table': Make { and } not-grouping (Sometimes they ARE grouping in RExen, but matching them would only confuse in many situations when they are not) `beginning-of-buffer': Replaced two occurences with goto-char... `cperl-calculate-indent': `char-after' could be nil... `cperl-find-pods-heres': REx can start after "[" too Hightlight (??{}) in RExen too `cperl-maybe-white-and-comment-rex': New constant `cperl-white-and-comment-rex': Likewise. XXXX Not very efficient, but hard to make better while keeping 1 group After 5.13: `cperl-find-pods-heres': $foo << identifier() is not a HERE-DOC Likewise for 1 << identifier After 5.14: `cperl-find-pods-heres': Different logic for $foo .= <<EOF etc Error-less condition-case could fail `cperl-font-lock-fontify-region-function': Likewise. `cperl-init-faces': Likewise. After 5.15: `cperl-find-pods-heres': Support property REx-part2 `cperl-calculate-indent': Likewise. Don't special-case REx with non-empty 1st line `cperl-find-pods-heres': In RExen, highlight non-literal backslashes Invert highlighting of charclasses: now the envelop is highlighted Highlight many others 0-length builtins `cperl-praise': Mention indenting and highlight in RExen After 5.15: `cperl-find-pods-heres': Highlight capturing parens in REx After 5.16: `cperl-find-pods-heres': Highlight '|' for alternation Initialize `font-lock-warning-face' if not present `cperl-find-pods-heres': Use `font-lock-warning-face' instead of `font-lock-function-name-face' `cperl-look-at-leading-count': Likewise. `cperl-find-pods-heres': localize `font-lock-variable-name-face' `font-lock-keyword-face' (needed for batch processing) etc Use `font-lock-builtin-face' for builtin in REx Now `font-lock-variable-name-face' is used for interpolated variables Use "talking aliases" for faces inside REx Highlight parts of REx (except in charclasses) according to the syntax and/or semantic Syntax-mark a {}-part of (?{}) as "comment" (it was the ()-part) Better logic to distinguish what is what in REx `cperl-tips-faces': Document REx highlighting `cperl-praise': Mention REx syntax highlight etc. After 5.17: `cperl-find-sub-attrs': Would not always manage to print error message `cperl-find-pods-heres': localize `font-lock-constant-face' After 5.18: `cperl-find-pods-heres': Misprint in REx for parsing REx Very minor optimization `my-cperl-REx-modifiers-face' got quoted Recognize "print $foo <<END" as HERE-doc Put `REx-interpolated' text attribute if needed `cperl-invert-if-unless-modifiers': New function `cperl-backward-to-start-of-expr': Likewise. `cperl-forward-to-end-of-expr': Likewise. `cperl-invert-if-unless': Works in "the opposite way" too Cursor position on return is on the switch-word Indents comments better `REx-interpolated': New text attribute `cperl-next-interpolated-REx': New function `cperl-next-interpolated-REx-0': Likewise. `cperl-next-interpolated-REx-1': Likewise. "\C-c\C-x", "\C-c\C-y", "\C-c\C-v": New keybinding for these functions Perl/Regexp menu: 3 new entries for `cperl-next-interpolated-REx' `cperl-praise': Mention finded interpolated RExen After 5.19: `cperl-init-faces': Highlight %$foo, @$foo too `cperl-short-docs': Better docs for system, exec `cperl-find-pods-heres': Better detect << after print {FH} <<EOF etc. Would not find HERE-doc ended by EOF without NL `cperl-short-docs': Correct not-doubled \-escapes start block: Put some `defvar' for stuff gone from XEmacs After 5.20: initial comment: Extend copyright, fix email address `cperl-indent-comment-at-column-0': New customization variable `cperl-comment-indent': Indentation after $#a would increasy by 1 `cperl-mode': Make `defun-prompt-regexp' grok BEGIN/END etc `cperl-find-pods-heres': Mark CODE of s///e as `syntax-type' `multiline' `cperl-at-end-of-expr': Would fail if @BAR=12 follows after ";" `cperl-init-faces': If `cperl-highlight-variables-indiscriminately' highlight $ in $foo too (UNTESTED) `cperl-set-style': Docstring missed some available styles toplevel: Menubar/Perl/Indent-Styles had FSF, now K&R Change "Current" to "Memorize Current" `cperl-indent-wrt-brace': New customization variable; the default is as for pre-5.2 version `cperl-styles-entries': Keep `cperl-extra-newline-before-brace-multiline' `cperl-style-alist': Likewise. `cperl-fix-line-spacing': Support `cperl-merge-trailing-else' being nil, and `cperl-extra-newline-before-brace' etc being t `cperl-indent-exp': Plans B and C to find continuation blocks even if `cperl-extra-newline-before-brace' is t After 5.21: Improve some docstrings concerning indentation. `cperl-indent-rules-alist': New variable `cperl-sniff-for-indent': New function name (separated from `cperl-calculate-indent') `cperl-calculate-indent': Separated the sniffer and the indenter; uses `cperl-sniff-for-indent' now `cperl-comment-indent': Test for `cperl-indent-comment-at-column-0' was inverted; Support `comment-column' = 0
author Stefan Monnier <monnier@iro.umontreal.ca>
date Wed, 11 Oct 2006 06:47:35 +0000
parents 743b3d313968
children ddcbd2c1b70d 8a8e69664178
line wrap: on
line source

;;; dirtrack.el --- Directory Tracking by watching the prompt

;; Copyright (C) 1996, 2002, 2003, 2004, 2005,
;;   2006 Free Software Foundation, Inc.

;; Author: Peter Breton <pbreton@cs.umb.edu>
;; Created: Sun Nov 17 1996
;; Keywords: processes

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; 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
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Commentary:

;; Shell directory tracking by watching the prompt.
;;
;; This is yet another attempt at a directory-tracking package for
;; Emacs shell-mode.  However, this package makes one strong assumption:
;; that you can customize your shell's prompt to contain the
;; current working directory.  Most shells do support this, including
;; 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
;; Windows shells.  If you cannot do this, or do not wish to, this package
;; 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.
;;
;; Note that directory tracking is done by matching regular expressions,
;; therefore it is *VERY IMPORTANT* for your prompt to be easily
;; distinguishable from other output.  If your prompt regexp is too general,
;; you will see error messages from the dirtrack filter as it attempts to cd
;; to non-existent directories.
;;
;; 2) Set the variable `dirtrack-list' to an appropriate value.  This
;; should be a list of two elements: the first is a regular expression
;; which matches your prompt up to and including the pathname part.
;; The second is a number which tells which regular expression group to
;; 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
;; 'comint.el' assume a single-line prompt (eg, comint-bol).
;;
;; Determining this information may take some experimentation.  Setting
;; the variable `dirtrack-debug' may help; it causes the directory-tracking
;; filter to log messages to the buffer `dirtrack-debug-buffer'.  You can easily
;; toggle this setting with the `dirtrack-debug-toggle' function.
;;
;; 3) Add a hook to shell-mode to enable the directory tracking:
;;
;; (add-hook 'shell-mode-hook
;;   (lambda () (add-hook 'comint-preoutput-filter-functions 'dirtrack nil t)))
;;
;; You may wish to turn ordinary shell tracking off by calling
;; `shell-dirtrack-toggle' or setting `shell-dirtrackp'.
;;
;; 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.
;;
;; Here's one from Stephen Eglen:
;;
;;   Running under tcsh:
;;   (setq-default dirtrack-list '("^%E \\([^ ]+\\)" 1))
;;
;;   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:
;;
;;   set prompt = "%%E %~ %h% "
;;
;;   This produces a prompt of the form:
;;   %E /var/spool 10%
;;
;;   This saves me from having to use the %E prefix in other non-emacs
;;   shells.
;;
;; A final note:
;;
;;   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
;;   who owns the shell buffer.  This may cause dirtrack to behave strangely
;;   (typically it reports that it is unable to cd to a directory
;;   with a ~ in it).
;;
;;   The same behavior can occur if you use dirtrack with remote filesystems
;;   (using telnet, rlogin, etc) as Emacs will be checking the local
;;   filesystem, not the remote one.  This problem is not specific to dirtrack,
;;   but also affects file completion, etc.

;;; Code:

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

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Customization Variables
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

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

(defcustom dirtrack-list (list "^emacs \\([a-zA-Z]:.*\\)>" 1)
  "List for directory tracking.
First item is a regexp that describes where to find the path in a prompt.
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
be on a single line."
  :group 'dirtrack
  :type  '(sexp (regexp  :tag "Prompt Expression")
		(integer :tag "Regexp Group")
		(boolean :tag "Multiline Prompt")))

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

(defcustom dirtrack-debug nil
  "If non-nil, the function `dirtrack' will report debugging info."
  :group 'dirtrack
  :type  'boolean)

(defcustom dirtrack-debug-buffer "*Directory Tracking Log*"
  "Buffer to write directory tracking debug information."
  :group 'dirtrack
  :type  'string)

(defcustom dirtrackp t
  "If non-nil, directory tracking via `dirtrack' is enabled."
  :group 'dirtrack
  :type  'boolean)

(make-variable-buffer-local 'dirtrackp)

(defcustom dirtrack-directory-function
  (if (memq system-type (list 'ms-dos 'windows-nt 'cygwin))
      'dirtrack-windows-directory-function
    'file-name-as-directory)
  "Function to apply to the prompt directory for comparison purposes."
  :group 'dirtrack
  :type  'function)

(defcustom dirtrack-canonicalize-function
  (if (memq system-type (list 'ms-dos 'windows-nt 'cygwin))
      'downcase 'identity)
  "Function to apply to the default directory for comparison purposes."
  :group 'dirtrack
  :type  'function)

(defcustom dirtrack-directory-change-hook nil
  "Hook that is called when a directory change is made."
  :group 'dirtrack
  :type 'hook)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defun dirtrack-windows-directory-function (dir)
  "Return a canonical directory for comparison purposes.
Such a directory is all lowercase, has forward-slashes as delimiters,
and ends with a forward slash."
  (file-name-as-directory (downcase (subst-char-in-string ?\\ ?/ dir))))

(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))

;; Copied from shell.el
(defun dirtrack-toggle ()
  "Enable or disable Dirtrack directory tracking in a shell buffer."
  (interactive)
  (if (setq dirtrackp (not dirtrackp))
      (add-hook 'comint-preoutput-filter-functions 'dirtrack nil t)
    (remove-hook 'comint-preoutput-filter-functions 'dirtrack t))
  (message "Directory tracking %s" (if dirtrackp "ON" "OFF")))

(defun dirtrack-debug-toggle ()
  "Enable or disable Dirtrack debugging."
  (interactive)
  (setq dirtrack-debug (not dirtrack-debug))
  (message "Directory debugging %s" (if dirtrack-debug "ON" "OFF"))
  (and dirtrack-debug
       (display-buffer (get-buffer-create dirtrack-debug-buffer))))

(defun dirtrack-debug-message (string)
  (let ((buf (current-buffer))
	(debug-buf (get-buffer-create dirtrack-debug-buffer))
	)
    (set-buffer debug-buf)
    (goto-char (point-max))
    (insert (concat string "\n"))
    (set-buffer buf)
  ))

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

You can toggle directory tracking by using the function `dirtrack-toggle'.

If directory tracking does not seem to be working, you can use the
function `dirtrack-debug-toggle' to turn on debugging output.

You can enable directory tracking by adding this function to
`comint-output-filter-functions'."
  (if (or (null dirtrackp)
          ;; No output?
          (eq (point) (point-min)))
      nil
    (let (prompt-path
	  (current-dir default-directory)
	  (dirtrack-regexp    (nth 0 dirtrack-list))
	  (match-num	      (nth 1 dirtrack-list))
          ;; Currently unimplemented, it seems.  --Stef
	  (multi-line	      (nth 2 dirtrack-list)))
      (save-excursion
        ;; No match
        (if (null (string-match dirtrack-regexp input))
            (and dirtrack-debug
                 (dirtrack-debug-message
                  (format
                   "Input `%s' failed to match `dirtrack-regexp'" input)))
          (setq prompt-path (match-string match-num input))
          ;; Empty string
          (if (not (> (length prompt-path) 0))
              (and dirtrack-debug
                   (dirtrack-debug-message "Match is empty string"))
            ;; Transform prompts into canonical forms
            (setq prompt-path (funcall dirtrack-directory-function
                                       prompt-path))
            (setq current-dir (funcall dirtrack-canonicalize-function
                                       current-dir))
            (and dirtrack-debug
                 (dirtrack-debug-message
                  (format
                   "Prompt is %s\nCurrent directory is %s"
                   prompt-path current-dir)))
            ;; Compare them
            (if (or (string= current-dir prompt-path)
                    (string= current-dir
                             (abbreviate-file-name prompt-path)))
                (and dirtrack-debug
                     (dirtrack-debug-message
                      (format "Not changing directory")))
              ;; It's possible that Emacs will think the directory
              ;; won't exist (eg, rlogin buffers)
              (if (file-accessible-directory-p prompt-path)
                  ;; Change directory
                  (and (shell-process-cd prompt-path)
                       (run-hooks 'dirtrack-directory-change-hook)
                       dirtrack-debug
                       (dirtrack-debug-message
                        (format "Changing directory to %s" prompt-path)))
                (error "Directory %s does not exist" prompt-path)))
            )))))
  input)

(provide 'dirtrack)

;; arch-tag: 168de071-be88-4937-aff6-2aba9f328d5a
;;; dirtrack.el ends here