comparison lisp/dired-aux.el @ 89943:4c90ffeb71c5

Revision: [e-mail]--gnu-2004/emacs--unicode--0--patch-15 Merge from emacs--cvs-trunk--0 Patches applied: * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-218 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-220 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-221 Restore deleted tagline in etc/TUTORIAL.ru * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-222 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-228 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-229 Remove TeX output files from the archive * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-230 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-247 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-248 src/lisp.h (CYCLE_CHECK): Macro moved from xfaces.c * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-249 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-256 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-258 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-263 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-264 Update from CVS: lispref/display.texi: emacs -> Emacs. * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-265 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-274 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-275 Update from CVS: man/makefile.w32-in: Revert last change * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-276 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-295 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-296 Allow restarting an existing debugger session that's exited * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-297 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-299 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-300 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-327 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-328 Update from CVS: src/.gdbinit (xsymbol): Fix last change. * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-329 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-344 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-345 Tweak source regexps so that building in place won't cause problems * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-346 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-351 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-352 Update from CVS: lisp/flymake.el: New file. * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-353 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-361 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-362 Support " [...]" style defaults in minibuffer-electric-default-mode * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-363 (read-number): Use canonical format for default in prompt. * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-364 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-367 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-368 Improve display-supports-face-attributes-p on non-ttys * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-369 Rewrite face-differs-from-default-p * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-370 Move `display-supports-face-attributes-p' entirely into C code * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-371 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-372 Simplify face-differs-from-default-p; don't consider :stipple. * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-373 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-374 (tty_supports_face_attributes_p): Ensure attributes differ from default * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-375 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-376 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-377 (Fdisplay_supports_face_attributes_p): Work around bootstrapping problem * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-378 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-380 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-381 Face merging cleanups * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-382 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-384 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-385 src/xfaces.c (push_named_merge_point): Return 0 if a cycle is detected * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-386 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-395 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-396 Tweak arch tagging to make build/install-in-place less annoying * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-397 Work around vc-arch problems when building eshell * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-398 Tweak permissions * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-399 Tweak directory permissions * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-400 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-401 More build-in-place tweaking of arch tagging * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-402 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-403 Yet more build-in-place tweaking of arch tagging * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-404 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-409 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-410 Make sure image types are initialized for lookup too * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-411 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-416 Update from CVS

89942:9cb747ae49af

     (list (read-file-name (format "Diff %s with: %s"
				   (dired-get-filename t)
				   (if default
				       (concat "(default " default ") ")
				     ""))
			   (dired-current-directory) default t)
	   (if current-prefix-arg
	       (read-string "Options for diff: "
			    (if (stringp diff-switches)
				diff-switches
			      (mapconcat 'identity diff-switches " ")))))))

       (list file-name
             full-file-name
             (file-attributes full-file-name))))
   (directory-files dir)))

(defun dired-do-chxxx (attribute-name program op-symbol arg)
  ;; Change file attributes (mode, group, owner, timestamp) of marked files and
  ;; refresh their file lines.
  ;; ATTRIBUTE-NAME is a string describing the attribute to the user.
  ;; PROGRAM is the program used to change the attribute.

  ;; ARG describes which files to use, as in dired-get-marked-files.
  (let* ((files (dired-get-marked-files t arg))
	 (new-attribute
	  (dired-mark-read-string
	   (concat "Change " attribute-name " of %s to: ")
	   nil op-symbol arg files))
	 (operation (concat program " " new-attribute))
	 failures)
    (setq failures
	  (dired-bunch-files 10000
			     (function dired-check-process)

  (interactive "P")
  (if (memq system-type '(ms-dos windows-nt))
      (error "chown not supported on this system"))
  (dired-do-chxxx "Owner" dired-chown-program 'chown arg))

(defun dired-do-touch (&optional arg)
  "Change the timestamp of the marked (or next ARG) files.
This calls touch."
  (interactive "P")
  (dired-do-chxxx "Timestamp" dired-touch-program 'touch arg))


;;; Cleaning a directory: flagging some backups for deletion.

(defvar dired-file-version-alist)

(defun dired-clean-directory (keep)
  "Flag numerical backups for deletion.
Spares `dired-kept-versions' latest versions, and `kept-old-versions' oldest.
Positive prefix arg KEEP overrides `dired-kept-versions';
Negative prefix arg KEEP overrides `kept-old-versions' with KEEP made positive.

	(if (> (length file-list) 1)
	    (setq files (concat dired-mark-prefix files dired-mark-postfix)))
	(funcall stuff-it files)))))

