* lisp/files.el (locate-dominating-file): Allow `name' to be a predicate.

(find-file--read-only): New function.
(find-file-read-only, find-file-read-only-other-window)
(find-file-read-only-other-frame): Use it.
(insert-file-contents-literally): Don't `fset'.
(get-free-disk-space): Use locate-dominating-file.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 34a74656415d726013ea7314a87ec3dccf4ab8ea..0a486daa80986a1f315b8ec71891f66b1b2f4d7d 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,12 @@
 2012-07-04  Stefan Monnier  <monnier@iro.umontreal.ca>
 
+       * files.el (locate-dominating-file): Allow `name' to be a predicate.
+       (find-file--read-only): New function.
+       (find-file-read-only, find-file-read-only-other-window)
+       (find-file-read-only-other-frame): Use it.
+       (insert-file-contents-literally): Don't `fset'.
+       (get-free-disk-space): Use locate-dominating-file.
+
        * emacs-lisp/bytecomp.el (byte-compile): Don't signal an error if the
        function is already compiled.
 

diff --git a/lisp/files.el b/lisp/files.el
index 2b5717a719cd79063e3a98c88162fb069c36c522..34144f494cf71b66e432ae50e9d4ef7207c75b50 100644 (file)
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -876,12 +876,12 @@ or mount points potentially requiring authentication as a different user.")
 ;;       nil)))
 
 (defun locate-dominating-file (file name)
-  "Look up the directory hierarchy from FILE for a file named NAME.
+  "Look up the directory hierarchy from FILE for a directory containing NAME.
 Stop at the first parent directory containing a file NAME,
 and return the directory.  Return nil if not found.
-
-This function only tests if FILE exists.  If you care about whether
-it is readable, regular, etc., you should test the result."
+Instead of a string, NAME can also be a predicate taking one argument
+\(a directory) and returning a non-nil value if that directory is the one for
+which we're looking."
   ;; We used to use the above locate-dominating-files code, but the
   ;; directory-files call is very costly, so we're much better off doing
   ;; multiple calls using the code in here.
@@ -908,16 +908,14 @@ it is readable, regular, etc., you should test the result."
                     ;;   (setq user (nth 2 (file-attributes file)))
                     ;;   (and prev-user (not (equal user prev-user))))
                     (string-match locate-dominating-stop-dir-regexp file)))
-      ;; FIXME? maybe this function should (optionally?)
-      ;; use file-readable-p instead.  In many cases, an unreadable
-      ;; FILE is no better than a non-existent one.
-      ;; See eg dir-locals-find-file.
-      (setq try (file-exists-p (expand-file-name name file)))
+      (setq try (if (stringp name)
+                    (file-exists-p (expand-file-name name file))
+                  (funcall name file)))
       (cond (try (setq root file))
             ((equal file (setq file (file-name-directory
                                      (directory-file-name file))))
              (setq file nil))))
-    root))
+    (if root (file-name-as-directory root))))
 
 
 (defun executable-find (command)
@@ -1467,23 +1465,26 @@ file names with wildcards."
      (find-file filename)
      (current-buffer)))
 
-(defun find-file-read-only (filename &optional wildcards)
-  "Edit file FILENAME but don't allow changes.
-Like \\[find-file], but marks buffer as read-only.
-Use \\[toggle-read-only] to permit editing."
-  (interactive
-   (find-file-read-args "Find file read-only: "
-                        (confirm-nonexistent-file-or-buffer)))
+(defun find-file--read-only (fun filename wildcards)
   (unless (or (and wildcards find-file-wildcards
                   (not (string-match "\\`/:" filename))
                   (string-match "[[*?]" filename))
              (file-exists-p filename))
     (error "%s does not exist" filename))
-  (let ((value (find-file filename wildcards)))
+  (let ((value (funcall fun filename wildcards)))
     (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1)))
          (if (listp value) value (list value)))
     value))
 
