diff options
Diffstat (limited to 'lisp/files.el')
| -rw-r--r-- | lisp/files.el | 579 |
1 files changed, 420 insertions, 159 deletions
diff --git a/lisp/files.el b/lisp/files.el index a6fe381a50a..fbd00af479c 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -278,8 +278,7 @@ The value `never' means do not make them." :type '(choice (const :tag "Never" never) (const :tag "If existing" nil) (other :tag "Always" t)) - :group 'backup - :group 'vc) + :group 'backup) (put 'version-control 'safe-local-variable (lambda (x) (or (booleanp x) (equal x 'never)))) @@ -611,9 +610,7 @@ is a valid DOS file name, but c:/bar/c:/foo is not. This function's standard definition is trivial; it just returns the argument. However, on Windows and DOS, replace invalid characters. On DOS, make sure to obey the 8.3 limitations. -In the native Windows build, turn Cygwin names into native names, -and also turn slashes into backslashes if the shell requires it (see -`w32-shell-dos-semantics'). +In the native Windows build, turn Cygwin names into native names. See Info node `(elisp)Standard File Names' for more details." (cond @@ -1132,6 +1129,12 @@ consecutive checks. For example: :format "Do not use file name cache older then %v seconds" :value 10))) +(defun file-local-name (file) + "Return the local name component of FILE. +It returns a file name which can be used directly as argument of +`process-file', `start-file-process', or `shell-command'." + (or (file-remote-p file 'localname) file)) + (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 @@ -1216,7 +1219,7 @@ containing it, until no links are left at any level. (setq dirfile (directory-file-name dir)) ;; If these are equal, we have the (or a) root directory. (or (string= dir dirfile) - (and (memq system-type '(windows-nt ms-dos cygwin nacl)) + (and (file-name-case-insensitive-p dir) (eq (compare-strings dir 0 nil dirfile 0 nil t) t)) ;; If this is the same dir we last got the truename for, ;; save time--don't recalculate. @@ -1316,6 +1319,36 @@ Optional second argument FLAVOR controls the units and the display format: (car post-fixes)) (if (eq flavor 'iec) "iB" "")))) +(defcustom mounted-file-systems + (if (memq system-type '(windows-nt cygwin)) + "^//[^/]+/" + ;; regexp-opt.el is not dumped into emacs binary. + ;;(concat + ;; "^" (regexp-opt '("/afs/" "/media/" "/mnt" "/net/" "/tmp_mnt/")))) + "^\\(?:/\\(?:afs/\\|m\\(?:edia/\\|nt\\)\\|\\(?:ne\\|tmp_mn\\)t/\\)\\)") + "File systems which ought to be mounted." + :group 'files + :version "26.1" + :require 'regexp-opt + :type 'regexp) + +(defun temporary-file-directory () + "The directory for writing temporary files. +In case of a remote `default-directory', this is a directory for +temporary files on that remote host. If such a directory does +not exist, or `default-directory' ought to be located on a +mounted file system (see `mounted-file-systems'), the function +returns `default-directory'. +For a non-remote and non-mounted `default-directory', the value of +the variable `temporary-file-directory' is returned." + (let ((handler (find-file-name-handler + default-directory 'temporary-file-directory))) + (if handler + (funcall handler 'temporary-file-directory) + (if (string-match mounted-file-systems default-directory) + default-directory + temporary-file-directory)))) + (defun make-temp-file (prefix &optional dir-flag suffix) "Create a temporary file. The returned file name (created by appending some random characters at the end @@ -1352,6 +1385,21 @@ If SUFFIX is non-nil, add that at the end of the file name." nil) file))) +(defun make-nearby-temp-file (prefix &optional dir-flag suffix) + "Create a temporary file as close as possible to `default-directory'. +If PREFIX is a relative file name, and `default-directory' is a +remote file name or located on a mounted file systems, the +temporary file is created in the directory returned by the +function `temporary-file-directory'. Otherwise, the function +`make-temp-file' is used. PREFIX, DIR-FLAG and SUFFIX have the +same meaning as in `make-temp-file'." + (let ((handler (find-file-name-handler + default-directory 'make-nearby-temp-file))) + (if (and handler (not (file-name-absolute-p default-directory))) + (funcall handler 'make-nearby-temp-file prefix dir-flag suffix) + (let ((temporary-file-directory (temporary-file-directory))) + (make-temp-file prefix dir-flag suffix))))) + (defun recode-file-name (file coding new-coding &optional ok-if-already-exists) "Change the encoding of FILE's name from CODING to NEW-CODING. The value is a new name of FILE. @@ -1557,7 +1605,7 @@ file names with wildcards." (defun find-file--read-only (fun filename wildcards) (unless (or (and wildcards find-file-wildcards - (not (string-match "\\`/:" filename)) + (not (file-name-quoted-p filename)) (string-match "[[*?]" filename)) (file-exists-p filename)) (error "%s does not exist" filename)) @@ -1753,10 +1801,7 @@ home directory is a root directory) and removes automounter prefixes (substring filename (1- (match-end 0)))))) (setq filename (substring filename (1- (match-end 0))))) ;; 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)))) + (let ((case-fold-search (file-name-case-insensitive-p filename))) ;; If any elt of directory-abbrev-alist matches this name, ;; abbreviate accordingly. (dolist (dir-abbrev directory-abbrev-alist) @@ -1940,7 +1985,7 @@ the various files." (error "%s is a directory" filename)) (if (and wildcards find-file-wildcards - (not (string-match "\\`/:" filename)) + (not (file-name-quoted-p filename)) (string-match "[[*?]" filename)) (let ((files (condition-case nil (file-expand-wildcards filename t) @@ -2333,14 +2378,21 @@ 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) - (fundamental-mode) + (kill-all-local-variables) + (unless delay-mode-hooks + (run-hooks 'change-major-mode-after-body-hook + 'after-change-major-mode-hook)) (let ((enable-local-variables (or (not find-file) enable-local-variables))) ;; FIXME this is less efficient than it could be, since both ;; s-a-m and h-l-v may parse the same regions, looking for "mode:". (with-demoted-errors "File mode specification error: %s" (set-auto-mode)) - (with-demoted-errors "File local-variables error: %s" - (hack-local-variables))) + ;; `delay-mode-hooks' being non-nil will have prevented the major + ;; mode's call to `run-mode-hooks' from calling + ;; `hack-local-variables'. In that case, call it now. + (when delay-mode-hooks + (with-demoted-errors "File local-variables error: %s" + (hack-local-variables 'no-mode)))) ;; Turn font lock off and on, to make sure it takes account of ;; whatever file local variables are relevant to it. (when (and font-lock-mode @@ -2473,8 +2525,8 @@ 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\\|7z\\|\ -ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|7Z\\)\\'" . archive-mode) +arc\\|zip\\|lzh\\|lha\\|zoo\\|[jew]ar\\|xpi\\|rar\\|cbr\\|7z\\|\ +ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|CBR\\|7Z\\)\\'" . archive-mode) ("\\.oxt\\'" . archive-mode) ;(Open|Libre)Office extensions. ("\\.\\(deb\\|[oi]pk\\)\\'" . archive-mode) ; Debian/Opkg packages. ;; Mailer puts message to be edited in @@ -2866,7 +2918,9 @@ we don't actually set it to the same mode the buffer already has." (unless done (if buffer-file-name (let ((name buffer-file-name) - (remote-id (file-remote-p buffer-file-name))) + (remote-id (file-remote-p buffer-file-name)) + (case-insensitive-p (file-name-case-insensitive-p + buffer-file-name))) ;; Remove backup-suffixes from file name. (setq name (file-name-sans-versions name)) ;; Remove remote file name identification. @@ -2876,12 +2930,12 @@ we don't actually set it to the same mode the buffer already has." (while name ;; Find first matching alist entry. (setq mode - (if (memq system-type '(windows-nt cygwin)) - ;; System is case-insensitive. + (if case-insensitive-p + ;; Filesystem is case-insensitive. (let ((case-fold-search t)) (assoc-default name auto-mode-alist 'string-match)) - ;; System is case-sensitive. + ;; Filesystem is case-sensitive. (or ;; First match case-sensitively. (let ((case-fold-search nil)) @@ -3189,16 +3243,21 @@ n -- to ignore the local variables list.") (defconst hack-local-variable-regexp "[ \t]*\\([^][;\"'?()\\ \t\n]+\\)[ \t]*:[ \t]*") -(defun hack-local-variables-prop-line (&optional mode-only) +(defun hack-local-variables-prop-line (&optional handle-mode) "Return local variables specified in the -*- line. -Returns an alist of elements (VAR . VAL), where VAR is a variable -and VAL is the specified value. Ignores any specification for -`mode:' and `coding:' (which should have already been handled -by `set-auto-mode' and `set-auto-coding', respectively). -Return nil if the -*- line is malformed. - -If MODE-ONLY is non-nil, just returns the symbol specifying the -mode, if there is one, otherwise nil." +Usually returns an alist of elements (VAR . VAL), where VAR is a +variable and VAL is the specified value. Ignores any +specification for `coding:', and sometimes for `mode' (which +should have already been handled by `set-auto-coding' and +`set-auto-mode', respectively). Return nil if the -*- line is +malformed. + +If HANDLE-MODE is nil, we return the alist of all the local +variables in the line except `coding' as described above. If it +is neither nil nor t, we do the same, except that any settings of +`mode' and `coding' are ignored. If HANDLE-MODE is t, we ignore +all settings in the line except for `mode', which \(if present) we +return as the symbol specifying the mode." (catch 'malformed-line (save-excursion (goto-char (point-min)) @@ -3208,14 +3267,14 @@ mode, if there is one, otherwise nil." nil) ((looking-at "[ \t]*\\([^ \t\n\r:;]+\\)\\([ \t]*-\\*-\\)") ;; Simple form: "-*- MODENAME -*-". - (if mode-only + (if (eq handle-mode t) (intern (concat (match-string 1) "-mode")))) (t ;; Hairy form: '-*-' [ <variable> ':' <value> ';' ]* '-*-' ;; (last ";" is optional). - ;; If MODE-ONLY, just check for `mode'. + ;; If HANDLE-MODE is t, just check for `mode'. ;; Otherwise, parse the -*- line into the RESULT alist. - (while (not (or (and mode-only result) + (while (not (or (and (eq handle-mode t) result) (>= (point) end))) (unless (looking-at hack-local-variable-regexp) (message "Malformed mode-line: %S" @@ -3236,19 +3295,24 @@ mode, if there is one, otherwise nil." ;; That is inconsistent, but we're stuck with it. ;; The same can be said for `coding' in set-auto-coding. (keyname (downcase (symbol-name key)))) - (if mode-only - (and (equal keyname "mode") - (setq result - (intern (concat (downcase (symbol-name val)) - "-mode")))) - (or (equal keyname "coding") - (condition-case nil - (push (cons (cond ((eq key 'eval) 'eval) - ;; Downcase "Mode:". - ((equal keyname "mode") 'mode) - (t (indirect-variable key))) - val) result) - (error nil)))) + (cond + ((eq handle-mode t) + (and (equal keyname "mode") + (setq result + (intern (concat (downcase (symbol-name val)) + "-mode"))))) + ((equal keyname "coding")) + (t + (when (or (not handle-mode) + (not (equal keyname "mode"))) + (condition-case nil + (push (cons (cond ((eq key 'eval) 'eval) + ;; Downcase "Mode:". + ((equal keyname "mode") 'mode) + (t (indirect-variable key))) + val) + result) + (error nil))))) (skip-chars-forward " \t;"))) result)))))) @@ -3314,11 +3378,15 @@ DIR-NAME is the name of the associated directory. Otherwise it is nil." ;; TODO? Warn once per file rather than once per session? (defvar hack-local-variables--warned-lexical nil) -(defun hack-local-variables (&optional mode-only) +(defun hack-local-variables (&optional handle-mode) "Parse and put into effect this buffer's local variables spec. Uses `hack-local-variables-apply' to apply the variables. -If MODE-ONLY is non-nil, all we do is check whether a \"mode:\" +If HANDLE-MODE is nil, we apply all the specified local +variables. If HANDLE-MODE is neither nil nor t, we do the same, +except that any settings of `mode' are ignored. + +If HANDLE-MODE is t, all we do is check whether a \"mode:\" is specified, and return the corresponding mode symbol, or nil. In this case, we try to ignore minor-modes, and only return a major-mode. @@ -3336,7 +3404,7 @@ local variables, but directory-local variables may still be applied." (let ((enable-local-variables (and local-enable-local-variables enable-local-variables)) result) - (unless mode-only + (unless (eq handle-mode t) (setq file-local-variables-alist nil) (with-demoted-errors "Directory-local variables error: %s" ;; Note this is a no-op if enable-local-variables is nil. @@ -3344,18 +3412,19 @@ local variables, but directory-local variables may still be applied." ;; This entire function is basically a no-op if enable-local-variables ;; is nil. All it does is set file-local-variables-alist to nil. (when enable-local-variables - ;; This part used to ignore enable-local-variables when mode-only - ;; was non-nil. That was inappropriate, eg consider the + ;; This part used to ignore enable-local-variables when handle-mode + ;; was t. That was inappropriate, eg consider the ;; (artificial) example of: ;; (setq local-enable-local-variables nil) ;; Open a file foo.txt that contains "mode: sh". ;; It correctly opens in text-mode. ;; M-x set-visited-file name foo.c, and it incorrectly stays in text-mode. (unless (or (inhibit-local-variables-p) - ;; If MODE-ONLY is non-nil, and the prop line specifies a + ;; If HANDLE-MODE is t, and the prop line specifies a ;; mode, then we're done, and have no need to scan further. - (and (setq result (hack-local-variables-prop-line mode-only)) - mode-only)) + (and (setq result (hack-local-variables-prop-line + handle-mode)) + (eq handle-mode t))) ;; Look for "Local variables:" line in last page. (save-excursion (goto-char (point-max)) @@ -3410,7 +3479,7 @@ local variables, but directory-local variables may still be applied." (goto-char (point-min)) (while (not (or (eobp) - (and mode-only result))) + (and (eq handle-mode t) result))) ;; Find the variable name; (unless (looking-at hack-local-variable-regexp) (error "Malformed local variable line: %S" @@ -3427,7 +3496,7 @@ local variables, but directory-local variables may still be applied." (forward-char 1) (let ((read-circle nil)) (setq val (read (current-buffer)))) - (if mode-only + (if (eq handle-mode t) (and (eq var 'mode) ;; Specifying minor-modes via mode: is ;; deprecated, but try to reject them anyway. @@ -3449,6 +3518,7 @@ local variables, but directory-local variables may still be applied." ;; to use 'thisbuf's name in the ;; warning message. (or (buffer-file-name thisbuf) "")))))) + ((and (eq var 'mode) handle-mode)) (t (ignore-errors (push (cons (if (eq var 'eval) @@ -3457,8 +3527,8 @@ local variables, but directory-local variables may still be applied." val) result)))))) (forward-line 1)))))))) ;; Now we've read all the local variables. - ;; If MODE-ONLY is non-nil, return whether the mode was specified. - (if mode-only result + ;; If HANDLE-MODE is t, return whether the mode was specified. + (if (eq handle-mode t) result ;; Otherwise, set the variables. (hack-local-variables-filter result nil) (hack-local-variables-apply))))) @@ -3685,7 +3755,7 @@ Return the new variables list." (error ;; The file's content might be invalid (e.g. have a merge conflict), but ;; that shouldn't prevent the user from opening the file. - (message ".dir-locals error: %s" (error-message-string err)) + (message "%s error: %s" dir-locals-file (error-message-string err)) nil)))) (defun dir-locals-set-directory-class (directory class &optional mtime) @@ -3737,8 +3807,41 @@ VARIABLES list of the class. The list is processed in order. (defconst dir-locals-file ".dir-locals.el" "File that contains directory-local variables. -It has to be constant to enforce uniform values -across different environments and users.") +It has to be constant to enforce uniform values across different +environments and users. +See also `dir-locals-file-2', whose values override this one's. +See Info node `(elisp)Directory Local Variables' for details.") + +(defconst dir-locals-file-2 ".dir-locals-2.el" + "File that contains directory-local variables. +This essentially a second file that can be used like +`dir-locals-file', so that users can have specify their personal +dir-local variables even if the current directory already has a +`dir-locals-file' that is shared with other users (such as in a +git repository). +See Info node `(elisp)Directory Local Variables' for details.") + +(defun dir-locals--all-files (directory) + "Return a list of all readable dir-locals files in DIRECTORY. +The returned list is sorted by increasing priority. That is, +values specified in the last file should take precedence over +those in the first." + (when (file-readable-p directory) + (let* ((file-1 (expand-file-name (if (eq system-type 'ms-dos) + (dosified-file-name dir-locals-file) + dir-locals-file) + directory)) + (file-2 (when (string-match "\\.el\\'" file-1) + (replace-match "-2.el" t nil file-1))) + (out nil)) + ;; The order here is important. + (dolist (f (list file-2 file-1)) + (when (and f + (file-readable-p f) + (file-regular-p f) + (not (file-directory-p f))) + (push f out))) + out))) (defun dir-locals-find-file (file) "Find the directory-local variables for FILE. @@ -3753,78 +3856,95 @@ A cache entry based on a `dir-locals-file' is valid if the modification time stored in the cache matches the current file modification time. If not, the cache entry is cleared so that the file will be re-read. -This function returns either nil (no directory local variables found), -or the matching entry from `dir-locals-directory-cache' (a list), -or the full path to the `dir-locals-file' (a string) in the case -of no valid cache entry." +This function returns either: + - nil (no directory local variables found), + - the matching entry from `dir-locals-directory-cache' (a list), + - or the full path to the directory (a string) containing at + least one `dir-locals-file' in the case of no valid cache + entry." (setq file (expand-file-name file)) - (let* ((dir-locals-file-name - (if (eq system-type 'ms-dos) - (dosified-file-name dir-locals-file) - dir-locals-file)) - (locals-file (locate-dominating-file file dir-locals-file-name)) - (dir-elt nil)) + (let* ((locals-dir (locate-dominating-file (file-name-directory file) + #'dir-locals--all-files)) + dir-elt) ;; `locate-dominating-file' may have abbreviated the name. - (and locals-file - (setq locals-file (expand-file-name dir-locals-file-name locals-file))) - ;; Let dir-locals-read-from-file inform us via demoted-errors - ;; about unreadable files, etc. - ;; Maybe we'd want to keep searching though - that is - ;; a locate-dominating-file issue. -;;; (or (not (file-readable-p locals-file)) -;;; (not (file-regular-p locals-file))) -;;; (setq locals-file nil)) + (when locals-dir + (setq locals-dir (expand-file-name locals-dir))) ;; Find the best cached value in `dir-locals-directory-cache'. (dolist (elt dir-locals-directory-cache) (when (and (string-prefix-p (car elt) file - (memq system-type - '(windows-nt cygwin ms-dos))) - (> (length (car elt)) (length (car dir-elt)))) - (setq dir-elt elt))) + (memq system-type + '(windows-nt cygwin ms-dos))) + (> (length (car elt)) (length (car dir-elt)))) + (setq dir-elt elt))) (if (and dir-elt - (or (null locals-file) - (<= (length (file-name-directory locals-file)) - (length (car dir-elt))))) - ;; Found a potential cache entry. Check validity. - ;; A cache entry with no MTIME is assumed to always be valid - ;; (ie, set directly, not from a dir-locals file). - ;; Note, we don't bother to check that there is a matching class - ;; element in dir-locals-class-alist, since that's done by - ;; dir-locals-set-directory-class. - (if (or (null (nth 2 dir-elt)) - (let ((cached-file (expand-file-name dir-locals-file-name - (car dir-elt)))) - (and (file-readable-p cached-file) - (equal (nth 2 dir-elt) - (nth 5 (file-attributes cached-file)))))) - ;; This cache entry is OK. - dir-elt - ;; This cache entry is invalid; clear it. - (setq dir-locals-directory-cache - (delq dir-elt dir-locals-directory-cache)) - ;; Return the first existing dir-locals file. Might be the same - ;; as dir-elt's, might not (eg latter might have been deleted). - locals-file) + (or (null locals-dir) + (<= (length locals-dir) + (length (car dir-elt))))) + ;; Found a potential cache entry. Check validity. + ;; A cache entry with no MTIME is assumed to always be valid + ;; (ie, set directly, not from a dir-locals file). + ;; Note, we don't bother to check that there is a matching class + ;; element in dir-locals-class-alist, since that's done by + ;; dir-locals-set-directory-class. + (if (or (null (nth 2 dir-elt)) + (let ((cached-files (dir-locals--all-files (car dir-elt)))) + ;; The entry MTIME should match the most recent + ;; MTIME among matching files. + (and cached-files + (= (float-time (nth 2 dir-elt)) + (apply #'max (mapcar (lambda (f) + (float-time + (nth 5 (file-attributes f)))) + cached-files)))))) + ;; This cache entry is OK. + dir-elt + ;; This cache entry is invalid; clear it. + (setq dir-locals-directory-cache + (delq dir-elt dir-locals-directory-cache)) + ;; Return the first existing dir-locals file. Might be the same + ;; as dir-elt's, might not (eg latter might have been deleted). + locals-dir) ;; No cache entry. - locals-file))) - -(defun dir-locals-read-from-file (file) - "Load a variables FILE and register a new class and instance. -FILE is the name of the file holding the variables to apply. -The new class name is the same as the directory in which FILE -is found. Returns the new class name." - (with-temp-buffer + locals-dir))) + +(defun dir-locals-read-from-dir (dir) + "Load all variables files in DIR and register a new class and instance. +DIR is the absolute name of a directory which must contain at +least one dir-local file (which is a file holding variables to +apply). +Return the new class name, which is a symbol named DIR." + (require 'map) + (let* ((class-name (intern dir)) + (files (dir-locals--all-files dir)) + (read-circle nil) + (success nil) + (variables)) (with-demoted-errors "Error reading dir-locals: %S" - (insert-file-contents file) - (unless (zerop (buffer-size)) - (let* ((dir-name (file-name-directory file)) - (class-name (intern dir-name)) - (variables (let ((read-circle nil)) - (read (current-buffer))))) - (dir-locals-set-class-variables class-name variables) - (dir-locals-set-directory-class dir-name class-name - (nth 5 (file-attributes file))) - class-name))))) + (dolist (file files) + (with-temp-buffer + (insert-file-contents file) + (condition-case-unless-debug nil + (setq variables + (map-merge-with 'list (lambda (a b) (map-merge 'list a b)) + variables + (read (current-buffer)))) + (end-of-file nil)))) + (setq success t)) + (dir-locals-set-class-variables class-name variables) + (dir-locals-set-directory-class + dir class-name + (seconds-to-time + (if success + (apply #'max (mapcar (lambda (file) + (float-time (nth 5 (file-attributes file)))) + files)) + ;; If there was a problem, use the values we could get but + ;; don't let the cache prevent future reads. + 0))) + class-name)) + +(define-obsolete-function-alias 'dir-locals-read-from-file + 'dir-locals-read-from-dir "25.1") (defcustom enable-remote-dir-locals nil "Non-nil means dir-local variables will be applied to remote files." @@ -3847,17 +3967,17 @@ This does nothing if either `enable-local-variables' or (not (file-remote-p (or (buffer-file-name) default-directory))))) ;; Find the variables file. - (let ((variables-file (dir-locals-find-file - (or (buffer-file-name) default-directory))) + (let ((dir-or-cache (dir-locals-find-file + (or (buffer-file-name) default-directory))) (class nil) (dir-name nil)) (cond - ((stringp variables-file) - (setq dir-name (file-name-directory variables-file) - class (dir-locals-read-from-file variables-file))) - ((consp variables-file) - (setq dir-name (nth 0 variables-file)) - (setq class (nth 1 variables-file)))) + ((stringp dir-or-cache) + (setq dir-name dir-or-cache + class (dir-locals-read-from-dir dir-or-cache))) + ((consp dir-or-cache) + (setq dir-name (nth 0 dir-or-cache)) + (setq class (nth 1 dir-or-cache)))) (when class (let ((variables (dir-locals-collect-variables @@ -4235,8 +4355,7 @@ See also `file-name-version-regexp'." (defun file-ownership-preserved-p (file &optional group) "Return t if deleting FILE and rewriting it would preserve the owner. -Return nil if FILE does not exist, or if deleting and recreating it -might not preserve the owner. If GROUP is non-nil, check whether +Return also t if FILE does not exist. If GROUP is non-nil, check whether the group would be preserved too." (let ((handler (find-file-name-handler file 'file-ownership-preserved-p))) (if handler @@ -4359,7 +4478,7 @@ ignored." (defun normal-backup-enable-predicate (name) "Default `backup-enable-predicate' function. Checks for files in `temporary-file-directory', -`small-temporary-file-directory', and /tmp." +`small-temporary-file-directory', and \"/tmp\"." (let ((temporary-file-directory temporary-file-directory) caseless) ;; On MS-Windows, file-truename will convert short 8+3 aliases to @@ -4594,7 +4713,7 @@ on a DOS/Windows machine, it returns FILENAME in expanded form." (setq filename (expand-file-name filename)) (let ((fremote (file-remote-p filename)) (dremote (file-remote-p directory)) - (fold-case (or (memq system-type '(ms-dos cygwin windows-nt)) + (fold-case (or (file-name-case-insensitive-p filename) read-file-name-completion-ignore-case))) (if ;; Conditions for separate trees (or @@ -5239,14 +5358,24 @@ raised." "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*" "Regexp matching any file name except \".\" and \"..\".") +(defun files--force (no-such fn &rest args) + "Use NO-SUCH to affect behavior of function FN applied to list ARGS. +This acts like (apply FN ARGS) except it returns NO-SUCH if it is +non-nil and if FN fails due to a missing file or directory." + (condition-case err + (apply fn args) + (file-missing (or no-such (signal (car err) (cdr err)))))) + (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, delete files in DIRECTORY as well, with +no error if something else is simultaneously deleting them. 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." +When called interactively, TRASH is nil if and only if a prefix +argument is given, and a further prompt asks the user for +RECURSIVE if DIRECTORY is nonempty." (interactive (let* ((trashing (and delete-by-moving-to-trash (null current-prefix-arg))) @@ -5284,18 +5413,22 @@ given. With a prefix argument, TRASH is nil." (move-file-to-trash directory))) ;; Otherwise, call ourselves recursively if needed. (t - (if (and recursive (not (file-symlink-p directory))) - (mapc (lambda (file) - ;; This test is equivalent to - ;; (and (file-directory-p fn) (not (file-symlink-p fn))) - ;; but more efficient - (if (eq t (car (file-attributes 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))) - (delete-directory-internal directory))))) + (when (or (not recursive) (file-symlink-p directory) + (let* ((files + (files--force t #'directory-files directory 'full + directory-files-no-dot-files-regexp)) + (directory-exists (listp files))) + (when directory-exists + (mapc (lambda (file) + ;; This test is equivalent to but more efficient + ;; than (and (file-directory-p fn) + ;; (not (file-symlink-p fn))). + (if (eq t (car (file-attributes file))) + (delete-directory file recursive) + (files--force t #'delete-file file))) + files)) + directory-exists)) + (files--force recursive #'delete-directory-internal directory)))))) (defun file-equal-p (file1 file2) "Return non-nil if files FILE1 and FILE2 name the same file. @@ -6102,9 +6235,7 @@ default directory. However, if FULL is non-nil, they are absolute." ;; This can be more than one dir ;; if DIRPART contains wildcards. (dirs (if (and dirpart - (string-match "[[*?]" - (or (file-remote-p dirpart 'localname) - dirpart))) + (string-match "[[*?]" (file-local-name dirpart))) (mapcar 'file-name-as-directory (file-expand-wildcards (directory-file-name dirpart))) (list dirpart))) @@ -6640,11 +6771,14 @@ message to that effect instead of signaling an error." ;; Simulate the message printed by `ls'. (insert (format "%s: No such file or directory\n" file)))) -(defvar kill-emacs-query-functions nil +(defcustom kill-emacs-query-functions nil "Functions to call with no arguments to query about killing Emacs. If any of these functions returns nil, killing Emacs is canceled. `save-buffers-kill-emacs' calls these functions, but `kill-emacs', -the low level primitive, does not. See also `kill-emacs-hook'.") +the low level primitive, does not. See also `kill-emacs-hook'." + :type 'hook + :version "26.1" + :group 'convenience) (defcustom confirm-kill-emacs nil "How to ask for confirmation when leaving Emacs. @@ -6657,11 +6791,22 @@ be a predicate function; for example `yes-or-no-p'." :group 'convenience :version "21.1") +(defcustom confirm-kill-processes t + "Non-nil if Emacs should confirm killing processes on exit. +If this variable is nil, the value of +`process-query-on-exit-flag' is ignored. Otherwise, if there are +processes with a non-nil `process-query-on-exit-flag', Emacs will +prompt the user before killing them." + :type 'boolean + :group 'convenience + :version "26.1") + (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 without asking. If there are active processes where `process-query-on-exit-flag' -returns non-nil, asks whether processes should be killed. +returns non-nil and `confirm-kill-processes' is non-nil, +asks whether processes should be killed. Runs the members of `kill-emacs-query-functions' in turn and stops if any returns nil. If `confirm-kill-emacs' is non-nil, calls it." (interactive "P") @@ -6676,6 +6821,7 @@ if any returns nil. If `confirm-kill-emacs' is non-nil, calls it." (yes-or-no-p "Modified buffers exist; exit anyway? "))) (or (not (fboundp 'process-list)) ;; process-list is not defined on MSDOS. + (not confirm-kill-processes) (let ((processes (process-list)) active) (while processes @@ -6703,7 +6849,8 @@ if any returns nil. If `confirm-kill-emacs' is non-nil, calls it." (defun save-buffers-kill-terminal (&optional arg) "Offer to save each buffer, then kill the current connection. -If the current frame has no client, kill Emacs itself. +If the current frame has no client, kill Emacs itself using +`save-buffers-kill-emacs'. With prefix ARG, silently save all file-visiting buffers, then kill. @@ -6797,6 +6944,28 @@ only these files will be asked to be saved." (apply operation arguments))) (_ (apply operation arguments))))) + +(defsubst file-name-quoted-p (name) + "Whether NAME is quoted with prefix \"/:\". +If NAME is a remote file name, check the local part of NAME." + (string-prefix-p "/:" (file-local-name name))) + +(defsubst file-name-quote (name) + "Add the quotation prefix \"/:\" to file NAME. +If NAME is a remote file name, the local part of NAME is quoted. +If NAME is already a quoted file name, NAME is returned unchanged." + (if (file-name-quoted-p name) + name + (concat (file-remote-p name) "/:" (file-local-name name)))) + +(defsubst file-name-unquote (name) + "Remove quotation prefix \"/:\" from file NAME, if any. +If NAME is a remote file name, the local part of NAME is unquoted." + (let ((localname (file-local-name name))) + (when (file-name-quoted-p localname) + (setq + localname (if (= (length localname) 2) "/" (substring localname 2)))) + (concat (file-remote-p name) localname))) ;; Symbolic modes and read-file-modes. @@ -7060,6 +7229,98 @@ Otherwise, trash FILENAME using the freedesktop.org conventions, (let ((delete-by-moving-to-trash nil)) (rename-file fn new-fn))))))))) +(defsubst file-attribute-type (attributes) + "The type field in ATTRIBUTES returned by `file-attributes'. +The value is either t for directory, string (name linked to) for +symbolic link, or nil." + (nth 0 attributes)) + +(defsubst file-attribute-link-number (attributes) + "Return the number of links in ATTRIBUTES returned by `file-attributes'." + (nth 1 attributes)) + +(defsubst file-attribute-user-id (attributes) + "The UID field in ATTRIBUTES returned by `file-attributes'. +This is either a string or a number. If a string value cannot be +looked up, a numeric value, either an integer or a float, is +returned." + (nth 2 attributes)) + +(defsubst file-attribute-group-id (attributes) + "The GID field in ATTRIBUTES returned by `file-attributes'. +This is either a string or a number. If a string value cannot be +looked up, a numeric value, either an integer or a float, is +returned." + (nth 3 attributes)) + +(defsubst file-attribute-access-time (attributes) + "The last access time in ATTRIBUTES returned by `file-attributes'. +This a list of integers (HIGH LOW USEC PSEC) in the same style +as (current-time)." + (nth 4 attributes)) + +(defsubst file-attribute-modification-time (attributes) + "The modification time in ATTRIBUTES returned by `file-attributes'. +This is the time of the last change to the file's contents, and +is a list of integers (HIGH LOW USEC PSEC) in the same style +as (current-time)." + (nth 5 attributes)) + +(defsubst file-attribute-status-change-time (attributes) + "The status modification time in ATTRIBUTES returned by `file-attributes'. +This is the time of last change to the file's attributes: owner +and group, access mode bits, etc, and is a list of integers (HIGH +LOW USEC PSEC) in the same style as (current-time)." + (nth 6 attributes)) + +(defsubst file-attribute-size (attributes) + "The size (in bytes) in ATTRIBUTES returned by `file-attributes'. +This is a floating point number if the size is too large for an integer." + (nth 7 attributes)) + +(defsubst file-attribute-modes (attributes) + "The file modes in ATTRIBUTES returned by `file-attributes'. +This is a string of ten letters or dashes as in ls -l." + (nth 8 attributes)) + +(defsubst file-attribute-inode-number (attributes) + "The inode number in ATTRIBUTES returned by `file-attributes'. +If it is larger than what an Emacs integer can hold, this is of +the form (HIGH . LOW): first the high bits, then the low 16 bits. +If even HIGH is too large for an Emacs integer, this is instead +of the form (HIGH MIDDLE . LOW): first the high bits, then the +middle 24 bits, and finally the low 16 bits." + (nth 10 attributes)) + +(defsubst file-attribute-device-number (attributes) + "The file system device number in ATTRIBUTES returned by `file-attributes'. +If it is larger than what an Emacs integer can hold, this is of +the form (HIGH . LOW): first the high bits, then the low 16 bits. +If even HIGH is too large for an Emacs integer, this is instead +of the form (HIGH MIDDLE . LOW): first the high bits, then the +middle 24 bits, and finally the low 16 bits." + (nth 11 attributes)) + +(defun file-attribute-collect (attributes &rest attr-names) + "Return a sublist of ATTRIBUTES returned by `file-attributes'. +ATTR-NAMES are symbols with the selected attribute names. + +Valid attribute names are: type, link-number, user-id, group-id, +access-time, modification-time, status-change-time, size, modes, +inode-number and device-number." + (let ((all '(type link-number user-id group-id access-time + modification-time status-change-time + size modes inode-number device-number)) + result) + (while attr-names + (let ((attr (pop attr-names))) + (if (memq attr all) + (push (funcall + (intern (format "file-attribute-%s" (symbol-name attr))) + attributes) + result) + (error "Wrong attribute name '%S'" attr)))) + (nreverse result))) (define-key ctl-x-map "\C-f" 'find-file) (define-key ctl-x-map "\C-r" 'find-file-read-only) |