Mercurial > emacs

changeset 1109:c9feb3e64805

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
*** empty log message ***
author Richard M. Stallman <rms@gnu.org>
date Sun, 13 Sep 1992 04:35:22 +0000
parents 6a0c694bd3a5
children f165d900e06e
files lisp/ange-ftp.el lisp/dired.el lisp/files.el
diffstat 3 files changed, 115 insertions(+), 332 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ange-ftp.el	Sat Sep 12 22:48:30 1992 +0000
+++ b/lisp/ange-ftp.el	Sun Sep 13 04:35:22 1992 +0000
@@ -3704,6 +3704,7 @@
 (put 'file-attributes 'ange-ftp 'ange-ftp-file-attributes)
 (put 'file-name-all-completions 'ange-ftp 'ange-ftp-file-name-all-completions)
 (put 'file-name-completion 'ange-ftp 'ange-ftp-file-name-completion)
+(put 'insert-directory 'ange-ftp 'ange-ftp-insert-directory)
 
 ;;; Define ways of getting at unmodified Emacs primitives,
 ;;; turning off our handler.
@@ -3780,128 +3781,21 @@
 (defun ange-ftp-real-file-name-completion (&rest args)
   (let (file-name-handler-alist)
     (apply 'file-name-completion args)))
-
-;;; This is obsolete and won't work
-
-;; Attention!
-;; It would be nice if ange-ftp-add-hook was generalized to
-;; (defun ange-ftp-add-hook (hook-var hook-function &optional postpend),
-;; where the optional postpend variable stipulates that hook-function
-;; should be post-pended to the hook-var, rather than prepended.
-;; Then, maybe we should overwrite dired with
-;; (ange-ftp-add-hook 'dired-load-hook 'ange-ftp-overwrite-dired t).
-;; This is because dired-load-hook is commonly used to add the dired extras
-;; features (dired-x.el, dired-trns.el, dired-nstd.el, ...). Some of these
-;; extras features overwrite functions in dired.el with fancier versions.
-;; The "extras" overwrites would then clobber the ange-ftp overwrites.
-;; As long as the ange-ftp overwrites are carefully written to use
-;; ange-ftp-real-... when the directory is local, then doing the ange-ftp
-;; overwrites after the extras overwites should be OK.
-;; At the moment, I think that there aren't any conflicts between the extras
-;; overwrites, and the ange-ftp overwrites. This may not last though.
-
-(defun ange-ftp-add-hook (hook-var hook-function)
-  "Prepend hook-function to hook-var's value, if it is not already an element.
-hook-var's value may be a single function or a list of functions."
-  (if (boundp hook-var)
-      (let ((value (symbol-value hook-var)))
-        (if (and (listp value) (not (eq (car value) 'lambda)))
-            (and (not (memq hook-function value))
-                 (set hook-var
-                      (if value (cons hook-function value) hook-function)))
-          (and (not (eq hook-function value))
-               (set hook-var
-                    (list hook-function value)))))
-    (set hook-var hook-function)))
-
-;; To load ange-ftp and not dired (leaving it to autoload), define
-;; dired-load-hook and make sure dired.el ends with:
-;;	(run-hooks 'dired-load-hook)
-;;
-(if (and (boundp 'dired-load-hook)
-	 (not (featurep 'dired)))
-    (ange-ftp-add-hook 'dired-load-hook 'ange-ftp-overwrite-dired)
-  (require 'dired)
-  (ange-ftp-overwrite-dired))
-
-(defun ange-ftp-overwrite-dired ()
-  (if (not (fboundp 'dired-ls))		;dired should have been loaded by now
-      (ange-ftp-overwrite-fn 'dired-readin) ; classic dired
-    (ange-ftp-overwrite-fn 'make-directory) ; tree dired and v19 stuff
-    (ange-ftp-overwrite-fn 'remove-directory)
-    (ange-ftp-overwrite-fn 'diff)
-    (ange-ftp-overwrite-fn 'dired-run-shell-command)
-    (ange-ftp-overwrite-fn 'dired-ls)
-    (ange-ftp-overwrite-fn 'dired-call-process)
-    ;; Can't use (fset 'ange-ftp-dired-readin 'ange-ftp-tree-dired-readin)
-    ;; here because it confuses ange-ftp-overwrite-fn.
-    (fset 'ange-ftp-dired-readin (symbol-function 'ange-ftp-tree-dired-readin))
-    (ange-ftp-overwrite-fn 'dired-readin)
-    (ange-ftp-overwrite-fn 'dired-insert-headerline)
-    (ange-ftp-overwrite-fn 'dired-move-to-filename)
-    (ange-ftp-overwrite-fn 'dired-move-to-end-of-filename)
-    (ange-ftp-overwrite-fn 'dired-get-filename)
-    (ange-ftp-overwrite-fn 'dired-between-files)
-    (ange-ftp-overwrite-fn 'dired-clean-directory)
-    (ange-ftp-overwrite-fn 'dired-flag-backup-files)
-    (ange-ftp-overwrite-fn 'dired-backup-diff)
-    (if (fboundp 'dired-do-create-files)
-	;; dired 6.0 or later.
-	(progn
-	  (ange-ftp-overwrite-fn 'dired-copy-file)
-	  (ange-ftp-overwrite-fn 'dired-create-files)
-	  (ange-ftp-overwrite-fn 'dired-do-create-files)))
-    (if (fboundp 'dired-compress-make-compressed-filename)
-	;; it's V5.255 or later
-	(ange-ftp-overwrite-fn 'dired-compress-make-compressed-filename)
-      ;; ange-ftp-overwrite-fn confuses dired-mark-map here.
-      (fset 'ange-ftp-real-dired-compress (symbol-function 'dired-compress))
-      (fset 'dired-compress 'ange-ftp-dired-compress)
-      (fset 'ange-ftp-real-dired-uncompress (symbol-function 'dired-uncompress))
-      (fset 'dired-uncompress 'ange-ftp-dired-uncompress)))
-
-  (ange-ftp-overwrite-fn 'dired-find-file)
-  (ange-ftp-overwrite-fn 'dired-revert))
+(defun ange-ftp-real-insert-directory (&rest args)
+  (let (file-name-handler-alist)
+    (apply 'insert-directory args)))
 
 ;;;; ------------------------------------------------------------
 ;;;; Classic Dired support.
 ;;;; ------------------------------------------------------------
 
-(defvar ange-ftp-dired-host-type nil
-  "The host type associated with a dired buffer. (buffer local)")
-(make-variable-buffer-local 'ange-ftp-dired-host-type)
-
-(defun ange-ftp-dired-readin (dirname buffer)
+(defun ange-ftp-insert-directory (file switches &optional wildcard full)
   "Documented as original."
-  (let ((file (ange-ftp-abbreviate-filename dirname))
-	(parsed (ange-ftp-ftp-path dirname)))
-    (save-excursion
-      (ange-ftp-message "Reading directory %s..." file)
-      (set-buffer buffer)
-      (let ((buffer-read-only nil))
-	(widen)
-	(erase-buffer)
-	(setq dirname (expand-file-name dirname))
-	(if parsed
-	    (let ((host-type (ange-ftp-host-type (car parsed))))
-	      (setq ange-ftp-dired-host-type host-type)
-	      (insert (ange-ftp-ls dirname dired-listing-switches t)))
-	  (if (ange-ftp-real-file-directory-p dirname)
-	      (call-process "ls" nil buffer nil
-			    dired-listing-switches dirname)
-	    (let ((default-directory
-		    (ange-ftp-real-file-name-directory dirname)))
-	      (call-process
-	       shell-file-name nil buffer nil
-	       "-c" (concat
-		     "ls " dired-listing-switches " "
-		     (ange-ftp-real-file-name-nondirectory dirname))))))
-	(goto-char (point-min))
-	(while (not (eobp))
-	  (insert "  ")
-	  (forward-line 1))
-	(goto-char (point-min))))
-    (ange-ftp-message "Reading directory %s...done" file)))
+  (setq file (ange-ftp-abbreviate-filename file))
+  (let ((parsed (ange-ftp-ftp-path file)))
+    (if parsed
+	(insert (ange-ftp-ls dirname switches t))
+      (ange-ftp-real-insert-directory file switches wildcard full))))
 
 (defun ange-ftp-dired-revert (&optional arg noconfirm)
   "Documented as original."
@@ -3909,147 +3803,21 @@
 	   (ange-ftp-ftp-path (expand-file-name dired-directory)))
       (setq ange-ftp-ls-cache-file nil))
   (ange-ftp-real-dired-revert arg noconfirm))
-
-;;;; ------------------------------------------------------------
-;;;; Tree Dired support (ange & Sebastian Kremer)
-;;;; ------------------------------------------------------------
-
-(defvar ange-ftp-dired-re-exe-alist nil
-  "Association list of regexps \(strings\) which match file lines of
- executable files.")
-
-(defvar ange-ftp-dired-re-dir-alist nil
-  "Association list of regexps \(strings\) which match file lines of
- subdirectories.")
-
-(defvar ange-ftp-dired-insert-headerline-alist nil
-  "Association list of \(TYPE \. FUNC \) pairs, where FUNC is
-the function to be used by dired to insert the headerline of
-the dired buffer.")
-
-(defvar ange-ftp-dired-move-to-filename-alist nil
-  "Association list of \(TYPE \. FUNC \) pairs, where FUNC is
-the function to be used by dired to move to the beginning of a
-filename.")
-
-(defvar ange-ftp-dired-move-to-end-of-filename-alist nil
-  "Association list of \(TYPE \. FUNC \) pairs, where FUNC is
-the function to be used by dired to move to the end of a
-filename.")
-
-(defvar ange-ftp-dired-get-filename-alist nil
-  "Association list of \(TYPE \. FUNC \) pairs, where FUNC is
-the function to be used by dired to get a filename from the
-current line.")
-
-(defvar ange-ftp-dired-between-files-alist nil
-  "Association list of \(TYPE \. FUNC \) pairs, where FUNC is
-the function to be used by dired to determine when the point
-is on a line between files.")
-
-(defvar ange-ftp-dired-ls-trim-alist nil
-  "Association list of \( TYPE \. FUNC \) pairs, where FUNC is
-a function which trims extraneous lines from a directory listing.")
-
-(defvar ange-ftp-dired-clean-directory-alist nil
-  "Association list of \( TYPE \. FUNC \) pairs, where FUNC is
-a function which cleans out old versions of files in the OS TYPE.")
-
-(defvar ange-ftp-dired-flag-backup-files-alist nil
-  "Association list of \( TYPE \. FUNC \) pairs, where FUNC is
-a functions which flags the backup files for deletion in the OS TYPE.")
-
-(defvar ange-ftp-dired-backup-diff-alist nil
-  "Association list of \( TYPE \. FUNC \) pairs, where FUNC diffs
-a file with its backup. The backup file is determined according to
-the OS TYPE.")
-
-;; Could use dired-before-readin-hook here, instead of overloading
-;; dired-readin. However, if people change this hook after ange-ftp
-;; is loaded, they'll break things.
-;; Also, why overload dired-readin rather than dired-mode?
-;; Because I don't want to muck up virtual dired (see dired-x.el).
-
-(defun ange-ftp-tree-dired-readin (dirname buffer)
+
+(defvar ange-ftp-sans-version-alist nil
+  "Alist of mapping host type into function to remove file version numbers.")
+
+(defun ange-ftp-file-name-sans-versions (file keep-backup-version)
   "Documented as original."
-  (let ((parsed (ange-ftp-ftp-path dirname)))
+  (setq file (ange-ftp-abbreviate-filename file))
+  (let ((parsed (ange-ftp-ftp-path file))
+	host-type func)
     (if parsed
-	(save-excursion
-	  (set-buffer buffer)
-	  (setq ange-ftp-dired-host-type
-		(ange-ftp-host-type (car parsed)))
-	  (and ange-ftp-dl-dir-regexp
-	       (eq ange-ftp-dired-host-type 'unix)
-	       (string-match ange-ftp-dl-dir-regexp dirname)
-	       (setq ange-ftp-dired-host-type 'unix:dl))
-	  (let ((eentry (assq ange-ftp-dired-host-type
-			      ange-ftp-dired-re-exe-alist))
-		(dentry (assq ange-ftp-dired-host-type
-			      ange-ftp-dired-re-dir-alist)))
-	    (if eentry
-		(set (make-local-variable 'dired-re-exe) (cdr eentry)))
-	    (if dentry
-		(set (make-local-variable 'dired-re-dir) (cdr dentry)))
-	    ;; No switches are sent to dumb hosts, so don't confuse dired.
-	    ;; I hope that dired doesn't get excited if it doesn't see the l
-	    ;; switch. If it does, then maybe fake things by setting this to
-	    ;; "-Al".
-	    (if (memq ange-ftp-dired-host-type ange-ftp-dumb-host-types)
-		(setq dired-actual-switches "-Al"))))))
-  (ange-ftp-real-dired-readin dirname buffer))
-
-(defun ange-ftp-dired-insert-headerline (dir)
-  "Documented as original."
-  (funcall (or (and ange-ftp-dired-host-type
-		    (cdr (assq ange-ftp-dired-host-type
-			       ange-ftp-dired-insert-headerline-alist)))
-	       'ange-ftp-real-dired-insert-headerline)
-	   dir))
-
-(defun ange-ftp-dired-move-to-filename (&optional raise-error eol)
-  "Documented as original."
-  (funcall (or (and ange-ftp-dired-host-type
-		    (cdr (assq ange-ftp-dired-host-type
-			       ange-ftp-dired-move-to-filename-alist)))
-	       'ange-ftp-real-dired-move-to-filename)
-	   raise-error eol))
-
-(defun ange-ftp-dired-move-to-end-of-filename (&optional no-error)
-  "Documented as original."
-  (funcall (or (and ange-ftp-dired-host-type
-		    (cdr (assq ange-ftp-dired-host-type
-			       ange-ftp-dired-move-to-end-of-filename-alist)))
-	       'ange-ftp-real-dired-move-to-end-of-filename)
-	   no-error))
-
-(defun ange-ftp-dired-get-filename (&optional localp no-error-if-not-filep)
-  "Documented as original."
-  (funcall (or (and ange-ftp-dired-host-type
-		    (cdr (assq ange-ftp-dired-host-type
-			       ange-ftp-dired-get-filename-alist)))
-	       'ange-ftp-real-dired-get-filename)
-	   localp no-error-if-not-filep))
-
-(defun ange-ftp-dired-between-files ()
-  "Documented as original."
-  (funcall (or (and ange-ftp-dired-host-type
-		    (cdr (assq ange-ftp-dired-host-type
-			       ange-ftp-dired-between-files-alist)))
-	       'ange-ftp-real-dired-between-files)))
-
-(defvar ange-ftp-bob-version-alist nil
-  "Association list of pairs \( TYPE \. FUNC \), where FUNC is
-a function to be used to bob the version number off of a filename
-in OS TYPE.")
-
-(defun ange-ftp-dired-find-file ()
-  "Documented as original."
-  (interactive)
-  (find-file (funcall (or (and ange-ftp-dired-host-type
-			       (cdr (assq ange-ftp-dired-host-type
-					  ange-ftp-bob-version-alist)))
-			  'identity)
-		      (dired-get-filename))))
+	(setq host-type (ange-ftp-host-type (car parsed))
+	      func (cdr (assq ange-ftp-dired-host-type
+			      ange-ftp-sans-version-alist))))
+    (if func (funcall func file keep-backup-version)
+      (ange-ftp-real-file-name-sans-versions file keep-backup-version))))
 
 ;; Need the following functions for making filenames of compressed
 ;; files, because some OS's (unlike UNIX) do not allow a filename to
--- a/lisp/dired.el	Sat Sep 12 22:48:30 1992 +0000
+++ b/lisp/dired.el	Sun Sep 13 04:35:22 1992 +0000
@@ -50,13 +50,9 @@
   "Name of chown command (usully `chown' or `/etc/chown').")
 
 ;;;###autoload
-(defvar dired-ls-program "ls"
-  "Absolute or relative name of the `ls' program used by dired.")
-
-;;;###autoload
 (defvar dired-ls-F-marks-symlinks nil
   "*Informs dired about how `ls -lF' marks symbolic links.
-Set this to t if `dired-ls-program' with `-lF' marks the symbolic link
+Set this to t if `insert-directory-program' with `-lF' marks the symbolic link
 itself with a trailing @ (usually the case under Ultrix).
 
 Example: if `ln -s foo bar; ls -F bar' gives `bar -> foo', set it to
@@ -307,39 +303,6 @@
 
 ;; Function dired-ls is redefinable for VMS, ange-ftp, Prospero or
 ;; other special applications.
-
-;; dired-ls
-;; - must insert _exactly_one_line_ describing FILE if WILDCARD and
-;;   FULL-DIRECTORY-P is nil.
-;;   The single line of output must display FILE's name as it was
-;;   given, namely, an absolute path name.
-;; - must insert exactly one line for each file if WILDCARD or
-;;   FULL-DIRECTORY-P is t, plus one optional "total" line
-;;   before the file lines, plus optional text after the file lines.
-;;   Lines are delimited by "\n", so filenames containing "\n" are not
-;;   allowed.
-;;   File lines should display the basename, not a path name.
-;; - must drag point after inserted text
-;; - must be consistent with
-;;   - functions dired-move-to-filename, (these two define what a file line is)
-;;   		 dired-move-to-end-of-filename,
-;;		 dired-between-files, (shortcut for (not (dired-move-to-filename)))
-;;   		 dired-insert-headerline
-;;   		 dired-after-subdir-garbage (defines what a "total" line is)
-;;   - variables dired-subdir-regexp
-(defun dired-ls (file switches &optional wildcard full-directory-p)
-;  "Insert `ls' output of FILE, formatted according to SWITCHES.
-;Optional third arg WILDCARD means treat FILE as shell wildcard.
-;Optional fourth arg FULL-DIRECTORY-P means file is a directory and
-;switches do not contain `d', so that a full listing is expected.
-;
-;Uses dired-ls-program (and shell-file-name if WILDCARD) to do the work."
-  (if wildcard
-      (let ((default-directory (file-name-directory file)))
-	(call-process shell-file-name nil t nil
-		      "-c" (concat dired-ls-program " -d " switches " "
-				   (file-name-nondirectory file))))
-    (call-process dired-ls-program nil t nil switches file)))
 
 ;; The dired command
 
@@ -496,12 +459,12 @@
 (defun dired-readin-insert (dirname)
   ;; Just insert listing for DIRNAME, assuming a clean buffer.
   (if (equal default-directory dirname);; i.e., (file-directory-p dirname)
-      (dired-ls dirname dired-actual-switches nil t)
+      (insert-directory dirname dired-actual-switches nil t)
     (if (not (file-readable-p
 	      (directory-file-name (file-name-directory dirname))))
 	(error "Directory %s inaccessible or nonexistent" dirname)
       ;; else assume it contains wildcards:
-      (dired-ls dirname dired-actual-switches t)
+      (insert-directory dirname dired-actual-switches t)
       (save-excursion;; insert wildcard instead of total line:
 	(goto-char (point-min))
 	(insert "wildcard " (file-name-nondirectory dirname) "\n")))))
@@ -881,7 +844,7 @@
 (defun dired-find-file ()
   "In dired, visit the file or directory named on this line."
   (interactive)
-  (find-file (dired-get-filename)))
+  (find-file (file-name-sans-versions (dired-get-filename) t)))
 
 (defun dired-view-file ()
   "In dired, examine a file in view mode, returning to dired when done.
@@ -891,17 +854,18 @@
   (if (file-directory-p (dired-get-filename))
       (or (and dired-subdir-alist (dired-goto-subdir (dired-get-filename)))
 	  (dired (dired-get-filename)))
-    (view-file (dired-get-filename))))
+    (view-file (file-name-sans-versions (dired-get-filename) t))))
 
 (defun dired-find-file-other-window ()
   "In dired, visit this file or directory in another window."
   (interactive)
-  (find-file-other-window (dired-get-filename)))
+  (find-file-other-window (file-name-sans-versions (dired-get-filename) t)))
 
 (defun dired-display-file ()
   "In dired, display this file or directory in another window."
   (interactive)
-  (display-buffer (find-file-noselect (dired-get-filename))))
+  (let ((file (file-name-sans-versions (dired-get-filename) t)))
+    (display-buffer (find-file-noselect file))))
 
 ;;; Functions for extracting and manipulating file names in dired buffers.
 
--- a/lisp/files.el	Sat Sep 12 22:48:30 1992 +0000
+++ b/lisp/files.el	Sun Sep 13 04:35:22 1992 +0000
@@ -824,25 +824,38 @@
 	      setmodes)
 	(file-error nil)))))
 
-(defun file-name-sans-versions (name)
+(defun file-name-sans-versions (name &optional keep-backup-version)
   "Return FILENAME sans backup versions or strings.
 This is a separate procedure so your site-init or startup file can
-redefine it."
-  (substring name 0
-             (if (eq system-type 'vax-vms)
-		 ;; VMS version number is (a) semicolon, optional
-		 ;; sign, zero or more digits or (b) period, option
-		 ;; sign, zero or more digits, provided this is the
-		 ;; second period encountered outside of the
-		 ;; device/directory part of the file name.
-                 (or (string-match ";[---+]?[0-9]*\\'" name)
-                     (if (string-match "\\.[^]>:]*\\(\\.[---+]?[0-9]*\\)\\'"
-                                       name)
-                         (match-beginning 1))
-                     (length name))
-               (or (string-match "\\.~[0-9]+~\\'" name)
-                   (string-match "~\\'" name)
-                   (length name)))))
+redefine it.
+If the optional argument KEEP-BACKUP-VERSION is non-nil,
+we do not remove backup version numbers, only true file version numbers."
+  (let (handler (handlers file-name-handler-alist))
+    (while (and (consp handlers) (null handler))
+      (if (and (consp (car handlers))
+	       (stringp (car (car handlers)))
+	       (string-match (car (car handlers)) name))
+	  (setq handler (cdr (car handlers))))
+      (setq handlers (cdr handlers)))
+    (if handler
+	(funcall handler 'file-name-sans-versions name keep-backup-version)
+      (substring name 0
+		 (if (eq system-type 'vax-vms)
+		     ;; VMS version number is (a) semicolon, optional
+		     ;; sign, zero or more digits or (b) period, option
+		     ;; sign, zero or more digits, provided this is the
+		     ;; second period encountered outside of the
+		     ;; device/directory part of the file name.
+		     (or (string-match ";[---+]?[0-9]*\\'" name)
+			 (if (string-match "\\.[^]>:]*\\(\\.[---+]?[0-9]*\\)\\'"
+					   name)
+			     (match-beginning 1))
+			 (length name))
+		   (if keep-backup-version
+		       (length name)
+		     (or (string-match "\\.~[0-9]+~\\'" name)
+			 (string-match "~\\'" name)
+			 (length name))))))))
 
 (defun make-backup-file-name (file)
   "Create the non-numeric backup file name for FILE.
@@ -1380,23 +1393,61 @@
       (princ "Directory ")
       (princ dirname)
       (terpri)
+      (save-excursion
+	(set-buffer "*Directory*")
+	(let ((wildcard (not (file-directory-p dirname))))
+	  (insert-directory dirname switches wildcard (not wildcard)))))))
+
+(defvar insert-directory-program "ls"
+  "Absolute or relative name of the `ls' program used by `insert-directory'.")
+
+;; insert-directory
+;; - must insert _exactly_one_line_ describing FILE if WILDCARD and
+;;   FULL-DIRECTORY-P is nil.
+;;   The single line of output must display FILE's name as it was
+;;   given, namely, an absolute path name.
+;; - must insert exactly one line for each file if WILDCARD or
+;;   FULL-DIRECTORY-P is t, plus one optional "total" line
+;;   before the file lines, plus optional text after the file lines.
+;;   Lines are delimited by "\n", so filenames containing "\n" are not
+;;   allowed.
+;;   File lines should display the basename.
+;; - must be consistent with
+;;   - functions dired-move-to-filename, (these two define what a file line is)
+;;   		 dired-move-to-end-of-filename,
+;;		 dired-between-files, (shortcut for (not (dired-move-to-filename)))
+;;   		 dired-insert-headerline
+;;   		 dired-after-subdir-garbage (defines what a "total" line is)
+;;   - variable dired-subdir-regexp
+(defun insert-directory (file switches &optional wildcard full-directory-p)
+  "Insert directory listing for of FILE, formatted according to SWITCHES.
+Leaves point after the inserted text.
+Optional third arg WILDCARD means treat FILE as shell wildcard.
+Optional fourth arg FULL-DIRECTORY-P means file is a directory and
+switches do not contain `d', so that a full listing is expected.
+
+This works by running a directory listing program
+whose name is in the variable `ls-program'.
+If WILDCARD, it also runs the shell specified by `shell-file-name'."
+  (let (handler (handlers file-name-handler-alist))
+    (while (and (consp handlers) (null handler))
+      (if (and (consp (car handlers))
+	       (stringp (car (car handlers)))
+	       (string-match (car (car handlers)) file))
+	  (setq handler (cdr (car handlers))))
+      (setq handlers (cdr handlers)))
+    (if handler
+	(funcall handler 'insert-directory file switches
+		 wildcard full-directory-p)
       (if (eq system-type 'vax-vms)
-	  (vms-read-directory dirname switches standard-output)
-	(if (file-directory-p dirname)
-	    (save-excursion
-	      (set-buffer "*Directory*")
-	      (call-process "ls" nil standard-output nil switches
-			    (setq default-directory
-				  (file-name-as-directory dirname))))
-	  (let ((default-directory (file-name-directory dirname)))
-	    (if (file-exists-p default-directory)
-		(call-process shell-file-name nil standard-output nil
-			      "-c" (concat "exec ls "
-					   switches " "
-					   (file-name-nondirectory dirname)))
-	      (princ "No such directory: ")
-	      (princ dirname)
-	      (terpri))))))))
+	  (vms-read-directory file switches (current-buffer))
+	(if wildcard
+	    (let ((default-directory (file-name-directory file)))
+	      (call-process shell-file-name nil t nil
+			    "-c" (concat insert-directory-program
+					 " -d " switches " "
+					 (file-name-nondirectory file))))
+	  (call-process insert-directory-program nil t nil switches file))))))
 
 (defun save-buffers-kill-emacs (&optional arg)
   "Offer to save each buffer, then kill this Emacs process.