diff options
Diffstat (limited to 'lisp/dired.el')
| -rw-r--r-- | lisp/dired.el | 257 |
1 files changed, 185 insertions, 72 deletions
diff --git a/lisp/dired.el b/lisp/dired.el index 4d0c2abdf55..1792250ac90 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -230,6 +230,8 @@ The target is used in the prompt for file copy, rename etc." You can customize key bindings or load extensions with this." :group 'dired :type 'hook) +(make-obsolete-variable 'dired-load-hook + "use `with-eval-after-load' instead." "28.1") (defcustom dired-mode-hook nil "Run at the very end of `dired-mode'." @@ -294,6 +296,36 @@ new Dired buffers." :version "26.1" :group 'dired) +(defcustom dired-mark-region 'file + "Defines what commands that mark files do with the active region. + +When nil, marking commands don't operate on all files in the +active region. They process their prefix arguments as usual. + +When the value of this option is non-nil, then all Dired commands +that mark or unmark files will operate on all files in the region +if the region is active in Transient Mark mode. + +When `file', the region marking is based on the file name. +This means don't mark the file if the end of the region is +before the file name displayed on the Dired line, so the file name +is visually outside the region. This behavior is consistent with +marking files without the region using the key `m' that advances +point to the next line after marking the file. Thus the number +of keys used to mark files is the same as the number of keys +used to select the region, e.g. `M-2 m' marks 2 files, and +`C-SPC M-2 n m' marks 2 files, and `M-2 S-down m' marks 2 files. + +When `line', the region marking is based on Dired lines, +so include the file into marking if the end of the region +is anywhere on its Dired line, except the beginning of the line." + :type '(choice + (const :tag "Don't mark files in active region" nil) + (const :tag "Exclude file name outside of region" file) + (const :tag "Include the file at region end line" line)) + :group 'dired + :version "28.1") + ;; Internal variables (defvar dired-marker-char ?* ; the answer is 42 @@ -610,12 +642,20 @@ Subexpression 2 must end right before the \\n.") PREDICATE is evaluated on each line, with point at beginning of line. MSG is a noun phrase for the type of files being marked. It should end with a noun that can be pluralized by adding `s'. + +In Transient Mark mode, if the mark is active, operate on the contents +of the region if `dired-mark-region' is non-nil. Otherwise, operate +on the whole buffer. + Return value is the number of files marked, or nil if none were marked." - `(let ((inhibit-read-only t) count) + `(let ((inhibit-read-only t) count + (use-region-p (dired-mark--region-use-p)) + (beg (dired-mark--region-beginning)) + (end (dired-mark--region-end))) (save-excursion (setq count 0) (when ,msg - (message "%s %ss%s..." + (message "%s %ss%s%s..." (cond ((eq dired-marker-char ?\s) "Unmarking") ((eq dired-del-marker dired-marker-char) "Flagging") @@ -623,22 +663,28 @@ Return value is the number of files marked, or nil if none were marked." ,msg (if (eq dired-del-marker dired-marker-char) " for deletion" - ""))) - (goto-char (point-min)) - (while (not (eobp)) + "") + (if use-region-p + " in region" + ""))) + (goto-char beg) + (while (< (point) end) (when ,predicate (unless (= (following-char) dired-marker-char) (delete-char 1) (insert dired-marker-char) (setq count (1+ count)))) (forward-line 1)) - (when ,msg (message "%s %s%s %s%s" + (when ,msg (message "%s %s%s %s%s%s" count ,msg (dired-plural-s count) (if (eq dired-marker-char ?\s) "un" "") (if (eq dired-marker-char dired-del-marker) - "flagged" "marked")))) + "flagged" "marked") + (if use-region-p + " in region" + "")))) (and (> count 0) count))) (defmacro dired-map-over-marks (body arg &optional show-progress @@ -757,6 +803,32 @@ ERROR can be a string with the error message." (user-error (if (stringp error) error "No files specified"))) result)) +(defun dired-mark--region-use-p () + "Whether Dired marking commands should act on region." + (and dired-mark-region + (region-active-p) + (> (region-end) (region-beginning)))) + +(defun dired-mark--region-beginning () + "Return the value of the region beginning aligned to Dired file lines." + (if (dired-mark--region-use-p) + (save-excursion + (goto-char (region-beginning)) + (line-beginning-position)) + (point-min))) + +(defun dired-mark--region-end () + "Return the value of the region end aligned to Dired file lines." + (if (dired-mark--region-use-p) + (save-excursion + (goto-char (region-end)) + (if (if (eq dired-mark-region 'line) + (not (bolp)) + (get-text-property (1- (point)) 'dired-filename)) + (line-end-position) + (line-beginning-position))) + (point-max))) + ;; The dired command @@ -849,7 +921,6 @@ If a directory or nothing is found at point, return nil." (if (and file-name (not (file-directory-p file-name))) file-name))) -(put 'dired-mode 'grep-read-files 'dired-grep-read-files) ;;;###autoload (define-key ctl-x-map "d" 'dired) ;;;###autoload @@ -1149,15 +1220,11 @@ wildcards, erases the buffer, and builds the subdir-alist anew ;; default-directory and dired-actual-switches must be buffer-local ;; and initialized by now. - (let (dirname - ;; This makes read-in much faster. - ;; In particular, it prevents the font lock hook from running - ;; until the directory is all read in. - (inhibit-modification-hooks t)) - (if (consp dired-directory) - (setq dirname (car dired-directory)) - (setq dirname dired-directory)) - (setq dirname (expand-file-name dirname)) + (let ((dirname + (expand-file-name + (if (consp dired-directory) + (car dired-directory) + dired-directory)))) (save-excursion ;; This hook which may want to modify dired-actual-switches ;; based on dired-directory, e.g. with ange-ftp to a SysV host @@ -1167,17 +1234,25 @@ wildcards, erases the buffer, and builds the subdir-alist anew (setq buffer-undo-list nil)) (setq-local file-name-coding-system (or coding-system-for-read file-name-coding-system)) - (let ((inhibit-read-only t) - ;; Don't make undo entries for readin. - (buffer-undo-list t)) - (widen) - (erase-buffer) - (dired-readin-insert)) - (goto-char (point-min)) - ;; Must first make alist buffer local and set it to nil because - ;; dired-build-subdir-alist will call dired-clear-alist first - (setq-local dired-subdir-alist nil) - (dired-build-subdir-alist) + (widen) + ;; We used to bind `inhibit-modification-hooks' to try and speed up + ;; execution, in particular, to prevent the font-lock hook from running + ;; until the directory is all read in. + ;; It's not clear why font-lock would be a significant issue + ;; here, but I used `combine-change-calls' which should provide the + ;; same performance advantages without the problem of breaking + ;; users of after/before-change-functions. + (combine-change-calls (point-min) (point-max) + (let ((inhibit-read-only t) + ;; Don't make undo entries for readin. + (buffer-undo-list t)) + (erase-buffer) + (dired-readin-insert)) + (goto-char (point-min)) + ;; Must first make alist buffer local and set it to nil because + ;; dired-build-subdir-alist will call dired-clear-alist first + (setq-local dired-subdir-alist nil) + (dired-build-subdir-alist)) (let ((attributes (file-attributes dirname))) (if (eq (car attributes) t) (set-visited-file-modtime (file-attribute-modification-time @@ -1811,6 +1886,7 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST." (define-key map "\177" 'dired-unmark-backward) (define-key map [remap undo] 'dired-undo) (define-key map [remap advertised-undo] 'dired-undo) + (define-key map [remap vc-next-action] 'dired-vc-next-action) ;; thumbnail manipulation (image-dired) (define-key map "\C-td" 'image-dired-display-thumbs) (define-key map "\C-tt" 'image-dired-tag-files) @@ -2149,6 +2225,7 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST." ;; Dired mode is suitable only for specially formatted data. (put 'dired-mode 'mode-class 'special) +(defvar grep-read-files-function) ;; Autoload cookie needed by desktop.el ;;;###autoload (defun dired-mode (&optional dirname switches) @@ -2210,7 +2287,6 @@ Hooks (use \\[describe-variable] to see their documentation): `dired-before-readin-hook' `dired-after-readin-hook' `dired-mode-hook' - `dired-load-hook' Keybindings: \\{dired-mode-map}" @@ -2243,6 +2319,7 @@ Keybindings: (setq-local font-lock-defaults '(dired-font-lock-keywords t nil nil beginning-of-line)) (setq-local desktop-save-buffer 'dired-desktop-buffer-misc-data) + (setq-local grep-read-files-function #'dired-grep-read-files) (setq dired-switches-alist nil) (hack-dir-local-variables-non-file-buffer) ; before sorting (dired-sort-other dired-actual-switches t) @@ -3170,8 +3247,8 @@ Any other value means to ask for each directory." (const :tag "Confirm for each top directory only" top)) :group 'dired) -;; Match anything but `.' and `..'. -(defvar dired-re-no-dot (rx (or (not ".") "..."))) +(define-obsolete-variable-alias 'dired-re-no-dot + 'directory-files-no-dot-files-regexp "28.1") ;; Delete file, possibly delete a directory and all its files. ;; This function is useful outside of dired. One could change its name @@ -3193,7 +3270,9 @@ TRASH non-nil means to trash the file instead of deleting, provided ;; but more efficient (if (not (eq t (car (file-attributes file)))) (delete-file file trash) - (let* ((empty-dir-p (null (directory-files file t dired-re-no-dot)))) + (let* ((empty-dir-p (null (directory-files + file t + directory-files-no-dot-files-regexp)))) (if (and recursive (not empty-dir-p)) (unless (eq recursive 'always) (let ((prompt @@ -3460,26 +3539,27 @@ argument or confirmation)." ;; Mark *Marked Files* window as softly-dedicated, to prevent ;; other buffers e.g. *Completions* from reusing it (bug#17554). (display-buffer-mark-dedicated 'soft)) - (with-displayed-buffer-window + (with-current-buffer-window buffer - (cons 'display-buffer-below-selected - '((window-height . fit-window-to-buffer) - (preserve-size . (nil . t)))) + `(display-buffer-below-selected + (window-height . fit-window-to-buffer) + (preserve-size . (nil . t)) + (body-function + . ,#'(lambda (_window) + ;; Handle (t FILE) just like (FILE), here. That value is + ;; used (only in some cases), to mean just one file that was + ;; marked, rather than the current line file. + (dired-format-columns-of-files + (if (eq (car files) t) (cdr files) files)) + (remove-text-properties (point-min) (point-max) + '(mouse-face nil help-echo nil)) + (setq tab-line-exclude nil)))) #'(lambda (window _value) (with-selected-window window (unwind-protect (apply function args) (when (window-live-p window) - (quit-restore-window window 'kill))))) - ;; Handle (t FILE) just like (FILE), here. That value is - ;; used (only in some cases), to mean just one file that was - ;; marked, rather than the current line file. - (with-current-buffer buffer - (dired-format-columns-of-files - (if (eq (car files) t) (cdr files) files)) - (remove-text-properties (point-min) (point-max) - '(mouse-face nil help-echo nil)) - (setq tab-line-exclude nil)))))) + (quit-restore-window window 'kill))))))))) (defun dired-format-columns-of-files (files) (let ((beg (point))) @@ -3578,7 +3658,8 @@ no ARGth marked file is found before this line." (defun dired-mark (arg &optional interactive) "Mark the file at point in the Dired buffer. -If the region is active, mark all files in the region. +If the region is active in Transient Mark mode, mark all files +in the region if `dired-mark-region' is non-nil. Otherwise, with a prefix arg, mark files on the next ARG lines. If on a subdir headerline, mark all its files except `.' and `..'. @@ -3589,13 +3670,20 @@ this subdir." (interactive (list current-prefix-arg t)) (cond ;; Mark files in the active region. - ((and interactive (use-region-p)) + ((and interactive dired-mark-region + (region-active-p) + (> (region-end) (region-beginning))) (save-excursion (let ((beg (region-beginning)) (end (region-end))) (dired-mark-files-in-region (progn (goto-char beg) (line-beginning-position)) - (progn (goto-char end) (line-beginning-position)))))) + (progn (goto-char end) + (if (if (eq dired-mark-region 'line) + (not (bolp)) + (get-text-property (1- (point)) 'dired-filename)) + (line-end-position) + (line-beginning-position))))))) ;; Mark subdir files from the subdir headerline. ((dired-get-subdir) (save-excursion (dired-mark-subdir-files))) @@ -3643,12 +3731,18 @@ in the active region." "Toggle marks: marked files become unmarked, and vice versa. Flagged files (indicated with flags such as `C' and `D', not with `*') are not affected, and `.' and `..' are never toggled. -As always, hidden subdirs are not affected." +As always, hidden subdirs are not affected. + +In Transient Mark mode, if the mark is active, operate on the contents +of the region if `dired-mark-region' is non-nil. Otherwise, operate +on the whole buffer." (interactive) (save-excursion - (goto-char (point-min)) - (let ((inhibit-read-only t)) - (while (not (eobp)) + (let ((inhibit-read-only t) + (beg (dired-mark--region-beginning)) + (end (dired-mark--region-end))) + (goto-char beg) + (while (< (point) end) (or (dired-between-files) (looking-at-p dired-re-dot) ;; use subst instead of insdel because it does not move @@ -3676,6 +3770,9 @@ As always, hidden subdirs are not affected." A prefix argument means to unmark them instead. `.' and `..' are never marked. +If the region is active in Transient Mark mode, mark files +only in the active region if `dired-mark-region' is non-nil. + REGEXP is an Emacs regexp, not a shell wildcard. Thus, use `\\.o$' for object files--just `.o' will mark more than you might think." (interactive @@ -3727,6 +3824,9 @@ object files--just `.o' will mark more than you might think." A prefix argument means to unmark them instead. `.' and `..' are never marked. +If the region is active in Transient Mark mode, mark files +only in the active region if `dired-mark-region' is non-nil. + Note that if a file is visited in an Emacs buffer, and `dired-always-read-filesystem' is nil, this command will look in the buffer without revisiting the file, so the results might @@ -3771,14 +3871,18 @@ The match is against the non-directory part of the filename. Use `^' (defun dired-mark-symlinks (unflag-p) "Mark all symbolic links. -With prefix argument, unmark or unflag all those files." +With prefix argument, unmark or unflag all those files. +If the region is active in Transient Mark mode, mark files +only in the active region if `dired-mark-region' is non-nil." (interactive "P") (let ((dired-marker-char (if unflag-p ?\s dired-marker-char))) (dired-mark-if (looking-at-p dired-re-sym) "symbolic link"))) (defun dired-mark-directories (unflag-p) "Mark all directory file lines except `.' and `..'. -With prefix argument, unmark or unflag all those files." +With prefix argument, unmark or unflag all those files. +If the region is active in Transient Mark mode, mark files +only in the active region if `dired-mark-region' is non-nil." (interactive "P") (let ((dired-marker-char (if unflag-p ?\s dired-marker-char))) (dired-mark-if (and (looking-at-p dired-re-dir) @@ -3787,7 +3891,9 @@ With prefix argument, unmark or unflag all those files." (defun dired-mark-executables (unflag-p) "Mark all executable files. -With prefix argument, unmark or unflag all those files." +With prefix argument, unmark or unflag all those files. +If the region is active in Transient Mark mode, mark files +only in the active region if `dired-mark-region' is non-nil." (interactive "P") (let ((dired-marker-char (if unflag-p ?\s dired-marker-char))) (dired-mark-if (looking-at-p dired-re-exe) "executable file"))) @@ -3797,7 +3903,9 @@ With prefix argument, unmark or unflag all those files." (defun dired-flag-auto-save-files (&optional unflag-p) "Flag for deletion files whose names suggest they are auto save files. -A prefix argument says to unmark or unflag those files instead." +A prefix argument says to unmark or unflag those files instead. +If the region is active in Transient Mark mode, flag files +only in the active region if `dired-mark-region' is non-nil." (interactive "P") (let ((dired-marker-char (if unflag-p ?\s dired-del-marker))) (dired-mark-if @@ -3837,7 +3945,9 @@ A prefix argument says to unmark or unflag those files instead." (defun dired-flag-backup-files (&optional unflag-p) "Flag all backup files (names ending with `~') for deletion. -With prefix argument, unmark or unflag these files." +With prefix argument, unmark or unflag these files. +If the region is active in Transient Mark mode, flag files +only in the active region if `dired-mark-region' is non-nil." (interactive "P") (let ((dired-marker-char (if unflag-p ?\s dired-del-marker))) (dired-mark-if @@ -3857,28 +3967,31 @@ With prefix argument, unmark or unflag these files." (if fn (backup-file-name-p fn)))) "backup file"))) -(defun dired-change-marks (&optional old new) +(defun dired-change-marks (old new) "Change all OLD marks to NEW marks. OLD and NEW are both characters used to mark files." + (declare (advertised-calling-convention '(old new) "28.1")) (interactive (let* ((cursor-in-echo-area t) (old (progn (message "Change (old mark): ") (read-char))) (new (progn (message "Change %c marks to (new mark): " old) (read-char)))) (list old new))) - (if (or (eq old ?\r) (eq new ?\r)) - (ding) - (let ((string (format "\n%c" old)) - (inhibit-read-only t)) - (save-excursion - (goto-char (point-min)) - (while (search-forward string nil t) - (if (if (= old ?\s) - (save-match-data - (dired-get-filename 'no-dir t)) - t) - (subst-char-in-region (match-beginning 0) - (match-end 0) old new))))))) + (dolist (c (list new old)) + (if (or (not (char-displayable-p c)) + (eq c ?\r)) + (user-error "Invalid mark character: `%c'" c))) + (let ((string (format "\n%c" old)) + (inhibit-read-only t)) + (save-excursion + (goto-char (point-min)) + (while (search-forward string nil t) + (if (if (= old ?\s) + (save-match-data + (dired-get-filename 'no-dir t)) + t) + (subst-char-in-region (match-beginning 0) + (match-end 0) old new)))))) (defun dired-unmark-all-marks () "Remove all marks from all files in the Dired buffer." |