Mercurial > emacs
annotate lisp/dirtrack.el @ 17077:8f8c3d05b158
(byte-compile-file): Bind coding-system-for-write
instead of coding-system-for-read to 'no-conversion to disbale
code convertion by write-region.
author | Kenichi Handa <handa@m17n.org> |
---|---|
date | Wed, 26 Feb 1997 11:59:40 +0000 |
parents | 8c56da3f7f7f |
children | c3daa16fce91 |
rev | line source |
---|---|
16817 | 1 ;;; dirtrack.el --- Directory Tracking by watching the prompt |
2 | |
3 ;; Copyright (C) 1996 Free Software Foundation, Inc. | |
4 | |
5 ;; Author: Peter Breton | |
6 ;; Created: Sun Nov 17 1996 | |
7 ;; Keywords: processes | |
16960
8c56da3f7f7f
(dirtrack-debug-message): Put output at end of buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16817
diff
changeset
|
8 ;; Time-stamp: <97/02/01 20:35:06 peter> |
16817 | 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., 59 Temple Place - Suite 330, | |
25 ;; Boston, MA 02111-1307, 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'. | |
63 ;; | |
64 ;; 3) Autoload directory tracking by adding the following to your .emacs: | |
65 ;; | |
66 ;; (autoload 'dirtrack "dirtrack" | |
67 ;; "Directory tracking by watching the prompt") | |
68 ;; | |
69 ;; 4) Add a hook to shell-mode to enable the directory tracking: | |
70 ;; | |
71 ;; (add-hook 'shell-mode-hook | |
72 ;; (function (lambda () | |
73 ;; (setq comint-output-filter-functions | |
74 ;; (append (list 'dirtrack) | |
75 ;; comint-output-filter-functions))))) | |
76 ;; | |
77 ;; You may wish to turn ordinary shell tracking off by calling | |
78 ;; 'shell-dirtrack-toggle' or setting 'shell-dirtrackp'. | |
79 ;; | |
80 ;; Examples: | |
81 ;; | |
82 ;; 1) On Windows NT, my prompt is set to emacs$S$P$G. | |
83 ;; 'dirtrack-list' is set to (list "^emacs \\([a-zA-Z]:.*\\)>" 1) | |
84 ;; | |
85 ;; 2) On Solaris running bash, my prompt is set like this: | |
86 ;; PS1="\w\012emacs@\h(\!) [\t]% " | |
87 ;; 'dirtrack-list' is set to (list "^\\([/~].*\\)\nemacs@[^%]+% *" 1 t) | |
88 ;; | |
89 ;; I'd appreciate other examples from people who use this package. | |
90 | |
91 ;;; Code: | |
92 | |
93 (eval-when-compile | |
94 (require 'comint) | |
95 (require 'shell)) | |
96 | |
97 (defvar dirtrack-list (list "^emacs \\([a-zA-Z]:.*\\)>" 1) | |
98 "*List for directory tracking. | |
99 First item is a regexp that describes where to find the path in a prompt. | |
100 Second is a number, the regexp group to match. Optional third item is | |
101 whether the prompt is multi-line. If nil or omitted, prompt is assumed to | |
102 be on a single line.") | |
103 | |
104 (make-variable-buffer-local 'dirtrack-list) | |
105 | |
106 (defvar dirtrack-debug nil | |
107 "*If non-nil, the function 'dirtrack' will report debugging info.") | |
108 | |
109 (defvar dirtrack-debug-buffer "*Directory Tracking Log*" | |
110 "Buffer to write directory tracking debug information.") | |
111 | |
112 (defvar dirtrackp t | |
113 "*If non-nil, directory tracking via 'dirtrack' is enabled.") | |
114 | |
115 (make-variable-buffer-local 'dirtrackp) | |
116 | |
117 (defvar dirtrack-directory-function | |
118 (if (memq system-type (list 'ms-dos 'windows-nt)) | |
119 'dirtrack-windows-directory-function | |
120 'dirtrack-default-directory-function) | |
121 "*Function to apply to the prompt directory for comparison purposes.") | |
122 | |
123 (defvar dirtrack-canonicalize-function | |
124 (if (memq system-type (list 'ms-dos 'windows-nt)) | |
125 'downcase 'identity) | |
126 "*Function to apply to the default directory for comparison purposes.") | |
127 | |
128 (defun dirtrack-default-directory-function (dir) | |
129 "Return a canonical directory for comparison purposes. | |
130 Such a directory ends with a forward slash." | |
131 (let ((directory dir)) | |
132 (if (not (char-equal ?/ (string-to-char (substring directory -1)))) | |
133 (concat directory "/") | |
134 directory))) | |
135 | |
136 (defun dirtrack-windows-directory-function (dir) | |
137 "Return a canonical directory for comparison purposes. | |
138 Such a directory is all lowercase, has forward-slashes as delimiters, | |
139 and ends with a forward slash." | |
140 (let ((directory dir)) | |
141 (setq directory (downcase (replace-slash directory t))) | |
142 (if (not (char-equal ?/ (string-to-char (substring directory -1)))) | |
143 (concat directory "/") | |
144 directory))) | |
145 | |
146 (defconst forward-slash (regexp-quote "/")) | |
147 (defconst backward-slash (regexp-quote "\\")) | |
148 | |
149 (defun replace-slash (string &optional opposite) | |
150 "Replace forward slashes with backwards ones. | |
151 If additional argument is non-nil, replace backwards slashes with | |
152 forward ones." | |
153 (let ((orig (if opposite backward-slash forward-slash)) | |
154 (replace (if opposite forward-slash backward-slash)) | |
155 (newstring string) | |
156 ) | |
157 (while (string-match orig newstring) | |
158 (setq newstring (replace-match replace nil t newstring))) | |
159 newstring)) | |
160 | |
161 ;; Copied from shell.el | |
162 (defun dirtrack-toggle () | |
163 "Enable or disable Dirtrack directory tracking in a shell buffer." | |
164 (interactive) | |
165 (setq dirtrackp (not dirtrackp)) | |
166 (message "Directory tracking %s" (if dirtrackp "ON" "OFF"))) | |
167 | |
168 (defun dirtrack-debug-message (string) | |
169 (let ((buf (current-buffer)) | |
170 (debug-buf (get-buffer-create dirtrack-debug-buffer)) | |
171 ) | |
172 (set-buffer debug-buf) | |
16960
8c56da3f7f7f
(dirtrack-debug-message): Put output at end of buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16817
diff
changeset
|
173 (goto-char (point-max)) |
16817 | 174 (insert (concat string "\n")) |
175 (set-buffer buf) | |
176 )) | |
177 | |
178 ;;;###autoload | |
179 (defun dirtrack (input) | |
180 (if (null dirtrackp) | |
181 nil | |
182 (let ((prompt-path) | |
183 (current-dir default-directory) | |
184 (matched) | |
16960
8c56da3f7f7f
(dirtrack-debug-message): Put output at end of buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16817
diff
changeset
|
185 (dirtrack-regexp (nth 0 dirtrack-list)) |
16817 | 186 (match-num (nth 1 dirtrack-list)) |
187 (multi-line (nth 2 dirtrack-list)) | |
188 ) | |
189 ;; No output? | |
190 (if (eq (point) (point-min)) | |
191 nil | |
192 (save-excursion | |
16960
8c56da3f7f7f
(dirtrack-debug-message): Put output at end of buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16817
diff
changeset
|
193 (goto-char (point-max)) |
16817 | 194 ;; Look for the prompt |
195 (if multi-line | |
16960
8c56da3f7f7f
(dirtrack-debug-message): Put output at end of buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16817
diff
changeset
|
196 (setq matched |
8c56da3f7f7f
(dirtrack-debug-message): Put output at end of buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16817
diff
changeset
|
197 (re-search-backward |
8c56da3f7f7f
(dirtrack-debug-message): Put output at end of buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16817
diff
changeset
|
198 dirtrack-regexp |
8c56da3f7f7f
(dirtrack-debug-message): Put output at end of buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16817
diff
changeset
|
199 comint-last-output-start |
8c56da3f7f7f
(dirtrack-debug-message): Put output at end of buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16817
diff
changeset
|
200 t)) |
16817 | 201 (beginning-of-line) |
202 (setq matched (looking-at dirtrack-regexp))) | |
203 ;; No match | |
204 (if (null matched) | |
205 (and dirtrack-debug | |
206 (dirtrack-debug-message | |
207 (format | |
208 "Failed to match regexp: %s" | |
209 dirtrack-regexp))) | |
210 (setq prompt-path | |
211 (buffer-substring-no-properties | |
212 (match-beginning match-num) (match-end match-num))) | |
213 ;; Empty string | |
214 (if (not (> (length prompt-path) 0)) | |
215 (and dirtrack-debug | |
216 (dirtrack-debug-message "Match is empty string")) | |
217 ;; Transform prompts into canonical forms | |
218 (setq prompt-path (funcall dirtrack-directory-function | |
219 prompt-path)) | |
220 (setq current-dir (funcall dirtrack-canonicalize-function | |
221 current-dir)) | |
222 (and dirtrack-debug | |
223 (dirtrack-debug-message | |
224 (format | |
225 "Prompt is %s\nCurrent directory is %s" | |
226 prompt-path current-dir))) | |
227 ;; Compare them | |
228 (if (or (string= current-dir prompt-path) | |
229 (string= current-dir | |
230 (abbreviate-file-name prompt-path))) | |
231 (and dirtrack-debug | |
232 (dirtrack-debug-message | |
233 (format "Not changing directory"))) | |
16960
8c56da3f7f7f
(dirtrack-debug-message): Put output at end of buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16817
diff
changeset
|
234 ;; It's possible that Emacs will think the directory |
8c56da3f7f7f
(dirtrack-debug-message): Put output at end of buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16817
diff
changeset
|
235 ;; won't exist (eg, rlogin buffers) |
8c56da3f7f7f
(dirtrack-debug-message): Put output at end of buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16817
diff
changeset
|
236 (if (file-accessible-directory-p prompt-path) |
8c56da3f7f7f
(dirtrack-debug-message): Put output at end of buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16817
diff
changeset
|
237 ;; Change directory |
8c56da3f7f7f
(dirtrack-debug-message): Put output at end of buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16817
diff
changeset
|
238 (and (shell-process-cd prompt-path) |
8c56da3f7f7f
(dirtrack-debug-message): Put output at end of buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16817
diff
changeset
|
239 dirtrack-debug |
8c56da3f7f7f
(dirtrack-debug-message): Put output at end of buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16817
diff
changeset
|
240 (dirtrack-debug-message |
8c56da3f7f7f
(dirtrack-debug-message): Put output at end of buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16817
diff
changeset
|
241 (format "Changing directory to %s" prompt-path))) |
8c56da3f7f7f
(dirtrack-debug-message): Put output at end of buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16817
diff
changeset
|
242 (error "Directory %s does not exist" prompt-path))) |
16817 | 243 ))))))) |
244 | |
245 (provide 'dirtrack) | |
246 | |
247 ;;; dirtrack.el ends here |