Commit e5369aad authored by Richard M. Stallman's avatar Richard M. Stallman
Browse files

(dired-bunch-files): Put the arg FILES

back as it was after temporary destrucive mods.
(dired-add-entry): Use dired-insert-directory to handle indentation.
Explicitly restore the line's marker character.
Preserve the old file name's text properties.
(dired-add-entry-do-indentation): Function deleted.
(dired-relist-file): Doc fix.
(dired-rename-file): Change argument names.
(foo-rename-file): New function.
(dired-do-hardlink): Use dired-hardlink.
(dired-hardlink): New function.
(dired-insert-subdir-doinsert): Use dired-insert-directory;
that handles indentation, text props and header line.
dired-readin-insert gets no args.
Use `last' instead of `reverse'.
parent fe6456af
......@@ -145,6 +145,7 @@ This calls chmod, thus symbolic modes like `g+w' are allowed."
;; allowing 3 extra characters of separator per file name.
(defun dired-bunch-files (max function args files)
(let (pending
past
(pending-length 0)
failures)
;; Accumulate files as long as they fit in MAX chars,
......@@ -156,9 +157,15 @@ This calls chmod, thus symbolic modes like `g+w' are allowed."
;; If we have at least 1 pending file
;; and this file won't fit in the length limit, process now.
(if (and pending (> (+ thislength pending-length) max))
(setq failures
(nconc (apply function (append args (nreverse pending)))
failures)
(setq pending (nreverse pending)
;; The elements of PENDING are now in forward order.
;; Do the operation and record failures.
failures (nconc (apply function (append args pending))
failures)
;; Transfer the elemens of PENDING onto PAST
;; and clear it out. Now PAST contains the first N files
;; specified (for some N), and FILES contains the rest.
past (nconc past pending)
pending nil
pending-length 0))
;; Do (setq pending (cons thisfile pending))
......@@ -167,8 +174,12 @@ This calls chmod, thus symbolic modes like `g+w' are allowed."
(setq pending files)
(setq pending-length (+ thislength pending-length))
(setq files rest)))
(nconc (apply function (append args (nreverse pending)))
failures)))
(setq pending (nreverse pending))
(prog1
(nconc (apply function (append args pending))
failures)
;; Now the original list FILES has been put back as it was.
(nconc past pending))))
;;;###autoload
(defun dired-do-print (&optional arg)
......@@ -825,7 +836,7 @@ a prefix arg lets you edit the `ls' switches used for the new listing."
(if (eq (following-char) ?\r)
(dired-unhide-subdir))
;; We are already where we should be, except when
;; point is before the subdir line or its total line.
;; point is before the subdir line or its total line.
(let ((p (dired-after-subdir-garbage cur-dir)))
(if (< (point) p)
(goto-char p))))
......@@ -843,11 +854,16 @@ a prefix arg lets you edit the `ls' switches used for the new listing."
(let (buffer-read-only opoint)
(beginning-of-line)
(setq opoint (point))
(dired-add-entry-do-indentation marker-char)
;; don't expand `.'. Show just the file name within directory.
;; Don't expand `.'. Show just the file name within directory.
(let ((default-directory directory))
(insert-directory filename
(concat dired-actual-switches "d")))
(dired-insert-directory directory
(concat dired-actual-switches "d")
(list filename)))
;; Put in desired marker char.
(when marker-char
(let ((dired-marker-char
(if (integerp marker-char) marker-char dired-marker-char)))
(dired-mark)))
;; Compensate for a bug in ange-ftp.
;; It inserts the file's absolute name, rather than
;; the relative one. That may be hard to fix since it
......@@ -855,14 +871,16 @@ a prefix arg lets you edit the `ls' switches used for the new listing."
(goto-char opoint)
(let ((inserted-name (dired-get-filename 'verbatim)))
(if (file-name-directory inserted-name)
(progn
(let (props)
(end-of-line)
(delete-char (- (length inserted-name)))
(insert filename)
(forward-char (- (length inserted-name)))
(setq props (text-properties-at (point)))
(delete-char (length inserted-name))
(let ((pt (point)))
(insert filename)
(set-text-properties pt (point) props))
(forward-char 1))
(forward-line 1)))
;; Give each line a text property recording info about it.
(dired-insert-set-properties opoint (point))
(forward-line -1)
(if dired-after-readin-hook ;; the subdir-alist is not affected...
(save-excursion ;; ...so we can run it right now:
......@@ -878,14 +896,6 @@ a prefix arg lets you edit the `ls' switches used for the new listing."
(goto-char opoint))
(not reason))) ; return t on success, nil else
;; This is a separate function for the sake of nested dired format.
(defun dired-add-entry-do-indentation (marker-char)
;; two spaces or a marker plus a space:
(insert (if marker-char
(if (integerp marker-char) marker-char dired-marker-char)
?\040)
?\040))
(defun dired-after-subdir-garbage (dir)
;; Return pos of first file line of DIR, skipping header and total
;; or wildcard lines.
......@@ -915,6 +925,7 @@ a prefix arg lets you edit the `ls' switches used for the new listing."
;;;###autoload
(defun dired-relist-file (file)
"Create or update the line for FILE in all Dired buffers it would belong in."
(dired-fun-in-all-buffers (file-name-directory file)
(file-name-nondirectory file)
(function dired-relist-entry) file))
......@@ -961,7 +972,7 @@ Special value `always' suppresses confirmation."
(defvar dired-overwrite-confirmed)
(defun dired-handle-overwrite (to)
;; Save old version of a to be overwritten file TO.
;; Save old version of file TO that is to be overwritten.
;; `dired-overwrite-confirmed' and `overwrite-backup-query' are fluid vars
;; from dired-create-files.
(let (backup)
......@@ -1006,16 +1017,16 @@ Special value `always' suppresses confirmation."
(copy-file from to ok-flag dired-copy-preserve-time)))
;;;###autoload
(defun dired-rename-file (from to ok-flag)
(dired-handle-overwrite to)
(rename-file from to ok-flag) ; error is caught in -create-files
(defun dired-rename-file (file newname ok-if-already-exists)
(dired-handle-overwrite newname)
(rename-file file newname ok-if-already-exists) ; error is caught in -create-files
;; Silently rename the visited file of any buffer visiting this file.
(and (get-file-buffer from)
(with-current-buffer (get-file-buffer from)
(set-visited-file-name to nil t)))
(dired-remove-file from)
(and (get-file-buffer file)
(with-current-buffer (get-file-buffer file)
(set-visited-file-name newname nil t)))
(dired-remove-file file)
;; See if it's an inserted subdir, and rename that, too.
(dired-rename-subdir from to))
(dired-rename-subdir file newname))
(defun dired-rename-subdir (from-dir to-dir)
(setq from-dir (file-name-as-directory from-dir)
......@@ -1379,14 +1390,22 @@ with the same names that the files currently have. The default
suggested for the target directory depends on the value of
`dired-dwim-target', which see."
(interactive "P")
(dired-do-create-files 'hardlink (function add-name-to-file)
(dired-do-create-files 'hardlink (function dired-hardlink)
"Hardlink" arg dired-keep-marker-hardlink))
(defun dired-hardlink (file newname &optional ok-if-already-exists)
(dired-handle-overwrite newname)
;; error is caught in -create-files
(add-name-to-file file newname ok-if-already-exists)
;; Update the link count
(dired-relist-file file))
;;;###autoload
(defun dired-do-rename (&optional arg)
"Rename current file or all marked (or next ARG) files.
When renaming just the current file, you specify the new name.
When renaming multiple or marked files, you specify a directory.
This command also renames any buffers that are visiting the files.
The default suggested for the target directory depends on the value
of `dired-dwim-target', which see."
(interactive "P")
......@@ -1707,34 +1726,22 @@ With optional arg REMEMBER-MARKS, return an alist of marked files."
(delete-region begin-marker (point)))))
(defun dired-insert-subdir-doinsert (dirname switches)
;; Insert ls output after point and put point on the correct
;; position for the subdir alist.
;; Insert ls output after point.
;; Return the boundary of the inserted text (as list of BEG and END).
(let ((begin (point)) end)
(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 (reverse dired-subdir-alist))))
;; top level directory may contain wildcards:
(dired-readin-insert dired-directory)
(let ((opoint (point)))
(insert-directory dirname dired-actual-switches nil t)
(dired-insert-set-properties opoint (point)))))
(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)
(let ((pt (point)))
(dired-insert-directory dirname dired-actual-switches nil nil t)
(goto-char pt))))
(message "Reading directory %s...done" dirname)
(setq end (point-marker))
(indent-rigidly begin end 2)
;; call dired-insert-headerline afterwards, as under VMS dired-ls
;; does insert the headerline itself and the insert function just
;; moves point.
;; Need a marker for END as this inserts text.
(goto-char begin)
(if (not (looking-at "^ /.*:$"))
(dired-insert-headerline dirname))
;; point is now like in dired-build-subdir-alist
(prog1
(list begin (marker-position end))
(set-marker end nil))))
(list begin (point))))
(defun dired-insert-subdir-doupdate (dirname elt beg-end)
;; Point is at the correct subdir alist position for ELT,
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment