;;; files.el --- file input and output commands for Emacs -*- lexical-binding:t -*-
-;; Copyright (C) 1985-1987, 1992-2015 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1987, 1992-2016 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Package: emacs
done when setting up the default directory of a newly visited file.
FROM is matched against directory names anchored at the first
-character, so it should start with a \"\\\\`\", or, if directory
+character, so it should start with a \"\\\\\\=`\", or, if directory
names cannot have embedded newlines, with a \"^\".
FROM and TO should be equivalent names, which refer to the
(error "No such directory found via CDPATH environment variable"))))
(defsubst directory-name-p (name)
- "Return non-nil if NAME ends with a slash character."
- (and (> (length name) 0)
- (char-equal (aref name (1- (length name))) ?/)))
-
-(defun directory-files-recursively (dir match &optional include-directories)
- "Return all files under DIR that have file names matching MATCH (a regexp).
+ "Return non-nil if NAME ends with a directory separator character."
+ (let ((len (length name))
+ (lastc ?.))
+ (if (> len 0)
+ (setq lastc (aref name (1- len))))
+ (or (= lastc ?/)
+ (and (memq system-type '(windows-nt ms-dos))
+ (= lastc ?\\)))))
+
+(defun directory-files-recursively (dir regexp &optional include-directories)
+ "Return list of all files under DIR that have file names matching REGEXP.
This function works recursively. Files are returned in \"depth first\"
-and alphabetical order.
-If INCLUDE-DIRECTORIES, also include directories that have matching names."
+order, and files from each directory are sorted in alphabetical order.
+Each file name appears in the returned list in its absolute form.
+Optional argument INCLUDE-DIRECTORIES non-nil means also include in the
+output directories whose names match REGEXP."
(let ((result nil)
(files nil)
;; When DIR is "/", remote file names like "/method:" could
;; also be offered. We shall suppress them.
- (tramp-mode (and tramp-mode (file-remote-p dir))))
+ (tramp-mode (and tramp-mode (file-remote-p (expand-file-name dir)))))
(dolist (file (sort (file-name-all-completions "" dir)
'string<))
(unless (member file '("./" "../"))
(unless (file-symlink-p full-file)
(setq result
(nconc result (directory-files-recursively
- full-file match include-directories))))
+ full-file regexp include-directories))))
(when (and include-directories
- (string-match match leaf))
+ (string-match regexp leaf))
(setq result (nconc result (list full-file)))))
- (when (string-match match file)
+ (when (string-match regexp file)
(push (expand-file-name file dir) files)))))
(nconc result (nreverse files))))
+(defvar module-file-suffix)
+
(defun load-file (file)
"Load the Lisp file named FILE."
- ;; This is a case where .elc makes a lot of sense.
+ ;; This is a case where .elc and .so/.dll make a lot of sense.
(interactive (list (let ((completion-ignored-extensions
- (remove ".elc" completion-ignored-extensions)))
+ (remove module-file-suffix
+ (remove ".elc"
+ completion-ignored-extensions))))
(read-file-name "Load file: " nil nil 'lambda))))
(load (expand-file-name file) nil nil t))
PATH should be a list of directories to look in, like the lists in
`exec-path' or `load-path'.
If SUFFIXES is non-nil, it should be a list of suffixes to append to
-file name when searching. If SUFFIXES is nil, it is equivalent to '(\"\").
-Use '(\"/\") to disable PATH search, but still try the suffixes in SUFFIXES.
+file name when searching. If SUFFIXES is nil, it is equivalent to (\"\").
+Use (\"/\") to disable PATH search, but still try the suffixes in SUFFIXES.
If non-nil, PREDICATE is used instead of `file-readable-p'.
This function will normally skip directories, so if you want it to find
(defun load-library (library)
"Load the Emacs Lisp library named LIBRARY.
+LIBRARY should be a string.
This is an interface to the function `load'. LIBRARY is searched
for in `load-path', both with and without `load-suffixes' (as
well as `load-file-rep-suffixes').
See Info node `(emacs)Lisp Libraries' for more details.
See `load-file' for a different interface to `load'."
(interactive
- (list (completing-read "Load library: "
- (apply-partially 'locate-file-completion-table
- load-path
- (get-load-suffixes)))))
+ (let (completion-ignored-extensions)
+ (list (completing-read "Load library: "
+ (apply-partially 'locate-file-completion-table
+ load-path
+ (get-load-suffixes))))))
(load library))
(defun file-remote-p (file &optional identification connected)
to derive a new remote file name from an existing one. For
example, if FILE is \"/sudo::/path/to/file\" then
- \(concat \(file-remote-p FILE) \"/bin/sh\")
+ (concat (file-remote-p FILE) \"/bin/sh\")
returns a remote file name for file \"/bin/sh\" that has the
same remote identifier as FILE but expanded; a name such as
(defcustom remote-file-name-inhibit-cache 10
"Whether to use the remote file-name cache for read access.
-When `nil', never expire cached values (caution)
-When `t', never use the cache (safe, but may be slow)
+When nil, never expire cached values (caution)
+When t, never use the cache (safe, but may be slow)
A number means use cached values for that amount of seconds since caching.
The attributes of remote files are cached for better performance.
If they are changed outside of Emacs's control, the cached values
become invalid, and must be reread. If you are sure that nothing
-other than Emacs changes the files, you can set this variable to `nil'.
+other than Emacs changes the files, you can set this variable to nil.
If a remote file is checked regularly, it might be a good idea to
let-bind this variable to a value less than the interval between
(defmacro minibuffer-with-setup-hook (fun &rest body)
"Temporarily add FUN to `minibuffer-setup-hook' while executing BODY.
-FUN can also be (:append FUN1), in which case FUN1 is appended to
-`minibuffer-setup-hook'.
+
+By default, FUN is prepended to `minibuffer-setup-hook'. But if FUN is of
+the form `(:append FUN1)', FUN1 will be appended to `minibuffer-setup-hook'
+instead of prepending it.
BODY should use the minibuffer at most once.
Recursive uses of the minibuffer are unaffected (FUN is not
(unless (run-hook-with-args-until-failure 'kill-buffer-query-functions)
(user-error "Aborted"))
(and (buffer-modified-p) buffer-file-name
- (not (yes-or-no-p "Kill and replace the buffer without saving it? "))
+ (not (yes-or-no-p
+ (format-message "Kill and replace buffer `%s' without saving it? "
+ (buffer-name))))
(user-error "Aborted"))
(let ((obuf (current-buffer))
(ofile buffer-file-name)
\f
(defun insert-file-contents-literally (filename &optional visit beg end replace)
"Like `insert-file-contents', but only reads in the file literally.
+See `insert-file-contents' for an explanation of the parameters.
A buffer may be modified in several ways after reading into the buffer,
due to Emacs features such as format decoding, character code
conversion, `find-file-hook', automatic uncompression, etc.
(view-mode-enter))
(run-hooks 'find-file-hook)))
-(defmacro report-errors (format &rest body)
- "Eval BODY and turn any error into a FORMAT message.
-FORMAT can have a %s escape which will be replaced with the actual error.
-If `debug-on-error' is set, errors are not caught, so that you can
-debug them.
-Avoid using a large BODY since it is duplicated."
- (declare (debug t) (indent 1))
- `(if debug-on-error
- (progn . ,body)
- (condition-case err
- (progn . ,body)
- (error (message ,format (prin1-to-string err))))))
+(define-obsolete-function-alias 'report-errors 'with-demoted-errors "25.1")
(defun normal-mode (&optional find-file)
"Choose the major mode for this buffer automatically.
or from Lisp without specifying the optional argument FIND-FILE;
in that case, this function acts as if `enable-local-variables' were t."
(interactive)
- (fundamental-mode)
+ (kill-all-local-variables)
+ (unless delay-mode-hooks
+ (run-hooks 'change-major-mode-after-body-hook
+ 'after-change-major-mode-hook))
(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:".
- (report-errors "File mode specification error: %s"
+ (with-demoted-errors "File mode specification error: %s"
(set-auto-mode))
- (report-errors "File local-variables error: %s"
- (hack-local-variables)))
+ ;; `delay-mode-hooks' being non-nil will have prevented the major
+ ;; mode's call to `run-mode-hooks' from calling
+ ;; `hack-local-variables'. In that case, call it now.
+ (when delay-mode-hooks
+ (with-demoted-errors "File local-variables error: %s"
+ (hack-local-variables 'no-mode))))
;; Turn font lock off and on, to make sure it takes account of
;; whatever file local variables are relevant to it.
(when (and font-lock-mode
"Alist mapping interpreter names to major modes.
This is used for files whose first lines match `auto-mode-interpreter-regexp'.
Each element looks like (REGEXP . MODE).
-If \\\\`REGEXP\\\\' matches the name (minus any directory part) of
+If REGEXP matches the entire name (minus any directory part) of
the interpreter specified in the first line of a script, enable
major mode MODE.
;; TODO? Warn once per file rather than once per session?
(defvar hack-local-variables--warned-lexical nil)
-(defun hack-local-variables (&optional mode-only)
+(defun hack-local-variables (&optional handle-mode)
"Parse and put into effect this buffer's local variables spec.
Uses `hack-local-variables-apply' to apply the variables.
-If MODE-ONLY is non-nil, all we do is check whether a \"mode:\"
+If HANDLE-MODE is nil, we apply all the specified local
+variables. If HANDLE-MODE is neither nil nor t, we do the same,
+except that any settings of `mode' are ignored.
+
+If HANDLE-MODE is t, all we do is check whether a \"mode:\"
is specified, and return the corresponding mode symbol, or nil.
In this case, we try to ignore minor-modes, and only return a
major-mode.
(let ((enable-local-variables
(and local-enable-local-variables enable-local-variables))
result)
- (unless mode-only
+ (unless (eq handle-mode t)
(setq file-local-variables-alist nil)
- (report-errors "Directory-local variables error: %s"
+ (with-demoted-errors "Directory-local variables error: %s"
;; Note this is a no-op if enable-local-variables is nil.
(hack-dir-local-variables)))
;; This entire function is basically a no-op if enable-local-variables
;; is nil. All it does is set file-local-variables-alist to nil.
(when enable-local-variables
- ;; This part used to ignore enable-local-variables when mode-only
- ;; was non-nil. That was inappropriate, eg consider the
+ ;; This part used to ignore enable-local-variables when handle-mode
+ ;; was t. That was inappropriate, eg consider the
;; (artificial) example of:
;; (setq local-enable-local-variables nil)
;; Open a file foo.txt that contains "mode: sh".
;; It correctly opens in text-mode.
;; M-x set-visited-file name foo.c, and it incorrectly stays in text-mode.
(unless (or (inhibit-local-variables-p)
- ;; If MODE-ONLY is non-nil, and the prop line specifies a
+ ;; If HANDLE-MODE is t, and the prop line specifies a
;; mode, then we're done, and have no need to scan further.
- (and (setq result (hack-local-variables-prop-line mode-only))
- mode-only))
+ (and (setq result (hack-local-variables-prop-line
+ (eq handle-mode t)))
+ (eq handle-mode t)))
;; Look for "Local variables:" line in last page.
(save-excursion
(goto-char (point-max))
(goto-char (point-min))
(while (not (or (eobp)
- (and mode-only result)))
+ (and (eq handle-mode t) result)))
;; Find the variable name;
(unless (looking-at hack-local-variable-regexp)
(error "Malformed local variable line: %S"
(forward-char 1)
(let ((read-circle nil))
(setq val (read (current-buffer))))
- (if mode-only
+ (if (eq handle-mode t)
(and (eq var 'mode)
;; Specifying minor-modes via mode: is
;; deprecated, but try to reject them anyway.
(unless hack-local-variables--warned-lexical
(setq hack-local-variables--warned-lexical t)
(display-warning
- :warning
- (format "%s: `lexical-binding' at end of file unreliable"
- (file-name-nondirectory
- (or buffer-file-name ""))))))
+ 'files
+ (format-message
+ "%s: `lexical-binding' at end of file unreliable"
+ (file-name-nondirectory
+ ;; We are called from
+ ;; 'with-temp-buffer', so we need
+ ;; to use 'thisbuf's name in the
+ ;; warning message.
+ (or (buffer-file-name thisbuf) ""))))))
+ ((and (eq var 'mode) handle-mode))
(t
(ignore-errors
(push (cons (if (eq var 'eval)
val) result))))))
(forward-line 1))))))))
;; Now we've read all the local variables.
- ;; If MODE-ONLY is non-nil, return whether the mode was specified.
- (if mode-only result
+ ;; If HANDLE-MODE is t, return whether the mode was specified.
+ (if (eq handle-mode t) result
;; Otherwise, set the variables.
(hack-local-variables-filter result nil)
(hack-local-variables-apply)))))
(since (nth 2 o)))
(message "%s is obsolete%s; %s"
var (if since (format " (since %s)" since))
- (if (stringp instead) instead
- (format "use `%s' instead" instead)))))))
+ (if (stringp instead)
+ (substitute-command-keys instead)
+ (format-message "use `%s' instead" instead)))))))
(defun hack-one-local-variable (var val)
"Set local variable VAR with value VAL.
(error
;; The file's content might be invalid (e.g. have a merge conflict), but
;; that shouldn't prevent the user from opening the file.
- (message ".dir-locals error: %s" (error-message-string err))
+ (message "%s error: %s" dir-locals-file (error-message-string err))
nil))))
(defun dir-locals-set-directory-class (directory class &optional mtime)
(defconst dir-locals-file ".dir-locals.el"
"File that contains directory-local variables.
-It has to be constant to enforce uniform values
-across different environments and users.")
+It has to be constant to enforce uniform values across different
+environments and users.
+See also `dir-locals-file-2', whose values override this one's.
+See Info node `(elisp)Directory Local Variables' for details.")
+
+(defconst dir-locals-file-2 ".dir-locals-2.el"
+ "File that contains directory-local variables.
+This essentially a second file that can be used like
+`dir-locals-file', so that users can have specify their personal
+dir-local variables even if the current directory already has a
+`dir-locals-file' that is shared with other users (such as in a
+git repository).
+See Info node `(elisp)Directory Local Variables' for details.")
+
+(defun dir-locals--all-files (directory)
+ "Return a list of all readable dir-locals files in DIRECTORY.
+The returned list is sorted by increasing priority. That is,
+values specified in the last file should take precedence over
+those in the first."
+ (when (file-readable-p directory)
+ (let* ((file-1 (expand-file-name (if (eq system-type 'ms-dos)
+ (dosified-file-name dir-locals-file)
+ dir-locals-file)
+ directory))
+ (file-2 (when (string-match "\\.el\\'" file-1)
+ (replace-match "-2.el" t nil file-1)))
+ (out nil))
+ ;; The order here is important.
+ (dolist (f (list file-2 file-1))
+ (when (and f
+ (file-readable-p f)
+ (file-regular-p f)
+ (not (file-directory-p f)))
+ (push f out)))
+ out)))
(defun dir-locals-find-file (file)
"Find the directory-local variables for FILE.
time stored in the cache matches the current file modification time.
If not, the cache entry is cleared so that the file will be re-read.
-This function returns either nil (no directory local variables found),
-or the matching entry from `dir-locals-directory-cache' (a list),
-or the full path to the `dir-locals-file' (a string) in the case
-of no valid cache entry."
+This function returns either:
+ - nil (no directory local variables found),
+ - the matching entry from `dir-locals-directory-cache' (a list),
+ - or the full path to the directory (a string) containing at
+ least one `dir-locals-file' in the case of no valid cache
+ entry."
(setq file (expand-file-name file))
- (let* ((dir-locals-file-name
- (if (eq system-type 'ms-dos)
- (dosified-file-name dir-locals-file)
- dir-locals-file))
- (locals-file (locate-dominating-file file dir-locals-file-name))
- (dir-elt nil))
+ (let* ((locals-dir (locate-dominating-file (file-name-directory file)
+ #'dir-locals--all-files))
+ dir-elt)
;; `locate-dominating-file' may have abbreviated the name.
- (and locals-file
- (setq locals-file (expand-file-name dir-locals-file-name locals-file)))
- ;; Let dir-locals-read-from-file inform us via demoted-errors
- ;; about unreadable files, etc.
- ;; Maybe we'd want to keep searching though - that is
- ;; a locate-dominating-file issue.
-;;; (or (not (file-readable-p locals-file))
-;;; (not (file-regular-p locals-file)))
-;;; (setq locals-file nil))
+ (when locals-dir
+ (setq locals-dir (expand-file-name locals-dir)))
;; Find the best cached value in `dir-locals-directory-cache'.
(dolist (elt dir-locals-directory-cache)
(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)))
+ (memq system-type
+ '(windows-nt cygwin ms-dos)))
+ (> (length (car elt)) (length (car dir-elt))))
+ (setq dir-elt elt)))
(if (and dir-elt
- (or (null locals-file)
- (<= (length (file-name-directory locals-file))
- (length (car dir-elt)))))
- ;; Found a potential cache entry. Check validity.
- ;; A cache entry with no MTIME is assumed to always be valid
- ;; (ie, set directly, not from a dir-locals file).
- ;; Note, we don't bother to check that there is a matching class
- ;; element in dir-locals-class-alist, since that's done by
- ;; dir-locals-set-directory-class.
- (if (or (null (nth 2 dir-elt))
- (let ((cached-file (expand-file-name dir-locals-file-name
- (car dir-elt))))
- (and (file-readable-p cached-file)
- (equal (nth 2 dir-elt)
- (nth 5 (file-attributes cached-file))))))
- ;; This cache entry is OK.
- dir-elt
- ;; This cache entry is invalid; clear it.
- (setq dir-locals-directory-cache
- (delq dir-elt dir-locals-directory-cache))
- ;; Return the first existing dir-locals file. Might be the same
- ;; as dir-elt's, might not (eg latter might have been deleted).
- locals-file)
+ (or (null locals-dir)
+ (<= (length locals-dir)
+ (length (car dir-elt)))))
+ ;; Found a potential cache entry. Check validity.
+ ;; A cache entry with no MTIME is assumed to always be valid
+ ;; (ie, set directly, not from a dir-locals file).
+ ;; Note, we don't bother to check that there is a matching class
+ ;; element in dir-locals-class-alist, since that's done by
+ ;; dir-locals-set-directory-class.
+ (if (or (null (nth 2 dir-elt))
+ (let ((cached-files (dir-locals--all-files (car dir-elt))))
+ ;; The entry MTIME should match the most recent
+ ;; MTIME among matching files.
+ (and cached-files
+ (= (float-time (nth 2 dir-elt))
+ (apply #'max (mapcar (lambda (f)
+ (float-time
+ (nth 5 (file-attributes f))))
+ cached-files))))))
+ ;; This cache entry is OK.
+ dir-elt
+ ;; This cache entry is invalid; clear it.
+ (setq dir-locals-directory-cache
+ (delq dir-elt dir-locals-directory-cache))
+ ;; Return the first existing dir-locals file. Might be the same
+ ;; as dir-elt's, might not (eg latter might have been deleted).
+ locals-dir)
;; No cache entry.
- locals-file)))
-
-(defun dir-locals-read-from-file (file)
- "Load a variables FILE and register a new class and instance.
-FILE is the name of the file holding the variables to apply.
-The new class name is the same as the directory in which FILE
-is found. Returns the new class name."
- (with-temp-buffer
+ locals-dir)))
+
+(defun dir-locals-read-from-dir (dir)
+ "Load all variables files in DIR and register a new class and instance.
+DIR is the absolute name of a directory which must contain at
+least one dir-local file (which is a file holding variables to
+apply).
+Return the new class name, which is a symbol named DIR."
+ (require 'map)
+ (let* ((class-name (intern dir))
+ (files (dir-locals--all-files dir))
+ (read-circle nil)
+ (success nil)
+ (variables))
(with-demoted-errors "Error reading dir-locals: %S"
- (insert-file-contents file)
- (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)))))
+ (dolist (file files)
+ (with-temp-buffer
+ (insert-file-contents file)
+ (condition-case-unless-debug nil
+ (setq variables
+ (map-merge-with 'list (lambda (a b) (map-merge 'list a b))
+ variables
+ (read (current-buffer))))
+ (end-of-file nil))))
+ (setq success t))
+ (dir-locals-set-class-variables class-name variables)
+ (dir-locals-set-directory-class
+ dir class-name
+ (seconds-to-time
+ (if success
+ (apply #'max (mapcar (lambda (file)
+ (float-time (nth 5 (file-attributes file))))
+ files))
+ ;; If there was a problem, use the values we could get but
+ ;; don't let the cache prevent future reads.
+ 0)))
+ class-name))
+
+(define-obsolete-function-alias 'dir-locals-read-from-file
+ 'dir-locals-read-from-dir "25.1")
(defcustom enable-remote-dir-locals nil
"Non-nil means dir-local variables will be applied to remote files."
(not (file-remote-p (or (buffer-file-name)
default-directory)))))
;; Find the variables file.
- (let ((variables-file (dir-locals-find-file
- (or (buffer-file-name) default-directory)))
+ (let ((dir-or-cache (dir-locals-find-file
+ (or (buffer-file-name) default-directory)))
(class nil)
(dir-name nil))
(cond
- ((stringp variables-file)
- (setq dir-name (file-name-directory variables-file)
- class (dir-locals-read-from-file variables-file)))
- ((consp variables-file)
- (setq dir-name (nth 0 variables-file))
- (setq class (nth 1 variables-file))))
+ ((stringp dir-or-cache)
+ (setq dir-name dir-or-cache
+ class (dir-locals-read-from-dir dir-or-cache)))
+ ((consp dir-or-cache)
+ (setq dir-name (nth 0 dir-or-cache))
+ (setq class (nth 1 dir-or-cache))))
(when class
(let ((variables
(dir-locals-collect-variables
(if (eq (car elt) 'coding)
(unless hack-dir-local-variables--warned-coding
(setq hack-dir-local-variables--warned-coding t)
- (display-warning :warning
+ (display-warning 'files
"Coding cannot be specified by dir-locals"))
(unless (memq (car elt) '(eval mode))
(setq dir-local-variables-alist
However, the mode will not be changed if
\(1) a local variables list or the `-*-' line specifies a major mode, or
\(2) the current major mode is a \"special\" mode,
-\ not suitable for ordinary files, or
+ not suitable for ordinary files, or
\(3) the new file name does not particularly specify any mode."
:type 'boolean
:group 'editing-basics)
(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))
+ (or (y-or-n-p (format-message
+ "File `%s' exists; overwrite? " filename))
(user-error "Canceled")))
(set-visited-file-name filename (not confirm))))
(set-buffer-modified-p t)
(save-buffer)
;; It's likely that the VC status at the new location is different from
;; the one at the old location.
- (vc-find-file-hook))
+ (vc-refresh-state))
\f
(defun file-extended-attributes (filename)
"Return an alist of extended attributes of file FILENAME.
"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))))))
+`file-extended-attributes'.
+Value is t if the function succeeds in setting the attributes."
+ (let (result rv)
+ (dolist (elt attributes)
+ (let ((attr (car elt))
+ (val (cdr elt)))
+ (cond ((eq attr 'acl)
+ (setq rv (set-file-acl filename val)))
+ ((eq attr 'selinux-context)
+ (setq rv (set-file-selinux-context filename val))))
+ (setq result (or result rv))))
+
+ result))
\f
(defun backup-buffer ()
"Make a backup of the disk file visited by the current buffer, if appropriate.
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)
- (file-exists-p buffer-file-name)
- (memq (aref (elt (file-attributes buffer-file-name) 8) 0)
- '(?- ?l)))
- (let ((real-file-name buffer-file-name)
- backup-info backupname targets setmodes)
+ (when (and make-backup-files (not backup-inhibited) (not buffer-backed-up))
+ (let ((attributes (file-attributes buffer-file-name)))
+ (when (and attributes (memq (aref (elt attributes 8) 0) '(?- ?l)))
;; If specified name is a symbolic link, chase it to the target.
- ;; Thus we make the backups in the directory where the real file is.
- (setq real-file-name (file-chase-links real-file-name))
- (setq backup-info (find-backup-file-name real-file-name)
- backupname (car backup-info)
- targets (cdr backup-info))
- ;; (if (file-directory-p buffer-file-name)
- ;; (error "Cannot save buffer in directory %s" buffer-file-name))
- (if backup-info
- (condition-case ()
- (let ((delete-old-versions
- ;; If have old versions to maybe delete,
- ;; ask the user to confirm now, before doing anything.
- ;; But don't actually delete til later.
- (and targets
- (or (eq delete-old-versions t) (eq delete-old-versions nil))
- (or delete-old-versions
- (y-or-n-p (format "Delete excess backup versions of %s? "
- real-file-name)))))
- (modes (file-modes buffer-file-name))
- (extended-attributes
- (file-extended-attributes buffer-file-name)))
- ;; Actually write the back up file.
- (condition-case ()
- (if (or file-precious-flag
- ; (file-symlink-p buffer-file-name)
- backup-by-copying
- ;; Don't rename a suid or sgid file.
- (and modes (< 0 (logand modes #o6000)))
- (not (file-writable-p (file-name-directory real-file-name)))
- (and backup-by-copying-when-linked
- (> (file-nlinks real-file-name) 1))
- (and (or backup-by-copying-when-mismatch
- (integerp backup-by-copying-when-privileged-mismatch))
- (let ((attr (file-attributes real-file-name)))
- (and (or backup-by-copying-when-mismatch
- (and (integerp (nth 2 attr))
- (integerp backup-by-copying-when-privileged-mismatch)
- (<= (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
- extended-attributes)
- ;; rename-file should delete old backup.
- (rename-file real-file-name backupname t)
- (setq setmodes (list modes extended-attributes
- backupname)))
- (file-error
- ;; If trouble writing the backup, write it in
- ;; .emacs.d/%backup%.
- (setq backupname (locate-user-emacs-file "%backup%~"))
- (message "Cannot write backup file; backing up in %s"
- backupname)
- (sleep-for 1)
- (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
- (while targets
- (condition-case ()
- (delete-file (car targets))
- (file-error nil))
- (setq targets (cdr targets))))
- setmodes)
- (file-error nil))))))
+ ;; This makes backups in the directory where the real file is.
+ (let* ((real-file-name (file-chase-links buffer-file-name))
+ (backup-info (find-backup-file-name real-file-name)))
+ (when backup-info
+ (let* ((backupname (car backup-info))
+ (targets (cdr backup-info))
+ (old-versions
+ ;; If have old versions to maybe delete,
+ ;; ask the user to confirm now, before doing anything.
+ ;; But don't actually delete til later.
+ (and targets
+ (booleanp delete-old-versions)
+ (or delete-old-versions
+ (y-or-n-p
+ (format "Delete excess backup versions of %s? "
+ real-file-name)))
+ targets))
+ (modes (file-modes buffer-file-name))
+ (extended-attributes
+ (file-extended-attributes buffer-file-name))
+ (copy-when-priv-mismatch
+ backup-by-copying-when-privileged-mismatch)
+ (make-copy
+ (or file-precious-flag backup-by-copying
+ ;; Don't rename a suid or sgid file.
+ (and modes (< 0 (logand modes #o6000)))
+ (not (file-writable-p
+ (file-name-directory real-file-name)))
+ (and backup-by-copying-when-linked
+ (< 1 (file-nlinks real-file-name)))
+ (and (or backup-by-copying-when-mismatch
+ (and (integerp copy-when-priv-mismatch)
+ (let ((attr (file-attributes
+ real-file-name
+ 'integer)))
+ (<= (nth 2 attr)
+ copy-when-priv-mismatch))))
+ (not (file-ownership-preserved-p real-file-name
+ t)))))
+ setmodes)
+ (condition-case ()
+ (progn
+ ;; Actually make the backup file.
+ (if make-copy
+ (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 extended-attributes
+ backupname)))
+ (setq buffer-backed-up t)
+ ;; Now delete the old versions, if desired.
+ (dolist (old-version old-versions)
+ (delete-file old-version)))
+ (file-error nil))
+ ;; If trouble writing the backup, write it in .emacs.d/%backup%.
+ (when (not buffer-backed-up)
+ (setq backupname (locate-user-emacs-file "%backup%~"))
+ (message "Cannot write backup file; backing up in %s"
+ backupname)
+ (sleep-for 1)
+ (backup-buffer-copy real-file-name backupname
+ modes extended-attributes)
+ (setq buffer-backed-up t))
+ setmodes)))))))
(defun backup-buffer-copy (from-name to-name modes extended-attributes)
;; Create temp files with strict access rights. It's easy to
(defun file-name-sans-extension (filename)
"Return FILENAME sans final \"extension\".
-The extension, in a file name, is the part that follows the last `.',
-except that a leading `.', if any, doesn't count."
+The extension, in a file name, is the part that begins with the last `.',
+except that a leading `.' of the file name, if there is one, doesn't count."
(save-match-data
(let ((file (file-name-sans-versions (file-name-nondirectory filename)))
directory)
(defun file-name-extension (filename &optional period)
"Return FILENAME's final \"extension\".
-The extension, in a file name, is the part that follows the last `.',
-excluding version numbers and backup suffixes,
-except that a leading `.', if any, doesn't count.
+The extension, in a file name, is the part that begins with the last `.',
+excluding version numbers and backup suffixes, except that a leading `.'
+of the file name, if there is one, doesn't count.
Return nil for extensionless file names such as `foo'.
Return the empty string for file names such as `foo.'.
-If PERIOD is non-nil, then the returned value includes the period
-that delimits the extension, and if FILENAME has no extension,
-the value is \"\"."
+By default, the returned value excludes the period that starts the
+extension, but if the optional argument PERIOD is non-nil, the period
+is included in the value, and in that case, if FILENAME has no
+extension, the value is \"\"."
(save-match-data
(let ((file (file-name-sans-versions (file-name-nondirectory filename))))
(if (and (string-match "\\.[^.]*\\'" file)
;; 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))
+ (unless (y-or-n-p (format-message
+ "File `%s' exists; overwrite? "
+ filename))
(error "Canceled"))))
(set-visited-file-name filename)))
(or (verify-visited-file-modtime (current-buffer))
(expand-file-name buffer-file-name))))
(unless (file-exists-p dir)
(if (y-or-n-p
- (format "Directory `%s' does not exist; create? " dir))
+ (format-message
+ "Directory `%s' does not exist; create? " dir))
(make-directory dir t)
(error "Canceled")))
(setq setmodes (basic-save-buffer-1))))
(file-exists-p buffer-file-name)
(> (file-nlinks buffer-file-name) 1)
(or dir-writable
- (error (concat (format
- "Directory %s write-protected; " dir)
- "cannot break hardlink when saving")))))
+ (error (concat "Directory %s write-protected; "
+ "cannot break hardlink when saving")
+ dir))))
;; Write temp name, then rename it.
;; This requires write access to the containing dir,
;; which is why we don't try it if we don't have that access.
\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."
+Next attempt to save will not complain of a discrepancy."
(set-visited-file-modtime 0))
(defun not-modified (&optional arg)
(list dir
(if (directory-files dir nil directory-files-no-dot-files-regexp)
(y-or-n-p
- (format "Directory `%s' is not empty, really %s? "
- dir (if trashing "trash" "delete")))
+ (format-message "Directory `%s' is not empty, really %s? "
+ dir (if trashing "trash" "delete")))
nil)
(null current-prefix-arg))))
;; If default-directory is a remote directory, make sure we find its
dir (file-truename dir))
(let ((ls1 (split-string file "/" t))
(ls2 (split-string dir "/" t))
- (root (if (string-match "\\`/" file) "/" ""))
+ (root
+ (cond
+ ;; A UNC on Windows systems, or a "super-root" on Apollo.
+ ((string-match "\\`//" file) "//")
+ ((string-match "\\`/" file) "/")
+ (t "")))
(mismatch nil))
(while (and ls1 ls2 (not mismatch))
(if (string-equal (car ls1) (car ls2))
Non-file buffers need a custom function"
(and buffer-file-name
(file-readable-p buffer-file-name)
+ (not (buffer-modified-p (current-buffer)))
(not (verify-visited-file-modtime (current-buffer)))))
(defvar buffer-stale-function #'buffer-stale--default-function
(defun file-expand-wildcards (pattern &optional full)
"Expand wildcard pattern PATTERN.
This returns a list of file names which match the pattern.
+Files are sorted in `string<' order.
If PATTERN is written as an absolute file name,
the values are absolute also.
PATTERN is assumed to represent a file-name wildcard suitable for the
underlying filesystem. For Unix and GNU/Linux, each character from the
-set [ \\t\\n;<>&|()`'\"#$] is quoted with a backslash; for DOS/Windows, all
+set [ \\t\\n;<>&|()\\=`\\='\"#$] is quoted with a backslash; for DOS/Windows, all
the parts of the pattern which don't include wildcard characters are
quoted with double quotes.
and `directory-free-space-args'. If the system call or program
is unsuccessful, or if DIR is a remote directory, this function
returns nil."
- (unless (file-remote-p dir)
+ (unless (file-remote-p (expand-file-name dir))
;; Try to find the number of free blocks. Non-Posix systems don't
;; always have df, but might have an equivalent system call.
(if (fboundp 'file-system-info)
(setq error-lines (nreverse error-lines))
;; Now read the numeric positions of file names.
(goto-char linebeg)
- (forward-word 1)
+ (forward-word-strictly 1)
(forward-char 3)
(while (< (point) end)
(let ((start (insert-directory-adj-pos
;; Simulate the message printed by `ls'.
(insert (format "%s: No such file or directory\n" file))))
-(defvar kill-emacs-query-functions nil
+(defcustom kill-emacs-query-functions nil
"Functions to call with no arguments to query about killing Emacs.
If any of these functions returns nil, killing Emacs is canceled.
`save-buffers-kill-emacs' calls these functions, but `kill-emacs',
-the low level primitive, does not. See also `kill-emacs-hook'.")
+the low level primitive, does not. See also `kill-emacs-hook'."
+ :type 'hook
+ :version "25.2"
+ :group 'convenience)
(defcustom confirm-kill-emacs nil
"How to ask for confirmation when leaving Emacs.
(defun save-buffers-kill-terminal (&optional arg)
"Offer to save each buffer, then kill the current connection.
-If the current frame has no client, kill Emacs itself.
+If the current frame has no client, kill Emacs itself using
+`save-buffers-kill-emacs'.
With prefix ARG, silently save all file-visiting buffers, then kill.
(cond ((= char ?r) #o0444)
((= char ?w) #o0222)
((= char ?x) #o0111)
- ((= char ?s) #o1000)
- ((= char ?t) #o6000)
+ ((= char ?s) #o6000)
+ ((= char ?t) #o1000)
;; Rights relative to the previous file modes.
((= char ?X) (if (= (logand from #o111) 0) 0 #o0111))
((= char ?u) (let ((uright (logand #o4700 from)))
(mapcar 'file-modes-char-to-who
(match-string 1 modes)))))
(when (= num-who 0)
- (setq num-who (default-file-modes)))
+ (setq num-who (logior #o7000 (default-file-modes))))
(setq num-modes
(file-modes-rights-to-number (substring modes (match-end 1))
num-who num-modes)
(defun read-file-modes (&optional prompt orig-file)
"Read file modes in octal or symbolic notation and return its numeric value.
-PROMPT is used as the prompt, default to `File modes (octal or symbolic): '.
+PROMPT is used as the prompt, default to \"File modes (octal or symbolic): \".
ORIG-FILE is the name of a file on whose mode bits to base returned
permissions if what user types requests to add, remove, or set permissions
based on existing mode bits, as in \"og+rX-w\"."
(let ((delete-by-moving-to-trash nil))
(rename-file fn new-fn)))))))))
+(defsubst file-attribute-type (attributes)
+ "The type field in ATTRIBUTES returned by `file-attribute'.
+The value is either t for directory, string (name linked to) for
+symbolic link, or nil."
+ (nth 0 attributes))
+
+(defsubst file-attribute-link-number (attributes)
+ "Return the number of links in ATTRIBUTES returned by `file-attribute'."
+ (nth 1 attributes))
+
+(defsubst file-attribute-user-id (attributes)
+ "The UID field in ATTRIBUTES returned by `file-attribute'.
+This is either a string or a number. If a string value cannot be
+looked up, a numeric value, either an integer or a float, is
+returned."
+ (nth 2 attributes))
+
+(defsubst file-attribute-group-id (attributes)
+ "The GID field in ATTRIBUTES returned by `file-attribute'.
+This is either a string or a number. If a string value cannot be
+looked up, a numeric value, either an integer or a float, is
+returned."
+ (nth 3 attributes))
+
+(defsubst file-attribute-access-time (attributes)
+ "The last access time in ATTRIBUTES returned by `file-attribute'.
+This a list of integers (HIGH LOW USEC PSEC) in the same style
+as (current-time)."
+ (nth 4 attributes))
+
+(defsubst file-attribute-modification-time (attributes)
+ "The modification time in ATTRIBUTES returned by `file-attribute'.
+This is the time of the last change to the file's contents, and
+is a list of integers (HIGH LOW USEC PSEC) in the same style
+as (current-time)."
+ (nth 5 attributes))
+
+(defsubst file-attribute-status-change-time (attributes)
+ "The status modification time in ATTRIBUTES returned by `file-attribute'.
+This is the time of last change to the file's attributes: owner
+and group, access mode bits, etc, and is a list of integers (HIGH
+LOW USEC PSEC) in the same style as (current-time)."
+ (nth 6 attributes))
+
+(defsubst file-attribute-size (attributes)
+ "The size (in bytes) in ATTRIBUTES returned by `file-attribute'.
+This is a floating point number if the size is too large for an integer."
+ (nth 7 attributes))
+
+(defsubst file-attribute-modes (attributes)
+ "The file modes in ATTRIBUTES returned by `file-attribute'.
+This is a string of ten letters or dashes as in ls -l."
+ (nth 8 attributes))
+
+(defsubst file-attribute-inode-number (attributes)
+ "The inode number in ATTRIBUTES returned by `file-attribute'.
+If it is larger than what an Emacs integer can hold, this is of
+the form (HIGH . LOW): first the high bits, then the low 16 bits.
+If even HIGH is too large for an Emacs integer, this is instead
+of the form (HIGH MIDDLE . LOW): first the high bits, then the
+middle 24 bits, and finally the low 16 bits."
+ (nth 10 attributes))
+
+(defsubst file-attribute-device-number (attributes)
+ "The file system device number in ATTRIBUTES returned by `file-attribute'.
+If it is larger than what an Emacs integer can hold, this is of
+the form (HIGH . LOW): first the high bits, then the low 16 bits.
+If even HIGH is too large for an Emacs integer, this is instead
+of the form (HIGH MIDDLE . LOW): first the high bits, then the
+middle 24 bits, and finally the low 16 bits."
+ (nth 11 attributes))
+
\f
(define-key ctl-x-map "\C-f" 'find-file)
(define-key ctl-x-map "\C-r" 'find-file-read-only)