]> code.delx.au - gnu-emacs/blobdiff - lisp/files.el
Merge from emacs-24; up to 2014-06-25T10:17:41Z!rgm@gnu.org
[gnu-emacs] / lisp / files.el
index a5cee47ee8a73352d047240da86f7271917537ed..252ae76fa0b27ae32e27a105b5c73a5ea8969405 100644 (file)
@@ -559,14 +559,6 @@ A value of nil means ignore them; anything else means query."
                 (other :tag "Query" other))
   :group 'find-file)
 
-;; Avoid losing in versions where CLASH_DETECTION is disabled.
-(or (fboundp 'lock-buffer)
-    (defalias 'lock-buffer 'ignore))
-(or (fboundp 'unlock-buffer)
-    (defalias 'unlock-buffer 'ignore))
-(or (fboundp 'file-locked-p)
-    (defalias 'file-locked-p 'ignore))
-
 (defcustom view-read-only nil
   "Non-nil means buffers visiting files read-only do so in view mode.
 In fact, this means that all read-only buffers normally have
@@ -891,7 +883,7 @@ which we're looking."
   ;;
   ;; Represent /home/luser/foo as ~/foo so that we don't try to look for
   ;; `name' in /home or in /.
-  (setq file (abbreviate-file-name file))
+  (setq file (abbreviate-file-name (expand-file-name file)))
   (let ((root nil)
         ;; `user' is not initialized outside the loop because
         ;; `file' may not exist, so we may have to walk up part of the
@@ -949,14 +941,10 @@ directory if it does not exist."
             (if (file-directory-p user-emacs-directory)
                 (or (file-accessible-directory-p user-emacs-directory)
                     (setq errtype "access"))
-              (let ((umask (default-file-modes)))
-                (unwind-protect
-                    (progn
-                      (set-default-file-modes ?\700)
-                      (condition-case nil
-                          (make-directory user-emacs-directory)
-                        (error (setq errtype "create"))))
-                  (set-default-file-modes umask))))
+              (with-file-modes ?\700
+                (condition-case nil
+                    (make-directory user-emacs-directory)
+                  (error (setq errtype "create")))))
             (when (and errtype
                        user-emacs-directory-warning
                        (not (get 'user-emacs-directory-warning 'this-session)))
@@ -1281,36 +1269,31 @@ You can then use `write-region' to write new data into the file.
 If DIR-FLAG is non-nil, create a new empty directory instead of a file.
 
 If SUFFIX is non-nil, add that at the end of the file name."
-  (let ((umask (default-file-modes))
-       file)
-    (unwind-protect
-       (progn
-         ;; Create temp files with strict access rights.  It's easy to
-         ;; loosen them later, whereas it's impossible to close the
-         ;; time-window of loose permissions otherwise.
-         (set-default-file-modes ?\700)
-         (while (condition-case ()
-                    (progn
-                      (setq file
-                            (make-temp-name
-                              (if (zerop (length prefix))
-                                  (file-name-as-directory
-                                   temporary-file-directory)
-                                (expand-file-name prefix
-                                                  temporary-file-directory))))
-                      (if suffix
-                          (setq file (concat file suffix)))
-                      (if dir-flag
-                          (make-directory file)
-                        (write-region "" nil file nil 'silent nil 'excl))
-                      nil)
-                  (file-already-exists t))
-           ;; the file was somehow created by someone else between
-           ;; `make-temp-name' and `write-region', let's try again.
-           nil)
-         file)
-      ;; Reset the umask.
-      (set-default-file-modes umask))))
+  ;; Create temp files with strict access rights.  It's easy to
+  ;; loosen them later, whereas it's impossible to close the
+  ;; time-window of loose permissions otherwise.
+  (with-file-modes ?\700
+    (let (file)
+      (while (condition-case ()
+                (progn
+                  (setq file
+                        (make-temp-name
+                         (if (zerop (length prefix))
+                             (file-name-as-directory
+                              temporary-file-directory)
+                           (expand-file-name prefix
+                                             temporary-file-directory))))
+                  (if suffix
+                      (setq file (concat file suffix)))
+                  (if dir-flag
+                      (make-directory file)
+                    (write-region "" nil file nil 'silent nil 'excl))
+                  nil)
+              (file-already-exists t))
+       ;; the file was somehow created by someone else between
+       ;; `make-temp-name' and `write-region', let's try again.
+       nil)
+      file)))
 
 (defun recode-file-name (file coding new-coding &optional ok-if-already-exists)
   "Change the encoding of FILE's name from CODING to NEW-CODING.
@@ -1399,14 +1382,16 @@ called additional times).
 This macro actually adds an auxiliary function that calls FUN,
 rather than FUN itself, to `minibuffer-setup-hook'."
   (declare (indent 1) (debug t))
-  (let ((hook (make-symbol "setup-hook")))
-    `(let (,hook)
+  (let ((hook (make-symbol "setup-hook"))
+        (funsym (make-symbol "fun")))
+    `(let ((,funsym ,fun)
+           ,hook)
        (setq ,hook
             (lambda ()
               ;; Clear out this hook so it does not interfere
               ;; with any recursive minibuffer usage.
               (remove-hook 'minibuffer-setup-hook ,hook)
-              (funcall ,fun)))
+              (funcall ,funsym)))
        (unwind-protect
           (progn
             (add-hook 'minibuffer-setup-hook ,hook)
@@ -1801,6 +1786,14 @@ When nil, never request confirmation."
   :version "22.1"
   :type '(choice integer (const :tag "Never request confirmation" nil)))
 
+(defcustom out-of-memory-warning-percentage 50
+  "Warn if file size exceeds this percentage of available free memory.
+When nil, never issue warning."
+  :group 'files
+  :group 'find-file
+  :version "24.4"
+  :type '(choice integer (const :tag "Never issue warning" nil)))
+
 (defun abort-if-file-too-large (size op-type filename)
   "If file SIZE larger than `large-file-warning-threshold', allow user to abort.
 OP-TYPE specifies the file operation being performed (for message to user)."
@@ -1811,6 +1804,25 @@ OP-TYPE specifies the file operation being performed (for message to user)."
                                    (file-size-human-readable size) op-type))))
     (error "Aborted")))
 
