changeset 890:bad1b9af86a1

*** empty log message ***

--- a/lisp/dired-aux.el	Tue Jul 28 03:39:30 1992 +0000
+++ b/lisp/dired-aux.el	Tue Jul 28 19:38:08 1992 +0000
@@ -1,9 +1,8 @@
-;; dired-aux.el --- directory browsing command support
+;; dired-aux.el --- all of dired except what people usually use
 
 ;; Copyright (C) 1985, 1986, 1992 Free Software Foundation, Inc.
 
 ;; Author: Sebastian Kremer <[e-mail]>.
-;; Version: 5.234
 
 ;; This file is part of GNU Emacs.
 
@@ -171,6 +170,91 @@
    (function read-string)
    (format prompt (dired-mark-prompt arg files)) initial))
 
+;;; Cleaning a directory: flagging some backups for deletion.
+
+(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.
+
+To clear the flags on these files, you can use \\[dired-flag-backup-files]
+with a prefix argument."
+  (interactive "P")
+  (setq keep (if keep (prefix-numeric-value keep) dired-kept-versions))
+  (let ((early-retention (if (< keep 0) (- keep) kept-old-versions))
+	(late-retention (if (<= keep 0) dired-kept-versions keep))
+	(dired-file-version-alist ()))
+    (message "Cleaning numerical backups (keeping %d late, %d old)..."
+	     late-retention early-retention)
+    ;; Look at each file.
+    ;; If the file has numeric backup versions,
+    ;; put on dired-file-version-alist an element of the form
+    ;; (FILENAME . VERSION-NUMBER-LIST)
+    (dired-map-dired-file-lines (function dired-collect-file-versions))
+    ;; Sort each VERSION-NUMBER-LIST,
+    ;; and remove the versions not to be deleted.
+    (let ((fval dired-file-version-alist))
+      (while fval
+	(let* ((sorted-v-list (cons 'q (sort (cdr (car fval)) '<)))
+	       (v-count (length sorted-v-list)))
+	  (if (> v-count (+ early-retention late-retention))
+	      (rplacd (nthcdr early-retention sorted-v-list)
+		      (nthcdr (- v-count late-retention)
+			      sorted-v-list)))
+	  (rplacd (car fval)
+		  (cdr sorted-v-list)))
+	(setq fval (cdr fval))))
+    ;; Look at each file.  If it is a numeric backup file,
+    ;; find it in a VERSION-NUMBER-LIST and maybe flag it for deletion.
+    (dired-map-dired-file-lines (function dired-trample-file-versions))
+    (message "Cleaning numerical backups...done")))
+
+;;; Subroutines of dired-clean-directory.
+
+(defun dired-map-dired-file-lines (fun)
+  ;; Perform FUN with point at the end of each non-directory line.
+  ;; FUN takes one argument, the filename (complete pathname).
+  (save-excursion
+    (let (file buffer-read-only)
+      (goto-char (point-min))
+      (while (not (eobp))
+	(save-excursion
+	  (and (not (looking-at dired-re-dir))
+	       (not (eolp))
+	       (setq file (dired-get-filename nil t)) ; nil on non-file
+	       (progn (end-of-line)
+		      (funcall fun file))))
+	(forward-line 1)))))
+
+(defun dired-collect-file-versions (fn)
+  ;;  "If it looks like file FN has versions, return a list of the versions.
+  ;;That is a list of strings which are file names.
+  ;;The caller may want to flag some of these files for deletion."
+    (let* ((base-versions
+	    (concat (file-name-nondirectory fn) ".~"))
+	   (bv-length (length base-versions))
+	   (possibilities (file-name-all-completions
+			   base-versions
+			   (file-name-directory fn)))
+	   (versions (mapcar 'backup-extract-version possibilities)))
+      (if versions
+	  (setq dired-file-version-alist (cons (cons fn versions)
+					       dired-file-version-alist)))))
+
+(defun dired-trample-file-versions (fn)
+  (let* ((start-vn (string-match "\\.~[0-9]+~$" fn))
+	 base-version-list)
+    (and start-vn
+	 (setq base-version-list	; there was a base version to which
+	       (assoc (substring fn 0 start-vn)	; this looks like a
+		      dired-file-version-alist))	; subversion
+	 (not (memq (string-to-int (substring fn (+ 2 start-vn)))
+		    base-version-list))	; this one doesn't make the cut
+	 (progn (beginning-of-line)
+		(delete-char 1)
+		(insert dired-del-marker)))))
+
 ;;; Shell commands
 ;;>>> install (move this function into simple.el)
 (defun dired-shell-quote (filename)

--- a/lisp/dired.el	Tue Jul 28 03:39:30 1992 +0000
+++ b/lisp/dired.el	Tue Jul 28 19:38:08 1992 +0000
@@ -1700,91 +1700,6 @@
 	  (forward-line 1))))
     (message "%s" (format "Flags removed: %d %s" count flag) )))
 
