mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-27 07:37:33 +00:00
Code Issues Releases Activity

*** empty log message ***

Browse Source
This commit is contained in:
Richard M. Stallman 1992-07-28 19:38:08 +00:00
parent b6df3e11b2
commit 2d05139977
3 changed files with 110 additions and 93 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

88
lisp/dired-aux.el
View File

@ -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)

95
lisp/dired.el
View File

@ -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."

20
lisp/files.el
View File

@ -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))