;;; dired.el --- directory-browsing commands
;; Copyright (C) 1985, 1986, 1992, 1993, 1994, 1995, 1996, 1997, 2000,
-;; 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>
;; Maintainer: FSF
;;; Code:
+(eval-when-compile (require 'cl))
+
;;; Customizable variables
(defgroup dired nil
;;;###autoload
(defvar dired-chown-program
- (if (memq system-type '(hpux dgux usg-unix-v irix linux gnu/linux cygwin))
+ (if (memq system-type '(hpux usg-unix-v irix linux gnu/linux cygwin))
"chown"
(if (file-exists-p "/usr/sbin/chown")
"/usr/sbin/chown"
"Face name used for flagged files.")
(defface dired-warning
- '((t (:inherit font-lock-comment-face)))
+ ;; Inherit from font-lock-warning-face since with min-colors 8
+ ;; font-lock-comment-face is not colored any more.
+ '((t (:inherit font-lock-warning-face)))
"Face used to highlight a part of a buffer that needs user attention."
:group 'dired-faces
:version "22.1")
(defvar dired-warning-face 'dired-warning
"Face name used for a part of a buffer that needs user attention.")
+(defface dired-perm-write
+ '((((type w32 pc)) :inherit default) ;; These default to rw-rw-rw.
+ ;; Inherit from font-lock-comment-delimiter-face since with min-colors 8
+ ;; font-lock-comment-face is not colored any more.
+ (t (:inherit font-lock-comment-delimiter-face)))
+ "Face used to highlight permissions of group- and world-writable files."
+ :group 'dired-faces
+ :version "22.2")
+(defvar dired-perm-write-face 'dired-perm-write
+ "Face name used for permissions of group- and world-writable files.")
+
(defface dired-directory
'((t (:inherit font-lock-function-name-face)))
"Face used for subdirectories."
;; fields with keymaps to frob the permissions, somewhat a la XEmacs.
(list (concat dired-re-maybe-mark dired-re-inode-size
"[-d]....\\(w\\)....") ; group writable
- '(1 dired-warning-face))
+ '(1 dired-perm-write-face))
(list (concat dired-re-maybe-mark dired-re-inode-size
"[-d].......\\(w\\).") ; world writable
- '(1 dired-warning-face))
+ '(1 dired-perm-write-face))
;;
;; Subdirectories.
(list dired-re-dir
(if (next-read-file-uses-dialog-p)
(read-directory-name (format "Dired %s(directory): " str)
nil default-directory nil)
- (read-file-name (format "Dired %s(directory): " str)
- nil default-directory nil)))))
+ (lexical-let ((default (and buffer-file-name
+ (abbreviate-file-name buffer-file-name)))
+ (defdir default-directory))
+ (minibuffer-with-setup-hook
+ (lambda ()
+ (setq minibuffer-default default)
+ (setq default-directory defdir))
+ (completing-read
+ (format "Dired %s(directory): " str)
+ ;; 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 'file-directory-p))
+ (complete-with-action
+ action 'read-file-name-internal str nil)))
+ 'read-file-name-internal)
+ nil nil (abbreviate-file-name defdir) 'file-name-history)))))))
;;;###autoload (define-key ctl-x-map "d" 'dired)
;;;###autoload
(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)
+ ;; encryption and decryption (epa-dired)
+ (define-key map ":d" 'epa-dired-do-decrypt)
+ (define-key map ":v" 'epa-dired-do-verify)
+ (define-key map ":s" 'epa-dired-do-sign)
+ (define-key map ":e" 'epa-dired-do-encrypt)
;; Make menu bar items.
(define-key map [menu-bar immediate]
(cons "Immediate" (make-sparse-keymap "Immediate")))
+ (define-key map
+ [menu-bar immediate epa-dired-do-decrypt]
+ '(menu-item "Decrypt" epa-dired-do-decrypt
+ :help "Decrypt file at cursor"))
+
+ (define-key map
+ [menu-bar immediate epa-dired-do-verify]
+ '(menu-item "Verify" epa-dired-do-verify
+ :help "Verify digital signature of file at cursor"))
+
+ (define-key map
+ [menu-bar immediate epa-dired-do-sign]
+ '(menu-item "Sign" epa-dired-do-sign
+ :help "Create digital signature of file at cursor"))
+
+ (define-key map
+ [menu-bar immediate epa-dired-do-encrypt]
+ '(menu-item "Encrypt" epa-dired-do-encrypt
+ :help "Encrypt file at cursor"))
+
+ (define-key map [menu-bar immediate dashes-4]
+ '("--"))
+
(define-key map
[menu-bar immediate image-dired-dired-display-external]
'(menu-item "Display Image Externally" image-dired-dired-display-external
'(menu-item "Find This File" dired-find-file
:help "Edit file at cursor"))
(define-key map [menu-bar immediate create-directory]
- '(menu-item "Create Directory..." dired-create-directory))
+ '(menu-item "Create Directory..." dired-create-directory
+ :help "Create a directory"))
(define-key map [menu-bar immediate wdired-mode]
'(menu-item "Edit File Names" wdired-change-to-wdired-mode
+ :help "Put a dired buffer in a mode in which filenames are editable"
:filter (lambda (x) (if (eq major-mode 'dired-mode) x))))
(define-key map [menu-bar regexp]
"Move down lines then position at filename.
Optional prefix ARG says how many lines to move; default is one line."
(interactive "p")
- (next-line arg)
+ (forward-line arg)
(dired-move-to-filename))
(defun dired-previous-line (arg)
"Move up lines then position at filename.
Optional prefix ARG says how many lines to move; default is one line."
(interactive "p")
- (previous-line arg)
+ (forward-line (- arg))
(dired-move-to-filename))
(defun dired-next-dirline (arg &optional opoint)
(forward-char -1))))
(or no-error
(not (eq opoint (point)))
- (error (if hidden
+ (error "%s" (if hidden
(substitute-command-keys
"File line is hidden, type \\[dired-hide-subdir] to unhide")
"No file on this line")))
(if (= 1 count) "" "s"))
(defun dired-mark-prompt (arg files)
- ;; Return a string for use in a prompt, either the current file
- ;; name, or the marker and a count of marked files.
+ "Return a string for use in a prompt, either the current file
+name, or the marker and a count of marked files."
+ ;; distinguish-one-marked can cause the first element to be just t.
+ (if (eq (car files) t) (setq files (cdr files)))
(let ((count (length files)))
(if (= count 1)
(car files)
(defun dired-dnd-popup-notice ()
(message-box
- "Recursive copies not enabled.\nSee variable dired-recursive-copies."))
+ "Dired recursive copies are currently disabled.\nSee the variable `dired-recursive-copies'."))
(defun dired-dnd-do-ask-action (uri)
(dired-dnd-handle-local-file uri action)
nil)))
+(declare-function dired-relist-entry "dired-aux" (file))
+(declare-function make-symbolic-link "fileio.c")
+
(defun dired-dnd-handle-local-file (uri action)
"Copy, move or link a file to the dired directory.
URI is the file to handle, ACTION is one of copy, move, link or ask.
Ask means pop up a menu for the user to select one of copy, move or link."
(require 'dired-aux)
(let* ((from (dnd-get-local-file-name uri t))
- (to (if from (concat (dired-current-directory)
- (file-name-nondirectory from))
- nil)))
- (if from
- (cond ((or (eq action 'copy)
- (eq action 'private)) ; Treat private as copy.
-
- ;; If copying a directory and dired-recursive-copies is nil,
- ;; dired-copy-file silently fails. Pop up a notice.
- (if (and (file-directory-p from)
- (not dired-recursive-copies))
- (dired-dnd-popup-notice)
- (progn
- (dired-copy-file from to 1)
- (dired-relist-entry to)
- action)))
-
- ((eq action 'move)
- (dired-rename-file from to 1)
- (dired-relist-entry to)
- action)
-
- ((eq action 'link)
- (make-symbolic-link from to 1)
- (dired-relist-entry to)
- action)
-
- ((eq action 'ask)
- (dired-dnd-do-ask-action uri))
-
- (t nil)))))
+ (to (when from
+ (concat (dired-current-directory)
+ (file-name-nondirectory from)))))
+ (when from
+ (cond ((eq action 'ask)
+ (dired-dnd-do-ask-action uri))
+ ;; If copying a directory and dired-recursive-copies is
+ ;; nil, dired-copy-file fails. Pop up a notice.
+ ((and (memq action '(copy private))
+ (file-directory-p from)
+ (not dired-recursive-copies))
+ (dired-dnd-popup-notice))
+ ((memq action '(copy private move link))
+ (let ((overwrite (and (file-exists-p to)
+ (y-or-n-p
+ (format "Overwrite existing file `%s'? " to))))
+ ;; Binding dired-overwrite-confirmed to nil makes
+ ;; dired-handle-overwrite a no-op. We instead use
+ ;; y-or-n-p, which pops a graphical menu.
+ dired-overwrite-confirmed backup-file)
+ (when (and overwrite
+ ;; d-b-o is defined in dired-aux.
+ (boundp 'dired-backup-overwrite)
+ dired-backup-overwrite
+ (setq backup-file
+ (car (find-backup-file-name to)))
+ (or (eq dired-backup-overwrite 'always)
+ (y-or-n-p
+ (format
+ "Make backup for existing file `%s'? " to))))
+ (rename-file to backup-file 0)
+ (dired-relist-entry backup-file))
+ (cond ((memq action '(copy private))
+ (dired-copy-file from to overwrite))
+ ((eq action 'move)
+ (dired-rename-file from to overwrite))
+ ((eq action 'link)
+ (make-symbolic-link from to overwrite)))
+ (dired-relist-entry to)
+ action))))))
(defun dired-dnd-handle-file (uri action)
"Copy, move or link a file to the dired directory if it is a local file.
(dired dired-dir)
;; The following elements of `desktop-buffer-misc' are the keys
;; from `dired-subdir-alist'.
- (mapcar 'dired-maybe-insert-subdir (cdr desktop-buffer-misc))
+ (mapc 'dired-maybe-insert-subdir (cdr desktop-buffer-misc))
(current-buffer))
(message "Desktop: Directory %s no longer exists." dir)
(when desktop-missing-file-warning (sit-for 1))
HCoop / bpt / emacs.git / blobdiff