X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/91859276fb135836dbce5a7338059215d4e05dbe..2536fb611876d5526fe40b9bee2a16e2836d4ff3:/lisp/dired.el diff --git a/lisp/dired.el b/lisp/dired.el index 82eae0053e..e71160c801 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 Free Software Foundation, Inc. +;; 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. ;; Author: Sebastian Kremer ;; Maintainer: FSF @@ -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) @@ -206,7 +206,8 @@ with the buffer narrowed to the listing." ("^file:" . dired-dnd-handle-local-file)) "The functions to call when a drop in `dired-mode' is made. See `dnd-protocol-alist' for more information. When nil, behave -as in other buffers." +as in other buffers. Changing this option is effective only for +new dired buffers." :type '(choice (repeat (cons (regexp) (function))) (const :tag "Behave as in other buffers" nil)) :version "22.1" @@ -286,6 +287,9 @@ In simple cases, this list contains one element.") This is an alist of the form (SUBDIR . SWITCHES).") (make-variable-buffer-local 'dired-switches-alist) +(defvaralias 'dired-move-to-filename-regexp + 'directory-listing-before-filename-regexp) + (defvar dired-subdir-regexp "^. \\([^\n\r]+\\)\\(:\\)[\n\r]" "Regexp matching a maybe hidden subdirectory line in `ls -lR' output. Subexpression 1 is the subdirectory proper, no trailing colon. @@ -787,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)) @@ -842,16 +849,17 @@ BEG..END is the line where the file info is located." ;; line, the alignment if this line w.r.t the rest is messed up because ;; the fields of that one line will generally be smaller. ;; - ;; To work around this problem, we here add spaces to try and re-align the - ;; fields as needed. Since this is purely aesthetic, it is of utmost - ;; importance that it doesn't mess up anything like - ;; `dired-move-to-filename'. To this end, we limit ourselves to adding - ;; spaces only, and to only add them at places where there was already at - ;; least one space. This way, as long as `dired-move-to-filename-regexp' - ;; always matches spaces with "*" or "+", we know we haven't made anything - ;; worse. There is one spot where the exact number of spaces is - ;; important, which is just before the actual filename, so we refrain from - ;; adding spaces there (and within the filename as well, of course). + ;; To work around this problem, we here add spaces to try and + ;; re-align the fields as needed. Since this is purely aesthetic, + ;; it is of utmost importance that it doesn't mess up anything like + ;; `dired-move-to-filename'. To this end, we limit ourselves to + ;; adding spaces only, and to only add them at places where there + ;; was already at least one space. This way, as long as + ;; `directory-listing-before-filename-regexp' always matches spaces + ;; with "*" or "+", we know we haven't made anything worse. There + ;; is one spot where the exact number of spaces is important, which + ;; is just before the actual filename, so we refrain from adding + ;; spaces there (and within the filename as well, of course). (save-excursion (let (file file-col other other-col) ;; Check the there is indeed a file, and that there is anoter adjacent @@ -953,7 +961,7 @@ If HDR is non-nil, insert a header line with the directory name." (setq switches (concat "--dired " switches))) ;; We used to specify the C locale here, to force English month names; ;; but this should not be necessary any more, - ;; with the new value of dired-move-to-filename-regexp. + ;; with the new value of `directory-listing-before-filename-regexp'. (if file-list (dolist (f file-list) (let ((beg (point))) @@ -1037,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 @@ -1207,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) @@ -1239,10 +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" 'wdired-change-to-wdired-mode) (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 (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. @@ -1288,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")) @@ -1296,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 @@ -1324,6 +1358,14 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST." (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 @@ -1411,6 +1453,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")) @@ -1837,47 +1899,6 @@ DIR must be a directory name, not a file name." ;;; Functions for finding the file name in a dired buffer line. -(defvar dired-move-to-filename-regexp - (let* ((l "\\([A-Za-z]\\|[^\0-\177]\\)") - (l-or-quote "\\([A-Za-z']\\|[^\0-\177]\\)") - ;; In some locales, month abbreviations are as short as 2 letters, - ;; and they can be followed by ".". - ;; In Breton, a month name can include a quote character. - (month (concat l-or-quote l-or-quote "+\\.?")) - (s " ") - (yyyy "[0-9][0-9][0-9][0-9]") - (dd "[ 0-3][0-9]") - (HH:MM "[ 0-2][0-9][:.][0-5][0-9]") - (seconds "[0-6][0-9]\\([.,][0-9]+\\)?") - (zone "[-+][0-2][0-9][0-5][0-9]") - (iso-mm-dd "[01][0-9]-[0-3][0-9]") - (iso-time (concat HH:MM "\\(:" seconds "\\( ?" zone "\\)?\\)?")) - (iso (concat "\\(\\(" yyyy "-\\)?" iso-mm-dd "[ T]" iso-time - "\\|" yyyy "-" iso-mm-dd "\\)")) - (western (concat "\\(" month s "+" dd "\\|" dd "\\.?" s month "\\)" - s "+" - "\\(" HH:MM "\\|" yyyy "\\)")) - (western-comma (concat month s "+" dd "," s "+" yyyy)) - ;; Japanese MS-Windows ls-lisp has one-digit months, and - ;; omits the Kanji characters after month and day-of-month. - (mm "[ 0-1]?[0-9]") - (japanese - (concat mm l "?" s dd l "?" s "+" - "\\(" HH:MM "\\|" yyyy l "?" "\\)"))) - ;; The "[0-9]" below requires the previous column to end in a digit. - ;; This avoids recognizing `1 may 1997' as a date in the line: - ;; -r--r--r-- 1 may 1997 1168 Oct 19 16:49 README - ;; The "[BkKMGTPEZY]?" below supports "ls -alh" output. - ;; The ".*" below finds the last match if there are multiple matches. - ;; This avoids recognizing `jservice 10 1024' as a date in the line: - ;; drwxr-xr-x 3 jservice 10 1024 Jul 2 1997 esg-host - (concat ".*[0-9][BkKMGTPEZY]?" s - "\\(" western "\\|" western-comma "\\|" japanese "\\|" iso "\\)" - s "+")) - "Regular expression to match up to the file name in a directory listing. -The default value is designed to recognize dates and times -regardless of the language.") - (defvar dired-permission-flags-regexp "\\([^ ]\\)[-r][-w]\\([^ ]\\)[-r][-w]\\([^ ]\\)[-r][-w]\\([^ ]\\)" "Regular expression to match the permission flags in `ls -l'.") @@ -1895,12 +1916,12 @@ Return the position of the beginning of the filename, or nil if none found." (cond ((and change (< change eol)) (goto-char change)) - ((re-search-forward dired-move-to-filename-regexp eol t) + ((re-search-forward directory-listing-before-filename-regexp eol t) (goto-char (match-end 0))) ((re-search-forward dired-permission-flags-regexp eol t) ;; Ha! There *is* a file. Our regexp-from-hell just failed to find it. (if raise-error - (error "Unrecognized line! Check dired-move-to-filename-regexp")) + (error "Unrecognized line! Check directory-listing-before-filename-regexp")) (beginning-of-line) nil) (raise-error @@ -1953,11 +1974,11 @@ Return the position of the beginning of the filename, or nil if none found." (eq (preceding-char) ?@) ;; did ls really mark the link? (forward-char -1)))) (goto-char eol) ;; else not a symbolic link - ;; ls -lF marks dirs, sockets and executables with exactly one - ;; trailing character. (Executable bits on symlinks ain't mean + ;; ls -lF marks dirs, sockets, fifos and executables with exactly + ;; one trailing character. (Executable bits on symlinks ain't mean ;; a thing, even to ls, but we know it's not a symlink.) (and used-F - (or (memq file-type '(?d ?s)) + (or (memq file-type '(?d ?s ?p)) executable) (forward-char -1)))) (or no-error @@ -2184,40 +2205,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. @@ -2242,7 +2263,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 @@ -2339,9 +2360,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 ; Default only delete empty directories. "*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. @@ -2376,7 +2397,7 @@ Anything else, ask for each sub-directory." (setq files (directory-files file t dired-re-no-dot)) ; Not empty. (or (eq recursive 'always) - (yes-or-no-p (format "Recursive delete of %s " + (yes-or-no-p (format "Recursive delete of %s? " (dired-make-relative file))))) (if (eq recursive 'top) (setq recursive 'always)) ; Don't ask again. (while files ; Recursively delete (possibly asking). @@ -2387,7 +2408,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)) @@ -2403,7 +2426,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") @@ -2554,11 +2579,18 @@ if there are no flagged files." (set-window-start w2 1) ))) -(defvar dired-no-confirm nil +(defcustom dired-no-confirm nil "A list of symbols for commands Dired should not confirm. Command symbols are `byte-compile', `chgrp', `chmod', `chown', `compress', `copy', `delete', `hardlink', `load', `move', `print', `shell', `symlink', -`touch' and `uncompress'.") +`touch' and `uncompress'." + :group 'dired + :type '(set (const byte-compile) (const chgrp) + (const chmod) (const chown) (const compress) + (const copy) (const delete) (const hardlink) + (const load) (const move) (const print) + (const shell) (const symlink) (const touch) + (const uncompress))) (defun dired-mark-pop-up (bufname op-symbol files function &rest args) "Return FUNCTION's result on ARGS after showing which files are marked. @@ -3016,6 +3048,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 @@ -3064,15 +3100,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. @@ -3128,12 +3167,12 @@ 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))) -(make-variable-buffer-local - (defvar dired-subdir-alist-pre-R nil - "Value of `dired-subdir-alist' before -R switch added.")) +(defvar dired-subdir-alist-pre-R nil + "Value of `dired-subdir-alist' before -R switch added.") +(make-variable-buffer-local 'dired-subdir-alist-pre-R) (defun dired-sort-R-check (switches) "Additional processing of -R in ls option string SWITCHES. @@ -3169,9 +3208,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." @@ -3292,9 +3331,8 @@ Ask means pop up a menu for the user to select one of copy, move or link." (when desktop-missing-file-warning (sit-for 1)) nil))) -(eval-after-load 'desktop - '(add-to-list 'desktop-buffer-mode-handlers - '(dired-mode . dired-restore-desktop-buffer))) +(add-to-list 'desktop-buffer-mode-handlers + '(dired-mode . dired-restore-desktop-buffer)) (if (eq system-type 'vax-vms)