;;; 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"
(defvar dired-warning-face 'dired-warning
"Face name used for a part of a buffer that needs user attention.")
-(defface dired-warn-writable
+(defface dired-perm-write
'((((type w32 pc)) :inherit default) ;; These default to rw-rw-rw.
- (t (:inherit font-lock-warning-face)))
+ ;; 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-warn-writable-face 'dired-warn-writable
+(defvar dired-perm-write-face 'dired-perm-write
"Face name used for permissions of group- and world-writable files.")
(defface dired-directory
;; 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-warn-writable-face))
+ '(1 dired-perm-write-face))
(list (concat dired-re-maybe-mark dired-re-inode-size
"[-d].......\\(w\\).") ; world writable
- '(1 dired-warn-writable-face))
+ '(1 dired-perm-write-face))
;;
;; Subdirectories.
(list dired-re-dir
(defun dired-read-dir-and-switches (str)
;; For use in interactive.
- (reverse (list
- (if current-prefix-arg
- (read-string "Dired listing switches: "
- dired-listing-switches))
- ;; If a dialog is about to be used, call read-directory-name so
- ;; the dialog code knows we want directories. Some dialogs can
- ;; only select directories or files when popped up, not both.
- (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)))))
+ (reverse
+ (list
+ (if current-prefix-arg
+ (read-string "Dired listing switches: "
+ dired-listing-switches))
+ ;; If a dialog is about to be used, call read-directory-name so
+ ;; the dialog code knows we want directories. Some dialogs can
+ ;; only select directories or files when popped up, not both.
+ (if (next-read-file-uses-dialog-p)
+ (read-directory-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 minibuffer-completing-file-name t)
+ (setq default-directory defdir))
+ (substitute-in-file-name
+ (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]
(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)
(apply function args))))
(defun dired-format-columns-of-files (files)
- ;; Files should be in forward order for this loop.
- ;; i.e., (car files) = first file in buffer.
- ;; Returns the number of lines used.
- (let* ((maxlen (+ 2 (apply 'max (mapcar 'length files))))
- (width (- (window-width (selected-window)) 2))
- (columns (max 1 (/ width maxlen)))
- (nfiles (length files))
- (rows (+ (/ nfiles columns)
- (if (zerop (% nfiles columns)) 0 1)))
- (i 0)
- (j 0))
- (setq files (nconc (copy-sequence files) ; fill up with empty fns
- (make-list (- (* columns rows) nfiles) "")))
- (setcdr (nthcdr (1- (length files)) files) files) ; make circular
- (while (< j rows)
- (while (< i columns)
- (indent-to (* i maxlen))
- (insert (car files))
- (setq files (nthcdr rows files)
- i (1+ i)))
- (insert "\n")
- (setq i 0
- j (1+ j)
- files (cdr files)))
- rows))
+ (let ((beg (point)))
+ (completion--insert-strings files)
+ (put-text-property beg (point) 'mouse-face nil)))
\f
;; Commands to mark or flag file(s) at or near current line.
(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.
HCoop / bpt / emacs.git / blobdiff