X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/10195bd66d5e64c7df1db1d961bddcf7f4f618e3..ef62b23df5a7007c3d8c74dbca87ba83e9da682e:/lisp/dired.el diff --git a/lisp/dired.el b/lisp/dired.el index ecb626a275..7428087ca8 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -1,6 +1,6 @@ ;;; dired.el --- directory-browsing commands -*- lexical-binding: t -*- -;; Copyright (C) 1985-1986, 1992-1997, 2000-2011 +;; Copyright (C) 1985-1986, 1992-1997, 2000-2012 ;; Free Software Foundation, Inc. ;; Author: Sebastian Kremer @@ -670,31 +670,31 @@ Don't use that together with FILTER." ;; (dolist (ext completion-ignored-extensions) ;; (if (eq ?/ (aref ext (1- (length ext)))) (push ext cie))) ;; (setq cie (concat (regexp-opt cie "\\(?:") "\\'")) -;; (lexical-let* ((default (and buffer-file-name -;; (abbreviate-file-name buffer-file-name))) -;; (cie cie) -;; (completion-table -;; ;; We need a mix of read-file-name and -;; ;; read-directory-name so that completion to directories -;; ;; is preferred, but if the user wants to enter a global -;; ;; pattern, he can still use completion on filenames to -;; ;; help him write the pattern. -;; ;; Essentially, we want to use -;; ;; (completion-table-with-predicate -;; ;; 'read-file-name-internal 'file-directory-p nil) -;; ;; but that doesn't work because read-file-name-internal -;; ;; does not obey its `predicate' argument. -;; (completion-table-in-turn -;; (lambda (str pred action) -;; (let ((read-file-name-predicate -;; (lambda (f) -;; (and (not (member f '("./" "../"))) -;; ;; Hack! Faster than file-directory-p! -;; (eq (aref f (1- (length f))) ?/) -;; (not (string-match cie f)))))) -;; (complete-with-action -;; action 'read-file-name-internal str nil))) -;; 'read-file-name-internal))) +;; (let* ((default (and buffer-file-name +;; (abbreviate-file-name buffer-file-name))) +;; (cie cie) +;; (completion-table +;; ;; We need a mix of read-file-name and +;; ;; read-directory-name so that completion to directories +;; ;; is preferred, but if the user wants to enter a global +;; ;; pattern, he can still use completion on filenames to +;; ;; help him write the pattern. +;; ;; Essentially, we want to use +;; ;; (completion-table-with-predicate +;; ;; 'read-file-name-internal 'file-directory-p nil) +;; ;; but that doesn't work because read-file-name-internal +;; ;; does not obey its `predicate' argument. +;; (completion-table-in-turn +;; (lambda (str pred action) +;; (let ((read-file-name-predicate +;; (lambda (f) +;; (and (not (member f '("./" "../"))) +;; ;; Hack! Faster than file-directory-p! +;; (eq (aref f (1- (length f))) ?/) +;; (not (string-match cie f)))))) +;; (complete-with-action +;; action 'read-file-name-internal str nil))) +;; 'read-file-name-internal))) ;; (minibuffer-with-setup-hook ;; (lambda () ;; (setq minibuffer-default default) @@ -704,7 +704,7 @@ Don't use that together with FILTER." (defun dired-file-name-at-point () "Try to get a file name at point in the current dired buffer. -This hook is inteneded to be put in `file-name-at-point-functions'." +This hook is intended to be put in `file-name-at-point-functions'." (let ((filename (dired-get-filename nil t))) (when filename (if (file-directory-p filename) @@ -1025,7 +1025,7 @@ BEG..END is the line where the file info is located." ;; spaces there (and within the filename as well, of course). (save-excursion (let (file file-col other other-col) - ;; Check that there is indeed a file, and that there is anoter adjacent + ;; Check that there is indeed a file, and that there is another adjacent ;; file with which to align, and that additional spaces are needed to ;; align the filenames. (when (and (setq file (progn (goto-char beg) @@ -1111,6 +1111,11 @@ BEG..END is the line where the file info is located." (defvar ls-lisp-use-insert-directory-program) +(defun dired-switches-escape-p (switches) + "Return non-nil if the string SWITCHES contains -b or --escape." + ;; Do not match things like "--block-size" that happen to contain "b". + (string-match "\\(\\`\\| \\)-[[:alnum:]]*b\\|--escape\\>" switches)) + (defun dired-insert-directory (dir switches &optional file-list wildcard hdr) "Insert a directory listing of DIR, Dired style. Use SWITCHES to make the listings. @@ -1152,7 +1157,7 @@ see `dired-use-ls-dired' for more details.") (dired-align-file beg (point)))) (insert-directory dir switches wildcard (not wildcard))) ;; Quote certain characters, unless ls quoted them for us. - (if (not (string-match "b" dired-actual-switches)) + (if (not (dired-switches-escape-p dired-actual-switches)) (save-excursion (setq end (point-marker)) (goto-char opoint) @@ -1167,7 +1172,22 @@ see `dired-use-ls-dired' for more details.") "\\015" (text-properties-at (match-beginning 0))) nil t)) - (set-marker end nil))) + (set-marker end nil)) + ;; Replace any newlines in DIR with literal "\n"s, for the sake + ;; of the header line. To disambiguate a literal "\n" in the + ;; actual dirname, we also replace "\" with "\\". + ;; Personally, I think this should always be done, irrespective + ;; of the value of dired-actual-switches, because: + ;; i) Dired simply does not work with an unescaped newline in + ;; the directory name used in the header (bug=10469#28), and + ;; ii) "\" is always replaced with "\\" in the listing, so doing + ;; it in the header as well makes things consistent. + ;; But at present it is only done if "-b" is in ls-switches, + ;; because newlines in dirnames are uncommon, and people may + ;; have gotten used to seeing unescaped "\" in the headers. + ;; Note: adjust dired-build-subdir-alist if you change this. + (setq dir (replace-regexp-in-string "\\\\" "\\\\" dir nil t) + dir (replace-regexp-in-string "\n" "\\n" dir nil t))) (dired-insert-set-properties opoint (point)) ;; If we used --dired and it worked, the lines are already indented. ;; Otherwise, indent them. @@ -1552,6 +1572,10 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST." [menu-bar immediate image-dired-dired-display-image] '(menu-item "Display Image" image-dired-dired-display-image :help "Display sized image in a separate window")) + (define-key map + [menu-bar immediate image-dired-dired-toggle-marked-thumbs] + '(menu-item "Toggle Image Thumbnails in This Buffer" image-dired-dired-toggle-marked-thumbs + :help "Add or remove image thumbnails in front of marked file names")) (define-key map [menu-bar immediate revert-buffer] '(menu-item "Refresh" revert-buffer @@ -1708,7 +1732,7 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST." :help "Add image comment to current or marked files")) (define-key map [menu-bar operate image-dired-display-thumbs] - '(menu-item "Display image thumbnails" image-dired-display-thumbs + '(menu-item "Display Image Thumbnails" image-dired-display-thumbs :help "Display image thumbnails for current or marked image files")) (define-key map [menu-bar operate dashes-4] @@ -1940,7 +1964,8 @@ Otherwise, for buffers inheriting from dired-mode, call `toggle-read-only'." (interactive) (if (eq major-mode 'dired-mode) (wdired-change-to-wdired-mode) - (toggle-read-only))) + (with-no-warnings + (toggle-read-only)))) (defun dired-next-line (arg) "Move down lines then position at filename. @@ -2095,7 +2120,18 @@ Otherwise, an error occurs in these cases." ;; with quotation marks in their names. (while (string-match "\\(?:[^\\]\\|\\`\\)\\(\"\\)" file) (setq file (replace-match "\\\"" nil t file 1))) - + ;; Unescape any spaces escaped by ls -b (bug#10469). + ;; Other -b quotes, eg \t, \n, work transparently. + (if (dired-switches-escape-p dired-actual-switches) + (let ((start 0) + (rep "") + (shift -1)) + (if (eq localp 'verbatim) + (setq rep "\\\\" + shift +1)) + (while (string-match "\\(\\\\\\) " file start) + (setq file (replace-match rep nil t file 1) + start (+ shift (match-end 0)))))) (when (eq system-type 'windows-nt) (save-match-data (let ((start 0)) @@ -2103,6 +2139,7 @@ Otherwise, an error occurs in these cases." (aset file (match-beginning 0) ?/) (setq start (match-end 0)))))) + ;; Hence we don't need to worry about converting `\\' back to `\'. (setq file (read (concat "\"" file "\""))) ;; The above `read' will return a unibyte string if FILE ;; contains eight-bit-control/graphic characters. @@ -2520,12 +2557,31 @@ instead of `dired-actual-switches'." (delete-region (point) (match-end 1)) (insert new-dir-name)) (setq count (1+ count)) + ;; Undo any escaping of newlines and \ by dired-insert-directory. + ;; Convert "n" preceded by odd number of \ to newline, and \\ to \. + (when (and (dired-switches-escape-p switches) + (string-match-p "\\\\" new-dir-name)) + (let (temp res) + (mapc (lambda (char) + (cond ((equal char ?\\) + (if temp + (setq res (concat res "\\") + temp nil) + (setq temp "\\"))) + ((and temp (equal char ?n)) + (setq res (concat res "\n") + temp nil)) + (t + (setq res (concat res temp (char-to-string char)) + temp nil)))) + new-dir-name) + (setq new-dir-name res))) (dired-alist-add-1 new-dir-name - ;; Place a sub directory boundary between lines. - (save-excursion - (goto-char (match-beginning 0)) - (beginning-of-line) - (point-marker))))) + ;; Place a sub directory boundary between lines. + (save-excursion + (goto-char (match-beginning 0)) + (beginning-of-line) + (point-marker))))) (if (and (> count 1) (called-interactively-p 'interactive)) (message "Buffer includes %d directories" count))) ;; We don't need to sort it because it is in buffer order per @@ -2567,44 +2623,61 @@ instead of `dired-actual-switches'." (read-file-name "Goto file: " (dired-current-directory)))) (push-mark))) - (setq file (directory-file-name file)) ; does no harm if no directory - (let (found case-fold-search dir) - (setq dir (or (file-name-directory file) - (error "File name `%s' is not absolute" file))) - (save-excursion - ;; The hair here is to get the result of dired-goto-subdir - ;; without really calling it if we don't have any subdirs. - (if (if (string= dir (expand-file-name default-directory)) - (goto-char (point-min)) - (and (cdr dired-subdir-alist) - (dired-goto-subdir dir))) - (let ((base (file-name-nondirectory file)) - search-string - (boundary (dired-subdir-max))) - (setq search-string - (replace-regexp-in-string "\^m" "\\^m" base nil t)) - (setq search-string - (replace-regexp-in-string "\\\\" "\\\\" search-string nil t)) - (while (and (not found) - ;; filenames are preceded by SPC, this makes - ;; the search faster (e.g. for the filename "-"!). - (search-forward (concat " " search-string) - boundary 'move)) - ;; Match could have BASE just as initial substring or - ;; or in permission bits or date or - ;; not be a proper filename at all: - (if (equal base (dired-get-filename 'no-dir t)) - ;; Must move to filename since an (actually - ;; correct) match could have been elsewhere on the - ;; ;; line (e.g. "-" would match somewhere in the - ;; permission bits). - (setq found (dired-move-to-filename)) - ;; If this isn't the right line, move forward to avoid - ;; trying this line again. - (forward-line 1)))))) - (and found - ;; return value of point (i.e., FOUND): - (goto-char found)))) + (unless (file-name-absolute-p file) + (error "File name `%s' is not absolute" file)) + (setq file (directory-file-name file)) ; does no harm if not a directory + (let* ((case-fold-search nil) + (dir (file-name-directory file)) + (found (or + ;; First, look for a listing under the absolute name. + (save-excursion + (goto-char (point-min)) + (dired-goto-file-1 file file (point-max))) + ;; Otherwise, look for it as a relative name. The + ;; hair is to get the result of `dired-goto-subdir' + ;; without calling it if we don't have any subdirs. + (save-excursion + (when (if (string= dir (expand-file-name default-directory)) + (goto-char (point-min)) + (and (cdr dired-subdir-alist) + (dired-goto-subdir dir))) + (dired-goto-file-1 (file-name-nondirectory file) + file + (dired-subdir-max))))))) + ;; Return buffer position, if found. + (if found + (goto-char found)))) + +(defun dired-goto-file-1 (file full-name limit) + "Advance to the Dired listing labeled by FILE; return its position. +Return nil if the listing is not found. If FILE contains +characters that would not appear in a Dired buffer, search using +the quoted forms of those characters. + +FULL-NAME specifies the actual file name the listing must have, +as returned by `dired-get-filename'. LIMIT is the search limit." + (let (str) + (setq str (replace-regexp-in-string "\^m" "\\^m" file nil t)) + (setq str (replace-regexp-in-string "\\\\" "\\\\" str nil t)) + (and (dired-switches-escape-p dired-actual-switches) + (string-match "[ \t\n]" str) + ;; FIXME: to fix this for embedded control characters etc, we + ;; should escape everything that `ls -b' does. + (setq str (replace-regexp-in-string " " "\\ " str nil t) + str (replace-regexp-in-string "\t" "\\t" str nil t) + str (replace-regexp-in-string "\n" "\\n" str nil t))) + (let ((found nil) + ;; filenames are preceded by SPC, this makes the search faster + ;; (e.g. for the filename "-"). + (search-string (concat " " str))) + (while (and (not found) + (search-forward search-string limit 'move)) + ;; Check that we are in the right place. Match could have + ;; BASE just as initial substring or in permission bits etc. + (if (equal full-name (dired-get-filename nil t)) + (setq found (dired-move-to-filename)) + (forward-line 1))) + found))) (defvar dired-find-subdir) @@ -2674,7 +2747,7 @@ Anything else means ask for each directory." (defvar dired-re-no-dot "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*") ;; Delete file, possibly delete a directory and all its files. -;; This function is usefull outside of dired. One could change it's name +;; This function is useful outside of dired. One could change its name ;; to e.g. recursive-delete-file and put it somewhere else. (defun dired-delete-file (file &optional recursive trash) "\ Delete FILE or directory (possibly recursively if optional RECURSIVE is true.) @@ -2875,7 +2948,7 @@ or \"* [3 files]\"." (window-splittable-p (selected-window))) ;; Try to split the selected window vertically if ;; that's possible. (Bug#1806) - (split-window-vertically)) + (split-window-below)) ;; Otherwise, try to split WINDOW sensibly. (split-window-sensibly window)))) pop-up-frames) @@ -3099,8 +3172,8 @@ object files--just `.o' will mark more than you might think." (dired-mark-if (and (not (looking-at dired-re-dot)) (not (eolp)) ; empty line - (let ((fn (dired-get-filename nil t))) - (and fn (string-match regexp (file-name-nondirectory fn))))) + (let ((fn (dired-get-filename t t))) + (and fn (string-match regexp fn)))) "matching file"))) (defun dired-mark-files-containing-regexp (regexp &optional marker-char) @@ -3387,9 +3460,9 @@ format, use `\\[universal-argument] \\[dired]'.") "Non-nil means the Dired sort command is disabled. The idea is to set this buffer-locally in special dired buffers.") -(defun dired-sort-set-modeline () - ;; Set modeline display according to dired-actual-switches. - ;; Modeline display of "by name" or "by date" guarantees the user a +(defun dired-sort-set-mode-line () + ;; Set mode line display according to dired-actual-switches. + ;; Mode line display of "by name" or "by date" guarantees the user a ;; match with the corresponding regexps. Non-matching switches are ;; shown literally. (when (eq major-mode 'dired-mode) @@ -3405,6 +3478,9 @@ The idea is to set this buffer-locally in special dired buffers.") (concat "Dired " dired-actual-switches))))) (force-mode-line-update))) +(define-obsolete-function-alias 'dired-sort-set-modeline + 'dired-sort-set-mode-line "24.2") + (defun dired-sort-toggle-or-edit (&optional arg) "Toggle sorting by date, and refresh the Dired buffer. With a prefix argument, edit the current listing switches instead." @@ -3436,7 +3512,7 @@ With a prefix argument, edit the current listing switches instead." ;; Now, if we weren't sorting by date before, add the -t switch. (unless sorting-by-date (setq dired-actual-switches (concat dired-actual-switches " -t")))) - (dired-sort-set-modeline) + (dired-sort-set-mode-line) (revert-buffer)) ;; Some user code loads dired especially for this. @@ -3459,7 +3535,7 @@ set the minor mode accordingly, others appear literally in the mode line. With optional second arg NO-REVERT, don't refresh the listing afterwards." (dired-sort-R-check switches) (setq dired-actual-switches switches) - (dired-sort-set-modeline) + (dired-sort-set-mode-line) (or no-revert (revert-buffer))) (defvar dired-subdir-alist-pre-R nil @@ -3663,7 +3739,7 @@ Ask means pop up a menu for the user to select one of copy, move or link." ;;;;;; dired-run-shell-command dired-do-shell-command dired-do-async-shell-command ;;;;;; dired-clean-directory dired-do-print dired-do-touch dired-do-chown ;;;;;; dired-do-chgrp dired-do-chmod dired-compare-directories dired-backup-diff -;;;;;; dired-diff) "dired-aux" "dired-aux.el" "bbb53a5b6bf56c413fe0f898559bef8d") +;;;;;; dired-diff) "dired-aux" "dired-aux.el" "de7e4c64718c8ba8438a6397a460bf23") ;;; Generated autoloads from dired-aux.el (autoload 'dired-diff "dired-aux" "\ @@ -3780,8 +3856,11 @@ file name added at the end of COMMAND (separated by a space). `*' and `?' when not surrounded by whitespace have no special significance for `dired-do-shell-command', and are passed through -normally to the shell, but you must confirm first. To pass `*' by -itself to the shell as a wildcard, type `*\"\"'. +normally to the shell, but you must confirm first. + +If you want to use `*' as a shell wildcard with whitespace around +it, write `*\"\"' in place of just `*'. This is equivalent to just +`*' in the shell, but avoids Dired's special handling. If COMMAND produces output, it goes to a separate buffer. @@ -4124,7 +4203,7 @@ instead. ;;;*** ;;;### (autoloads (dired-do-relsymlink dired-jump-other-window dired-jump) -;;;;;; "dired-x" "dired-x.el" "219648338c42c7912fa336680b434db0") +;;;;;; "dired-x" "dired-x.el" "d2461aa6efb8c1d7de8f245728ab448e") ;;; Generated autoloads from dired-x.el (autoload 'dired-jump "dired-x" "\