Skip to content

GitLab

Commit 6482fcac authored by Richard M. Stallman's avatar Richard M. Stallman
Browse files

*** empty log message ***

parent 1586b965
Hide whitespace changes
Inline Side-by-side
Showing with 100 additions and 85 deletions
lisp/dired-aux.el
View file @ 6482fcac
......@@ -28,6 +28,9 @@
;;; Code:
;; We need macros in dired.el to compile properly.
(eval-when-compile (require 'dired))
;;; 15K
;;;###begin dired-cmd.el
;; Diffing and compressing
......@@ -127,7 +130,7 @@ This calls chmod, thus symbolic modes like `g+w' are allowed."
;; and this file won't fit in the length limit, process now.
(if (and pending (> (+ thislength pending-length) max))
(setq failures
(nconc (apply function (append args pending) pending)
(nconc (apply function (append args pending))
failures)
pending nil
pending-length 0))
......@@ -137,7 +140,7 @@ This calls chmod, thus symbolic modes like `g+w' are allowed."
(setq pending files)
(setq pending-length (+ thislength pending-length))
(setq files rest)))
(nconc (apply function (append args pending) pending)
(nconc (apply function (append args pending))
failures)))
;;;###autoload
......@@ -172,6 +175,8 @@ Uses the shell command coming from variables `lpr-command' and
;;; Cleaning a directory: flagging some backups for deletion.
(defvar dired-file-version-alist)
(defun dired-clean-directory (keep)
"Flag numerical backups for deletion.
Spares `dired-kept-versions' latest versions, and `kept-old-versions' oldest.
......@@ -282,46 +287,47 @@ with a prefix argument."
;; The in-background argument is only needed in Emacs 18 where
;; shell-command doesn't understand an appended ampersand `&'.
;;;###autoload
(defun dired-do-shell-command (&optional arg in-background)
"Run a shell command on the marked files.
(defun dired-do-shell-command (command &optional arg)
"Run a shell command COMMAND on the marked files.
If no files are marked or a specific numeric prefix arg is given,
the next ARG files are used. Just \\[universal-argument] means the current file.
The prompt mentions the file(s) or the marker, as appropriate.
If there is output, it goes to a separate buffer.
Normally the command is run on each file individually.
However, if there is a `*' in the command then it is run
just once with the entire file list substituted there.
If no files are marked or a specific numeric prefix arg is given,
the next ARG files are used. Just \\[universal-argument] means the current file.
The prompt mentions the file(s) or the marker, as appropriate.
No automatic redisplay is attempted, as the file names may have
changed. Type \\[dired-do-redisplay] to redisplay the marked files.
No automatic redisplay of dired buffers is attempted, as there's no
telling what files the command may have changed. Type
\\[dired-do-redisplay] to redisplay the marked files.
The shell command has the top level directory as working directory, so
output files usually are created there instead of in a subdir."
;;Functions dired-run-shell-command and dired-shell-stuff-it do the
;;actual work and can be redefined for customization.
(interactive "P")
(interactive (list
;; Want to give feedback whether this file or marked files are used:
(dired-read-shell-command (concat "! on "
"%s: ")
current-prefix-arg
(dired-get-marked-files
t current-prefix-arg))
current-prefix-arg))
(let* ((on-each (not (string-match "\\*" command)))
(prompt (concat (if in-background "& on " "! on ")
(if on-each "each " "")
"%s: "))
(file-list (dired-get-marked-files t arg))
;; Want to give feedback whether this file or marked files are used:
(command (dired-read-shell-command
prompt arg file-list)))
(file-list (dired-get-marked-files t arg)))
(if on-each
(dired-bunch-files
(- 10000 (length command))
(function (lambda (&rest files)
(dired-run-shell-command
(dired-shell-stuff-it command files t arg))
in-background))
(dired-shell-stuff-it command files t arg))))
nil
file-list)
;; execute the shell command
(dired-run-shell-command
(dired-shell-stuff-it command file-list nil arg)
in-background))))
(dired-shell-stuff-it command file-list nil arg)))))
;; Might use {,} for bash or csh:
(defvar dired-mark-prefix ""
......@@ -356,12 +362,10 @@ output files usually are created there instead of in a subdir."
(funcall stuff-it fns)))))
;; This is an extra function so that it can be redefined by ange-ftp.
(defun dired-run-shell-command (command &optional in-background)
(if (not in-background)
(shell-command command)
;; We need this only in Emacs 18 (19's shell command has `&').
;; comint::background is defined in emacs-19.el.
(comint::background command)))
(defun dired-run-shell-command (command)
(shell-command command)
;; Return nil for sake of nconc in dired-bunch-files.
nil)
;; In Emacs 19 this will return program's exit status.
;; This is a separate function so that ange-ftp can redefine it.
......@@ -398,17 +402,6 @@ output files usually are created there instead of in a subdir."
;; Commands that delete or redisplay part of the dired buffer.
;;;###autoload
(defun dired-kill-line-or-subdir (&optional arg)
"Kill this line (but don't delete its file).
Optional prefix argument is a repeat factor.
If file is displayed as in situ subdir, kill that as well.
If on a subdir headerline, kill whole subdir."
(interactive "p")
(if (dired-get-subdir)
(dired-kill-subdir)
(dired-kill-line arg)))
(defun dired-kill-line (&optional arg)
(interactive "P")
(setq arg (prefix-numeric-value arg))
......@@ -431,31 +424,38 @@ If on a subdir headerline, kill whole subdir."
;;;###autoload
(defun dired-do-kill-lines (&optional arg fmt)
"Kill all marked lines (not the files).
With a prefix arg, kill all lines not marked or flagged."
With a prefix argument, kill that many lines starting with the current line.
\(A negative argument kills lines before the current line.)
To kill an entire subdirectory, go to its directory header line
and use this command with a prefix argument (the value does not matter)."
;; Returns count of killed lines. FMT="" suppresses message.
(interactive "P")
(save-excursion
(goto-char (point-min))
(let (buffer-read-only (count 0))
(if (not arg) ; kill marked lines
(let ((regexp (dired-marker-regexp)))
(while (and (not (eobp))
(re-search-forward regexp nil t))
(if arg
(if (dired-get-subdir)
(dired-kill-subdir)
(dired-kill-line arg))
(save-excursion
(goto-char (point-min))
(let (buffer-read-only (count 0))
(if (not arg) ; kill marked lines
(let ((regexp (dired-marker-regexp)))
(while (and (not (eobp))
(re-search-forward regexp nil t))
(setq count (1+ count))
(delete-region (progn (beginning-of-line) (point))
(progn (forward-line 1) (point)))))
;; else kill unmarked lines
(while (not (eobp))
(if (or (dired-between-files)
(not (looking-at "^ ")))
(forward-line 1)
(setq count (1+ count))
(delete-region (progn (beginning-of-line) (point))
(progn (forward-line 1) (point)))))
;; else kill unmarked lines
(while (not (eobp))
(if (or (dired-between-files)
(not (looking-at "^ ")))
(forward-line 1)
(setq count (1+ count))
(delete-region (point) (save-excursion
(forward-line 1)
(point))))))
(or (equal "" fmt)
(message (or fmt "Killed %d line%s.") count (dired-plural-s count)))
count)))
(delete-region (point) (save-excursion
(forward-line 1)
(point))))))
(or (equal "" fmt)
(message (or fmt "Killed %d line%s.") count (dired-plural-s count)))
count))))
;;;###end dired-cmd.el
......@@ -645,7 +645,8 @@ a prefix arg lets you edit the `ls' switches used for the new listing."
;; here is faster than with dired-add-entry's optional arg).
;; Does not update other dired buffers. Use dired-relist-entry for that.
(beginning-of-line)
(let ((char (following-char)) (opoint (point)))
(let ((char (following-char)) (opoint (point))
(buffer-read-only))
(delete-region (point) (progn (forward-line 1) (point)))
(if file
(progn
......@@ -801,12 +802,14 @@ a prefix arg lets you edit the `ls' switches used for the new listing."
"*Non-nil if Dired should ask about making backups before overwriting files.
Special value `always' suppresses confirmation.")
(defvar dired-overwrite-confirmed)
(defun dired-handle-overwrite (to)
;; Save old version of a to be overwritten file TO.
;; `overwrite-confirmed' and `overwrite-backup-query' are fluid vars
;; `dired-overwrite-confirmed' and `overwrite-backup-query' are fluid vars
;; from dired-create-files.
(if (and dired-backup-overwrite
overwrite-confirmed
dired-overwrite-confirmed
(or (eq 'always dired-backup-overwrite)
(dired-query 'overwrite-backup-query
(format "Make backup for existing file `%s'? " to))))
......@@ -1013,7 +1016,7 @@ Optional arg GLOBAL means to replace all matches."
(if (not to)
(setq skipped (cons (dired-make-relative from) skipped))
(let* ((overwrite (file-exists-p to))
(overwrite-confirmed ; for dired-handle-overwrite
(dired-overwrite-confirmed ; for dired-handle-overwrite
(and overwrite
(let ((help-form '(format "\
Type SPC or `y' to overwrite file `%s',
......@@ -1030,7 +1033,7 @@ ESC or `q' to not overwrite any of the remaining files,
(t nil))))
(condition-case err
(progn
(funcall file-creator from to overwrite-confirmed)
(funcall file-creator from to dired-overwrite-confirmed)
(if overwrite
;; If we get here, file-creator hasn't been aborted
;; and the old entry (if any) has to be deleted
......
lisp/dired.el
View file @ 6482fcac
......@@ -630,7 +630,7 @@ If DIRNAME is already in a dired buffer, that buffer is used without refresh."
(define-key dired-mode-map "/" 'dired-mark-directories)
(define-key dired-mode-map "@" 'dired-mark-symlinks)
(define-key dired-mode-map "~" 'dired-flag-backup-files)
;; Upper case keys (except !, c) for operating on the marked files
;; Upper case keys (except !) for operating on the marked files
(define-key dired-mode-map "C" 'dired-do-copy)
(define-key dired-mode-map "B" 'dired-do-byte-compile)
(define-key dired-mode-map "D" 'dired-do-delete)
......@@ -657,8 +657,6 @@ If DIRNAME is already in a dired buffer, that buffer is used without refresh."
;; move to marked files
(define-key dired-mode-map "\M-{" 'dired-prev-marked-file)
(define-key dired-mode-map "\M-}" 'dired-next-marked-file)
;; kill marked files
(define-key dired-mode-map "\M-k" 'dired-do-kill-lines)
;; Make all regexp commands share a `%' prefix:
(fset 'dired-regexp-prefix (make-sparse-keymap))
(define-key dired-mode-map "%" 'dired-regexp-prefix)
......@@ -672,13 +670,14 @@ If DIRNAME is already in a dired buffer, that buffer is used without refresh."
(define-key dired-mode-map "%R" 'dired-do-rename-regexp)
(define-key dired-mode-map "%S" 'dired-do-symlink-regexp)
;; Lower keys for commands not operating on all the marked files
(define-key dired-mode-map "c" 'dired-change-marks)
(define-key dired-mode-map "d" 'dired-flag-file-deletion)
(define-key dired-mode-map "e" 'dired-find-file)
(define-key dired-mode-map "f" 'dired-advertised-find-file)
(define-key dired-mode-map "g" 'revert-buffer)
(define-key dired-mode-map "h" 'describe-mode)
(define-key dired-mode-map "i" 'dired-maybe-insert-subdir)
(define-key dired-mode-map "k" 'dired-kill-line-or-subdir)
(define-key dired-mode-map "k" 'dired-do-kill-lines)
(define-key dired-mode-map "l" 'dired-do-redisplay)
(define-key dired-mode-map "m" 'dired-mark)
(define-key dired-mode-map "n" 'dired-next-line)
......@@ -1678,6 +1677,24 @@ With prefix argument, unflag these files."
(if fn (backup-file-name-p fn))))
"backup file")))
(defun dired-change-marks (&optional old new)
"Change all OLD marks to NEW marks.
OLD and NEW are both characters used to mark files."
(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)))
(let ((regexp (format "^%s" (regexp-quote old)))
(buffer-read-only))
(save-excursion
(goto-char (point-min))
(while (re-search-forward regexp nil t)
(beginning-of-line)
(delete-region (point) (1+ (point)))
(insert-char new 1)))))
(defun dired-unmark-all-files (flag &optional arg)
"Remove a specific mark or any mark from every file.
With an arg, queries for each marked file.
......@@ -1713,7 +1730,7 @@ Thus, use \\[backward-page] to find the beginning of a group of errors."
(let ((owindow (selected-window))
(window (display-buffer (get-buffer dired-log-buffer))))
(unwind-protect
(save-excursion
(progn
(select-window window)
(goto-char (point-max))
(recenter -1))
......@@ -1881,30 +1898,25 @@ Uses the shell command coming from variables `lpr-command' and
t)
(autoload 'dired-do-shell-command "dired-aux"
"Run a shell command on the marked files.
"Run a shell command COMMAND on the marked files.
If no files are marked or a specific numeric prefix arg is given,
the next ARG files are used. Just \\[universal-argument] means the current file.
The prompt mentions the file(s) or the marker, as appropriate.
If there is output, it goes to a separate buffer.
Normally the command is run on each file individually.
However, if there is a `*' in the command then it is run
just once with the entire file list substituted there.
If no files are marked or a specific numeric prefix arg is given,
the next ARG files are used. Just \\[universal-argument] means the current file.
The prompt mentions the file(s) or the marker, as appropriate.
No automatic redisplay is attempted, as the file names may have
changed. Type \\[dired-do-redisplay] to redisplay the marked files.
No automatic redisplay of dired buffers is attempted, as there's no
telling what files the command may have changed. Type
\\[dired-do-redisplay] to redisplay the marked files.
The shell command has the top level directory as working directory, so
output files usually are created there instead of in a subdir."
t)
(autoload 'dired-kill-line-or-subdir "dired-aux"
"Kill this line (but don't delete its file).
Optional prefix argument is a repeat factor.
If file is displayed as in situ subdir, kill that as well.
If on a subdir headerline, kill whole subdir."
t)
(autoload 'dired-do-kill-lines "dired-aux"
"Kill all marked lines (not the files).
With a prefix arg, kill all lines not marked or flagged."
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment