/[emacs]/emacs/lisp/dirtrack.el
ViewVC logotype

Diff of /emacs/lisp/dirtrack.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.11 by fx, Wed Feb 7 23:38:46 2001 UTC revision 1.11.16.1 by miles, Fri Apr 4 06:20:04 2003 UTC
# Line 5  Line 5 
5  ;; Author: Peter Breton <pbreton@cs.umb.edu>  ;; Author: Peter Breton <pbreton@cs.umb.edu>
6  ;; Created: Sun Nov 17 1996  ;; Created: Sun Nov 17 1996
7  ;; Keywords: processes  ;; Keywords: processes
 ;; Time-stamp: <1999-02-21 01:27:24 pbreton>  
8    
9  ;; This file is part of GNU Emacs.  ;; This file is part of GNU Emacs.
10    
# Line 42  Line 41 
41  ;; 1) Set your shell's prompt to contain the current working directory.  ;; 1) Set your shell's prompt to contain the current working directory.
42  ;; You may need to consult your shell's documentation to find out how to  ;; You may need to consult your shell's documentation to find out how to
43  ;; do this.  ;; do this.
44  ;;  ;;
45  ;; Note that directory tracking is done by matching regular expressions,  ;; Note that directory tracking is done by matching regular expressions,
46  ;; therefore it is *VERY IMPORTANT* for your prompt to be easily  ;; therefore it is *VERY IMPORTANT* for your prompt to be easily
47  ;; distinguishable from other output. If your prompt regexp is too general,  ;; distinguishable from other output. If your prompt regexp is too general,
48  ;; you will see error messages from the dirtrack filter as it attempts to cd  ;; you will see error messages from the dirtrack filter as it attempts to cd
# Line 52  Line 51 
51  ;; 2) Set the variable `dirtrack-list' to an appropriate value. This  ;; 2) Set the variable `dirtrack-list' to an appropriate value. This
52  ;; should be a list of two elements: the first is a regular expression  ;; should be a list of two elements: the first is a regular expression
53  ;; which matches your prompt up to and including the pathname part.  ;; which matches your prompt up to and including the pathname part.
54  ;; The second is a number which tells which regular expression group to  ;; The second is a number which tells which regular expression group to
55  ;; match to extract only the pathname. If you use a multi-line prompt,  ;; match to extract only the pathname. If you use a multi-line prompt,
56  ;; add 't' as a third element. Note that some of the functions in  ;; add 't' as a third element. Note that some of the functions in
57  ;; 'comint.el' assume a single-line prompt (eg, comint-bol).  ;; 'comint.el' assume a single-line prompt (eg, comint-bol).
58  ;;  ;;
59  ;; Determining this information may take some experimentation. Setting  ;; Determining this information may take some experimentation. Setting
60  ;; the variable `dirtrack-debug' may help; it causes the directory-tracking  ;; the variable `dirtrack-debug' may help; it causes the directory-tracking
61  ;; filter to log messages to the buffer `dirtrack-debug-buffer'. You can easily  ;; filter to log messages to the buffer `dirtrack-debug-buffer'. You can easily
62  ;; toggle this setting with the `dirtrack-debug-toggle' function.  ;; toggle this setting with the `dirtrack-debug-toggle' function.
63  ;;  ;;
64  ;; 3) Add a hook to shell-mode to enable the directory tracking:  ;; 3) Add a hook to shell-mode to enable the directory tracking:
65  ;;  ;;
66  ;; (add-hook 'shell-mode-hook  ;; (add-hook 'shell-mode-hook
# Line 83  Line 82 
82  ;;    'dirtrack-list' is set to (list "^\\([/~].*\\)\nemacs@[^%]+% *" 1 t)  ;;    'dirtrack-list' is set to (list "^\\([/~].*\\)\nemacs@[^%]+% *" 1 t)
83  ;;  ;;
84  ;; I'd appreciate other examples from people who use this package.  ;; I'd appreciate other examples from people who use this package.
85  ;;  ;;
86  ;; Here's one from Stephen Eglen:  ;; Here's one from Stephen Eglen:
87  ;;  ;;
88  ;;   Running under tcsh:  ;;   Running under tcsh:
89  ;;   (setq-default dirtrack-list '("^%E \\([^ ]+\\)" 1))  ;;   (setq-default dirtrack-list '("^%E \\([^ ]+\\)" 1))
90  ;;    ;;
91  ;;   It might be worth mentioning in your file that emacs sources start up  ;;   It might be worth mentioning in your file that emacs sources start up
92  ;;   files of the form: ~/.emacs_<SHELL> where <SHELL> is the name of the  ;;   files of the form: ~/.emacs_<SHELL> where <SHELL> is the name of the
93  ;;   shell.  So for example, I have the following in ~/.emacs_tcsh:  ;;   shell.  So for example, I have the following in ~/.emacs_tcsh:
94  ;;    ;;
95  ;;   set prompt = "%%E %~ %h% "  ;;   set prompt = "%%E %~ %h% "
96  ;;    ;;
97  ;;   This produces a prompt of the form:  ;;   This produces a prompt of the form:
98  ;;   %E /var/spool 10%  ;;   %E /var/spool 10%
99  ;;    ;;
100  ;;   This saves me from having to use the %E prefix in other non-emacs  ;;   This saves me from having to use the %E prefix in other non-emacs
101  ;;   shells.  ;;   shells.
102  ;;  ;;
103  ;; A final note:  ;; A final note:
104  ;;  ;;
105  ;;   I run LOTS of shell buffers through Emacs, sometimes as different users  ;;   I run LOTS of shell buffers through Emacs, sometimes as different users
106  ;;   (eg, when logged in as myself, I'll run a root shell in the same Emacs).  ;;   (eg, when logged in as myself, I'll run a root shell in the same Emacs).
107  ;;   If you do this, and the shell prompt contains a ~, Emacs will interpret  ;;   If you do this, and the shell prompt contains a ~, Emacs will interpret
# Line 134  Line 133 
133  (defcustom dirtrack-list (list "^emacs \\([a-zA-Z]:.*\\)>" 1)  (defcustom dirtrack-list (list "^emacs \\([a-zA-Z]:.*\\)>" 1)
134    "*List for directory tracking.    "*List for directory tracking.
135  First item is a regexp that describes where to find the path in a prompt.  First item is a regexp that describes where to find the path in a prompt.
136  Second is a number, the regexp group to match. Optional third item is  Second is a number, the regexp group to match. Optional third item is
137  whether the prompt is multi-line. If nil or omitted, prompt is assumed to  whether the prompt is multi-line. If nil or omitted, prompt is assumed to
138  be on a single line."  be on a single line."
139    :group 'dirtrack    :group 'dirtrack
140    :type  '(sexp (regexp  :tag "Prompt Expression")    :type  '(sexp (regexp  :tag "Prompt Expression")
141                  (integer :tag "Regexp Group")                  (integer :tag "Regexp Group")
142                  (boolean :tag "Multiline Prompt")                  (boolean :tag "Multiline Prompt")
143                  )                  )
# Line 166  be on a single line." Line 165  be on a single line."
165    
166  (make-variable-buffer-local 'dirtrackp)  (make-variable-buffer-local 'dirtrackp)
167    
168  (defcustom dirtrack-directory-function  (defcustom dirtrack-directory-function
169    (if (memq system-type (list 'ms-dos 'windows-nt))    (if (memq system-type (list 'ms-dos 'windows-nt 'cygwin))
170        'dirtrack-windows-directory-function        'dirtrack-windows-directory-function
171      'dirtrack-default-directory-function)      'dirtrack-default-directory-function)
172    "*Function to apply to the prompt directory for comparison purposes."    "*Function to apply to the prompt directory for comparison purposes."
# Line 175  be on a single line." Line 174  be on a single line."
174    :type  'function    :type  'function
175    )    )
176    
177  (defcustom dirtrack-canonicalize-function    (defcustom dirtrack-canonicalize-function
178    (if (memq system-type (list 'ms-dos 'windows-nt))    (if (memq system-type (list 'ms-dos 'windows-nt 'cygwin))
179        'downcase 'identity)        'downcase 'identity)
180    "*Function to apply to the default directory for comparison purposes."    "*Function to apply to the default directory for comparison purposes."
181    :group 'dirtrack    :group 'dirtrack
# Line 204  Such a directory ends with a forward sla Line 203  Such a directory ends with a forward sla
203    
204  (defun dirtrack-windows-directory-function (dir)  (defun dirtrack-windows-directory-function (dir)
205    "Return a canonical directory for comparison purposes.    "Return a canonical directory for comparison purposes.
206  Such a directory is all lowercase, has forward-slashes as delimiters,  Such a directory is all lowercase, has forward-slashes as delimiters,
207  and ends with a forward slash."  and ends with a forward slash."
208    (let ((directory dir))    (let ((directory dir))
209      (setq directory (downcase (dirtrack-replace-slash directory t)))      (setq directory (downcase (dirtrack-replace-slash directory t)))
# Line 212  and ends with a forward slash." Line 211  and ends with a forward slash."
211          (concat directory "/")          (concat directory "/")
212        directory)))        directory)))
213    
214    (defun dirtrack-cygwin-directory-function (dir)
215      "Return a canonical directory taken from a Cygwin path for comparison purposes."
216      (if (string-match "/cygdrive/\\([A-Z]\\)\\(.*\\)" dir)
217          (concat (match-string 1 dir) ":" (match-string 2 dir))
218        dir))
219    
220  (defconst dirtrack-forward-slash  (regexp-quote "/"))  (defconst dirtrack-forward-slash  (regexp-quote "/"))
221  (defconst dirtrack-backward-slash (regexp-quote "\\"))  (defconst dirtrack-backward-slash (regexp-quote "\\"))
222    
223  (defun dirtrack-replace-slash (string &optional opposite)  (defun dirtrack-replace-slash (string &optional opposite)
224    "Replace forward slashes with backwards ones.    "Replace forward slashes with backwards ones.
225  If additional argument is non-nil, replace backwards slashes with  If additional argument is non-nil, replace backwards slashes with
226  forward ones."  forward ones."
227    (let ((orig     (if opposite    (let ((orig     (if opposite
228                        dirtrack-backward-slash                        dirtrack-backward-slash
229                      dirtrack-forward-slash))                      dirtrack-forward-slash))
230          (replace  (if opposite          (replace  (if opposite
231                        dirtrack-forward-slash                        dirtrack-forward-slash
232                      dirtrack-backward-slash))                      dirtrack-backward-slash))
233          (newstring string)          (newstring string)
234          )          )
# Line 266  You can toggle directory tracking by usi Line 271  You can toggle directory tracking by usi
271  If directory tracking does not seem to be working, you can use the  If directory tracking does not seem to be working, you can use the
272  function `dirtrack-debug-toggle' to turn on debugging output.  function `dirtrack-debug-toggle' to turn on debugging output.
273    
274  You can enable directory tracking by adding this function to  You can enable directory tracking by adding this function to
275  `comint-output-filter-functions'.  `comint-output-filter-functions'.
276  "  "
277    (if (null dirtrackp)    (if (null dirtrackp)
# Line 286  You can enable directory tracking by add Line 291  You can enable directory tracking by add
291            ;; No match            ;; No match
292            (if (null matched)            (if (null matched)
293                (and dirtrack-debug                (and dirtrack-debug
294                     (dirtrack-debug-message                     (dirtrack-debug-message
295                      (format                      (format
296                       "Input `%s' failed to match regexp: %s"                       "Input `%s' failed to match regexp: %s"
297                      input dirtrack-regexp)))                      input dirtrack-regexp)))
298              (setq prompt-path              (setq prompt-path
299                    (substring input                    (substring input
300                     (match-beginning match-num) (match-end match-num)))                     (match-beginning match-num) (match-end match-num)))
301              ;; Empty string              ;; Empty string
302              (if (not (> (length prompt-path) 0))              (if (not (> (length prompt-path) 0))
303                  (and dirtrack-debug                  (and dirtrack-debug
304                       (dirtrack-debug-message "Match is empty string"))                       (dirtrack-debug-message "Match is empty string"))
305                ;; Transform prompts into canonical forms                ;; Transform prompts into canonical forms
306                (setq prompt-path (funcall dirtrack-directory-function                (setq prompt-path (funcall dirtrack-directory-function
307                                           prompt-path))                                           prompt-path))
308                (setq current-dir (funcall dirtrack-canonicalize-function                (setq current-dir (funcall dirtrack-canonicalize-function
309                                           current-dir))                                           current-dir))
310                (and dirtrack-debug                (and dirtrack-debug
311                     (dirtrack-debug-message                     (dirtrack-debug-message
312                      (format                      (format
313                       "Prompt is %s\nCurrent directory is %s"                       "Prompt is %s\nCurrent directory is %s"
314                       prompt-path current-dir)))                       prompt-path current-dir)))
315                ;; Compare them                ;; Compare them
316                (if (or (string= current-dir prompt-path)                (if (or (string= current-dir prompt-path)
317                        (string= current-dir                        (string= current-dir
318                                 (abbreviate-file-name prompt-path)))                                 (abbreviate-file-name prompt-path)))
319                    (and dirtrack-debug                    (and dirtrack-debug
320                         (dirtrack-debug-message                         (dirtrack-debug-message
321                          (format "Not changing directory")))                          (format "Not changing directory")))
322                  ;; It's possible that Emacs will think the directory                  ;; It's possible that Emacs will think the directory
323                  ;; won't exist (eg, rlogin buffers)                  ;; won't exist (eg, rlogin buffers)
# Line 321  You can enable directory tracking by add Line 326  You can enable directory tracking by add
326                      (and (shell-process-cd prompt-path)                      (and (shell-process-cd prompt-path)
327                           (run-hooks 'dirtrack-directory-change-hook)                           (run-hooks 'dirtrack-directory-change-hook)
328                           dirtrack-debug                           dirtrack-debug
329                           (dirtrack-debug-message                           (dirtrack-debug-message
330                            (format "Changing directory to %s" prompt-path)))                            (format "Changing directory to %s" prompt-path)))
331                    (error "Directory %s does not exist" prompt-path)))                    (error "Directory %s does not exist" prompt-path)))
332                )))))                )))))

Legend:
Removed from v.1.11  
changed lines
  Added in v.1.11.16.1

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26