diff options
Diffstat (limited to 'lisp/files.el')
| -rw-r--r-- | lisp/files.el | 1161 |
1 files changed, 707 insertions, 454 deletions
diff --git a/lisp/files.el b/lisp/files.el index 5536af014f6..20d63d33fef 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -228,7 +228,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 + :initialize #'custom-initialize-delay :type '(choice (const nil) directory)) ;; The system null device. (Should reference NULL_DEVICE from C.) @@ -434,7 +434,7 @@ ignored." ,@(mapcar (lambda (algo) (list 'const algo)) (secure-hash-algorithms))))) - :initialize 'custom-initialize-delay + :initialize #'custom-initialize-delay :version "21.1") (defvar auto-save--timer nil "Timer for `auto-save-visited-mode'.") @@ -482,6 +482,7 @@ non-nil." "When nil, `auto-save-visited-mode' will auto-save remote files. Any other value means that it will not." :group 'auto-save + :group 'tramp :type 'boolean :version "29.1") @@ -555,8 +556,9 @@ using a transform that puts the lock files on a local file system." :version "28.1") (defcustom remote-file-name-inhibit-locks nil - "Whether to use file locks for remote files." + "Whether to create file locks for remote files." :group 'files + :group 'tramp :version "28.1" :type 'boolean) @@ -681,7 +683,8 @@ The command \\[normal-mode], when used interactively, always obeys file local variable specifications and the -*- line, and ignores this variable. -Also see the `permanently-enabled-local-variables' variable." +Also see the `permanently-enabled-local-variables' and +`safe-local-variable-directories' variables." :risky t :type '(choice (const :tag "Query Unsafe" t) (const :tag "Safe Only" :safe) @@ -1140,9 +1143,11 @@ the function needs to examine, starting with FILE." (while (not (or root (null file) (string-match locate-dominating-stop-dir-regexp file))) - (setq try (if (stringp name) - (and (file-directory-p file) - (file-exists-p (expand-file-name name file))) + (setq file (if (file-directory-p file) + file + (file-name-directory file)) + try (if (stringp name) + (file-exists-p (expand-file-name name file)) (funcall name file))) (cond (try (setq root file)) ((equal file (setq file (file-name-directory @@ -1249,6 +1254,29 @@ See `load-file' for a different interface to `load'." (interactive (list (read-library-name))) (load library)) +(defun require-with-check (feature &optional filename noerror) + "If FEATURE is not already loaded, load it from FILENAME. +This is like `require' except if FEATURE is already a member of the list +`features’, then we check if this was provided by a different file than the +one that we would load now (presumably because `load-path' has been +changed since the file was loaded). +If it's the case, we either signal an error (the default), or forcibly reload +the new file (if NOERROR is equal to `reload'), or otherwise emit a warning." + (let ((lh load-history) + (res (require feature filename (if (eq noerror 'reload) nil noerror)))) + ;; If the `feature' was not yet provided, `require' just loaded the right + ;; file, so we're done. + (when (eq lh load-history) + ;; If `require' did nothing, we need to make sure that was warranted. + (let ((fn (locate-file (or filename (symbol-name feature)) + load-path (get-load-suffixes)))) + (cond + ((assoc fn load-history) nil) ;We loaded the right file. + ((eq noerror 'reload) (load fn nil 'nomessage)) + (t (funcall (if noerror #'warn #'error) + "Feature provided by other file: %S" feature))))) + res)) + (defun file-remote-p (file &optional identification connected) "Test whether FILE specifies a location on a remote system. A file is considered remote if accessing it is likely to @@ -1275,7 +1303,9 @@ there is an existing connection. If CONNECTED is non-nil, return an identification only if FILE is located on a remote system and a connection is established to -that remote system. +that remote system. If CONNECTED is `never', never use an +existing connection to return the identification (this is +otherwise like a value of nil). Tip: You can use this expansion of remote identifier components to derive a new remote file name from an existing one. For @@ -1286,10 +1316,8 @@ Tip: You can use this expansion of remote identifier components returns a remote file name for file \"/bin/sh\" that has the same remote identifier as FILE but expanded; a name such as \"/sudo:root@myhost:/bin/sh\"." - (let ((handler (find-file-name-handler file 'file-remote-p))) - (if handler - (funcall handler 'file-remote-p file identification connected) - nil))) + (when-let ((handler (find-file-name-handler file 'file-remote-p))) + (funcall handler 'file-remote-p file identification connected))) ;; Probably this entire variable should be obsolete now, in favor of ;; something Tramp-related (?). It is not used in many places. @@ -1299,7 +1327,7 @@ Tip: You can use this expansion of remote identifier components (defcustom remote-shell-program (or (executable-find "ssh") "ssh") "Program to use to execute commands on a remote host (i.e. ssh)." :version "29.1" - :initialize 'custom-initialize-delay + :initialize #'custom-initialize-delay :group 'environment :type 'file) @@ -1324,6 +1352,7 @@ consecutive checks. For example: (< 0 (file-attribute-size (file-attributes (file-chase-links file)))))))" :group 'files + :group 'tramp :version "24.1" :type '(choice (const :tag "Do not cache remote file attributes" t) @@ -1332,6 +1361,22 @@ consecutive checks. For example: :format "Cache expiry in seconds: %v" :value 10))) +(defcustom remote-file-name-access-timeout nil + "Timeout (in seconds) for `access-file'. +This timeout limits the time to check, whether a remote file is +accessible. `access-file' returns an error after that time. If +the value is 0 or nil, no timeout is used. + +This applies only when there isn't time spent for other actions, +like reading passwords." + :group 'files + :group 'tramp + :version "30.1" + ;;:type '(choice :tag "Timeout (seconds)" natnum (const nil))) + :type '(choice + (natnum :tag "Timeout (seconds)") + (const :tag "Do not use timeout" nil))) + (defun file-local-name (file) "Return the local name component of FILE. This function removes from FILE the specification of the remote host @@ -1984,6 +2029,8 @@ INHIBIT-BUFFER-HOOKS non-nil. Note: Be careful with let-binding this hook considering it is frequently used for cleanup.") +(defvar find-alternate-file-dont-kill-client nil + "If non-nil, `server-buffer-done' should not delete the client.") (defun find-alternate-file (filename &optional wildcards) "Find file FILENAME, select its buffer, kill previous buffer. If the current buffer now contains an empty file that you just visited @@ -2030,7 +2077,8 @@ killed." ;; 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) + (let ((find-alternate-file-dont-kill-client 'dont-kill-client)) + (run-hooks 'kill-buffer-hook)) ;; Okay, now we can end-of-life the old buffer. (if (get-buffer " **lose**") (kill-buffer " **lose**")) @@ -2070,22 +2118,32 @@ killed." (kill-buffer obuf)))))) ;; FIXME we really need to fold the uniquify stuff in here by default, -;; not using advice, and add it to the doc string. (defun create-file-buffer (filename) "Create a suitably named buffer for visiting FILENAME, and return it. FILENAME (sans directory) is used unchanged if that name is free; -otherwise a string <2> or <3> or ... is appended to get an unused name. +otherwise the buffer is renamed according to +`uniquify-buffer-name-style' to get an unused name. Emacs treats buffers whose names begin with a space as internal buffers. To avoid confusion when visiting a file whose name begins with a space, this function prepends a \"|\" to the final result if necessary." - (let* ((lastname (file-name-nondirectory filename)) - (lastname (if (string= lastname "") - filename lastname)) - (buf (generate-new-buffer (if (string-prefix-p " " lastname) - (concat "|" lastname) - lastname)))) - (uniquify--create-file-buffer-advice buf filename) + (let* ((lastname (file-name-nondirectory (directory-file-name filename))) + (lastname (if (string= lastname "") ; FILENAME is a root directory + filename lastname)) + (lastname (cond + ((not (and uniquify-trailing-separator-p + (file-directory-p filename))) + lastname) + ((eq uniquify-buffer-name-style 'forward) + (file-name-as-directory lastname)) + ((eq uniquify-buffer-name-style 'reverse) + (concat (or uniquify-separator "\\") lastname)) + (t lastname))) + (basename (if (string-prefix-p " " lastname) + (concat "|" lastname) + lastname)) + (buf (generate-new-buffer basename))) + (uniquify--create-file-buffer-advice buf filename basename) buf)) (defvar abbreviated-home-dir nil @@ -2158,37 +2216,33 @@ and others are ignored. PREDICATE is called with the buffer as the only argument, but not with the buffer as the current buffer. If there is no such live buffer, return nil." - (let ((predicate (or predicate #'identity)) - (truename (abbreviate-file-name (file-truename filename)))) - (or (let ((buf (get-file-buffer filename))) - (when (and buf (funcall predicate buf)) buf)) - (let ((list (buffer-list)) found) - (while (and (not found) list) - (with-current-buffer (car list) - (if (and buffer-file-name - (string= buffer-file-truename truename) - (funcall predicate (current-buffer))) - (setq found (car list)))) - (setq list (cdr list))) - found) - (let* ((attributes (file-attributes truename)) - (number (file-attribute-file-identifier attributes)) - (list (buffer-list)) found) - (and buffer-file-numbers-unique - (car-safe number) ;Make sure the inode is not just nil. - (while (and (not found) list) - (with-current-buffer (car list) - (if (and buffer-file-name - (equal buffer-file-number number) - ;; Verify this buffer's file number - ;; still belongs to its file. - (file-exists-p buffer-file-name) - (equal (file-attributes buffer-file-truename) - attributes) - (funcall predicate (current-buffer))) - (setq found (car list)))) - (setq list (cdr list)))) - found)))) + (or (let ((buf (get-file-buffer filename))) + (when (and buf (or (not predicate) (funcall predicate buf))) buf)) + (let ((truename (abbreviate-file-name (file-truename filename)))) + (or + (let ((buf (get-truename-buffer truename))) + (when (and buf (buffer-local-value 'buffer-file-name buf) + (or (not predicate) (funcall predicate buf))) + buf)) + (let* ((attributes (file-attributes truename)) + (number (file-attribute-file-identifier attributes))) + (and buffer-file-numbers-unique + (car-safe number) ;Make sure the inode is not just nil. + (let* ((buf (find-buffer 'buffer-file-number number)) + (buf-file-name + (and buf (buffer-local-value 'buffer-file-name buf)))) + (when (and buf-file-name + ;; Verify this buffer's file number + ;; still belongs to its file. + (file-exists-p buf-file-name) + (equal (file-attributes + (buffer-local-value + 'buffer-file-truename buf)) + attributes) + (or (not predicate) + (funcall predicate buf))) + buf)))))))) + (defcustom find-file-wildcards t "Non-nil means file-visiting commands should handle wildcards. @@ -2701,6 +2755,10 @@ Fifth arg NOMODES non-nil means don't alter the file's modes. Finishes by calling the functions in `find-file-hook' unless NOMODES is non-nil." (setq buffer-read-only (not (file-writable-p buffer-file-name))) + ;; The above is sufficiently like turning on read-only-mode, so run + ;; the mode hook here by hand. + (if buffer-read-only + (run-hooks 'read-only-mode-hook)) (if noninteractive nil (let* (not-serious @@ -3013,7 +3071,7 @@ ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|CBR\\|7Z\\|SQUASHFS\\)\\'" . ("\\.docbook\\'" . sgml-mode) ("\\.com\\'" . dcl-mode) ("/config\\.\\(?:bat\\|log\\)\\'" . fundamental-mode) - ("/\\.\\(authinfo\\|netrc\\)\\'" . authinfo-mode) + ("/\\.?\\(authinfo\\|netrc\\)\\'" . authinfo-mode) ;; Windows candidates may be opened case sensitively on Unix ("\\.\\(?:[iI][nN][iI]\\|[lL][sS][tT]\\|[rR][eE][gG]\\|[sS][yY][sS]\\)\\'" . conf-mode) ("\\.la\\'" . conf-unix-mode) @@ -3218,8 +3276,25 @@ and `inhibit-local-variables-suffixes'. If temp)) (defvar auto-mode-interpreter-regexp - (purecopy "#![ \t]?\\([^ \t\n]*\ -/bin/env[ \t]\\)?\\([^ \t\n]+\\)") + (purecopy + (concat + "#![ \t]*" + ;; Optional group 1: env(1) invocation. + "\\(" + "[^ \t\n]*/bin/env[ \t]*" + ;; Within group 1: possible -S/--split-string and environment + ;; adjustments. + "\\(?:" + ;; -S/--split-string + "\\(?:-[0a-z]*S[ \t]*\\|--split-string=\\)" + ;; More env arguments. + "\\(?:-[^ \t\n]+[ \t]+\\)*" + ;; Interpreter environment modifications. + "\\(?:[^ \t\n]+=[^ \t\n]*[ \t]+\\)*" + "\\)?" + "\\)?" + ;; Group 2: interpreter. + "\\([^ \t\n]+\\)")) "Regexp matching interpreters, for file mode determination. This regular expression is matched against the first line of a file to determine the file's mode in `set-auto-mode'. If it matches, the file @@ -3346,7 +3421,7 @@ checks if it uses an interpreter listed in `interpreter-mode-alist', matches the buffer beginning against `magic-mode-alist', compares the file name against the entries in `auto-mode-alist', then matches the buffer beginning against `magic-fallback-mode-alist'. -It also obeys `major-mode-remap-alist'. +It also obeys `major-mode-remap-alist' and `major-mode-remap-defaults'. If `enable-local-variables' is nil, or if the file name matches `inhibit-local-variables-regexps', this function does not check @@ -3358,7 +3433,7 @@ set the major mode only if that would change it. In other words we don't actually set it to the same mode the buffer already has." ;; Look for -*-MODENAME-*- or -*- ... mode: MODENAME; ... -*- (let ((try-locals (not (inhibit-local-variables-p))) - end done mode modes) + end modes) ;; Once we drop the deprecated feature where mode: is also allowed to ;; specify minor-modes (ie, there can be more than one "mode:"), we can ;; remove this section and just let (hack-local-variables t) handle it. @@ -3389,100 +3464,96 @@ we don't actually set it to the same mode the buffer already has." (push (intern (concat (downcase (buffer-substring (point) end)) "-mode")) modes)))) - ;; If we found modes to use, invoke them now, outside the save-excursion. - (if modes - (catch 'nop - (dolist (mode (nreverse modes)) - (if (not (functionp mode)) - (message "Ignoring unknown mode `%s'" mode) - (setq done t) - (or (set-auto-mode-0 mode keep-mode-if-same) - ;; continuing would call minor modes again, toggling them off - (throw 'nop nil)))))) - ;; Check for auto-mode-alist entry in dir-locals. - (unless done - (with-demoted-errors "Directory-local variables error: %s" - ;; Note this is a no-op if enable-local-variables is nil. - (let* ((mode-alist (cdr (hack-dir-local--get-variables - (lambda (key) (eq key 'auto-mode-alist)))))) - (setq done (set-auto-mode--apply-alist mode-alist - keep-mode-if-same t))))) - (and (not done) - (setq mode (hack-local-variables t (not try-locals))) - (not (memq mode modes)) ; already tried and failed - (if (not (functionp mode)) - (message "Ignoring unknown mode `%s'" mode) - (setq done t) - (set-auto-mode-0 mode keep-mode-if-same))) - ;; If we didn't, look for an interpreter specified in the first line. - ;; As a special case, allow for things like "#!/bin/env perl", which - ;; finds the interpreter anywhere in $PATH. - (and (not done) - (setq mode (save-excursion - (goto-char (point-min)) - (if (looking-at auto-mode-interpreter-regexp) - (match-string 2)))) - ;; Map interpreter name to a mode, signaling we're done at the - ;; same time. - (setq done (assoc-default - (file-name-nondirectory mode) - (mapcar (lambda (e) - (cons - (format "\\`%s\\'" (car e)) - (cdr e))) - interpreter-mode-alist) - #'string-match-p)) - ;; If we found an interpreter mode to use, invoke it now. - (set-auto-mode-0 done keep-mode-if-same)) - ;; Next try matching the buffer beginning against magic-mode-alist. - (unless done - (if (setq done (save-excursion - (goto-char (point-min)) - (save-restriction - (narrow-to-region (point-min) - (min (point-max) - (+ (point-min) magic-mode-regexp-match-limit))) - (assoc-default - nil magic-mode-alist - (lambda (re _dummy) - (cond - ((functionp re) - (funcall re)) - ((stringp re) - (let ((case-fold-search nil)) - (looking-at re))) - (t - (error - "Problem in magic-mode-alist with element %s" - re)))))))) - (set-auto-mode-0 done keep-mode-if-same))) - ;; Next compare the filename against the entries in auto-mode-alist. - (unless done - (setq done (set-auto-mode--apply-alist auto-mode-alist - keep-mode-if-same nil))) - ;; Next try matching the buffer beginning against magic-fallback-mode-alist. - (unless done - (if (setq done (save-excursion - (goto-char (point-min)) - (save-restriction - (narrow-to-region (point-min) - (min (point-max) - (+ (point-min) magic-mode-regexp-match-limit))) - (assoc-default nil magic-fallback-mode-alist - (lambda (re _dummy) - (cond - ((functionp re) - (funcall re)) - ((stringp re) - (let ((case-fold-search nil)) - (looking-at re))) - (t - (error - "Problem with magic-fallback-mode-alist element: %s" - re)))))))) - (set-auto-mode-0 done keep-mode-if-same))) - (unless done - (set-buffer-major-mode (current-buffer))))) + (or + ;; If we found modes to use, invoke them now, outside the save-excursion. + ;; Presume `modes' holds a major mode followed by minor modes. + (let ((done ())) + (dolist (mode (nreverse modes)) + (if (eq done :keep) + ;; `keep-mode-if-same' is set and the (major) mode + ;; was already set. Refrain from calling the following + ;; minor modes since they have already been set. + ;; It was especially important in the past when calling + ;; minor modes without an arg would toggle them, but it's + ;; still preferable to avoid re-enabling them, + nil + (let ((res (set-auto-mode-0 mode keep-mode-if-same))) + (setq done (or res done))))) + done) + ;; Check for auto-mode-alist entry in dir-locals. + (with-demoted-errors "Directory-local variables error: %s" + ;; Note this is a no-op if enable-local-variables is nil. + (let* ((mode-alist (cdr (hack-dir-local--get-variables + (lambda (key) (eq key 'auto-mode-alist)))))) + (set-auto-mode--apply-alist mode-alist keep-mode-if-same t))) + (let ((mode (hack-local-variables t (not try-locals)))) + (unless (memq mode modes) ; already tried and failed + (set-auto-mode-0 mode keep-mode-if-same))) + ;; If we didn't, look for an interpreter specified in the first line. + ;; As a special case, allow for things like "#!/bin/env perl", which + ;; finds the interpreter anywhere in $PATH. + (when-let + ((interp (save-excursion + (goto-char (point-min)) + (if (looking-at auto-mode-interpreter-regexp) + (match-string 2)))) + ;; Map interpreter name to a mode, signaling we're done at the + ;; same time. + (mode (assoc-default + (file-name-nondirectory interp) + (mapcar (lambda (e) + (cons + (format "\\`%s\\'" (car e)) + (cdr e))) + interpreter-mode-alist) + #'string-match-p))) + ;; If we found an interpreter mode to use, invoke it now. + (set-auto-mode-0 mode keep-mode-if-same)) + ;; Next try matching the buffer beginning against magic-mode-alist. + (let ((mode (save-excursion + (goto-char (point-min)) + (save-restriction + (narrow-to-region (point-min) + (min (point-max) + (+ (point-min) magic-mode-regexp-match-limit))) + (assoc-default + nil magic-mode-alist + (lambda (re _dummy) + (cond + ((functionp re) + (funcall re)) + ((stringp re) + (let ((case-fold-search nil)) + (looking-at re))) + (t + (error + "Problem in magic-mode-alist with element %s" + re))))))))) + (set-auto-mode-0 mode keep-mode-if-same)) + ;; Next compare the filename against the entries in auto-mode-alist. + (set-auto-mode--apply-alist auto-mode-alist + keep-mode-if-same nil) + ;; Next try matching the buffer beginning against magic-fallback-mode-alist. + (let ((mode (save-excursion + (goto-char (point-min)) + (save-restriction + (narrow-to-region (point-min) + (min (point-max) + (+ (point-min) magic-mode-regexp-match-limit))) + (assoc-default nil magic-fallback-mode-alist + (lambda (re _dummy) + (cond + ((functionp re) + (funcall re)) + ((stringp re) + (let ((case-fold-search nil)) + (looking-at re))) + (t + (error + "Problem with magic-fallback-mode-alist element: %s" + re))))))))) + (set-auto-mode-0 mode keep-mode-if-same)) + (set-buffer-major-mode (current-buffer))))) (defvar-local set-auto-mode--last nil "Remember the mode we have set via `set-auto-mode-0'.") @@ -3492,9 +3563,22 @@ we don't actually set it to the same mode the buffer already has." Every entry is of the form (MODE . FUNCTION) which means that in order to activate the major mode MODE (specified via something like `auto-mode-alist', file-local variables, ...) we should actually call -FUNCTION instead." +FUNCTION instead. +FUNCTION can be nil to hide other entries (either in this var or in +`major-mode-remap-defaults') and means that we should call MODE." :type '(alist (symbol) (function))) +(defvar major-mode-remap-defaults nil + "Alist mapping file-specified mode to actual mode. +This works like `major-mode-remap-alist' except it has lower priority +and it is meant to be modified by packages rather than users.") + +(defun major-mode-remap (mode) + "Return the function to use to enable MODE." + (or (cdr (or (assq mode major-mode-remap-alist) + (assq mode major-mode-remap-defaults))) + mode)) + ;; When `keep-mode-if-same' is set, we are working on behalf of ;; set-visited-file-name. In that case, if the major mode specified is the ;; same one we already have, don't actually reset it. We don't want to lose @@ -3503,18 +3587,29 @@ FUNCTION instead." "Apply MODE and return it. If optional arg KEEP-MODE-IF-SAME is non-nil, MODE is chased of any aliases and compared to current major mode. If they are the -same, do nothing and return nil." - (unless (and keep-mode-if-same - (or (eq (indirect-function mode) - (indirect-function major-mode)) - (and set-auto-mode--last - (eq mode (car set-auto-mode--last)) - (eq major-mode (cdr set-auto-mode--last))))) - (when mode - (funcall (alist-get mode major-mode-remap-alist mode)) - (unless (eq mode major-mode) - (setq set-auto-mode--last (cons mode major-mode))) - mode))) +same, do nothing and return `:keep'. +Return nil if MODE could not be applied." + (when mode + (if (and keep-mode-if-same + (or (eq (indirect-function mode) + (indirect-function major-mode)) + (and set-auto-mode--last + (eq mode (car set-auto-mode--last)) + (eq major-mode (cdr set-auto-mode--last))))) + :keep + (let ((modefun (major-mode-remap mode))) + (if (not (functionp modefun)) + (progn + (message "Ignoring unknown mode `%s'%s" mode + (if (eq mode modefun) "" + (format " (remapped to `%S')" modefun))) + nil) + (funcall modefun) + (unless (or (eq mode major-mode) ;`set-auto-mode--last' is overkill. + ;; `modefun' is something like a minor mode. + (local-variable-p 'set-auto-mode--last)) + (setq set-auto-mode--last (cons mode major-mode))) + mode))))) (defvar file-auto-mode-skip "^\\(#!\\|'\\\\\"\\)" "Regexp of lines to skip when looking for file-local settings. @@ -3700,10 +3795,23 @@ function is allowed to change the contents of this alist. This hook is called only if there is at least one file-local variable to set.") -(defvar permanently-enabled-local-variables '(lexical-binding) +(defvar permanently-enabled-local-variables + '(lexical-binding read-symbol-shorthands) "A list of file-local variables that are always enabled. This overrides any `enable-local-variables' setting.") +(defcustom safe-local-variable-directories '() + "A list of directories where local variables are always enabled. +Directory-local variables loaded from these directories, such as the +variables in .dir-locals.el, will be enabled even if they are risky. +The names of the directories in the list must be absolute, and must +end in a slash. Remote directories can be included if the +variable `enable-remote-dir-locals' is non-nil." + :version "30.1" + :type '(repeat string) + :risky t + :group 'find-file) + (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. @@ -3742,7 +3850,11 @@ n -- to ignore the local variables list.") ! -- to apply the local variables list, and permanently mark these values (*) as safe (in the future, they will be set automatically.) i -- to ignore the local variables list, and permanently mark these - values (*) as ignored\n\n") + values (*) as ignored" + (if dir-name " ++ -- to apply the local variables list, and trust all directory-local + variables in this directory\n\n" + "\n\n")) (insert "\n\n")) (dolist (elt all-vars) (cond ((member elt unsafe-vars) @@ -3766,7 +3878,11 @@ i -- to ignore the local variables list, and permanently mark these (pop-to-buffer buf '(display-buffer--maybe-at-bottom)) (let* ((exit-chars '(?y ?n ?\s)) (prompt (format "Please type %s%s: " - (if offer-save "y, n, ! or i" "y or n") + (if offer-save + (if dir-name + "y, n, !, i, +" + "y, n, !, i") + "y or n") (if (< (line-number-at-pos (point-max)) (window-body-height)) "" @@ -3774,8 +3890,13 @@ i -- to ignore the local variables list, and permanently mark these char) (when offer-save (push ?i exit-chars) - (push ?! exit-chars)) + (push ?! exit-chars) + (when dir-name + (push ?+ exit-chars))) (setq char (read-char-choice prompt exit-chars)) + (when (and offer-save dir-name (= char ?+)) + (customize-push-and-save 'safe-local-variable-directories + (list dir-name))) (when (and offer-save (or (= char ?!) (= char ?i)) unsafe-vars) @@ -3784,7 +3905,7 @@ i -- to ignore the local variables list, and permanently mark these 'safe-local-variable-values 'ignored-local-variable-values) unsafe-vars)) - (prog1 (memq char '(?! ?\s ?y)) + (prog1 (memq char '(?! ?\s ?y ?+)) (quit-window t))))))) (defconst hack-local-variable-regexp @@ -3916,6 +4037,10 @@ DIR-NAME is the name of the associated directory. Otherwise it is nil." (null unsafe-vars) (null risky-vars)) (memq enable-local-variables '(:all :safe)) + (delq nil (mapcar (lambda (dir) + (and dir-name dir + (file-equal-p dir dir-name))) + safe-local-variable-directories)) (hack-local-variables-confirm all-vars unsafe-vars risky-vars dir-name)) (dolist (elt all-vars) @@ -4033,6 +4158,7 @@ major-mode." (forward-line 1) (let ((startpos (point)) endpos + (selective-p (eq selective-display t)) (thisbuf (current-buffer))) (save-excursion (unless (let ((case-fold-search t)) @@ -4049,7 +4175,8 @@ major-mode." (with-temp-buffer (insert-buffer-substring thisbuf startpos endpos) (goto-char (point-min)) - (subst-char-in-region (point) (point-max) ?\^m ?\n) + (if selective-p + (subst-char-in-region (point) (point-max) ?\r ?\n)) (while (not (eobp)) ;; Discard the prefix. (if (looking-at prefix) @@ -4089,8 +4216,9 @@ major-mode." (not (string-match "-minor\\'" (setq val2 (downcase (symbol-name val))))) - ;; Allow several mode: elements. - (push (intern (concat val2 "-mode")) result)) + (let ((mode (intern (concat val2 "-mode")))) + (when (fboundp (major-mode-remap mode)) + (setq result mode)))) (cond ((eq var 'coding)) ((eq var 'lexical-binding) (unless hack-local-variables--warned-lexical @@ -4105,6 +4233,13 @@ major-mode." ;; to use 'thisbuf's name in the ;; warning message. (or (buffer-file-name thisbuf) "")))))) + ((eq var 'read-symbol-shorthands) + ;; Sort automatically by shorthand length + ;; in descending order. + (setq val (sort val + (lambda (sh1 sh2) (> (length (car sh1)) + (length (car sh2)))))) + (push (cons 'read-symbol-shorthands val) result)) ((and (eq var 'mode) handle-mode)) (t (ignore-errors @@ -4114,10 +4249,7 @@ major-mode." val) result)))))) (forward-line 1))))))) - (if (eq handle-mode t) - ;; Return the final mode: setting that's defined. - (car (seq-filter #'fboundp result)) - result))) + result)) (defun hack-local-variables-apply () "Apply the elements of `file-local-variables-alist'. @@ -4327,6 +4459,12 @@ to see whether it should be considered." (funcall predicate key) (or (not key) (derived-mode-p key))) + ;; If KEY is an extra parent it may remain not loaded + ;; (hence with some of its mode-specific vars missing their + ;; `safe-local-variable' property), leading to spurious + ;; prompts about unsafe vars (bug#68246). + (if (and (symbolp key) (autoloadp (indirect-function key))) + (ignore-errors (autoload-do-load (indirect-function key)))) (let* ((alist (cdr entry)) (subdirs (assq 'subdirs alist))) (if (or (not subdirs) @@ -4525,12 +4663,7 @@ applied in order then that means the more specific modes will variables will override modes." (let ((key (car node))) (cond ((null key) -1) - ((symbolp key) - (let ((mode key) - (depth 0)) - (while (setq mode (get mode 'derived-mode-parent)) - (setq depth (1+ depth))) - depth)) + ((symbolp key) (length (derived-mode-all-parents key))) ((stringp key) (+ 1000 (length key))) (t -2)))) @@ -5738,9 +5871,14 @@ Before and after saving the buffer, this function runs (run-hook-with-args-until-success 'write-file-functions) ;; If a hook returned t, file is already "written". ;; Otherwise, write it the usual way now. - (let ((dir (file-name-directory + (let ((file (buffer-file-name)) + (dir (file-name-directory (expand-file-name buffer-file-name)))) - (unless (file-exists-p dir) + ;; Some systems have directories (like /content on + ;; Android) in which files can exist without a + ;; corresponding parent directory. + (unless (or (file-exists-p file) + (file-exists-p dir)) (if (y-or-n-p (format-message "Directory `%s' does not exist; create? " dir)) @@ -5809,8 +5947,10 @@ Before and after saving the buffer, this function runs buffer-file-name))) (setq tempsetmodes t) (error "Attempt to save to a file that you aren't allowed to write")))))) - (or buffer-backed-up - (setq setmodes (backup-buffer))) + (with-demoted-errors + "Backing up buffer: %s" + (or buffer-backed-up + (setq setmodes (backup-buffer)))) (let* ((dir (file-name-directory buffer-file-name)) (dir-writable (file-writable-p dir))) (if (or (and file-precious-flag dir-writable) @@ -5868,9 +6008,11 @@ Before and after saving the buffer, this function runs buffer-file-name) t)) ;; If file not writable, see if we can make it writable - ;; temporarily while we write it. - ;; But no need to do so if we have just backed it up - ;; (setmodes is set) because that says we're superseding. + ;; temporarily while we write it (its original modes will be + ;; restored in 'basic-save-buffer' or, in case of an error, in + ;; the `unwind-protect' below). But no need to do so if we + ;; have just backed it up (setmodes is set) because that says + ;; we're superseding. (cond ((and tempsetmodes (not setmodes)) ;; Change the mode back, after writing. (setq setmodes @@ -5879,12 +6021,17 @@ Before and after saving the buffer, this function runs "Error getting extended attributes: %s" (file-extended-attributes buffer-file-name)) buffer-file-name)) - ;; If set-file-extended-attributes fails, fall back on - ;; set-file-modes. - (unless - (with-demoted-errors "Error setting attributes: %s" - (set-file-extended-attributes buffer-file-name - (nth 1 setmodes))) + ;; If set-file-extended-attributes fails to make the + ;; file writable, fall back on set-file-modes. Calling + ;; set-file-extended-attributes here may or may not be + ;; actually necessary. However, since its exact + ;; behavior is highly port-specific, since calling it + ;; does not do any harm, and since the call has a long + ;; history, we decided to leave it in (bug#66546). + (with-demoted-errors "Error setting attributes: %s" + (set-file-extended-attributes buffer-file-name + (nth 1 setmodes))) + (unless (file-writable-p buffer-file-name) (set-file-modes buffer-file-name (logior (car setmodes) 128))))) (let (success) @@ -5897,12 +6044,22 @@ Before and after saving the buffer, this function runs buffer-file-name nil t buffer-file-truename) (when save-silently (message nil)) (setq success t)) - ;; If we get an error writing the new file, and we made - ;; the backup by renaming, undo the backing-up. - (and setmodes (not success) - (progn - (rename-file (nth 2 setmodes) buffer-file-name t) - (setq buffer-backed-up nil))))))) + (cond + ;; If we get an error writing the file, and there is no + ;; backup file, then we (most likely) made that file + ;; writable above. Attempt to undo the write-access. + ((and setmodes (not success) + (equal (nth 2 setmodes) buffer-file-name)) + (with-demoted-errors "Error setting file modes: %S" + (set-file-modes buffer-file-name (car setmodes))) + (with-demoted-errors "Error setting attributes: %s" + (set-file-extended-attributes buffer-file-name + (nth 1 setmodes)))) + ;; If we get an error writing the new file, and we made + ;; the backup by renaming, undo the backing-up. + ((and setmodes (not success)) + (rename-file (nth 2 setmodes) buffer-file-name t) + (setq buffer-backed-up nil))))))) setmodes)) (declare-function diff-no-select "diff" @@ -6217,11 +6374,11 @@ instance of such commands." (rename-buffer (generate-new-buffer-name base-name)) (force-mode-line-update)))) -(defun files--ensure-directory (mkdir dir) - "Use function MKDIR to make directory DIR if it is not already a directory. +(defun files--ensure-directory (dir) + "Make directory DIR if it is not already a directory. Return non-nil if DIR is already a directory." (condition-case err - (funcall mkdir dir) + (make-directory-internal dir) (error (or (file-directory-p dir) (signal (car err) (cdr err)))))) @@ -6247,32 +6404,27 @@ Signal an error if unsuccessful." ;; If default-directory is a remote directory, ;; make sure we find its make-directory handler. (setq dir (expand-file-name dir)) - (let ((mkdir (if-let ((handler (find-file-name-handler dir 'make-directory))) - #'(lambda (dir) - ;; Use 'ignore' since the handler might be designed for - ;; Emacs 28-, so it might return an (undocumented) - ;; non-nil value, whereas the Emacs 29+ convention is - ;; to return nil here. - (ignore (funcall handler 'make-directory dir))) - #'make-directory-internal))) - (if (not parents) - (funcall mkdir dir) - (let ((dir (directory-file-name (expand-file-name dir))) - already-dir create-list parent) - (while (progn - (setq parent (directory-file-name - (file-name-directory dir))) - (condition-case () - (ignore (setq already-dir - (files--ensure-directory mkdir dir))) - (error - ;; Do not loop if root does not exist (Bug#2309). - (not (string= dir parent))))) - (setq create-list (cons dir create-list) - dir parent)) - (dolist (dir create-list) - (setq already-dir (files--ensure-directory mkdir dir))) - already-dir)))) + (let ((handler (find-file-name-handler dir 'make-directory))) + (if handler + (funcall handler 'make-directory dir parents) + (if (not parents) + (make-directory-internal dir) + (let ((dir (directory-file-name (expand-file-name dir))) + already-dir create-list parent) + (while (progn + (setq parent (directory-file-name + (file-name-directory dir))) + (condition-case () + (ignore (setq already-dir + (files--ensure-directory dir))) + (error + ;; Do not loop if root does not exist (Bug#2309). + (not (string= dir parent))))) + (setq create-list (cons dir create-list) + dir parent)) + (dolist (dir create-list) + (setq already-dir (files--ensure-directory dir))) + already-dir))))) (defun make-empty-file (filename &optional parents) "Create an empty file FILENAME. @@ -6304,6 +6456,27 @@ non-nil and if FN fails due to a missing file or directory." (apply fn args) (file-missing (or no-such (signal (car err) (cdr err)))))) +(defun delete-file (filename &optional trash) + "Delete file named FILENAME. If it is a symlink, remove the symlink. +If file has multiple names, it continues to exist with the other names. +TRASH non-nil means to trash the file instead of deleting, 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 (list (read-file-name + (if (and delete-by-moving-to-trash (null current-prefix-arg)) + "Move file to trash: " "Delete file: ") + nil default-directory (confirm-nonexistent-file-or-buffer)) + (null current-prefix-arg))) + (if (and (file-directory-p filename) (not (file-symlink-p filename))) + (signal 'file-error (list "Removing old name: is a directory" filename))) + (let* ((filename (expand-file-name filename)) + (handler (find-file-name-handler filename 'delete-file))) + (cond (handler (funcall handler 'delete-file filename trash)) + ((and delete-by-moving-to-trash trash) (move-file-to-trash filename)) + (t (delete-file-internal filename))))) + (defun delete-directory (directory &optional recursive trash) "Delete the directory named DIRECTORY. Does not follow symlinks. If RECURSIVE is non-nil, delete files in DIRECTORY as well, with @@ -6365,6 +6538,14 @@ RECURSIVE if DIRECTORY is nonempty." directory-exists)) (files--force recursive #'delete-directory-internal directory)))))) +(defcustom remote-file-name-inhibit-delete-by-moving-to-trash nil + "Whether remote files shall be moved to the Trash. +This overrules any setting of `delete-by-moving-to-trash'." + :version "30.1" + :group 'files + :group 'tramp + :type 'boolean) + (defun file-equal-p (file1 file2) "Return non-nil if files FILE1 and FILE2 name the same file. If FILE1 or FILE2 does not exist, the return value is unspecified." @@ -6537,7 +6718,15 @@ into NEWNAME instead." (file-attributes directory)))) (follow-flag (unless follow 'nofollow))) (if modes (set-file-modes newname modes follow-flag)) - (if times (set-file-times newname times follow-flag))))))) + (when times + ;; When built for an Android GUI build, don't attempt to + ;; set file times for a file within /content, as the + ;; Android VFS layer does not provide means to change file + ;; timestamps. + (when (or (not (and (eq system-type 'android) + (featurep 'android))) + (not (string-prefix-p "/content/" newname))) + (set-file-times newname times follow-flag)))))))) ;; At time of writing, only info uses this. @@ -6819,9 +7008,9 @@ an auto-save file." (if revert-buffer-preserve-modes (let ((buffer-file-format buffer-file-format)) (insert-file-contents file-name (not auto-save-p) - nil nil t)) + nil nil 'if-regular)) (insert-file-contents file-name (not auto-save-p) - nil nil t)))))) + nil nil 'if-regular)))))) (defvar revert-buffer-with-fine-grain-max-seconds 2.0 "Maximum time that `revert-buffer-with-fine-grain' should use. @@ -6964,11 +7153,19 @@ auto-save file, if that is more recent than the visited file." #'(lambda (window _value) (with-selected-window window (unwind-protect - (yes-or-no-p (format "Recover auto save file %s? " file-name)) + (let ((prompt (format "Recover auto save file %s? " file-name)) + (choices + '(("yes" ?y "recover auto save file") + ("no" ?n "don't recover auto save file") + ("diff" ?= "show changes between auto save file and current file"))) + ans) + (while (equal "diff" (setq ans (read-answer prompt choices))) + (diff file file-name)) + (equal ans "yes")) (when (window-live-p window) (quit-restore-window window 'kill))))) (with-current-buffer standard-output - (let ((switches dired-listing-switches)) + (let ((switches (connection-local-value dired-listing-switches))) (if (file-symlink-p file) (setq switches (concat switches " -L"))) ;; Use insert-directory-safely, not insert-directory, @@ -7020,7 +7217,7 @@ Then you'll be asked about a number of files to recover." ;; hook. (dired-mode-hook (delete 'dired-omit-mode dired-mode-hook))) (dired (concat auto-save-list-file-prefix "*") - (concat dired-listing-switches " -t"))) + (concat (connection-local-value dired-listing-switches) " -t"))) (use-local-map (nconc (make-sparse-keymap) (current-local-map))) (define-key (current-local-map) "\C-c\C-c" 'recover-session-finish) (save-excursion @@ -7134,10 +7331,11 @@ specifies the list of buffers to kill, asking for approval for each one." (setq list (cdr list)))) (defun kill-matching-buffers (regexp &optional internal-too no-ask) - "Kill buffers whose name matches the specified REGEXP. -Ignores buffers whose name starts with a space, unless optional -prefix argument INTERNAL-TOO is non-nil. Asks before killing -each buffer, unless NO-ASK is non-nil." + "Kill buffers whose names match the regular expression REGEXP. +Interactively, prompt for REGEXP. +Ignores buffers whose names start with a space, unless optional +prefix argument INTERNAL-TOO(interactively, the prefix argument) +is non-nil. Asks before killing each buffer, unless NO-ASK is non-nil." (interactive "sKill buffers matching this regular expression: \nP") (dolist (buffer (buffer-list)) (let ((name (buffer-name buffer))) @@ -7146,6 +7344,17 @@ each buffer, unless NO-ASK is non-nil." (string-match regexp name)) (funcall (if no-ask 'kill-buffer 'kill-buffer-ask) buffer))))) +(defun kill-matching-buffers-no-ask (regexp &optional internal-too) + "Kill buffers whose names match the regular expression REGEXP. +Interactively, prompt for REGEXP. +Like `kill-matching-buffers', but doesn't ask for confirmation +before killing each buffer. +Ignores buffers whose names start with a space, unless the +optional argument INTERNAL-TOO (interactively, the prefix argument) +is non-nil." + (interactive "sKill buffers matching this regular expression: \nP") + (kill-matching-buffers regexp internal-too t)) + (defun rename-auto-save-file () "Adjust current buffer's auto save file name for current conditions. @@ -7408,35 +7617,42 @@ default directory. However, if FULL is non-nil, they are absolute." ;; if DIRPART contains wildcards. (dirs (if (and dirpart (string-match "[[*?]" (file-local-name dirpart))) - (mapcar 'file-name-as-directory + (mapcar #'file-name-as-directory (file-expand-wildcards (directory-file-name dirpart) nil regexp)) (list dirpart))) contents) - (dolist (dir dirs) + (dolist (dir (nreverse dirs)) (when (or (null dir) ; Possible if DIRPART is not wild. (file-accessible-directory-p dir)) - (let ((this-dir-contents - ;; Filter out "." and ".." - (delq nil - (mapcar (lambda (name) - (unless (string-match "\\`\\.\\.?\\'" - (file-name-nondirectory name)) - name)) - (directory-files - (or dir ".") full - (if regexp - ;; We're matching each file name - ;; element separately. - (concat "\\`" nondir "\\'") - (wildcard-to-regexp nondir))))))) - (setq contents - (nconc - (if (and dir (not full)) - (mapcar (lambda (name) (concat dir name)) - this-dir-contents) - this-dir-contents) - contents))))) + (if (equal "" nondir) + ;; `nondir' is "" when the pattern ends in "/". Basically "" + ;; refers to the directory itself, like ".", but it's not + ;; among the names returned by `directory-files', so we have + ;; to special-case it. + (push (or dir nondir) contents) + (let ((this-dir-contents + ;; Filter out "." and ".." + (delq nil + (mapcar (lambda (name) + (unless (string-match "\\`\\.\\.?\\'" + (file-name-nondirectory + name)) + name)) + (directory-files + (or dir ".") full + (if regexp + ;; We're matching each file name + ;; element separately. + (concat "\\`" nondir "\\'") + (wildcard-to-regexp nondir))))))) + (setq contents + (nconc + (if (and dir (not full)) + (mapcar (lambda (name) (concat dir name)) + this-dir-contents) + this-dir-contents) + contents)))))) contents))) (defcustom find-sibling-rules nil @@ -7463,7 +7679,8 @@ files, you could say something like: In this example, if you're in \"src/emacs/emacs-27/lisp/abbrev.el\", and a \"src/emacs/emacs-28/lisp/abbrev.el\" file exists, it's now defined as a sibling." - :type 'sexp + :type '(alist :key-type (regexp :tag "Match") + :value-type (repeat (string :tag "Expansion"))) :version "29.1") (defun find-sibling-file (file) @@ -7618,10 +7835,38 @@ need to be passed verbatim to shell commands." pattern)))) -(defvar insert-directory-program (purecopy "ls") +(defcustom insert-directory-program + (if (and (memq system-type '(berkeley-unix darwin)) + (executable-find "gls")) + (purecopy "gls") + (purecopy "ls")) "Absolute or relative name of the `ls'-like program. This is used by `insert-directory' and `dired-insert-directory' -\(thus, also by `dired').") +\(thus, also by `dired'). For Dired, this should ideally point to +GNU ls, or another version of ls that supports the \"--dired\" +flag. See `dired-use-ls-dired'. + +On GNU/Linux and other capable systems, the default is \"ls\". + +On *BSD and macOS systems, the default \"ls\" does not support +the \"--dired\" flag. Therefore, the default is to use the +\"gls\" executable on such machines, if it exists. This means +that there should normally be no need to customize this when +installing GNU coreutils using something like ports or Homebrew." + :group 'dired + :type 'string + :initialize #'custom-initialize-delay + :version "30.1") + +(defun files--use-insert-directory-program-p () + "Return non-nil if we should use `insert-directory-program'. +Return nil if we should prefer `ls-lisp' instead." + ;; FIXME: Should we also check `file-accessible-directory-p' so we + ;; automatically redirect to ls-lisp when operating on magic file names? + (and (if (boundp 'ls-lisp-use-insert-directory-program) + ls-lisp-use-insert-directory-program + t) + insert-directory-program)) (defcustom directory-free-space-program (purecopy "df") "Program to get the amount of free space on a file system. @@ -7653,7 +7898,6 @@ If DIR's free space cannot be obtained, this function returns nil." (if avail (funcall byte-count-to-string-function avail))))) -;; The following expression replaces `dired-move-to-filename-regexp'. (defvar directory-listing-before-filename-regexp (let* ((l "\\([A-Za-z]\\|[^\0-\177]\\)") (l-or-quote "\\([A-Za-z']\\|[^\0-\177]\\)") @@ -7691,7 +7935,7 @@ If DIR's free space cannot be obtained, this function returns nil." ;; This avoids recognizing `1 may 1997' as a date in the line: ;; -r--r--r-- 1 may 1997 1168 Oct 19 16:49 README - ;; The "[BkKMGTPEZY]?" below supports "ls -alh" output. + ;; The "[BkKMGTPEZYRQ]?" below supports "ls -alh" output. ;; For non-iso date formats, we add the ".*" in order to find ;; the last possible match. This avoids recognizing @@ -7703,8 +7947,8 @@ If DIR's free space cannot be obtained, this function returns nil." ;; parentheses: ;; -rw-r--r-- (modified) 2005-10-22 21:25 files.el ;; This is not supported yet. - (purecopy (concat "\\([0-9][BkKMGTPEZY]? " iso - "\\|.*[0-9][BkKMGTPEZY]? " + (purecopy (concat "\\([0-9][BkKMGTPEZYRQ]? " iso + "\\|.*[0-9][BkKMGTPEZYRQ]? " "\\(" western "\\|" western-comma "\\|" DD-MMM-YYYY "\\|" east-asian "\\)" "\\) +"))) @@ -7816,9 +8060,11 @@ Optional third arg WILDCARD means treat FILE as shell wildcard. Optional fourth arg FULL-DIRECTORY-P means file is a directory and switches do not contain `d', so that a full listing is expected. -This works by running a directory listing program -whose name is in the variable `insert-directory-program'. -If WILDCARD, it also runs the shell specified by `shell-file-name'. +Depending on the value of `ls-lisp-use-insert-directory-program' +this works either using a Lisp emulation of the \"ls\" program +or by running a directory listing program +whose name is in the variable `insert-directory-program' +\(and if WILDCARD, it also runs the shell specified by `shell-file-name'). When SWITCHES contains the long `--dired' option, this function treats it specially, for the sake of dired. However, the @@ -7827,184 +8073,191 @@ normally equivalent short `-D' option is just passed on to ;; We need the directory in order to find the right handler. (let ((handler (find-file-name-handler (expand-file-name file) 'insert-directory))) - (if handler - (funcall handler 'insert-directory file switches - wildcard full-directory-p) - (let (result (beg (point))) - - ;; Read the actual directory using `insert-directory-program'. - ;; RESULT gets the status code. - (let* (;; We at first read by no-conversion, then after - ;; putting text property `dired-filename, decode one - ;; bunch by one to preserve that property. - (coding-system-for-read 'no-conversion) - ;; This is to control encoding the arguments in call-process. - (coding-system-for-write - (and enable-multibyte-characters - (or file-name-coding-system - default-file-name-coding-system)))) - (setq result - (if wildcard - ;; If the wildcard is just in the file part, then run ls in - ;; the directory part of the file pattern using the last - ;; component as argument. Otherwise, run ls in the longest - ;; subdirectory of the directory part free of wildcards; use - ;; the remaining of the file pattern as argument. - (let* ((dir-wildcard (insert-directory-wildcard-in-dir-p file)) - (default-directory - (cond (dir-wildcard (car dir-wildcard)) - (t - (if (file-name-absolute-p file) - (file-name-directory file) - (file-name-directory (expand-file-name file)))))) - (pattern (if dir-wildcard (cdr dir-wildcard) (file-name-nondirectory file)))) - ;; NB since switches is passed to the shell, be - ;; careful of malicious values, eg "-l;reboot". - ;; See eg dired-safe-switches-p. - (call-process - shell-file-name nil t nil - shell-command-switch - (concat (if (memq system-type '(ms-dos windows-nt)) - "" - "\\") ; Disregard Unix shell aliases! - insert-directory-program - " -d " - (if (stringp switches) - switches - (mapconcat 'identity switches " ")) - " -- " - ;; Quote some characters that have - ;; special meanings in shells; but - ;; don't quote the wildcards--we want - ;; them to be special. We also - ;; currently don't quote the quoting - ;; characters in case people want to - ;; use them explicitly to quote - ;; wildcard characters. - (shell-quote-wildcard-pattern pattern)))) - ;; SunOS 4.1.3, SVr4 and others need the "." to list the - ;; directory if FILE is a symbolic link. - (unless full-directory-p - (setq switches - (cond - ((stringp switches) (concat switches " -d")) - ((member "-d" switches) switches) - (t (append switches '("-d")))))) - (if (string-match "\\`~" file) - (setq file (expand-file-name file))) - (apply 'call-process - insert-directory-program nil t nil - (append - (if (listp switches) switches - (unless (equal switches "") - ;; Split the switches at any spaces so we can - ;; pass separate options as separate args. - (split-string-and-unquote switches))) - ;; Avoid lossage if FILE starts with `-'. - '("--") - (list file)))))) - - ;; If we got "//DIRED//" in the output, it means we got a real - ;; directory listing, even if `ls' returned nonzero. - ;; So ignore any errors. - (when (if (stringp switches) - (string-match "--dired\\>" switches) - (member "--dired" switches)) - (save-excursion - (forward-line -2) - (when (looking-at "//SUBDIRED//") - (forward-line -1)) - (if (looking-at "//DIRED//") - (setq result 0)))) - - (when (and (not (eq 0 result)) - (eq insert-directory-ls-version 'unknown)) - ;; The first time ls returns an error, - ;; find the version numbers of ls, - ;; and set insert-directory-ls-version - ;; to > if it is more than 5.2.1, < if it is less, nil if it - ;; is equal or if the info cannot be obtained. - ;; (That can mean it isn't GNU ls.) - (let ((version-out - (with-temp-buffer - (call-process "ls" nil t nil "--version") - (buffer-string)))) - (if (string-match "ls (.*utils) \\([0-9.]*\\)$" version-out) - (let* ((version (match-string 1 version-out)) - (split (split-string version "[.]")) - (numbers (mapcar 'string-to-number split)) - (min '(5 2 1)) - comparison) - (while (and (not comparison) (or numbers min)) - (cond ((null min) - (setq comparison '>)) - ((null numbers) - (setq comparison '<)) - ((> (car numbers) (car min)) - (setq comparison '>)) - ((< (car numbers) (car min)) - (setq comparison '<)) - (t - (setq numbers (cdr numbers) - min (cdr min))))) - (setq insert-directory-ls-version (or comparison '=))) - (setq insert-directory-ls-version nil)))) - - ;; For GNU ls versions 5.2.2 and up, ignore minor errors. - (when (and (eq 1 result) (eq insert-directory-ls-version '>)) - (setq result 0)) - - ;; If `insert-directory-program' failed, signal an error. - (unless (eq 0 result) - ;; Delete the error message it may have output. - (delete-region beg (point)) - ;; On non-Posix systems, we cannot open a directory, so - ;; don't even try, because that will always result in - ;; the ubiquitous "Access denied". Instead, show the - ;; command line so the user can try to guess what went wrong. - (if (and (file-directory-p file) - (memq system-type '(ms-dos windows-nt))) - (error - "Reading directory: \"%s %s -- %s\" exited with status %s" - insert-directory-program - (if (listp switches) (concat switches) switches) - file result) - ;; Unix. Access the file to get a suitable error. - (access-file file "Reading directory") - (error "Listing directory failed but `access-file' worked"))) - (insert-directory-clean beg switches) - ;; Now decode what read if necessary. - (let ((coding (or coding-system-for-read - file-name-coding-system - default-file-name-coding-system - 'undecided)) - coding-no-eol - val pos) - (when (and enable-multibyte-characters - (not (memq (coding-system-base coding) - '(raw-text no-conversion)))) - ;; If no coding system is specified or detection is - ;; requested, detect the coding. - (if (eq (coding-system-base coding) 'undecided) - (setq coding (detect-coding-region beg (point) t))) - (if (not (eq (coding-system-base coding) 'undecided)) - (save-restriction - (setq coding-no-eol - (coding-system-change-eol-conversion coding 'unix)) - (narrow-to-region beg (point)) - (goto-char (point-min)) - (while (not (eobp)) - (setq pos (point) - val (get-text-property (point) 'dired-filename)) - (goto-char (next-single-property-change - (point) 'dired-filename nil (point-max))) - ;; Force no eol conversion on a file name, so - ;; that CR is preserved. - (decode-coding-region pos (point) - (if val coding-no-eol coding)) - (if val - (put-text-property pos (point) - 'dired-filename t))))))))))) + (cond + (handler + (funcall handler 'insert-directory file switches + wildcard full-directory-p)) + ((not (files--use-insert-directory-program-p)) + (require 'ls-lisp) + (declare-function ls-lisp--insert-directory "ls-lisp") + (ls-lisp--insert-directory file switches wildcard full-directory-p)) + (t + (let (result (beg (point))) + + ;; Read the actual directory using `insert-directory-program'. + ;; RESULT gets the status code. + (let* (;; We at first read by no-conversion, then after + ;; putting text property `dired-filename, decode one + ;; bunch by one to preserve that property. + (coding-system-for-read 'no-conversion) + ;; This is to control encoding the arguments in call-process. + (coding-system-for-write + (and enable-multibyte-characters + (or file-name-coding-system + default-file-name-coding-system)))) + (setq result + (if wildcard + ;; If the wildcard is just in the file part, then run ls in + ;; the directory part of the file pattern using the last + ;; component as argument. Otherwise, run ls in the longest + ;; subdirectory of the directory part free of wildcards; use + ;; the remaining of the file pattern as argument. + (let* ((dir-wildcard (insert-directory-wildcard-in-dir-p file)) + (default-directory + (cond (dir-wildcard (car dir-wildcard)) + (t + (if (file-name-absolute-p file) + (file-name-directory file) + (file-name-directory (expand-file-name file)))))) + (pattern (if dir-wildcard (cdr dir-wildcard) (file-name-nondirectory file)))) + ;; NB since switches is passed to the shell, be + ;; careful of malicious values, eg "-l;reboot". + ;; See eg dired-safe-switches-p. + (call-process + shell-file-name nil t nil + shell-command-switch + (concat (if (memq system-type '(ms-dos windows-nt)) + "" + "\\") ; Disregard Unix shell aliases! + insert-directory-program + " -d " + (if (stringp switches) + switches + (mapconcat #'identity switches " ")) + " -- " + ;; Quote some characters that have + ;; special meanings in shells; but + ;; don't quote the wildcards--we want + ;; them to be special. We also + ;; currently don't quote the quoting + ;; characters in case people want to + ;; use them explicitly to quote + ;; wildcard characters. + (shell-quote-wildcard-pattern pattern)))) + ;; SunOS 4.1.3, SVr4 and others need the "." to list the + ;; directory if FILE is a symbolic link. + (unless full-directory-p + (setq switches + (cond + ((stringp switches) (concat switches " -d")) + ((member "-d" switches) switches) + (t (append switches '("-d")))))) + (if (string-match "\\`~" file) + (setq file (expand-file-name file))) + (apply #'call-process + insert-directory-program nil t nil + (append + (if (listp switches) switches + (unless (equal switches "") + ;; Split the switches at any spaces so we can + ;; pass separate options as separate args. + (split-string-and-unquote switches))) + ;; Avoid lossage if FILE starts with `-'. + '("--") + (list file)))))) + + ;; If we got "//DIRED//" in the output, it means we got a real + ;; directory listing, even if `ls' returned nonzero. + ;; So ignore any errors. + (when (if (stringp switches) + (string-match "--dired\\>" switches) + (member "--dired" switches)) + (save-excursion + (forward-line -2) + (when (looking-at "//SUBDIRED//") + (forward-line -1)) + (if (looking-at "//DIRED//") + (setq result 0)))) + + (when (and (not (eq 0 result)) + (eq insert-directory-ls-version 'unknown)) + ;; The first time ls returns an error, + ;; find the version numbers of ls, + ;; and set insert-directory-ls-version + ;; to > if it is more than 5.2.1, < if it is less, nil if it + ;; is equal or if the info cannot be obtained. + ;; (That can mean it isn't GNU ls.) + (let ((version-out + (with-temp-buffer + (call-process "ls" nil t nil "--version") + (buffer-string)))) + (setq insert-directory-ls-version + (if (string-match "ls (.*utils) \\([0-9.]*\\)$" version-out) + (let* ((version (match-string 1 version-out)) + (split (split-string version "[.]")) + (numbers (mapcar #'string-to-number split)) + (min '(5 2 1)) + comparison) + (while (and (not comparison) (or numbers min)) + (cond ((null min) + (setq comparison #'>)) + ((null numbers) + (setq comparison #'<)) + ((> (car numbers) (car min)) + (setq comparison #'>)) + ((< (car numbers) (car min)) + (setq comparison #'<)) + (t + (setq numbers (cdr numbers) + min (cdr min))))) + (or comparison #'=)) + nil)))) + + ;; For GNU ls versions 5.2.2 and up, ignore minor errors. + (when (and (eq 1 result) (eq insert-directory-ls-version #'>)) + (setq result 0)) + + ;; If `insert-directory-program' failed, signal an error. + (unless (eq 0 result) + ;; Delete the error message it may have output. + (delete-region beg (point)) + ;; On non-Posix systems, we cannot open a directory, so + ;; don't even try, because that will always result in + ;; the ubiquitous "Access denied". Instead, show the + ;; command line so the user can try to guess what went wrong. + (if (and (file-directory-p file) + (memq system-type '(ms-dos windows-nt))) + (error + "Reading directory: \"%s %s -- %s\" exited with status %s" + insert-directory-program + (if (listp switches) (concat switches) switches) + file result) + ;; Unix. Access the file to get a suitable error. + (access-file file "Reading directory") + (error "Listing directory failed but `access-file' worked"))) + (insert-directory-clean beg switches) + ;; Now decode what read if necessary. + (let ((coding (or coding-system-for-read + file-name-coding-system + default-file-name-coding-system + 'undecided)) + coding-no-eol + val pos) + (when (and enable-multibyte-characters + (not (memq (coding-system-base coding) + '(raw-text no-conversion)))) + ;; If no coding system is specified or detection is + ;; requested, detect the coding. + (if (eq (coding-system-base coding) 'undecided) + (setq coding (detect-coding-region beg (point) t))) + (if (not (eq (coding-system-base coding) 'undecided)) + (save-restriction + (setq coding-no-eol + (coding-system-change-eol-conversion coding 'unix)) + (narrow-to-region beg (point)) + (goto-char (point-min)) + (while (not (eobp)) + (setq pos (point) + val (get-text-property (point) 'dired-filename)) + (goto-char (next-single-property-change + (point) 'dired-filename nil (point-max))) + ;; Force no eol conversion on a file name, so + ;; that CR is preserved. + (decode-coding-region pos (point) + (if val coding-no-eol coding)) + (if val + (put-text-property pos (point) + 'dired-filename t)))))))))))) (defun insert-directory-adj-pos (pos error-lines) "Convert `ls --dired' file name position value POS to a buffer position. @@ -8465,7 +8718,7 @@ the leading `-' character." (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 node `(coreutils)File permissions' for more information on this notation. FROM (or 0 if nil) gives the mode bits on which to base permissions if |