;; Copyright (C) 1985, 1986, 1987, 1992, 1993, 1994, 1995, 1996,
;; 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
-;; 2006, 2007, 2008 Free Software Foundation, Inc.
+;; 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
;; Maintainer: FSF
;;; Code:
+(eval-when-compile (require 'cl))
+
(defvar font-lock-keywords)
(defgroup backup nil
(defcustom backup-by-copying nil
"Non-nil means always use copying to create backup files.
See documentation of variable `make-backup-files'."
- :type 'boolean
- :group 'backup)
+ :type 'boolean
+ :group 'backup)
(defcustom backup-by-copying-when-linked nil
"Non-nil means use copying to create backups for files with multiple names.
This causes the alternate names to refer to the latest version as edited.
This variable is relevant only if `backup-by-copying' is nil."
- :type 'boolean
- :group 'backup)
+ :type 'boolean
+ :group 'backup)
(defcustom backup-by-copying-when-mismatch nil
"Non-nil means create backups by copying if this preserves owner or group.
:group 'find-file)
(defcustom find-file-visit-truename nil
- "*Non-nil means visit a file under its truename.
+ "Non-nil means visit a file under its truename.
The truename of a file is found by chasing all links
both at the file level and at the levels of the containing directories."
:type 'boolean
(or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "/tmp"))))
"The directory for writing temporary files."
:group 'files
+ :initialize 'custom-initialize-delay
:type 'directory)
(defcustom small-temporary-file-directory
by programs that create small temporary files. This is for systems that
have fast storage with limited space, such as a RAM disk."
:group 'files
+ :initialize 'custom-initialize-delay
:type '(choice (const nil) directory))
;; The system null device. (Should reference NULL_DEVICE from C.)
(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
(cond ((and (eq system-type 'ms-dos) (not (msdos-long-file-names)))
Note that this feature forces backups to be made by copying.
Yet, at the same time, saving a precious file
-breaks any hard links between it and other files."
+breaks any hard links between it and other files.
+
+This feature is advisory: for example, if the directory in which the
+file is being saved is not writable, Emacs may ignore a non-nil value
+of `file-precious-flag' and write directly into the file.
+
+See also: `break-hardlink-on-save'."
:type 'boolean
:group 'backup)
+(defcustom break-hardlink-on-save nil
+ "Non-nil means when saving a file that exists under several names
+\(i.e., has multiple hardlinks), break the hardlink associated with
+`buffer-file-name' and write to a new file, so that the other
+instances of the file are not affected by the save.
+
+If `buffer-file-name' refers to a symlink, do not break the symlink.
+
+Unlike `file-precious-flag', `break-hardlink-on-save' is not advisory.
+For example, if the directory in which a file is being saved is not
+itself writable, then error instead of saving in some
+hardlink-nonbreaking way.
+
+See also `backup-by-copying' and `backup-by-copying-when-linked'."
+ :type 'boolean
+ :group 'files
+ :version "23.1")
+
(defcustom version-control nil
"Control use of version numbers for backup files.
When t, make numeric backup versions unconditionally.
:type 'boolean
:group 'auto-save)
-(defcustom auto-save-visited-file-name nil
- "Non-nil says auto-save a buffer in the file it is visiting, when practical.
-Normally auto-save files are written under other names."
- :type 'boolean
- :group 'auto-save)
-
(defcustom auto-save-file-name-transforms
`(("\\`/[^/]*:\\([^/]*/\\)*\\([^/]*\\)\\'"
;; Don't put "\\2" inside expand-file-name, since it will be
:group 'auto-save
:type '(repeat (list (string :tag "Regexp") (string :tag "Replacement")
(boolean :tag "Uniquify")))
+ :initialize 'custom-initialize-delay
:version "21.1")
(defcustom save-abbrevs t
The command \\[normal-mode], when used interactively,
always obeys file local variable specifications and the -*- line,
and ignores this variable."
+ :risky t
:type '(choice (const :tag "Query Unsafe" t)
(const :tag "Safe Only" :safe)
(const :tag "Do all" :all)
(defcustom enable-local-eval 'maybe
"Control processing of the \"variable\" `eval' in a file's local variables.
The value can be t, nil or something else.
-A value of t means obey `eval' variables;
+A value of t means obey `eval' variables.
A value of nil means ignore them; anything else means query."
+ :risky t
:type '(choice (const :tag "Obey" t)
(const :tag "Ignore" nil)
(other :tag "Query" other))
(defun locate-file-completion-table (dirs suffixes string pred action)
"Do completion for file names passed to `locate-file'."
- (if (file-name-absolute-p string)
- (let ((read-file-name-predicate pred))
- (read-file-name-internal string nil action))
+ (cond
+ ((file-name-absolute-p string)
+ (let ((read-file-name-predicate pred))
+ (read-file-name-internal string nil action)))
+ ((eq (car-safe action) 'boundaries)
+ (let ((suffix (cdr action)))
+ (list* 'boundaries
+ (length (file-name-directory string))
+ (let ((x (file-name-directory suffix)))
+ (if x (1- (length x)) (length suffix))))))
+ (t
(let ((names nil)
(suffix (concat (regexp-opt suffixes t) "\\'"))
- (string-dir (file-name-directory string)))
+ (string-dir (file-name-directory string))
+ (string-file (file-name-nondirectory string)))
(dolist (dir dirs)
(unless dir
(setq dir default-directory))
(if string-dir (setq dir (expand-file-name string-dir dir)))
(when (file-directory-p dir)
(dolist (file (file-name-all-completions
- (file-name-nondirectory string) dir))
- (add-to-list 'names (if string-dir (concat string-dir file) file))
+ string-file dir))
+ (push file names)
(when (string-match suffix file)
(setq file (substring file 0 (match-beginning 0)))
- (push (if string-dir (concat string-dir file) file) names)))))
- (complete-with-action action names string pred))))
+ (push file names)))))
+ (completion-table-with-context
+ string-dir names string-file pred action)))))
(defun locate-file-completion (string path-and-suffixes action)
"Do completion for file names passed to `locate-file'.
string nil action))
(make-obsolete 'locate-file-completion 'locate-file-completion-table "23.1")
-(defun locate-dominating-file (file regexp)
- "Look up the directory hierarchy from FILE for a file matching REGEXP."
- (catch 'found
- ;; `user' is not initialized yet because `file' may not exist, so we may
- ;; have to walk up part of the hierarchy before we find the "initial UID".
- (let ((user nil)
- ;; Abbreviate, so as to stop when we cross ~/.
- (dir (abbreviate-file-name (file-name-as-directory file)))
- files)
- (while (and dir
- ;; As a heuristic, we stop looking up the hierarchy of
- ;; directories as soon as we find a directory belonging to
- ;; another user. This should save us from looking in
- ;; things like /net and /afs. This assumes that all the
- ;; files inside a project belong to the same user.
- (let ((prev-user user))
- (setq user (nth 2 (file-attributes file)))
- (or (null prev-user) (equal user prev-user))))
- (if (setq files (and (file-directory-p dir)
- (directory-files dir 'full regexp)))
- (throw 'found (car files))
- (if (equal dir
- (setq dir (file-name-directory
- (directory-file-name dir))))
- (setq dir nil))))
- nil)))
+(defvar locate-dominating-stop-dir-regexp
+ "\\`\\(?:[\\/][\\/][^\\/]+[\\/]\\|/\\(?:net\\|afs\\|\\.\\.\\.\\)/\\)\\'"
+ "Regexp of directory names which stop the search in `locate-dominating-file'.
+Any directory whose name matches this regexp will be treated like
+a kind of root directory by `locate-dominating-file' which will stop its search
+when it bumps into it.
+The default regexp prevents fruitless and time-consuming attempts to find
+special files in directories in which filenames are interpreted as hostnames,
+or mount points potentially requiring authentication as a different user.")
+
+;; (defun locate-dominating-files (file regexp)
+;; "Look up the directory hierarchy from FILE for a file matching REGEXP.
+;; Stop at the first parent where a matching file is found and return the list
+;; of files that that match in this directory."
+;; (catch 'found
+;; ;; `user' is not initialized yet because `file' may not exist, so we may
+;; ;; have to walk up part of the hierarchy before we find the "initial UID".
+;; (let ((user nil)
+;; ;; Abbreviate, so as to stop when we cross ~/.
+;; (dir (abbreviate-file-name (file-name-as-directory file)))
+;; files)
+;; (while (and dir
+;; ;; As a heuristic, we stop looking up the hierarchy of
+;; ;; directories as soon as we find a directory belonging to
+;; ;; another user. This should save us from looking in
+;; ;; things like /net and /afs. This assumes that all the
+;; ;; files inside a project belong to the same user.
+;; (let ((prev-user user))
+;; (setq user (nth 2 (file-attributes dir)))
+;; (or (null prev-user) (equal user prev-user))))
+;; (if (setq files (condition-case nil
+;; (directory-files dir 'full regexp 'nosort)
+;; (error nil)))
+;; (throw 'found files)
+;; (if (equal dir
+;; (setq dir (file-name-directory
+;; (directory-file-name dir))))
+;; (setq dir nil))))
+;; nil)))
+
+(defun locate-dominating-file (file name)
+ "Look up the directory hierarchy from FILE for a file named NAME.
+Stop at the first parent directory containing a file NAME,
+and return the directory. Return nil if not found."
+ ;; 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.
+ ;;
+ ;; Represent /home/luser/foo as ~/foo so that we don't try to look for
+ ;; `name' in /home or in /.
+ (setq file (abbreviate-file-name file))
+ (let ((root nil)
+ (prev-file file)
+ ;; `user' is not initialized outside the loop because
+ ;; `file' may not exist, so we may have to walk up part of the
+ ;; hierarchy before we find the "initial UID".
+ (user nil)
+ try)
+ (while (not (or root
+ (null file)
+ ;; FIXME: Disabled this heuristic because it is sometimes
+ ;; inappropriate.
+ ;; As a heuristic, we stop looking up the hierarchy of
+ ;; directories as soon as we find a directory belonging
+ ;; to another user. This should save us from looking in
+ ;; things like /net and /afs. This assumes that all the
+ ;; files inside a project belong to the same user.
+ ;; (let ((prev-user user))
+ ;; (setq user (nth 2 (file-attributes file)))
+ ;; (and prev-user (not (equal user prev-user))))
+ (string-match locate-dominating-stop-dir-regexp file)))
+ (setq try (file-exists-p (expand-file-name name file)))
+ (cond (try (setq root file))
+ ((equal file (setq prev-file file
+ file (file-name-directory
+ (directory-file-name file))))
+ (setq file nil))))
+ root))
+
(defun executable-find (command)
"Search for COMMAND in `exec-path' and return the absolute file name.
(locate-file command exec-path exec-suffixes 1))
(defun load-library (library)
- "Load the library named LIBRARY.
-This is an interface to the function `load'."
+ "Load the Emacs Lisp library named LIBRARY.
+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
IDENTIFICATION specifies which part of the identification shall
be returned as string. IDENTIFICATION can be the symbol
-`method', `user' or `host'; any other value is handled like nil
-and means to return the complete identification string.
+`method', `user', `host' or `localname'; any other value is
+handled like nil and means to return the complete identification
+string.
If CONNECTED is non-nil, the function returns an identification only
if FILE is located on a remote system, and a connection is established
missing rest)
(if longname
(setq filename longname)
- ;; include the preceding directory separator in the missing
+ ;; Include the preceding directory separator in the missing
;; part so subsequent recursion on the rest works.
(setq missing (concat "/" (file-name-nondirectory filename)))
- (setq rest (substring filename 0 (* -1 (length missing))))
+ (let ((length (length missing)))
+ (setq rest
+ (if (> length (length filename))
+ ""
+ (substring filename 0 (- length)))))
(setq filename (concat (file-truename rest) missing))))))
(setq done t)))
(progn
(setq file
(make-temp-name
- (expand-file-name prefix temporary-file-directory)))
+ (if (zerop (length prefix))
+ (file-name-as-directory
+ temporary-file-directory)
+ (expand-file-name prefix
+ temporary-file-directory))))
(if suffix
(setq file (concat file suffix)))
(if dir-flag
(rename-file encoded new-encoded ok-if-already-exists)
newname))
\f
+(defcustom confirm-nonexistent-file-or-buffer 'after-completion
+ "Whether confirmation is requested before visiting a new file or buffer.
+If nil, confirmation is not requested.
+If the value is `after-completion', confirmation is only
+ requested if the user called `minibuffer-complete' right before
+ `minibuffer-complete-and-exit'.
+Any other non-nil value means to request confirmation.
+
+This affects commands like `switch-to-buffer' and `find-file'."
+ :group 'find-file
+ :version "23.1"
+ :type '(choice (const :tag "After completion" after-completion)
+ (const :tag "Never" nil)
+ (other :tag "Always" t)))
+
+(defun confirm-nonexistent-file-or-buffer ()
+ "Whether to request confirmation before visiting a new file or buffer.
+The variable `confirm-nonexistent-file-or-buffer' determines the
+return value, which may be passed as the REQUIRE-MATCH arg to
+`read-buffer' or `find-file-read-args'."
+ (cond ((eq confirm-nonexistent-file-or-buffer 'after-completion)
+ 'confirm-after-completion)
+ (confirm-nonexistent-file-or-buffer
+ 'confirm)
+ (t nil)))
+
(defun read-buffer-to-switch (prompt)
"Read the name of a buffer to switch to and return as a string.
It is intended for `switch-to-buffer' family of commands since they
and default values."
(let ((rbts-completion-table (internal-complete-buffer-except)))
(minibuffer-with-setup-hook
- (lambda () (setq minibuffer-completion-table rbts-completion-table))
- (read-buffer prompt (other-buffer (current-buffer))))))
-
-(defun switch-to-buffer-other-window (buffer &optional norecord)
- "Select buffer BUFFER in another window.
-If BUFFER does not identify an existing buffer, then this function
-creates a buffer with that name.
-
-When called from Lisp, BUFFER can be a buffer, a string \(a buffer name),
-or nil. If BUFFER is nil, then this function chooses a buffer
-using `other-buffer'.
-Optional second arg NORECORD non-nil means
-do not put this buffer at the front of the list of recently selected ones.
-This function returns the buffer it switched to.
+ (lambda ()
+ (setq minibuffer-completion-table rbts-completion-table)
+ ;; Since rbts-completion-table is built dynamically, we
+ ;; can't just add it to the default value of
+ ;; icomplete-with-completion-tables, so we add it
+ ;; here manually.
+ (if (and (boundp 'icomplete-with-completion-tables)
+ (listp icomplete-with-completion-tables))
+ (set (make-local-variable 'icomplete-with-completion-tables)
+ (cons rbts-completion-table
+ icomplete-with-completion-tables))))
+ (read-buffer prompt (other-buffer (current-buffer))
+ (confirm-nonexistent-file-or-buffer)))))
+
+(defun switch-to-buffer-other-window (buffer-or-name &optional norecord)
+ "Select the buffer specified by BUFFER-OR-NAME in another window.
+BUFFER-OR-NAME may be a buffer, a string \(a buffer name), or
+nil. Return the buffer switched to.
+
+If called interactively, prompt for the buffer name using the
+minibuffer. The variable `confirm-nonexistent-file-or-buffer'
+determines whether to request confirmation before creating a new
+buffer.
+
+If BUFFER-OR-NAME is a string and does not identify an existing
+buffer, create a new buffer with that name. If BUFFER-OR-NAME is
+nil, switch to the buffer returned by `other-buffer'.
+
+Optional second argument NORECORD non-nil means do not put this
+buffer at the front of the list of recently selected ones.
This uses the function `display-buffer' as a subroutine; see its
documentation for additional customization information."
(interactive
(list (read-buffer-to-switch "Switch to buffer in other window: ")))
(let ((pop-up-windows t)
- ;; Don't let these interfere.
same-window-buffer-names same-window-regexps)
- (pop-to-buffer buffer t norecord)))
+ (pop-to-buffer buffer-or-name t norecord)))
+
+(defun switch-to-buffer-other-frame (buffer-or-name &optional norecord)
+ "Switch to buffer BUFFER-OR-NAME in another frame.
+BUFFER-OR-NAME may be a buffer, a string \(a buffer name), or
+nil. Return the buffer switched to.
+
+If called interactively, prompt for the buffer name using the
+minibuffer. The variable `confirm-nonexistent-file-or-buffer'
+determines whether to request confirmation before creating a new
+buffer.
+
+If BUFFER-OR-NAME is a string and does not identify an existing
+buffer, create a new buffer with that name. If BUFFER-OR-NAME is
+nil, switch to the buffer returned by `other-buffer'.
-(defun switch-to-buffer-other-frame (buffer &optional norecord)
- "Switch to buffer BUFFER in another frame.
-Optional second arg NORECORD non-nil means
-do not put this buffer at the front of the list of recently selected ones.
-This function returns the buffer it switched to.
+Optional second arg NORECORD non-nil means do not put this
+buffer at the front of the list of recently selected ones.
This uses the function `display-buffer' as a subroutine; see its
documentation for additional customization information."
(list (read-buffer-to-switch "Switch to buffer in other frame: ")))
(let ((pop-up-frames t)
same-window-buffer-names same-window-regexps)
- (prog1
- (pop-to-buffer buffer t norecord)
- (raise-frame (window-frame (selected-window))))))
+ (pop-to-buffer buffer-or-name t norecord)))
(defun display-buffer-other-frame (buffer)
- "Switch to buffer BUFFER in another frame.
-This uses the function `display-buffer' as a subroutine; see its
-documentation for additional customization information."
+ "Display buffer BUFFER in another frame.
+This uses the function `display-buffer' as a subroutine; see
+its documentation for additional customization information."
(interactive "BDisplay buffer in other frame: ")
(let ((pop-up-frames t)
same-window-buffer-names same-window-regexps
,@body)
(remove-hook 'minibuffer-setup-hook ,hook)))))
-(defcustom find-file-confirm-nonexistent-file nil
- "If non-nil, `find-file' requires confirmation before visiting a new file."
- :group 'find-file
- :version "23.1"
- :type 'boolean)
-
(defun find-file-read-args (prompt mustmatch)
(list (let ((find-file-default
(and buffer-file-name
automatically choosing a major mode, use \\[find-file-literally]."
(interactive
(find-file-read-args "Find file: "
- (if find-file-confirm-nonexistent-file 'confirm-only)))
+ (confirm-nonexistent-file-or-buffer)))
(let ((value (find-file-noselect filename nil nil wildcards)))
(if (listp value)
(mapcar 'switch-to-buffer (nreverse value))
expand wildcards (if any) and visit multiple files."
(interactive
(find-file-read-args "Find file in other window: "
- (if find-file-confirm-nonexistent-file 'confirm-only)))
+ (confirm-nonexistent-file-or-buffer)))
(let ((value (find-file-noselect filename nil nil wildcards)))
(if (listp value)
(progn
expand wildcards (if any) and visit multiple files."
(interactive
(find-file-read-args "Find file in other frame: "
- (if find-file-confirm-nonexistent-file 'confirm-only)))
+ (confirm-nonexistent-file-or-buffer)))
(let ((value (find-file-noselect filename nil nil wildcards)))
(if (listp value)
(progn
Use \\[toggle-read-only] to permit editing."
(interactive
(find-file-read-args "Find file read-only: "
- (if find-file-confirm-nonexistent-file 'confirm-only)))
+ (confirm-nonexistent-file-or-buffer)))
(unless (or (and wildcards find-file-wildcards
(not (string-match "\\`/:" filename))
(string-match "[[*?]" filename))
Use \\[toggle-read-only] to permit editing."
(interactive
(find-file-read-args "Find file read-only other window: "
- (if find-file-confirm-nonexistent-file 'confirm-only)))
+ (confirm-nonexistent-file-or-buffer)))
(unless (or (and wildcards find-file-wildcards
(not (string-match "\\`/:" filename))
(string-match "[[*?]" filename))
Use \\[toggle-read-only] to permit editing."
(interactive
(find-file-read-args "Find file read-only other frame: "
- (if find-file-confirm-nonexistent-file 'confirm-only)))
+ (confirm-nonexistent-file-or-buffer)))
(unless (or (and wildcards find-file-wildcards
(not (string-match "\\`/:" filename))
(string-match "[[*?]" filename))
(setq file-name (file-name-nondirectory file)
file-dir (file-name-directory file)))
(list (read-file-name
- "Find alternate file: " file-dir nil nil file-name)
+ "Find alternate file: " file-dir nil
+ (confirm-nonexistent-file-or-buffer) file-name)
t))))
(if (one-window-p)
(find-file-other-window filename wildcards)
(setq file-name (file-name-nondirectory file)
file-dir (file-name-directory file)))
(list (read-file-name
- "Find alternate file: " file-dir nil nil file-name)
+ "Find alternate file: " file-dir nil
+ (confirm-nonexistent-file-or-buffer) file-name)
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; kill anyway? "
- (buffer-name)))
- (unless (yes-or-no-p "Kill and replace the buffer without saving it? ")
- (error "Aborted"))
- (save-buffer)))
+ (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"))))
(let ((obuf (current-buffer))
(ofile buffer-file-name)
(onum buffer-file-number)
(odir dired-directory)
(otrue buffer-file-truename)
(oname (buffer-name)))
+ ;; Run `kill-buffer-hook' here. It needs to happen before
+ ;; variables like `buffer-file-name' etc are set to nil below,
+ ;; because some of the hooks that could be invoked
+ ;; (e.g., `save-place-to-alist') depend on those variables.
+ ;;
+ ;; Note that `kill-buffer-hook' is not what queries whether to
+ ;; save a modified buffer visiting a file. Rather, `kill-buffer'
+ ;; asks that itself. Thus, there's no need to temporarily do
+ ;; `(set-buffer-modified-p nil)' before running this hook.
+ (run-hooks 'kill-buffer-hook)
+ ;; Okay, now we can end-of-life the old buffer.
(if (get-buffer " **lose**")
(kill-buffer " **lose**"))
(rename-buffer " **lose**")
(rename-buffer oname)))
(unless (eq (current-buffer) obuf)
(with-current-buffer obuf
- ;; We already asked; don't ask again.
- (let ((kill-buffer-query-functions))
+ ;; We already ran these; don't run them again.
+ (let (kill-buffer-query-functions kill-buffer-hook)
(kill-buffer obuf))))))
\f
(defun create-file-buffer (filename)
(file-exists-p (file-name-directory
(substring filename (1- (match-end 0))))))
(setq filename (substring filename (1- (match-end 0)))))
- (let ((tail directory-abbrev-alist))
+ ;; Avoid treating /home/foo as /home/Foo during `~' substitution.
+ ;; To fix this right, we need a `file-name-case-sensitive-p'
+ ;; function, but we don't have that yet, so just guess.
+ (let ((case-fold-search
+ (memq system-type '(ms-dos windows-nt darwin cygwin))))
;; If any elt of directory-abbrev-alist matches this name,
;; abbreviate accordingly.
- (while tail
- (if (string-match (car (car tail)) filename)
+ (dolist (dir-abbrev directory-abbrev-alist)
+ (if (string-match (car dir-abbrev) filename)
(setq filename
- (concat (cdr (car tail)) (substring filename (match-end 0)))))
- (setq tail (cdr tail)))
+ (concat (cdr dir-abbrev)
+ (substring filename (match-end 0))))))
;; Compute and save the abbreviated homedir name.
;; We defer computing this until the first time it's needed, to
;; give time for directory-abbrev-alist to be set properly.
:version "22.1"
:type '(choice integer (const :tag "Never request confirmation" nil)))
-(defun abort-if-file-too-large (size op-type)
+(defun abort-if-file-too-large (size op-type filename)
"If file SIZE larger than `large-file-warning-threshold', allow user to abort.
OP-TYPE specifies the file operation being performed (for message to user)."
(when (and large-file-warning-threshold size
(setq buf other))))
;; Check to see if the file looks uncommonly large.
(when (not (or buf nowarn))
- (abort-if-file-too-large (nth 7 attributes) "open"))
+ (abort-if-file-too-large (nth 7 attributes) "open" filename))
(if buf
;; We are using an existing buffer.
(let (nonexistent)
(signal 'file-error (list "Opening input file" "file is a directory"
filename)))
;; Check whether the file is uncommonly large
- (abort-if-file-too-large (nth 7 (file-attributes filename)) "insert")
+ (abort-if-file-too-large (nth 7 (file-attributes filename)) "insert" filename)
(let* ((buffer (find-buffer-visiting (abbreviate-file-name (file-truename filename))
#'buffer-modified-p))
(tem (funcall insert-func filename)))
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-major-mode 'fundamental-mode))
+ (funcall (or (default-value 'major-mode) 'fundamental-mode))
(let ((enable-local-variables (or (not find-file) enable-local-variables)))
(report-errors "File mode specification error: %s"
(set-auto-mode))
("\\.for\\'" . fortran-mode)
("\\.p\\'" . pascal-mode)
("\\.pas\\'" . pascal-mode)
+ ("\\.\\(dpr\\|DPR\\)\\'" . delphi-mode)
("\\.ad[abs]\\'" . ada-mode)
("\\.ad[bs].dg\\'" . ada-mode)
("\\.\\([pP]\\([Llm]\\|erl\\|od\\)\\|al\\)\\'" . perl-mode)
("Imakefile\\'" . makefile-imake-mode)
("Makeppfile\\(?:\\.mk\\)?\\'" . makefile-makepp-mode) ; Put this before .mk
("\\.makepp\\'" . makefile-makepp-mode)
- ,@(if (memq system-type '(berkeley-unix next-mach darwin))
+ ,@(if (memq system-type '(berkeley-unix darwin))
'(("\\.mk\\'" . makefile-bsdmake-mode)
("GNUmakefile\\'" . makefile-gmake-mode)
("[Mm]akefile\\'" . makefile-bsdmake-mode))
("\\.mss\\'" . scribe-mode)
("\\.f9[05]\\'" . f90-mode)
("\\.indent\\.pro\\'" . fundamental-mode) ; to avoid idlwave-mode
- ("\\.pro\\'" . idlwave-mode)
+ ("\\.\\(pro\\|PRO\\)\\'" . idlwave-mode)
("\\.prolog\\'" . prolog-mode)
("\\.tar\\'" . tar-mode)
;; The list of archive file extensions should be in sync with
("\\.\\(\
arc\\|zip\\|lzh\\|lha\\|zoo\\|[jew]ar\\|xpi\\|rar\\|\
ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\)\\'" . archive-mode)
- ("\\.\\(sx[dmicw]\\|odt\\)\\'" . archive-mode) ; OpenOffice.org
- ("\\.\\(deb\\)\\'" . archive-mode) ; Debian packages.
+ ("\\.\\(sx[dmicw]\\|od[fgpst]\\|oxt\\)\\'" . archive-mode) ;OpenOffice.org
+ ("\\.\\(deb\\|[oi]pk\\)\\'" . archive-mode) ; Debian/Opkg packages.
;; Mailer puts message to be edited in
;; /tmp/Re.... or Message
("\\`/tmp/Re" . text-mode)
("\\.x[ms]l\\'" . xml-mode)
("\\.dtd\\'" . sgml-mode)
("\\.ds\\(ss\\)?l\\'" . dsssl-mode)
- ("\\.js\\'" . java-mode) ; javascript-mode would be better
- ("\\.d?v\\'" . verilog-mode)
+ ("\\.js\\'" . js-mode) ; javascript-mode would be better
+ ("\\.[ds]?v\\'" . verilog-mode)
;; .emacs or .gnus or .viper following a directory delimiter in
;; Unix, MSDOG or VMS syntax.
("[]>:/\\]\\..*\\(emacs\\|gnus\\|viper\\)\\'" . emacs-lisp-mode)
("\\.[eE]?[pP][sS]\\'" . ps-mode)
("\\.\\(?:PDF\\|DVI\\|pdf\\|dvi\\)\\'" . doc-view-mode)
("configure\\.\\(ac\\|in\\)\\'" . autoconf-mode)
+ ("\\.s\\(v\\|iv\\|ieve\\)\\'" . sieve-mode)
("BROWSE\\'" . ebrowse-tree-mode)
("\\.ebrowse\\'" . ebrowse-tree-mode)
("#\\*mail\\*" . mail-mode)
See also `interpreter-mode-alist', which detects executable script modes
based on the interpreters they specify to run,
and `magic-mode-alist', which determines modes based on file contents.")
+(put 'auto-mode-alist 'risky-local-variable t)
(defun conf-mode-maybe ()
"Select Conf mode or XML mode according to start of file."
(defvar magic-fallback-mode-alist
`((image-type-auto-detected-p . image-mode)
+ ("\\(PK00\\)?[P]K\003\004" . archive-mode) ; zip
;; The < comes before the groups (but the first) to reduce backtracking.
;; TODO: UTF-16 <?xml may be preceded by a BOM 0xff 0xfe or 0xfe 0xff.
;; We use [ \t\r\n] instead of `\\s ' to make regex overflow less likely.
(defvar ignored-local-variables
'(ignored-local-variables safe-local-variable-values
- file-local-variables-alist)
+ file-local-variables-alist dir-local-variables-alist)
"Variables to be ignored in a file's local variable spec.")
+(put 'ignored-local-variables 'risky-local-variable t)
(defvar hack-local-variables-hook nil
"Normal hook run after processing a file's local variables specs.
"List variable-value pairs that are considered safe.
Each element is a cons cell (VAR . VAL), where VAR is a variable
symbol and VAL is a value that is considered safe."
+ :risky t
:group 'find-file
- :type 'alist)
+ :type 'alist)
(defcustom safe-local-eval-forms '((add-hook 'write-file-hooks 'time-stamp))
"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
asking you for confirmation."
+ :risky t
:group 'find-file
:version "22.2"
:type '(repeat sexp))
;; Risky local variables:
(mapc (lambda (var) (put var 'risky-local-variable t))
'(after-load-alist
- auto-mode-alist
buffer-auto-save-file-name
buffer-file-name
buffer-file-truename
buffer-undo-list
- dabbrev-case-fold-search
- dabbrev-case-replace
debugger
default-text-properties
- display-time-string
- enable-local-eval
- enable-local-variables
eval
exec-directory
exec-path
file-name-handler-alist
- font-lock-defaults
- format-alist
frame-title-format
global-mode-string
header-line-format
icon-title-format
- ignored-local-variables
- imenu--index-alist
- imenu-generic-expression
inhibit-quit
- input-method-alist
load-path
max-lisp-eval-depth
max-specpdl-size
- minor-mode-alist
minor-mode-map-alist
minor-mode-overriding-map-alist
- mode-line-buffer-identification
mode-line-format
- mode-line-client
- mode-line-modes
- mode-line-modified
- mode-line-mule-info
- mode-line-position
- mode-line-process
- mode-line-remote
mode-name
- outline-level
overriding-local-map
overriding-terminal-local-map
- parse-time-rules
process-environment
- rmail-output-file-alist
- safe-local-variable-values
- safe-local-eval-forms
- save-some-buffers-action-alist
- special-display-buffer-names
standard-input
standard-output
- unread-command-events
- vc-mode))
+ unread-command-events))
;; Safe local variables:
;;
if it is changed by the major or minor modes, or by the user.")
(make-variable-buffer-local 'file-local-variables-alist)
+(defvar dir-local-variables-alist nil
+ "Alist of directory-local variable settings in the current buffer.
+Each element in this list has the form (VAR . VALUE), where VAR
+is a directory-local variable (a symbol) and VALUE is the value
+specified in .dir-locals.el. The actual value in the buffer
+may differ from VALUE, if it is changed by the major or minor modes,
+or by the user.")
+(make-variable-buffer-local 'dir-local-variables-alist)
+
(defvar before-hack-local-variables-hook nil
"Normal hook run before setting file-local variables.
It is called after checking for unsafe/risky variables and
This hook is called only if there is at least one file-local
variable to set.")
-(defun hack-local-variables-confirm (all-vars unsafe-vars risky-vars project)
+(defun hack-local-variables-confirm (all-vars unsafe-vars risky-vars dir-name)
"Get confirmation before setting up local variable values.
ALL-VARS is the list of all variables to be set up.
UNSAFE-VARS is the list of those that aren't marked as safe or risky.
RISKY-VARS is the list of those that are marked as risky.
-PROJECT is a directory name if these settings come from directory-local
-settings, or nil otherwise."
+DIR-NAME is a directory name if these settings come from
+directory-local variables, or nil otherwise."
(if noninteractive
nil
- (let ((name (if buffer-file-name
- (file-name-nondirectory buffer-file-name)
- (concat "buffer " (buffer-name))))
+ (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))
prompt char)
(save-window-excursion
(set (make-local-variable 'cursor-type) nil)
(erase-buffer)
(if unsafe-vars
- (insert "The local variables list in " (or project name)
+ (insert "The local variables list in " name
"\ncontains values that may not be safe (*)"
(if risky-vars
", and variables that are risky (**)."
"."))
(if risky-vars
- (insert "The local variables list in " (or project name)
+ (insert "The local variables list in " name
"\ncontains variables that are risky (**).")
- (insert "A local variables list is specified in "
- (or project name) ".")))
+ (insert "A local variables list is specified in " name ".")))
(insert "\n\nDo you want to apply it? You can type
y -- to apply the local variables list.
n -- to ignore the local variables list.")
(let ((key (intern (match-string 1)))
(val (save-restriction
(narrow-to-region (point) end)
- (read (current-buffer)))))
+ (let ((read-circle nil))
+ (read (current-buffer))))))
;; It is traditional to ignore
;; case when checking for `mode' in set-auto-mode,
;; so we must do that here as well.
mode-specified
result))))
-(defun hack-local-variables-filter (variables project)
+(defun hack-local-variables-filter (variables dir-name)
"Filter local variable settings, querying the user if necessary.
VARIABLES is the alist of variable-value settings. This alist is
filtered based on the values of `ignored-local-variables',
`enable-local-eval', `enable-local-variables', and (if necessary)
user interaction. The results are added to
`file-local-variables-alist', without applying them.
-PROJECT is a directory name if these settings come from
- directory-local settings, or nil otherwise."
- ;; Strip any variables that are in `ignored-local-variables'.
- (dolist (ignored ignored-local-variables)
- (setq variables (assq-delete-all ignored variables)))
- ;; If `enable-local-eval' is nil, strip eval "variables".
- (if (null enable-local-eval)
- (setq variables (assq-delete-all 'eval variables)))
- (setq variables (nreverse variables))
- (when variables
- ;; Find those variables that we may want to save to
- ;; `safe-local-variable-values'.
- (let (risky-vars unsafe-vars)
- (dolist (elt variables)
- (let ((var (car elt))
- (val (cdr elt)))
- ;; Don't query about the fake variables.
- (or (memq var '(mode unibyte coding))
- (and (eq var 'eval)
- (or (eq enable-local-eval t)
- (hack-one-local-variable-eval-safep
- (eval (quote val)))))
- (safe-local-variable-p var val)
- (and (risky-local-variable-p var val)
- (push elt risky-vars))
- (push elt unsafe-vars))))
- (if (eq enable-local-variables :safe)
- ;; If caller wants only safe variables, store only these.
- (dolist (elt variables)
- (unless (or (member elt unsafe-vars)
- (member elt risky-vars))
- (push elt file-local-variables-alist)))
- ;; Query, unless all are known safe or the user wants no
- ;; querying.
- (if (or (and (eq enable-local-variables t)
- (null unsafe-vars)
- (null risky-vars))
- (eq enable-local-variables :all)
- (hack-local-variables-confirm
- variables unsafe-vars risky-vars project))
- (dolist (elt variables)
- (push elt file-local-variables-alist)))))))
+DIR-NAME is a directory name if these settings come from
+ directory-local variables, or nil otherwise."
+ ;; Find those variables that we may want to save to
+ ;; `safe-local-variable-values'.
+ (let (all-vars risky-vars unsafe-vars)
+ (dolist (elt variables)
+ (let ((var (car elt))
+ (val (cdr elt)))
+ (cond ((memq var ignored-local-variables)
+ ;; Ignore any variable in `ignored-local-variables'.
+ nil)
+ ;; 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)))
+ (push elt unsafe-vars))))
+ ;; Ignore duplicates in the present list.
+ ((assq var all-vars) nil)
+ ;; Accept known-safe variables.
+ ((or (memq var '(mode unibyte coding))
+ (safe-local-variable-p var val))
+ (push elt all-vars))
+ ;; The variable is either risky or unsafe:
+ ((not (eq enable-local-variables :safe))
+ (push elt all-vars)
+ (if (risky-local-variable-p var val)
+ (push elt risky-vars)
+ (push elt unsafe-vars))))))
+ (and all-vars
+ ;; Query, unless all vars are safe or user wants no querying.
+ (or (and (eq enable-local-variables t)
+ (null unsafe-vars)
+ (null risky-vars))
+ (memq enable-local-variables '(:all :safe))
+ (hack-local-variables-confirm all-vars unsafe-vars
+ risky-vars dir-name))
+ (dolist (elt all-vars)
+ (unless (eq (car elt) 'eval)
+ (unless dir-name
+ (setq dir-local-variables-alist
+ (assq-delete-all (car elt) dir-local-variables-alist)))
+ (setq file-local-variables-alist
+ (assq-delete-all (car elt) file-local-variables-alist)))
+ (push elt file-local-variables-alist)))))
(defun hack-local-variables (&optional mode-only)
"Parse and put into effect this buffer's local variables spec.
result)
(unless mode-only
(setq file-local-variables-alist nil)
- (report-errors "Project local-variables error: %s"
- (hack-project-variables)))
+ (report-errors "Directory-local variables error: %s"
+ (hack-dir-local-variables)))
(when (or mode-only enable-local-variables)
(setq result (hack-local-variables-prop-line mode-only))
;; Look for "Local variables:" line in last page.
(if (eolp) (error "Missing colon in local variables entry"))
(skip-chars-backward " \t")
(let* ((str (buffer-substring beg (point)))
- (var (read str))
+ (var (let ((read-circle nil))
+ (read str)))
val)
;; Read the variable value.
(skip-chars-forward "^:")
(forward-char 1)
- (setq val (read (current-buffer)))
+ (let ((read-circle nil))
+ (setq val (read (current-buffer))))
(if mode-only
(if (eq var 'mode)
(setq result t))
(enable-local-variables
(hack-local-variables-filter result nil)
(when file-local-variables-alist
+ ;; Any 'evals must run in the Right sequence.
(setq file-local-variables-alist
(nreverse file-local-variables-alist))
(run-hooks 'before-hack-local-variables-hook)
(and (eq (car exp) 'put)
(hack-one-local-variable-quotep (nth 1 exp))
(hack-one-local-variable-quotep (nth 2 exp))
- (let ((prop (nth 1 (nth 2 exp))) (val (nth 3 exp)))
- (cond ((eq prop 'lisp-indent-hook)
- ;; Only allow safe values of lisp-indent-hook;
- ;; not functions.
- (or (numberp val) (equal val ''defun)))
+ (let ((prop (nth 1 (nth 2 exp)))
+ (val (nth 3 exp)))
+ (cond ((memq prop '(lisp-indent-hook
+ lisp-indent-function
+ scheme-indent-function))
+ ;; Only allow safe values (not functions).
+ (or (numberp val)
+ (and (hack-one-local-variable-quotep val)
+ (eq (nth 1 val) 'defun))))
((eq prop 'edebug-form-spec)
;; Only allow indirect form specs.
;; During bootstrapping, edebug-basic-spec might not be
"-mode"))))
(unless (eq (indirect-function mode)
(indirect-function major-mode))
- (funcall 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
(set-text-properties 0 (length val) nil val))
(set (make-local-variable var) val))))
\f
-;;; Handling directory local variables, aka project settings.
-
-(defvar project-class-alist '()
- "Alist mapping project class names (symbols) to project variable lists.")
-
-(defvar project-directory-alist '()
- "Alist mapping project directory roots to project classes.")
-
-(defsubst project-get-alist (class)
- "Return the project variable list for project CLASS."
- (cdr (assq class project-class-alist)))
-
-(defun project-collect-bindings-from-alist (mode-alist settings)
- "Collect local variable settings from MODE-ALIST.
-SETTINGS is the initial list of bindings.
+;;; Handling directory-local variables, aka project settings.
+
+(defvar dir-locals-class-alist '()
+ "Alist mapping directory-local variable classes (symbols) to variable lists.")
+
+(defvar dir-locals-directory-cache '()
+ "List of cached directory roots for directory-local variable classes.
+Each element in this list has the form (DIR CLASS MTIME).
+DIR is the name of the directory.
+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
+ used to test whether the cache entry is still valid.
+ Alternatively, MTIME can be nil, which means the entry is always
+ considered valid.")
+
+(defsubst dir-locals-get-class-variables (class)
+ "Return the variable list for CLASS."
+ (cdr (assq class dir-locals-class-alist)))
+
+(defun dir-locals-collect-mode-variables (mode-variables variables)
+ "Collect directory-local variables from MODE-VARIABLES.
+VARIABLES is the initial list of variables.
Returns the new list."
- (dolist (pair mode-alist settings)
+ (dolist (pair mode-variables variables)
(let* ((variable (car pair))
(value (cdr pair))
- (slot (assq variable settings)))
- (if slot
+ (slot (assq variable variables)))
+ ;; If variables are specified more than once, only use the last. (Why?)
+ ;; The pseudo-variables mode and eval are different (bug#3430).
+ (if (and slot (not (memq variable '(mode eval))))
(setcdr slot value)
;; Need a new cons in case we setcdr later.
- (push (cons variable value) settings)))))
+ (push (cons variable value) variables)))))
-(defun project-collect-binding-list (binding-list root settings)
- "Collect entries from BINDING-LIST into SETTINGS.
+(defun dir-locals-collect-variables (class-variables root variables)
+ "Collect entries from CLASS-VARIABLES into VARIABLES.
ROOT is the root directory of the project.
-Return the new settings list."
+Return the new variables list."
(let* ((file-name (buffer-file-name))
(sub-file-name (if file-name
(substring file-name (length root)))))
- (dolist (entry binding-list settings)
+ (dolist (entry class-variables variables)
(let ((key (car entry)))
(cond
((stringp key)
(when (and sub-file-name
(>= (length sub-file-name) (length key))
(string= key (substring sub-file-name 0 (length key))))
- (setq settings (project-collect-binding-list (cdr entry)
- root settings))))
+ (setq variables (dir-locals-collect-variables
+ (cdr entry) root variables))))
((or (not key)
(derived-mode-p key))
- (setq settings (project-collect-bindings-from-alist (cdr entry)
- settings))))))))
+ (setq variables (dir-locals-collect-mode-variables
+ (cdr entry) variables))))))))
-(defun set-directory-project (directory class)
- "Declare that the project rooted at DIRECTORY is an instance of CLASS.
+(defun dir-locals-set-directory-class (directory class &optional mtime)
+ "Declare that the DIRECTORY root is an instance of CLASS.
DIRECTORY is the name of a directory, a string.
CLASS is the name of a project class, a symbol.
+MTIME is either the modification time of the directory-local
+variables file that defined this class, or nil.
When a file beneath DIRECTORY is visited, the mode-specific
-settings from CLASS will be applied to the buffer. The settings
-for a class are defined using `define-project-bindings'."
+variables from CLASS are applied to the buffer. The variables
+for a class are defined using `dir-locals-set-class-variables'."
(setq directory (file-name-as-directory (expand-file-name directory)))
- (unless (assq class project-class-alist)
- (error "No such project class `%s'" (symbol-name class)))
- (push (cons directory class) project-directory-alist))
-
-(defun define-project-bindings (class list)
- "Map the project type CLASS to a list of variable settings.
-CLASS is the project class, a symbol.
-LIST is a list that declares variable settings for the class.
-An element in LIST is either of the form:
+ (unless (assq class dir-locals-class-alist)
+ (error "No such class `%s'" (symbol-name class)))
+ (push (list directory class mtime) dir-locals-directory-cache))
+
+(defun dir-locals-set-class-variables (class variables)
+ "Map the type CLASS to a list of variable settings.
+CLASS is the project class, a symbol. VARIABLES is a list
+that declares directory-local variables for the class.
+An element in VARIABLES is either of the form:
(MAJOR-MODE . ALIST)
or
(DIRECTORY . LIST)
LIST is a list of the form accepted by the function.
When a file is visited, the file's class is found. A directory
-may be assigned a class using `set-directory-project'. Then
-variables are set in the file's buffer according to the class'
-LIST. The list is processed in order.
+may be assigned a class using `dir-locals-set-directory-class'.
+Then variables are set in the file's buffer according to the
+class' LIST. The list is processed in order.
* If the element is of the form (MAJOR-MODE . ALIST), and the
buffer's major mode is derived from MAJOR-MODE (as determined
- by `derived-mode-p'), then all the settings in ALIST are
+ by `derived-mode-p'), then all the variables in ALIST are
applied. A MAJOR-MODE of nil may be used to match any buffer.
`make-local-variable' is called for each variable before it is
set.
* If the element is of the form (DIRECTORY . LIST), and DIRECTORY
is an initial substring of the file's directory, then LIST is
applied by recursively following these rules."
- (let ((elt (assq class project-class-alist)))
+ (let ((elt (assq class dir-locals-class-alist)))
(if elt
- (setcdr elt list)
- (push (cons class list) project-class-alist))))
-
-(defun project-find-settings-file (file)
- "Find the settings file for FILE.
-This searches upward in the directory tree.
-If a settings file is found, the file name is returned.
-If the file is in a registered project, a cons from
-`project-directory-alist' is returned.
-Otherwise this returns nil."
+ (setcdr elt variables)
+ (push (cons class variables) dir-locals-class-alist))))
+
+(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.")
+
+(defun dir-locals-find-file (file)
+ "Find the directory-local variables for FILE.
+This searches upward in the directory tree from FILE.
+If the directory root of FILE has been registered in
+ `dir-locals-directory-cache' and the directory-local variables
+ file has not been modified, return the matching entry in
+ `dir-locals-directory-cache'.
+Otherwise, if a directory-local variables file is found, return
+ the file name.
+Otherwise, return nil."
(setq file (expand-file-name file))
- (let* ((settings (locate-dominating-file file "\\`\\.dir-settings\\.el\\'"))
- (pda nil))
+ (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))
;; `locate-dominating-file' may have abbreviated the name.
- (if settings (setq settings (expand-file-name settings)))
- (dolist (x project-directory-alist)
- (when (and (eq t (compare-strings file nil (length (car x))
- (car x) nil nil))
- (> (length (car x)) (length (car pda))))
- (setq pda x)))
- (if (and settings pda)
- (if (> (length (file-name-directory settings))
- (length (car pda)))
- settings pda)
- (or settings pda))))
-
-(defun project-define-from-project-file (settings-file)
- "Load a settings file and register a new project class and instance.
-SETTINGS-FILE is the name of the file holding the settings to apply.
-The new class name is the same as the directory in which SETTINGS-FILE
+ (when locals-file
+ (setq locals-file (expand-file-name dir-locals-file-name locals-file)))
+ ;; Find the best cached value in `dir-locals-directory-cache'.
+ (dolist (elt dir-locals-directory-cache)
+ (when (and (eq t (compare-strings file nil (length (car elt))
+ (car elt) nil nil
+ (memq system-type
+ '(windows-nt cygwin ms-dos))))
+ (> (length (car elt)) (length (car dir-elt))))
+ (setq dir-elt elt)))
+ (let ((use-cache (and dir-elt
+ (or (null locals-file)
+ (<= (length (file-name-directory locals-file))
+ (length (car dir-elt)))))))
+ (if use-cache
+ ;; Check the validity of the cache.
+ (if (and (file-readable-p (car dir-elt))
+ (or (null (nth 2 dir-elt))
+ (equal (nth 2 dir-elt)
+ (nth 5 (file-attributes (car dir-elt))))))
+ ;; 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))
+ locals-file)
+ 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
- ;; We should probably store the modtime of SETTINGS-FILE and then
- ;; reload it whenever it changes.
- (insert-file-contents settings-file)
- (let* ((dir-name (file-name-directory settings-file))
+ (insert-file-contents file)
+ (let* ((dir-name (file-name-directory file))
(class-name (intern dir-name))
- (list (read (current-buffer))))
- (define-project-bindings class-name list)
- (set-directory-project dir-name class-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)))
-(declare-function c-postprocess-file-styles "cc-mode" ())
-
-(defun hack-project-variables ()
- "Read local variables for the current buffer based on project settings.
-Store the project variables in `file-local-variables-alist',
-without applying them."
+(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."
(when (and enable-local-variables
(buffer-file-name)
(not (file-remote-p (buffer-file-name))))
- ;; Find the settings file.
- (let ((settings (project-find-settings-file (buffer-file-name)))
+ ;; Find the variables file.
+ (let ((variables-file (dir-locals-find-file (buffer-file-name)))
(class nil)
- (root-dir nil))
+ (dir-name nil))
(cond
- ((stringp settings)
- (setq root-dir (file-name-directory (buffer-file-name)))
- (setq class (project-define-from-project-file settings)))
- ((consp settings)
- (setq root-dir (car settings))
- (setq class (cdr settings))))
+ ((stringp variables-file)
+ (setq dir-name (file-name-directory (buffer-file-name)))
+ (setq class (dir-locals-read-from-file variables-file)))
+ ((consp variables-file)
+ (setq dir-name (nth 0 variables-file))
+ (setq class (nth 1 variables-file))))
(when class
- (let ((bindings
- (project-collect-binding-list (project-get-alist class)
- root-dir nil)))
- (when bindings
- (hack-local-variables-filter bindings root-dir)))))))
+ (let ((variables
+ (dir-locals-collect-variables
+ (dir-locals-get-class-variables class) dir-name nil)))
+ (when variables
+ (dolist (elt variables)
+ (unless (eq (car elt) 'eval)
+ (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)))))))
\f
(defcustom change-major-mode-with-file-name t
See the subroutine `basic-save-buffer' for more information."
(interactive "p")
(let ((modp (buffer-modified-p))
- (large (> (buffer-size) 50000))
(make-backup-files (or (and make-backup-files (not (eq args 0)))
(memq args '(16 64)))))
(and modp (memq args '(16 64)) (setq buffer-backed-up nil))
- (if (and modp large (buffer-file-name))
+ ;; We used to display the message below only for files > 50KB, but
+ ;; then Rmail-mbox never displays it due to buffer swapping. If
+ ;; the test is ever re-introduced, be sure to handle saving of
+ ;; Rmail files.
+ (if (and modp (buffer-file-name))
(message "Saving file %s..." (buffer-file-name)))
(basic-save-buffer)
(and modp (memq args '(4 64)) (setq buffer-backed-up nil))))
(let ((coding-system-for-write save-buffer-coding-system))
(basic-save-buffer-2))
(basic-save-buffer-2))
- (setq buffer-file-coding-system-explicit last-coding-system-used)))
+ (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)))))
;; This returns a value (MODES . BACKUPNAME), like backup-buffer.
(defun basic-save-buffer-2 ()
(error "Attempt to save to a file which you aren't allowed to write"))))))
(or buffer-backed-up
(setq setmodes (backup-buffer)))
- (let ((dir (file-name-directory buffer-file-name)))
- (if (and file-precious-flag
- (file-writable-p dir))
- ;; If file is precious, write temp name, then rename it.
+ (let* ((dir (file-name-directory buffer-file-name))
+ (dir-writable (file-writable-p dir)))
+ (if (or (and file-precious-flag dir-writable)
+ (and break-hardlink-on-save
+ (> (file-nlinks buffer-file-name) 1)
+ (or dir-writable
+ (error (concat (format
+ "Directory %s write-protected; " dir)
+ "cannot break hardlink when saving")))))
+ ;; 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.
(let ((realname buffer-file-name)
nil)
"view this buffer")
(?d ,(lambda (buf)
- (if (null buffer-file-name)
+ (if (null (buffer-file-name buf))
(message "Not applicable: no file")
(save-window-excursion (diff-buffer-with-file buf))
(if (not enable-recursive-minibuffers)
nil)
"view changes in this buffer"))
"ACTION-ALIST argument used in call to `map-y-or-n-p'.")
+(put 'save-some-buffers-action-alist 'risky-local-variable t)
(defvar buffer-save-without-query nil
"Non-nil means `save-some-buffers' should save this buffer without asking.")
(setq files-done
(map-y-or-n-p
(lambda (buffer)
- (and (buffer-modified-p buffer)
+ ;; Note that killing some buffers may kill others via
+ ;; hooks (e.g. Rmail and its viewing buffer).
+ (and (buffer-live-p buffer)
+ (buffer-modified-p buffer)
(not (buffer-base-buffer buffer))
(or
(buffer-file-name buffer)
\f
(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.
+With prefix ARG, mark buffer as modified, so \\[save-buffer] will save.
It is not a good idea to use this function in Lisp programs, because it
prints a message in the minibuffer. Instead, use `set-buffer-modified-p'."
(set-buffer-modified-p arg))
(defun toggle-read-only (&optional arg)
- "Change whether this buffer is visiting its file read-only.
+ "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 visiting file read-only
+positive, otherwise make it writable. If buffer is read-only
and `view-read-only' is non-nil, enter view mode."
(interactive "P")
(if (and arg
(defun append-to-file (start end filename)
"Append the contents of the region to the end of file FILENAME.
When called from a function, expects three arguments,
-START, END and FILENAME. START and END are buffer positions
-saying what text to write."
+START, END and FILENAME. START and END are normally buffer positions
+specifying the part of the buffer to write.
+If START is nil, that means to use the entire buffer contents.
+If START is a string, then output that string to the file
+instead of any buffer contents; END is ignored.
+
+This does character code conversion and applies annotations
+like `write-region' does."
(interactive "r\nFAppend to file: ")
(write-region start end filename t))
(make-directory-internal dir)
(let ((dir (directory-file-name (expand-file-name dir)))
create-list)
- (while (not (file-exists-p dir))
+ (while (and (not (file-exists-p dir))
+ ;; If directory is its own parent, then we can't
+ ;; keep looping forever
+ (not (equal dir
+ (directory-file-name
+ (file-name-directory dir)))))
(setq create-list (cons dir create-list)
dir (directory-file-name (file-name-directory dir))))
(while create-list
This command also implements an interface for special buffers
that contain text which doesn't come from a file, but reflects
some other data instead (e.g. Dired buffers, `buffer-list'
-buffers). This is done via the variable
-`revert-buffer-function'. In these cases, it should reconstruct
-the buffer contents from the appropriate data.
+buffers). This is done via the variable `revert-buffer-function'.
+In these cases, it should reconstruct the buffer contents from the
+appropriate data.
When called from Lisp, the first argument is IGNORE-AUTO; only offer
to revert from the auto-save file when this is nil. Note that the
sake of backward compatibility. IGNORE-AUTO is optional, defaulting
to nil.
-Optional second argument NOCONFIRM means don't ask for confirmation at
-all. \(The variable `revert-without-query' offers another way to
+Optional second argument NOCONFIRM means don't ask for confirmation
+at all. \(The variable `revert-without-query' offers another way to
revert buffers without querying for confirmation.)
Optional third argument PRESERVE-MODES non-nil means don't alter
;; internal coding.
(if auto-save-p 'auto-save-coding
(or coding-system-for-read
- buffer-file-coding-system-explicit))))
+ (and
+ buffer-file-coding-system-explicit
+ (car buffer-file-coding-system-explicit))))))
(if (and (not enable-multibyte-characters)
coding-system-for-read
(not (memq (coding-system-base
(kill-buffer buffer))))
(defun kill-buffer-ask (buffer)
- "Kill buffer if confirmed."
+ "Kill BUFFER if confirmed."
(when (yes-or-no-p
(format "Buffer %s %s. Kill? " (buffer-name buffer)
(if (buffer-modified-p buffer)
(setq list (cdr list))))
(defun kill-matching-buffers (regexp &optional internal-too)
- "Kill buffers whose name matches the specified regexp.
+ "Kill buffers whose name matches the specified REGEXP.
The optional second argument indicates whether to kill internal buffers too."
(interactive "sKill buffers matching this regular expression: \nP")
(dolist (buffer (buffer-list))
"Quote characters special to the shell in PATTERN, leave wildcards alone.
PATTERN is assumed to represent a file-name wildcard suitable for the
-underlying filesystem. For Unix and GNU/Linux, the characters from the
-set [ \\t\\n;<>&|()'\"#$] are quoted with a backslash; for DOS/Windows, all
+underlying filesystem. For Unix and GNU/Linux, each character from the
+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.
-Existing quote characters in PATTERN are left alone, so you can pass
-PATTERN that already quotes some of the special characters."
+
+This function leaves alone existing quote characters (\\ on Unix and \"
+on Windows), so PATTERN can use them to quote wildcard characters that
+need to be passed verbatim to shell commands."
(save-match-data
(cond
((memq system-type '(ms-dos windows-nt cygwin))
This function calls `file-system-info' if it is available, or invokes the
program specified by `directory-free-space-program' if that is non-nil."
- (when (not (file-remote-p dir))
+ (unless (file-remote-p 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)
(let ((fsinfo (file-system-info dir)))
(if fsinfo
(format "%.0f" (/ (nth 2 fsinfo) 1024))))
+ (setq dir (expand-file-name dir))
(save-match-data
(with-temp-buffer
(when (and directory-free-space-program
- (eq 0 (call-process 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
nil t nil
directory-free-space-args
- dir)))
+ dir)
+ 0)))
;; Usual format is a header line followed by a line of
;; numbers.
(goto-char (point-min))
(defun save-buffers-kill-emacs (&optional arg)
"Offer to save each buffer, then kill this Emacs process.
-With prefix arg, silently save all file-visiting buffers, then kill."
+With prefix ARG, silently save all file-visiting buffers, then kill."
(interactive "P")
(save-some-buffers arg t)
(and (or (not (memq t (mapcar (function
"Offer to save each buffer, then kill the current connection.
If the current frame has no client, kill Emacs itself.
-With prefix arg, silently save all file-visiting buffers, then kill.
+With prefix ARG, silently save all file-visiting buffers, then kill.
If emacsclient was started with a list of filenames to edit, then
only these files will be asked to be saved."
(interactive "P")
- (let ((proc (frame-parameter (selected-frame) 'client))
- (frame (selected-frame)))
- (if (null proc)
- (save-buffers-kill-emacs)
- (server-save-buffers-kill-terminal proc arg))))
-
+ (if (frame-parameter (selected-frame) 'client)
+ (server-save-buffers-kill-terminal arg)
+ (save-buffers-kill-emacs arg)))
\f
;; We use /: as a prefix to "quote" a file name
;; so that magic file name handlers will not apply to it.
;; Symbolic modes and read-file-modes.
(defun file-modes-char-to-who (char)
- "Convert CHAR to a who-mask from a symbolic mode notation.
-CHAR is in [ugoa] and represents the users on which rights are applied."
+ "Convert CHAR to a numeric bit-mask for extracting mode bits.
+CHAR is in [ugoa] and represents the category of users (Owner, Group,
+Others, or All) for whom to produce the mask.
+The bit-mask that is returned extracts from mode bits the access rights
+for the specified category of users."
(cond ((= char ?u) #o4700)
((= char ?g) #o2070)
((= char ?o) #o1007)
(t (error "%c: bad `who' character" char))))
(defun file-modes-char-to-right (char &optional from)
- "Convert CHAR to a right-mask from a symbolic mode notation.
-CHAR is in [rwxXstugo] and represents a right.
-If CHAR is in [Xugo], the value is extracted from FROM (or 0 if nil)."
+ "Convert CHAR to a numeric value of mode bits.
+CHAR is in [rwxXstugo] and represents symbolic access permissions.
+If CHAR is in [Xugo], the value is taken from FROM (or 0 if omitted)."
(or from (setq from 0))
(cond ((= char ?r) #o0444)
((= char ?w) #o0222)
(t (error "%c: bad right character" char))))
(defun file-modes-rights-to-number (rights who-mask &optional from)
- "Convert a right string to a right-mask from a symbolic modes notation.
-RIGHTS is the right string, it should match \"([+=-][rwxXstugo]+)+\".
-WHO-MASK is the mask number of the users on which the rights are to be applied.
-FROM (or 0 if nil) is the orginal modes of the file to be chmod'ed."
+ "Convert a symbolic mode string specification to an equivalent number.
+RIGHTS is the symbolic mode spec, it should match \"([+=-][rwxXstugo]*)+\".
+WHO-MASK is the bit-mask specifying the category of users to which to
+apply the access permissions. See `file-modes-char-to-who'.
+FROM (or 0 if nil) gives the mode bits on which to base permissions if
+RIGHTS request to add, remove, or set permissions based on existing ones,
+as in \"og+rX-w\"."
(let* ((num-rights (or from 0))
(list-rights (string-to-list rights))
(op (pop list-rights)))
(defun file-modes-symbolic-to-number (modes &optional from)
"Convert symbolic file modes to numeric file modes.
MODES is the string to convert, it should match
-\"[ugoa]*([+-=][rwxXstugo]+)+,...\".
+\"[ugoa]*([+-=][rwxXstugo]*)+,...\".
See (info \"(coreutils)File permissions\") for more information on this
notation.
-FROM (or 0 if nil) is the orginal modes of the file to be chmod'ed."
+FROM (or 0 if nil) gives the mode bits on which to base permissions if
+MODES request to add, remove, or set permissions based on existing ones,
+as in \"og+rX-w\"."
(save-match-data
(let ((case-fold-search nil)
(num-modes (or from 0)))
(while (/= (string-to-char modes) 0)
- (if (string-match "^\\([ugoa]*\\)\\([+=-][rwxXstugo]+\\)+\\(,\\|\\)" modes)
+ (if (string-match "^\\([ugoa]*\\)\\([+=-][rwxXstugo]*\\)+\\(,\\|\\)" modes)
(let ((num-who (apply 'logior 0
(mapcar 'file-modes-char-to-who
(match-string 1 modes)))))
num-modes)))
(defun read-file-modes (&optional prompt orig-file)
- "Read file modes in octal or symbolic notation.
+ "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): '.
-ORIG-FILE is the original file of which modes will be change."
+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* ((modes (or (if orig-file (file-modes orig-file) 0)
(error "File not found")))
- (value (read-string (or prompt "File modes (octal or symbolic): "))))
+ (modestr (and (stringp orig-file)
+ (nth 8 (file-attributes orig-file))))
+ (default
+ (and (stringp modestr)
+ (string-match "^.\\(...\\)\\(...\\)\\(...\\)$" modestr)
+ (replace-regexp-in-string
+ "-" ""
+ (format "u=%s,g=%s,o=%s"
+ (match-string 1 modestr)
+ (match-string 2 modestr)
+ (match-string 3 modestr)))))
+ (value (read-string (or prompt "File modes (octal or symbolic): ")
+ nil nil default)))
(save-match-data
(if (string-match "^[0-7]+" value)
(string-to-number value 8)
(file-modes-symbolic-to-number value modes)))))
\f
-;; Trash can handling.
-(defcustom trash-directory "~/.Trash"
+;; Trashcan handling.
+(defcustom trash-directory nil
"Directory for `move-file-to-trash' to move files and directories to.
-This directory is only used when the function `system-move-file-to-trash' is
-not defined. Relative paths are interpreted relative to `default-directory'.
-See also `delete-by-moving-to-trash'."
- :type 'directory
+This directory is only used when the function `system-move-file-to-trash'
+is not defined.
+Relative paths are interpreted relative to `default-directory'.
+If the value is nil, Emacs uses a freedesktop.org-style trashcan."
+ :type '(choice (const nil) directory)
:group 'auto-save
- :version "23.1")
+ :version "23.2")
+
+(defvar trash--hexify-table)
(declare-function system-move-file-to-trash "w32fns.c" (filename))
(defun move-file-to-trash (filename)
- "Move file (or directory) name FILENAME to the trash.
-This function is called by `delete-file' and `delete-directory' when
-`delete-by-moving-to-trash' is non-nil. On platforms that define
-`system-move-file-to-trash', that function is used to move FILENAME to the
-system trash, otherwise FILENAME is moved to `trash-directory'.
-Returns nil on success."
+ "Move the file (or directory) named FILENAME to the trash.
+When `delete-by-moving-to-trash' is non-nil, this function is
+called by `delete-file' and `delete-directory' instead of
+deleting files outright.
+
+If the function `system-move-file-to-trash' is defined, call it
+ with FILENAME as an argument.
+Otherwise, if `trash-directory' is non-nil, move FILENAME to that
+ directory.
+Otherwise, trash FILENAME using the freedesktop.org conventions,
+ like the GNOME, KDE and XFCE desktop environments. Emacs only
+ moves files to \"home trash\", ignoring per-volume trashcans."
(interactive "fMove file to trash: ")
- (cond
- ((fboundp 'system-move-file-to-trash)
- (system-move-file-to-trash filename))
- (t
- (let* ((trash-dir (expand-file-name trash-directory))
- (fn (directory-file-name (expand-file-name filename)))
- (fn-nondir (file-name-nondirectory fn))
- (new-fn (expand-file-name fn-nondir trash-dir)))
- (or (file-directory-p trash-dir)
- (make-directory trash-dir t))
- (and (file-exists-p new-fn)
- ;; make new-fn unique.
- ;; example: "~/.Trash/abc.txt" -> "~/.Trash/abc.txt.~1~"
- (let ((version-control t))
- (setq new-fn (car (find-backup-file-name new-fn)))))
- ;; stop processing if fn is same or parent directory of trash-dir.
- (and (string-match fn trash-dir)
- (error "Filename `%s' is same or parent directory of trash-directory"
- filename))
- (rename-file fn new-fn)))))
+ (cond (trash-directory
+ ;; If `trash-directory' is non-nil, move the file there.
+ (let* ((trash-dir (expand-file-name trash-directory))
+ (fn (directory-file-name (expand-file-name filename)))
+ (new-fn (expand-file-name (file-name-nondirectory fn)
+ trash-dir)))
+ ;; We can't trash a parent directory of trash-directory.
+ (if (string-match fn trash-dir)
+ (error "Trash directory `%s' is a subdirectory of `%s'"
+ trash-dir filename))
+ (unless (file-directory-p trash-dir)
+ (make-directory trash-dir t))
+ ;; Ensure that the trashed file-name is unique.
+ (if (file-exists-p new-fn)
+ (let ((version-control t)
+ (backup-directory-alist nil))
+ (setq new-fn (car (find-backup-file-name new-fn)))))
+ (let (delete-by-moving-to-trash)
+ (rename-file fn new-fn))))
+ ;; If `system-move-file-to-trash' is defined, use it.
+ ((fboundp 'system-move-file-to-trash)
+ (system-move-file-to-trash filename))
+ ;; Otherwise, use the freedesktop.org method, as specified at
+ ;; http://freedesktop.org/wiki/Specifications/trash-spec
+ (t
+ (let* ((xdg-data-dir
+ (directory-file-name
+ (expand-file-name "Trash"
+ (or (getenv "XDG_DATA_HOME")
+ "~/.local/share"))))
+ (trash-files-dir (expand-file-name "files" xdg-data-dir))
+ (trash-info-dir (expand-file-name "info" xdg-data-dir))
+ (fn (directory-file-name (expand-file-name filename))))
+
+ ;; Check if we have permissions to delete.
+ (unless (file-writable-p (directory-file-name
+ (file-name-directory fn)))
+ (error "Cannot move %s to trash: Permission denied" filename))
+ ;; The trashed file cannot be the trash dir or its parent.
+ (if (string-match fn trash-files-dir)
+ (error "The trash directory %s is a subdirectory of %s"
+ trash-files-dir filename))
+ (if (string-match fn trash-info-dir)
+ (error "The trash directory %s is a subdirectory of %s"
+ trash-info-dir filename))
+
+ ;; Ensure that the trash directory exists; otherwise, create it.
+ (let ((saved-default-file-modes (default-file-modes)))
+ (set-default-file-modes ?\700)
+ (unless (file-exists-p trash-files-dir)
+ (make-directory trash-files-dir t))
+ (unless (file-exists-p trash-info-dir)
+ (make-directory trash-info-dir t))
+ (set-default-file-modes saved-default-file-modes))
+
+ ;; Try to move to trash with .trashinfo undo information
+ (save-excursion
+ (with-temp-buffer
+ (set-buffer-file-coding-system 'utf-8-unix)
+ (insert "[Trash Info]\nPath=")
+ ;; Perform url-encoding on FN. For compatibility with
+ ;; other programs (e.g. XFCE Thunar), allow literal "/"
+ ;; for path separators.
+ (unless (boundp 'trash--hexify-table)
+ (setq trash--hexify-table (make-vector 256 nil))
+ (let ((unreserved-chars
+ (list ?/ ?a ?b ?c ?d ?e ?f ?g ?h ?i ?j ?k ?l ?m
+ ?n ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x ?y ?z ?A
+ ?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M ?N ?O
+ ?P ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z ?0 ?1 ?2
+ ?3 ?4 ?5 ?6 ?7 ?8 ?9 ?- ?_ ?. ?! ?~ ?* ?'
+ ?\( ?\))))
+ (dotimes (byte 256)
+ (aset trash--hexify-table byte
+ (if (memq byte unreserved-chars)
+ (char-to-string byte)
+ (format "%%%02x" byte))))))
+ (mapc (lambda (byte)
+ (insert (aref trash--hexify-table byte)))
+ (if (multibyte-string-p fn)
+ (encode-coding-string fn 'utf-8)
+ fn))
+ (insert "\nDeletionDate="
+ (format-time-string "%Y-%m-%dT%T")
+ "\n")
+
+ ;; Attempt to make .trashinfo file, trying up to 5
+ ;; times. The .trashinfo file is opened with O_EXCL,
+ ;; as per trash-spec 0.7, even if that can be a problem
+ ;; on old NFS versions...
+ (let* ((tries 5)
+ (base-fn (expand-file-name
+ (file-name-nondirectory fn)
+ trash-files-dir))
+ (new-fn base-fn)
+ success info-fn)
+ (while (> tries 0)
+ (setq info-fn (expand-file-name
+ (concat (file-name-nondirectory new-fn)
+ ".trashinfo")
+ trash-info-dir))
+ (unless (condition-case nil
+ (progn
+ (write-region nil nil info-fn nil
+ 'quiet info-fn 'excl)
+ (setq tries 0 success t))
+ (file-already-exists nil))
+ (setq tries (1- tries))
+ ;; Uniqify new-fn. (Some file managers do not
+ ;; like Emacs-style backup file names---e.g. bug
+ ;; 170956 in Konqueror bug tracker.)
+ (setq new-fn (make-temp-name (concat base-fn "_")))))
+ (unless success
+ (error "Cannot move %s to trash: Lock failed" filename))
+
+ ;; Finally, try to move the file to the trashcan.
+ (let ((delete-by-moving-to-trash nil))
+ (rename-file fn new-fn)))))))))
\f
(define-key ctl-x-map "\C-f" 'find-file)
HCoop / bpt / emacs.git / blobdiff