;;; dired-wipe.el
;;;
;;; Copyright (C) 1996, 1997, 1998, 1999,
;;;   2000, 2002, 2004, 2007, 2008 Thien-Thi Nguyen
;;; This file is part of ttn's personal elisp library, released under GNU
;;; GPL with ABSOLUTELY NO WARRANTY.  See the file COPYING for details.

;;; Description: In dired, remove lines of certain type.

(require 'cl)

(defvar dired-wipe-types                ; todo: use defcustom
  (append
   '(("change log" . "ChangeLog")
     ("cvs base" . ".*CVS/Base/.*")
     ("generated makefile" . "Makefile\\(.in\\)*$")
     ("unseeables"      . "---  ")
     ("read-only"       . "^....-")
     ("writeable"       . "^....w")
     ("executables"     . "[*]$")
     ("directories"     . "/$")
     ("version control" . ",v\\>")
     ("compiled elisp"  . "\\.elc\\>")
     ;; Add new wipe types here.
     )
   (let (ret)
     (dolist (pair (remove-if-not (lambda (item)
                                    (and (consp item)
                                         (not (consp (cdr item)))))
                                  auto-mode-alist))
       (let ((key (symbol-name (cdr pair)))
             (val (car pair)))
         (let ((lookup (assoc key ret)))
           (if lookup
               (setcdr lookup (cons val (cdr lookup)))
             (setq ret (cons (list key val) ret))))))
     (flet ((munge (s)
                   (while (string-match "\\\\[`]" s)
                     (setq s (concat
                              (substring s 0 (match-beginning 0))
                              (substring s (match-end 0)))))
                   (while (string-match "\\\\[']" s)
                     (setq s (concat
                              (substring s 0 (match-beginning 0))
                              "$"
                              (substring s (match-end 0)))))
                   s))
       (mapcar (lambda (pair)
                 (cons (car pair)
                       (if (= 1 (length (cdr pair)))
                           (munge (cadr pair))
                         (mapconcat (lambda (s)
                                      (concat "\\(" (munge s) "\\)"))
                                    (cdr pair)
                                    "\\|"))))
               ret)))))

;;;###autoload
(defun dired-wipe (type)
  "In dired, don't bother with certain TYPEs of files/directories."
  (interactive (list (completing-read "Type: " dired-wipe-types nil 1)))
  (let ((wt dired-wipe-types))
    (when (string= "" type)
      (let ((new (read-string "Regexp: "))
            (name (read-string "Name (or blank for temporary): ")))
        (if (string= "" name)
            (setq wt (cons (cons type new) wt))
          (setq type name
                dired-wipe-types (cons (cons type new) dired-wipe-types)
                wt dired-wipe-types))))
    (unless (eq 'dired-mode major-mode)
      (dired "."))
    (let ((re (cdr (assoc type wt))))
      (save-excursion
        (goto-char (point-min))
        (dired-goto-next-nontrivial-file)
        (let (buffer-read-only)
          (delete-matching-lines re))))))

(provide 'dired-wipe)

;;; dired-wipe.el ends here