X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/4f1d7d31737310082d0e03b0007d0c25db175480..d18a808f42266d6a1873373e6fef9ca6e74a5226:/lisp/dired-aux.el diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 4588c8e8bc..175e48cd1f 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -1,8 +1,9 @@ ;;; dired-aux.el --- less commonly used parts of dired -*-byte-compile-dynamic: t;-*- -;; Copyright (C) 1985, 1986, 1992, 1994 Free Software Foundation, Inc. +;; Copyright (C) 1985, 1986, 1992, 1994, 1998 Free Software Foundation, Inc. ;; Author: Sebastian Kremer . +;; Maintainer: FSF ;; This file is part of GNU Emacs. @@ -267,7 +268,7 @@ with a prefix argument." ;;The caller may want to flag some of these files for deletion. (let* ((base-versions (concat (file-name-nondirectory fn) ".~")) - (bv-length (length base-versions)) + (backup-extract-version-start (length base-versions)) (possibilities (file-name-all-completions base-versions (file-name-directory fn))) @@ -291,18 +292,6 @@ with a prefix argument." (insert dired-del-marker))))) ;;; Shell commands -;;>>> install (move this function into simple.el) -(defun dired-shell-quote (filename) - "Quote a file name for inferior shell (see variable `shell-file-name')." - ;; Quote everything except POSIX filename characters. - ;; This should be safe enough even for really weird shells. - (let ((result "") (start 0) end) - (while (string-match "[^-0-9a-zA-Z_./]" filename start) - (setq end (match-beginning 0) - result (concat result (substring filename start end) - "\\" (substring filename end (1+ end))) - start (1+ end))) - (concat result (substring filename start)))) (defun dired-read-shell-command (prompt arg files) ;; "Read a dired shell command prompting with PROMPT (using read-string). @@ -318,7 +307,7 @@ 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 (command &optional arg) +(defun dired-do-shell-command (command &optional arg file-list) "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. @@ -338,16 +327,17 @@ 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 (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))) - (file-list (dired-get-marked-files t arg))) + (interactive + (let ((files (dired-get-marked-files t current-prefix-arg))) + (list + ;; Want to give feedback whether this file or marked files are used: + (dired-read-shell-command (concat "! on " + "%s: ") + current-prefix-arg + files) + current-prefix-arg + files))) + (let* ((on-each (not (string-match "\\*" command)))) (if on-each (dired-bunch-files (- 10000 (length command)) @@ -385,8 +375,8 @@ output files usually are created there instead of in a subdir." (dired-replace-in-string "\\*" x command))) (function (lambda (x) (concat command " " x)))))) (if on-each - (mapconcat stuff-it (mapcar 'dired-shell-quote file-list) ";") - (let ((fns (mapconcat 'dired-shell-quote + (mapconcat stuff-it (mapcar 'shell-quote-argument file-list) ";") + (let ((fns (mapconcat 'shell-quote-argument file-list dired-mark-separator))) (if (> (length file-list) 1) (setq fns (concat dired-mark-prefix fns dired-mark-postfix))) @@ -394,7 +384,11 @@ output files usually are created there instead of in a subdir." ;; This is an extra function so that it can be redefined by ange-ftp. (defun dired-run-shell-command (command) - (shell-command command) + (let ((handler + (find-file-name-handler (directory-file-name default-directory) + 'shell-command))) + (if handler (apply handler 'shell-command (list command)) + (shell-command command))) ;; Return nil for sake of nconc in dired-bunch-files. nil) @@ -756,7 +750,7 @@ a prefix arg lets you edit the `ls' switches used for the new listing." (delete-region (point) (progn (forward-line 1) (point))) (if file (progn - (dired-add-entry file) + (dired-add-entry file nil t) ;; Replace space by old marker without moving point. ;; Faster than goto+insdel inside a save-excursion? (subst-char-in-region opoint (1+ opoint) ?\040 char)))) @@ -789,7 +783,7 @@ a prefix arg lets you edit the `ls' switches used for the new listing." (file-name-directory filename) (file-name-nondirectory filename) (function dired-add-entry) filename marker-char)) -(defun dired-add-entry (filename &optional marker-char) +(defun dired-add-entry (filename &optional marker-char relative) ;; Add a new entry for FILENAME, optionally marking it ;; with MARKER-CHAR (a character, else dired-marker-char is used). ;; Note that this adds the entry `out of order' if files sorted by @@ -799,12 +793,15 @@ a prefix arg lets you edit the `ls' switches used for the new listing." ;; Hidden subdirs are exposed if a file is added there. (setq filename (directory-file-name filename)) ;; Entry is always for files, even if they happen to also be directories - (let ((opoint (point)) + (let* ((opoint (point)) (cur-dir (dired-current-directory)) (orig-file-name filename) - (directory (file-name-directory filename)) + (directory (if relative cur-dir (file-name-directory filename))) reason) - (setq filename (file-name-nondirectory filename) + (setq filename + (if relative + (file-relative-name filename directory) + (file-name-nondirectory filename)) reason (catch 'not-found (if (string= directory cur-dir) @@ -925,9 +922,13 @@ a prefix arg lets you edit the `ls' switches used for the new listing." ;;; Copy, move/rename, making hard and symbolic links -(defvar dired-backup-overwrite nil +(defcustom dired-backup-overwrite nil "*Non-nil if Dired should ask about making backups before overwriting files. -Special value `always' suppresses confirmation.") +Special value `always' suppresses confirmation." + :type '(choice (const :tag "off" nil) + (const :tag "suppress" always) + (other :tag "ask" t)) + :group 'dired) (defvar dired-overwrite-confirmed) @@ -1750,7 +1751,9 @@ The next char is either \\n, or \\r if DIR is hidden." ;;;###autoload (defun dired-mark-subdir-files () - "Mark all files except `.' and `..'." + "Mark all files except `.' and `..' in current subdirectory. +If the Dired buffer shows multiple directories, this command +marks the files listed in the subdirectory that point is in." (interactive) (let ((p-min (dired-subdir-min))) (dired-mark-files-in-region p-min (dired-subdir-max))))