Download
(defconst traverse-version "2.10")
(require 'derived)
(eval-when-compile (require 'cl))
(defvar traverse-mode-map
(let ((map (make-sparse-keymap)))
(define-key map [?q] 'traverse-quit)
(define-key map [?N] 'traverse-go-forward)
(define-key map [?P] 'traverse-go-backward)
(define-key map [(shift down)] 'traverse-scroll-down-other-window)
(define-key map [(shift up)] 'traverse-scroll-up-other-window)
(define-key map [?|] 'traverse-toggle-split-window-h-v)
(define-key map (kbd "C-z") 'traverse-jump-other-window)
map)
"Keymap used for traverse commands.")
(define-derived-mode traverse-mode text-mode "traverse"
"Major mode to recurse in a tree and perform diverses actions on files.
Special commands:
\\{traverse-mode-map}")
(defgroup traverse nil
"Mode that allow walking through directories and perform diverses actions on files."
:prefix "traverse-"
:group 'text)
(defcustom traverse-ignore-files
'(".elc$" ".pyc$"
".orig$" ".bz2$"
".gz$" ".zip$"
".vdi$" ".doc$"
".jpg$" ".avi$"
".jpeg$" ".png$"
".xpm$" ".jar$"
".pbm$" ".gif$"
".xls$" ".ppt$"
".mdb$" ".adp$"
"\\<\\(TAGS\\)\\>"
".tiff$" ".img$"
".pdf$" ".dvi$"
".xbm$" ".gpg$"
".svg$" ".rej$")
"Files we want to ignore.
Are allowed:(examples)
- extensions file ==> .ext
- Plain name ==> TAGS ; note regexps take precedence on plain names.
- Regexp ==> \".*\\(.py\\)$\""
:group 'traverse
:type '(repeat string))
(defcustom traverse-ignore-dirs
'(".hg" ".svn"
"RCS" ".bzr"
".git" ".VirtualBox"
".arch-ids" "CVS"
"{arch}" "knits")
"Directories we don't want to search in."
:group 'traverse
:type '(repeat string))
(defcustom traverse-length-line
45
"Length of the line displayed in traverse buffers."
:group 'traverse
:type 'integer)
(defcustom traverse-file-function
'traverse-file-process
"Default function to use to process files."
:group 'traverse
:type 'symbol)
(defcustom traverse-use-avfs
nil
"Enable support for avfs."
:group 'traverse
:type 'boolean)
(defcustom traverse-avfs-default-directory
"~/.avfs"
"Default directory for avfs."
:group 'traverse
:type 'string)
(defgroup traverse-faces nil
"Faces for TRAVERSE."
:group 'traverse)
(defface traverse-match-face '((t (:foreground "red")))
"TRAVERSE face."
:group 'traverse-faces)
(defface traverse-regex-face '((t (:foreground "yellow")))
"TRAVERSE face."
:group 'traverse-faces)
(defface traverse-path-face '((t (:foreground "green")))
"TRAVERSE face."
:group 'traverse-faces)
(defface traverse-overlay-face '((t (:background "Indianred4" :underline t)))
"Face for highlight line in matched buffer."
:group 'traverse-faces)
(defvar traverse-match-overlay-face 'traverse-overlay-face
"*Use the default traverse face for overlay.")
(defvar traverse-show-regexp-delay 1
"*Delay in seconds where regexp found is highlighted.")
(defvar traverse-keep-indent nil
"*Keep indentation in traverse buffer if non nil.")
(defvar traverse-count-occurences 0
"Simple variable to store the number of occurence found.")
(defvar traverse-occur-overlay nil)
(make-variable-buffer-local 'traverse-occur-overlay)
(defun traverselisp-version ()
"Give version number of traverselisp."
(interactive)
(message "traverse-lisp-version-%s" traverse-version))
(defun traverse-quit ()
"Quit and kill traverse buffer."
(interactive)
(quit-window t)
(other-window 1)
(delete-other-windows)
(when traverse-occur-overlay
(delete-overlay traverse-occur-overlay)))
(defun traverse-list-directory (dirname &optional abs)
"Use directory-files without these \".\" \"..\".
If abs is non-nil use absolute path."
(let ((regexp "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"))
(directory-files dirname abs regexp)))
(defsubst* traverse-walk-directory (dirname &key file-fn dir-fn exclude-files exclude-dirs)
"Walk through DIRNAME and use FILE-FN and/or DIR-FN function on each file/dir found.
DIRNAME ==> we start in this directory
Use keys to set args:
You must specify at list one of these 2 functions:
:FILE-FN ==> function to apply to FILES
:DIR-FN ==> function to apply on DIRECTORIES
Files or/and directories in these lists will be skipped:
:EXCLUDES-FILES ==> list of .ext or files to ignore.
:EXCLUDE-DIRS ==> list of directory to ignore.
Example of use:
(traverse-walk-directory \"~/foo\" :file-fn #'(lambda (x) (princ x) (terpri)))
See `traverse-ignore-files' and `traverse-ignore-dirs'."
(labels
((walk (name)
(cond (
(eq t (car (file-attributes name)))
(when dir-fn (funcall dir-fn name))
(if exclude-dirs
(dolist (x (traverse-list-directory name t))
(when (stringp x)
(unless (member (file-name-nondirectory x) exclude-dirs)
(walk x))))
(dolist (x (traverse-list-directory name t))
(when (stringp x)
(walk x)))))
((eq nil (car (file-attributes name)))
(when file-fn
(if exclude-files
(unless (traverse-check-only-lists name exclude-files)
(funcall file-fn name))
(funcall file-fn name)))))))
(if (or file-fn dir-fn)
(walk (expand-file-name dirname))
(error "Error:you must specify at least one function"))))
(defun traverse-goto-line (numline)
"Non--interactive version of `goto-line.'"
(goto-char (point-min)) (forward-line (1- numline)))
(defun traverse-comp-str-to-list (str lis)
"Compare STR with all elements of list LIS.
All the elements of list LIS are regexps issued from prompt.
Each element of LIS is compared with the filename STR."
(catch 'break
(dolist (i lis)
(when (string-match i str)
(throw 'break t)))))
(defun traverse-check-only-lists (str lis)
"Check if STR match one element of LIS."
(or (member (file-name-extension str t) lis)
(traverse-comp-str-to-list str lis)))
(defsubst* traverse-find-readlines (bfile regexp &key (insert-fn 'buffer))
"Return an alist of all the (numline line) matching REGEXP."
(let ((fn (case insert-fn
('file 'insert-file-contents)
('buffer 'insert-buffer-substring))))
(with-temp-buffer
(funcall fn bfile)
(goto-char (point-min))
(loop
with lines-list = (split-string (buffer-string) "\n")
for i in lines-list for count from 0 when (string-match regexp i)
collect (list count i) into lis
finally return lis))))
(defun traverse-file-process (regex fname &optional full-path insert-fn)
"Default function to process files and insert matched lines in *traverse-lisp* buffer."
(let ((matched-lines (traverse-find-readlines fname regex :insert-fn (or insert-fn 'file))))
(when matched-lines
(dolist (i matched-lines)
(let ((line-to-print (if traverse-keep-indent
(second i)
(replace-regexp-in-string "\\(^ *\\)" "" (second i)))))
(and (cond ((eq insert-fn 'file)
(insert-button (format "[%s]"
(if full-path
fname
(file-relative-name fname default-directory)))
'action 'traverse-button-func
'face "hi-green"))
((eq insert-fn 'buffer)
(insert-button (format "[%s]" (buffer-name fname))
'action 'traverse-button-func
'face "hi-green")))
(insert (concat " " (int-to-string (+ (first i) 1))
":"
(if (> (length line-to-print) traverse-length-line)
(substring line-to-print 0 traverse-length-line)
line-to-print)
"\n"))))))
(setq traverse-count-occurences (+ traverse-count-occurences (length matched-lines)))))
(defun* traverse-file-process-ext (regex fname &key (lline traverse-length-line))
"Function to process files in external program like anything."
(setq traverse-count-occurences 0)
(let ((matched-lines (traverse-find-readlines fname regex :insert-fn 'file)))
(when matched-lines
(dolist (i matched-lines)
(let* ((ltp (second i))
(replace-reg (if (string-match "^\t" ltp) "\\(^\t*\\)" "\\(^ *\\)"))
(new-ltp (replace-regexp-in-string replace-reg "" ltp))
(line-to-print (if traverse-keep-indent ltp new-ltp)))
(incf traverse-count-occurences)
(insert (concat (propertize (file-name-nondirectory fname)
'face 'traverse-path-face
'help-echo line-to-print)
" "
(propertize (int-to-string (+ (first i) 1))
'face 'traverse-match-face)
":"
(if (> (length line-to-print) lline)
(substring line-to-print 0 lline)
line-to-print)
"\n")))))))
(defun* traverse-buffer-process-ext (regex buffer &key (lline traverse-length-line))
"Function to process buffer in external program like anything."
(setq traverse-count-occurences 0)
(let ((matched-lines (traverse-find-readlines buffer regex :insert-fn 'buffer)))
(when matched-lines
(dolist (i matched-lines)
(let* ((ltp (second i))
(replace-reg (if (string-match "^\t" ltp) "\\(^\t*\\)" "\\(^ *\\)"))
(new-ltp (replace-regexp-in-string replace-reg "" ltp))
(line-to-print (if traverse-keep-indent ltp new-ltp)))
(incf traverse-count-occurences)
(insert (concat " " (propertize (int-to-string (+ (first i) 1))
'face 'traverse-match-face
'help-echo line-to-print)
":"
(if (> (length line-to-print) lline)
(substring line-to-print 0 lline)
line-to-print)
"\n")))))))
(defun traverse-find-in-file (fname regexp &optional full-path)
"Traverse search regex in a single file."
(interactive (list (read-file-name "FileName: ")
(traverse-read-regexp (if (fboundp 'read-regexp) "Regexp" "Regexp: "))))
(traverse-prepare-buffer)
(let ((prefarg (not (null current-prefix-arg))))
(if (and (not (bufferp fname))
(file-regular-p fname)
(not (file-symlink-p fname)))
(traverse-file-process regexp fname prefarg 'file)
(traverse-file-process regexp fname prefarg 'buffer))
(goto-char (point-min))
(when (re-search-forward "^Wait")
(beginning-of-line)
(delete-region (point) (line-end-position))
(insert (format "Found %s occurences for %s:\n"
traverse-count-occurences
regexp))
(message "%s Occurences found for %s"
(propertize (int-to-string traverse-count-occurences)
'face 'traverse-match-face)
(propertize regexp
'face 'traverse-regex-face))
(highlight-regexp regexp)
(setq traverse-count-occurences 0)))
(switch-to-buffer-other-window "*traverse-lisp*"))
(defun traverse-occur-color-current-line ()
"Highlight and underline current position."
(if (not traverse-occur-overlay)
(setq traverse-occur-overlay
(make-overlay
(line-beginning-position) (1+ (line-end-position))))
(move-overlay traverse-occur-overlay
(line-beginning-position) (1+ (line-end-position))))
(overlay-put traverse-occur-overlay
'face traverse-match-overlay-face))
(defun traverse-button-func (button)
"The function called by buttons in traverse buffers."
(let* ((list-line (split-string (thing-at-point 'line)))
(nline (nth 1 list-line))
(fname (button-label (button-at (point)))))
(save-excursion
(setq fname (replace-regexp-in-string "\\(\\[\\|\\]\\)" "" fname))
(if (bufferp (get-buffer fname))
(switch-to-buffer-other-window (get-buffer fname))
(find-file-other-window fname))
(traverse-goto-line (string-to-number nline))
(beginning-of-line) (traverse-occur-color-current-line))))
(defun traverse-prepare-buffer ()
"Prepare a traverse buffer."
(set-buffer (get-buffer-create "*traverse-lisp*"))
(erase-buffer)
(hi-lock-mode 1)
(goto-char (point-min))
(traverse-mode)
(insert " *Traverse-lisp-output*\n\n\n")
(highlight-regexp " \\*Traverse-lisp-output\\*$" "hi-pink")
(display-buffer "*traverse-lisp*")
(insert "Wait Lisp searching...\n\n")
(sit-for 1))
(defun traverse-read-regexp (&rest args)
"For compatibility with emacs-22.
Use `read-string' in emacs-22 instead of using `read-regexp'.
Use the same args as `read-string' or `read-regexp'
depending of what emacs version you use.
NOTE:When using `read-string' some regexp (complex)
may not be displayed correctly to traverselisp"
(apply #'funcall (if (fboundp 'read-regexp) 'read-regexp 'read-string)
args))
(defun traverse-deep-rfind (tree regexp &optional only)
"Search for regexp in all files of dirs and subdirs of current tree.
Main function that call walk, if only is omitted it
will be set as nil and search will be proceeded on all files
except on files that are in `traverse-ignore-files'
Called with prefix-argument (C-u) absolute path is displayed"
(interactive
(list (read-directory-name "Tree: ")
(traverse-read-regexp (if (fboundp 'read-regexp) "Regexp" "Regexp: "))
(read-string "CheckOnly: ")))
(traverse-prepare-buffer)
(let ((init-time (cadr (current-time)))
(only-list (split-string only)))
(unwind-protect
(traverse-walk-directory
tree
:file-fn #'(lambda (y)
(let ((prefarg (not (null current-prefix-arg))))
(if only-list
(when (traverse-check-only-lists y only-list)
(funcall traverse-file-function regexp y prefarg 'file))
(funcall traverse-file-function regexp y prefarg 'file)))
(message "[%s] Matches for `%s'"
(if (>= traverse-count-occurences 1)
(int-to-string traverse-count-occurences) 0)
regexp))
:exclude-files (unless only-list
traverse-ignore-files)
:exclude-dirs traverse-ignore-dirs)
(setq traverse-count-occurences
(if (< traverse-count-occurences 0)
0 traverse-count-occurences))
(goto-char (point-min))
(when (re-search-forward "^Wait")
(beginning-of-line)
(delete-region (point) (line-end-position))
(if (eq traverse-count-occurences 0)
(insert "Oh!No! Nothing found!")
(insert
(format "Search performed in %s seconds\n\nFound %s occurences for %s\n"
(- (cadr (current-time)) init-time)
traverse-count-occurences regexp))))
(message "%s Occurences found for %s in %s seconds"
(int-to-string traverse-count-occurences)
regexp (- (cadr (current-time)) init-time))
(highlight-regexp regexp)
(setq traverse-count-occurences 0)))
(switch-to-buffer-other-window "*traverse-lisp*"))
(defun traverse-search-in-dired-dir-at-point (regex &optional only)
"Search for regexp in all files of directory at point in a dired buffer."
(interactive (list (traverse-read-regexp (if (fboundp 'read-regexp) "Regexp" "Regexp: "))
(read-string "CheckOnly: ")))
(if (eq major-mode 'dired-mode)
(let ((tree (dired-get-filename)))
(if (file-directory-p tree)
(traverse-deep-rfind tree regex only)
(message "Sorry! %s is not a Directory" tree)))
(message "Hoops! We are not in Dired!")))
(defun traverse-search-in-dired-file-at-point (regex)
"Search for regexp in file at point in a dired buffer."
(interactive (list (traverse-read-regexp (if (fboundp 'read-regexp) "Regexp" "Regexp: "))))
(if (eq major-mode 'dired-mode)
(let ((fname (dired-get-filename)))
(if (file-regular-p fname)
(traverse-find-in-file fname regex)
(message "Sorry! %s is not a regular file" fname)))
(message "Hoops! We are not in Dired!")))
(defun traverse-dired-browse-archive ()
"Open compressed archive at point in a dired buffer.
This function use AVFS and FUSE, so be sure
to have these programs and modules installed on your system."
(interactive)
(when traverse-use-avfs
(let ((file-at-point (dired-get-filename)))
(if (file-compressed-p file-at-point)
(progn
(when (not (cddr (directory-files traverse-avfs-default-directory)))
(shell-command "mountavfs"))
(find-file (concat traverse-avfs-default-directory file-at-point "#")))
(find-file file-at-point)))))
(defun traverse-dired-search-in-archive (regexp &optional only)
"Search for regexp in compressed archive at point in a dired buffer.
This function use AVFS and FUSE, so be sure
to have these programs installed on your system and FUSE module
enabled in your kernel.
This function is disabled by default, enable it setting
traverse-use-avfs to non--nil"
(interactive (list (traverse-read-regexp (if (fboundp 'read-regexp) "Regexp" "Regexp: "))
(read-string "CheckOnly: ")))
(when traverse-use-avfs
(let ((file-at-point (dired-get-filename)))
(if (file-compressed-p file-at-point)
(progn
(when (not (cddr (directory-files traverse-avfs-default-directory)))
(shell-command "mountavfs"))
(traverse-deep-rfind (concat traverse-avfs-default-directory file-at-point "#")
regexp
only))
(message "That's not a compressed file")))))
(defun traverse-dired-find-in-marked-files (regexp &optional full-path)
"Search for regexp in all marked files of a dired buffer.
if some of the marked files are directories ignore them
if no marked files use file at point."
(interactive (list (traverse-read-regexp (if (fboundp 'read-regexp) "Regexp" "Regexp: "))))
(let ((prefarg (not (null current-prefix-arg)))
(fname-list (traverse-dired-get-marked-files)))
(traverse-prepare-buffer)
(dolist (i fname-list)
(traverse-file-process regexp i prefarg 'file))
(goto-char (point-min))
(when (re-search-forward "^Wait")
(beginning-of-line)
(delete-region (point) (line-end-position))
(insert (format "Found %s occurences for %s:\n"
traverse-count-occurences
regexp))
(message "%s Occurences found for %s"
(propertize (int-to-string traverse-count-occurences)
'face 'traverse-match-face)
(propertize regexp
'face 'traverse-regex-face))
(highlight-regexp regexp)
(setq traverse-count-occurences 0)))
(switch-to-buffer-other-window "*traverse-lisp*"))
(defun traverse-dired-find-in-all-files (regexp only &optional full-path)
"Search for regexp in all files of current dired buffer.
except compressed files and symlinks"
(interactive (list (traverse-read-regexp (if (fboundp 'read-regexp) "Regexp" "Regexp: "))
(read-string "CheckOnly: ")))
(let ((prefarg (not (null current-prefix-arg)))
(all-files (traverse-list-directory (dired-current-directory)))
(only-list (split-string only)))
(traverse-prepare-buffer)
(dolist (i all-files)
(when (and (file-regular-p i)
(not (file-symlink-p i))
(not (file-compressed-p i))
(if only-list
(traverse-check-only-lists i only-list)
(not (traverse-check-only-lists i traverse-ignore-files))))
(traverse-file-process regexp i prefarg 'file)))
(goto-char (point-min))
(when (re-search-forward "^Wait")
(beginning-of-line)
(delete-region (point) (line-end-position))
(insert (format "Found %s occurences for %s:\n"
traverse-count-occurences
regexp))
(message "%s Occurences found for %s"
(propertize (int-to-string traverse-count-occurences)
'face 'traverse-match-face)
(propertize regexp
'face 'traverse-regex-face))
(highlight-regexp regexp)
(setq traverse-count-occurences 0)))
(switch-to-buffer-other-window "*traverse-lisp*"))
(defun traverse-dired-get-marked-files (&optional strict)
"Get a list of all marked files in a dired buffer for traverse."
(let* ((fname-list nil)
(all-marked (dired-get-marked-files nil nil nil t))
(dir-marked-list (if strict
(if (symbolp (car all-marked))
(cdr all-marked)
(when (> (length all-marked) 1)
all-marked))
(if (symbolp (car all-marked))
(cdr all-marked)
all-marked))))
(dolist (i dir-marked-list)
(when (and (not (file-directory-p i))
(not (file-compressed-p i)))
(push i fname-list)))
(nreverse fname-list)))
(defun traverse-dired-search-regexp-in-anything-at-point (regexp &optional only)
"Use the right function in dired depending on context.
Search in:
file at point
or
marked files
or
directory at point (recursion)
or
in compressed archive at point if traverse-use-avfs is non--nil."
(interactive
(let ((f-or-d-name (dired-get-filename)))
(cond ((traverse-dired-get-marked-files)
(list (traverse-read-regexp (if (fboundp 'read-regexp) "Regexp" "Regexp: "))))
((or (file-directory-p f-or-d-name)
(and (file-regular-p f-or-d-name)
(file-compressed-p f-or-d-name)))
(list (traverse-read-regexp (if (fboundp 'read-regexp) "Regexp" "Regexp: "))
(read-string "CheckOnly: "))))))
(let ((fname (dired-get-filename)))
(cond ((traverse-dired-get-marked-files)
(traverse-dired-find-in-marked-files regexp))
((file-directory-p fname)
(traverse-search-in-dired-dir-at-point regexp only))
((and (file-regular-p fname)
(file-compressed-p fname))
(traverse-dired-search-in-archive regexp only)))))
(defun traverse-go-forward-or-backward (num)
"Go to next or precedent occurence in a traverse buffer."
(other-window -1)
(when (buffer-file-name (current-buffer))
(save-buffer)
(kill-buffer (current-buffer)))
(other-window -1)
(forward-button num)
(push-button)
(other-window -1))
(defun traverse-jump-other-window ()
(interactive)
(push-button)
(other-window -1))
(defun traverse-go-forward (&optional num)
"Go to next occurence and open file with point at the right place in other window."
(interactive "p")
(traverse-go-forward-or-backward (or num 1)))
(defun traverse-go-backward (&optional num)
"Go to next occurence and open file with point at the right place in other window."
(interactive "p")
(traverse-go-forward-or-backward (- (or num 1))))
(defun traverse-scroll-down-other-window ()
"Scroll other window down from a traverse buffer."
(interactive)
(when (equal (current-buffer)
(get-buffer "*traverse-lisp*"))
(scroll-other-window 1)))
(defun traverse-scroll-up-other-window ()
"Scroll other window up from a traverse buffer."
(interactive)
(when (equal (current-buffer)
(get-buffer "*traverse-lisp*"))
(scroll-other-window -1)))
(defun file-compressed-p (fname)
"Return t if FNAME is a compressed file."
(let ((ext (file-name-extension fname)))
(member ext '("gz" "bz2" "zip"))))
(defun traverse-window-split-h-or-t ()
"Give current split window state under symbol form.
Possible value are 'hor or 'ver"
(cdr (assoc 'dir (bw-get-tree))))
(defun traverse-toggle-split-window-h-v ()
"From traverse buffer toggle split window horizontally or vertically ala ediff."
(interactive)
(when (eq (count-windows) 2)
(balance-windows)
(let ((buffA (current-buffer))
(buffB)
(split-pos (traverse-window-split-h-or-t)))
(save-excursion
(other-window 1)
(setq buffB (current-buffer))
(delete-window))
(if (eq split-pos 'hor)
(split-window-vertically)
(split-window-horizontally))
(set-buffer (get-buffer buffB))
(display-buffer (current-buffer)))))
(defun traverse-count-files-in-dir (tree &optional quiet)
"Count files in TREE.
and return a message and the number of files.
If `quiet' is non-nil don't send message."
(interactive "DDirectory: ")
(let ((count-files 0))
(traverse-walk-directory
tree
:file-fn #'(lambda (n)
(when n
(incf count-files))))
(unless quiet
(message "[%s] contain <%s> files"
(propertize tree
'face 'traverse-path-face)
(propertize (number-to-string count-files)
'face 'traverse-match-face)))
count-files))
(defun traverse-list-directories-in-tree (tree &optional ignore-dirs)
"Return all directories and subdirectories of TREE.
IGNORE-DIRS is a list of directories to ignore."
(let (list-dirs)
(traverse-walk-directory
tree
:dir-fn #'(lambda (x)
(push x list-dirs))
:exclude-dirs (if ignore-dirs
ignore-dirs))
(nreverse list-dirs)))
(defun* traverse-list-files-in-tree (tree
&optional
(ignore-files traverse-ignore-files)
(ignore-dirs traverse-ignore-dirs)
only-ext)
"Return all files in TREE without directories.
IGNORE-FILES is a list of files(and/or).ext to ignore.
ONLY-EXT will match only files with .ext or matching regexp that are in this list.
NOTE: if both IGNORE-FILES and ONLY-EXT' are set, ONLY-EXT will take precedence on IGNORE-FILES."
(let (list-files)
(traverse-walk-directory
tree
:file-fn #'(lambda (x)
(if only-ext
(if (traverse-check-only-lists x only-ext)
(push x list-files))
(push x list-files)))
:exclude-files (unless only-ext
(if ignore-files
ignore-files))
:exclude-dirs ignore-dirs)
(nreverse list-files)))
(defmacro traverse-collect-files-in-tree-if (tree pred)
"Return a list of files matching PRED in TREE.
PRED is a function that take one arg."
`(let ((flist ()))
(traverse-walk-directory
,tree
:file-fn #'(lambda (x) (when (funcall ,pred x) (push x flist))))
flist))
(defmacro traverse-collect-files-in-tree-if-not (tree pred)
"Return a list of files not matching PRED in TREE.
PRED is a function that take one arg."
`(let ((flist ()))
(traverse-walk-directory
,tree
:file-fn #'(lambda (x) (unless (funcall ,pred x) (push x flist))))
flist))
(defun* traverse-mv-files-in-tree (tree dest ext
&key
test-only
(fn 'rename-file)
(confirm 'noconfirm))
"Copy or Move all files in TREE with EXT to DEST.
FN determine which of `copy-file' or `rename-file' is used.
CONFIRM can be one of 'noconfirm, nil(signal error), \
or any number value to ask for confirmation.
If TEST-ONLY is non--nil only print a buffer signaling what will be done."
(let ((f-to-rename (traverse-collect-files-in-tree-if
tree
#'(lambda (x)
(if (listp ext)
(loop for i in ext
when (string= (file-name-extension x) i) return t)
(string= (file-name-extension x) ext))))))
(if test-only
(progn
(with-current-buffer (get-buffer-create "*test buffer*")
(erase-buffer)
(loop for f in f-to-rename
do (insert (format "%s <will be renamed to> %s\n" (file-name-nondirectory f) dest))))
(switch-to-buffer "*test buffer*")
(align-regexp (point-min) (point-max) "\\(\\s-*\\)<will be renamed to>" 1 1 nil)
(unless (file-exists-p dest)
(insert (format "WARNING:<%s> doesn't exist and will have to be created." dest))))
(unless (file-exists-p dest)
(if (y-or-n-p (format "%s doesn't exists, create it? " dest))
(make-directory dest)
(error "Abort: %s doesn't exists." dest)))
(loop for f in f-to-rename
do (funcall fn f dest confirm))
(message "%d files %s to %s"
(length f-to-rename)
(if (eq 'fn 'rename-file) "renamed" "copied")
dest))))
(provide 'traverselisp)