;;; files.el --- file input and output commands for Emacs
-;; Copyright (C) 1985-1987, 1992-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1987, 1992-2013 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Package: emacs
(declare-function dired-unmark "dired" (arg))
(declare-function dired-do-flagged-delete "dired" (&optional nomessage))
(declare-function dos-8+3-filename "dos-fns" (filename))
-(declare-function view-mode-disable "view" ())
(declare-function dosified-file-name "dos-fns" (file-name))
(defvar file-name-invalid-regexp
"Explode a search path into a list of directory names.
Directories are separated by `path-separator' (which is colon in
GNU and Unix systems). Substitute environment variables into the
-resulting list of directory names."
+resulting list of directory names. For an empty path element (i.e.,
+a leading or trailing separator, or two adjacent separators), return
+nil (meaning `default-directory') as the associated list element."
(when (stringp search-path)
(mapcar (lambda (f)
- (substitute-in-file-name (file-name-as-directory f)))
- (split-string search-path path-separator t))))
+ (if (equal "" f) nil
+ (substitute-in-file-name (file-name-as-directory f))))
+ (split-string search-path path-separator))))
(defun cd-absolute (dir)
"Change current directory to given absolute file name DIR."
(setq buffer-read-only t))
(unless nomodes
(when (and view-read-only view-mode)
- (view-mode-disable))
+ (view-mode -1))
(normal-mode t)
;; If requested, add a newline at the end of the file.
(and (memq require-final-newline '(visit visit-save))
("\\.\\(diffs?\\|patch\\|rej\\)\\'" . diff-mode)
("\\.\\(dif\\|pat\\)\\'" . diff-mode) ; for MSDOG
("\\.[eE]?[pP][sS]\\'" . ps-mode)
- ("\\.\\(?:PDF\\|DVI\\|OD[FGPST]\\|DOCX?\\|XLSX?\\|PPTX?\\|pdf\\|dvi\\|od[fgpst]\\|docx?\\|xlsx?\\|pptx?\\)\\'" . doc-view-mode-maybe)
+ ("\\.\\(?:PDF\\|DVI\\|OD[FGPST]\\|DOCX?\\|XLSX?\\|PPTX?\\|pdf\\|djvu\\|dvi\\|od[fgpst]\\|docx?\\|xlsx?\\|pptx?\\)\\'" . doc-view-mode-maybe)
("configure\\.\\(ac\\|in\\)\\'" . autoconf-mode)
("\\.s\\(v\\|iv\\|ieve\\)\\'" . sieve-mode)
("BROWSE\\'" . ebrowse-tree-mode)
(condition-case err
(progn
(insert-file-contents file)
- (let* ((dir-name (file-name-directory file))
- (class-name (intern dir-name))
- (variables (let ((read-circle nil))
- (read (current-buffer)))))
- (dir-locals-set-class-variables class-name variables)
- (dir-locals-set-directory-class dir-name class-name
- (nth 5 (file-attributes file)))
- class-name))
+ (unless (zerop (buffer-size))
+ (let* ((dir-name (file-name-directory file))
+ (class-name (intern dir-name))
+ (variables (let ((read-circle nil))
+ (read (current-buffer)))))
+ (dir-locals-set-class-variables class-name variables)
+ (dir-locals-set-directory-class dir-name class-name
+ (nth 5 (file-attributes file)))
+ class-name)))
(error (message "Error reading dir-locals: %S" err) nil)))))
(defcustom enable-remote-dir-locals nil
(dir-locals-get-class-variables class) dir-name nil)))
(when variables
(dolist (elt variables)
- (unless (memq (car elt) '(eval mode))
- (setq dir-local-variables-alist
- (assq-delete-all (car elt) dir-local-variables-alist)))
- (push elt dir-local-variables-alist))
+ (if (eq (car elt) 'coding)
+ (display-warning :warning
+ "Coding cannot be specified by dir-locals")
+ (unless (memq (car elt) '(eval mode))
+ (setq dir-local-variables-alist
+ (assq-delete-all (car elt) dir-local-variables-alist)))
+ (push elt dir-local-variables-alist)))
(hack-local-variables-filter variables dir-name)))))))
(defun hack-dir-local-variables-non-file-buffer ()
;; the one at the old location.
(vc-find-file-hook))
\f
+(defun file-extended-attributes (filename)
+ "Return an alist of extended attributes of file FILENAME.
+
+Extended attributes are platform-specific metadata about the file,
+such as SELinux context, list of ACL entries, etc."
+ `((acl . ,(file-acl filename))
+ (selinux-context . ,(file-selinux-context filename))))
+
+(defun set-file-extended-attributes (filename attributes)
+ "Set extended attributes of file FILENAME to ATTRIBUTES.
+
+ATTRIBUTES must be an alist of file attributes as returned by
+`file-extended-attributes'."
+ (dolist (elt attributes)
+ (let ((attr (car elt))
+ (val (cdr elt)))
+ (cond ((eq attr 'acl)
+ (set-file-acl filename val))
+ ((eq attr 'selinux-context)
+ (set-file-selinux-context filename val))))))
+\f
(defun backup-buffer ()
"Make a backup of the disk file visited by the current buffer, if appropriate.
This is normally done before saving the buffer the first time.
no longer accessible under its old name.
The value is non-nil after a backup was made by renaming.
-It has the form (MODES SELINUXCONTEXT BACKUPNAME).
+It has the form (MODES EXTENDED-ATTRIBUTES BACKUPNAME).
MODES is the result of `file-modes' on the original
file; this means that the caller, after saving the buffer, should change
the modes of the new file to agree with the old modes.
-SELINUXCONTEXT is the result of `file-selinux-context' on the original
-file; this means that the caller, after saving the buffer, should change
-the SELinux context of the new file to agree with the old context.
+EXTENDED-ATTRIBUTES is the result of `file-extended-attributes'
+on the original file; this means that the caller, after saving
+the buffer, should change the extended attributes of the new file
+to agree with the old attributes.
BACKUPNAME is the backup file name, which is the old file renamed."
(if (and make-backup-files (not backup-inhibited)
(not buffer-backed-up)
(y-or-n-p (format "Delete excess backup versions of %s? "
real-file-name)))))
(modes (file-modes buffer-file-name))
- (context (file-selinux-context buffer-file-name)))
+ (extended-attributes
+ (file-extended-attributes buffer-file-name)))
;; Actually write the back up file.
(condition-case ()
(if (or file-precious-flag
(and (integerp (nth 2 attr))
(integerp backup-by-copying-when-privileged-mismatch)
(<= (nth 2 attr) backup-by-copying-when-privileged-mismatch)))
- (or (nth 9 attr)
- (not (file-ownership-preserved-p real-file-name)))))))
- (backup-buffer-copy real-file-name backupname modes context)
+ (not (file-ownership-preserved-p
+ real-file-name t))))))
+ (backup-buffer-copy real-file-name
+ backupname modes
+ extended-attributes)
;; rename-file should delete old backup.
(rename-file real-file-name backupname t)
- (setq setmodes (list modes context backupname)))
+ (setq setmodes (list modes extended-attributes
+ backupname)))
(file-error
;; If trouble writing the backup, write it in
;; .emacs.d/%backup%.
(message "Cannot write backup file; backing up in %s"
backupname)
(sleep-for 1)
- (backup-buffer-copy real-file-name backupname modes context)))
+ (backup-buffer-copy real-file-name backupname
+ modes extended-attributes)))
(setq buffer-backed-up t)
;; Now delete the old versions, if desired.
(if delete-old-versions
setmodes)
(file-error nil))))))
-(defun backup-buffer-copy (from-name to-name modes context)
+(defun backup-buffer-copy (from-name to-name modes extended-attributes)
(let ((umask (default-file-modes)))
(unwind-protect
(progn
nil)))
;; Reset the umask.
(set-default-file-modes umask)))
- (and modes
- (set-file-modes to-name (logand modes #o1777)))
- (and context
- (set-file-selinux-context to-name context)))
+ ;; If set-file-extended-attributes fails, fall back on set-file-modes.
+ (unless (and extended-attributes
+ (with-demoted-errors
+ (set-file-extended-attributes to-name extended-attributes)))
+ (and modes
+ (set-file-modes to-name (logand modes #o1777)))))
(defvar file-name-version-regexp
"\\(?:~\\|\\.~[-[:alnum:]:#@^._]+\\(?:~[[:digit:]]+\\)?~\\)"
(string-match (concat file-name-version-regexp "\\'")
name))))))
-(defun file-ownership-preserved-p (file)
- "Return t if deleting FILE and rewriting it would preserve the owner."
+(defun file-ownership-preserved-p (file &optional group)
+ "Return t if deleting FILE and rewriting it would preserve the owner.
+Return nil if FILE does not exist, or if deleting and recreating it
+might not preserve the owner. If GROUP is non-nil, check whether
+the group would be preserved too."
(let ((handler (find-file-name-handler file 'file-ownership-preserved-p)))
(if handler
- (funcall handler 'file-ownership-preserved-p file)
+ (funcall handler 'file-ownership-preserved-p file group)
(let ((attributes (file-attributes file 'integer)))
;; Return t if the file doesn't exist, since it's true that no
;; information would be lost by an (attempted) delete and create.
(or (null attributes)
- (= (nth 2 attributes) (user-uid))
- ;; Files created on Windows by Administrator (RID=500)
- ;; have the Administrators group (RID=544) recorded as
- ;; their owner. Rewriting them will still preserve the
- ;; owner.
- (and (eq system-type 'windows-nt)
- (= (user-uid) 500) (= (nth 2 attributes) 544)))))))
+ (and (or (= (nth 2 attributes) (user-uid))
+ ;; Files created on Windows by Administrator (RID=500)
+ ;; have the Administrators group (RID=544) recorded as
+ ;; their owner. Rewriting them will still preserve the
+ ;; owner.
+ (and (eq system-type 'windows-nt)
+ (= (user-uid) 500) (= (nth 2 attributes) 544)))
+ (or (not group)
+ ;; On BSD-derived systems files always inherit the parent
+ ;; directory's group, so skip the group-gid test.
+ (memq system-type '(berkeley-unix darwin gnu/kfreebsd))
+ (= (nth 3 attributes) (group-gid)))
+ (let* ((parent (or (file-name-directory file) "."))
+ (parent-attributes (file-attributes parent 'integer)))
+ (and parent-attributes
+ ;; On some systems, a file created in a setuid directory
+ ;; inherits that directory's owner.
+ (or
+ (= (nth 2 parent-attributes) (user-uid))
+ (string-match "^...[^sS]" (nth 8 parent-attributes)))
+ ;; On many systems, a file created in a setgid directory
+ ;; inherits that directory's group. On some systems
+ ;; this happens even if the setgid bit is not set.
+ (or (not group)
+ (= (nth 3 parent-attributes)
+ (nth 3 attributes)))))))))))
(defun file-name-sans-extension (filename)
"Return FILENAME sans final \"extension\".
(if setmodes
(condition-case ()
(progn
- (set-file-modes buffer-file-name (car setmodes))
- (set-file-selinux-context buffer-file-name (nth 1 setmodes)))
+ (unless
+ (with-demoted-errors
+ (set-file-modes buffer-file-name (car setmodes)))
+ (set-file-extended-attributes buffer-file-name
+ (nth 1 setmodes))))
(error nil))))
;; If the auto-save file was recent before this command,
;; delete it now.
;; This does the "real job" of writing a buffer into its visited file
;; and making a backup file. This is what is normally done
;; but inhibited if one of write-file-functions returns non-nil.
-;; It returns a value (MODES SELINUXCONTEXT BACKUPNAME), like backup-buffer.
+;; It returns a value (MODES EXTENDED-ATTRIBUTES BACKUPNAME), like
+;; backup-buffer.
(defun basic-save-buffer-1 ()
(prog1
(if save-buffer-coding-system
(setq buffer-file-coding-system-explicit
(cons last-coding-system-used nil)))))
-;; This returns a value (MODES SELINUXCONTEXT BACKUPNAME), like backup-buffer.
+;; This returns a value (MODES EXTENDED-ATTRIBUTES BACKUPNAME), like
+;; backup-buffer.
(defun basic-save-buffer-2 ()
(let (tempsetmodes setmodes)
(if (not (file-writable-p buffer-file-name))
(setq setmodes (or setmodes
(list (or (file-modes buffer-file-name)
(logand ?\666 umask))
- (file-selinux-context buffer-file-name)
+ (file-extended-attributes buffer-file-name)
buffer-file-name)))
;; We succeeded in writing the temp file,
;; so rename it.
(cond ((and tempsetmodes (not setmodes))
;; Change the mode back, after writing.
(setq setmodes (list (file-modes buffer-file-name)
- (file-selinux-context buffer-file-name)
+ (file-extended-attributes buffer-file-name)
buffer-file-name))
- (set-file-modes buffer-file-name (logior (car setmodes) 128))
- (set-file-selinux-context buffer-file-name (nth 1 setmodes)))))
+ ;; If set-file-extended-attributes fails, fall back on
+ ;; set-file-modes.
+ (unless
+ (with-demoted-errors
+ (set-file-extended-attributes buffer-file-name
+ (nth 1 setmodes)))
+ (set-file-modes buffer-file-name
+ (logior (car setmodes) 128))))))
(let (success)
(unwind-protect
(progn
(let ((ls-lisp-support-shell-wildcards t))
(dired (concat auto-save-list-file-prefix "*")
(concat dired-listing-switches " -t")))
+ (use-local-map (nconc (make-sparse-keymap) (current-local-map)))
+ (define-key (current-local-map) "\C-c\C-c" 'recover-session-finish)
(save-excursion
(goto-char (point-min))
(or (looking-at " Move to the session you want to recover,")
(let ((inhibit-read-only t))
;; Each line starts with a space
;; so that Font Lock mode won't highlight the first character.
- (insert " Move to the session you want to recover,\n"
- " then type C-c C-c to select it.\n\n"
- " You can also delete some of these files;\n"
- " type d on a line to mark that file for deletion.\n\n"))))
- (use-local-map (nconc (make-sparse-keymap) (current-local-map)))
- (define-key (current-local-map) "\C-c\C-c" 'recover-session-finish))
+ (insert " To recover a session, move to it and type C-c C-c.\n"
+ (substitute-command-keys
+ " To delete a session file, type \
+\\[dired-flag-file-deletion] on its line to flag
+ the file for deletion, then \\[dired-do-flagged-delete] to \
+delete flagged files.\n\n"))))))
(defun recover-session-finish ()
"Choose one saved session to recover auto-save files from.
(defun auto-save-file-name-p (filename)
"Return non-nil if FILENAME can be yielded by `make-auto-save-file-name'.
FILENAME should lack slashes. You can redefine this for customization."
- (string-match "^#.*#$" filename))
+ (string-match "\\`#.*#\\'" filename))
\f
(defun wildcard-to-regexp (wildcard)
"Given a shell file name pattern WILDCARD, return an equivalent regexp.