-;;; Cleaning a directory: flagging some backups for deletion.
-
-(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.
-
-To clear the flags on these files, you can use \\[dired-flag-backup-files]
-with a prefix argument."
-  (interactive "P")
-  (setq keep (if keep (prefix-numeric-value keep) dired-kept-versions))
-  (let ((early-retention (if (< keep 0) (- keep) kept-old-versions))
-	(late-retention (if (<= keep 0) dired-kept-versions keep))
-	(dired-file-version-alist ()))
-    (message "Cleaning numerical backups (keeping %d late, %d old)..."
-	     late-retention early-retention)
-    ;; Look at each file.
-    ;; If the file has numeric backup versions,
-    ;; put on dired-file-version-alist an element of the form
-    ;; (FILENAME . VERSION-NUMBER-LIST)
-    (dired-map-dired-file-lines (function dired-collect-file-versions))
-    ;; Sort each VERSION-NUMBER-LIST,
-    ;; and remove the versions not to be deleted.
-    (let ((fval dired-file-version-alist))
-      (while fval
-	(let* ((sorted-v-list (cons 'q (sort (cdr (car fval)) '<)))
-	       (v-count (length sorted-v-list)))
-	  (if (> v-count (+ early-retention late-retention))
-	      (rplacd (nthcdr early-retention sorted-v-list)
-		      (nthcdr (- v-count late-retention)
-			      sorted-v-list)))
-	  (rplacd (car fval)
-		  (cdr sorted-v-list)))
-	(setq fval (cdr fval))))
-    ;; Look at each file.  If it is a numeric backup file,
-    ;; find it in a VERSION-NUMBER-LIST and maybe flag it for deletion.
-    (dired-map-dired-file-lines (function dired-trample-file-versions))
-    (message "Cleaning numerical backups...done")))
-
-;;; Subroutines of dired-clean-directory.
-
-(defun dired-map-dired-file-lines (fun)
-  ;; Perform FUN with point at the end of each non-directory line.
-  ;; FUN takes one argument, the filename (complete pathname).
-  (save-excursion
-    (let (file buffer-read-only)
-      (goto-char (point-min))
-      (while (not (eobp))
-	(save-excursion
-	  (and (not (looking-at dired-re-dir))
-	       (not (eolp))
-	       (setq file (dired-get-filename nil t)) ; nil on non-file
-	       (progn (end-of-line)
-		      (funcall fun file))))
-	(forward-line 1)))))
-
-(defun dired-collect-file-versions (fn)
-  ;;  "If it looks like file FN has versions, return a list of the versions.
-  ;;That is a list of strings which are file names.
-  ;;The caller may want to flag some of these files for deletion."
-    (let* ((base-versions
-	    (concat (file-name-nondirectory fn) ".~"))
-	   (bv-length (length base-versions))
-	   (possibilities (file-name-all-completions
-			   base-versions
-			   (file-name-directory fn)))
-	   (versions (mapcar 'backup-extract-version possibilities)))
-      (if versions
-	  (setq dired-file-version-alist (cons (cons fn versions)
-					       dired-file-version-alist)))))
-
-(defun dired-trample-file-versions (fn)
-  (let* ((start-vn (string-match "\\.~[0-9]+~$" fn))
-	 base-version-list)
-    (and start-vn
-	 (setq base-version-list	; there was a base version to which
-	       (assoc (substring fn 0 start-vn)	; this looks like a
-		      dired-file-version-alist))	; subversion
-	 (not (memq (string-to-int (substring fn (+ 2 start-vn)))
-		    base-version-list))	; this one doesn't make the cut
-	 (progn (beginning-of-line)
-		(delete-char 1)
-		(insert dired-del-marker)))))
-
 ;; Logging failures operating on files, and showing the results.
 
 (defvar dired-log-buffer "*Dired log*")
@@ -1936,6 +1851,16 @@
 The backup file is the first file given to `diff'."
   t)
 
+(autoload 'dired-clean-directory "dired-aux"
+  "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.
+
+To clear the flags on these files, you can use \\[dired-flag-backup-files]
+with a prefix argument."
+  t)
+
 (autoload 'dired-do-chmod "dired-aux"
   "Change the mode of the marked (or next ARG) files.
 This calls chmod, thus symbolic modes like `g+w' are allowed."

--- a/lisp/files.el	Tue Jul 28 03:39:30 1992 +0000
+++ b/lisp/files.el	Tue Jul 28 19:38:08 1992 +0000
@@ -836,6 +836,19 @@
 You may need to redefine `file-name-sans-versions' as well."
   (string-match "~$" file))
 
+;; This is used in various files.
+;; The usage of bv-length is not very clean,
+;; but I can't see a good alternative,
+;; so as of now I am leaving it alone.
+(defun backup-extract-version (fn)
+  "Given the name of a numeric backup file, return the backup number.
+Uses the free variable `bv-length', whose value should be
+the index in the name where the version number begins."
+  (if (and (string-match "[0-9]+~$" fn bv-length)
+	   (= (match-beginning 0) bv-length))
+      (string-to-int (substring fn bv-length -1))
+      0))
+
 ;; I believe there is no need to alter this behavior for VMS;
 ;; since backup files are not made on VMS, it should not get called.
 (defun find-backup-file-name (fn)
@@ -850,12 +863,7 @@
 			   base-versions
 			   (file-name-directory fn)))
 	   (versions (sort (mapcar
-			    (function
-			     (lambda (fn)
-			       (if (and (string-match "[0-9]+~$" fn bv-length)
-					(= (match-beginning 0) bv-length))
-				   (string-to-int (substring fn bv-length -1))
-				 0)))
+			    (function backup-extract-version)
 			    possibilities)
 			   '<))
 	   (high-water-mark (apply 'max 0 versions))