+(defun find-file-read-only (filename &optional wildcards)
+  "Edit file FILENAME but don't allow changes.
+Like \\[find-file], but marks buffer as read-only.
+Use \\[toggle-read-only] to permit editing."
+  (interactive
+   (find-file-read-args "Find file read-only: "
+                        (confirm-nonexistent-file-or-buffer)))
+  (find-file--read-only #'find-file filename wildcards))
+
 (defun find-file-read-only-other-window (filename &optional wildcards)
   "Edit file FILENAME in another window but don't allow changes.
 Like \\[find-file-other-window], but marks buffer as read-only.
@@ -1491,15 +1492,7 @@ Use \\[toggle-read-only] to permit editing."
   (interactive
    (find-file-read-args "Find file read-only other window: "
                         (confirm-nonexistent-file-or-buffer)))
-  (unless (or (and wildcards find-file-wildcards
-                  (not (string-match "\\`/:" filename))
-                  (string-match "[[*?]" filename))
-             (file-exists-p filename))
-    (error "%s does not exist" filename))
-  (let ((value (find-file-other-window filename wildcards)))
-    (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1)))
-         (if (listp value) value (list value)))
-    value))
+  (find-file--read-only #'find-file-other-window filename wildcards))
 
 (defun find-file-read-only-other-frame (filename &optional wildcards)
   "Edit file FILENAME in another frame but don't allow changes.
@@ -1508,15 +1501,7 @@ Use \\[toggle-read-only] to permit editing."
   (interactive
    (find-file-read-args "Find file read-only other frame: "
                         (confirm-nonexistent-file-or-buffer)))
-  (unless (or (and wildcards find-file-wildcards
-                  (not (string-match "\\`/:" filename))
-                  (string-match "[[*?]" filename))
-             (file-exists-p filename))
-    (error "%s does not exist" filename))
-  (let ((value (find-file-other-frame filename wildcards)))
-    (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1)))
-         (if (listp value) value (list value)))
-    value))
+  (find-file--read-only #'find-file-other-frame filename wildcards))
 
 (defun find-alternate-file-other-window (filename &optional wildcards)
   "Find file FILENAME as a replacement for the file in the next window.
@@ -2020,6 +2005,8 @@ Do you want to revisit the file normally now? ")
        (after-find-file error (not nowarn)))
       (current-buffer))))
 \f
+(defvar file-name-buffer-file-type-alist) ;From dos-w32.el.
+
 (defun insert-file-contents-literally (filename &optional visit beg end replace)
   "Like `insert-file-contents', but only reads in the file literally.
 A buffer may be modified in several ways after reading into the buffer,
@@ -2031,21 +2018,14 @@ This function ensures that none of these modifications will take place."
        (after-insert-file-functions nil)
        (coding-system-for-read 'no-conversion)
        (coding-system-for-write 'no-conversion)
-       (find-buffer-file-type-function
-         (if (fboundp 'find-buffer-file-type)
-             (symbol-function 'find-buffer-file-type)
-           nil))
+       (file-name-buffer-file-type-alist '(("" . t)))
         (inhibit-file-name-handlers
+         ;; FIXME: Yuck!!  We should turn insert-file-contents-literally
+         ;; into a file operation instead!
          (append '(jka-compr-handler image-file-handler epa-file-handler)
                  inhibit-file-name-handlers))
         (inhibit-file-name-operation 'insert-file-contents))
-    (unwind-protect
-         (progn
-           (fset 'find-buffer-file-type (lambda (_filename) t))
-           (insert-file-contents filename visit beg end replace))
-      (if find-buffer-file-type-function
-         (fset 'find-buffer-file-type find-buffer-file-type-function)
-       (fmakunbound 'find-buffer-file-type)))))
+    (insert-file-contents filename visit beg end replace)))
 
 (defun insert-file-1 (filename insert-func)
   (if (file-directory-p filename)
@@ -5958,11 +5938,12 @@ returns nil."
          (when (and directory-free-space-program
                     ;; Avoid failure if the default directory does
                     ;; not exist (Bug#2631, Bug#3911).
-                    (let ((default-directory "/"))
-                      (eq (call-process directory-free-space-program
+                     (let ((default-directory
+                             (locate-dominating-file dir 'file-directory-p)))
+                       (eq (process-file directory-free-space-program
                                         nil t nil
                                         directory-free-space-args
-                                        dir)
+                                         (file-relative-name dir))
                           0)))
            ;; Assume that the "available" column is before the
            ;; "capacity" column.  Find the "%" and scan backward.