Mercurial > emacs

changeset 2575:1c5dca7628cb

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(cd): Changed to use to resolve relative cd calls. (cd-absolute): Added. This is actually the old cd code with a changed doc string. (parse-colon-path): Added. Path-to-string exploder --- may be useful elsewhere.
author Eric S. Raymond <esr@snark.thyrsus.com>
date Sun, 25 Apr 1993 06:14:06 +0000
parents c782b69b60a4
children 48318133e7a6
files lisp/files.el
diffstat 1 files changed, 42 insertions(+), 7 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/files.el	Sun Apr 25 06:14:03 1993 +0000
+++ b/lisp/files.el	Sun Apr 25 06:14:06 1993 +0000
@@ -226,17 +226,32 @@
 
 ;; Avoid losing in versions where CLASH_DETECTION is disabled.
 (or (fboundp 'lock-buffer)
-    (fset 'lock-buffer 'ignore))
+    (defalias 'lock-buffer 'ignore))
 (or (fboundp 'unlock-buffer)
-    (fset 'unlock-buffer 'ignore))
+    (defalias 'unlock-buffer 'ignore))
 
 (defun pwd ()
   "Show the current default directory."
   (interactive nil)
   (message "Directory %s" default-directory))
 
-(defun cd (dir)
-  "Make DIR become the current buffer's default directory."
+(defvar cd-path nil
+  "Value of the CDPATH environment variable, as a list.
+Not actually set up until the first time you you use it.")
+
+(defun parse-colon-path (cd-path)
+  "Explode a colon-separated list of paths into a string list."
+  (and cd-path
+       (let (cd-prefix cd-list (cd-start 0) cd-colon)
+	 (setq cd-path (concat cd-path ":"))
+	 (while (setq cd-colon (string-match ":" cd-path cd-start))
+	   (setq cd-list
+		 (nconc cd-list (list (substitute-in-file-name (file-name-as-directory (substring cd-path cd-start cd-colon))))))
+	   (setq cd-start (+ cd-colon 1)))
+	 cd-list)))
+
+(defun cd-absolute (dir)
+  "Change current directory to given absolute path DIR."
   (interactive "DChange default directory: ")
   (setq dir (expand-file-name dir))
   (if (not (eq system-type 'vax-vms))
@@ -246,11 +261,31 @@
     (if (file-executable-p dir)
 	(setq default-directory dir)
       (error "Cannot cd to %s:  Permission denied" dir)))
-  ;; We used to call pwd at this point.  That's not terribly helpful
-  ;; when we're invoking cd interactively, and the new cmushell-based
-  ;; shell has its own (better) facilities for this.
 )
 
+(defun cd (dir)
+  "Make DIR become the current buffer's default directory.
+If your environment imcludes a $CDPATH variable, cd tries each one of that
+colon-separated list of directories when resolving a relative cd."
+  (interactive "FChange default directory: ")
+  (if (= (aref dir 0) ?/)
+      (cd-absolute (expand-file-name dir))
+    (if (null cd-path)
+	(let ((trypath (parse-colon-path (getenv "CDPATH"))))
+	  (setq cd-path (or trypath "./"))))
+    (if (not (catch 'found
+	       (mapcar
+		(function (lambda (x)
+			    (let ((f (expand-file-name (concat x dir))))
+			      (if (file-directory-p f)
+				  (progn
+				    (cd-absolute f)
+				    (throw 'found t))))))
+		cd-path)
+	       nil))
+	(error "No such directory on your cd path.")))
+  )
+
 (defun load-file (file)
   "Load the Lisp file named FILE."
   (interactive "fLoad file: ")