Mercurial > hg > xemacs-beta
comparison lisp/efs/dired-mob.el @ 22:8fc7fe29b841 r19-15b94
Import from CVS: tag r19-15b94
| author | cvs |
|---|---|
| date | Mon, 13 Aug 2007 08:50:29 +0200 |
| parents | |
| children | 7e54bd776075 9f59509498e1 |
comparison
equal
deleted
inserted
replaced
| 21:b88636d63495 | 22:8fc7fe29b841 |
|---|---|
| 1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| 2 ;; | |
| 3 ;; File: dired-mob.el | |
| 4 ;; RCS: | |
| 5 ;; Dired Version: $Revision: 1.1 $ | |
| 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 |