--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/efs/dired-mob.el	Mon Aug 13 09:13:56 2007 +0200
@@ -0,0 +1,122 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; File:           dired-mob.el
+;; RCS:
+;; Dired Version:  $Revision: 1.1 $
+;; 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