+(defun warn-maybe-out-of-memory (size)
+  "Warn if an attempt to open file of SIZE bytes may run out of memory."
+  (when (and (numberp size) (not (zerop size))
+            (integerp out-of-memory-warning-percentage))
+    (let ((meminfo (memory-info)))
+      (when (consp meminfo)
+       (let ((total-free-memory (float (+ (nth 1 meminfo) (nth 3 meminfo)))))
+         (when (> (/ size 1024)
+                  (/ (* total-free-memory out-of-memory-warning-percentage)
+                     100.0))
+           (warn
+            "You are trying to open a file whose size (%s)
+exceeds the %S%% of currently available free memory (%s).
+If that fails, try to open it with `find-file-literally'
+\(but note that some characters might be displayed incorrectly)."
+            (file-size-human-readable size)
+            out-of-memory-warning-percentage
+            (file-size-human-readable (* total-free-memory 1024)))))))))
+
 (defun find-file-noselect (filename &optional nowarn rawfile wildcards)
   "Read file FILENAME into a buffer and return the buffer.
 If a buffer exists visiting FILENAME, return that one, but
@@ -1863,7 +1875,8 @@ the various files."
                  (setq buf other))))
        ;; Check to see if the file looks uncommonly large.
        (when (not (or buf nowarn))
-         (abort-if-file-too-large (nth 7 attributes) "open" filename))
+         (abort-if-file-too-large (nth 7 attributes) "open" filename)
+         (warn-maybe-out-of-memory (nth 7 attributes)))
        (if buf
            ;; We are using an existing buffer.
            (let (nonexistent)
@@ -2091,9 +2104,9 @@ This function ensures that none of these modifications will take place."
 This function is meant for the user to run interactively.
 Don't call it from programs!  Use `insert-file-contents-literally' instead.
 \(Its calling sequence is different; see its documentation)."
+  (declare (interactive-only insert-file-contents-literally))
   (interactive "*fInsert file literally: ")
   (insert-file-1 filename #'insert-file-contents-literally))
-(put 'insert-file-literally 'interactive-only 'insert-file-contents-literally)
 
 (defvar find-file-literally nil
   "Non-nil if this buffer was made by `find-file-literally' or equivalent.
@@ -2457,7 +2470,7 @@ ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|7Z\\)\\'" . archive-mode)
      ("/\\.\\(?:enigma\\|gltron\\|gtk\\|hxplayer\\|net\\|neverball\\|qt/.+\\|realplayer\\|scummvm\\|sversion\\|sylpheed/.+\\|xmp\\)rc\\'" . conf-mode)
      ("/\\.\\(?:gdbtkinit\\|grip\\|orbital/.+txt\\|rhosts\\|tuxracer/options\\)\\'" . conf-mode)
      ("/\\.?X\\(?:default\\|resource\\|re\\)s\\>" . conf-xdefaults-mode)
-     ("/X11.+app-defaults/" . conf-xdefaults-mode)
+     ("/X11.+app-defaults/\\|\\.ad\\'" . conf-xdefaults-mode)
      ("/X11.+locale/.+/Compose\\'" . conf-colon-mode)
      ;; this contains everything twice, with space and with colon :-(
      ("/X11.+locale/compose\\.dir\\'" . conf-javaprop-mode)
@@ -2520,6 +2533,7 @@ and `magic-mode-alist', which determines modes based on file contents.")
      ("[acjkwz]sh" . sh-mode)
      ("r?bash2?" . sh-mode)
      ("dash" . sh-mode)
+     ("mksh" . sh-mode)
      ("\\(dt\\|pd\\|w\\)ksh" . sh-mode)
      ("es" . sh-mode)
      ("i?tcsh" . sh-mode)
@@ -3675,10 +3689,9 @@ of no valid cache entry."
 ;;;     (setq locals-file nil))
     ;; Find the best cached value in `dir-locals-directory-cache'.
     (dolist (elt dir-locals-directory-cache)
-      (when (and (eq t (compare-strings file nil (length (car elt))
-                                       (car elt) nil nil
-                                       (memq system-type
-                                             '(windows-nt cygwin ms-dos))))
+      (when (and (string-prefix-p (car elt) file
+                                 (memq system-type
+                                       '(windows-nt cygwin ms-dos)))
                 (> (length (car elt)) (length (car dir-elt))))
        (setq dir-elt elt)))
     (if (and dir-elt
@@ -4081,31 +4094,26 @@ BACKUPNAME is the backup file name, which is the old file renamed."
            (file-error nil))))))
 
 (defun backup-buffer-copy (from-name to-name modes extended-attributes)
-  (let ((umask (default-file-modes)))
-    (unwind-protect
-       (progn
-         ;; Create temp files with strict access rights.  It's easy to
-         ;; loosen them later, whereas it's impossible to close the
-         ;; time-window of loose permissions otherwise.
-         (set-default-file-modes ?\700)
-         (when (condition-case nil
-                   ;; Try to overwrite old backup first.
-                   (copy-file from-name to-name t t t)
-                 (error t))
-           (while (condition-case nil
-                      (progn
-                        (when (file-exists-p to-name)
-                          (delete-file to-name))
-                        (copy-file from-name to-name nil t t)
-                        nil)
-                    (file-already-exists t))
-             ;; The file was somehow created by someone else between
-             ;; `delete-file' and `copy-file', so let's try again.
-             ;; rms says "I think there is also a possible race
-             ;; condition for making backup files" (emacs-devel 20070821).
-             nil)))
-      ;; Reset the umask.
-      (set-default-file-modes umask)))
+  ;; Create temp files with strict access rights.  It's easy to
+  ;; loosen them later, whereas it's impossible to close the
+  ;; time-window of loose permissions otherwise.
+  (with-file-modes ?\700
+    (when (condition-case nil
+             ;; Try to overwrite old backup first.
+             (copy-file from-name to-name t t t)
+           (error t))
+      (while (condition-case nil
+                (progn
+                  (when (file-exists-p to-name)
+                    (delete-file to-name))
+                  (copy-file from-name to-name nil t t)
+                  nil)
+              (file-already-exists t))
+       ;; The file was somehow created by someone else between
+       ;; `delete-file' and `copy-file', so let's try again.
+       ;; rms says "I think there is also a possible race
+       ;; condition for making backup files" (emacs-devel 20070821).
+       nil)))
   ;; If set-file-extended-attributes fails, fall back on set-file-modes.
   (unless (and extended-attributes
               (with-demoted-errors
@@ -4528,18 +4536,14 @@ on a DOS/Windows machine, it returns FILENAME in expanded form."
         (let ((ancestor ".")
              (filename-dir (file-name-as-directory filename)))
           (while (not
-                 (or
-                  (eq t (compare-strings filename-dir nil (length directory)
-                                         directory nil nil fold-case))
-                  (eq t (compare-strings filename nil (length directory)
-                                         directory nil nil fold-case))))
+                 (or (string-prefix-p directory filename-dir fold-case)
+                     (string-prefix-p directory filename fold-case)))
             (setq directory (file-name-directory (substring directory 0 -1))
                  ancestor (if (equal ancestor ".")
                               ".."
                             (concat "../" ancestor))))
           ;; Now ancestor is empty, or .., or ../.., etc.
-          (if (eq t (compare-strings filename nil (length directory)
-                                    directory nil nil fold-case))
+          (if (string-prefix-p directory filename fold-case)
              ;; We matched within FILENAME's directory part.
              ;; Add the rest of FILENAME onto ANCESTOR.
              (let ((rest (substring filename (length directory))))
@@ -5006,6 +5010,7 @@ With prefix ARG, mark buffer as modified, so \\[save-buffer] will save.
 
 It is not a good idea to use this function in Lisp programs, because it
 prints a message in the minibuffer.  Instead, use `set-buffer-modified-p'."
+  (declare (interactive-only set-buffer-modified-p))
   (interactive "P")
   (message (if arg "Modification-flag set"
               "Modification-flag cleared"))
@@ -5025,9 +5030,9 @@ Set mark after the inserted text.
 This function is meant for the user to run interactively.
 Don't call it from programs!  Use `insert-file-contents' instead.
 \(Its calling sequence is different; see its documentation)."
+  (declare (interactive-only insert-file-contents))
   (interactive "*fInsert file: ")
   (insert-file-1 filename #'insert-file-contents))
-(put 'insert-file 'interactive-only 'insert-file-contents)
 
 (defun append-to-file (start end filename)
   "Append the contents of the region to the end of file FILENAME.
@@ -5996,10 +6001,9 @@ default directory.  However, if FULL is non-nil, they are absolute."
                             (file-expand-wildcards (directory-file-name dirpart)))
                   (list dirpart)))
           contents)
-      (while dirs
-       (when (or (null (car dirs))     ; Possible if DIRPART is not wild.
-                 (and (file-directory-p (directory-file-name (car dirs)))
-                      (file-readable-p (car dirs))))
+      (dolist (dir dirs)
+       (when (or (null dir)    ; Possible if DIRPART is not wild.
+                 (file-accessible-directory-p dir))
          (let ((this-dir-contents
                 ;; Filter out "." and ".."
                 (delq nil
@@ -6007,16 +6011,15 @@ default directory.  However, if FULL is non-nil, they are absolute."
                                   (unless (string-match "\\`\\.\\.?\\'"
                                                         (file-name-nondirectory name))
                                     name))
-                              (directory-files (or (car dirs) ".") full
+                              (directory-files (or dir ".") full
                                                (wildcard-to-regexp nondir))))))
            (setq contents
                  (nconc
-                  (if (and (car dirs) (not full))
-                      (mapcar (function (lambda (name) (concat (car dirs) name)))
+                  (if (and dir (not full))
+                      (mapcar #'(lambda (name) (concat dir name))
                               this-dir-contents)
                     this-dir-contents)
-                  contents))))
-       (setq dirs (cdr dirs)))
+                  contents)))))
       contents)))
 
 ;; Let Tramp know that `file-expand-wildcards' does not need an advice.
@@ -6874,15 +6877,11 @@ Otherwise, trash FILENAME using the freedesktop.org conventions,
                      trash-info-dir filename))
 
           ;; Ensure that the trash directory exists; otherwise, create it.
-          (let ((saved-default-file-modes (default-file-modes)))
-            (unwind-protect
-                (progn
-                  (set-default-file-modes #o700)
-                  (unless (file-exists-p trash-files-dir)
-                    (make-directory trash-files-dir t))
-                  (unless (file-exists-p trash-info-dir)
-                    (make-directory trash-info-dir t)))
-              (set-default-file-modes saved-default-file-modes)))
+          (with-file-modes #o700
+            (unless (file-exists-p trash-files-dir)
+              (make-directory trash-files-dir t))
+            (unless (file-exists-p trash-info-dir)
+              (make-directory trash-info-dir t)))
 
           ;; Try to move to trash with .trashinfo undo information
           (save-excursion