summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRichard M. Stallman <rms@gnu.org>1992-07-28 19:38:08 +0000
committerRichard M. Stallman <rms@gnu.org>1992-07-28 19:38:08 +0000
commit2d051399770c312b514081780e514fdabee2183d (patch)
treecc107d6ba710dab3e9155cbc36df457e1aa46b5b
parentb6df3e11b27d4aad739d89001d1d8d18b82528b6 (diff)
downloademacs-2d051399770c312b514081780e514fdabee2183d.tar.gz
*** empty log message ***
-rw-r--r--lisp/dired-aux.el88
-rw-r--r--lisp/dired.el95
-rw-r--r--lisp/files.el20
3 files changed, 110 insertions, 93 deletions
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index d81d0641ec4..be93d71d70e 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -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 <sk@thp.uni-koeln.de>.
-;; Version: 5.234
;; This file is part of GNU Emacs.
@@ -171,6 +170,91 @@ Uses the shell command coming from variables `lpr-command' and
(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)
diff --git a/lisp/dired.el b/lisp/dired.el
index 0f2d205afa5..be4595fa28b 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -1700,91 +1700,6 @@ Type SPC or `y' to unflag one file, DEL or `n' to skip to next,
(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 @@ If this file is a backup, diff it with its original.
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."
diff --git a/lisp/files.el b/lisp/files.el
index f1fde0575e0..c16581f60b4 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -836,6 +836,19 @@ This is a separate function so you can redefine it for customization.
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 @@ Value is a list whose car is the name for the backup file
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))