;; This is an extra function so that it can be redefined by ange-ftp.
(defun dired-run-shell-command (command)
  (let ((handler
	 (find-file-name-handler (directory-file-name default-directory)
				 'shell-command)))
    (if handler (apply handler 'shell-command (list command))

    (?! . yes)				; `!' accepts rest
    (?q . no) (?\e . no)		; `q' or ESC skips rest
    ;; None of these keys quit - use C-g for that.
    ))

(defun dired-query (qs-var qs-prompt &rest qs-args)
  ;; Query user and return nil or t.
  ;; Store answer in symbol VAR (which must initially be bound to nil).
  ;; Format PROMPT with ARGS.
  ;; Binding variable help-form will help the user who types the help key.

;;;###autoload
(defun dired-do-redisplay (&optional arg test-for-subdir)
  "Redisplay all marked (or next ARG) files.
If on a subdir line, redisplay that subdirectory.  In that case,
a prefix arg lets you edit the `ls' switches used for the new listing."
  ;; Moves point if the next ARG files are redisplayed.
  (interactive "P\np")
  (if (and test-for-subdir (dired-get-subdir))
      (dired-insert-subdir
       (dired-get-subdir)
       (if arg (read-string "Switches for listing: " dired-actual-switches)))
    (message "Redisplaying...")
    ;; message much faster than making dired-map-over-marks show progress
    (dired-uncache
     (if (consp dired-directory) (car dired-directory) dired-directory))
    (dired-map-over-marks (let ((fname (dired-get-filename)))
			    (message "Redisplaying... %s" fname)
			    (dired-update-file-line fname))
			  arg)
    (dired-move-to-filename)
    (message "Redisplaying...done")))

(defun dired-update-file-line (file)
  ;; Delete the current line, and insert an entry for FILE.
  ;; If FILE is nil, then just delete the current line.
  ;; Keeps any marks that may be present in column one (doing this

		(rename-buffer new-name)))
	  ;; ... we dired TO now:
	  (dired-advertise)))))

(defun dired-rename-subdir-2 (elt dir to)
  ;; Update the headerline and dired-subdir-alist element of directory
  ;; described by alist-element ELT to reflect the moving of DIR to TO.
  ;; Thus, ELT describes either DIR itself or a subdir of DIR.
  (save-excursion
    (let ((regexp (regexp-quote (directory-file-name dir)))
	  (newtext (directory-file-name to))
	  buffer-read-only)
      (goto-char (dired-get-subdir-min elt))

		 dir)
	(goto-char (match-beginning 1))
	(if (re-search-forward regexp (match-end 1) t)
	    (replace-match newtext t t)
	  (error "Expected to find `%s' in headerline of %s" dir (car elt))))
      ;; Update buffer-local dired-subdir-alist
      (setcar elt
	      (dired-normalize-subdir
	       (dired-replace-in-string regexp newtext (car elt)))))))

;; The basic function for half a dozen variations on cp/mv/ln/ln -s.
(defun dired-create-files (file-creator operation fn-list name-constructor
					&optional marker-char)

If it is already present, just move to it (type \\[dired-do-redisplay] to refresh),
  else inserts it at its natural place (as `ls -lR' would have done).
With a prefix arg, you may edit the ls switches used for this listing.
  You can add `R' to the switches to expand the whole tree starting at
  this subdirectory.
This function takes some pains to conform to `ls -lR' output."
  (interactive
   (list (dired-get-filename)
	 (if current-prefix-arg
	     (read-string "Switches for listing: " dired-actual-switches))))
  (let ((opoint (point)))
    ;; We don't need a marker for opoint as the subdir is always
    ;; inserted *after* opoint.
    (setq dirname (file-name-as-directory dirname))
    (or (and (not switches)

  ;; Prospero where dired-ls does the right thing, but
  ;; file-directory-p has not been redefined.
  (interactive
   (list (dired-get-filename)
	 (if current-prefix-arg
	     (read-string "Switches for listing: " dired-actual-switches))))
  (setq dirname (file-name-as-directory (expand-file-name dirname)))
  (dired-insert-subdir-validate dirname switches)
  (or no-error-if-not-dir-p
      (file-directory-p dirname)
      (error  "Attempt to insert a non-directory: %s" dirname))
  (let ((elt (assoc dirname dired-subdir-alist))
	 switches-have-R mark-alist case-fold-search buffer-read-only)
    ;; case-fold-search is nil now, so we can test for capital `R':
    (if (setq switches-have-R (and switches (string-match "R" switches)))
	;; avoid duplicated subdirs
	(setq mark-alist (dired-kill-tree dirname t)))
    (if elt
	;; If subdir is already present, remove it and remember its marks
	(setq mark-alist (nconc (dired-insert-subdir-del elt) mark-alist))
      (dired-insert-subdir-newpos dirname)) ; else compute new position
    (dired-insert-subdir-doupdate
     dirname elt (dired-insert-subdir-doinsert dirname switches))
    (if switches-have-R (dired-build-subdir-alist switches))
    (dired-initial-position dirname)
    (save-excursion (dired-mark-remembered mark-alist))))

;; This is a separate function for dired-vms.
(defun dired-insert-subdir-validate (dirname &optional switches)
  ;; Check that it is valid to insert DIRNAME with SWITCHES.
  ;; Signal an error if invalid (e.g. user typed `i' on `..').
  (or (dired-in-this-tree dirname (expand-file-name default-directory))
      (error  "%s: not in this directory tree" dirname))
  (if switches
      (let (case-fold-search)
	(mapcar
	 (function
	  (lambda (x)
	    (or (eq (null (string-match x switches))
		    (null (string-match x dired-actual-switches)))
		(error "Can't have dirs with and without -%s switches together"
		       x))))
	 ;; all switches that make a difference to dired-get-filename:
	 '("F" "b")))))

(defun dired-alist-add (dir new-marker)
  ;; Add new DIR at NEW-MARKER.  Sort alist.
  (dired-alist-add-1 dir new-marker)
  (dired-alist-sort))

	(sort dired-subdir-alist
	      (function (lambda (elt1 elt2)
			  (> (dired-get-subdir-min elt1)
			     (dired-get-subdir-min elt2)))))))

(defun dired-kill-tree (dirname &optional remember-marks)
  "Kill all proper subdirs of DIRNAME, excluding DIRNAME itself.
With optional arg REMEMBER-MARKS, return an alist of marked files."
  (interactive "DKill tree below directory: ")
  (setq dirname (expand-file-name dirname))
  (let ((s-alist dired-subdir-alist) dir m-alist)
    (while s-alist
      (setq dir (car (car s-alist))
	    s-alist (cdr s-alist))
      (if (and (not (string-equal dir dirname))
	       (dired-in-this-tree dir dirname)
	       (dired-goto-subdir dir))
	  (setq m-alist (nconc (dired-kill-subdir remember-marks) m-alist))))
    m-alist))

(defun dired-insert-subdir-newpos (new-dir)
  ;; Find pos for new subdir, according to tree order.
  ;;(goto-char (point-max))

(defun dired-insert-subdir-doinsert (dirname switches)
  ;; Insert ls output after point.
  ;; Return the boundary of the inserted text (as list of BEG and END).
  (save-excursion
    (let ((begin (point)))
      (message "Reading directory %s..." dirname)
      (let ((dired-actual-switches
	     (or switches
		 (dired-replace-in-string "R" "" dired-actual-switches))))
	(if (equal dirname (car (car (last dired-subdir-alist))))
	    ;; If doing the top level directory of the buffer,
	    ;; redo it as specified in dired-directory.
	    (dired-readin-insert)
	  (dired-insert-directory dirname dired-actual-switches nil nil t)))
      (message "Reading directory %s...done" dirname)
      (list begin (point)))))

(defun dired-insert-subdir-doupdate (dirname elt beg-end)
  ;; Point is at the correct subdir alist position for ELT,
  ;; BEG-END is the subdir-region (as list of begin and end).

(defun dired-kill-subdir (&optional remember-marks)
  "Remove all lines of current subdirectory.
Lower levels are unaffected."
  ;; With optional REMEMBER-MARKS, return a mark-alist.
  (interactive)
  (let ((beg (dired-subdir-min))
	(end (dired-subdir-max))
	buffer-read-only cur-dir)
    (setq cur-dir (dired-current-directory))
    (if (equal cur-dir default-directory)
	(error "Attempt to kill top level directory"))
    (prog1
	(if remember-marks (dired-remember-marks beg end))
      (delete-region beg end)
      (if (eobp)			; don't leave final blank line
	  (delete-char -1))
      (dired-unsubdir cur-dir))))

(defun dired-unsubdir (dir)
  ;; Remove DIR from the alist
  (setq dired-subdir-alist
	(delq (assoc dir dired-subdir-alist) dired-subdir-alist)))

  "Hide or unhide the current subdirectory and move to next directory.
Optional prefix arg is a repeat factor.
Use \\[dired-hide-all] to (un)hide all directories."
  (interactive "p")
  (dired-hide-check)
  (while (>=  (setq arg (1- arg)) 0)
    (let* ((cur-dir (dired-current-directory))
	   (hidden-p (dired-subdir-hidden-p cur-dir))
	   (elt (assoc cur-dir dired-subdir-alist))
	   (end-pos (1- (dired-get-subdir-max elt)))
	   buffer-read-only)
      ;; keep header line visible, hide rest
      (goto-char (dired-get-subdir-min elt))
      (skip-chars-forward "^\n\r")
      (if hidden-p
	  (subst-char-in-region (point) end-pos ?\r ?\n)
	(subst-char-in-region (point) end-pos ?\n ?\r)))
    (dired-next-subdir 1 t)))

;;;###autoload
(defun dired-hide-all (arg)
  "Hide all subdirectories, leaving only their header lines.
If there is already something hidden, make everything visible again.
Use \\[dired-hide-subdir] to (un)hide a particular subdirectory."
  (interactive "P")
  (dired-hide-check)
  (let (buffer-read-only)
    (if (save-excursion
	  (goto-char (point-min))
	  (search-forward "\r" nil t))
	;; unhide - bombs on \r in filenames
	(subst-char-in-region (point-min) (point-max) ?\r ?\n)
      ;; hide
      (let ((pos (point-max))		; pos of end of last directory
	    (alist dired-subdir-alist))
	(while alist			; while there are dirs before pos
	  (subst-char-in-region (dired-get-subdir-min (car alist)) ; pos of prev dir
				(save-excursion
				  (goto-char pos) ; current dir
				  ;; we're somewhere on current dir's line
				  (forward-line -1)
				  (point))
				?\n ?\r)
	  (setq pos (dired-get-subdir-min (car alist)))	; prev dir gets current dir
	  (setq alist (cdr alist)))))))

;;;###end dired-ins.el


;; Functions for searching in tags style among marked files.

89943:4c90ffeb71c5

     (list (read-file-name (format "Diff %s with: %s"
				   (dired-get-filename t)
				   (if default
				       (concat "(default " default ") ")
				     ""))
			   (if default
			       (dired-current-directory)
			     (dired-dwim-target-directory))
			   default t)
	   (if current-prefix-arg
	       (read-string "Options for diff: "
			    (if (stringp diff-switches)
				diff-switches
			      (mapconcat 'identity diff-switches " ")))))))

       (list file-name
             full-file-name
             (file-attributes full-file-name))))
   (directory-files dir)))


(defun dired-touch-initial (files)
  "Create initial input value for `touch' command."
  (let (initial)
    (while files
      (let ((current (nth 5 (file-attributes (car files)))))
        (if (and initial (not (equal initial current)))
            (setq initial (current-time) files nil)
          (setq initial current))
        (setq files (cdr files))))
    (format-time-string "%Y%m%d%H%M.%S" initial)))

(defun dired-do-chxxx (attribute-name program op-symbol arg)
  ;; Change file attributes (mode, group, owner, timestamp) of marked files and
  ;; refresh their file lines.
  ;; ATTRIBUTE-NAME is a string describing the attribute to the user.
  ;; PROGRAM is the program used to change the attribute.

  ;; ARG describes which files to use, as in dired-get-marked-files.
  (let* ((files (dired-get-marked-files t arg))
	 (new-attribute
	  (dired-mark-read-string
	   (concat "Change " attribute-name " of %s to: ")
	   (if (eq op-symbol 'touch) (dired-touch-initial files))
	   op-symbol arg files))
	 (operation (concat program " " new-attribute))
	 failures)
    (setq failures
	  (dired-bunch-files 10000
			     (function dired-check-process)

  (interactive "P")
  (if (memq system-type '(ms-dos windows-nt))
      (error "chown not supported on this system"))
  (dired-do-chxxx "Owner" dired-chown-program 'chown arg))

;;;###autoload
(defun dired-do-touch (&optional arg)
  "Change the timestamp of the marked (or next ARG) files.
This calls touch."
  (interactive "P")
  (dired-do-chxxx "Timestamp" dired-touch-program 'touch arg))


;;; Cleaning a directory: flagging some backups for deletion.

(defvar dired-file-version-alist)

;;;###autoload
(defun dired-clean-directory (keep)
  "Flag numerical backups for deletion.
Spares `dired-kept-versions' latest versions, and `kept-old-versions' oldest.
Positive prefix arg KEEP overrides `dired-kept-versions';
Negative prefix arg KEEP overrides `kept-old-versions' with KEEP made positive.

	(if (> (length file-list) 1)
	    (setq files (concat dired-mark-prefix files dired-mark-postfix)))
	(funcall stuff-it files)))))

;; This is an extra function so that it can be redefined by ange-ftp.
;;;###autoload
(defun dired-run-shell-command (command)
  (let ((handler
	 (find-file-name-handler (directory-file-name default-directory)
				 'shell-command)))
    (if handler (apply handler 'shell-command (list command))

    (?! . yes)				; `!' accepts rest
    (?q . no) (?\e . no)		; `q' or ESC skips rest
    ;; None of these keys quit - use C-g for that.
    ))

;;;###autoload
(defun dired-query (qs-var qs-prompt &rest qs-args)
  ;; Query user and return nil or t.
  ;; Store answer in symbol VAR (which must initially be bound to nil).
  ;; Format PROMPT with ARGS.
  ;; Binding variable help-form will help the user who types the help key.

;;;###autoload
(defun dired-do-redisplay (&optional arg test-for-subdir)
  "Redisplay all marked (or next ARG) files.
If on a subdir line, redisplay that subdirectory.  In that case,
a prefix arg lets you edit the `ls' switches used for the new listing.

Dired remembers switches specified with a prefix arg, so that reverting
the buffer will not reset them.  However, using `dired-undo' to re-insert
or delete subdirectories can bypass this machinery.  Hence, you sometimes
may have to reset some subdirectory switches after a `dired-undo'.
You can reset all subdirectory switches to the default using
\\<dired-mode-map>\\[dired-reset-subdir-switches].
See Info node `(emacs-xtra)Subdir switches' for more details."
  ;; Moves point if the next ARG files are redisplayed.
  (interactive "P\np")
  (if (and test-for-subdir (dired-get-subdir))
      (let* ((dir (dired-get-subdir))
	     (switches (cdr (assoc-string dir dired-switches-alist))))
	(dired-insert-subdir
	 dir
	 (when arg
	   (read-string "Switches for listing: "
			(or switches
			    dired-subdir-switches
			    dired-actual-switches)))))
    (message "Redisplaying...")
    ;; message much faster than making dired-map-over-marks show progress
    (dired-uncache
     (if (consp dired-directory) (car dired-directory) dired-directory))
    (dired-map-over-marks (let ((fname (dired-get-filename)))
			    (message "Redisplaying... %s" fname)
			    (dired-update-file-line fname))
			  arg)
    (dired-move-to-filename)
    (message "Redisplaying...done")))

(defun dired-reset-subdir-switches ()
  "Set `dired-switches-alist' to nil and revert dired buffer."
  (interactive)
  (setq dired-switches-alist nil)
  (revert-buffer))

(defun dired-update-file-line (file)
  ;; Delete the current line, and insert an entry for FILE.
  ;; If FILE is nil, then just delete the current line.
  ;; Keeps any marks that may be present in column one (doing this

		(rename-buffer new-name)))
	  ;; ... we dired TO now:
	  (dired-advertise)))))

(defun dired-rename-subdir-2 (elt dir to)
  ;; Update the headerline and dired-subdir-alist element, as well as
  ;; dired-switches-alist element, of directory described by
  ;; alist-element ELT to reflect the moving of DIR to TO.  Thus, ELT
  ;; describes either DIR itself or a subdir of DIR.
  (save-excursion
    (let ((regexp (regexp-quote (directory-file-name dir)))
	  (newtext (directory-file-name to))
	  buffer-read-only)
      (goto-char (dired-get-subdir-min elt))

		 dir)
	(goto-char (match-beginning 1))
	(if (re-search-forward regexp (match-end 1) t)
	    (replace-match newtext t t)
	  (error "Expected to find `%s' in headerline of %s" dir (car elt))))
      ;; Update buffer-local dired-subdir-alist and dired-switches-alist
      (let ((cons (assoc-string (car elt) dired-switches-alist))
	    (cur-dir (dired-normalize-subdir
		      (dired-replace-in-string regexp newtext (car elt)))))
	(setcar elt cur-dir)
	(when cons (setcar cons cur-dir))))))

;; The basic function for half a dozen variations on cp/mv/ln/ln -s.
(defun dired-create-files (file-creator operation fn-list name-constructor
					&optional marker-char)

If it is already present, just move to it (type \\[dired-do-redisplay] to refresh),
  else inserts it at its natural place (as `ls -lR' would have done).
With a prefix arg, you may edit the ls switches used for this listing.
  You can add `R' to the switches to expand the whole tree starting at
  this subdirectory.
This function takes some pains to conform to `ls -lR' output.

Dired remembers switches specified with a prefix arg, so that reverting
the buffer will not reset them.  However, using `dired-undo' to re-insert
or delete subdirectories can bypass this machinery.  Hence, you sometimes
may have to reset some subdirectory switches after a `dired-undo'.
You can reset all subdirectory switches to the default using
\\<dired-mode-map>\\[dired-reset-subdir-switches].
See Info node `(emacs-xtra)Subdir switches' for more details."
  (interactive
   (list (dired-get-filename)
	 (if current-prefix-arg
	     (read-string "Switches for listing: "
			  (or dired-subdir-switches dired-actual-switches)))))
  (let ((opoint (point)))
    ;; We don't need a marker for opoint as the subdir is always
    ;; inserted *after* opoint.
    (setq dirname (file-name-as-directory dirname))
    (or (and (not switches)

  ;; Prospero where dired-ls does the right thing, but
  ;; file-directory-p has not been redefined.
  (interactive
   (list (dired-get-filename)
	 (if current-prefix-arg
	     (read-string "Switches for listing: "
			  (or dired-subdir-switches dired-actual-switches)))))
  (setq dirname (file-name-as-directory (expand-file-name dirname)))
  (or no-error-if-not-dir-p
      (file-directory-p dirname)
      (error  "Attempt to insert a non-directory: %s" dirname))
  (let ((elt (assoc dirname dired-subdir-alist))
	(cons (assoc-string dirname dired-switches-alist))
	(modflag (buffer-modified-p))
	(old-switches switches)
	switches-have-R mark-alist case-fold-search buffer-read-only)
    (and (not switches) cons (setq switches (cdr cons)))
    (dired-insert-subdir-validate dirname switches)
    ;; case-fold-search is nil now, so we can test for capital `R':
    (if (setq switches-have-R (and switches (string-match "R" switches)))
	;; avoid duplicated subdirs
	(setq mark-alist (dired-kill-tree dirname t)))
    (if elt
	;; If subdir is already present, remove it and remember its marks
	(setq mark-alist (nconc (dired-insert-subdir-del elt) mark-alist))
      (dired-insert-subdir-newpos dirname)) ; else compute new position
    (dired-insert-subdir-doupdate
     dirname elt (dired-insert-subdir-doinsert dirname switches))
    (when old-switches
      (if cons
	  (setcdr cons switches)
	(push (cons dirname switches) dired-switches-alist)))
    (when switches-have-R
      (dired-build-subdir-alist switches)
      (setq switches (dired-replace-in-string "R" "" switches))
      (dolist (cur-ass dired-subdir-alist)
	(let ((cur-dir (car cur-ass)))
	  (and (dired-in-this-tree cur-dir dirname)
	       (let ((cur-cons (assoc-string cur-dir dired-switches-alist)))
		 (if cur-cons
		     (setcdr cur-cons switches)
		   (push (cons cur-dir switches) dired-switches-alist)))))))
    (dired-initial-position dirname)
    (save-excursion (dired-mark-remembered mark-alist))
    (restore-buffer-modified-p modflag)))

;; This is a separate function for dired-vms.
(defun dired-insert-subdir-validate (dirname &optional switches)
  ;; Check that it is valid to insert DIRNAME with SWITCHES.
  ;; Signal an error if invalid (e.g. user typed `i' on `..').
  (or (dired-in-this-tree dirname (expand-file-name default-directory))
      (error  "%s: not in this directory tree" dirname))
  (let ((real-switches (or switches dired-subdir-switches)))
    (when real-switches
      (let (case-fold-search)
	(mapcar
	 (function
	  (lambda (x)
	    (or (eq (null (string-match x real-switches))
		    (null (string-match x dired-actual-switches)))
		(error
		 "Can't have dirs with and without -%s switches together" x))))
	 ;; all switches that make a difference to dired-get-filename:
	 '("F" "b"))))))

(defun dired-alist-add (dir new-marker)
  ;; Add new DIR at NEW-MARKER.  Sort alist.
  (dired-alist-add-1 dir new-marker)
  (dired-alist-sort))

	(sort dired-subdir-alist
	      (function (lambda (elt1 elt2)
			  (> (dired-get-subdir-min elt1)
			     (dired-get-subdir-min elt2)))))))

(defun dired-kill-tree (dirname &optional remember-marks kill-root)
  "Kill all proper subdirs of DIRNAME, excluding DIRNAME itself.
Interactively, you can kill DIRNAME as well by using a prefix argument.
In interactive use, the command prompts for DIRNAME.

When called from Lisp, if REMEMBER-MARKS is non-nil, return an alist
of marked files.  If KILL-ROOT is non-nil, kill DIRNAME as well."
  (interactive "DKill tree below directory: \ni\nP")
  (setq dirname (file-name-as-directory (expand-file-name dirname)))
  (let ((s-alist dired-subdir-alist) dir m-alist)
    (while s-alist
      (setq dir (car (car s-alist))
	    s-alist (cdr s-alist))
      (and (or kill-root (not (string-equal dir dirname)))
	   (dired-in-this-tree dir dirname)
	   (dired-goto-subdir dir)
	   (setq m-alist (nconc (dired-kill-subdir remember-marks) m-alist))))
    m-alist))

(defun dired-insert-subdir-newpos (new-dir)
  ;; Find pos for new subdir, according to tree order.
  ;;(goto-char (point-max))

(defun dired-insert-subdir-doinsert (dirname switches)
  ;; Insert ls output after point.
  ;; Return the boundary of the inserted text (as list of BEG and END).
  (save-excursion
    (let ((begin (point)))
      (let ((dired-actual-switches
	     (or switches
		 dired-subdir-switches
		 (dired-replace-in-string "R" "" dired-actual-switches))))
	(if (equal dirname (car (car (last dired-subdir-alist))))
	    ;; If doing the top level directory of the buffer,
	    ;; redo it as specified in dired-directory.
	    (dired-readin-insert)
	  (dired-insert-directory dirname dired-actual-switches nil nil t)))
      (list begin (point)))))

(defun dired-insert-subdir-doupdate (dirname elt beg-end)
  ;; Point is at the correct subdir alist position for ELT,
  ;; BEG-END is the subdir-region (as list of begin and end).

(defun dired-kill-subdir (&optional remember-marks)
  "Remove all lines of current subdirectory.
Lower levels are unaffected."
  ;; With optional REMEMBER-MARKS, return a mark-alist.
  (interactive)
  (let* ((beg (dired-subdir-min))
	 (end (dired-subdir-max))
	 (modflag (buffer-modified-p))
	 (cur-dir (dired-current-directory))
	 (cons (assoc-string cur-dir dired-switches-alist))
	 buffer-read-only)
    (if (equal cur-dir default-directory)
	(error "Attempt to kill top level directory"))
    (prog1
	(if remember-marks (dired-remember-marks beg end))
      (delete-region beg end)
      (if (eobp)			; don't leave final blank line
	  (delete-char -1))
      (dired-unsubdir cur-dir)
      (when cons
	(setq dired-switches-alist (delete cons dired-switches-alist)))
      (restore-buffer-modified-p modflag))))

(defun dired-unsubdir (dir)
  ;; Remove DIR from the alist
  (setq dired-subdir-alist
	(delq (assoc dir dired-subdir-alist) dired-subdir-alist)))

  "Hide or unhide the current subdirectory and move to next directory.
Optional prefix arg is a repeat factor.
Use \\[dired-hide-all] to (un)hide all directories."
  (interactive "p")
  (dired-hide-check)
  (let ((modflag (buffer-modified-p)))
    (while (>=  (setq arg (1- arg)) 0)
      (let* ((cur-dir (dired-current-directory))
	     (hidden-p (dired-subdir-hidden-p cur-dir))
	     (elt (assoc cur-dir dired-subdir-alist))
	     (end-pos (1- (dired-get-subdir-max elt)))
	     buffer-read-only)
	;; keep header line visible, hide rest
	(goto-char (dired-get-subdir-min elt))
	(skip-chars-forward "^\n\r")
	(if hidden-p
	    (subst-char-in-region (point) end-pos ?\r ?\n)
	  (subst-char-in-region (point) end-pos ?\n ?\r)))
      (dired-next-subdir 1 t))
    (restore-buffer-modified-p modflag)))

;;;###autoload
(defun dired-hide-all (arg)
  "Hide all subdirectories, leaving only their header lines.
If there is already something hidden, make everything visible again.
Use \\[dired-hide-subdir] to (un)hide a particular subdirectory."
  (interactive "P")
  (dired-hide-check)
  (let ((modflag (buffer-modified-p))
	buffer-read-only)
    (if (save-excursion
	  (goto-char (point-min))
	  (search-forward "\r" nil t))
	;; unhide - bombs on \r in filenames
	(subst-char-in-region (point-min) (point-max) ?\r ?\n)
      ;; hide
      (let ((pos (point-max))		; pos of end of last directory
	    (alist dired-subdir-alist))
	(while alist		        ; while there are dirs before pos
	  (subst-char-in-region (dired-get-subdir-min (car alist)) ; pos of prev dir
				(save-excursion
				  (goto-char pos) ; current dir
				  ;; we're somewhere on current dir's line
				  (forward-line -1)
				  (point))
				?\n ?\r)
	  (setq pos (dired-get-subdir-min (car alist)))	; prev dir gets current dir
	  (setq alist (cdr alist)))))
    (restore-buffer-modified-p modflag)))

;;;###end dired-ins.el


;; Functions for searching in tags style among marked files.