[Emacs-diffs] /srv/bzr/emacs/trunk r108864: * lisp/files.el (locate-dominating-file): Allow `name' to be a predicate.

[Stefan Monnier]

------------------------------------------------------------
revno: 108864
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Wed 2012-07-04 11:59:12 -0400
message:
  * 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.
modified:
  lisp/ChangeLog
  lisp/files.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2012-07-04 14:42:59 +0000
+++ b/lisp/ChangeLog    2012-07-04 15:59:12 +0000
@@ -1,5 +1,12 @@
 2012-07-04  Stefan Monnier  <address@hidden>
 
+       * 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.
 

=== modified file 'lisp/files.el'
--- a/lisp/files.el     2012-06-26 16:23:01 +0000
+++ b/lisp/files.el     2012-07-04 15:59:12 +0000
@@ -876,12 +876,12 @@
 ;;       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 @@
                     ;;   (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,6 +1465,17 @@
      (find-file filename)
      (current-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 (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.
@@ -1474,15 +1483,7 @@
   (interactive
    (find-file-read-args "Find file read-only: "
                         (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 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 filename wildcards))
 
 (defun find-file-read-only-other-window (filename &optional wildcards)
   "Edit file FILENAME in another window but don't allow changes.
@@ -1491,15 +1492,7 @@
   (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 @@
   (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 @@
        (after-find-file error (not nowarn)))
       (current-buffer))))
 
+(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 @@
        (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 @@
          (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.