Mercurial > emacs
comparison lisp/dirtrack.el @ 49549:99be3a1e2589
Cygwin support patch.
author | Juanma Barranquero <lekktu@gmail.com> |
---|---|
date | Fri, 31 Jan 2003 15:24:20 +0000 |
parents | 5f41effdffe6 |
children | 251a71560199 d7ddb3e565de |
comparison
equal
deleted
inserted
replaced
49548:8b1c605f8c9b | 49549:99be3a1e2589 |
---|---|
3 ;; Copyright (C) 1996 Free Software Foundation, Inc. | 3 ;; Copyright (C) 1996 Free Software Foundation, Inc. |
4 | 4 |
5 ;; Author: Peter Breton <pbreton@cs.umb.edu> | 5 ;; Author: Peter Breton <pbreton@cs.umb.edu> |
6 ;; Created: Sun Nov 17 1996 | 6 ;; Created: Sun Nov 17 1996 |
7 ;; Keywords: processes | 7 ;; Keywords: processes |
8 ;; Time-stamp: <1999-02-21 01:27:24 pbreton> | 8 ;; Time-stamp: <2003-01-31 16:15:05 jbarranquero> |
9 | 9 |
10 ;; This file is part of GNU Emacs. | 10 ;; This file is part of GNU Emacs. |
11 | 11 |
12 ;; GNU Emacs is free software; you can redistribute it and/or modify | 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 | 13 ;; it under the terms of the GNU General Public License as published by |
40 ;; Installation: | 40 ;; Installation: |
41 ;; | 41 ;; |
42 ;; 1) Set your shell's prompt to contain the current working directory. | 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 | 43 ;; You may need to consult your shell's documentation to find out how to |
44 ;; do this. | 44 ;; do this. |
45 ;; | 45 ;; |
46 ;; Note that directory tracking is done by matching regular expressions, | 46 ;; Note that directory tracking is done by matching regular expressions, |
47 ;; therefore it is *VERY IMPORTANT* for your prompt to be easily | 47 ;; therefore it is *VERY IMPORTANT* for your prompt to be easily |
48 ;; distinguishable from other output. If your prompt regexp is too general, | 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 | 49 ;; you will see error messages from the dirtrack filter as it attempts to cd |
50 ;; to non-existent directories. | 50 ;; to non-existent directories. |
51 ;; | 51 ;; |
52 ;; 2) Set the variable `dirtrack-list' to an appropriate value. This | 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 | 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. | 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 | 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, | 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 | 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). | 58 ;; 'comint.el' assume a single-line prompt (eg, comint-bol). |
59 ;; | 59 ;; |
60 ;; Determining this information may take some experimentation. Setting | 60 ;; Determining this information may take some experimentation. Setting |
61 ;; the variable `dirtrack-debug' may help; it causes the directory-tracking | 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 | 62 ;; filter to log messages to the buffer `dirtrack-debug-buffer'. You can easily |
63 ;; toggle this setting with the `dirtrack-debug-toggle' function. | 63 ;; toggle this setting with the `dirtrack-debug-toggle' function. |
64 ;; | 64 ;; |
65 ;; 3) Add a hook to shell-mode to enable the directory tracking: | 65 ;; 3) Add a hook to shell-mode to enable the directory tracking: |
66 ;; | 66 ;; |
67 ;; (add-hook 'shell-mode-hook | 67 ;; (add-hook 'shell-mode-hook |
68 ;; (function (lambda () | 68 ;; (function (lambda () |
69 ;; (setq comint-preoutput-filter-functions | 69 ;; (setq comint-preoutput-filter-functions |
81 ;; 2) On Solaris running bash, my prompt is set like this: | 81 ;; 2) On Solaris running bash, my prompt is set like this: |
82 ;; PS1="\w\012emacs@\h(\!) [\t]% " | 82 ;; PS1="\w\012emacs@\h(\!) [\t]% " |
83 ;; 'dirtrack-list' is set to (list "^\\([/~].*\\)\nemacs@[^%]+% *" 1 t) | 83 ;; 'dirtrack-list' is set to (list "^\\([/~].*\\)\nemacs@[^%]+% *" 1 t) |
84 ;; | 84 ;; |
85 ;; I'd appreciate other examples from people who use this package. | 85 ;; I'd appreciate other examples from people who use this package. |
86 ;; | 86 ;; |
87 ;; Here's one from Stephen Eglen: | 87 ;; Here's one from Stephen Eglen: |
88 ;; | 88 ;; |
89 ;; Running under tcsh: | 89 ;; Running under tcsh: |
90 ;; (setq-default dirtrack-list '("^%E \\([^ ]+\\)" 1)) | 90 ;; (setq-default dirtrack-list '("^%E \\([^ ]+\\)" 1)) |
91 ;; | 91 ;; |
92 ;; It might be worth mentioning in your file that emacs sources start up | 92 ;; It might be worth mentioning in your file that emacs sources start up |
93 ;; files of the form: ~/.emacs_<SHELL> where <SHELL> is the name of the | 93 ;; files of the form: ~/.emacs_<SHELL> where <SHELL> is the name of the |
94 ;; shell. So for example, I have the following in ~/.emacs_tcsh: | 94 ;; shell. So for example, I have the following in ~/.emacs_tcsh: |
95 ;; | 95 ;; |
96 ;; set prompt = "%%E %~ %h% " | 96 ;; set prompt = "%%E %~ %h% " |
97 ;; | 97 ;; |
98 ;; This produces a prompt of the form: | 98 ;; This produces a prompt of the form: |
99 ;; %E /var/spool 10% | 99 ;; %E /var/spool 10% |
100 ;; | 100 ;; |
101 ;; This saves me from having to use the %E prefix in other non-emacs | 101 ;; This saves me from having to use the %E prefix in other non-emacs |
102 ;; shells. | 102 ;; shells. |
103 ;; | 103 ;; |
104 ;; A final note: | 104 ;; A final note: |
105 ;; | 105 ;; |
106 ;; I run LOTS of shell buffers through Emacs, sometimes as different users | 106 ;; I run LOTS of shell buffers through Emacs, sometimes as different users |
107 ;; (eg, when logged in as myself, I'll run a root shell in the same Emacs). | 107 ;; (eg, when logged in as myself, I'll run a root shell in the same Emacs). |
108 ;; If you do this, and the shell prompt contains a ~, Emacs will interpret | 108 ;; If you do this, and the shell prompt contains a ~, Emacs will interpret |
109 ;; this relative to the user which owns the Emacs process, not the user | 109 ;; this relative to the user which owns the Emacs process, not the user |
110 ;; who owns the shell buffer. This may cause dirtrack to behave strangely | 110 ;; who owns the shell buffer. This may cause dirtrack to behave strangely |
132 :group 'shell) | 132 :group 'shell) |
133 | 133 |
134 (defcustom dirtrack-list (list "^emacs \\([a-zA-Z]:.*\\)>" 1) | 134 (defcustom dirtrack-list (list "^emacs \\([a-zA-Z]:.*\\)>" 1) |
135 "*List for directory tracking. | 135 "*List for directory tracking. |
136 First item is a regexp that describes where to find the path in a prompt. | 136 First item is a regexp that describes where to find the path in a prompt. |
137 Second is a number, the regexp group to match. Optional third item is | 137 Second is a number, the regexp group to match. Optional third item is |
138 whether the prompt is multi-line. If nil or omitted, prompt is assumed to | 138 whether the prompt is multi-line. If nil or omitted, prompt is assumed to |
139 be on a single line." | 139 be on a single line." |
140 :group 'dirtrack | 140 :group 'dirtrack |
141 :type '(sexp (regexp :tag "Prompt Expression") | 141 :type '(sexp (regexp :tag "Prompt Expression") |
142 (integer :tag "Regexp Group") | 142 (integer :tag "Regexp Group") |
143 (boolean :tag "Multiline Prompt") | 143 (boolean :tag "Multiline Prompt") |
144 ) | 144 ) |
145 ) | 145 ) |
146 | 146 |
164 :type 'boolean | 164 :type 'boolean |
165 ) | 165 ) |
166 | 166 |
167 (make-variable-buffer-local 'dirtrackp) | 167 (make-variable-buffer-local 'dirtrackp) |
168 | 168 |
169 (defcustom dirtrack-directory-function | 169 (defcustom dirtrack-directory-function |
170 (if (memq system-type (list 'ms-dos 'windows-nt)) | 170 (if (memq system-type (list 'ms-dos 'windows-nt 'cygwin)) |
171 'dirtrack-windows-directory-function | 171 'dirtrack-windows-directory-function |
172 'dirtrack-default-directory-function) | 172 'dirtrack-default-directory-function) |
173 "*Function to apply to the prompt directory for comparison purposes." | 173 "*Function to apply to the prompt directory for comparison purposes." |
174 :group 'dirtrack | 174 :group 'dirtrack |
175 :type 'function | 175 :type 'function |
176 ) | 176 ) |
177 | 177 |
178 (defcustom dirtrack-canonicalize-function | 178 (defcustom dirtrack-canonicalize-function |
179 (if (memq system-type (list 'ms-dos 'windows-nt)) | 179 (if (memq system-type (list 'ms-dos 'windows-nt 'cygwin)) |
180 'downcase 'identity) | 180 'downcase 'identity) |
181 "*Function to apply to the default directory for comparison purposes." | 181 "*Function to apply to the default directory for comparison purposes." |
182 :group 'dirtrack | 182 :group 'dirtrack |
183 :type 'function | 183 :type 'function |
184 ) | 184 ) |
202 (concat directory "/") | 202 (concat directory "/") |
203 directory))) | 203 directory))) |
204 | 204 |
205 (defun dirtrack-windows-directory-function (dir) | 205 (defun dirtrack-windows-directory-function (dir) |
206 "Return a canonical directory for comparison purposes. | 206 "Return a canonical directory for comparison purposes. |
207 Such a directory is all lowercase, has forward-slashes as delimiters, | 207 Such a directory is all lowercase, has forward-slashes as delimiters, |
208 and ends with a forward slash." | 208 and ends with a forward slash." |
209 (let ((directory dir)) | 209 (let ((directory dir)) |
210 (setq directory (downcase (dirtrack-replace-slash directory t))) | 210 (setq directory (downcase (dirtrack-replace-slash directory t))) |
211 (if (not (char-equal ?/ (string-to-char (substring directory -1)))) | 211 (if (not (char-equal ?/ (string-to-char (substring directory -1)))) |
212 (concat directory "/") | 212 (concat directory "/") |
215 (defconst dirtrack-forward-slash (regexp-quote "/")) | 215 (defconst dirtrack-forward-slash (regexp-quote "/")) |
216 (defconst dirtrack-backward-slash (regexp-quote "\\")) | 216 (defconst dirtrack-backward-slash (regexp-quote "\\")) |
217 | 217 |
218 (defun dirtrack-replace-slash (string &optional opposite) | 218 (defun dirtrack-replace-slash (string &optional opposite) |
219 "Replace forward slashes with backwards ones. | 219 "Replace forward slashes with backwards ones. |
220 If additional argument is non-nil, replace backwards slashes with | 220 If additional argument is non-nil, replace backwards slashes with |
221 forward ones." | 221 forward ones." |
222 (let ((orig (if opposite | 222 (let ((orig (if opposite |
223 dirtrack-backward-slash | 223 dirtrack-backward-slash |
224 dirtrack-forward-slash)) | 224 dirtrack-forward-slash)) |
225 (replace (if opposite | 225 (replace (if opposite |
226 dirtrack-forward-slash | 226 dirtrack-forward-slash |
227 dirtrack-backward-slash)) | 227 dirtrack-backward-slash)) |
228 (newstring string) | 228 (newstring string) |
229 ) | 229 ) |
230 (while (string-match orig newstring) | 230 (while (string-match orig newstring) |
231 (setq newstring (replace-match replace nil t newstring))) | 231 (setq newstring (replace-match replace nil t newstring))) |
264 You can toggle directory tracking by using the function `dirtrack-toggle'. | 264 You can toggle directory tracking by using the function `dirtrack-toggle'. |
265 | 265 |
266 If directory tracking does not seem to be working, you can use the | 266 If directory tracking does not seem to be working, you can use the |
267 function `dirtrack-debug-toggle' to turn on debugging output. | 267 function `dirtrack-debug-toggle' to turn on debugging output. |
268 | 268 |
269 You can enable directory tracking by adding this function to | 269 You can enable directory tracking by adding this function to |
270 `comint-output-filter-functions'. | 270 `comint-output-filter-functions'. |
271 " | 271 " |
272 (if (null dirtrackp) | 272 (if (null dirtrackp) |
273 nil | 273 nil |
274 (let (prompt-path | 274 (let (prompt-path |
284 (save-excursion | 284 (save-excursion |
285 (setq matched (string-match dirtrack-regexp input))) | 285 (setq matched (string-match dirtrack-regexp input))) |
286 ;; No match | 286 ;; No match |
287 (if (null matched) | 287 (if (null matched) |
288 (and dirtrack-debug | 288 (and dirtrack-debug |
289 (dirtrack-debug-message | 289 (dirtrack-debug-message |
290 (format | 290 (format |
291 "Input `%s' failed to match regexp: %s" | 291 "Input `%s' failed to match regexp: %s" |
292 input dirtrack-regexp))) | 292 input dirtrack-regexp))) |
293 (setq prompt-path | 293 (setq prompt-path |
294 (substring input | 294 (substring input |
295 (match-beginning match-num) (match-end match-num))) | 295 (match-beginning match-num) (match-end match-num))) |
296 ;; Empty string | 296 ;; Empty string |
297 (if (not (> (length prompt-path) 0)) | 297 (if (not (> (length prompt-path) 0)) |
298 (and dirtrack-debug | 298 (and dirtrack-debug |
299 (dirtrack-debug-message "Match is empty string")) | 299 (dirtrack-debug-message "Match is empty string")) |
300 ;; Transform prompts into canonical forms | 300 ;; Transform prompts into canonical forms |
301 (setq prompt-path (funcall dirtrack-directory-function | 301 (setq prompt-path (funcall dirtrack-directory-function |
302 prompt-path)) | 302 prompt-path)) |
303 (setq current-dir (funcall dirtrack-canonicalize-function | 303 (setq current-dir (funcall dirtrack-canonicalize-function |
304 current-dir)) | 304 current-dir)) |
305 (and dirtrack-debug | 305 (and dirtrack-debug |
306 (dirtrack-debug-message | 306 (dirtrack-debug-message |
307 (format | 307 (format |
308 "Prompt is %s\nCurrent directory is %s" | 308 "Prompt is %s\nCurrent directory is %s" |
309 prompt-path current-dir))) | 309 prompt-path current-dir))) |
310 ;; Compare them | 310 ;; Compare them |
311 (if (or (string= current-dir prompt-path) | 311 (if (or (string= current-dir prompt-path) |
312 (string= current-dir | 312 (string= current-dir |
313 (abbreviate-file-name prompt-path))) | 313 (abbreviate-file-name prompt-path))) |
314 (and dirtrack-debug | 314 (and dirtrack-debug |
315 (dirtrack-debug-message | 315 (dirtrack-debug-message |
316 (format "Not changing directory"))) | 316 (format "Not changing directory"))) |
317 ;; It's possible that Emacs will think the directory | 317 ;; It's possible that Emacs will think the directory |
318 ;; won't exist (eg, rlogin buffers) | 318 ;; won't exist (eg, rlogin buffers) |
319 (if (file-accessible-directory-p prompt-path) | 319 (if (file-accessible-directory-p prompt-path) |
320 ;; Change directory | 320 ;; Change directory |
321 (and (shell-process-cd prompt-path) | 321 (and (shell-process-cd prompt-path) |
322 (run-hooks 'dirtrack-directory-change-hook) | 322 (run-hooks 'dirtrack-directory-change-hook) |
323 dirtrack-debug | 323 dirtrack-debug |
324 (dirtrack-debug-message | 324 (dirtrack-debug-message |
325 (format "Changing directory to %s" prompt-path))) | 325 (format "Changing directory to %s" prompt-path))) |
326 (error "Directory %s does not exist" prompt-path))) | 326 (error "Directory %s does not exist" prompt-path))) |
327 ))))) | 327 ))))) |
328 input) | 328 input) |
329 | 329 |