aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
authorRichard M. Stallman1998-03-14 21:44:13 +0000
committerRichard M. Stallman1998-03-14 21:44:13 +0000
commitd1212648240dac5f58e65eea68a78a9dac9a61c8 (patch)
treea618d8b850f491bfe43f2ccc6cfed160c7429896 /lisp
parent6fe8a37af388aae8dbd2e10a7827846df20f5573 (diff)
downloademacs-d1212648240dac5f58e65eea68a78a9dac9a61c8.tar.gz
emacs-d1212648240dac5f58e65eea68a78a9dac9a61c8.zip
Customized.
(dirtrack-forward-slash): Renamed from `forward-slash'. (dirtrack-backward-slash): Renamed from `backward-slash'. (dirtrack-replace-slash): Renamed from `replace-slash'.
Diffstat (limited to 'lisp')
-rw-r--r--lisp/dirtrack.el103
1 files changed, 79 insertions, 24 deletions
diff --git a/lisp/dirtrack.el b/lisp/dirtrack.el
index 7d3b89e2c06..cadaf6dcfc0 100644
--- a/lisp/dirtrack.el
+++ b/lisp/dirtrack.el
@@ -2,10 +2,10 @@
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
@@ -49,7 +49,7 @@
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
@@ -58,8 +58,8 @@
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;;
@@ -70,7 +70,7 @@
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;;
@@ -82,6 +82,23 @@
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
@@ -89,36 +106,70 @@
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.
94First item is a regexp that describes where to find the path in a prompt. 120First item is a regexp that describes where to find the path in a prompt.
95Second is a number, the regexp group to match. Optional third item is 121Second is a number, the regexp group to match. Optional third item is
96whether the prompt is multi-line. If nil or omitted, prompt is assumed to 122whether the prompt is multi-line. If nil or omitted, prompt is assumed to
97be on a single line.") 123be 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."
135 :group 'dirtrack
136 :type 'boolean
137 )
103 138
104(defvar dirtrack-debug-buffer "*Directory Tracking Log*" 139(defcustom dirtrack-debug-buffer "*Directory Tracking Log*"
105 "Buffer to write directory tracking debug information.") 140 "Buffer to write directory tracking debug information."
141 :group 'dirtrack
142 :type 'string
143 )
106 144
107(defvar dirtrackp t 145(defcustom dirtrackp t
108 "*If non-nil, directory tracking via 'dirtrack' is enabled.") 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."
158 :group 'dirtrack
159 :type 'function
160 )
117 161
118(defvar dirtrack-canonicalize-function 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.
@@ -133,20 +184,24 @@ Such a directory ends with a forward slash."
133Such a directory is all lowercase, has forward-slashes as delimiters, 184Such a directory is all lowercase, has forward-slashes as delimiters,
134and ends with a forward slash." 185and 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.
146If additional argument is non-nil, replace backwards slashes with 197If additional argument is non-nil, replace backwards slashes with
147forward ones." 198forward 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)