X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/bac524e036a6a64d33dcbb71e8458675fd7a97cd..f0ee9096ba9f35b9e6b85fb5c5f5f56168a67824:/lisp/dired.el?ds=sidebyside diff --git a/lisp/dired.el b/lisp/dired.el index c56e15a71a..a241fb3b33 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -1,10 +1,10 @@ ;;; dired.el --- directory-browsing commands -*- lexical-binding: t -*- -;; Copyright (C) 1985-1986, 1992-1997, 2000-2014 Free Software -;; Foundation, Inc. +;; Copyright (C) 1985-1986, 1992-1997, 2000-2014 +;; Free Software Foundation, Inc. ;; Author: Sebastian Kremer -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: files ;; Package: emacs @@ -222,7 +222,7 @@ with the buffer narrowed to the listing." (defcustom dired-initial-position-hook nil "This hook is used to position the point. -It is run the function `dired-initial-position'." +It is run by the function `dired-initial-position'." :group 'dired :type 'hook :version "24.4") @@ -634,7 +634,8 @@ Optional second argument ARG, if non-nil, specifies files near point instead of marked files. It usually comes from the prefix argument. If ARG is an integer, use the next ARG files. - Any other non-nil value means to use the current file instead. + If ARG is any other non-nil value, return the current file name. + If no files are marked, and ARG is nil, also return the current file name. Optional third argument FILTER, if non-nil, is a function to select some of the files--those for which (funcall FILTER FILENAME) is non-nil. @@ -1141,10 +1142,22 @@ BEG..END is the line where the file info is located." (defvar ls-lisp-use-insert-directory-program) +(defun dired-check-switches (switches short &optional long) + "Return non-nil if the string SWITCHES matches LONG or SHORT format." + (let (case-fold-search) + (and (stringp switches) + (string-match-p (concat "\\(\\`\\| \\)-[[:alnum:]]*" short + (if long (concat "\\|--" long "\\>") "")) + switches)))) + (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-p "\\(\\`\\| \\)-[[:alnum:]]*b\\|--escape\\>" switches)) + (dired-check-switches switches "b" "escape")) + +(defun dired-switches-recursive-p (switches) + "Return non-nil if the string SWITCHES contains -R or --recursive." + (dired-check-switches switches "R" "recursive")) (defun dired-insert-directory (dir switches &optional file-list wildcard hdr) "Insert a directory listing of DIR, Dired style. @@ -1249,9 +1262,11 @@ see `dired-use-ls-dired' for more details.") (while (< (point) end) (ignore-errors (if (not (dired-move-to-filename)) - (put-text-property (line-beginning-position) - (1+ (line-end-position)) - 'invisible 'dired-hide-details-information) + (unless (or (looking-at-p "^$") + (looking-at-p dired-subdir-regexp)) + (put-text-property (line-beginning-position) + (1+ (line-end-position)) + 'invisible 'dired-hide-details-information)) (put-text-property (+ (line-beginning-position) 1) (1- (point)) 'invisible 'dired-hide-details-detail) (add-text-properties @@ -1399,7 +1414,7 @@ Each element of ALIST looks like (FILE . MARKERCHAR)." (defun dired-insert-old-subdirs (old-subdir-alist) "Try to insert all subdirs that were displayed before. Do so according to the former subdir alist OLD-SUBDIR-ALIST." - (or (string-match-p "R" dired-actual-switches) + (or (dired-switches-recursive-p dired-actual-switches) (let (elt dir) (while old-subdir-alist (setq elt (car old-subdir-alist) @@ -1785,22 +1800,22 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST." (define-key map [menu-bar operate epa-dired-do-decrypt] '(menu-item "Decrypt..." epa-dired-do-decrypt - :help "Decrypt file at cursor")) + :help "Decrypt current or marked files")) (define-key map [menu-bar operate epa-dired-do-verify] '(menu-item "Verify" epa-dired-do-verify - :help "Verify digital signature of file at cursor")) + :help "Verify digital signature of current or marked files")) (define-key map [menu-bar operate epa-dired-do-sign] '(menu-item "Sign..." epa-dired-do-sign - :help "Create digital signature of file at cursor")) + :help "Create digital signature of current or marked files")) (define-key map [menu-bar operate epa-dired-do-encrypt] '(menu-item "Encrypt..." epa-dired-do-encrypt - :help "Encrypt file at cursor")) + :help "Encrypt current or marked files")) (define-key map [menu-bar operate dashes-3] '("--")) @@ -1897,7 +1912,7 @@ Type \\[dired-mark] to Mark a file or subdirectory for later commands. to see why something went wrong. Type \\[dired-unmark] to Unmark a file or all files of an inserted subdirectory. Type \\[dired-unmark-backward] to back up one line and unmark or unflag. -Type \\[dired-do-flagged-delete] to delete (eXecute) the files flagged `D'. +Type \\[dired-do-flagged-delete] to delete (eXpunge) the files flagged `D'. Type \\[dired-find-file] to Find the current line's file (or dired it in another buffer, if it is a directory). Type \\[dired-find-file-other-window] to find file or Dired directory in Other window. @@ -2045,7 +2060,9 @@ Optional prefix ARG says how many lines to move; default is one line." (defun dired-up-directory (&optional other-window) "Run Dired on parent directory of current directory. Find the parent directory either in this buffer or another buffer. -Creates a buffer if necessary." +Creates a buffer if necessary. +If OTHER-WINDOW (the optional prefix arg), display the parent +directory in another window." (interactive "P") (let* ((dir (dired-current-directory)) (up (file-name-directory (directory-file-name dir)))) @@ -2133,7 +2150,8 @@ Otherwise, display it in another buffer." (defun dired-display-file () "In Dired, display this file or directory in another window." (interactive) - (display-buffer (find-file-noselect (dired-get-file-for-visit)))) + (display-buffer (find-file-noselect (dired-get-file-for-visit)) + t)) ;;; Functions for extracting and manipulating file names in Dired buffers. @@ -2343,9 +2361,8 @@ Return the position of the beginning of the filename, or nil if none found." ;; This is the UNIX version. (if (get-text-property (point) 'dired-filename) (goto-char (next-single-property-change (point) 'dired-filename)) - (let (opoint file-type executable symlink hidden case-fold-search used-F eol) - ;; case-fold-search is nil now, so we can test for capital F: - (setq used-F (string-match-p "F" dired-actual-switches) + (let (opoint file-type executable symlink hidden used-F eol) + (setq used-F (dired-check-switches dired-actual-switches "F" "classify") opoint (point) eol (line-end-position) hidden (and selective-display @@ -2607,7 +2624,7 @@ instead of `dired-actual-switches'." (R-ftp-base-dir-regex ;; Used to expand subdirectory names correctly in recursive ;; ange-ftp listings. - (and (string-match-p "R" switches) + (and (dired-switches-recursive-p switches) (string-match "\\`/.*:\\(/.*\\)" default-directory) (concat "\\`" (match-string 1 default-directory))))) (goto-char (point-min)) @@ -2762,7 +2779,7 @@ as returned by `dired-get-filename'. LIMIT is the search limit." ;; FIXME document whatever dired-x is doing. (defun dired-initial-position (dirname) "Where point should go in a new listing of DIRNAME. -Point assumed at beginning of new subdir line. +Point is assumed to be at the beginning of new subdir line. It runs the hook `dired-initial-position-hook'." (end-of-line) (and (featurep 'dired-x) dired-find-subdir @@ -2903,11 +2920,7 @@ non-empty directories is allowed." (let* ((files (mapcar (function car) l)) (count (length l)) (succ 0) - (trashing (and trash delete-by-moving-to-trash)) - (progress-reporter - (make-progress-reporter - (if trashing "Trashing..." "Deleting...") - succ count))) + (trashing (and trash delete-by-moving-to-trash))) ;; canonicalize file list for pop up (setq files (nreverse (mapcar (function dired-make-relative) files))) (if (dired-mark-pop-up @@ -2916,7 +2929,11 @@ non-empty directories is allowed." (if trashing "Trash" "Delete") (dired-mark-prompt arg files))) (save-excursion - (let (failures);; files better be in reverse order for this loop! + (let ((progress-reporter + (make-progress-reporter + (if trashing "Trashing..." "Deleting...") + succ count)) + failures) ;; files better be in reverse order for this loop! (while l (goto-char (cdr (car l))) (let ((inhibit-read-only t)) @@ -2929,7 +2946,7 @@ non-empty directories is allowed." (dired-fun-in-all-buffers (file-name-directory fn) (file-name-nondirectory fn) (function dired-delete-entry) fn)) - (error;; catch errors from failed deletions + (error ;; catch errors from failed deletions (dired-log "%s\n" err) (setq failures (cons (car (car l)) failures))))) (setq l (cdr l))) @@ -3082,9 +3099,12 @@ argument or confirmation)." ;; If FILES defaulted to the current line's file. (= (length files) 1)) (apply function args) - (let ((buffer (get-buffer-create (or buffer-or-name " *Marked Files*")))) + (let ((buffer (get-buffer-create (or buffer-or-name " *Marked Files*"))) + ;; 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-current-buffer buffer - (with-temp-buffer-window + (with-current-buffer-window buffer (cons 'display-buffer-below-selected '((window-height . fit-window-to-buffer))) @@ -3140,7 +3160,9 @@ argument or confirmation)." (save-excursion (not (dired-move-to-filename)))) (defun dired-next-marked-file (arg &optional wrap opoint) - "Move to the next marked file, wrapping around the end of the buffer." + "Move to the next marked file. +If WRAP is non-nil, wrap around to the beginning of the buffer if +we reach the end." (interactive "p\np") (or opoint (setq opoint (point)));; return to where interactively started (if (if (> arg 0) @@ -3157,7 +3179,9 @@ argument or confirmation)." (dired-next-marked-file arg nil opoint)))) (defun dired-prev-marked-file (arg &optional wrap) - "Move to the previous marked file, wrapping around the end of the buffer." + "Move to the previous marked file. +If WRAP is non-nil, wrap around to the end of the buffer if we +reach the beginning of the buffer." (interactive "p\np") (dired-next-marked-file (- arg) wrap)) @@ -3277,6 +3301,8 @@ As always, hidden subdirs are not affected." "History list of regular expressions used in Dired commands.") (defun dired-read-regexp (prompt &optional default history) + "Read a regexp using `read-regexp'." + (declare (obsolete read-regexp "24.5")) (read-regexp prompt default (or history 'dired-regexp-history))) (defun dired-mark-files-regexp (regexp &optional marker-char) @@ -3287,8 +3313,9 @@ A prefix argument means to unmark them instead. 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 - (list (dired-read-regexp (concat (if current-prefix-arg "Unmark" "Mark") - " files (regexp): ")) + (list (read-regexp (concat (if current-prefix-arg "Unmark" "Mark") + " files (regexp): ") + nil 'dired-regexp-history) (if current-prefix-arg ?\040))) (let ((dired-marker-char (or marker-char dired-marker-char))) (dired-mark-if @@ -3303,8 +3330,9 @@ object files--just `.o' will mark more than you might think." A prefix argument means to unmark them instead. `.' and `..' are never marked." (interactive - (list (dired-read-regexp (concat (if current-prefix-arg "Unmark" "Mark") - " files containing (regexp): ")) + (list (read-regexp (concat (if current-prefix-arg "Unmark" "Mark") + " files containing (regexp): ") + nil 'dired-regexp-history) (if current-prefix-arg ?\040))) (let ((dired-marker-char (or marker-char dired-marker-char))) (dired-mark-if @@ -3334,7 +3362,8 @@ A prefix argument means to unmark them instead. The match is against the non-directory part of the filename. Use `^' and `$' to anchor matches. Exclude subdirs by hiding them. `.' and `..' are never flagged." - (interactive (list (dired-read-regexp "Flag for deletion (regexp): "))) + (interactive (list (read-regexp "Flag for deletion (regexp): " + nil 'dired-regexp-history))) (dired-mark-files-regexp regexp dired-del-marker)) (defun dired-mark-symlinks (unflag-p) @@ -3631,6 +3660,7 @@ With a prefix argument, edit the current listing switches instead." ;; Remove a switch of the form -XtY for some X and Y. (setq dired-actual-switches (replace-match "" t t dired-actual-switches 3)))) + ;; Now, if we weren't sorting by date before, add the -t switch. ;; Some simple-minded ls implementations (eg ftp servers) only ;; allow a single option string, so try not to add " -t" if possible. @@ -3676,12 +3706,12 @@ Saves `dired-subdir-alist' when R is set and restores saved value minus any directories explicitly deleted when R is cleared. To be called first in body of `dired-sort-other', etc." (cond - ((and (string-match-p "R" switches) - (not (string-match-p "R" dired-actual-switches))) + ((and (dired-switches-recursive-p switches) + (not (dired-switches-recursive-p dired-actual-switches))) ;; Adding -R to ls switches -- save `dired-subdir-alist': (setq dired-subdir-alist-pre-R dired-subdir-alist)) - ((and (string-match-p "R" dired-actual-switches) - (not (string-match-p "R" switches))) + ((and (dired-switches-recursive-p dired-actual-switches) + (not (dired-switches-recursive-p switches))) ;; Deleting -R from ls switches -- revert to pre-R subdirs ;; that are still present: (setq dired-subdir-alist @@ -3837,7 +3867,7 @@ Ask means pop up a menu for the user to select one of copy, move or link." (let* ((dired-dir (car misc-data)) (dir (if (consp dired-dir) (car dired-dir) dired-dir))) (if (file-directory-p (file-name-directory dir)) - (progn + (with-demoted-errors "Desktop: Problem restoring directory: %S" (dired dired-dir) ;; The following elements of `misc-data' are the keys ;; from `dired-subdir-alist'. @@ -3853,7 +3883,7 @@ Ask means pop up a menu for the user to select one of copy, move or link." ;;; Start of automatically extracted autoloads. -;;;### (autoloads nil "dired-aux" "dired-aux.el" "8861a67d8b72a1110007fba0be161c86") +;;;### (autoloads nil "dired-aux" "dired-aux.el" "1448837b5f3e2b9ad63f723361f1e32e") ;;; Generated autoloads from dired-aux.el (autoload 'dired-diff "dired-aux" "\ @@ -4356,7 +4386,7 @@ instead. ;;;*** -;;;### (autoloads nil "dired-x" "dired-x.el" "291bc6e869bf72c900604c45d40f45ed") +;;;### (autoloads nil "dired-x" "dired-x.el" "994b5d9fc38059ab641ec271c728e56f") ;;; Generated autoloads from dired-x.el (autoload 'dired-jump "dired-x" "\