Mercurial > emacs
comparison lisp/dirtrack.el @ 16817:40eaf36862f4
Initial revision
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Fri, 03 Jan 1997 01:16:16 +0000 |
parents | |
children | 8c56da3f7f7f |
comparison
equal
deleted
inserted
replaced
16816:9bdccdf9388b | 16817:40eaf36862f4 |
---|---|
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 | |
8 ;; Time-stamp: <96/12/26 09:23:01 peter> | |
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) | |
173 (insert (concat string "\n")) | |
174 (set-buffer buf) | |
175 )) | |
176 | |
177 ;;;###autoload | |
178 (defun dirtrack (input) | |
179 (if (null dirtrackp) | |
180 nil | |
181 (let ((prompt-path) | |
182 (current-dir default-directory) | |
183 (matched) | |
184 (dirtrack-regexp (nth 0 dirtrack-list)) | |
185 (match-num (nth 1 dirtrack-list)) | |
186 (multi-line (nth 2 dirtrack-list)) | |
187 ) | |
188 ;; No output? | |
189 (if (eq (point) (point-min)) | |
190 nil | |
191 (save-excursion | |
192 (goto-char comint-last-output-start) | |
193 ;; Look for the prompt | |
194 (if multi-line | |
195 (and | |
196 (goto-char (point-max)) | |
197 (setq matched | |
198 (re-search-backward | |
199 dirtrack-regexp | |
200 comint-last-output-start | |
201 t))) | |
202 (beginning-of-line) | |
203 (setq matched (looking-at dirtrack-regexp))) | |
204 ;; No match | |
205 (if (null matched) | |
206 (and dirtrack-debug | |
207 (dirtrack-debug-message | |
208 (format | |
209 "Failed to match regexp: %s" | |
210 dirtrack-regexp))) | |
211 (setq prompt-path | |
212 (buffer-substring-no-properties | |
213 (match-beginning match-num) (match-end match-num))) | |
214 ;; Empty string | |
215 (if (not (> (length prompt-path) 0)) | |
216 (and dirtrack-debug | |
217 (dirtrack-debug-message "Match is empty string")) | |
218 ;; Transform prompts into canonical forms | |
219 (setq prompt-path (funcall dirtrack-directory-function | |
220 prompt-path)) | |
221 (setq current-dir (funcall dirtrack-canonicalize-function | |
222 current-dir)) | |
223 (and dirtrack-debug | |
224 (dirtrack-debug-message | |
225 (format | |
226 "Prompt is %s\nCurrent directory is %s" | |
227 prompt-path current-dir))) | |
228 ;; Compare them | |
229 (if (or (string= current-dir prompt-path) | |
230 (string= current-dir | |
231 (abbreviate-file-name prompt-path))) | |
232 (and dirtrack-debug | |
233 (dirtrack-debug-message | |
234 (format "Not changing directory"))) | |
235 ;; Change directory | |
236 (shell-process-cd prompt-path) | |
237 (and dirtrack-debug | |
238 (dirtrack-debug-message | |
239 (format "Changing directory to %s" prompt-path)))) | |
240 ))))))) | |
241 | |
242 (provide 'dirtrack) | |
243 | |
244 ;;; dirtrack.el ends here |