;;; 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 msdos-long-file-names "msdos.c")
(declare-function w32-long-file-name "w32proc.c")
(declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep))
-(declare-function dired-unmark "dired" (arg))
+(declare-function dired-unmark "dired" (arg &optional interactive))
(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
Certain major modes set this locally to the value obtained
from `mode-require-final-newline'."
+ :safe #'symbolp
:type '(choice (const :tag "When visiting" visit)
(const :tag "When saving" t)
(const :tag "When visiting or saving" visit-save)
(const :tag "Don't add newlines" nil)
(other :tag "Ask each time" ask))
- :group 'editing-basics)
+ :group 'editing-basics
+ :version "24.4")
(defcustom mode-require-final-newline t
"Whether to add a newline at end of file, in certain major modes.
(other :tag "Query" other))
:group 'find-file)
+(defvar enable-dir-local-variables t
+ "Non-nil means enable use of directory-local variables.
+Some modes may wish to set this to nil to prevent directory-local
+settings being applied, but still respect file-local ones.")
+
;; This is an odd variable IMO.
;; You might wonder why it is needed, when we could just do:
;; (set (make-local-variable 'enable-local-variables) nil)
"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."
(defvar kill-buffer-hook nil
"Hook run when a buffer is killed.
The buffer being killed is current while the hook is running.
-See `kill-buffer'.")
+See `kill-buffer'.
+
+Note: Be careful with let-binding this hook considering it is
+frequently used for cleanup.")
(defun find-alternate-file (filename &optional wildcards)
"Find file FILENAME, select its buffer, kill previous buffer.
(setq buffer-read-only read-only)))
(setq buffer-file-read-only read-only))
- (when (and (not (eq (not (null rawfile))
- (not (null find-file-literally))))
- (not nonexistent)
- ;; It is confusing to ask whether to visit
- ;; non-literally if they have the file in
- ;; hexl-mode or image-mode.
- (not (memq major-mode '(hexl-mode image-mode))))
+ (unless (or (eq (null rawfile) (null find-file-literally))
+ nonexistent
+ ;; It is confusing to ask whether to visit
+ ;; non-literally if they have the file in
+ ;; hexl-mode or image-mode.
+ (memq major-mode '(hexl-mode image-mode)))
(if (buffer-modified-p)
(if (y-or-n-p
(format
(set-buffer-multibyte nil)
(setq buffer-file-coding-system 'no-conversion)
(set-buffer-major-mode buf)
- (make-local-variable 'find-file-literally)
- (setq find-file-literally t))
+ (setq-local find-file-literally t))
(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,
(after-insert-file-functions nil)
(coding-system-for-read 'no-conversion)
(coding-system-for-write 'no-conversion)
- (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!
(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))
or from Lisp without specifying the optional argument FIND-FILE;
in that case, this function acts as if `enable-local-variables' were t."
(interactive)
- (funcall (or (default-value 'major-mode) 'fundamental-mode))
+ (fundamental-mode)
(let ((enable-local-variables (or (not find-file) enable-local-variables)))
;; FIXME this is less efficient than it could be, since both
;; s-a-m and h-l-v may parse the same regions, looking for "mode:".
("\\.\\(\
arc\\|zip\\|lzh\\|lha\\|zoo\\|[jew]ar\\|xpi\\|rar\\|7z\\|\
ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|7Z\\)\\'" . archive-mode)
- ("\\.\\(sx[dmicw]\\|od[fgpst]\\|oxt\\)\\'" . archive-mode) ;OpenOffice.org
+ ("\\.oxt\\'" . archive-mode) ;(Open|Libre)Office extensions.
("\\.\\(deb\\|[oi]pk\\)\\'" . archive-mode) ; Debian/Opkg packages.
;; Mailer puts message to be edited in
;; /tmp/Re.... or Message
("\\.\\(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)
"\\.zoo\\'" "\\.[jew]ar\\'" "\\.xpi\\'" "\\.rar\\'"
"\\.7z\\'"
"\\.sx[dmicw]\\'" "\\.odt\\'"
+ "\\.diff\\'" "\\.patch\\'"
"\\.tiff?\\'" "\\.gif\\'" "\\.png\\'" "\\.jpe?g\\'"))
"List of regexps matching file names in which to ignore local variables.
This includes `-*-' lines as well as trailing \"Local Variables\" sections.
(if (functionp re)
(funcall re)
(looking-at re)))))))
- (set-auto-mode-0 done keep-mode-if-same)))))
+ (set-auto-mode-0 done keep-mode-if-same)))
+ (unless done
+ (set-buffer-major-mode (current-buffer)))))
;; When `keep-mode-if-same' is set, we are working on behalf of
;; set-visited-file-name. In that case, if the major mode specified is the
(prog1 (memq char '(?! ?\s ?y))
(quit-window t)))))))
+(defconst hack-local-variable-regexp
+ "[ \t]*\\([^][;\"'?()\\ \t\n]+\\)[ \t]*:[ \t]*")
+
(defun hack-local-variables-prop-line (&optional mode-only)
"Return local variables specified in the -*- line.
Returns an alist of elements (VAR . VAL), where VAR is a variable
;; (last ";" is optional).
;; If MODE-ONLY, just check for `mode'.
;; Otherwise, parse the -*- line into the RESULT alist.
- (while (and (or (not mode-only)
- (not result))
- (< (point) end))
- (unless (looking-at "[ \t]*\\([^ \t\n:]+\\)[ \t]*:[ \t]*")
- (message "Malformed mode-line")
+ (while (not (or (and mode-only result)
+ (>= (point) end)))
+ (unless (looking-at hack-local-variable-regexp)
+ (message "Malformed mode-line: %S"
+ (buffer-substring-no-properties (point) end))
(throw 'malformed-line nil))
(goto-char (match-end 0))
;; There used to be a downcase here,
(prefix
(concat "^" (regexp-quote
(buffer-substring (line-beginning-position)
- (match-beginning 0)))))
- beg)
+ (match-beginning 0))))))
(forward-line 1)
(let ((startpos (point))
(forward-line 1))
(goto-char (point-min))
- (while (and (not (eobp))
- (or (not mode-only)
- (not result)))
- ;; Find the variable name; strip whitespace.
- (skip-chars-forward " \t")
- (setq beg (point))
- (skip-chars-forward "^:\n")
- (if (eolp) (error "Missing colon in local variables entry"))
- (skip-chars-backward " \t")
- (let* ((str (buffer-substring beg (point)))
- (var (let ((read-circle nil))
- (read str)))
+ (while (not (or (eobp)
+ (and mode-only result)))
+ ;; Find the variable name;
+ (unless (looking-at hack-local-variable-regexp)
+ (error "Malformed local variable line: %S"
+ (buffer-substring-no-properties
+ (point) (line-end-position))))
+ (goto-char (match-end 1))
+ (let* ((str (match-string 1))
+ (var (intern str))
val val2)
(and (equal (downcase (symbol-name var)) "mode")
(setq var 'mode))
(defun hack-dir-local-variables ()
"Read per-directory local variables for the current buffer.
Store the directory-local variables in `dir-local-variables-alist'
-and `file-local-variables-alist', without applying them."
+and `file-local-variables-alist', without applying them.
+
+This does nothing if either `enable-local-variables' or
+`enable-dir-local-variables' are nil."
(when (and enable-local-variables
+ enable-dir-local-variables
(or enable-remote-dir-locals
(not (file-remote-p (or (buffer-file-name)
default-directory)))))
(or buffer-file-name (buffer-name))))))
(and confirm
(file-exists-p filename)
+ ;; NS does its own confirm dialog.
+ (not (and (eq (framep-on-display) 'ns)
+ (listp last-nonmenu-event)
+ use-dialog-box))
(or (y-or-n-p (format "File `%s' exists; overwrite? " filename))
(error "Canceled")))
(set-visited-file-name filename (not confirm))))
;; 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
(<= (nth 2 attr) backup-by-copying-when-privileged-mismatch)))
(not (file-ownership-preserved-p
real-file-name t))))))
- (backup-buffer-copy real-file-name backupname modes context)
+ (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:]]+\\)?~\\)"
"Default `backup-enable-predicate' function.
Checks for files in `temporary-file-directory',
`small-temporary-file-directory', and /tmp."
- (not (or (let ((comp (compare-strings temporary-file-directory 0 nil
- name 0 nil)))
- ;; Directory is under temporary-file-directory.
- (and (not (eq comp t))
- (< comp (- (length temporary-file-directory)))))
- (let ((comp (compare-strings "/tmp" 0 nil
- name 0 nil)))
- ;; Directory is under /tmp.
- (and (not (eq comp t))
- (< comp (- (length "/tmp")))))
- (if small-temporary-file-directory
- (let ((comp (compare-strings small-temporary-file-directory
- 0 nil
- name 0 nil)))
- ;; Directory is under small-temporary-file-directory.
- (and (not (eq comp t))
- (< comp (- (length small-temporary-file-directory)))))))))
+ (let ((temporary-file-directory temporary-file-directory)
+ caseless)
+ ;; On MS-Windows, file-truename will convert short 8+3 aliases to
+ ;; their long file-name equivalents, so compare-strings does TRT.
+ (if (memq system-type '(ms-dos windows-nt))
+ (setq temporary-file-directory (file-truename temporary-file-directory)
+ name (file-truename name)
+ caseless t))
+ (not (or (let ((comp (compare-strings temporary-file-directory 0 nil
+ name 0 nil caseless)))
+ ;; Directory is under temporary-file-directory.
+ (and (not (eq comp t))
+ (< comp (- (length temporary-file-directory)))))
+ (let ((comp (compare-strings "/tmp" 0 nil
+ name 0 nil)))
+ ;; Directory is under /tmp.
+ (and (not (eq comp t))
+ (< comp (- (length "/tmp")))))
+ (if small-temporary-file-directory
+ (let ((comp (compare-strings small-temporary-file-directory
+ 0 nil
+ name 0 nil caseless)))
+ ;; Directory is under small-temporary-file-directory.
+ (and (not (eq comp t))
+ (< comp (- (length small-temporary-file-directory))))))))))
(defun make-backup-file-name (file)
"Create the non-numeric backup file name for FILE.
(not (file-exists-p buffer-file-name))))
(let ((recent-save (recent-auto-save-p))
setmodes)
- ;; If buffer has no file name, ask user for one.
+ ;; If buffer has no file name, ask user for one.
(or buffer-file-name
- (let ((filename
- (expand-file-name
- (read-file-name "File to save in: "
- nil (expand-file-name (buffer-name))))))
- (if (file-exists-p filename)
- (if (file-directory-p filename)
- ;; Signal an error if the user specified the name of an
- ;; existing directory.
- (error "%s is a directory" filename)
- (unless (y-or-n-p (format "File `%s' exists; overwrite? "
- filename))
- (error "Canceled")))
- ;; Signal an error if the specified name refers to a
- ;; non-existing directory.
- (let ((dir (file-name-directory filename)))
- (unless (file-directory-p dir)
- (if (file-exists-p dir)
- (error "%s is not a directory" dir)
- (error "%s: no such directory" dir)))))
- (set-visited-file-name filename)))
+ (let ((filename
+ (expand-file-name
+ (read-file-name "File to save in: "
+ nil (expand-file-name (buffer-name))))))
+ (if (file-exists-p filename)
+ (if (file-directory-p filename)
+ ;; Signal an error if the user specified the name of an
+ ;; existing directory.
+ (error "%s is a directory" filename)
+ (unless (y-or-n-p (format "File `%s' exists; overwrite? "
+ filename))
+ (error "Canceled"))))
+ (set-visited-file-name filename)))
(or (verify-visited-file-modtime (current-buffer))
(not (file-exists-p buffer-file-name))
(yes-or-no-p
(insert ?\n))))
;; Support VC version backups.
(vc-before-save)
- (run-hooks 'before-save-hook)
+ ;; Don't let errors prevent saving the buffer.
+ (with-demoted-errors (run-hooks 'before-save-hook))
(or (run-hook-with-args-until-success 'write-contents-functions)
(run-hook-with-args-until-success 'local-write-file-hooks)
(run-hook-with-args-until-success 'write-file-functions)
;; If a hook returned t, file is already "written".
;; Otherwise, write it the usual way now.
- (setq setmodes (basic-save-buffer-1)))
+ (let ((dir (file-name-directory
+ (expand-file-name buffer-file-name))))
+ (unless (file-exists-p dir)
+ (if (y-or-n-p
+ (format "Directory `%s' does not exist; create? " dir))
+ (make-directory dir t)
+ (error "Canceled")))
+ (setq setmodes (basic-save-buffer-1))))
;; Now we have saved the current buffer. Let's make sure
;; that buffer-file-coding-system is fixed to what
;; actually used for saving by binding it locally.
(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
(basic-save-buffer-2))
(basic-save-buffer-2))
(if buffer-file-coding-system-explicit
- (setcar buffer-file-coding-system-explicit last-coding-system-used)
- (setq buffer-file-coding-system-explicit
- (cons last-coding-system-used nil)))))
+ (setcar buffer-file-coding-system-explicit last-coding-system-used))))
-;; 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)
+ (let (tempsetmodes setmodes writecoding)
(if (not (file-writable-p buffer-file-name))
(let ((dir (file-name-directory buffer-file-name)))
(if (not (file-directory-p dir))
buffer-file-name)))
(setq tempsetmodes t)
(error "Attempt to save to a file which you aren't allowed to write"))))))
+ ;; This may involve prompting, so do it now before backing up the file.
+ ;; Otherwise there can be a delay while the user answers the
+ ;; prompt during which the original file has been renamed. (Bug#13522)
+ (setq writecoding
+ ;; Args here should match write-region call below around
+ ;; which we use writecoding.
+ (choose-write-coding-system nil nil buffer-file-name nil t
+ buffer-file-truename))
(or buffer-backed-up
(setq setmodes (backup-buffer)))
(let* ((dir (file-name-directory 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
;; Pass in nil&nil rather than point-min&max to indicate
;; we're saving the buffer rather than just a region.
;; write-region-annotate-functions may make us of it.
+ (let ((coding-system-for-write writecoding)
+ (coding-system-require-warning nil))
(write-region nil nil
buffer-file-name nil t buffer-file-truename)
(setq success t))
(length autosaved-buffers)
(mapconcat 'identity autosaved-buffers ", "))))))))
\f
+(defun clear-visited-file-modtime ()
+ "Clear out records of last mod time of visited file.
+Next attempt to save will certainly not complain of a discrepancy."
+ (set-visited-file-modtime 0))
+
(defun not-modified (&optional arg)
"Mark current buffer as unmodified, not needing to be saved.
With prefix ARG, mark buffer as modified, so \\[save-buffer] will save.
(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.