X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/1a1f8804c8eafdd0e20e607ff611a130fc69999f..7e09ef09a479731d01b1ca46e94ddadd73ac98e3:/lisp/files.el

diff --git a/lisp/files.el b/lisp/files.el
index be1b6c29d1..22362ca13c 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -1,6 +1,6 @@
 ;;; files.el --- file input and output commands for Emacs  -*- lexical-binding:t -*-
 
-;; Copyright (C) 1985-1987, 1992-2014 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1987, 1992-2015 Free Software Foundation, Inc.
 
 ;; Maintainer: emacs-devel@gnu.org
 ;; Package: emacs
@@ -729,6 +729,67 @@ The path separator is colon in GNU and GNU-like systems."
                     (lambda (f) (and (file-directory-p f) 'dir-ok)))
        (error "No such directory found via CDPATH environment variable"))))
 
+(defun file-tree-walk (dir action &rest args)
+  "Walk DIR executing ACTION on each file, with ARGS as additional arguments.
+For each file, the function calls ACTION as follows:
+
+   \(ACTION DIRECTORY BASENAME ARGS\)
+
+Where DIRECTORY is the leading directory of the file,
+      BASENAME is the basename of the file,
+      and ARGS are as specified in the call to this function, or nil if omitted.
+
+The ACTION is applied to each subdirectory before descending into
+it, and if nil is returned at that point, the descent will be
+prevented.  Directory entries are sorted with string-lessp."
+  (cond ((file-directory-p dir)
+	 (setq dir (file-name-as-directory dir))
+	 (let ((lst (directory-files dir nil nil t))
+	       fullname file)
+	   (while lst
+	     (setq file (car lst))
+	     (setq lst (cdr lst))
+	     (cond ((member file '("." "..")))
+		   (t
+		    (and (apply action dir file args)
+			 (setq fullname (concat dir file))
+			 (file-directory-p fullname)
+			 (apply 'file-tree-walk fullname action args)))))))
+	(t
+	 (apply action
+		(file-name-directory dir)
+		(file-name-nondirectory dir)
+		args))))
+
+(defsubst directory-name-p (name)
+  "Return non-nil if NAME ends with a slash character."
+  (and (> (length name) 0)
+       (char-equal (aref name (1- (length name))) ?/)))
+
+(defun directory-files-recursively (dir match &optional include-directories)
+  "Return all files under DIR that have file names matching MATCH (a regexp).
+This function works recursively.  Files are returned in \"depth first\"
+and alphabetical order.
+If INCLUDE-DIRECTORIES, also include directories that have matching names."
+  (let ((result nil)
+	(files nil))
+    (dolist (file (sort (file-name-all-completions "" dir)
+			'string<))
+      (unless (member file '("./" "../"))
+	(if (directory-name-p file)
+	    (let* ((leaf (substring file 0 (1- (length file))))
+		   (path (expand-file-name leaf dir)))
+	      ;; Don't follow symlinks to other directories.
+	      (unless (file-symlink-p path)
+		(setq result (nconc result (directory-files-recursively
+					    path match include-directories))))
+	      (when (and include-directories
+			 (string-match match leaf))
+		(setq result (nconc result (list path)))))
+	  (when (string-match match file)
+	    (push (expand-file-name file dir) files)))))
+    (nconc result (nreverse files))))
+
 (defun load-file (file)
   "Load the Lisp file named FILE."
   ;; This is a case where .elc makes a lot of sense.
@@ -6670,7 +6731,7 @@ only these files will be asked to be saved."
       (`add (concat "/:" (apply operation arguments)))
       (`insert-file-contents
        (let ((visit (nth 1 arguments)))
-         (prog1
+         (unwind-protect
              (apply operation arguments)
            (when (and visit buffer-file-name)
              (setq buffer-file-name (concat "/:" buffer-file-name))))))