Mercurial > emacs
changeset 53215:99f19d6d7aeb
(dired-do-query-replace-regexp): Report files visited read-only.
(dired-compare-directories): New command.
(dired-file-set-difference, dired-files-attributes): New functions.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Mon, 01 Dec 2003 01:56:19 +0000 |
parents | 931e46b73703 |
children | 4f30a35fdb55 |
files | lisp/dired-aux.el |
diffstat | 1 files changed, 100 insertions(+), 0 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/dired-aux.el Mon Dec 01 00:45:50 2003 +0000 +++ b/lisp/dired-aux.el Mon Dec 01 01:56:19 2003 +0000 @@ -88,6 +88,101 @@ nil)) (diff-backup (dired-get-filename) switches)) +(defun dired-compare-directories (dir2 predicate) + "Mark files with different file attributes in two dired buffers. +Compare file attributes of files in the current directory +with file attributes in directory DIR2 using PREDICATE on pairs of files +with the same name. Mark files for which PREDICATE returns non-nil. + +PREDICATE is a Lisp expression that can refer to the following variables: + + size1, size2 - file size in bytes + mtime1, mtime2 - last modification time in seconds, as a float + fa1, fa2 - list of file attributes + returned by function `file-attributes' + + where 1 refers to attribute of file in the current dired buffer + and 2 to attribute of file in second dired buffer. + +Examples of PREDICATE: + + (> mtime1 mtime2) - mark newer files + (not (= size1 size2)) - mark files with different sizes + (not (string= (nth 8 fa1) (nth 8 fa2))) - mark files with different modes + (not (and (= (nth 2 fa1) (nth 2 fa2)) - mark files with different UID + (= (nth 3 fa1) (nth 3 fa2)))) and GID." + (interactive + (list (read-file-name (format "Compare %s with: " + (dired-current-directory)) + (dired-dwim-target-directory)) + (read-minibuffer "Mark if (lisp expr): "))) + (let* ((dir1 (dired-current-directory)) + (file-alist1 (dired-files-attributes dir1)) + (file-alist2 (dired-files-attributes dir2)) + (file-list1 (mapcar + 'cadr + (dired-file-set-difference + file-alist1 file-alist2 + predicate))) + (file-list2 (mapcar + 'cadr + (dired-file-set-difference + file-alist2 file-alist1 + predicate)))) + (dired-fun-in-all-buffers + dir1 nil + (lambda () + (dired-mark-if + (member (dired-get-filename nil t) file-list1) nil))) + (dired-fun-in-all-buffers + dir2 nil + (lambda () + (dired-mark-if + (member (dired-get-filename nil t) file-list2) nil))) + (message "Marked in dir1: %s files, in dir2: %s files" + (length file-list1) + (length file-list2)))) + +(defun dired-file-set-difference (list1 list2 predicate) + "Combine LIST1 and LIST2 using a set-difference operation. +The result list contains all file items that appear in LIST1 but not LIST2. +This is a non-destructive function; it makes a copy of the data if necessary +to avoid corrupting the original LIST1 and LIST2. +PREDICATE (see `dired-compare-directories') is an additional match +condition. Two file items are considered to match if they are equal +*and* PREDICATE evaluates to t." + (if (or (null list1) (null list2)) + list1 + (let (res) + (dolist (file1 list1) + (unless (let ((list list2)) + (while (and list + (not (let* ((file2 (car list)) + (fa1 (caddr file1)) + (fa2 (caddr file2)) + (size1 (nth 7 fa1)) + (size2 (nth 7 fa2)) + (mtime1 (float-time (nth 5 fa1))) + (mtime2 (float-time (nth 5 fa2)))) + (and + (equal (car file1) (car file2)) + (not (eval predicate)))))) + (setq list (cdr list))) + list) + (setq res (cons file1 res)))) + (nreverse res)))) + +(defun dired-files-attributes (dir) + "Return a list of all file names and attributes from DIR. +List has a form of (file-name full-file-name (attribute-list))" + (mapcar + (lambda (file-name) + (let ((full-file-name (expand-file-name file-name dir))) + (list file-name + full-file-name + (file-attributes full-file-name)))) + (directory-files dir))) + (defun dired-do-chxxx (attribute-name program op-symbol arg) ;; Change file attributes (mode, group, owner) of marked files and ;; refresh their file lines. @@ -2015,6 +2110,11 @@ with the command \\[tags-loop-continue]." (interactive "sQuery replace in marked files (regexp): \nsQuery replace %s by: \nP") + (dolist (file (dired-get-marked-files nil nil 'dired-nondirectory-p)) + (let ((buffer (get-file-buffer file))) + (if (and buffer (with-current-buffer buffer + buffer-read-only)) + (error "File `%s' is visited read-only")))) (tags-query-replace from to delimited '(dired-get-marked-files nil nil 'dired-nondirectory-p)))