*** empty log message ***

3 files changed, 114 insertions, 331 deletions

diff --git a/lisp/ange-ftp.el b/lisp/ange-ftp.el
index 4be219f87f1..a08f010d53f 100644
--- a/lisp/ange-ftp.el
+++ b/lisp/ange-ftp.el
@@ -3704,6 +3704,7 @@ to the directory part of the contents of the current buffer."
 (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 @@ to the directory part of the contents of the current buffer."
 (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 @@ hook-var's value may be a single function or a list of functions."
            (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)
-  "Documented as original."
-  (let ((parsed (ange-ftp-ftp-path dirname)))
-    (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))
+(defvar ange-ftp-sans-version-alist nil
+  "Alist of mapping host type into function to remove file version numbers.")
 
-(defun ange-ftp-dired-get-filename (&optional localp no-error-if-not-filep)
+(defun ange-ftp-file-name-sans-versions (file keep-backup-version)
   "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 file (ange-ftp-abbreviate-filename file))
+  (let ((parsed (ange-ftp-ftp-path file))
+        host-type func)
+    (if parsed
+        (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
diff --git a/lisp/dired.el b/lisp/dired.el
index 99ae4681075..d4788e7cac6 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -50,13 +50,9 @@ may contain even `F', `b', `i' and `s'.")
   "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 @@ Optional second argument ARG forces to use other files.  If ARG is an
 
 ;; 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 @@ If DIRNAME is already in a dired buffer, that buffer is used without refresh."
 (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 @@ Creates a buffer if necessary."
 (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 @@ otherwise, display it in another buffer."
   (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.
 
diff --git a/lisp/files.el b/lisp/files.el
index 07c2d2c301e..bd7cf7d8864 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -824,25 +824,38 @@ the modes of the new file to agree with the old modes."
               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 @@ and `list-directory-verbose-switches'."
       (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.