X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/ccb012c57e549910127d657282e0ada2b1be7181..adba8116c3a918f2f091600b60ea1700c9ea7362:/lisp/files.el diff --git a/lisp/files.el b/lisp/files.el index 00207d63b2..9d6218cc4e 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -29,6 +29,8 @@ ;;; Code: +(eval-when-compile (require 'cl)) + (defvar font-lock-keywords) (defgroup backup nil @@ -193,6 +195,7 @@ If the buffer is visiting a new file, the value is nil.") (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 @@ -202,6 +205,7 @@ If non-nil, this directory is used instead of `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.) @@ -383,6 +387,7 @@ ignored." :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 @@ -493,6 +498,7 @@ a -*- line. 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) @@ -514,6 +520,7 @@ specified in a -*- line.") The value can be t, nil or something else. 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)) @@ -714,24 +721,34 @@ one or more of those symbols." (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'. @@ -742,13 +759,14 @@ PATH-AND-SUFFIXES is a pair of lists, (DIRECTORIES . SUFFIXES)." (make-obsolete 'locate-file-completion 'locate-file-completion-table "23.1") (defvar locate-dominating-stop-dir-regexp - "\\`\\(?:[\\/][\\/]\\|/\\(?:net\\|afs\\|\\.\\.\\.\\)/\\)\\'" + "\\`\\(?:[\\/][\\/][^\\/]+[\\/]\\|/\\(?: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.") +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. @@ -828,12 +846,13 @@ Return nil if COMMAND is not found anywhere in `exec-path'." (locate-file command exec-path exec-suffixes 1)) (defun load-library (library) - "Load the library named LIBRARY. + "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'). -LIBRARY should be a relative file name of the library, a string. -It can omit the suffix (a.k.a. file-name extension). - -This is an interface to the function `load'." +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 @@ -1432,7 +1451,8 @@ expand wildcards (if any) and replace the file with multiple files." (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) @@ -1461,22 +1481,34 @@ killed." (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**") @@ -1504,8 +1536,8 @@ killed." (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)))))) (defun create-file-buffer (filename) @@ -1657,7 +1689,7 @@ When nil, never request confirmation." :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 @@ -1720,7 +1752,7 @@ the various files." (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) @@ -1941,7 +1973,7 @@ This function ensures that none of these modifications will take place." (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))) @@ -2094,7 +2126,7 @@ not set local variables (though we do notice a mode specified with -*-.) 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)) @@ -2147,13 +2179,14 @@ since only a single case-insensitive search through the alist is made." ("\\.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)) @@ -2219,7 +2252,7 @@ ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\)\\'" . archive-mode) ("\\.x[ms]l\\'" . xml-mode) ("\\.dtd\\'" . sgml-mode) ("\\.ds\\(ss\\)?l\\'" . dsssl-mode) - ("\\.js\\'" . java-mode) ; javascript-mode would be better + ("\\.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. @@ -2302,6 +2335,7 @@ appear in `auto-coding-alist' with `no-conversion' coding system. 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." @@ -2395,6 +2429,7 @@ If FUNCTION is nil, then it is not called. (That is a way of saying (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 (length (car elt)) (length (car dir-elt)))) (setq dir-elt elt))) - (if (and locals-file dir-elt) - (if (> (length (file-name-directory locals-file)) - (length (car dir-elt))) - locals-file - dir-elt) - (or locals-file dir-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. @@ -3319,22 +3378,20 @@ 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 FILE and then - ;; reload it whenever it changes. (insert-file-contents file) (let* ((dir-name (file-name-directory file)) (class-name (intern dir-name)) - (variables (read (current-buffer)))) + (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) + (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-dir-local-variables () "Read per-directory local variables for the current buffer. -Store the directory-local variables in `file-local-variables-alist', -without applying them." +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)))) @@ -3347,13 +3404,18 @@ without applying them." (setq dir-name (file-name-directory (buffer-file-name))) (setq class (dir-locals-read-from-file variables-file))) ((consp variables-file) - (setq dir-name (car variables-file)) - (setq class (cdr variables-file)))) + (setq dir-name (nth 0 variables-file)) + (setq class (nth 1 variables-file)))) (when class (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))))))) @@ -4329,7 +4391,7 @@ This requires the external program `diff' to be in your `exec-path'." 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) @@ -4342,6 +4404,7 @@ This requires the external program `diff' to be in your `exec-path'." 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.") @@ -4474,8 +4537,14 @@ Don't call it from programs! Use `insert-file-contents' instead. (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)) @@ -5254,12 +5323,14 @@ and `list-directory-verbose-switches'." "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)) @@ -5326,20 +5397,25 @@ fail. It returns also nil when DIR is a remote directory. 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)) @@ -5885,7 +5961,7 @@ If CHAR is in [Xugo], the value is taken from FROM (or 0 if omitted)." (defun file-modes-rights-to-number (rights who-mask &optional from) "Convert a symbolic mode string specification to an equivalent number. -RIGHTS is the symbolic mode spec, it should match \"([+=-][rwxXstugo]+)+\". +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 @@ -5913,7 +5989,7 @@ as in \"og+rX-w\"." (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) gives the mode bits on which to base permissions if @@ -5923,7 +5999,7 @@ as in \"og+rX-w\"." (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))))) @@ -5964,47 +6040,152 @@ based on existing mode bits, as in \"og+rX-w\"." ;; Trashcan handling. -(defcustom trash-directory (convert-standard-filename "~/.Trash") +(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) - (backup-directory-alist nil)) - (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)) - (let ((delete-by-moving-to-trash nil)) - (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))))))))) (define-key ctl-x-map "\C-f" 'find-file)