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