|
22
|
1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
2 ;;
|
|
|
3 ;; File: dired-mob.el
|
|
|
4 ;; RCS:
|
|
116
|
5 ;; Dired Version: #Revision: 7.9 $
|
|
22
|
6 ;; Description: Commands for marking files from another buffer.
|
|
|
7 ;;
|
|
|
8 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
9
|
|
|
10 ;;; Requirements and provisions
|
|
|
11 (provide 'dired-mob)
|
|
|
12 (require 'dired)
|
|
|
13 (autoload 'compilation-buffer-p "compile")
|
|
|
14 (autoload 'compile-reinitialize-errors "compile")
|
|
|
15
|
|
|
16 ;; For the byte-compiler
|
|
|
17 (defvar compilation-error-list)
|
|
|
18
|
|
|
19 ;;; Utilities
|
|
|
20
|
|
|
21 (defun dired-mark-these-files (file-list from)
|
|
|
22 ;; Mark the files in FILE-LIST. Relative filenames are taken to be
|
|
|
23 ;; in the current dired directory.
|
|
|
24 ;; FROM is a string (used for logging) describing where FILE-LIST
|
|
|
25 ;; came from.
|
|
|
26 ;; Logs files that were not found and displays a success or failure
|
|
|
27 ;; message.
|
|
|
28 (message "Marking files %s..." from)
|
|
|
29 (let ((total (length file-list))
|
|
|
30 (cur-dir (dired-current-directory))
|
|
|
31 file failures)
|
|
|
32 (while file-list
|
|
|
33 (setq file (expand-file-name (car file-list) cur-dir)
|
|
|
34 file-list (cdr file-list))
|
|
|
35 ;;(message "Marking file `%s'" file)
|
|
|
36 (save-excursion
|
|
|
37 (if (dired-goto-file file)
|
|
|
38 (dired-mark 1) ; supplying a prefix keeps it from checking
|
|
|
39 ; for a subdir.
|
|
|
40 (setq failures (cons (dired-make-relative file) failures))
|
|
|
41 (dired-log (buffer-name (current-buffer))
|
|
|
42 "Cannot mark this file (not found): %s\n" file))))
|
|
|
43 (dired-update-mode-line-modified t)
|
|
|
44 (if failures
|
|
|
45 (dired-log-summary
|
|
|
46 (buffer-name (current-buffer))
|
|
|
47 (format "Failed to mark %d of %d files %s %s"
|
|
|
48 (length failures) total from failures) failures)
|
|
|
49 (message "Marked %d file%s %s." total (dired-plural-s total) from))))
|
|
|
50
|
|
|
51 ;;; User commands
|
|
|
52
|
|
|
53 (defun dired-mark-files-from-other-dired-buffer (buf)
|
|
|
54 "Mark files that are marked in the other Dired buffer.
|
|
|
55 I.e, mark those files in this Dired buffer that have the same
|
|
|
56 non-directory part as the marked files in the Dired buffer in the other
|
|
|
57 window."
|
|
|
58 (interactive (list (window-buffer (next-window))))
|
|
|
59 (if (eq (get-buffer buf) (current-buffer))
|
|
|
60 (error "Other dired buffer is the same"))
|
|
|
61 (or (stringp buf) (setq buf (buffer-name buf)))
|
|
|
62 (let ((other-files (save-excursion
|
|
|
63 (set-buffer buf)
|
|
|
64 (or (eq major-mode 'dired-mode)
|
|
|
65 (error "%s is not a dired buffer" buf))
|
|
|
66 (dired-get-marked-files 'no-dir))))
|
|
|
67 (dired-mark-these-files other-files (concat "from buffer " buf))))
|
|
|
68
|
|
|
69 (defun dired-mark-files-compilation-buffer (&optional buf)
|
|
|
70 "Mark the files mentioned in the `*compilation*' buffer.
|
|
|
71 With a prefix, you may specify the other buffer."
|
|
|
72 (interactive
|
|
|
73 (list
|
|
|
74 (let ((buff (let ((owin (selected-window))
|
|
|
75 found)
|
|
|
76 (unwind-protect
|
|
|
77 (progn
|
|
|
78 (other-window 1)
|
|
|
79 (while (null (or found (eq (selected-window) owin)))
|
|
|
80 (if (compilation-buffer-p
|
|
|
81 (window-buffer (selected-window)))
|
|
|
82 (setq found (current-buffer)))
|
|
|
83 (other-window 1)))
|
|
|
84 (select-window owin))
|
|
|
85 found)))
|
|
|
86 (if (or current-prefix-arg (null buff))
|
|
|
87 (let ((minibuffer-history
|
|
|
88 (delq nil
|
|
|
89 (mapcar
|
|
|
90 (function
|
|
|
91 (lambda (b)
|
|
|
92 (and (compilation-buffer-p b) (buffer-name b))))
|
|
|
93 (buffer-list)))))
|
|
|
94 (read-buffer "Use buffer: "
|
|
|
95 (or buff (car minibuffer-history))))
|
|
|
96 buff))))
|
|
|
97 (let ((dired-dir (directory-file-name default-directory))
|
|
|
98 files)
|
|
|
99 (save-window-excursion
|
|
|
100 (set-buffer buf)
|
|
|
101 (compile-reinitialize-errors nil (point-max))
|
|
|
102 (let ((alist compilation-error-list)
|
|
|
103 f d elt)
|
|
|
104 (while alist
|
|
|
105 (setq elt (car alist)
|
|
|
106 alist (cdr alist))
|
|
|
107 (and (consp (setq elt (car (cdr elt))))
|
|
|
108 (stringp (setq d (car elt)))
|
|
|
109 (stringp (setq f (cdr elt)))
|
|
|
110 (progn
|
|
|
111 (setq d (expand-file-name d))
|
|
|
112 (dired-in-this-tree d dired-dir))
|
|
|
113 (progn
|
|
|
114 (setq f (expand-file-name f d))
|
|
|
115 (not (member f files)))
|
|
|
116 (setq files (cons f files))))))
|
|
|
117 (dired-mark-these-files
|
|
|
118 files
|
|
|
119 (concat "From compilation buffer "
|
|
|
120 (if (stringp buf) buf (buffer-name buf))))))
|
|
|
121
|
|
|
122 ;;; end of dired-mob.el
|
