cgit.sxemacs.org Git - packages/blob - xemacs-packages/dired/dired-mob.el

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;;
   3 ;; File:           dired-mob.el
   4 ;; RCS:
   5 ;; Dired Version: 7.17
   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 ;;;###autoload
  54 (defun dired-mark-files-from-other-dired-buffer (buf)
  55   "Mark files that are marked in the other Dired buffer.
  56 I.e, mark those files in this Dired buffer that have the same
  57 non-directory part as the marked files in the Dired buffer in the other
  58 window."
  59   (interactive (list (window-buffer (next-window))))
  60   (if (eq (get-buffer buf) (current-buffer))
  61       (error "Other dired buffer is the same"))
  62   (or (stringp buf) (setq buf (buffer-name buf)))
  63   (let ((other-files (save-excursion
  64                        (set-buffer buf)
  65                        (or (eq major-mode 'dired-mode)
  66                            (error "%s is not a dired buffer" buf))
  67                        (dired-get-marked-files 'no-dir))))
  68     (dired-mark-these-files other-files (concat "from buffer " buf))))
  69
  70 ;;;###autoload
  71 (defun dired-mark-files-compilation-buffer (&optional buf)
  72   "Mark the files mentioned in the `*compilation*' buffer.
  73 With a prefix, you may specify the other buffer."
  74   (interactive
  75    (list
  76     (let ((buff  (let ((owin (selected-window))
  77                       found)
  78                   (unwind-protect
  79                       (progn
  80                         (other-window 1)
  81                         (while (null (or found (eq (selected-window) owin)))
  82                           (if (compilation-buffer-p
  83                                (window-buffer (selected-window)))
  84                               (setq found (current-buffer)))
  85                           (other-window 1)))
  86                     (select-window owin))
  87                   found)))
  88       (if (or current-prefix-arg (null buff))
  89           (let ((minibuffer-history
  90                  (delq nil
  91                       (mapcar
  92                        (function
  93                         (lambda (b)
  94                           (and (compilation-buffer-p b) (buffer-name b))))
  95                        (buffer-list)))))
  96             (read-buffer "Use buffer: "
  97                          (or buff (car minibuffer-history))))
  98         buff))))
  99   (let ((dired-dir (directory-file-name default-directory))
 100         files)
 101     (save-window-excursion
 102       (set-buffer buf)
 103       (compile-reinitialize-errors nil (point-max))
 104       (let ((alist compilation-error-list)
 105             f d elt)
 106         (while alist
 107           (setq elt (car alist)
 108                 alist (cdr alist))
 109           (and (consp (setq elt (car (cdr elt))))
 110                (stringp (setq d (car elt)))
 111                (stringp (setq f (cdr elt)))
 112                (progn
 113                  (setq d (expand-file-name d))
 114                  (dired-in-this-tree d dired-dir))
 115                (progn
 116                  (setq f (expand-file-name f d))
 117                  (not (member f files)))
 118                (setq files (cons f files))))))
 119     (dired-mark-these-files
 120      files
 121      (concat "From compilation buffer "
 122              (if (stringp buf) buf (buffer-name buf))))))
 123
 124 ;;; end of dired-mob.el