/[emacs]/emacs/lisp/dired-aux.el
ViewVC logotype

Diff of /emacs/lisp/dired-aux.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.111 by miles, Mon Sep 1 15:45:09 2003 UTC revision 1.112 by rms, Mon Dec 1 01:56:19 2003 UTC
# Line 88  With prefix arg, prompt for argument SWI Line 88  With prefix arg, prompt for argument SWI
88        nil))        nil))
89    (diff-backup (dired-get-filename) switches))    (diff-backup (dired-get-filename) switches))
90    
91    (defun dired-compare-directories (dir2 predicate)
92      "Mark files with different file attributes in two dired buffers.
93    Compare file attributes of files in the current directory
94    with file attributes in directory DIR2 using PREDICATE on pairs of files
95    with the same name.  Mark files for which PREDICATE returns non-nil.
96    
97    PREDICATE is a Lisp expression that can refer to the following variables:
98    
99        size1, size2   - file size in bytes
100        mtime1, mtime2 - last modification time in seconds, as a float
101        fa1, fa2       - list of file attributes
102                         returned by function `file-attributes'
103    
104        where 1 refers to attribute of file in the current dired buffer
105        and 2 to attribute of file in second dired buffer.
106    
107    Examples of PREDICATE:
108    
109        (> mtime1 mtime2) - mark newer files
110        (not (= size1 size2)) - mark files with different sizes
111        (not (string= (nth 8 fa1) (nth 8 fa2))) - mark files with different modes
112        (not (and (= (nth 2 fa1) (nth 2 fa2))   - mark files with different UID
113                  (= (nth 3 fa1) (nth 3 fa2))))   and GID."
114      (interactive
115       (list (read-file-name (format "Compare %s with: "
116                                     (dired-current-directory))
117                             (dired-dwim-target-directory))
118             (read-minibuffer "Mark if (lisp expr): ")))
119      (let* ((dir1 (dired-current-directory))
120             (file-alist1 (dired-files-attributes dir1))
121             (file-alist2 (dired-files-attributes dir2))
122             (file-list1 (mapcar
123                          'cadr
124                          (dired-file-set-difference
125                           file-alist1 file-alist2
126                           predicate)))
127             (file-list2 (mapcar
128                          'cadr
129                          (dired-file-set-difference
130                           file-alist2 file-alist1
131                           predicate))))
132        (dired-fun-in-all-buffers
133         dir1 nil
134         (lambda ()
135           (dired-mark-if
136            (member (dired-get-filename nil t) file-list1) nil)))
137        (dired-fun-in-all-buffers
138         dir2 nil
139         (lambda ()
140           (dired-mark-if
141            (member (dired-get-filename nil t) file-list2) nil)))
142        (message "Marked in dir1: %s files, in dir2: %s files"
143                 (length file-list1)
144                 (length file-list2))))
145    
146    (defun dired-file-set-difference (list1 list2 predicate)
147      "Combine LIST1 and LIST2 using a set-difference operation.
148    The result list contains all file items that appear in LIST1 but not LIST2.
149    This is a non-destructive function; it makes a copy of the data if necessary
150    to avoid corrupting the original LIST1 and LIST2.
151    PREDICATE (see `dired-compare-directories') is an additional match
152    condition.  Two file items are considered to match if they are equal
153    *and* PREDICATE evaluates to t."
154      (if (or (null list1) (null list2))
155          list1
156        (let (res)
157          (dolist (file1 list1)
158            (unless (let ((list list2))
159                      (while (and list
160                                  (not (let* ((file2 (car list))
161                                              (fa1 (caddr file1))
162                                              (fa2 (caddr file2))
163                                              (size1 (nth 7 fa1))
164                                              (size2 (nth 7 fa2))
165                                              (mtime1 (float-time (nth 5 fa1)))
166                                              (mtime2 (float-time (nth 5 fa2))))
167                                         (and
168                                          (equal (car file1) (car file2))
169                                          (not (eval predicate))))))
170                        (setq list (cdr list)))
171                      list)
172              (setq res (cons file1 res))))
173          (nreverse res))))
174    
175    (defun dired-files-attributes (dir)
176      "Return a list of all file names and attributes from DIR.
177    List has a form of (file-name full-file-name (attribute-list))"
178      (mapcar
179       (lambda (file-name)
180         (let ((full-file-name (expand-file-name file-name dir)))
181           (list file-name
182                 full-file-name
183                 (file-attributes full-file-name))))
184       (directory-files dir)))
185    
186  (defun dired-do-chxxx (attribute-name program op-symbol arg)  (defun dired-do-chxxx (attribute-name program op-symbol arg)
187    ;; Change file attributes (mode, group, owner) of marked files and    ;; Change file attributes (mode, group, owner) of marked files and
188    ;; refresh their file lines.    ;; refresh their file lines.
# Line 2015  If you exit (\\[keyboard-quit], RET or q Line 2110  If you exit (\\[keyboard-quit], RET or q
2110  with the command \\[tags-loop-continue]."  with the command \\[tags-loop-continue]."
2111    (interactive    (interactive
2112     "sQuery replace in marked files (regexp): \nsQuery replace %s by: \nP")     "sQuery replace in marked files (regexp): \nsQuery replace %s by: \nP")
2113      (dolist (file (dired-get-marked-files nil nil 'dired-nondirectory-p))
2114        (let ((buffer (get-file-buffer file)))
2115          (if (and buffer (with-current-buffer buffer
2116                            buffer-read-only))
2117              (error "File `%s' is visited read-only"))))
2118    (tags-query-replace from to delimited    (tags-query-replace from to delimited
2119                        '(dired-get-marked-files nil nil 'dired-nondirectory-p)))                        '(dired-get-marked-files nil nil 'dired-nondirectory-p)))
2120    

Legend:
Removed from v.1.111  
changed lines
  Added in v.1.112

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26