diff options
| author | Richard M. Stallman | 1998-03-14 21:44:13 +0000 |
|---|---|---|
| committer | Richard M. Stallman | 1998-03-14 21:44:13 +0000 |
| commit | d1212648240dac5f58e65eea68a78a9dac9a61c8 (patch) | |
| tree | a618d8b850f491bfe43f2ccc6cfed160c7429896 /lisp | |
| parent | 6fe8a37af388aae8dbd2e10a7827846df20f5573 (diff) | |
| download | emacs-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.el | 103 |
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. |
| 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." |
| 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." | |||
| 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) |