Mercurial > emacs
comparison lisp/dirtrack.el @ 21183:934132d62987
Customized.
(dirtrack-forward-slash): Renamed from `forward-slash'.
(dirtrack-backward-slash): Renamed from `backward-slash'.
(dirtrack-replace-slash): Renamed from `replace-slash'.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Sat, 14 Mar 1998 21:44:13 +0000 |
parents | 852464ce5d6a |
children | ce9dd8548989 |
comparison
equal
deleted
inserted
replaced
21182:9049fbf96317 | 21183:934132d62987 |
---|---|
1 ;;; dirtrack.el --- Directory Tracking by watching the prompt | 1 ;;; dirtrack.el --- Directory Tracking by watching the prompt |
2 | 2 |
3 ;; Copyright (C) 1996 Free Software Foundation, Inc. | 3 ;; Copyright (C) 1996 Free Software Foundation, Inc. |
4 | 4 |
5 ;; Author: Peter Breton <pbreton@i-kinetics.com> | 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: <97/02/01 20:35:06 peter> | 8 ;; Time-stamp: <1998-03-14 09:24:38 pbreton> |
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 |
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'. | 62 ;; filter to log messages to the buffer `dirtrack-debug-buffer'. |
63 ;; | 63 ;; |
64 ;; 3) Add a hook to shell-mode to enable the directory tracking: | 64 ;; 3) Add a hook to shell-mode to enable the directory tracking: |
65 ;; | 65 ;; |
66 ;; (add-hook 'shell-mode-hook | 66 ;; (add-hook 'shell-mode-hook |
67 ;; (function (lambda () | 67 ;; (function (lambda () |
68 ;; (setq comint-output-filter-functions | 68 ;; (setq comint-output-filter-functions |
69 ;; (append (list 'dirtrack) | 69 ;; (append (list 'dirtrack) |
70 ;; comint-output-filter-functions))))) | 70 ;; comint-output-filter-functions))))) |
71 ;; | 71 ;; |
72 ;; You may wish to turn ordinary shell tracking off by calling | 72 ;; You may wish to turn ordinary shell tracking off by calling |
73 ;; 'shell-dirtrack-toggle' or setting 'shell-dirtrackp'. | 73 ;; `shell-dirtrack-toggle' or setting `shell-dirtrackp'. |
74 ;; | 74 ;; |
75 ;; Examples: | 75 ;; Examples: |
76 ;; | 76 ;; |
77 ;; 1) On Windows NT, my prompt is set to emacs$S$P$G. | 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) | 78 ;; 'dirtrack-list' is set to (list "^emacs \\([a-zA-Z]:.*\\)>" 1) |
80 ;; 2) On Solaris running bash, my prompt is set like this: | 80 ;; 2) On Solaris running bash, my prompt is set like this: |
81 ;; PS1="\w\012emacs@\h(\!) [\t]% " | 81 ;; PS1="\w\012emacs@\h(\!) [\t]% " |
82 ;; 'dirtrack-list' is set to (list "^\\([/~].*\\)\nemacs@[^%]+% *" 1 t) | 82 ;; 'dirtrack-list' is set to (list "^\\([/~].*\\)\nemacs@[^%]+% *" 1 t) |
83 ;; | 83 ;; |
84 ;; I'd appreciate other examples from people who use this package. | 84 ;; I'd appreciate other examples from people who use this package. |
85 ;; | |
86 ;; Here's one from Stephen Eglen: | |
87 ;; | |
88 ;; Running under tcsh: | |
89 ;; (setq-default dirtrack-list '("^%E \\([^ ]+\\)" 1)) | |
90 ;; | |
91 ;; 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 | |
93 ;; shell. So for example, I have the following in ~/.emacs_tcsh: | |
94 ;; | |
95 ;; set prompt = "%%E %~ %h% " | |
96 ;; | |
97 ;; This produces a prompt of the form: | |
98 ;; %E /var/spool 10% | |
99 ;; | |
100 ;; This saves me from having to use the %E prefix in other non-emacs | |
101 ;; shells. | |
85 | 102 |
86 ;;; Code: | 103 ;;; Code: |
87 | 104 |
88 (eval-when-compile | 105 (eval-when-compile |
89 (require 'comint) | 106 (require 'comint) |
90 (require 'shell)) | 107 (require 'shell)) |
91 | 108 |
92 (defvar dirtrack-list (list "^emacs \\([a-zA-Z]:.*\\)>" 1) | 109 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
110 ;; Customization Variables | |
111 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
112 | |
113 (defgroup dirtrack nil | |
114 "Directory tracking by watching the prompt." | |
115 :prefix "dirtrack-" | |
116 :group 'shell) | |
117 | |
118 (defcustom dirtrack-list (list "^emacs \\([a-zA-Z]:.*\\)>" 1) | |
93 "*List for directory tracking. | 119 "*List for directory tracking. |
94 First item is a regexp that describes where to find the path in a prompt. | 120 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 | 121 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 | 122 whether the prompt is multi-line. If nil or omitted, prompt is assumed to |
97 be on a single line.") | 123 be on a single line." |
124 :group 'dirtrack | |
125 :type '(sexp (regexp :tag "Prompt Expression") | |
126 (integer :tag "Regexp Group") | |
127 (boolean :tag "Multiline Prompt") | |
128 ) | |
129 ) | |
98 | 130 |
99 (make-variable-buffer-local 'dirtrack-list) | 131 (make-variable-buffer-local 'dirtrack-list) |
100 | 132 |
101 (defvar dirtrack-debug nil | 133 (defcustom dirtrack-debug nil |
102 "*If non-nil, the function 'dirtrack' will report debugging info.") | 134 "*If non-nil, the function `dirtrack' will report debugging info." |
103 | 135 :group 'dirtrack |
104 (defvar dirtrack-debug-buffer "*Directory Tracking Log*" | 136 :type 'boolean |
105 "Buffer to write directory tracking debug information.") | 137 ) |
106 | 138 |
107 (defvar dirtrackp t | 139 (defcustom dirtrack-debug-buffer "*Directory Tracking Log*" |
108 "*If non-nil, directory tracking via 'dirtrack' is enabled.") | 140 "Buffer to write directory tracking debug information." |
141 :group 'dirtrack | |
142 :type 'string | |
143 ) | |
144 | |
145 (defcustom dirtrackp t | |
146 "*If non-nil, directory tracking via `dirtrack' is enabled." | |
147 :group 'dirtrack | |
148 :type 'boolean | |
149 ) | |
109 | 150 |
110 (make-variable-buffer-local 'dirtrackp) | 151 (make-variable-buffer-local 'dirtrackp) |
111 | 152 |
112 (defvar dirtrack-directory-function | 153 (defcustom dirtrack-directory-function |
113 (if (memq system-type (list 'ms-dos 'windows-nt)) | 154 (if (memq system-type (list 'ms-dos 'windows-nt)) |
114 'dirtrack-windows-directory-function | 155 'dirtrack-windows-directory-function |
115 'dirtrack-default-directory-function) | 156 'dirtrack-default-directory-function) |
116 "*Function to apply to the prompt directory for comparison purposes.") | 157 "*Function to apply to the prompt directory for comparison purposes." |
117 | 158 :group 'dirtrack |
118 (defvar dirtrack-canonicalize-function | 159 :type 'function |
160 ) | |
161 | |
162 (defcustom dirtrack-canonicalize-function | |
119 (if (memq system-type (list 'ms-dos 'windows-nt)) | 163 (if (memq system-type (list 'ms-dos 'windows-nt)) |
120 'downcase 'identity) | 164 'downcase 'identity) |
121 "*Function to apply to the default directory for comparison purposes.") | 165 "*Function to apply to the default directory for comparison purposes." |
166 :group 'dirtrack | |
167 :type 'function | |
168 ) | |
169 | |
170 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
171 ;; Functions | |
172 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
122 | 173 |
123 (defun dirtrack-default-directory-function (dir) | 174 (defun dirtrack-default-directory-function (dir) |
124 "Return a canonical directory for comparison purposes. | 175 "Return a canonical directory for comparison purposes. |
125 Such a directory ends with a forward slash." | 176 Such a directory ends with a forward slash." |
126 (let ((directory dir)) | 177 (let ((directory dir)) |
131 (defun dirtrack-windows-directory-function (dir) | 182 (defun dirtrack-windows-directory-function (dir) |
132 "Return a canonical directory for comparison purposes. | 183 "Return a canonical directory for comparison purposes. |
133 Such a directory is all lowercase, has forward-slashes as delimiters, | 184 Such a directory is all lowercase, has forward-slashes as delimiters, |
134 and ends with a forward slash." | 185 and ends with a forward slash." |
135 (let ((directory dir)) | 186 (let ((directory dir)) |
136 (setq directory (downcase (replace-slash directory t))) | 187 (setq directory (downcase (dirtrack-replace-slash directory t))) |
137 (if (not (char-equal ?/ (string-to-char (substring directory -1)))) | 188 (if (not (char-equal ?/ (string-to-char (substring directory -1)))) |
138 (concat directory "/") | 189 (concat directory "/") |
139 directory))) | 190 directory))) |
140 | 191 |
141 (defconst forward-slash (regexp-quote "/")) | 192 (defconst dirtrack-forward-slash (regexp-quote "/")) |
142 (defconst backward-slash (regexp-quote "\\")) | 193 (defconst dirtrack-backward-slash (regexp-quote "\\")) |
143 | 194 |
144 (defun replace-slash (string &optional opposite) | 195 (defun dirtrack-replace-slash (string &optional opposite) |
145 "Replace forward slashes with backwards ones. | 196 "Replace forward slashes with backwards ones. |
146 If additional argument is non-nil, replace backwards slashes with | 197 If additional argument is non-nil, replace backwards slashes with |
147 forward ones." | 198 forward ones." |
148 (let ((orig (if opposite backward-slash forward-slash)) | 199 (let ((orig (if opposite |
149 (replace (if opposite forward-slash backward-slash)) | 200 dirtrack-backward-slash |
201 dirtrack-forward-slash)) | |
202 (replace (if opposite | |
203 dirtrack-forward-slash | |
204 dirtrack-backward-slash)) | |
150 (newstring string) | 205 (newstring string) |
151 ) | 206 ) |
152 (while (string-match orig newstring) | 207 (while (string-match orig newstring) |
153 (setq newstring (replace-match replace nil t newstring))) | 208 (setq newstring (replace-match replace nil t newstring))) |
154 newstring)) | 209 newstring)) |