;;; 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
;;; Commentary:
-;; Defines most of Emacs'ss file- and directory-handling functions,
+;; Defines most of Emacs's file- and directory-handling functions,
;; including basic file visiting, backup generation, link handling,
;; ITS-id version control, load- and write-hook handling, and the like.
(defun parse-colon-path (search-path)
"Explode a search path into a list of directory names.
-Directories are separated by occurrences of `path-separator'
-\(which is colon in GNU and GNU-like systems)."
- ;; We could use split-string here.
- (and search-path
- (let (cd-list (cd-start 0) cd-colon)
- (setq search-path (concat search-path path-separator))
- (while (setq cd-colon (string-match path-separator search-path cd-start))
- (setq cd-list
- (nconc cd-list
- (list (if (= cd-start cd-colon)
- nil
- (substitute-in-file-name
- (file-name-as-directory
- (substring search-path cd-start cd-colon)))))))
- (setq cd-start (+ cd-colon 1)))
- cd-list)))
+Directories are separated by `path-separator' (which is colon in
+GNU and Unix systems). Substitute environment variables into the
+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)
+ (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."
;; This is a case where .elc makes a lot of sense.
(interactive (list (let ((completion-ignored-extensions
(remove ".elc" completion-ignored-extensions)))
- (read-file-name "Load file: "))))
+ (read-file-name "Load file: " nil nil 'lambda))))
(load (expand-file-name file) nil nil t))
(defun locate-file (filename path &optional suffixes predicate)
(defun locate-file-completion (string path-and-suffixes action)
"Do completion for file names passed to `locate-file'.
PATH-AND-SUFFIXES is a pair of lists, (DIRECTORIES . SUFFIXES)."
+ (declare (obsolete locate-file-completion-table "23.1"))
(locate-file-completion-table (car path-and-suffixes)
(cdr path-and-suffixes)
string nil action))
-(make-obsolete 'locate-file-completion 'locate-file-completion-table "23.1")
(defvar locate-dominating-stop-dir-regexp
(purecopy "\\`\\(?:[\\/][\\/][^\\/]+[\\/]\\|/\\(?:net\\|afs\\|\\.\\.\\.\\)/\\)\\'")
;; nil)))
(defun locate-dominating-file (file name)
- "Look up the directory hierarchy from FILE for a file named NAME.
+ "Look up the directory hierarchy from FILE for a directory containing NAME.
Stop at the first parent directory containing a file NAME,
and return the directory. Return nil if not found.
-
-This function only tests if FILE exists. If you care about whether
-it is readable, regular, etc., you should test the result."
+Instead of a string, NAME can also be a predicate taking one argument
+\(a directory) and returning a non-nil value if that directory is the one for
+which we're looking."
;; We used to use the above locate-dominating-files code, but the
;; directory-files call is very costly, so we're much better off doing
;; multiple calls using the code in here.
;; (setq user (nth 2 (file-attributes file)))
;; (and prev-user (not (equal user prev-user))))
(string-match locate-dominating-stop-dir-regexp file)))
- ;; FIXME? maybe this function should (optionally?)
- ;; use file-readable-p instead. In many cases, an unreadable
- ;; FILE is no better than a non-existent one.
- ;; See eg dir-locals-find-file.
- (setq try (file-exists-p (expand-file-name name file)))
+ (setq try (if (stringp name)
+ (file-exists-p (expand-file-name name file))
+ (funcall name file)))
(cond (try (setq root file))
((equal file (setq file (file-name-directory
(directory-file-name file))))
(setq file nil))))
- root))
+ (if root (file-name-as-directory root))))
(defun executable-find (command)
(setq list (cdr list))))
(or (car list) "ssh")))
"Program to use to execute commands on a remote host (e.g. ssh or rsh)."
- :version "24.2" ; ssh rather than rsh, etc
+ :version "24.3" ; ssh rather than rsh, etc
:initialize 'custom-initialize-delay
:group 'environment
:type 'file)
(delq (rassq 'ange-ftp-completion-hook-function tem) tem)))))
(or prev-dirs (setq prev-dirs (list nil)))
- ;; andrewi@harlequin.co.uk - none of the following code (except for
- ;; invoking the file-name handler) currently applies on Windows
- ;; (ie. there are no native symlinks), but there is an issue with
+ ;; andrewi@harlequin.co.uk - on Windows, there is an issue with
;; case differences being ignored by the OS, and short "8.3 DOS"
;; name aliases existing for all files. (The short names are not
;; reported by directory-files, but can be used to refer to files.)
;; it is stored on disk (expanding short name aliases with the full
;; name in the process).
(if (eq system-type 'windows-nt)
- (let ((handler (find-file-name-handler filename 'file-truename)))
- ;; For file name that has a special handler, call handler.
- ;; This is so that ange-ftp can save time by doing a no-op.
- (if handler
- (setq filename (funcall handler 'file-truename filename))
- ;; If filename contains a wildcard, newname will be the old name.
- (unless (string-match "[[*?]" filename)
- ;; If filename exists, use the long name. If it doesn't exist,
- ;; drill down until we find a directory that exists, and use
- ;; the long name of that, with the extra non-existent path
- ;; components concatenated.
- (let ((longname (w32-long-file-name filename))
- missing rest)
- (if longname
- (setq filename longname)
- ;; Include the preceding directory separator in the missing
- ;; part so subsequent recursion on the rest works.
- (setq missing (concat "/" (file-name-nondirectory filename)))
- (let ((length (length missing)))
- (setq rest
- (if (> length (length filename))
- ""
- (substring filename 0 (- length)))))
- (setq filename (concat (file-truename rest) missing))))))
- (setq done t)))
+ (unless (string-match "[[*?]" filename)
+ ;; If filename exists, use its long name. If it doesn't
+ ;; exist, the recursion below on the directory of filename
+ ;; will drill down until we find a directory that exists,
+ ;; and use the long name of that, with the extra
+ ;; non-existent path components concatenated.
+ (let ((longname (w32-long-file-name filename)))
+ (if longname
+ (setq filename longname)))))
;; If this file directly leads to a link, process that iteratively
;; so that we don't use lots of stack.
(setq dirfile (directory-file-name dir))
;; If these are equal, we have the (or a) root directory.
(or (string= dir dirfile)
+ (and (memq system-type '(windows-nt ms-dos cygwin))
+ (eq (compare-strings dir 0 nil dirfile 0 nil t) t))
;; If this is the same dir we last got the truename for,
;; save time--don't recalculate.
(if (assoc dir (car prev-dirs))
(find-file filename)
(current-buffer)))
-(defun find-file-read-only (filename &optional wildcards)
- "Edit file FILENAME but don't allow changes.
-Like \\[find-file], but marks buffer as read-only.
-Use \\[toggle-read-only] to permit editing."
- (interactive
- (find-file-read-args "Find file read-only: "
- (confirm-nonexistent-file-or-buffer)))
+(defun find-file--read-only (fun filename wildcards)
(unless (or (and wildcards find-file-wildcards
(not (string-match "\\`/:" filename))
(string-match "[[*?]" filename))
(file-exists-p filename))
(error "%s does not exist" filename))
- (let ((value (find-file filename wildcards)))
- (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1)))
+ (let ((value (funcall fun filename wildcards)))
+ (mapc (lambda (b) (with-current-buffer b (read-only-mode 1)))
(if (listp value) value (list value)))
value))
+(defun find-file-read-only (filename &optional wildcards)
+ "Edit file FILENAME but don't allow changes.
+Like \\[find-file], but marks buffer as read-only.
+Use \\[toggle-read-only] to permit editing."
+ (interactive
+ (find-file-read-args "Find file read-only: "
+ (confirm-nonexistent-file-or-buffer)))
+ (find-file--read-only #'find-file filename wildcards))
+
(defun find-file-read-only-other-window (filename &optional wildcards)
"Edit file FILENAME in another window but don't allow changes.
Like \\[find-file-other-window], but marks buffer as read-only.
(interactive
(find-file-read-args "Find file read-only other window: "
(confirm-nonexistent-file-or-buffer)))
- (unless (or (and wildcards find-file-wildcards
- (not (string-match "\\`/:" filename))
- (string-match "[[*?]" filename))
- (file-exists-p filename))
- (error "%s does not exist" filename))
- (let ((value (find-file-other-window filename wildcards)))
- (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1)))
- (if (listp value) value (list value)))
- value))
+ (find-file--read-only #'find-file-other-window filename wildcards))
(defun find-file-read-only-other-frame (filename &optional wildcards)
"Edit file FILENAME in another frame but don't allow changes.
(interactive
(find-file-read-args "Find file read-only other frame: "
(confirm-nonexistent-file-or-buffer)))
- (unless (or (and wildcards find-file-wildcards
- (not (string-match "\\`/:" filename))
- (string-match "[[*?]" filename))
- (file-exists-p filename))
- (error "%s does not exist" filename))
- (let ((value (find-file-other-frame filename wildcards)))
- (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1)))
- (if (listp value) value (list value)))
- value))
+ (find-file--read-only #'find-file-other-frame filename wildcards))
(defun find-alternate-file-other-window (filename &optional wildcards)
"Find file FILENAME as a replacement for the file in the next window.
(other-window 1)
(find-alternate-file filename wildcards))))
-(defvar kill-buffer-hook) ; from buffer.c
+;; Defined and used in buffer.c, but not as a DEFVAR_LISP.
+(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'.")
(defun find-alternate-file (filename &optional wildcards)
"Find file FILENAME, select its buffer, kill previous buffer.
t)))
(unless (run-hook-with-args-until-failure 'kill-buffer-query-functions)
(error "Aborted"))
- (when (and (buffer-modified-p) buffer-file-name)
- (if (yes-or-no-p (format "Buffer %s is modified; save it first? "
- (buffer-name)))
- (save-buffer)
- (unless (yes-or-no-p "Kill and replace the buffer without saving it? ")
- (error "Aborted"))))
+ (and (buffer-modified-p) buffer-file-name
+ (not (yes-or-no-p "Kill and replace the buffer without saving it? "))
+ (error "Aborted"))
(let ((obuf (current-buffer))
(ofile buffer-file-name)
(onum buffer-file-number)
"Regexp to match the automounter prefix in a directory name."
:group 'files
:type 'regexp)
-(make-obsolete-variable 'automount-dir-prefix 'directory-abbrev-alist "24.2")
+(make-obsolete-variable 'automount-dir-prefix 'directory-abbrev-alist "24.3")
(defvar abbreviated-home-dir nil
"The user's homedir abbreviated according to `directory-abbrev-alist'.")
(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)
- (find-buffer-file-type-function
- (if (fboundp 'find-buffer-file-type)
- (symbol-function 'find-buffer-file-type)
- nil))
+ (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!
(append '(jka-compr-handler image-file-handler epa-file-handler)
inhibit-file-name-handlers))
(inhibit-file-name-operation 'insert-file-contents))
- (unwind-protect
- (progn
- (fset 'find-buffer-file-type (lambda (_filename) t))
- (insert-file-contents filename visit beg end replace))
- (if find-buffer-file-type-function
- (fset 'find-buffer-file-type find-buffer-file-type-function)
- (fmakunbound 'find-buffer-file-type)))))
+ (insert-file-contents filename visit beg end replace)))
(defun insert-file-1 (filename insert-func)
(if (file-directory-p filename)
(not buffer-read-only)
(save-excursion
(goto-char (point-max))
- (insert "\n")))
+ (ignore-errors (insert "\n"))))
(when (and buffer-read-only
view-read-only
(not (eq (get major-mode 'mode-class) 'special)))
("\\.js\\'" . javascript-mode)
("\\.json\\'" . javascript-mode)
("\\.[ds]?vh?\\'" . verilog-mode)
+ ("\\.by\\'" . bovine-grammar-mode)
+ ("\\.wy\\'" . wisent-grammar-mode)
;; .emacs or .gnus or .viper following a directory delimiter in
;; Unix, MSDOG or VMS syntax.
("[]>:/\\]\\..*\\(emacs\\|gnus\\|viper\\)\\'" . emacs-lisp-mode)
specifications, but are not really, or they may be containers for
member files with their own local variable sections, which are
not appropriate for the containing file.
-See also `inhibit-local-variables-suffixes'.")
+The function `inhibit-local-variables-p' uses this.")
(define-obsolete-variable-alias 'inhibit-first-line-modes-suffixes
'inhibit-local-variables-suffixes "24.1")
(defvar inhibit-local-variables-suffixes nil
"List of regexps matching suffixes to remove from file names.
-When checking `inhibit-local-variables-regexps', we first discard
-from the end of the file name anything that matches one of these regexps.")
+The function `inhibit-local-variables-p' uses this: when checking
+a file name, it first discards from the end of the name anything that
+matches one of these regexps.")
+
+;; Can't think of any situation in which you'd want this to be nil...
+(defvar inhibit-local-variables-ignore-case t
+ "Non-nil means `inhibit-local-variables-p' ignores case.")
-;; TODO explicitly add case-fold-search t?
(defun inhibit-local-variables-p ()
"Return non-nil if file local variables should be ignored.
This checks the file (or buffer) name against `inhibit-local-variables-regexps'
-and `inhibit-local-variables-suffixes'."
+and `inhibit-local-variables-suffixes'. If
+`inhibit-local-variables-ignore-case' is non-nil, this ignores case."
(let ((temp inhibit-local-variables-regexps)
(name (if buffer-file-name
(file-name-sans-versions buffer-file-name)
- (buffer-name))))
+ (buffer-name)))
+ (case-fold-search inhibit-local-variables-ignore-case))
(while (let ((sufs inhibit-local-variables-suffixes))
(while (and sufs (not (string-match (car sufs) name)))
(setq sufs (cdr sufs)))
(cadr mode))
(setq mode (car mode)
name (substring name 0 (match-beginning 0)))
- (setq name))
+ (setq name nil))
(when mode
(set-auto-mode-0 mode keep-mode-if-same)
(setq done t))))))
;; This should be here at least as long as Emacs supports write-file-hooks.
'((add-hook 'write-file-hooks 'time-stamp)
(add-hook 'write-file-functions 'time-stamp)
- (add-hook 'before-save-hook 'time-stamp))
+ (add-hook 'before-save-hook 'time-stamp nil t)
+ (add-hook 'before-save-hook 'delete-trailing-whitespace nil t))
"Expressions that are considered safe in an `eval:' local variable.
Add expressions to this list if you want Emacs to evaluate them, when
they appear in an `eval' local variable specification, without first
RISKY-VARS is the list of those that are marked as risky.
If these settings come from directory-local variables, then
DIR-NAME is the name of the associated directory. Otherwise it is nil."
- (if noninteractive
- nil
- (save-window-excursion
- (let* ((name (or dir-name
- (if buffer-file-name
- (file-name-nondirectory buffer-file-name)
- (concat "buffer " (buffer-name)))))
- (offer-save (and (eq enable-local-variables t)
- unsafe-vars))
- (exit-chars
- (if offer-save '(?! ?y ?n ?\s ?\C-g) '(?y ?n ?\s ?\C-g)))
- (buf (pop-to-buffer "*Local Variables*"))
- prompt char)
- (set (make-local-variable 'cursor-type) nil)
+ (unless noninteractive
+ (let ((name (cond (dir-name)
+ (buffer-file-name
+ (file-name-nondirectory buffer-file-name))
+ ((concat "buffer " (buffer-name)))))
+ (offer-save (and (eq enable-local-variables t)
+ unsafe-vars))
+ (buf (get-buffer-create "*Local Variables*")))
+ ;; Set up the contents of the *Local Variables* buffer.
+ (with-current-buffer buf
(erase-buffer)
(cond
(unsafe-vars
(let ((print-escape-newlines t))
(prin1 (cdr elt) buf))
(insert "\n"))
- (setq prompt
- (format "Please type %s%s: "
- (if offer-save "y, n, or !" "y or n")
- (if (< (line-number-at-pos) (window-body-height))
- ""
- (push ?\C-v exit-chars)
- ", or C-v to scroll")))
- (goto-char (point-min))
- (while (null char)
- (setq char (read-char-choice prompt exit-chars t))
- (when (eq char ?\C-v)
- (condition-case nil
- (scroll-up)
- (error (goto-char (point-min))))
- (setq char nil)))
- (kill-buffer buf)
- (when (and offer-save (= char ?!) unsafe-vars)
- (customize-push-and-save 'safe-local-variable-values unsafe-vars))
- (memq char '(?! ?\s ?y))))))
+ (set (make-local-variable 'cursor-type) nil)
+ (set-buffer-modified-p nil)
+ (goto-char (point-min)))
+
+ ;; Display the buffer and read a choice.
+ (save-window-excursion
+ (pop-to-buffer buf)
+ (let* ((exit-chars '(?y ?n ?\s ?\C-g ?\C-v))
+ (prompt (format "Please type %s%s: "
+ (if offer-save "y, n, or !" "y or n")
+ (if (< (line-number-at-pos (point-max))
+ (window-body-height))
+ ""
+ (push ?\C-v exit-chars)
+ ", or C-v to scroll")))
+ char)
+ (if offer-save (push ?! exit-chars))
+ (while (null char)
+ (setq char (read-char-choice prompt exit-chars t))
+ (when (eq char ?\C-v)
+ (condition-case nil
+ (scroll-up)
+ (error (goto-char (point-min))
+ (recenter 1)))
+ (setq char nil)))
+ (when (and offer-save (= char ?!) unsafe-vars)
+ (customize-push-and-save 'safe-local-variable-values unsafe-vars))
+ (prog1 (memq char '(?! ?\s ?y))
+ (quit-window t)))))))
(defun hack-local-variables-prop-line (&optional mode-only)
"Return local variables specified in the -*- line.
;; Obey `enable-local-eval'.
((eq var 'eval)
(when enable-local-eval
- (push elt all-vars)
- (or (eq enable-local-eval t)
- (hack-one-local-variable-eval-safep (eval (quote val)))
- (safe-local-variable-p var val)
- (push elt unsafe-vars))))
+ (let ((safe (or (hack-one-local-variable-eval-safep val)
+ ;; In case previously marked safe (bug#5636).
+ (safe-local-variable-p var val))))
+ ;; If not safe and e-l-v = :safe, ignore totally.
+ (when (or safe (not (eq enable-local-variables :safe)))
+ (push elt all-vars)
+ (or (eq enable-local-eval t)
+ safe
+ (push elt unsafe-vars))))))
;; Ignore duplicates (except `mode') in the present list.
((and (assq var all-vars) (not (eq var 'mode))) nil)
;; Accept known-safe variables.
(setq ok t)))
ok))))))))
+(defun hack-one-local-variable--obsolete (var)
+ (let ((o (get var 'byte-obsolete-variable)))
+ (when o
+ (let ((instead (nth 0 o))
+ (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)))))))
+
(defun hack-one-local-variable (var val)
"Set local variable VAR with value VAL.
If VAR is `mode', call `VAL-mode' as a function unless it's
already the major mode."
- (cond ((eq var 'mode)
- (let ((mode (intern (concat (downcase (symbol-name val))
- "-mode"))))
- (unless (eq (indirect-function mode)
- (indirect-function major-mode))
- (if (memq mode minor-mode-list)
- ;; A minor mode must be passed an argument.
- ;; Otherwise, if the user enables the minor mode in a
- ;; major mode hook, this would toggle it off.
- (funcall mode 1)
- (funcall mode)))))
- ((eq var 'eval)
- (save-excursion (eval val)))
- (t
- ;; Make sure the string has no text properties.
- ;; Some text properties can get evaluated in various ways,
- ;; so it is risky to put them on with a local variable list.
- (if (stringp val)
- (set-text-properties 0 (length val) nil val))
- (set (make-local-variable var) val))))
+ (pcase var
+ (`mode
+ (let ((mode (intern (concat (downcase (symbol-name val))
+ "-mode"))))
+ (unless (eq (indirect-function mode)
+ (indirect-function major-mode))
+ (funcall mode))))
+ (`eval
+ (pcase val
+ (`(add-hook ',hook . ,_) (hack-one-local-variable--obsolete hook)))
+ (save-excursion (eval val)))
+ (_
+ (hack-one-local-variable--obsolete var)
+ ;; Make sure the string has no text properties.
+ ;; Some text properties can get evaluated in various ways,
+ ;; so it is risky to put them on with a local variable list.
+ (if (stringp val)
+ (set-text-properties 0 (length val) nil val))
+ (set (make-local-variable var) val))))
\f
;;; Handling directory-local variables, aka project settings.
CLASS is the name of a variable class (a symbol).
MTIME is the recorded modification time of the directory-local
variables file associated with this entry. This time is a list
-of two integers (the same format as `file-attributes'), and is
+of integers (the same format as `file-attributes'), and is
used to test whether the cache entry is still valid.
Alternatively, MTIME can be nil, which means the entry is always
considered valid.")
(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
"Non-nil means dir-local variables will be applied to remote files."
- :version "24.2"
+ :version "24.3"
:type 'boolean
:group 'find-file)
(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 period
"")))))
+(defun file-name-base (&optional filename)
+ "Return the base name of the FILENAME: no directory, no extension.
+FILENAME defaults to `buffer-file-name'."
+ (file-name-sans-extension
+ (file-name-nondirectory (or filename (buffer-file-name)))))
+
(defcustom make-backup-file-name-function nil
"A function to use instead of the default `make-backup-file-name'.
A value of nil gives the default `make-backup-file-name' behavior.
default-directory))))
(setq filename (expand-file-name filename))
(let ((fremote (file-remote-p filename))
- (dremote (file-remote-p directory)))
+ (dremote (file-remote-p directory))
+ (fold-case (or (memq system-type '(ms-dos cygwin windows-nt))
+ read-file-name-completion-ignore-case)))
(if ;; Conditions for separate trees
(or
;; Test for different filesystems on DOS/Windows
(memq system-type '(ms-dos cygwin windows-nt))
(or
;; Test for different drive letters
- (not (eq t (compare-strings filename 0 2 directory 0 2)))
+ (not (eq t (compare-strings filename 0 2 directory 0 2 fold-case)))
;; Test for UNCs on different servers
(not (eq t (compare-strings
(progn
(while (not
(or
(eq t (compare-strings filename-dir nil (length directory)
- directory nil nil case-fold-search))
+ directory nil nil fold-case))
(eq t (compare-strings filename nil (length directory)
- directory nil nil case-fold-search))))
+ directory nil nil 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 case-fold-search))
+ directory nil nil fold-case))
;; We matched within FILENAME's directory part.
;; Add the rest of FILENAME onto ANCESTOR.
(let ((rest (substring filename (length directory))))
(or buffer-file-name
(let ((filename
(expand-file-name
- (read-file-name "File to save in: ") nil)))
+ (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
(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
"Modification-flag cleared"))
(set-buffer-modified-p arg))
-(defun toggle-read-only (&optional arg)
- "Change whether this buffer is read-only.
-With prefix argument ARG, make the buffer read-only if ARG is
-positive, otherwise make it writable. If buffer is read-only
-and `view-read-only' is non-nil, enter view mode.
-
-This function is usually the wrong thing to use in a Lisp program.
-It can have side-effects beyond changing the read-only status of a buffer
-\(e.g., enabling view mode), and does not affect read-only regions that
-are caused by text properties. To make a buffer read-only in Lisp code,
-set `buffer-read-only'. To ignore read-only status (whether due to text
-properties or buffer state) and make changes, temporarily bind
-`inhibit-read-only'."
- (interactive "P")
- (if (and arg
- (if (> (prefix-numeric-value arg) 0) buffer-read-only
- (not buffer-read-only))) ; If buffer-read-only is set correctly,
- nil ; do nothing.
- ;; Toggle.
- (progn
- (cond
- ((and buffer-read-only view-mode)
- (View-exit-and-edit)
- (make-local-variable 'view-read-only)
- (setq view-read-only t)) ; Must leave view mode.
- ((and (not buffer-read-only) view-read-only
- ;; If view-mode is already active, `view-mode-enter' is a nop.
- (not view-mode)
- (not (eq (get major-mode 'mode-class) 'special)))
- (view-mode-enter))
- (t (setq buffer-read-only (not buffer-read-only))
- (force-mode-line-update))))
- (message "Read-only %s for this buffer"
- (if buffer-read-only "enabled" "disabled"))))
+(defun toggle-read-only (&optional arg interactive)
+ (declare (obsolete read-only-mode "24.3"))
+ (interactive (list current-prefix-arg t))
+ (if interactive
+ (call-interactively 'read-only-mode)
+ (read-only-mode (or arg 'toggle))))
(defun insert-file (filename)
"Insert contents of file FILENAME into buffer after point.
(not (file-exists-p file-name)))
(error "Auto-save file %s not current"
(abbreviate-file-name file-name)))
- ((save-window-excursion
- (with-output-to-temp-buffer "*Directory*"
- (buffer-disable-undo standard-output)
- (save-excursion
- (let ((switches dired-listing-switches))
- (if (file-symlink-p file)
- (setq switches (concat switches " -L")))
- (set-buffer standard-output)
- ;; Use insert-directory-safely, not insert-directory,
- ;; because these files might not exist. In particular,
- ;; FILE might not exist if the auto-save file was for
- ;; a buffer that didn't visit a file, such as "*mail*".
- ;; The code in v20.x called `ls' directly, so we need
- ;; to emulate what `ls' did in that case.
- (insert-directory-safely file switches)
- (insert-directory-safely file-name switches))))
- (yes-or-no-p (format "Recover auto save file %s? " file-name)))
+ ((with-temp-buffer-window
+ "*Directory*" nil
+ #'(lambda (window _value)
+ (with-selected-window window
+ (unwind-protect
+ (yes-or-no-p (format "Recover auto save file %s? " file-name))
+ (when (window-live-p window)
+ (quit-restore-window window 'kill)))))
+ (with-current-buffer standard-output
+ (let ((switches dired-listing-switches))
+ (if (file-symlink-p file)
+ (setq switches (concat switches " -L")))
+ ;; Use insert-directory-safely, not insert-directory,
+ ;; because these files might not exist. In particular,
+ ;; FILE might not exist if the auto-save file was for
+ ;; a buffer that didn't visit a file, such as "*mail*".
+ ;; The code in v20.x called `ls' directly, so we need
+ ;; to emulate what `ls' did in that case.
+ (insert-directory-safely file switches)
+ (insert-directory-safely file-name switches))))
(switch-to-buffer (find-file-noselect file t))
(let ((inhibit-read-only t)
;; Keep the current buffer-file-coding-system.
(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.
(when (and directory-free-space-program
;; Avoid failure if the default directory does
;; not exist (Bug#2631, Bug#3911).
- (let ((default-directory "/"))
- (eq (call-process directory-free-space-program
+ (let ((default-directory
+ (locate-dominating-file dir 'file-directory-p)))
+ (eq (process-file directory-free-space-program
nil t nil
directory-free-space-args
- dir)
+ (file-relative-name dir))
0)))
;; Assume that the "available" column is before the
;; "capacity" column. Find the "%" and scan backward.
(setq active t))
(setq processes (cdr processes)))
(or (not active)
- (progn (list-processes t)
- (yes-or-no-p "Active processes exist; kill them and exit anyway? ")))))
+ (with-temp-buffer-window
+ (get-buffer-create "*Process List*") nil
+ #'(lambda (window _value)
+ (with-selected-window window
+ (unwind-protect
+ (yes-or-no-p "Active processes exist; kill them and exit anyway? ")
+ (when (window-live-p window)
+ (quit-restore-window window 'kill)))))
+ (list-processes t)))))
;; Query the user for other things, perhaps.
(run-hook-with-args-until-failure 'kill-emacs-query-functions)
(or (null confirm-kill-emacs)
(define-key esc-map "~" 'not-modified)
(define-key ctl-x-map "\C-d" 'list-directory)
(define-key ctl-x-map "\C-c" 'save-buffers-kill-terminal)
-(define-key ctl-x-map "\C-q" 'toggle-read-only)
+(define-key ctl-x-map "\C-q" 'read-only-mode)
(define-key ctl-x-4-map "f" 'find-file-other-window)
(define-key ctl-x-4-map "r" 'find-file-read-only-other-window)