[Emacs-diffs] Changes to emacs/lisp/dired-aux.el

[Richard M. Stallman]

Index: emacs/lisp/dired-aux.el
diff -c emacs/lisp/dired-aux.el:1.102 emacs/lisp/dired-aux.el:1.103
*** emacs/lisp/dired-aux.el:1.102       Sun May 12 12:42:26 2002
--- emacs/lisp/dired-aux.el     Sat Sep 14 21:52:08 2002
***************
*** 145,150 ****
--- 145,151 ----
  ;; 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,164 ****
        ;; 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)
                  pending nil
                  pending-length 0))
        ;; Do (setq pending (cons thisfile pending))
--- 157,171 ----
        ;; 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 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,174 ****
        (setq pending files)
        (setq pending-length (+ thislength pending-length))
        (setq files rest)))
!     (nconc (apply function (append args (nreverse pending)))
!          failures)))
  
  ;;;###autoload
  (defun dired-do-print (&optional arg)
--- 174,185 ----
        (setq pending files)
        (setq pending-length (+ thislength pending-length))
        (setq files rest)))
!     (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,831 ****
                  (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.
                  (let ((p (dired-after-subdir-garbage cur-dir)))
                    (if (< (point) p)
                        (goto-char p))))
--- 836,842 ----
                  (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.
                  (let ((p (dired-after-subdir-garbage cur-dir)))
                    (if (< (point) p)
                        (goto-char p))))
***************
*** 843,853 ****
            (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.
              (let ((default-directory directory))
!               (insert-directory filename
!                                 (concat dired-actual-switches "d")))
              ;; 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
--- 854,869 ----
            (let (buffer-read-only opoint)
              (beginning-of-line)
              (setq opoint (point))
!             ;; Don't expand `.'.  Show just the file name within directory.
              (let ((default-directory directory))
!               (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,868 ****
              (goto-char opoint)
              (let ((inserted-name (dired-get-filename 'verbatim)))
                (if (file-name-directory inserted-name)
!                   (progn
                      (end-of-line)
!                     (delete-char (- (length inserted-name)))
!                     (insert filename)
                      (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:
--- 871,886 ----
              (goto-char opoint)
              (let ((inserted-name (dired-get-filename 'verbatim)))
                (if (file-name-directory inserted-name)
!                   (let (props)
                      (end-of-line)
!                     (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)))
              (forward-line -1)
              (if dired-after-readin-hook ;; the subdir-alist is not affected...
                  (save-excursion ;; ...so we can run it right now:
***************
*** 878,891 ****
        (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.
--- 896,901 ----
***************
*** 915,920 ****
--- 925,931 ----
  
  ;;;###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,967 ****
  (defvar dired-overwrite-confirmed)
  
  (defun dired-handle-overwrite (to)
!   ;; Save old version of a to be overwritten file TO.
    ;; `dired-overwrite-confirmed' and `overwrite-backup-query' are fluid vars
    ;; from dired-create-files.
    (let (backup)
--- 972,978 ----
  (defvar dired-overwrite-confirmed)
  
  (defun dired-handle-overwrite (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,1021 ****
      (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
    ;; 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)
    ;; See if it's an inserted subdir, and rename that, too.
!   (dired-rename-subdir from to))
  
  (defun dired-rename-subdir (from-dir to-dir)
    (setq from-dir (file-name-as-directory from-dir)
--- 1017,1032 ----
      (copy-file from to ok-flag dired-copy-preserve-time)))
  
  ;;;###autoload
! (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 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 file newname))
  
  (defun dired-rename-subdir (from-dir to-dir)
    (setq from-dir (file-name-as-directory from-dir)
***************
*** 1379,1392 ****
  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)
                           "Hardlink" arg dired-keep-marker-hardlink))
  
  ;;;###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.
  The default suggested for the target directory depends on the value
  of `dired-dwim-target', which see."
    (interactive "P")
--- 1390,1411 ----
  suggested for the target directory depends on the value of
  `dired-dwim-target', which see."
    (interactive "P")
!   (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,1740 ****
        (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.
    ;; Return the boundary of the inserted text (as list of BEG and END).
!   (let ((begin (point)) end)
      (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)))))
      (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))))
  
  (defun dired-insert-subdir-doupdate (dirname elt beg-end)
    ;; Point is at the correct subdir alist position for ELT,
--- 1726,1747 ----
        (delete-region begin-marker (point)))))
  
  (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).
!   (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)
!       (let ((pt (point)))
!         (dired-insert-directory dirname dired-actual-switches nil nil t)
!         (goto-char pt))))
      (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,