Do not allow out-of-range character position in Fcompare_strings.
[bpt/emacs.git] / lisp / files.el
index d5c6028..65f2009 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
@@ -693,7 +685,7 @@ nil (meaning `default-directory') as the associated list element."
       (if (file-exists-p dir)
          (error "%s is not a directory" dir)
        (error "%s: no such directory" dir))
-    (unless (file-executable-p dir)
+    (unless (file-accessible-directory-p dir)
       (error "Cannot cd to %s:  Permission denied" dir))
     (setq default-directory dir)
     (setq list-buffers-directory dir)))
@@ -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.
@@ -1654,6 +1637,8 @@ killed."
        (let (kill-buffer-query-functions kill-buffer-hook)
          (kill-buffer obuf))))))
 \f
+;; FIXME we really need to fold the uniquify stuff in here by default,
+;; not using advice, and add it to the doc string.
 (defun create-file-buffer (filename)
   "Create a suitably named buffer for visiting FILENAME, and return it.
 FILENAME (sans directory) is used unchanged if that name is free;
@@ -2089,9 +2074,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.
@@ -2455,7 +2440,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)
@@ -2518,6 +2503,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)
@@ -3673,10 +3659,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
@@ -4079,31 +4064,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
@@ -4526,18 +4506,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))))
@@ -5004,6 +4980,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"))
@@ -5023,9 +5000,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.
@@ -5349,13 +5326,16 @@ This should not be relied upon.")
   "Default function to use for `buffer-stale-function'.
 This function ignores its argument.
 This returns non-nil if the current buffer is visiting a readable file
-whose modification time does not match that of the buffer."
+whose modification time does not match that of the buffer.
+
+This function only handles buffers that are visiting files.
+Non-file buffers need a custom function"
   (and buffer-file-name
        (file-readable-p buffer-file-name)
        (not (verify-visited-file-modtime (current-buffer)))))
 
 (defvar buffer-stale-function #'buffer-stale--default-function
-  "Function to check whether a non-file buffer needs reverting.
+  "Function to check whether a buffer needs reverting.
 This should be a function with one optional argument NOCONFIRM.
 Auto Revert Mode passes t for NOCONFIRM.  The function should return
 non-nil if the buffer should be reverted.  A return value of
@@ -5450,7 +5430,10 @@ start and end.
 
 Calls `revert-buffer-insert-file-contents-function' to reread the
 contents of the visited file, with two arguments: the first is the file
-name, the second is non-nil if reading an auto-save file."
+name, the second is non-nil if reading an auto-save file.
+
+This function only handles buffers that are visiting files.
+Non-file buffers need a custom function."
   (with-current-buffer (or (buffer-base-buffer (current-buffer))
                            (current-buffer))
     (let* ((auto-save-p (and (not ignore-auto)
@@ -5988,10 +5971,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
@@ -5999,16 +5981,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.
@@ -6866,15 +6847,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