diff options
Diffstat (limited to 'lisp/files.el')
| -rw-r--r-- | lisp/files.el | 364 |
1 files changed, 228 insertions, 136 deletions
diff --git a/lisp/files.el b/lisp/files.el index 4901c3872cd..3b130a20d2b 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -1,10 +1,11 @@ ;;; files.el --- file input and output commands for Emacs ;; Copyright (C) 1985, 1986, 1987, 1992, 1993, 1994, 1995, 1996, -;; 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, -;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, +;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Maintainer: FSF +;; Package: emacs ;; This file is part of GNU Emacs. @@ -188,17 +189,6 @@ If the buffer is visiting a new file, the value is nil.") "Non-nil if visited file was read-only when visited.") (make-variable-buffer-local 'buffer-file-read-only) -(defcustom temporary-file-directory - (file-name-as-directory - (cond ((memq system-type '(ms-dos windows-nt)) - (or (getenv "TEMP") (getenv "TMPDIR") (getenv "TMP") "c:/temp")) - (t - (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 (if (eq system-type 'ms-dos) (getenv "TMPDIR")) "The directory for writing small temporary files. @@ -575,6 +565,9 @@ Runs the usual ange-ftp hook, but only for completion operations." (inhibit-file-name-operation op)) (apply op args)))) +(declare-function dos-convert-standard-filename "dos-fns.el" (filename)) +(declare-function w32-convert-standard-filename "w32-fns.el" (filename)) + (defun convert-standard-filename (filename) "Convert a standard file's name to something suitable for the OS. This means to guarantee valid names and perhaps to canonicalize @@ -592,15 +585,20 @@ and also turn slashes into backslashes if the shell requires it (see `w32-shell-dos-semantics'). See Info node `(elisp)Standard File Names' for more details." - (if (eq system-type 'cygwin) - (let ((name (copy-sequence filename)) - (start 0)) - ;; Replace invalid filename characters with ! - (while (string-match "[?*:<>|\"\000-\037]" name start) - (aset name (match-beginning 0) ?!) - (setq start (match-end 0))) - name) - filename)) + (cond + ((eq system-type 'cygwin) + (let ((name (copy-sequence filename)) + (start 0)) + ;; Replace invalid filename characters with ! + (while (string-match "[?*:<>|\"\000-\037]" name start) + (aset name (match-beginning 0) ?!) + (setq start (match-end 0))) + name)) + ((eq system-type 'windows-nt) + (w32-convert-standard-filename filename)) + ((eq system-type 'ms-dos) + (dos-convert-standard-filename filename)) + (t filename))) (defun read-directory-name (prompt &optional dir default-dirname mustmatch initial) "Read directory name, prompting with PROMPT and completing in directory DIR. @@ -750,21 +748,45 @@ one or more of those symbols." (let ((x (file-name-directory suffix))) (if x (1- (length x)) (length suffix)))))) (t - (let ((names nil) + (let ((names '()) + ;; If we have files like "foo.el" and "foo.elc", we could load one of + ;; them with "foo.el", "foo.elc", or "foo", where just "foo" is the + ;; preferred way. So if we list all 3, that gives a lot of redundant + ;; entries for the poor soul looking just for "foo". OTOH, sometimes + ;; the user does want to pay attention to the extension. We try to + ;; diffuse this tension by stripping the suffix, except when the + ;; result is a single element (i.e. usually we only list "foo" unless + ;; it's the only remaining element in the list, in which case we do + ;; list "foo", "foo.elc" and "foo.el"). + (fullnames '()) (suffix (concat (regexp-opt suffixes t) "\\'")) (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 - string-file dir)) - (push file names) - (when (string-match suffix file) - (setq file (substring file 0 (match-beginning 0))) - (push file names))))) + (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 + string-file dir)) + (if (not (string-match suffix file)) + (push file names) + (push file fullnames) + (push (substring file 0 (match-beginning 0)) names))))) + ;; Switching from names to names+fullnames creates a non-monotonicity + ;; which can cause problems with things like partial-completion. + ;; To minimize the problem, filter out completion-regexp-list, so that + ;; M-x load-library RET t/x.e TAB finds some files. Also remove elements + ;; from `names' which only matched `string' when they still had + ;; their suffix. + (setq names (all-completions string names)) + ;; Remove duplicates of the first element, so that we can easily check + ;; if `names' really only contains a single element. + (when (cdr names) (setcdr names (delete (car names) (cdr names)))) + (unless (cdr names) + ;; There's no more than one matching non-suffixed element, so expand + ;; the list by adding the suffixed elements as well. + (setq names (nconc names fullnames))) (completion-table-with-context string-dir names string-file pred action))))) @@ -903,6 +925,36 @@ to that remote system. (funcall handler 'file-remote-p file identification connected) nil))) +(defcustom remote-file-name-inhibit-cache 10 + "Whether to use the remote file-name cache for read access. + +When `nil', always use the cached values. +When `t', never use them. +A number means use them for that amount of seconds since they were +cached. + +File attributes of remote files are cached for better performance. +If they are changed out of Emacs' control, the cached values +become invalid, and must be invalidated. + +In case a remote file is checked regularly, it might be +reasonable to let-bind this variable to a value less then the +time period between two checks. +Example: + + \(defun display-time-file-nonempty-p \(file) + \(let \(\(remote-file-name-inhibit-cache \(- display-time-interval 5))) + \(and \(file-exists-p file) + \(< 0 \(nth 7 \(file-attributes \(file-chase-links file)))))))" + :group 'files + :version "24.1" + :type `(choice + (const :tag "Do not inhibit file name cache" nil) + (const :tag "Do not use file name cache" t) + (integer :tag "Do not use file name cache" + :format "Do not use file name cache older then %v seconds" + :value 10))) + (defun file-local-copy (file) "Copy the file FILE into a temporary file on this machine. Returns the name of the local copy, or nil, if FILE is directly @@ -2160,7 +2212,7 @@ in that case, this function acts as if `enable-local-variables' were t." (if (fboundp 'ucs-set-table-for-input) ; don't lose when building (ucs-set-table-for-input))) -(defcustom auto-mode-case-fold nil +(defcustom auto-mode-case-fold t "Non-nil means to try second pass through `auto-mode-alist'. This means that if the first case-sensitive search through the alist fails to find a matching major mode, a second case-insensitive search is made. @@ -2180,6 +2232,15 @@ since only a single case-insensitive search through the alist is made." (cons (purecopy (car elt)) (cdr elt))) `(;; do this first, so that .html.pl is Polish html, not Perl ("\\.s?html?\\(\\.[a-zA-Z_]+\\)?\\'" . html-mode) + ("\\.svgz?\\'" . image-mode) + ("\\.svgz?\\'" . xml-mode) + ("\\.x[bp]m\\'" . image-mode) + ("\\.x[bp]m\\'" . c-mode) + ("\\.p[bpgn]m\\'" . image-mode) + ("\\.tiff?\\'" . image-mode) + ("\\.gif\\'" . image-mode) + ("\\.png\\'" . image-mode) + ("\\.jpe?g\\'" . image-mode) ("\\.te?xt\\'" . text-mode) ("\\.[tT]e[xX]\\'" . tex-mode) ("\\.ins\\'" . tex-mode) ;Installation files for TeX packages. @@ -2215,6 +2276,14 @@ since only a single case-insensitive search through the alist is made." ("\\.te?xi\\'" . texinfo-mode) ("\\.[sS]\\'" . asm-mode) ("\\.asm\\'" . asm-mode) + ("\\.css\\'" . css-mode) + ("\\.mixal\\'" . mixal-mode) + ("\\.gcov\\'" . compilation-mode) + ;; Besides .gdbinit, gdb documents other names to be usable for init + ;; files, cross-debuggers can use something like + ;; .PROCESSORNAME-gdbinit so that the host and target gdbinit files + ;; don't interfere with each other. + ("/\\.[a-z0-9-]*gdbinit" . gdb-script-mode) ("[cC]hange\\.?[lL]og?\\'" . change-log-mode) ("[cC]hange[lL]og[-.][0-9]+\\'" . change-log-mode) ("\\$CHANGE_LOG\\$\\.TXT" . change-log-mode) @@ -2231,6 +2300,7 @@ since only a single case-insensitive search through the alist is made." ("\\.cl[so]\\'" . latex-mode) ;LaTeX 2e class option ("\\.bbl\\'" . latex-mode) ("\\.bib\\'" . bibtex-mode) + ("\\.bst\\'" . bibtex-style-mode) ("\\.sql\\'" . sql-mode) ("\\.m[4c]\\'" . m4-mode) ("\\.mf\\'" . metafont-mode) @@ -2253,15 +2323,14 @@ since only a single case-insensitive search through the alist is made." ;; The list of archive file extensions should be in sync with ;; `auto-coding-alist' with `no-conversion' coding system. ("\\.\\(\ -arc\\|zip\\|lzh\\|lha\\|zoo\\|[jew]ar\\|xpi\\|rar\\|\ -ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\)\\'" . archive-mode) +arc\\|zip\\|lzh\\|lha\\|zoo\\|[jew]ar\\|xpi\\|rar\\|7z\\|\ +ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|7Z\\)\\'" . archive-mode) ("\\.\\(sx[dmicw]\\|od[fgpst]\\|oxt\\)\\'" . archive-mode) ;OpenOffice.org ("\\.\\(deb\\|[oi]pk\\)\\'" . archive-mode) ; Debian/Opkg packages. ;; Mailer puts message to be edited in ;; /tmp/Re.... or Message ("\\`/tmp/Re" . text-mode) ("/Message[0-9]*\\'" . text-mode) - ("\\.zone\\'" . zone-mode) ;; some news reader is reported to use this ("\\`/tmp/fol/" . text-mode) ("\\.oak\\'" . scheme-mode) @@ -2280,6 +2349,20 @@ ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\)\\'" . archive-mode) ("[:/]_emacs\\'" . emacs-lisp-mode) ("/crontab\\.X*[0-9]+\\'" . shell-script-mode) ("\\.ml\\'" . lisp-mode) + ;; Linux-2.6.9 uses some different suffix for linker scripts: + ;; "ld", "lds", "lds.S", "lds.in", "ld.script", and "ld.script.balo". + ;; eCos uses "ld" and "ldi". Netbsd uses "ldscript.*". + ("\\.ld[si]?\\'" . ld-script-mode) + ("ld\\.?script\\'" . ld-script-mode) + ;; .xs is also used for ld scripts, but seems to be more commonly + ;; associated with Perl .xs files (C with Perl bindings). (Bug#7071) + ("\\.xs\\'" . c-mode) + ;; Explained in binutils ld/genscripts.sh. Eg: + ;; A .x script file is the default script. + ;; A .xr script is for linking without relocation (-r flag). Etc. + ("\\.x[abdsru]?[cnw]?\\'" . ld-script-mode) + ("\\.zone\\'" . dns-mode) + ("\\.soa\\'" . dns-mode) ;; Common Lisp ASDF package system. ("\\.asd\\'" . lisp-mode) ("\\.\\(asn\\|mib\\|smi\\)\\'" . snmp-mode) @@ -2295,7 +2378,6 @@ ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\)\\'" . archive-mode) ("#\\*mail\\*" . mail-mode) ("\\.g\\'" . antlr-mode) ("\\.ses\\'" . ses-mode) - ("\\.\\(soa\\|zone\\)\\'" . dns-mode) ("\\.docbook\\'" . sgml-mode) ("\\.com\\'" . dcl-mode) ("/config\\.\\(?:bat\\|log\\)\\'" . fundamental-mode) @@ -2405,7 +2487,8 @@ and `magic-mode-alist', which determines modes based on file contents.") ("pg" . text-mode) ("make" . makefile-gmake-mode) ; Debian uses this ("guile" . scheme-mode) - ("clisp" . lisp-mode))) + ("clisp" . lisp-mode) + ("emacs" . emacs-lisp-mode))) "Alist mapping interpreter names to major modes. This is used for files whose first lines match `auto-mode-interpreter-regexp'. Each element looks like (INTERPRETER . MODE). @@ -2768,15 +2851,19 @@ asking you for confirmation." (mapc (lambda (pair) (put (car pair) 'safe-local-variable (cdr pair))) - '((buffer-read-only . booleanp) ;; C source code - (default-directory . stringp) ;; C source code - (fill-column . integerp) ;; C source code - (indent-tabs-mode . booleanp) ;; C source code - (left-margin . integerp) ;; C source code - (no-update-autoloads . booleanp) - (tab-width . integerp) ;; C source code - (truncate-lines . booleanp) ;; C source code - (word-wrap . booleanp))) ;; C source code + '((buffer-read-only . booleanp) ;; C source code + (default-directory . stringp) ;; C source code + (fill-column . integerp) ;; C source code + (indent-tabs-mode . booleanp) ;; C source code + (left-margin . integerp) ;; C source code + (no-update-autoloads . booleanp) + (tab-width . integerp) ;; C source code + (truncate-lines . booleanp) ;; C source code + (word-wrap . booleanp) ;; C source code + (bidi-display-reordering . booleanp))) ;; C source code + +(put 'bidi-paragraph-direction 'safe-local-variable + (lambda (v) (memq v '(nil right-to-left left-to-right)))) (put 'c-set-style 'safe-local-eval-function t) @@ -3114,14 +3201,17 @@ is specified, returning t if it is specified." ;; Otherwise, set the variables. (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) - (dolist (elt file-local-variables-alist) - (hack-one-local-variable (car elt) (cdr elt)))) - (run-hooks 'hack-local-variables-hook))))) + (hack-local-variables-apply))))) + +(defun hack-local-variables-apply () + (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) + (dolist (elt file-local-variables-alist) + (hack-one-local-variable (car elt) (cdr elt)))) + (run-hooks 'hack-local-variables-hook)) (defun safe-local-variable-p (sym val) "Non-nil if SYM is safe as a file-local variable with value VAL. @@ -3418,15 +3508,14 @@ is found. Returns the new class name." 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)))) + (not (file-remote-p (or (buffer-file-name) default-directory)))) ;; Find the variables file. - (let ((variables-file (dir-locals-find-file (buffer-file-name))) + (let ((variables-file (dir-locals-find-file (or (buffer-file-name) default-directory))) (class nil) (dir-name nil)) (cond ((stringp variables-file) - (setq dir-name (file-name-directory (buffer-file-name))) + (setq dir-name (if (buffer-file-name) (file-name-directory (buffer-file-name)) default-directory)) (setq class (dir-locals-read-from-file variables-file))) ((consp variables-file) (setq dir-name (nth 0 variables-file)) @@ -3443,6 +3532,10 @@ and `file-local-variables-alist', without applying them." (push elt dir-local-variables-alist)) (hack-local-variables-filter variables dir-name))))))) +(defun hack-dir-local-variables-non-file-buffer () + (hack-dir-local-variables) + (hack-local-variables-apply)) + (defcustom change-major-mode-with-file-name t "Non-nil means \\[write-file] should set the major mode from the file name. @@ -3622,10 +3715,13 @@ variable `make-backup-files'. If it's done by renaming, then the file is no longer accessible under its old name. The value is non-nil after a backup was made by renaming. -It has the form (MODES . BACKUPNAME). +It has the form (MODES SELINUXCONTEXT BACKUPNAME). MODES is the result of `file-modes' on the original file; this means that the caller, after saving the buffer, should change the modes of the new file to agree with the old modes. +SELINUXCONTEXT is the result of `file-selinux-context' on the original +file; this means that the caller, after saving the buffer, should change +the SELinux context of the new file to agree with the old context. BACKUPNAME is the backup file name, which is the old file renamed." (if (and make-backup-files (not backup-inhibited) (not buffer-backed-up) @@ -3653,7 +3749,8 @@ BACKUPNAME is the backup file name, which is the old file renamed." (or delete-old-versions (y-or-n-p (format "Delete excess backup versions of %s? " real-file-name))))) - (modes (file-modes buffer-file-name))) + (modes (file-modes buffer-file-name)) + (context (file-selinux-context buffer-file-name))) ;; Actually write the back up file. (condition-case () (if (or file-precious-flag @@ -3673,10 +3770,10 @@ BACKUPNAME is the backup file name, which is the old file renamed." (<= (nth 2 attr) backup-by-copying-when-privileged-mismatch))) (or (nth 9 attr) (not (file-ownership-preserved-p real-file-name))))))) - (backup-buffer-copy real-file-name backupname modes) + (backup-buffer-copy real-file-name backupname modes context) ;; rename-file should delete old backup. (rename-file real-file-name backupname t) - (setq setmodes (cons modes backupname))) + (setq setmodes (list modes context backupname))) (file-error ;; If trouble writing the backup, write it in ~. (setq backupname (expand-file-name @@ -3685,7 +3782,7 @@ BACKUPNAME is the backup file name, which is the old file renamed." (message "Cannot write backup file; backing up in %s" backupname) (sleep-for 1) - (backup-buffer-copy real-file-name backupname modes))) + (backup-buffer-copy real-file-name backupname modes context))) (setq buffer-backed-up t) ;; Now delete the old versions, if desired. (if delete-old-versions @@ -3697,7 +3794,7 @@ BACKUPNAME is the backup file name, which is the old file renamed." setmodes) (file-error nil)))))) -(defun backup-buffer-copy (from-name to-name modes) +(defun backup-buffer-copy (from-name to-name modes context) (let ((umask (default-file-modes))) (unwind-protect (progn @@ -3724,7 +3821,9 @@ BACKUPNAME is the backup file name, which is the old file renamed." ;; Reset the umask. (set-default-file-modes umask))) (and modes - (set-file-modes to-name (logand modes #o1777)))) + (set-file-modes to-name (logand modes #o1777))) + (and context + (set-file-selinux-context to-name context))) (defun file-name-sans-versions (name &optional keep-backup-version) "Return file NAME sans backup versions or strings. @@ -4254,7 +4353,9 @@ Before and after saving the buffer, this function runs (nthcdr 10 (file-attributes buffer-file-name))) (if setmodes (condition-case () - (set-file-modes buffer-file-name (car setmodes)) + (progn + (set-file-modes buffer-file-name (car setmodes)) + (set-file-selinux-context buffer-file-name (nth 1 setmodes))) (error nil)))) ;; If the auto-save file was recent before this command, ;; delete it now. @@ -4267,7 +4368,7 @@ Before and after saving the buffer, this function runs ;; This does the "real job" of writing a buffer into its visited file ;; and making a backup file. This is what is normally done ;; but inhibited if one of write-file-functions returns non-nil. -;; It returns a value (MODES . BACKUPNAME), like backup-buffer. +;; It returns a value (MODES SELINUXCONTEXT BACKUPNAME), like backup-buffer. (defun basic-save-buffer-1 () (prog1 (if save-buffer-coding-system @@ -4279,7 +4380,7 @@ Before and after saving the buffer, this function runs (setq buffer-file-coding-system-explicit (cons last-coding-system-used nil))))) -;; This returns a value (MODES . BACKUPNAME), like backup-buffer. +;; This returns a value (MODES SELINUXCONTEXT BACKUPNAME), like backup-buffer. (defun basic-save-buffer-2 () (let (tempsetmodes setmodes) (if (not (file-writable-p buffer-file-name)) @@ -4350,8 +4451,9 @@ Before and after saving the buffer, this function runs ;; Since we have created an entirely new file, ;; make sure it gets the right permission bits set. (setq setmodes (or setmodes - (cons (or (file-modes buffer-file-name) + (list (or (file-modes buffer-file-name) (logand ?\666 umask)) + (file-selinux-context buffer-file-name) buffer-file-name))) ;; We succeeded in writing the temp file, ;; so rename it. @@ -4362,8 +4464,11 @@ Before and after saving the buffer, this function runs ;; (setmodes is set) because that says we're superseding. (cond ((and tempsetmodes (not setmodes)) ;; Change the mode back, after writing. - (setq setmodes (cons (file-modes buffer-file-name) buffer-file-name)) - (set-file-modes buffer-file-name (logior (car setmodes) 128)))) + (setq setmodes (list (file-modes buffer-file-name) + (file-selinux-context buffer-file-name) + buffer-file-name)) + (set-file-modes buffer-file-name (logior (car setmodes) 128)) + (set-file-selinux-context buffer-file-name (nth 1 setmodes))))) (let (success) (unwind-protect (progn @@ -4377,8 +4482,8 @@ Before and after saving the buffer, this function runs ;; the backup by renaming, undo the backing-up. (and setmodes (not success) (progn - (rename-file (cdr setmodes) buffer-file-name t) - (setq buffer-backed-up nil))))))) + (rename-file (nth 2 setmodes) buffer-file-name t) + (setq buffer-backed-up nil)))))) setmodes)) (defun diff-buffer-with-file (&optional buffer) @@ -4614,16 +4719,17 @@ or multiple mail buffers, etc." (force-mode-line-update)))) (defun make-directory (dir &optional parents) - "Create the directory DIR and any nonexistent parent dirs. -If DIR already exists as a directory, signal an error, unless PARENTS is set. + "Create the directory DIR and optionally any nonexistent parent dirs. +If DIR already exists as a directory, signal an error, unless +PARENTS is non-nil. -Interactively, the default choice of directory to create -is the current default directory for file names. -That is useful when you have visited a file in a nonexistent directory. +Interactively, the default choice of directory to create is the +current buffer's default directory. That is useful when you have +visited a file in a nonexistent directory. -Noninteractively, the second (optional) argument PARENTS says whether -to create parent directories if they don't exist. Interactively, -this happens by default." +Noninteractively, the second (optional) argument PARENTS, if +non-nil, says whether to create parent directories that don't +exist. Interactively, this happens by default." (interactive (list (read-file-name "Make directory: " default-directory default-directory nil nil) @@ -4654,19 +4760,30 @@ this happens by default." "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*" "Regexp matching any file name except \".\" and \"..\".") -(defun delete-directory (directory &optional recursive) +(defun delete-directory (directory &optional recursive trash) "Delete the directory named DIRECTORY. Does not follow symlinks. -If RECURSIVE is non-nil, all files in DIRECTORY are deleted as well." +If RECURSIVE is non-nil, all files in DIRECTORY are deleted as well. +TRASH non-nil means to trash the directory instead, provided +`delete-by-moving-to-trash' is non-nil. + +When called interactively, TRASH is t if no prefix argument is +given. With a prefix argument, TRASH is nil." (interactive - (let ((dir (expand-file-name - (read-file-name - "Delete directory: " - default-directory default-directory nil nil)))) + (let* ((trashing (and delete-by-moving-to-trash + (null current-prefix-arg))) + (dir (expand-file-name + (read-file-name + (if trashing + "Move directory to trash: " + "Delete directory: ") + default-directory default-directory nil nil)))) (list dir (if (directory-files dir nil directory-files-no-dot-files-regexp) (y-or-n-p - (format "Directory `%s' is not empty, really delete? " dir)) - nil)))) + (format "Directory `%s' is not empty, really %s? " + dir (if trashing "trash" "delete"))) + nil) + (null current-prefix-arg)))) ;; If default-directory is a remote directory, make sure we find its ;; delete-directory handler. (setq directory (directory-file-name (expand-file-name directory))) @@ -4674,7 +4791,7 @@ If RECURSIVE is non-nil, all files in DIRECTORY are deleted as well." (cond (handler (funcall handler 'delete-directory directory recursive)) - (delete-by-moving-to-trash + ((and delete-by-moving-to-trash trash) ;; Only move non-empty dir to trash if recursive deletion was ;; requested. This mimics the non-`delete-by-moving-to-trash' ;; case, where the operation fails in delete-directory-internal. @@ -4694,8 +4811,8 @@ If RECURSIVE is non-nil, all files in DIRECTORY are deleted as well." ;; (and (file-directory-p fn) (not (file-symlink-p fn))) ;; but more efficient (if (eq t (car (file-attributes file))) - (delete-directory file recursive) - (delete-file file))) + (delete-directory file recursive nil) + (delete-file file nil))) ;; We do not want to delete "." and "..". (directory-files directory 'full directory-files-no-dot-files-regexp))) @@ -5139,30 +5256,6 @@ The optional second argument indicates whether to kill internal buffers too." (kill-buffer-ask buffer))))) -(defun auto-save-mode (arg) - "Toggle auto-saving of contents of current buffer. -With prefix argument ARG, turn auto-saving on if positive, else off." - (interactive "P") - (setq buffer-auto-save-file-name - (and (if (null arg) - (or (not buffer-auto-save-file-name) - ;; If auto-save is off because buffer has shrunk, - ;; then toggling should turn it on. - (< buffer-saved-size 0)) - (or (eq arg t) (listp arg) (and (integerp arg) (> arg 0)))) - (if (and buffer-file-name auto-save-visited-file-name - (not buffer-read-only)) - buffer-file-name - (make-auto-save-file-name)))) - ;; If -1 was stored here, to temporarily turn off saving, - ;; turn it back on. - (and (< buffer-saved-size 0) - (setq buffer-saved-size 0)) - (if (called-interactively-p 'interactive) - (message "Auto-save %s (in this buffer)" - (if buffer-auto-save-file-name "on" "off"))) - buffer-auto-save-file-name) - (defun rename-auto-save-file () "Adjust current buffer's auto save file name for current conditions. Also rename any existing auto save file, if it was made in this session." @@ -5526,12 +5619,14 @@ preference to the program given by this variable." (defun get-free-disk-space (dir) "Return the amount of free space on directory DIR's file system. -The result is a string that gives the number of free 1KB blocks, -or nil if the system call or the program which retrieve the information -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." +The return value is a string describing the amount of free +space (normally, the number of free 1KB blocks). + +This function calls `file-system-info' if it is available, or +invokes the program specified by `directory-free-space-program' +and `directory-free-space-args'. If the system call or program +is unsuccessful, or if DIR is a remote directory, this function +returns nil." (unless (file-remote-p dir) ;; Try to find the number of free blocks. Non-Posix systems don't ;; always have df, but might have an equivalent system call. @@ -5551,19 +5646,17 @@ program specified by `directory-free-space-program' if that is non-nil." directory-free-space-args dir) 0))) - ;; Usual format is a header line followed by a line of - ;; numbers. + ;; Assume that the "available" column is before the + ;; "capacity" column. Find the "%" and scan backward. (goto-char (point-min)) (forward-line 1) - (if (not (eobp)) - (progn - ;; Move to the end of the "available blocks" number. - (skip-chars-forward "^ \t") - (forward-word 3) - ;; Copy it into AVAILABLE. - (let ((end (point))) - (forward-word -1) - (buffer-substring (point) end)))))))))) + (when (re-search-forward + "[[:space:]]+[^[:space:]]+%[^%]*$" + (line-end-position) t) + (goto-char (match-beginning 0)) + (let ((endpt (point))) + (skip-chars-backward "^[:space:]") + (buffer-substring-no-properties (point) endpt))))))))) ;; The following expression replaces `dired-move-to-filename-regexp'. (defvar directory-listing-before-filename-regexp @@ -6355,5 +6448,4 @@ Otherwise, trash FILENAME using the freedesktop.org conventions, (define-key ctl-x-5-map "r" 'find-file-read-only-other-frame) (define-key ctl-x-5-map "\C-o" 'display-buffer-other-frame) -;; arch-tag: bc68d3ea-19ca-468b-aac6-3a4a7766101f ;;; files.el ends here |