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