X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/49d395cd57e646162e7f646a8561a416abacac82..e145a7fe95fb8f97407d125f94653ef95e42696d:/lisp/dired.el diff --git a/lisp/dired.el b/lisp/dired.el index 7209248a75..1a906093a7 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -1,7 +1,7 @@ ;;; dired.el --- directory-browsing commands ;; Copyright (C) 1985, 1986, 1992, 1993, 1994, 1995, 1996, 1997, 2000, -;; 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. +;; 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. ;; Author: Sebastian Kremer ;; Maintainer: FSF @@ -11,7 +11,7 @@ ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) +;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, @@ -56,7 +56,7 @@ may contain even `F', `b', `i' and `s'. See also the variable `dired-ls-F-marks-symlinks' concerning the `F' switch. On systems such as MS-DOS and MS-Windows, which use `ls' emulation in Lisp, some of the `ls' switches are not supported; see the doc string of -`insert-directory' on `ls-lisp.el' for more details." +`insert-directory' in `ls-lisp.el' for more details." :type 'string :group 'dired) @@ -791,6 +791,9 @@ wildcards, erases the buffer, and builds the subdir-alist anew (run-hooks 'dired-before-readin-hook) (if (consp buffer-undo-list) (setq buffer-undo-list nil)) + (make-local-variable 'file-name-coding-system) + (setq file-name-coding-system + (or coding-system-for-read file-name-coding-system)) (let (buffer-read-only ;; Don't make undo entries for readin. (buffer-undo-list t)) @@ -1042,9 +1045,9 @@ Preserves old cursor, marks/flags, hidden-p." ;; treat top level dir extra (it may contain wildcards) (dired-uncache (if (consp dired-directory) (car dired-directory) dired-directory)) - (dired-readin) + ;; Run dired-after-readin-hook just once, below. (let ((dired-after-readin-hook nil)) - ;; don't run that hook for each subdir... + (dired-readin) (dired-insert-old-subdirs old-subdir-alist)) (dired-mark-remembered mark-alist) ; mark files that were marked ;; ... run the hook for the whole buffer, and only after markers @@ -1212,9 +1215,9 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST." (define-key map "f" 'dired-find-file) (define-key map "\C-m" 'dired-advertised-find-file) (define-key map "g" 'revert-buffer) - (define-key map "\M-g" 'dired-goto-file) (define-key map "h" 'describe-mode) (define-key map "i" 'dired-maybe-insert-subdir) + (define-key map "j" 'dired-goto-file) (define-key map "k" 'dired-do-kill-lines) (define-key map "l" 'dired-do-redisplay) (define-key map "m" 'dired-mark) @@ -1244,22 +1247,24 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST." (define-key map "$" 'dired-hide-subdir) (define-key map "\M-$" 'dired-hide-all) ;; misc + (define-key map "\C-x\C-q" 'dired-toggle-read-only) (define-key map "?" 'dired-summary) (define-key map "\177" 'dired-unmark-backward) (define-key map [remap undo] 'dired-undo) (define-key map [remap advertised-undo] 'dired-undo) - ;; thumbnail manipulation (tumme) - (define-key map "\C-td" 'tumme-display-thumbs) - (define-key map "\C-tt" 'tumme-tag-files) - (define-key map "\C-tr" 'tumme-tag-remove) - (define-key map "\C-tj" 'tumme-jump-thumbnail-buffer) - (define-key map "\C-ti" 'tumme-display-dired-image) - (define-key map "\C-tx" 'tumme-dired-display-external) - (define-key map "\C-ta" 'tumme-display-thumbs-append) - (define-key map "\C-t." 'tumme-display-thumb) - (define-key map "\C-tc" 'tumme-dired-comment-files) - (define-key map "\C-tf" 'tumme-mark-tagged-files) - (define-key map "\C-t\C-t" 'tumme-dired-insert-marked-thumbs) + ;; thumbnail manipulation (image-dired) + (define-key map "\C-td" 'image-dired-display-thumbs) + (define-key map "\C-tt" 'image-dired-tag-files) + (define-key map "\C-tr" 'image-dired-delete-tag) + (define-key map "\C-tj" 'image-dired-jump-thumbnail-buffer) + (define-key map "\C-ti" 'image-dired-dired-display-image) + (define-key map "\C-tx" 'image-dired-dired-display-external) + (define-key map "\C-ta" 'image-dired-display-thumbs-append) + (define-key map "\C-t." 'image-dired-display-thumb) + (define-key map "\C-tc" 'image-dired-dired-comment-files) + (define-key map "\C-tf" 'image-dired-mark-tagged-files) + (define-key map "\C-t\C-t" 'image-dired-dired-insert-marked-thumbs) + (define-key map "\C-te" 'image-dired-dired-edit-comment-and-tags) ;; Make menu bar items. @@ -1305,6 +1310,18 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST." (define-key map [menu-bar immediate] (cons "Immediate" (make-sparse-keymap "Immediate"))) + (define-key map + [menu-bar immediate image-dired-dired-display-external] + '(menu-item "Display Image Externally" image-dired-dired-display-external + :help "Display image in external viewer")) + (define-key map + [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 dashes-4] + '("--")) + (define-key map [menu-bar immediate revert-buffer] '(menu-item "Refresh" revert-buffer :help "Update contents of shown directories")) @@ -1313,7 +1330,7 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST." '("--")) (define-key map [menu-bar immediate compare-directories] - '(menu-item "Compare directories..." dired-compare-directories + '(menu-item "Compare Directories..." dired-compare-directories :help "Mark files with different attributes in two dired buffers")) (define-key map [menu-bar immediate backup-diff] '(menu-item "Compare with Backup" dired-backup-diff @@ -1336,11 +1353,20 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST." (define-key map [menu-bar immediate create-directory] '(menu-item "Create Directory..." dired-create-directory)) (define-key map [menu-bar immediate wdired-mode] - '(menu-item "Edit File Names" wdired-change-to-wdired-mode)) + '(menu-item "Edit File Names" wdired-change-to-wdired-mode + :filter (lambda (x) (if (eq major-mode 'dired-mode) x)))) (define-key map [menu-bar regexp] (cons "Regexp" (make-sparse-keymap "Regexp"))) + (define-key map + [menu-bar regexp image-dired-mark-tagged-files] + '(menu-item "Mark From Image Tag..." image-dired-mark-tagged-files + :help "Mark files whose image tags matches regexp")) + + (define-key map [menu-bar regexp dashes-1] + '("--")) + (define-key map [menu-bar regexp downcase] '(menu-item "Downcase" dired-downcase ;; When running on plain MS-DOS, there's only one @@ -1428,6 +1454,26 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST." (define-key map [menu-bar operate] (cons "Operate" (make-sparse-keymap "Operate"))) + (define-key map + [menu-bar operate image-dired-delete-tag] + '(menu-item "Delete Image Tag..." image-dired-delete-tag + :help "Delete image tag from current or marked files")) + (define-key map + [menu-bar operate image-dired-tag-files] + '(menu-item "Add Image Tags..." image-dired-tag-files + :help "Add image tags to current or marked files")) + (define-key map + [menu-bar operate image-dired-dired-comment-files] + '(menu-item "Add Image Comment..." image-dired-dired-comment-files + :help "Add image comment to current or marked files")) + (define-key map + [menu-bar operate image-dired-display-thumbs] + '(menu-item "Display Image-Dired" image-dired-display-thumbs + :help "Display image-dired for current or marked image files")) + + (define-key map [menu-bar operate dashes-3] + '("--")) + (define-key map [menu-bar operate query-replace] '(menu-item "Query Replace in Files..." dired-do-query-replace-regexp :help "Replace regexp in marked files")) @@ -1611,6 +1657,16 @@ You can use it to recover marks, killed lines or subdirs." (message "Change in dired buffer undone. Actual changes in files cannot be undone by Emacs.")) +(defun dired-toggle-read-only () + "Edit dired buffer with Wdired, or set it read-only. +Call `wdired-change-to-wdired-mode' in dired buffers whose editing is +supported by Wdired (the major mode of the dired buffer is `dired-mode'). +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))) + (defun dired-next-line (arg) "Move down lines then position at filename. Optional prefix ARG says how many lines to move; default is one line." @@ -2160,40 +2216,40 @@ instead of `dired-actual-switches'." (concat "\\`" (match-string 1 default-directory))))) (goto-char (point-min)) (setq dired-subdir-alist nil) - (while (and (re-search-forward dired-subdir-regexp nil t) - ;; Avoid taking a file name ending in a colon - ;; as a subdir name. - (not (save-excursion - (goto-char (match-beginning 0)) - (beginning-of-line) - (forward-char 2) - (save-match-data (looking-at dired-re-perms))))) - (save-excursion - (goto-char (match-beginning 1)) - (setq new-dir-name - (buffer-substring-no-properties (point) (match-end 1)) - new-dir-name - (save-match-data - (if (and R-ftp-base-dir-regex - (not (string= new-dir-name default-directory)) - (string-match R-ftp-base-dir-regex new-dir-name)) - (concat default-directory - (substring new-dir-name (match-end 0))) - (expand-file-name new-dir-name)))) - (delete-region (point) (match-end 1)) - (insert new-dir-name)) - (setq count (1+ count)) - (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)))) + (while (re-search-forward dired-subdir-regexp nil t) + ;; Avoid taking a file name ending in a colon + ;; as a subdir name. + (unless (save-excursion + (goto-char (match-beginning 0)) + (beginning-of-line) + (forward-char 2) + (save-match-data (looking-at dired-re-perms))) + (save-excursion + (goto-char (match-beginning 1)) + (setq new-dir-name + (buffer-substring-no-properties (point) (match-end 1)) + new-dir-name + (save-match-data + (if (and R-ftp-base-dir-regex + (not (string= new-dir-name default-directory)) + (string-match R-ftp-base-dir-regex new-dir-name)) + (concat default-directory + (substring new-dir-name (match-end 0))) + (expand-file-name new-dir-name)))) + (delete-region (point) (match-end 1)) + (insert new-dir-name)) + (setq count (1+ count)) + (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))))) (if (and (> count 1) (interactive-p)) - (message "Buffer includes %d directories" count)) - ;; We don't need to sort it because it is in buffer order per - ;; constructionem. Return new alist: - dired-subdir-alist))) + (message "Buffer includes %d directories" count))) + ;; We don't need to sort it because it is in buffer order per + ;; constructionem. Return new alist: + dired-subdir-alist)) (defun dired-alist-add-1 (dir new-marker) ;; Add new DIR at NEW-MARKER. Don't sort. @@ -2218,7 +2274,7 @@ instead of `dired-actual-switches'." (forward-line 1)))) (defun dired-goto-file (file) - "Go to file line of FILE in this dired buffer." + "Go to line describing file FILE in this dired buffer." ;; Return value of point on success, else nil. ;; FILE must be an absolute file name. ;; Loses if FILE contains control chars like "\007" for which ls @@ -2315,9 +2371,9 @@ Optional argument means return a file name relative to `default-directory'." ;; Deleting files -(defcustom dired-recursive-deletes nil ; Default only delete empty directories. +(defcustom dired-recursive-deletes 'top "*Decide whether recursive deletes are allowed. -nil means no recursive deletes. +A value of nil means no recursive deletes. `always' means delete recursively without asking. This is DANGEROUS! `top' means ask for each directory at top level, but delete its subdirectories without asking. @@ -2363,7 +2419,9 @@ Anything else, ask for each sub-directory." (defun dired-do-flagged-delete (&optional nomessage) "In Dired, delete the files flagged for deletion. If NOMESSAGE is non-nil, we don't display any message -if there are no flagged files." +if there are no flagged files. +`dired-recursive-deletes' controls whether deletion of +non-empty directories is allowed." (interactive) (let* ((dired-marker-char dired-del-marker) (regexp (dired-marker-regexp)) @@ -2379,7 +2437,9 @@ if there are no flagged files." (message "(No deletions requested)"))))) (defun dired-do-delete (&optional arg) - "Delete all marked (or next ARG) files." + "Delete all marked (or next ARG) files. +`dired-recursive-deletes' controls whether deletion of +non-empty directories is allowed." ;; This is more consistent with the file marking feature than ;; dired-do-flagged-delete. (interactive "P") @@ -2999,6 +3059,10 @@ Thus, use \\[backward-page] to find the beginning of a group of errors." (insert "\f\n"))))))) (defun dired-log-summary (string failures) + "State a summary of a command's failures, in echo area and log buffer. +STRING is an overall summary of the failures. +FAILURES is a list of file names that we failed to operate on, +or nil if file names are not applicable." (if (= (length failures) 1) (message "%s" (with-current-buffer dired-log-buffer @@ -3047,15 +3111,18 @@ The idea is to set this buffer-locally in special dired buffers.") ;; Modeline display of "by name" or "by date" guarantees the user a ;; match with the corresponding regexps. Non-matching switches are ;; shown literally. - (setq mode-name - (let (case-fold-search) - (cond ((string-match dired-sort-by-name-regexp dired-actual-switches) - "Dired by name") - ((string-match dired-sort-by-date-regexp dired-actual-switches) - "Dired by date") - (t - (concat "Dired " dired-actual-switches))))) - (force-mode-line-update)) + (when (eq major-mode 'dired-mode) + (setq mode-name + (let (case-fold-search) + (cond ((string-match + dired-sort-by-name-regexp dired-actual-switches) + "Dired by name") + ((string-match + dired-sort-by-date-regexp dired-actual-switches) + "Dired by date") + (t + (concat "Dired " dired-actual-switches))))) + (force-mode-line-update))) (defun dired-sort-toggle-or-edit (&optional arg) "Toggle between sort by date/name and refresh the dired buffer. @@ -3111,7 +3178,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) - (if (eq major-mode 'dired-mode) (dired-sort-set-modeline)) + (dired-sort-set-modeline) (or no-revert (revert-buffer))) (defvar dired-subdir-alist-pre-R nil @@ -3152,9 +3219,9 @@ To be called first in body of `dired-sort-other', etc." ;;;; Drag and drop support -(defcustom dired-recursive-copies nil +(defcustom dired-recursive-copies 'top "*Decide whether recursive copies are allowed. -nil means no recursive copies. +A value of nil means no recursive copies. `always' means copy recursively without asking. `top' means ask for each directory at top level. Anything else means ask for each directory."