Download
(eval-when-compile (require 'cl))
(eval-when-compile (require 'easymenu))
(require 'dired)
(require 'dired-aux)
(require 'dired-x nil t)
(require 'misc-fns nil t)
(when (memq system-type '(windows-nt ms-dos))
(require 'w32-browser nil t))
(when (< emacs-major-version 21) (require 'subr-21))
(eval-when-compile
(when (< emacs-major-version 22)
(defmacro minibuffer-with-setup-hook (fun &rest body)
"Temporarily add FUN to `minibuffer-setup-hook' while executing BODY.
BODY should use the minibuffer at most once.
Recursive uses of the minibuffer are unaffected (FUN is not
called additional times).
This macro actually adds an auxiliary function that calls FUN,
rather than FUN itself, to `minibuffer-setup-hook'."
(let ((hook (make-symbol "setup-hook")))
`(let (,hook)
(setq ,hook (lambda ()
(remove-hook 'minibuffer-setup-hook ,hook)
(funcall ,fun)))
(unwind-protect
(progn (add-hook 'minibuffer-setup-hook ,hook) ,@body)
(remove-hook 'minibuffer-setup-hook ,hook)))))))
(provide 'dired+)
(require 'dired+)
(defvar bmkp-copied-tags)
(defvar bmkp-current-bookmark-file)
(defvar dired-keep-marker-hardlink)
(defvar dired-switches-alist)
(defvar dired-subdir-switches)
(defvar dired-touch-program)
(defvar dired-use-ls-dired)
(defvar filesets-data)
(defvar grep-use-null-device)
(defvar image-dired-line-up-method)
(defvar image-dired-thumbnail-buffer)
(when (fboundp 'dired-toggle-marks) (defalias 'dired-do-toggle 'dired-toggle-marks))
(defcustom diff-switches "-c"
"*A string or list of strings specifying switches to be passed to diff."
:type '(choice string (repeat string))
:group 'dired :group 'diff)
(defcustom diredp-prompt-for-bookmark-prefix-flag nil
"*Non-nil means prompt for a prefix string for bookmark names."
:type 'boolean :group 'Dired-Plus)
(defcustom diredp-w32-local-drives '(("C:" "Local disk"))
"*Local MS Windows drives that you want to use for `diredp-w32-drives'.
Each entry is a list (DRIVE DESCRIPTION), where DRIVE is the drive
name and DESCRIPTION describes DRIVE."
:type '(alist
:key-type (string :tag "Drive name")
:value-type (group (string :tag "Drive description")))
:group 'Dired-Plus)
(defvar diredp-re-no-dot "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"
"Regexp that matches anything except `.' and `..'.")
(defvar diredp-w32-drives-mode-map (let ((map (make-sparse-keymap)))
(define-key map "q" 'bury-buffer)
(define-key map "\r" 'widget-button-press)
(define-key map [mouse-2] 'widget-button-click)
map)
"Keymap for `diredp-w32-drives-mode'.")
(defmacro dired-mark-if (predicate msg)
"Mark files for PREDICATE, according to `dired-marker-char'.
PREDICATE is evaluated on each line, with point at beginning of line.
MSG is a noun phrase for the type of files being marked.
It should end with a noun that can be pluralized by adding `s'.
Return value is the number of files marked, or nil if none were marked."
`(let ((inhibit-read-only t)
count)
(save-excursion
(setq count 0)
(when ,msg (message "%s %ss%s..."
,(cond ((eq ?\040 dired-marker-char) "Unmarking")
((eq dired-del-marker dired-marker-char) "Flagging")
(t "Marking"))
,msg
,(if (eq dired-del-marker dired-marker-char) " for deletion" "")))
(goto-char (point-min))
(while (not (eobp))
(when ,predicate (delete-char 1) (insert dired-marker-char) (setq count (1+ count)))
(forward-line 1))
(when ,msg (message "%s %s%s %s%s" count ,msg
(dired-plural-s count)
(if (eq dired-marker-char ?\040) "un" "")
(if (eq dired-marker-char dired-del-marker) "flagged" "marked"))))
(and (> count 0) count)))
(defun diredp-get-file-or-dir-name (arg)
"Return name of next file or directory or nil if none.
Argument ARG:
`all-files-no-dirs' or nil means skip directories.
`all-files-no-dots' means skip `.' and `..'."
(let ((fname nil))
(while (and (not fname) (not (eobp)))
(setq fname (dired-get-filename t t))
(when (and fname (or (not arg) (eq arg 'all-files-no-dirs)) (file-directory-p fname))
(setq fname nil))
(when (and fname (eq arg 'all-files-no-dots)
(or (member fname '("." "..")) (string-match "/\.\.?$" fname)))
(setq fname nil))
(forward-line 1))
(forward-line -1)
fname))
(defmacro dired-map-over-marks (body arg &optional show-progress
distinguish-one-marked)
"Eval BODY with point on each marked line. Return a list of BODY's results.
If no marked file could be found, execute BODY on the current line.
ARG, if non-nil, specifies the files to use instead of the marked files.
If ARG is an integer, use the next ARG files (previous -ARG, if < 0).
In that case point is dragged along. This is so that commands on
the next ARG (instead of the marked) files can be easily chained.
If ARG is a cons with element 16, 64, or 256, corresponding to
`C-u C-u', `C-u C-u C-u', or `C-u C-u C-u C-u', then use all files
in the Dired buffer, where:
16 includes NO directories (including `.' and `..')
64 includes directories EXCEPT `.' and `..'
256 includes ALL directories (including `.' and `..')
If ARG is otherwise non-nil, use the current file.
If optional third arg SHOW-PROGRESS evaluates to non-nil,
redisplay the dired buffer after each file is processed.
No guarantee is made about the position on the marked line.
BODY must ensure this itself, if it depends on this.
Search starts at the beginning of the buffer, thus the car of the list
corresponds to the line nearest to the buffer's bottom. This
is also true for (positive and negative) integer values of ARG.
BODY should not be too long, since it is expanded four times.
If DISTINGUISH-ONE-MARKED is non-nil, then return (t FILENAME) instead
of (FILENAME), if only one file is marked."
`(prog1
(let ((inhibit-read-only t)
(newarg ,arg)
multi-C-u case-fold-search found results)
(when (and (consp newarg) (> (prefix-numeric-value newarg) 4))
(setq newarg (case (prefix-numeric-value newarg)
(16 'all-files-no-dirs)
(64 'all-files-no-dots)
(256 'all-files)
(t 'all-files-no-dirs))
multi-C-u t))
(if (and newarg (not multi-C-u))
(if (integerp newarg)
(progn
(dired-repeat-over-lines newarg #'(lambda ()
(when ,show-progress (sit-for 0))
(setq results (cons ,body results))))
(if (< newarg 0) (nreverse results) results))
(list ,body))
(let ((regexp (dired-marker-regexp))
next-position)
(save-excursion
(goto-char (point-min))
(setq next-position (and (if multi-C-u
(diredp-get-file-or-dir-name newarg)
(re-search-forward regexp nil t))
(point-marker))
found (not (null next-position)))
(while next-position
(goto-char next-position)
(when ,show-progress (sit-for 0))
(setq results (cons ,body results))
(goto-char next-position)
(forward-line 1)
(set-marker next-position nil)
(setq next-position (and (if multi-C-u
(diredp-get-file-or-dir-name newarg)
(re-search-forward regexp nil t))
(point-marker)))))
(when (and ,distinguish-one-marked (= (length results) 1))
(setq results (cons t results)))
(if found results (list ,body)))))
(dired-move-to-filename)))
(unless (fboundp 'derived-mode-p)
(defun derived-mode-p (&rest modes)
"Non-nil if the current major mode is derived from one of MODES.
Uses the `derived-mode-parent' property of the symbol to trace backwards."
(let ((parent major-mode))
(while (and (not (memq parent modes)) (setq parent (get parent 'derived-mode-parent))))
parent)))
(defun diredp-ensure-mode ()
(unless (derived-mode-p 'dired-mode)
(error "You must be in Dired or a mode derived from it to use this command")))
(defun dired-get-marked-files (&optional localp arg filter distinguish-one-marked)
"Return names of the marked files as a list of strings.
The list is in the same order as the buffer, that is, the car is the
first marked file.
Values returned are normally absolute file names.
Optional arg LOCALP as in `dired-get-filename'.
Optional second argument ARG specifies files to use instead of marked.
Usually ARG comes from the command's prefix arg.
If ARG is an integer, use the next ARG files (previous -ARG, if < 0).
If ARG is a cons with element 16, 64, or 256, corresponding to
`C-u C-u', `C-u C-u C-u', or `C-u C-u C-u C-u', then use all files
in the Dired buffer, where:
16 includes NO directories (including `.' and `..')
64 includes directories EXCEPT `.' and `..'
256 includes ALL directories (including `.' and `..')
If ARG is otherwise non-nil, use the current file.
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.
If DISTINGUISH-ONE-MARKED is non-nil, then return (t FILENAME) instead
of (FILENAME), if only one file is marked. Do not use non-nil
DISTINGUISH-ONE-MARKED together with FILTER."
(let ((all-of-them (save-excursion
(dired-map-over-marks
(dired-get-filename localp) arg nil distinguish-one-marked)))
result)
(if (not filter)
(if (and distinguish-one-marked (eq (car all-of-them) t))
all-of-them
(nreverse all-of-them))
(dolist (file all-of-them) (when (funcall filter file) (push file result)))
result)))
(defun dired-map-over-marks-check (fun arg op-symbol &optional show-progress)
"Map FUN over marked lines and display failures.
FUN takes zero args. It returns non-nil (the offending object, e.g.
the short form of the filename) for a failure and probably logs a
detailed error explanation using function `dired-log'.
ARG is as in `dired-map-over-marks'.
OP-SYMBOL is a symbol describing the operation performed (e.g.
`compress'). It is used with `dired-mark-pop-up' to prompt the user
\(e.g. with `Compress * [2 files]? ') and to display errors (e.g.
`Failed to compress 1 of 2 files - type W to see why (\"foo\")')
SHOW-PROGRESS if non-nil means redisplay dired after each file."
(and (dired-mark-confirm op-symbol arg)
(let* ((total-list (dired-map-over-marks (funcall fun) arg show-progress))
(total (length total-list))
(failures (delq nil total-list))
(count (length failures))
(string (if (eq op-symbol 'compress)
"Compress or uncompress"
(capitalize (symbol-name op-symbol)))))
(if (not failures)
(message "%s: %d file%s." string total (dired-plural-s total))
(dired-log-summary (format "Failed to %s %d of %d file%s"
(downcase string) count total (dired-plural-s total))
failures)))))
(when (boundp 'dired-subdir-switches)
(defun dired-do-redisplay (&optional arg test-for-subdir)
"Redisplay all marked (or next ARG) files.
If on a subdir line, redisplay that subdirectory. In that case,
a prefix arg lets you edit the `ls' switches used for the new listing.
Dired remembers switches specified with a prefix arg, so that reverting
the buffer will not reset them. However, using `dired-undo' to re-insert
or delete subdirectories can bypass this machinery. Hence, you sometimes
may have to reset some subdirectory switches after a `dired-undo'.
You can reset all subdirectory switches to the default using
\\<dired-mode-map>\\[dired-reset-subdir-switches].
See Info node `(emacs)Subdir switches' for more details."
(interactive "P\np")
(if (and test-for-subdir (dired-get-subdir))
(let* ((dir (dired-get-subdir))
(switches (cdr (assoc-string dir dired-switches-alist))))
(dired-insert-subdir dir (and arg (read-string "Switches for listing: "
(or switches
dired-subdir-switches
dired-actual-switches)))))
(message "Redisplaying...")
(dired-uncache (if (consp dired-directory) (car dired-directory) dired-directory))
(dired-map-over-marks (let ((fname (dired-get-filename))
(dired-after-readin-hook nil))
(message "Redisplaying... `%s'" fname)
(dired-update-file-line fname))
arg)
(run-hooks 'dired-after-readin-hook)
(dired-move-to-filename)
(message "Redisplaying...done"))))
(unless (boundp 'dired-subdir-switches)
(defun dired-do-redisplay (&optional arg test-for-subdir)
"Redisplay all marked (or next ARG) files.
If on a subdir line, redisplay that subdirectory. In that case,
a prefix arg lets you edit the `ls' switches used for the new listing."
(interactive "P\np")
(if (and test-for-subdir (dired-get-subdir))
(dired-insert-subdir (dired-get-subdir)
(and arg (read-string "Switches for listing: "
dired-actual-switches)))
(message "Redisplaying...")
(dired-uncache (if (consp dired-directory) (car dired-directory) dired-directory))
(dired-map-over-marks (let ((fname (dired-get-filename)))
(message "Redisplaying... `%s'" fname)
(dired-update-file-line fname))
arg)
(dired-move-to-filename)
(message "Redisplaying...done"))))
(defun dired-switches-escape-p (switches)
"Return non-nil if the string SWITCHES contains `-b' or `--escape'."
(if (> emacs-major-version 21)
(string-match "\\(\\`\\| \\)-[[:alnum:]]*b\\|--escape\\>" switches)
(string-match "\\(\\`\\| \\)-\\(\w\\|[0-9]\\)*b\\|--escape\\>" switches)))
(when (and (> emacs-major-version 22) (featurep 'ls-lisp+))
(defun dired-insert-directory (dir switches &optional file-list wildcard hdr)
"Insert a directory listing of DIR, Dired style.
Use SWITCHES to make the listings.
If FILE-LIST is non-nil, list only those files.
Otherwise, if WILDCARD is non-nil, expand wildcards
in that case, DIR should be a file name that uses wildcards.
In other cases, DIR should be a directory name or a directory filename.
If HDR is non-nil, insert a header line with the directory name."
(let ((opoint (point))
(process-environment (copy-sequence process-environment))
end)
(when (and
(or (not (featurep 'ls-lisp)) ls-lisp-use-insert-directory-program)
(or (if (eq dired-use-ls-dired 'unspecified)
(or (setq dired-use-ls-dired (eq 0 (call-process insert-directory-program
nil nil nil "--dired")))
(progn (message "Command `ls' does not support switch `--dired' - see \
`dired-use-ls-dired'.")
nil))
dired-use-ls-dired)
(file-remote-p dir)))
(setq switches (concat "--dired " switches)))
(if file-list
(dolist (f file-list)
(let ((beg (point)))
(insert-directory f switches (string-match "[[?*]" f) nil)
(dired-align-file beg (point))))
(insert-directory dir switches wildcard (not wildcard)))
(unless (if (fboundp 'dired-switches-escape-p)
(dired-switches-escape-p dired-actual-switches)
(string-match "b" dired-actual-switches))
(save-excursion
(setq end (point-marker))
(goto-char opoint)
(while (search-forward "\\" end t)
(replace-match (apply #'propertize "\\\\" (text-properties-at (match-beginning 0)))
nil t))
(goto-char opoint)
(while (search-forward "\^m" end t)
(replace-match (apply #'propertize "\\015" (text-properties-at (match-beginning 0)))
nil t))
(set-marker end nil))
\\\\" "\\\\" dir nil t)
dir (replace-regexp-in-string "\n" "\\n" dir nil t)))
(dired-insert-set-properties opoint (point))
(unless (save-excursion (goto-char opoint) (looking-at " "))
(let ((indent-tabs-mode nil)) (indent-rigidly opoint (point) 2)))
(save-excursion
(goto-char opoint)
(when (and (or hdr wildcard) (not (and (looking-at "^ \\(.*\\):$")
(file-name-absolute-p (match-string 1)))))
(insert " " (directory-file-name (file-name-directory dir)) ":\n"))
(when wildcard
wildcard" line where "total" line would be for a full dir.
(insert " wildcard " (file-name-nondirectory dir) "\n"))))))
(when (fboundp 'image-dired-get-thumbnail-image)
(defun image-dired-dired-insert-marked-thumbs ()
"Insert thumbnails before file names of marked files in the dired buffer."
(interactive)
(dired-map-over-marks
(let* ((image-pos (dired-move-to-filename))
(image-file (dired-get-filename))
(thumb-file (image-dired-get-thumbnail-image image-file))
overlay)
(unless (delq nil (mapcar (lambda (o) (overlay-get o 'put-image))
(overlays-in (point) (1+ (point)))))
(put-image thumb-file image-pos)
(setq overlay (car (delq nil (mapcar (lambda (o) (and (overlay-get o 'put-image) o))
(overlays-in (point) (1+ (point)))))))
(overlay-put overlay 'image-file image-file)
(overlay-put overlay 'thumb-file thumb-file)))
nil)
(add-hook 'dired-after-readin-hook 'image-dired-dired-after-readin-hook nil t)))
(define-key dired-mode-map [menu-bar] nil)
(define-key dired-mode-map [menu-bar edit] 'undefined)
(defvar diredp-menu-bar-immediate-menu (make-sparse-keymap "Single"))
(define-key dired-mode-map [menu-bar immediate]
(cons "Single" diredp-menu-bar-immediate-menu))
(define-key diredp-menu-bar-immediate-menu [diredp-describe-file]
'(menu-item "Describe" diredp-describe-file
:help "Describe the file or directory at cursor"))
(define-key diredp-menu-bar-immediate-menu [separator-describe] '("--"))
(when (fboundp 'image-dired-dired-display-image)
(define-key diredp-menu-bar-immediate-menu [image-dired-dired-display-external]
'(menu-item "Display Image Externally" image-dired-dired-display-external
:help "Display image in external viewer"))
(define-key diredp-menu-bar-immediate-menu [image-dired-dired-display-image]
'(menu-item "Display Image" image-dired-dired-display-image
:help "Display sized image in a separate window"))
(define-key diredp-menu-bar-immediate-menu [separator-image] '("--")))
(when (fboundp 'diredp-chown-this-file)
(define-key diredp-menu-bar-immediate-menu [chown]
'(menu-item "Change Owner..." diredp-chown-this-file
:help "Change the owner of file at cursor")))
(when (fboundp 'diredp-chgrp-this-file)
(define-key diredp-menu-bar-immediate-menu [chgrp]
'(menu-item "Change Group..." diredp-chgrp-this-file
:help "Change the group of file at cursor")))
(define-key diredp-menu-bar-immediate-menu [chmod]
'(menu-item "Change Mode..." diredp-chmod-this-file
:help "Change mode (attributes) of file at cursor"))
(when (fboundp 'dired-do-touch)
(define-key diredp-menu-bar-immediate-menu [touch]
'(menu-item "Change Timestamp (`touch')..." diredp-touch-this-file
:help "Change the timestamp of file at cursor, using `touch'")))
(define-key diredp-menu-bar-immediate-menu [separator-change] '("--"))
(define-key diredp-menu-bar-immediate-menu [load]
'(menu-item "Load" diredp-load-this-file
:help "Load this Emacs Lisp file"))
(define-key diredp-menu-bar-immediate-menu [compile]
'(menu-item "Byte Compile" diredp-byte-compile-this-file
:help "Byte-compile this Emacs Lisp file"))
(define-key diredp-menu-bar-immediate-menu [command]
'(menu-item "Shell Command..." diredp-shell-command-this-file
:help "Run a shell command on file at cursor"))
(define-key diredp-menu-bar-immediate-menu [compress]
'(menu-item "Compress/Uncompress" diredp-compress-this-file
:help "Compress/uncompress file at cursor"))
(define-key diredp-menu-bar-immediate-menu [grep]
'(menu-item "Grep..." diredp-grep-this-file :help "Grep file at cursor"))
(define-key diredp-menu-bar-immediate-menu [print]
'(menu-item "Print..." diredp-print-this-file
:help "Print file at cursor, supplying print command"))
(when (fboundp 'mkhtml-dired-files)
(define-key diredp-menu-bar-immediate-menu [mkhtml-dired-files]
'(menu-item "Create HTML" mkhtml-dired-files
:help "Create an HTML file corresponding to file at cursor")))
(define-key diredp-menu-bar-immediate-menu [separator-misc] '("--"))
(define-key diredp-menu-bar-immediate-menu [hardlink]
'(menu-item "Hardlink to..." diredp-hardlink-this-file
:help "Make hard links for current or marked files"))
(if (not (fboundp 'dired-do-relsymlink))
(define-key diredp-menu-bar-immediate-menu [symlink]
'(menu-item "Symlink to..." diredp-symlink-this-file
:visible (fboundp 'make-symbolic-link) :help "Make symbolic link for file at cursor"))
(define-key diredp-menu-bar-immediate-menu [symlink]
'(menu-item "Symlink to (Absolute)..." diredp-symlink-this-file
:help "Make absolute symbolic link for file at cursor"))
(define-key diredp-menu-bar-immediate-menu [relsymlink]
'(menu-item "Symlink to (Relative)..." diredp-relsymlink-this-file
:help "Make relative symbolic link for file at cursor")))
(define-key diredp-menu-bar-immediate-menu [separator-link] '("--"))
(define-key diredp-menu-bar-immediate-menu [delete]
'(menu-item "Delete" diredp-delete-this-file :help "Delete file at cursor"))
(define-key diredp-menu-bar-immediate-menu [separator-delete] '("--"))
(define-key diredp-menu-bar-immediate-menu [downcase]
'(menu-item "Downcase" diredp-downcase-this-file
:enable (or (not (fboundp 'msdos-long-file-names)) (msdos-long-file-names))
:help "Rename file at cursor to a lower-case name"))
(define-key diredp-menu-bar-immediate-menu [upcase]
'(menu-item "Upcase" diredp-upcase-this-file
:enable (or (not (fboundp 'msdos-long-file-names)) (msdos-long-file-names))
:help "Rename file at cursor to an upper-case name"))
(define-key diredp-menu-bar-immediate-menu [capitalize]
'(menu-item "Capitalize" diredp-capitalize-this-file
:help "Capitalize (initial caps) name of file at cursor"))
(define-key diredp-menu-bar-immediate-menu [rename]
'(menu-item "Rename to..." diredp-rename-this-file :help "Rename file at cursor"))
(define-key diredp-menu-bar-immediate-menu [copy]
'(menu-item "Copy to..." diredp-copy-this-file :help "Copy file at cursor"))
(define-key diredp-menu-bar-immediate-menu [separator-rename] '("--"))
(define-key diredp-menu-bar-immediate-menu [backup-diff]
'(menu-item "Diff with Backup" dired-backup-diff
:help "Diff file at cursor with its latest backup"))
(define-key diredp-menu-bar-immediate-menu [diff]
'(menu-item "Diff..." dired-diff
:help "Compare file at cursor with another file using `diff'"))
(define-key diredp-menu-bar-immediate-menu [ediff]
'(menu-item "Compare..." diredp-ediff :help "Compare file at cursor with another file"))
(define-key diredp-menu-bar-immediate-menu [separator-diff] '("--"))
(define-key diredp-menu-bar-immediate-menu [dired-kill-subdir]
'(menu-item "Remove This Inserted Subdir" dired-kill-subdir
:visible (not (equal (dired-current-directory) default-directory))))
(define-key diredp-menu-bar-immediate-menu [diredp-dired-this-subdir]
'(menu-item "Dired This Inserted Subdir (Tear Off)"
(lambda () (interactive) (diredp-dired-this-subdir t))
:visible (and (cdr dired-subdir-alist)
(not (equal (dired-current-directory) default-directory)))
:help "Open Dired for subdir at or above point, tearing it off if inserted"))
(define-key diredp-menu-bar-immediate-menu [insert-subdir]
'(menu-item "Insert This Subdir" dired-maybe-insert-subdir
:visible (and (atom (diredp-this-subdir))
(not (assoc (file-name-as-directory (diredp-this-subdir)) dired-subdir-alist)))
:enable (atom (diredp-this-subdir))
:help "Insert a listing of this subdirectory"))
(define-key diredp-menu-bar-immediate-menu [goto-subdir]
'(menu-item "Go To Inserted Subdir" dired-maybe-insert-subdir
:visible (and (atom (diredp-this-subdir))
(assoc (file-name-as-directory (diredp-this-subdir)) dired-subdir-alist))
:enable (atom (diredp-this-subdir))
:help "Go to the inserted listing of this subdirectory"))
(define-key diredp-menu-bar-immediate-menu [separator-subdir] '("--"
:visible (or (atom (diredp-this-subdir))
(not (equal (dired-current-directory) default-directory)))))
(define-key diredp-menu-bar-immediate-menu [view]
'(menu-item "View (Read Only)" dired-view-file
:help "Examine file at cursor in read-only mode"))
(define-key diredp-menu-bar-immediate-menu [display]
'(menu-item "Display in Other Window" dired-display-file
:help "Display file at cursor in a different window"))
(eval-after-load "w32-browser"
'(progn
(define-key diredp-menu-bar-immediate-menu [dired-w32-browser]
'(menu-item "Open Associated Windows App" dired-w32-browser
:help "Open file using the Windows app associated with its file type"))
(define-key diredp-menu-bar-immediate-menu [dired-w32explore]
'(menu-item "Open in Windows Explorer" dired-w32explore
:help "Open file in Windows Explorer"))))
(define-key diredp-menu-bar-immediate-menu [find-file-other-frame]
'(menu-item "Open in Other Frame" diredp-find-file-other-frame
:help "Edit file at cursor in a different frame"))
(define-key diredp-menu-bar-immediate-menu [find-file-other-window]
'(menu-item "Open in Other Window" dired-find-file-other-window
:help "Edit file at cursor in a different window"))
(define-key diredp-menu-bar-immediate-menu [find-file]
'(menu-item "Open" dired-find-file :help "Edit file at cursor"))
(when (require 'bookmark+ nil t)
(defvar diredp-menu-bar-immediate-bookmarks-menu (make-sparse-keymap "Bookmarks"))
(define-key diredp-menu-bar-immediate-menu [bookmark]
(cons "Bookmarks" diredp-menu-bar-immediate-bookmarks-menu))
(define-key diredp-menu-bar-immediate-bookmarks-menu [diredp-set-tag-value-this-file]
'(menu-item "Set Tag Value..." diredp-set-tag-value-this-file
:help "Set the value (not the name) of a given tag for this file"))
(define-key diredp-menu-bar-immediate-bookmarks-menu [diredp-paste-replace-tags-this-file]
'(menu-item "Paste Tags (Replace)" diredp-paste-replace-tags-this-file
:help "Replace tags for this file with previously copied tags"))
(define-key diredp-menu-bar-immediate-bookmarks-menu [diredp-paste-add-tags-this-file]
'(menu-item "Paste Tags (Add)" diredp-paste-add-tags-this-file
:help "Add previously copied tags to this file"))
(define-key diredp-menu-bar-immediate-bookmarks-menu [diredp-copy-tags-this-file]
'(menu-item "Copy Tags" diredp-copy-tags-this-file
:help "Copy the tags from this file, so you can paste them to another"))
(define-key diredp-menu-bar-immediate-bookmarks-menu [diredp-remove-all-tags-this-file]
'(menu-item "Remove All Tags" diredp-remove-all-tags-this-file
:help "Remove all tags from the file at cursor"))
(define-key diredp-menu-bar-immediate-bookmarks-menu [diredp-untag-this-file]
'(menu-item "Remove Tags..." diredp-untag-this-file
:help "Remove some tags from the file at cursor (`C-u': remove all tags)"))
(define-key diredp-menu-bar-immediate-bookmarks-menu [diredp-tag-this-file]
'(menu-item "Add Tags..." diredp-tag-this-file :help "Add some tags to the file at cursor")))
(when (require 'bookmark+ nil t)
(define-key diredp-menu-bar-immediate-bookmarks-menu [diredp-bookmark-this-file]
'(menu-item "Bookmark..." diredp-bookmark-this-file :help "Bookmark the file at cursor")))
Operate" menu in `dired.el'.
(defvar diredp-menu-bar-operate-menu (make-sparse-keymap "Multiple"))
(define-key dired-mode-map [menu-bar operate]
(cons "Multiple" diredp-menu-bar-operate-menu))
(when (fboundp 'epa-dired-do-decrypt)
(define-key diredp-menu-bar-operate-menu [epa-dired-do-decrypt]
'(menu-item "Decrypt" epa-dired-do-decrypt :help "Decrypt file at cursor"))
(define-key diredp-menu-bar-operate-menu [epa-dired-do-verify]
'(menu-item "Verify" epa-dired-do-verify
:help "Verify digital signature of file at cursor"))
(define-key diredp-menu-bar-operate-menu [epa-dired-do-sign]
'(menu-item "Sign" epa-dired-do-sign :help "Create digital signature of file at cursor"))
(define-key diredp-menu-bar-operate-menu [epa-dired-do-encrypt]
'(menu-item "Encrypt" epa-dired-do-encrypt :help "Encrypt file at cursor"))
(define-key diredp-menu-bar-operate-menu [separator-encryption] '("--")))
(when (fboundp 'image-dired-delete-tag)
(define-key diredp-menu-bar-operate-menu [image-dired-delete-tag]
'(menu-item "Delete Image Tag..." image-dired-delete-tag
:help "Delete image tag from marked files"))
(define-key diredp-menu-bar-operate-menu [image-dired-tag-files]
'(menu-item "Add Image Tags..." image-dired-tag-files
:help "Add image tags to marked files"))
(define-key diredp-menu-bar-operate-menu [image-dired-dired-comment-files]
'(menu-item "Add Image Comment..." image-dired-dired-comment-files
:help "Add image comment to marked files"))
(define-key diredp-menu-bar-operate-menu [image-dired-display-thumbs]
'(menu-item "Display Image Thumbnails" image-dired-display-thumbs
:help "Display image thumbnails for marked image files"))
(define-key diredp-menu-bar-operate-menu [separator-image] '("--")))
(unless (memq system-type '(windows-nt ms-dos))
(define-key diredp-menu-bar-operate-menu [chown]
'(menu-item "Change Owner..." dired-do-chown
:help "Change the owner of marked files")))
(unless (memq system-type '(windows-nt ms-dos))
(define-key diredp-menu-bar-operate-menu [chgrp]
'(menu-item "Change Group..." dired-do-chgrp
:help "Change the owner of marked files")))
(define-key diredp-menu-bar-operate-menu [chmod]
'(menu-item "Change Mode..." dired-do-chmod
:help "Change mode (attributes) of marked files"))
(when (fboundp 'dired-do-touch)
(define-key diredp-menu-bar-operate-menu [touch]
'(menu-item "Change Timestamp (`touch')..." dired-do-touch
:help "Change the timestamp of the marked files, using `touch'")))
(define-key diredp-menu-bar-operate-menu [separator-change] '("--"))
(when (fboundp 'dired-do-isearch-regexp)
(define-key diredp-menu-bar-operate-menu [isearch-regexp]
'(menu-item "Isearch Regexp Files..." dired-do-isearch-regexp
:help "Incrementally search marked files for regexp"))
(define-key diredp-menu-bar-operate-menu [isearch]
'(menu-item "Isearch Files..." dired-do-isearch
:help "Incrementally search marked files for string")))
(define-key diredp-menu-bar-operate-menu [query-replace]
(if (< emacs-major-version 21)
'(menu-item "Query Replace..." dired-do-query-replace)
'(menu-item "Query Replace..." dired-do-query-replace-regexp
:help "Replace regexp in marked files")))
(define-key diredp-menu-bar-operate-menu [search]
'(menu-item "Search Files..." dired-do-search :help "Search marked files for regexp"))
(define-key diredp-menu-bar-operate-menu [grep]
'(menu-item "Grep..." diredp-do-grep :help "Grep marked, next N, or all files shown"))
(define-key diredp-menu-bar-operate-menu [separator-search] '("--"))
(define-key diredp-menu-bar-operate-menu [load]
'(menu-item "Load" dired-do-load :help "Load marked Emacs Lisp files"))
(define-key diredp-menu-bar-operate-menu [compile]
'(menu-item "Byte Compile" dired-do-byte-compile :help "Byte-compile marked Emacs Lisp files"))
(define-key diredp-menu-bar-operate-menu [command]
'(menu-item "Shell Command..." dired-do-shell-command
:help "Run a shell command on each of marked files"))
(define-key diredp-menu-bar-operate-menu [compress]
'(menu-item "Compress/Uncompress" dired-do-compress :help "Compress/uncompress marked files"))
(define-key diredp-menu-bar-operate-menu [print]
'(menu-item "Print..." dired-do-print :help "Print marked files, supplying print command"))
(unless (require 'bookmark+ nil t)
(define-key diredp-menu-bar-immediate-menu [diredp-bookmark-this-file]
'(menu-item "Bookmark..." diredp-bookmark-this-file :help "Bookmark the file at cursor")))
(when (fboundp 'mkhtml-dired-files)
(define-key diredp-menu-bar-operate-menu [mkhtml-dired-files]
'(menu-item "Create HTML" mkhtml-dired-files
:help "Create HTML files corresponding to marked files")))
(define-key diredp-menu-bar-operate-menu [separator-misc] '("--"))
(define-key diredp-menu-bar-operate-menu [hardlink]
'(menu-item "Hardlink to..." dired-do-hardlink
:help "Make hard links for current or marked files"))
(if (not (fboundp 'dired-do-relsymlink))
(define-key diredp-menu-bar-operate-menu [symlink]
'(menu-item "Symlink to..." dired-do-symlink
:visible (fboundp 'make-symbolic-link)
:help "Make symbolic links for current or marked files"))
(define-key diredp-menu-bar-operate-menu [symlink]
'(menu-item "Symlink to (Absolute)..." dired-do-symlink
:help "Make absolute symbolic links for current or marked files"))
(define-key diredp-menu-bar-operate-menu [relsymlink]
'(menu-item "Symlink to (Relative)..." dired-do-relsymlink
:help "Make relative symbolic links for current or marked files")))
(define-key diredp-menu-bar-operate-menu [separator-link] '("--"))
(define-key diredp-menu-bar-operate-menu [delete-flagged]
'(menu-item "Delete Flagged" dired-do-flagged-delete
:help "Delete all files flagged for deletion (D)"))
(define-key diredp-menu-bar-operate-menu [delete]
'(menu-item "Delete Marked (not Flagged)" dired-do-delete
:help "Delete current file or all marked files (not flagged files)"))
(define-key diredp-menu-bar-operate-menu [separator-delete] '("--"))
(define-key diredp-menu-bar-operate-menu [downcase]
'(menu-item "Downcase" dired-downcase
:enable (or (not (fboundp 'msdos-long-file-names)) (msdos-long-file-names))
:help "Rename marked files to lowercase names"))
(define-key diredp-menu-bar-operate-menu [upcase]
'(menu-item "Upcase" dired-upcase
:enable (or (not (fboundp 'msdos-long-file-names)) (msdos-long-file-names))
:help "Rename marked files to uppercase names"))
(define-key diredp-menu-bar-operate-menu [capitalize]
'(menu-item "Capitalize" diredp-capitalize
:help "Capitalize (initial caps) the names of all marked files"))
(define-key diredp-menu-bar-operate-menu [rename]
'(menu-item "Rename to..." dired-do-rename :help "Rename current file or move marked files"))
(define-key diredp-menu-bar-operate-menu [copy]
'(menu-item "Copy to..." dired-do-copy :help "Copy current file or all marked files"))
(define-key diredp-menu-bar-operate-menu [separator-rename] '("--"))
(when (fboundp 'dired-copy-filename-as-kill)
(define-key diredp-menu-bar-operate-menu [kill-ring]
'(menu-item "Copy File Names (to Paste)" dired-copy-filename-as-kill
:help "Copy names of marked files onto kill ring, for pasting")))
(define-key diredp-menu-bar-operate-menu [diredp-insert-subdirs]
'(menu-item "Insert Subdirs" diredp-insert-subdirs
:help "Insert the marked subdirectories - like using `i' at each marked dir"))
(define-key diredp-menu-bar-operate-menu [diredp-marked-other-window]
'(menu-item "Dired (Marked) in Other Window" diredp-marked-other-window
:enable (save-excursion (goto-char (point-min))
(and (re-search-forward (dired-marker-regexp) nil t)
(re-search-forward (dired-marker-regexp) nil t)))
:help "Open Dired on marked files only, in other window"))
(define-key diredp-menu-bar-operate-menu [diredp-marked]
'(menu-item "Dired (Marked)" diredp-marked
:enable (save-excursion (goto-char (point-min))
(and (re-search-forward (dired-marker-regexp) nil t)
(re-search-forward (dired-marker-regexp) nil t)))
:help "Open Dired on marked files only"))
(eval-after-load "w32-browser"
'(define-key diredp-menu-bar-operate-menu [dired-multiple-w32-browser]
'(menu-item "Open Associated Windows Apps" dired-multiple-w32-browser
:help "Open files using the Windows apps associated with their file types")))
(when (fboundp 'dired-do-find-marked-files)
(define-key diredp-menu-bar-operate-menu [find-files]
'(menu-item "Open" dired-do-find-marked-files
:help "Open each marked file for editing")))
(defvar diredp-menu-bar-recursive-marked-menu (make-sparse-keymap "Marked Here and Below"))
(define-key diredp-menu-bar-operate-menu [recursive-marked]
(cons "Marked Here and Below" diredp-menu-bar-recursive-marked-menu))
(when (> emacs-major-version 22)
(define-key diredp-menu-bar-recursive-marked-menu [diredp-do-decrypt-recursive]
'(menu-item "Decrypt..." diredp-do-decrypt-recursive
:help "Decrypt marked files, including those in marked subdirs"))
(define-key diredp-menu-bar-recursive-marked-menu [diredp-do-verify-recursive]
'(menu-item "Verify" diredp-do-verify-recursive
:help "Verify marked files, including those in marked subdirs"))
(define-key diredp-menu-bar-recursive-marked-menu [diredp-do-sign-recursive]
'(menu-item "Sign..." diredp-do-sign-recursive
:help "Sign marked files, including those in marked subdirs"))
(define-key diredp-menu-bar-recursive-marked-menu [diredp-do-encrypt-recursive]
'(menu-item "Encrypt..." diredp-do-encrypt-recursive
:help "Encrypt marked files, including those in marked subdirs"))
(define-key diredp-menu-bar-recursive-marked-menu [separator-crypt] '("--")))
(when (fboundp 'image-dired-delete-tag)
(define-key diredp-menu-bar-recursive-marked-menu [diredp-image-dired-delete-tag-recursive]
'(menu-item "Delete Image Tag..." diredp-image-dired-delete-tag-recursive
:help "Delete image tag from marked files, including those in marked subdirs"))
(define-key diredp-menu-bar-recursive-marked-menu [diredp-image-dired-tag-files-recursive]
'(menu-item "Add Image Tags..." diredp-image-dired-tag-files-recursive
:help "Add image tags to marked files, including those in marked subdirs"))
(define-key diredp-menu-bar-recursive-marked-menu [diredp-image-dired-comment-files-recursive]
'(menu-item "Add Image Comment..." diredp-image-dired-comment-files-recursive
:help "Add image comment to marked files, including those in marked subdirs"))
(define-key diredp-menu-bar-recursive-marked-menu [diredp-image-dired-display-thumbs-recursive]
'(menu-item "Display Image Thumbnails" diredp-image-dired-display-thumbs-recursive
:help "Show thumbnails for marked image files, including those in marked subdirs"))
(define-key diredp-menu-bar-recursive-marked-menu [separator-image] '("--")))
(when (fboundp 'diredp-do-chown-recursive)
(define-key diredp-menu-bar-recursive-marked-menu [chown]
'(menu-item "Change Owner..." diredp-do-chown-recursive
:help "Change the owner of marked files, including those in marked subdirs")))
(when (fboundp 'diredp-do-chgrp-recursive)
(define-key diredp-menu-bar-recursive-marked-menu [chgrp]
'(menu-item "Change Group..." diredp-do-chgrp-recursive
:help "Change the owner of marked files, including those in marked subdirs")))
(define-key diredp-menu-bar-recursive-marked-menu [chmod]
'(menu-item "Change Mode..." diredp-do-chmod-recursive
:help "Change mode (attributes) of marked files, including those in marked subdirs"))
(when (fboundp 'dired-do-touch)
(define-key diredp-menu-bar-recursive-marked-menu [touch]
'(menu-item "Change Timestamp (`touch')..." diredp-do-touch-recursive
:help "Change timestamp of marked files, including those in marked subdirs")))
(define-key diredp-menu-bar-recursive-marked-menu [separator-change] '("--"))
(when (fboundp 'dired-do-isearch-regexp)
(define-key diredp-menu-bar-recursive-marked-menu [diredp-do-isearch-regexp-recursive]
'(menu-item "Isearch Regexp Files..." diredp-do-isearch-regexp-recursive
:help "Incrementally regexp search marked files, including those in marked subdirs"))
(define-key diredp-menu-bar-recursive-marked-menu [diredp-do-isearch-recursive]
'(menu-item "Isearch Files..." diredp-do-isearch-recursive
:help "Incrementally search marked files, including those in marked subdirs")))
(define-key diredp-menu-bar-recursive-marked-menu [diredp-do-query-replace-regexp-recursive]
'(menu-item "Query Replace..." diredp-do-query-replace-regexp-recursive
:help "Replace regexp in marked files, including those in marked subdirs"))
(define-key diredp-menu-bar-recursive-marked-menu [diredp-do-search-recursive]
'(menu-item "Search Files..." diredp-do-search-recursive
:help "Regexp search marked files, including those in marked subdirs"))
(define-key diredp-menu-bar-recursive-marked-menu [diredp-do-grep-recursive]
'(menu-item "Grep..." diredp-do-grep-recursive
:help "Run `grep' on the marked files, including those in marked subdirs"))
(define-key diredp-menu-bar-recursive-marked-menu [separator-search] '("--"))
(define-key diredp-menu-bar-recursive-marked-menu [diredp-do-shell-command-recursive]
'(menu-item "Shell Command..." diredp-do-shell-command-recursive
:help "Run shell command on the marked files, including those in marked subdirs"))
(define-key diredp-menu-bar-recursive-marked-menu [diredp-do-print-recursive]
'(menu-item "Print..." diredp-do-print-recursive
:help "Print the marked files, including those in marked subdirs"))
(define-key diredp-menu-bar-recursive-marked-menu [separator-misc] '("--"))
(define-key diredp-menu-bar-recursive-marked-menu [diredp-do-hardlink-recursive]
'(menu-item "Hardlink to..." diredp-do-hardlink-recursive
:help "Make hard links for marked files, including those in marked subdirs"))
(if (not (fboundp 'dired-do-relsymlink))
(define-key diredp-menu-bar-recursive-marked-menu [diredp-do-symlink-recursive]
'(menu-item "Symlink to..." diredp-do-symlink-recursive
:visible (fboundp 'make-symbolic-link)
:help "Make symbolic links for marked files, including those in marked subdirs"))
(define-key diredp-menu-bar-recursive-marked-menu [diredp-do-symlink-recursive]
'(menu-item "Symlink to (Absolute)..." diredp-do-symlink-recursive
:help "Make absolute symbolic links for marked files, including those in marked subdirs"))
(define-key diredp-menu-bar-recursive-marked-menu [diredp-do-relsymlink-recursive]
'(menu-item "Symlink to (Relative)..." diredp-do-relsymlink-recursive
:help "Make relative symbolic links for marked files, including those in marked subdirs")))
(define-key diredp-menu-bar-recursive-marked-menu [separator-link] '("--"))
(define-key diredp-menu-bar-recursive-marked-menu [diredp-capitalize-recursive]
'(menu-item "Capitalize" diredp-capitalize-recursive
:enable (or (not (fboundp 'msdos-long-file-names)) (msdos-long-file-names))
:help "Capitalize (initial caps) the names of all marked files"))
(define-key diredp-menu-bar-recursive-marked-menu [diredp-downcase-recursive]
'(menu-item "Downcase" diredp-downcase-recursive
:enable (or (not (fboundp 'msdos-long-file-names)) (msdos-long-file-names))
:help "Rename marked files to lowercase names"))
(define-key diredp-menu-bar-recursive-marked-menu [diredp-upcase-recursive]
'(menu-item "Upcase" diredp-upcase-recursive
:enable (or (not (fboundp 'msdos-long-file-names)) (msdos-long-file-names))
:help "Rename marked files to uppercase names"))
(define-key diredp-menu-bar-recursive-marked-menu [diredp-do-move-recursive]
'(menu-item "Move to..." diredp-do-move-recursive
:help "Move marked files, including in marked subdirs, to a given directory"))
(define-key diredp-menu-bar-recursive-marked-menu [diredp-do-copy-recursive]
'(menu-item "Copy to..." diredp-do-copy-recursive
:help "Copy marked files, including in marked subdirs, to a given directory"))
(define-key diredp-menu-bar-recursive-marked-menu [separator-rename] '("--"))
(define-key diredp-menu-bar-recursive-marked-menu [diredp-list-marked-recursive]
'(menu-item "List Marked Files" diredp-list-marked-recursive
:help "List the files marked here and in marked subdirs, recursively"))
(define-key diredp-menu-bar-recursive-marked-menu [diredp-copy-filename-as-kill-recursive]
'(menu-item "Copy File Names (to Paste)" diredp-copy-filename-as-kill-recursive
:help "Copy names of marked files here and in marked subdirs, to `kill-ring'"))
(define-key diredp-menu-bar-recursive-marked-menu [diredp-insert-subdirs-recursive]
'(menu-item "Insert Subdirs" diredp-insert-subdirs-recursive
:help "Insert the marked subdirectories, gathered recursively"))
(define-key diredp-menu-bar-recursive-marked-menu [separator-dirs] '("--"))
(define-key diredp-menu-bar-recursive-marked-menu [diredp-do-bookmark-in-bookmark-file-recursive]
'(menu-item "Bookmark in Bookmark File" diredp-do-bookmark-in-bookmark-file-recursive
:help "Bookmark marked files, including those in marked subdirs, in a bookmark file"))
(define-key diredp-menu-bar-recursive-marked-menu
[diredp-set-bookmark-file-bookmark-for-marked-recursive]
'(menu-item "Create Bookmark-File Bookmark"
diredp-set-bookmark-file-bookmark-for-marked-recursive
:help "Create a bookmark-file bookmark for marked files, including in marked subdirs"))
(define-key diredp-menu-bar-recursive-marked-menu [diredp-do-bookmark-recursive]
'(menu-item "Bookmark" diredp-do-bookmark-recursive
:help "Bookmark the marked files, including those in marked subdirs"))
(define-key diredp-menu-bar-recursive-marked-menu [separator-bookmark] '("--"))
(define-key diredp-menu-bar-recursive-marked-menu [diredp-marked-recursive-other-window]
'(menu-item "Dired (Marked) in Other Window" diredp-marked-recursive-other-window
:help "Open Dired (in other window) on marked files, including those in marked subdirs"))
(define-key diredp-menu-bar-recursive-marked-menu [diredp-marked-recursive]
'(menu-item "Dired (Marked)" diredp-marked-recursive
:help "Open Dired on marked files, including those in marked subdirs"))
(eval-after-load "w32-browser"
'(define-key diredp-menu-bar-recursive-marked-menu [diredp-multiple-w32-browser-recursive]
'(menu-item "Open Associated Windows Apps" diredp-multiple-w32-browser-recursive
:help "Run Windows apps for with marked files, including those in marked subdirs")))
(define-key diredp-menu-bar-recursive-marked-menu [diredp-do-find-marked-files-recursive]
'(menu-item "Open" diredp-do-find-marked-files-recursive
:help "Find marked files simultaneously, including those in marked subdirs"))
(defvar diredp-menu-bar-operate-bookmarks-menu (make-sparse-keymap "Bookmarks"))
(define-key diredp-menu-bar-operate-menu [bookmark]
(cons "Bookmarks" diredp-menu-bar-operate-bookmarks-menu))
(when (require 'bookmark+ nil t)
(define-key diredp-menu-bar-operate-bookmarks-menu [diredp-do-set-tag-value]
'(menu-item "Set Tag Value..." diredp-do-set-tag-value
:help "Set the value of a given tag for the marked or next N files"))
(define-key diredp-menu-bar-operate-bookmarks-menu [diredp-do-paste-replace-tags]
'(menu-item "Paste Tags (Replace)" diredp-do-paste-replace-tags
:help "Replace tags for the marked or next N files with copied tags"))
(define-key diredp-menu-bar-operate-bookmarks-menu [diredp-do-paste-add-tags]
'(menu-item "Paste Tags (Add)" diredp-do-paste-add-tags
:help "Add previously copied tags to the marked or next N files"))
(define-key diredp-menu-bar-operate-bookmarks-menu [diredp-do-remove-all-tags]
'(menu-item "Remove All Tags" diredp-do-remove-all-tags
:help "Remove all tags from the marked or next N files"))
(define-key diredp-menu-bar-operate-bookmarks-menu [diredp-do-untag]
'(menu-item "Remove Tags..." diredp-do-untag
:help "Remove some tags from the marked or next N files"))
(define-key diredp-menu-bar-operate-bookmarks-menu [diredp-do-tag]
'(menu-item "Add Tags..." diredp-do-tag
:help "Add some tags to the marked or next N files"))
(define-key diredp-menu-bar-operate-bookmarks-menu [separator-book-2] '("--")))
(define-key diredp-menu-bar-operate-bookmarks-menu
[diredp-do-bookmark-in-bookmark-file-recursive]
'(menu-item "Bookmark in Bookmark File (Here and Below)..."
diredp-do-bookmark-in-bookmark-file-recursive
:help "Bookmark marked files (including in marked subdirs) in bookmark file and save it"))
(define-key diredp-menu-bar-operate-bookmarks-menu
[diredp-set-bookmark-file-bookmark-for-marked-recursive]
'(menu-item "Create Bookmark-File Bookmark (Here and Below)..."
diredp-set-bookmark-file-bookmark-for-marked-recursive
:help "Create a bookmark-file bookmark for marked files, including in marked subdirs"))
(define-key diredp-menu-bar-operate-bookmarks-menu [diredp-do-bookmark-recursive]
'(menu-item "Bookmark (Here and Below)..." diredp-do-bookmark-recursive
:help "Bookmark the marked files, including those in marked subdirs"))
(define-key diredp-menu-bar-operate-bookmarks-menu [separator-book-1] '("--"))
(define-key diredp-menu-bar-operate-bookmarks-menu [diredp-do-bookmark-in-bookmark-file]
'(menu-item "Bookmark in Bookmark File..." diredp-do-bookmark-in-bookmark-file
:help "Bookmark the marked files in BOOKMARK-FILE and save BOOKMARK-FILE"))
(define-key diredp-menu-bar-operate-bookmarks-menu [diredp-set-bookmark-file-bookmark-for-marked]
'(menu-item "Create Bookmark-File Bookmark..." diredp-set-bookmark-file-bookmark-for-marked
:help "Create a bookmark-file bookmark, and bookmark the marked files in it"))
(define-key diredp-menu-bar-operate-bookmarks-menu [diredp-do-bookmark]
'(menu-item "Bookmark..." diredp-do-bookmark :help "Bookmark the marked or next N files"))
(defvar diredp-menu-bar-regexp-menu (make-sparse-keymap "Regexp"))
(define-key dired-mode-map [menu-bar regexp]
(cons "Regexp" diredp-menu-bar-regexp-menu))
(define-key diredp-menu-bar-regexp-menu [hardlink]
'(menu-item "Hardlink to..." dired-do-hardlink-regexp
:help "Make hard links for files matching regexp"))
(if (not (fboundp 'dired-do-relsymlink-regexp))
(define-key diredp-menu-bar-regexp-menu [symlink]
'(menu-item "Symlink to..." dired-do-symlink-regexp
:visible (fboundp 'make-symbolic-link)
:help "Make symbolic links for files matching regexp"))
(define-key diredp-menu-bar-regexp-menu [symlink]
'(menu-item "Symlink to (Absolute)..." dired-do-symlink-regexp
:visible (fboundp 'make-symbolic-link)
:help "Make absolute symbolic links for files matching regexp"))
(define-key diredp-menu-bar-regexp-menu [relsymlink]
'(menu-item "Symlink to (Relative)..." dired-do-relsymlink-regexp
:visible (fboundp 'make-symbolic-link)
:help "Make relative symbolic links for files matching regexp")))
(define-key diredp-menu-bar-regexp-menu [rename]
'(menu-item "Rename to..." dired-do-rename-regexp :help "Rename marked files matching regexp"))
(define-key diredp-menu-bar-regexp-menu [copy]
'(menu-item "Copy to..." dired-do-copy-regexp :help "Copy marked files matching regexp"))
(define-key diredp-menu-bar-regexp-menu [flag]
'(menu-item "Flag..." dired-flag-files-regexp :help "Flag files matching regexp for deletion"))
(define-key diredp-menu-bar-regexp-menu [mark]
'(menu-item "Mark..." dired-mark-files-regexp
:help "Mark files matching regexp for future operations"))
(define-key diredp-menu-bar-regexp-menu [mark-cont]
'(menu-item "Mark Containing..." dired-mark-files-containing-regexp
:help "Mark files whose contents matches regexp"))
Mark" menu.
Mark" menu in `dired.el'.
(defvar diredp-menu-bar-mark-menu (make-sparse-keymap "Mark"))
(define-key dired-mode-map [menu-bar mark] (cons "Mark" diredp-menu-bar-mark-menu))
(when (fboundp 'dired-flag-extension)
(define-key diredp-menu-bar-mark-menu [flag-extension]
'(menu-item "Flag Extension..." dired-flag-extension
:help "Flag all files that have a certain extension, for deletion")))
(define-key diredp-menu-bar-mark-menu [garbage-files]
'(menu-item "Flag Garbage Files" dired-flag-garbage-files
:help "Flag unneeded files for deletion"))
(define-key diredp-menu-bar-mark-menu [backup-files]
'(menu-item "Flag Backup Files" dired-flag-backup-files
:help "Flag all backup files for deletion"))
(define-key diredp-menu-bar-mark-menu [auto-save-files]
'(menu-item "Flag Auto-save Files" dired-flag-auto-save-files
:help "Flag auto-save files for deletion"))
(define-key diredp-menu-bar-mark-menu [flag-region]
'(menu-item "Flag Region" diredp-flag-region-files-for-deletion
:enable (and transient-mark-mode mark-active (not (eq (mark) (point))))
:help "Flag all files in the region (selection) for deletion"))
(when (< emacs-major-version 21)
(put 'diredp-flag-region-files-for-deletion
'menu-enable '(and transient-mark-mode mark-active (not (eq (mark) (point))))))
(define-key diredp-menu-bar-mark-menu [deletion]
'(menu-item "Flag" dired-flag-file-deletion :help "Flag current line's file for deletion"))
(define-key diredp-menu-bar-mark-menu [separator-flag] '("--"))
(define-key diredp-menu-bar-mark-menu [prev]
'(menu-item "Previous Marked" dired-prev-marked-file :help "Move to previous marked file"))
(define-key diredp-menu-bar-mark-menu [next]
'(menu-item "Next Marked" dired-next-marked-file :help "Move to next marked file"))
(define-key diredp-menu-bar-mark-menu [marks]
'(menu-item "Change Marks..." dired-change-marks
:help "Replace marker with another character"))
(define-key diredp-menu-bar-mark-menu [omit-unmarked]
'(menu-item "Omit Unmarked" diredp-omit-unmarked :help "Hide lines of unmarked files"))
(define-key diredp-menu-bar-mark-menu [omit-marked]
'(menu-item "Omit Marked" diredp-omit-marked :help "Hide lines of marked files"))
(define-key diredp-menu-bar-mark-menu [toggle-marks]
(if (> emacs-major-version 21)
'(menu-item "Toggle Marked/Unmarked" dired-toggle-marks
:help "Mark unmarked files, unmark marked ones")
'(menu-item "Toggle Marked/Unmarked" dired-do-toggle
:help "Mark unmarked files, unmark marked ones")))
(define-key diredp-menu-bar-mark-menu [separator-mark] '("--"))
(when (fboundp 'dired-mark-sexp)
(define-key diredp-menu-bar-mark-menu [mark-sexp]
'(menu-item "Mark If..." dired-mark-sexp
:help "Mark files for which specified condition is true")))
(define-key diredp-menu-bar-mark-menu [mark-extension]
'(menu-item "Mark Extension..." diredp-mark/unmark-extension
:help "Mark all files with specified extension"))
(define-key diredp-menu-bar-mark-menu [symlinks]
'(menu-item "Mark Symlinks" dired-mark-symlinks
:visible (fboundp 'make-symbolic-link) :help "Mark all symbolic links"))
(define-key diredp-menu-bar-mark-menu [directories]
'(menu-item "Mark Directories" dired-mark-directories
:help "Mark all directories except `.' and `..'"))
(define-key diredp-menu-bar-mark-menu [directory]
'(menu-item "Mark Old Backups" dired-clean-directory
:help "Flag old numbered backups for deletion"))
(define-key diredp-menu-bar-mark-menu [executables]
'(menu-item "Mark Executables" dired-mark-executables :help "Mark all executable files"))
(define-key diredp-menu-bar-mark-menu [mark-region]
'(menu-item "Mark Region" diredp-mark-region-files
:enable (and transient-mark-mode mark-active (not (eq (mark) (point))))
:help "Mark all of the files in the region (selection)"))
(when (< emacs-major-version 21)
(put 'diredp-mark-region-files
'menu-enable '(and transient-mark-mode mark-active (not (eq (mark) (point))))))
(define-key diredp-menu-bar-mark-menu [mark]
'(menu-item "Mark" dired-mark :help "Mark current line's file for future operations"))
(define-key diredp-menu-bar-mark-menu [separator-unmark] '("--"))
(define-key diredp-menu-bar-mark-menu [unmark-all]
'(menu-item "Unmark All" dired-unmark-all-marks :help "Remove all marks from all files"))
(define-key diredp-menu-bar-mark-menu [unmark-with]
'(menu-item "Unmark Marked-With..." dired-unmark-all-files
:help "Remove a specific mark (or all marks) from every file"))
(define-key diredp-menu-bar-mark-menu [unmark-region]
'(menu-item "Unmark Region" diredp-unmark-region-files
:enable (and transient-mark-mode mark-active (not (eq (mark) (point))))
:help "Unmark all files in the region (selection)"))
(when (< emacs-major-version 21)
(put 'diredp-unmark-region-files
'menu-enable '(and transient-mark-mode mark-active (not (eq (mark) (point))))))
(define-key diredp-menu-bar-mark-menu [unmark]
'(menu-item "Unmark" dired-unmark :help "Unmark or unflag current line's file"))
(when (require 'bookmark+ nil t)
(defvar diredp-mark-tags-menu (make-sparse-keymap "Tagged")
"`Tags' submenu for Dired menu-bar `Mark' menu.")
(define-key diredp-menu-bar-mark-menu [mark-tags] (cons "Tagged" diredp-mark-tags-menu))
(define-key diredp-mark-tags-menu [diredp-unmark-files-tagged-none]
'(menu-item "Unmark Not Tagged with Any..." diredp-unmark-files-tagged-none
:help "Unmark files that are not tagged with *any* of the tags you enter"))
(define-key diredp-mark-tags-menu [diredp-unmark-files-tagged-not-all]
'(menu-item "Unmark Not Tagged with All..." diredp-unmark-files-tagged-not-all
:help "Unmark files that are not tagged with *all* tags"))
(define-key diredp-mark-tags-menu [diredp-unmark-files-tagged-some]
'(menu-item "Unmark Tagged with Some..." diredp-unmark-files-tagged-some
:help "Unmark files that are tagged with at least one of the tags you enter"))
(define-key diredp-mark-tags-menu [diredp-unmark-files-tagged-all]
'(menu-item "Unmark Tagged with All..." diredp-unmark-files-tagged-all
:help "Unmark files that are tagged with *each* tag you enter"))
(define-key diredp-mark-tags-menu [diredp-unmark-files-tagged-regexp]
'(menu-item "Unmark Tagged Matching Regexp..." diredp-unmark-files-tagged-regexp
:help "Unmark files that have at least one tag that matches a regexp"))
(define-key diredp-mark-tags-menu [diredp-mark-files-tagged-none]
'(menu-item "Mark Not Tagged with Any..." diredp-mark-files-tagged-none
:help "Mark files that are not tagged with *any* of the tags you enter"))
(define-key diredp-mark-tags-menu [diredp-mark-files-tagged-not-all]
'(menu-item "Mark Not Tagged with All..." diredp-mark-files-tagged-not-all
:help "Mark files that are not tagged with *all* tags"))
(define-key diredp-mark-tags-menu [diredp-mark-files-tagged-some]
'(menu-item "Mark Tagged with Some..." diredp-mark-files-tagged-some
:help "Mark files that are tagged with at least one of the tags you enter"))
(define-key diredp-mark-tags-menu [diredp-mark-files-tagged-all]
'(menu-item "Mark Tagged with All..." diredp-mark-files-tagged-all
:help "Mark files that are tagged with *each* tag you enter"))
(define-key diredp-mark-tags-menu [diredp-mark-files-tagged-regexp]
'(menu-item "Mark Tagged Matching Regexp..." diredp-mark-files-tagged-regexp
:help "Mark files that have at least one tag that matches a regexp")))
Dir" menu.
Subdir" menu in `dired.el'.
(defvar diredp-menu-bar-subdir-menu (make-sparse-keymap "Dir"))
(define-key dired-mode-map [menu-bar subdir]
(cons "Dir" diredp-menu-bar-subdir-menu))
(define-key diredp-menu-bar-subdir-menu [hide-all]
'(menu-item "Hide/Show All" dired-hide-all
:help "Hide all subdirectories, leave only header lines"))
(define-key diredp-menu-bar-subdir-menu [hide-subdir]
'(menu-item "Hide/Show Subdir" dired-hide-subdir
:help "Hide or unhide current directory listing"))
(define-key diredp-menu-bar-subdir-menu [tree-down]
'(menu-item "Tree Down" dired-tree-down :help "Go to first subdirectory header down the tree"))
(define-key diredp-menu-bar-subdir-menu [tree-up]
'(menu-item "Tree Up" dired-tree-up :help "Go to first subdirectory header up the tree"))
(define-key diredp-menu-bar-subdir-menu [up]
'(menu-item "Up Directory" dired-up-directory :help "Dired the parent directory"))
(define-key diredp-menu-bar-subdir-menu [prev-subdir]
'(menu-item "Prev Subdir" dired-prev-subdir :help "Go to previous subdirectory header line"))
(define-key diredp-menu-bar-subdir-menu [next-subdir]
'(menu-item "Next Subdir" dired-next-subdir :help "Go to next subdirectory header line"))
(define-key diredp-menu-bar-subdir-menu [prev-dirline]
'(menu-item "Prev Dirline" dired-prev-dirline :help "Move to previous directory-file line"))
(define-key diredp-menu-bar-subdir-menu [next-dirline]
'(menu-item "Next Dirline" dired-next-dirline :help "Move to next directory-file line"))
(define-key diredp-menu-bar-subdir-menu [insert]
'(menu-item "This Subdir" dired-maybe-insert-subdir
:help "Move to subdirectory line or listing"))
(define-key diredp-menu-bar-subdir-menu [separator-subdir] '("--"))
(when (fboundp 'image-dired-dired-toggle-marked-thumbs)
(define-key diredp-menu-bar-subdir-menu [image-dired-dired-toggle-marked-thumbs]
'(menu-item "Toggle Image Thumbnails" image-dired-dired-toggle-marked-thumbs
:help "Add or remove image thumbnails in front of marked file names")))
(when (fboundp 'dired-isearch-filenames)
(define-key diredp-menu-bar-subdir-menu [isearch-filenames-regexp]
'(menu-item "Isearch Regexp in File Names..." dired-isearch-filenames-regexp
:help "Incrementally search for regexp in file names only"))
(define-key diredp-menu-bar-subdir-menu [isearch-filenames]
'(menu-item "Isearch in File Names..." dired-isearch-filenames
:help "Incrementally search for literal text in file names only.")))
(when (or (> emacs-major-version 21) (fboundp 'wdired-change-to-wdired-mode))
(define-key diredp-menu-bar-subdir-menu [wdired-mode]
'(menu-item "Edit File Names (WDired)" wdired-change-to-wdired-mode
:help "Put a dired buffer in a mode in which filenames are editable"
:keys "C-x C-q" :filter (lambda (x) (and (derived-mode-p 'dired-mode) x)))))
(when (fboundp 'dired-compare-directories)
(define-key diredp-menu-bar-subdir-menu [compare-directories]
'(menu-item "Compare Directories..." dired-compare-directories
:help "Mark files with different attributes in two Dired buffers")))
(define-key diredp-menu-bar-subdir-menu [create-directory] Immediate".
'(menu-item "New Directory..." dired-create-directory :help "Create a directory"))
(define-key diredp-menu-bar-subdir-menu [separator-dired-on-set] '("--"))
(define-key diredp-menu-bar-subdir-menu [diredp-dired-inserted-subdirs]
'(menu-item "Dired Each Inserted Subdir..." diredp-dired-inserted-subdirs
:enable (cdr dired-subdir-alist)
:help "Open Dired for each of the inserted subdirectories"))
(define-key diredp-menu-bar-subdir-menu [diredp-dired-union-other-window]
'(menu-item "Dired Union..." diredp-dired-union-other-window
:help "Open Dired for the union of some existing Dired buffers"))
(define-key diredp-menu-bar-subdir-menu [diredp-fileset]
'(menu-item "Dired Fileset..." diredp-fileset
:enable (> emacs-major-version 21) :help "Open Dired on an Emacs fileset"))
(define-key diredp-menu-bar-subdir-menu [diredp-marked-other-window]
'(menu-item "Dired Marked Files in Other Window" diredp-marked-other-window
:enable (save-excursion (goto-char (point-min))
(and (re-search-forward (dired-marker-regexp) nil t)
(re-search-forward (dired-marker-regexp) nil t)))
:help "Open Dired on marked files only, in other window"))
(define-key diredp-menu-bar-subdir-menu [diredp-marked]
'(menu-item "Dired Marked Files" diredp-marked
:enable (save-excursion (goto-char (point-min))
(and (re-search-forward (dired-marker-regexp) nil t)
(re-search-forward (dired-marker-regexp) nil t)))
:help "Open Dired on marked files only"))
(define-key diredp-menu-bar-subdir-menu [dired]
'(menu-item "Dired (Filter via Wildcards)..." dired
:help "Explore a directory (you can provide wildcards)"))
(define-key diredp-menu-bar-subdir-menu [revert]
'(menu-item "Refresh (Sync \& Show All)" revert-buffer :help "Update directory contents"))
(define-key dired-mode-map [down-mouse-3] 'diredp-mouse-3-menu)
(define-key dired-mode-map [mouse-3] 'ignore)
d" 'diredp-dired-files) ; `C-x d'
d" 'diredp-dired-files-other-window) ; `C-x 4 d'
(define-key dired-mode-map [S-down-mouse-1] 'ignore)
(define-key dired-mode-map [S-mouse-1] 'diredp-mouse-mark-region-files)
(define-key dired-mode-map [mouse-2] 'dired-mouse-find-file-other-window)
(define-key dired-mode-map [S-down-mouse-2] 'diredp-mouse-find-file)
(define-key dired-mode-map [S-mouse-2] 'ignore)
(define-key dired-mode-map [M-mouse-2] 'diredp-mouse-find-file-other-frame)
(eval-after-load "w32-browser"
'(progn
(define-key dired-mode-map [(control return)] 'dired-w32explore)
(define-key dired-mode-map [(meta return)] 'dired-w32-browser)
(define-key dired-mode-map [mouse-2] 'dired-mouse-w32-browser)))
(define-key dired-mode-map "=" 'diredp-ediff)
(define-key dired-mode-map "*." 'diredp-mark/unmark-extension)
(define-key dired-mode-map [(control meta ?*)] 'diredp-marked-other-window)
(define-key dired-mode-map "\M-b" 'diredp-do-bookmark)
(define-key dired-mode-map "\C-\M-b" 'diredp-set-bookmark-file-bookmark-for-marked)
(define-key dired-mode-map [(control meta shift ?b)]
'diredp-do-bookmark-in-bookmark-file)
(define-key dired-mode-map "\M-g" 'diredp-do-grep)
(when (fboundp 'mkhtml-dired-files)
(define-key dired-mode-map "\M-h" 'mkhtml-dired-files))
(define-key dired-mode-map "U" 'dired-unmark-all-marks)
(substitute-key-definition 'describe-mode 'diredp-describe-mode
dired-mode-map (current-global-map))
(define-key dired-mode-map "T" nil)
(define-key dired-mode-map "T+" 'diredp-tag-this-file)
(define-key dired-mode-map "T-" 'diredp-untag-this-file)
(define-key dired-mode-map "T0" 'diredp-remove-all-tags-this-file)
(define-key dired-mode-map "Tc" 'diredp-copy-tags-this-file)
(define-key dired-mode-map "Tp" 'diredp-paste-add-tags-this-file)
(define-key dired-mode-map "Tq" 'diredp-paste-replace-tags-this-file)
(define-key dired-mode-map "Tv" 'diredp-set-tag-value-this-file)
(define-key dired-mode-map "T\M-w" 'diredp-copy-tags-this-file)
(define-key dired-mode-map "T\C-y" 'diredp-paste-add-tags-this-file)
(define-key dired-mode-map "T>+" 'diredp-do-tag)
(define-key dired-mode-map "T>-" 'diredp-do-untag)
(define-key dired-mode-map "T>0" 'diredp-do-remove-all-tags)
(define-key dired-mode-map "T>p" 'diredp-do-paste-add-tags)
(define-key dired-mode-map "T>q" 'diredp-do-paste-replace-tags)
(define-key dired-mode-map "T>v" 'diredp-do-set-tag-value)
(define-key dired-mode-map "T>\C-y" 'diredp-do-paste-add-tags)
(define-key dired-mode-map "Tm%" 'diredp-mark-files-tagged-regexp)
(define-key dired-mode-map "Tm*" 'diredp-mark-files-tagged-all)
(define-key dired-mode-map "Tm+" 'diredp-mark-files-tagged-some)
(define-key dired-mode-map "Tm~*" 'diredp-mark-files-tagged-not-all)
(define-key dired-mode-map "Tm~+" 'diredp-mark-files-tagged-none)
(define-key dired-mode-map "Tu%" 'diredp-unmark-files-tagged-regexp)
(define-key dired-mode-map "Tu*" 'diredp-unmark-files-tagged-all)
(define-key dired-mode-map "Tu+" 'diredp-unmark-files-tagged-some)
(define-key dired-mode-map "Tu~*" 'diredp-unmark-files-tagged-not-all)
(define-key dired-mode-map "Tu~+" 'diredp-unmark-files-tagged-none)
(define-key dired-mode-map "\r" 'dired-find-file)
(define-key dired-mode-map (kbd "C-h RET") 'diredp-describe-file)
(define-key dired-mode-map (kbd "C-h C-<return>") 'diredp-describe-file)
(define-key dired-mode-map "%c" 'diredp-capitalize)
(define-key dired-mode-map "b" 'diredp-byte-compile-this-file)
(define-key dired-mode-map [(control shift ?b)] 'diredp-bookmark-this-file)
(define-key dired-mode-map "\M-c" 'diredp-capitalize-this-file)
(when (fboundp 'diredp-chgrp-this-file)
(define-key dired-mode-map [(control meta shift ?g)] 'diredp-chgrp-this-file))
(define-key dired-mode-map "\M-i" 'diredp-insert-subdirs)
(define-key dired-mode-map "\M-l" 'diredp-downcase-this-file)
(define-key dired-mode-map [(meta shift ?m)] 'diredp-chmod-this-file)
(define-key dired-mode-map "\C-o" 'diredp-find-file-other-frame)
(when (fboundp 'diredp-chown-this-file)
(define-key dired-mode-map [(meta shift ?o)] 'diredp-chown-this-file))
(define-key dired-mode-map "\C-\M-o" 'dired-display-file)
(define-key dired-mode-map "\M-p" 'diredp-print-this-file)
(define-key dired-mode-map "r" 'diredp-rename-this-file)
(define-key dired-mode-map [(meta shift ?t)] 'diredp-touch-this-file)
(define-key dired-mode-map [(control meta shift ?t)] 'dired-do-touch)
(define-key dired-mode-map "\M-u" 'diredp-upcase-this-file)
(define-key dired-mode-map "y" 'diredp-relsymlink-this-file)
(define-key dired-mode-map "z" 'diredp-compress-this-file)
(when (fboundp 'dired-show-file-type)
(define-key dired-mode-map "_" 'dired-show-file-type))
(substitute-key-definition 'kill-line 'diredp-delete-this-file
dired-mode-map (current-global-map))
(define-prefix-command 'diredp-recursive-map)
(define-key dired-mode-map "\M-+" diredp-recursive-map)
(when (> emacs-major-version 22)
(define-key diredp-recursive-map ":d class="string">" 'diredp-do-decrypt-recursive)
(define-key diredp-recursive-map ":e class="string">" 'diredp-do-encrypt-recursive)
(define-key diredp-recursive-map ":s class="string">" 'diredp-do-sign-recursive)
(define-key diredp-recursive-map ":v class="string">" 'diredp-do-verify-recursive)
)
(define-key diredp-recursive-map "%c" 'diredp-capitalize-recursive)
(define-key diredp-recursive-map "%l" 'diredp-downcase-recursive)
(define-key diredp-recursive-map "%u" 'diredp-upcase-recursive)
(define-key diredp-recursive-map "!" 'diredp-do-shell-command-recursive)
(define-key diredp-recursive-map (kbd "C-M-*") 'diredp-marked-recursive-other-window)
(define-key diredp-recursive-map "A" 'diredp-do-search-recursive)
(define-key diredp-recursive-map "\M-b" 'diredp-do-bookmark-recursive)
(define-key diredp-recursive-map (kbd "C-M-b")
'diredp-set-bookmark-file-bookmark-for-marked-recursive)
(define-key diredp-recursive-map [(control meta shift ?b)]
'diredp-do-bookmark-in-bookmark-file-recursive)
(define-key diredp-recursive-map "C" 'diredp-do-copy-recursive)
(define-key diredp-recursive-map "F" 'diredp-do-find-marked-files-recursive)
(when (fboundp 'diredp-do-chgrp-recursive)
(define-key diredp-recursive-map "G" 'diredp-do-chgrp-recursive))
(define-key diredp-recursive-map "\M-g" 'diredp-do-grep-recursive)
(define-key diredp-recursive-map "H" 'diredp-do-hardlink-recursive)
(define-key diredp-recursive-map "\M-i" 'diredp-insert-subdirs-recursive)
(define-key diredp-recursive-map "l" 'diredp-list-marked-recursive)
(define-key diredp-recursive-map "M" 'diredp-do-chmod-recursive)
(when (fboundp 'diredp-do-chown-recursive)
(define-key diredp-recursive-map "O" 'diredp-do-chown-recursive))
(define-key diredp-recursive-map "P" 'diredp-do-print-recursive)
(define-key diredp-recursive-map "Q" 'diredp-do-query-replace-regexp-recursive)
(define-key diredp-recursive-map "R" 'diredp-do-move-recursive)
(define-key diredp-recursive-map "S" 'diredp-do-symlink-recursive)
(define-key diredp-recursive-map (kbd "M-s a C-s")
'diredp-do-isearch-recursive)
(define-key diredp-recursive-map (kbd "M-s a C-M-s")
'diredp-do-isearch-regexp-recursive)
(define-key diredp-recursive-map [(control meta shift ?t)] 'diredp-do-touch-recursive)
(define-key diredp-recursive-map "\C-tc" 'diredp-image-dired-comment-files-recursive)
(define-key diredp-recursive-map "\C-td" 'diredp-image-dired-display-thumbs-recursive)
(define-key diredp-recursive-map "\C-tr" 'diredp-image-dired-delete-tag-recursive)
(define-key diredp-recursive-map "\C-tt" 'diredp-image-dired-tag-files-recursive)
(define-key diredp-recursive-map "\M-w" 'diredp-copy-filename-as-kill-recursive)
(define-key diredp-recursive-map "Y" 'diredp-do-relsymlink-recursive)
(when (fboundp 'undefine-killer-commands) (undefine-killer-commands dired-mode-map))
(defgroup Dired-Plus nil
"Various enhancements to Dired."
:prefix "diredp-" :group 'dired
:link `(url-link :tag "Send Bug Report"
,(concat "mailto: class="string">" "drew.adams" "@" "oracle" ".com?subject=\
dired+.el bug: \
&body=Describe bug here, starting with `emacs -q'. \
Don't forget to mention your Emacs and library versions."))
:link '(url-link :tag "Other Libraries by Drew"
"http://www.emacswiki.org/cgi-bin/wiki/DrewsElispLibraries")
:link '(url-link :tag "Download"
"http://www.emacswiki.org/cgi-bin/wiki/dired+.el")
:link '(url-link :tag "Description"
"http://www.emacswiki.org/cgi-bin/wiki/DiredPlus")
:link '(emacs-commentary-link :tag "Commentary" "dired+"))
(defface diredp-display-msg
'((((background dark)) (:foreground "Yellow"))
(t (:foreground "Blue")))
"*Face used for message display."
:group 'Dired-Plus)
(defvar diredp-display-msg 'diredp-display-msg)
(defface diredp-dir-heading
'((((background dark)) (:foreground "Yellow" :background "#00003F3F3434"))
(t (:foreground "Blue" :background "Pink")))
"*Face used for directory headings in dired buffers."
:group 'Dired-Plus :group 'font-lock-highlighting-faces)
(defvar diredp-dir-heading 'diredp-dir-heading)
(defface diredp-deletion
'((t (:foreground "Yellow" :background "Red")))
"*Face used for deletion flags (D) in dired buffers."
:group 'Dired-Plus :group 'font-lock-highlighting-faces)
(defvar diredp-deletion 'diredp-deletion)
(defface diredp-deletion-file-name
'((t (:foreground "Red")))
"*Face used for names of deleted files in dired buffers."
:group 'Dired-Plus :group 'font-lock-highlighting-faces)
(defvar diredp-deletion-file-name 'diredp-deletion-file-name)
(defface diredp-flag-mark
'((((background dark)) (:foreground "Blue" :background "#7575D4D41D1D"))
(t (:foreground "Yellow" :background "Blueviolet")))
"*Face used for flags and marks (except D) in dired buffers."
:group 'Dired-Plus :group 'font-lock-highlighting-faces)
(defvar diredp-flag-mark 'diredp-flag-mark)
(defface diredp-flag-mark-line
'((((background dark)) (:background "#787831311414"))
(t (:background "Skyblue")))
"*Face used for flagged and marked lines in dired buffers."
:group 'Dired-Plus :group 'font-lock-highlighting-faces)
(defvar diredp-flag-mark-line 'diredp-flag-mark-line)
(defface diredp-file-suffix
'((((background dark)) (:foreground "#7474FFFF7474"))
(t (:foreground "DarkMagenta")))
"*Face used for file suffixes in dired buffers."
:group 'Dired-Plus :group 'font-lock-highlighting-faces)
(defvar diredp-file-suffix 'diredp-file-suffix)
(defface diredp-number
'((((background dark)) (:foreground "#FFFFFFFF7474"))
(t (:foreground "DarkBlue")))
"*Face used for numerical fields in dired buffers.
In particular, inode number, number of hard links, and file size."
:group 'Dired-Plus :group 'font-lock-highlighting-faces)
(defvar diredp-number 'diredp-number)
(defface diredp-symlink
'((((background dark)) (:foreground "#00007373FFFF"))
(t (:foreground "DarkOrange")))
"*Face used for symbolic links in dired buffers."
:group 'Dired-Plus :group 'font-lock-highlighting-faces)
(defvar diredp-symlink 'diredp-symlink)
(defface diredp-date-time
'((((background dark)) (:foreground "#74749A9AF7F7"))
(t (:foreground "DarkGoldenrod4")))
"*Face used for date and time in dired buffers."
:group 'Dired-Plus :group 'font-lock-highlighting-faces)
(defvar diredp-date-time 'diredp-date-time)
(defface diredp-file-name
'((((background dark)) (:foreground "Yellow"))
(t (:foreground "Blue")))
"*Face used for file names (without suffixes) in dired buffers."
:group 'Dired-Plus :group 'font-lock-highlighting-faces)
(defvar diredp-file-name 'diredp-file-name)
(defface diredp-ignored-file-name
'(#FFFF921F921F")) ; ~ salmon
#A71F5F645F64")) ; ~ dark salmon
(((background dark)) (:foreground "#C29D6F156F15"))
(t (:foreground "#00006DE06DE0")))
"*Face used for ignored file names in dired buffers."
:group 'Dired-Plus :group 'font-lock-highlighting-faces)
(defvar diredp-ignored-file-name 'diredp-ignored-file-name)
(defface diredp-compressed-file-suffix
'((((background dark)) (:foreground "Blue"))
(t (:foreground "Yellow")))
"*Face used for compressed file suffixes in dired buffers."
:group 'Dired-Plus :group 'font-lock-highlighting-faces)
(defvar diredp-compressed-file-suffix 'diredp-compressed-file-suffix)
-alF" for `dired-listing-switches'.
(defface diredp-executable-tag
'((t (:foreground "Red")))
"*Face used for executable tag (*) on file names in dired buffers."
:group 'Dired-Plus :group 'font-lock-highlighting-faces)
(defvar diredp-executable-tag 'diredp-executable-tag)
(defface diredp-dir-priv
'((((background dark))
(:foreground "#7474FFFFFFFF" :background "#2C2C2C2C2C2C"))
(t (:foreground "DarkRed" :background "LightGray")))
"*Face used for directory privilege indicator (d) in dired buffers."
:group 'Dired-Plus :group 'font-lock-highlighting-faces)
(defvar diredp-dir-priv 'diredp-dir-priv)
(defface diredp-exec-priv
'((((background dark)) (:background "#4F4F3B3B2121"))
(t (:background "LightSteelBlue")))
"*Face used for execute privilege indicator (x) in dired buffers."
:group 'Dired-Plus :group 'font-lock-highlighting-faces)
(defvar diredp-exec-priv 'diredp-exec-priv)
(defface diredp-other-priv
'((((background dark)) (:background "#111117175555"))
(t (:background "PaleGoldenrod")))
"*Face used for l,s,S,t,T privilege indicators in dired buffers."
:group 'Dired-Plus :group 'font-lock-highlighting-faces)
(defvar diredp-other-priv 'diredp-other-priv)
(defface diredp-write-priv
'((((background dark)) (:background "#25258F8F2929"))
(t (:background "Orchid")))
"*Face used for write privilege indicator (w) in dired buffers."
:group 'Dired-Plus :group 'font-lock-highlighting-faces)
(defvar diredp-write-priv 'diredp-write-priv)
(defface diredp-read-priv
'((((background dark)) (:background "#999932325555"))
(t (:background "MediumAquamarine")))
"*Face used for read privilege indicator (w) in dired buffers."
:group 'Dired-Plus :group 'font-lock-highlighting-faces)
(defvar diredp-read-priv 'diredp-read-priv)
(defface diredp-no-priv
'((((background dark)) (:background "#2C2C2C2C2C2C"))
(t (:background "LightGray")))
"*Face used for no privilege indicator (-) in dired buffers."
:group 'Dired-Plus :group 'font-lock-highlighting-faces)
(defvar diredp-no-priv 'diredp-no-priv)
(defface diredp-rare-priv
'((((background dark)) (:foreground "Green" :background "#FFFF00008080"))
(t (:foreground "Magenta" :background "SpringGreen")))
"*Face used for rare privilege indicators (b,c,s,m,p,S) in dired buffers."
:group 'Dired-Plus :group 'font-lock-highlighting-faces)
(defvar diredp-rare-priv 'diredp-rare-priv)
(defface diredp-link-priv
'((((background dark)) (:foreground "#00007373FFFF"))
(t (:foreground "DarkOrange")))
"*Face used for link privilege indicator (l) in dired buffers."
:group 'Dired-Plus :group 'font-lock-highlighting-faces)
(defvar diredp-link-priv 'diredp-link-priv)
(when (and (< emacs-major-version 21) (not (boundp 'diredp-loaded-p))
dired-move-to-filename-regexp
(eq (aref dired-move-to-filename-regexp 7) ?\ ))
(setq dired-move-to-filename-regexp (concat "[0-9][BkKMGTPEZY]?"
(substring dired-move-to-filename-regexp 7))))
(defvar diredp-font-lock-keywords-1
(list
'("^ \\(.+:\\)$" 1 diredp-dir-heading)
'("^ wildcard.*$" 0 'default)
'("^ (No match).*$" 0 'default)
'("[^ .]\\.\\([^. /]+\\)$" 1 diredp-file-suffix)
'("\\([^ ]+\\) -> [^ ]+$" 1 diredp-symlink)
(if (or (not (fboundp 'version<)) (version< emacs-version "23.2"))
(list dired-move-to-filename-regexp
(list 1 'diredp-date-time t t)
(list "\\(.+\\)$" nil nil (list 0 diredp-file-name 'keep t)))
(list dired-move-to-filename-regexp
(list 7 'diredp-date-time t t)
(list 2 'diredp-date-time t t)
(list "\\(.+\\)$" nil nil (list 0 diredp-file-name 'keep t))))
(list (concat "^ \\(.*\\(" (concat (mapconcat 'regexp-quote
(or (and (boundp 'dired-omit-extensions)
dired-omit-extensions)
completion-ignored-extensions)
"[*]?\\|")
"[*]?")
"\\|\\.\\(g?z\\|Z\\)[*]?\\)\\)$")
1 diredp-ignored-file-name t)
'("[^ .]\\.\\([bg]?[zZ]2?\\)[*]?$" 1 diredp-compressed-file-suffix t)
'("\\([*]\\)$" 1 diredp-executable-tag t)
'("\\(\\([0-9]+\\([.,][0-9]+\\)?\\)[BkKMGTPEZY]? \\)" 1 diredp-number)
(list "^..\\([0-9]* \\)*d"
(list dired-move-to-filename-regexp nil nil)
(list "\\(.+\\)" nil nil '(0 diredp-dir-priv t t)))
'("^..\\([0-9]* \\)*.........\\(x\\)" 2 diredp-exec-priv)
'("^..\\([0-9]* \\)*.........\\([lsStT]\\)" 2 diredp-other-priv)
'("^..\\([0-9]* \\)*........\\(w\\)" 2 diredp-write-priv)
'("^..\\([0-9]* \\)*.......\\(r\\)" 2 diredp-read-priv)
'("^..\\([0-9]* \\)*......\\(x\\)" 2 diredp-exec-priv)
'("^..\\([0-9]* \\)*....[^0-9].\\([lsStT]\\)" 2 diredp-other-priv)
'("^..\\([0-9]* \\)*.....\\(w\\)" 2 diredp-write-priv)
'("^..\\([0-9]* \\)*....\\(r\\)" 2 diredp-read-priv)
'("^..\\([0-9]* \\)*...\\(x\\)" 2 diredp-exec-priv)
'("^..\\([0-9]* \\)*...\\([lsStT]\\)" 2 diredp-other-priv)
'("^..\\([0-9]* \\)*..\\(w\\)" 2 diredp-write-priv)
'("^..\\([0-9]* \\)*.\\(r\\)" 2 diredp-read-priv)
'("^..\\([0-9]* \\)*.\\([-rwxlsStT]+\\)" 2 diredp-no-priv keep)
'("^..\\([0-9]* \\)*\\([bcsmpS]\\)[-rwxlsStT]" 2 diredp-rare-priv)
'("^..\\([0-9]* \\)*\\(l\\)[-rwxlsStT]" 2 diredp-link-priv)
(list (concat "^\\([^\n " (char-to-string dired-del-marker) "].*$\\)")
1 diredp-flag-mark-line t)
(list (concat "^\\([" (char-to-string dired-del-marker) "]\\)")
'(1 diredp-deletion t)
'(".+" (dired-move-to-filename) nil (0 diredp-deletion-file-name t)))
(list (concat "^\\([^\n " (char-to-string dired-del-marker) "]\\)")
1 diredp-flag-mark t)
) "2nd level of Dired highlighting. See `font-lock-maximum-decoration'.")
(add-hook 'dired-mode-hook
(lambda ()
(set (make-local-variable 'font-lock-defaults)
'((dired-font-lock-keywords
dired-font-lock-keywords
diredp-font-lock-keywords-1)
t nil nil beginning-of-line))
(when (fboundp 'font-lock-refresh-defaults) (font-lock-refresh-defaults))))
(defun diredp-dired-files (arg &optional switches)
"Like `dired', but non-positive prefix arg prompts for files to list.
This is like `dired' unless you use a non-positive prefix arg.
In that case, you are prompted for names of files and directories to
list, and then you are prompted for the name of the Dired buffer that
lists them. Use `C-g' when you are done entering file names to list.
In all cases, when inputting a file or directory name you can use
shell wildcards.
If you use Icicles, then in Icicle mode the following keys are bound
in the minibuffer during completion (`*' means the key requires
library `Bookmark+'):
M-| - Open Dired on the file names matching your input
C-c + - Create a new directory
*C-x a + - Add tags to the current-candidate file
*C-x a - - Remove tags from the current-candidate file
*C-x m - Access file bookmarks (not just autofiles)"
(interactive (diredp-dired-files-interactive-spec ""))
(when (consp arg)
(let ((buf (dired-find-buffer-nocreate (car arg))))
(when buf (kill-buffer buf))))
(switch-to-buffer (dired-noselect arg switches)))
(defun diredp-dired-files-other-window (arg &optional switches)
"Same as `diredp-dired-files' except uses another window."
(interactive (diredp-dired-files-interactive-spec "in other window "))
(when (consp arg)
(let ((buf (dired-find-buffer-nocreate (car arg))))
(when buf (kill-buffer buf))))
(dired-other-window arg switches))
(defun diredp-dired-for-files (arg &optional switches)
"Like `dired', but prompts for the specific files to list.
You are prompted for names of files and directories to list, and then
you are prompted for the name of the Dired buffer that lists them.
Use `C-g' when you are done entering file names to list.
In all cases, when inputting a file or directory name you can use
shell wildcards.
If you use Icicles, then in Icicle mode the following keys are bound
in the minibuffer during completion (`*' means the key requires
library `Bookmark+'):
M-| - Open Dired on the file names matching your input
C-c + - Create a new directory
*C-x a + - Add tags to the current-candidate file
*C-x a - - Remove tags from the current-candidate file
*C-x m - Access file bookmarks (not just autofiles)"
(interactive
(let ((current-prefix-arg -1))
(diredp-dired-files-interactive-spec "in other window ")))
(diredp-dired-files-other-window arg switches))
(defun diredp-dired-for-files-other-window (arg &optional switches)
"Same as `diredp-dired-for-files' except uses another window."
(interactive
(let ((current-prefix-arg -1))
(diredp-dired-files-interactive-spec "in other window ")))
(diredp-dired-files-other-window arg switches))
(defun diredp-dired-files-interactive-spec (str)
"`interactive' spec for `diredp-dired-files' commands.
STR is a string appended to the prompt.
With non-negative prefix arg, read switches.
With non-positive prefix arg, read files and dirs to list and then the
Dired buffer name. User uses `C-g' when done reading files and dirs.
If you use Icicles, then in Icicle mode the following keys are bound
in the minibuffer during completion (`*' means the key requires
library `Bookmark+'):
M-| - Open Dired on the file names matching your input
C-c + - Create a new directory
*C-x a + - Add tags to the current-candidate file
*C-x a - - Remove tags from the current-candidate file
*C-x m - Access file bookmarks (not just autofiles)"
(list
(unwind-protect
(let ((icicle-sort-comparer (or icicle-file-sort
(and (> (prefix-numeric-value current-prefix-arg) 0)
'icicle-dirs-first-p)
icicle-sort-comparer))
(icicle-all-candidates-list-alt-action-fn
(lambda (files)
(let ((enable-recursive-minibuffers t))
(dired-other-window (cons (read-string "Dired buffer name: ") files))))))
(when (fboundp 'icicle-bind-file-candidate-keys) (icicle-bind-file-candidate-keys))
(if (> (prefix-numeric-value current-prefix-arg) 0)
(if (and (fboundp 'read-directory-name) (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))
(let ((insert-default-directory nil)
(files ())
file)
(while (condition-case nil
(setq file (read-file-name "File or dir (C-g when done): "))
(quit nil))
(push file files))
(cons (read-string "Dired buffer name: " nil nil default-directory) files))))
(when (fboundp 'icicle-unbind-file-candidate-keys)
(icicle-unbind-file-candidate-keys)))
(and current-prefix-arg (natnump (prefix-numeric-value current-prefix-arg))
(read-string "Dired listing switches: " dired-listing-switches))))
(defun diredp-dired-union (dirbufs &optional switches)
"Create a Dired buffer that is the union of some existing Dired buffers.
With a prefix arg, read `ls' switches.
You are prompted for the Dired buffers. Use `C-g' when done choosing
them. Then you are prompted for the name of the new Dired buffer.
Its `default-directory' is the same as the `default-directory' before
invoking the command.
The selected Dired listings are included in the order that you choose
them, and each entry is listed only once in the new Dired buffer. The
new Dired listing respects the markings, subdirectory insertions, and
hidden subdirectories of the selected Dired listings.
However, in case of conflict between marked or unmarked status for the
same entry, the entry is marked. Similarly, in case of conflict over
an included subdirectory between it being hidden or shown, it is
hidden, but its contained files are also listed."
(interactive (diredp-dired-union-interactive-spec ""))
(diredp-dired-union-1 dirbufs switches))
(defun diredp-dired-union-other-window (dirbufs &optional switches)
"Same as `diredp-dired-union' but uses another window."
(interactive (diredp-dired-union-interactive-spec ""))
(diredp-dired-union-1 dirbufs switches 'OTHER-WINDOW))
(defun diredp-dired-union-1 (dirbufs switches &optional other-window-p)
"Helper for `diredp-dired-union(-other-window)'."
(let ((files ())
(marked ())
(subdirs ())
(hidden-dirs ())
hid-here files-here)
(dolist (buf (reverse (cdr dirbufs)))
(with-current-buffer buf
(unwind-protect
(progn
(setq hid-here (save-excursion (dired-remember-hidden))
files-here (if (consp dired-directory)
(reverse (cdr dired-directory))
()))
(unless files-here
(save-excursion
(goto-char (point-min))
(while (not (eobp))
(or (looking-at dired-re-dot)
(push (dired-get-filename nil 'NO-ERROR-P) files-here))
(forward-line 1)))
(setq files-here (delq nil files-here)))
(dolist (hid-here hid-here) (push hid-here hidden-dirs))
(dolist (sub (cdr (reverse dired-subdir-alist)))
(push (list (car sub)) subdirs))
(dolist (mkd (dired-remember-marks (point-min) (point-max)))
(push (car mkd) marked))
(dolist (file files-here)
(when (or (not (file-name-absolute-p file)) (not (member file files)))
(push file files))))
(save-excursion
(dolist (dir hid-here) (when (dired-goto-subdir dir) (dired-hide-subdir 1)))))))
(if other-window-p
(dired-other-window (cons (car dirbufs) files) switches)
(dired (cons (car dirbufs) files) switches))
(with-current-buffer (car dirbufs)
(let ((inhibit-read-only t))
(dired-insert-old-subdirs subdirs)
(dired-mark-remembered
(mapcar (lambda (mf) (cons (expand-file-name mf dired-directory) 42)) marked))
(save-excursion
(dolist (dir hidden-dirs) (when (dired-goto-subdir dir) (dired-hide-subdir 1))))))))
(defun diredp-dired-union-interactive-spec (str)
"`interactive' spec for `diredp-dired-dired' commands.
STR is a string appended to the prompt.
With a prefix arg, read switches.
Read names of Dired buffers to include, and then the new, Dired-union
buffer name. User uses `C-g' when done reading Dired buffer names."
(list
(let ((bufs ())
dirbufs buf)
(dolist (dbuf dired-buffers)
(when (buffer-live-p (cdr dbuf))
(push (cons (buffer-name (cdr dbuf)) (car dbuf)) dirbufs)))
(while (and dirbufs (condition-case nil
(setq buf (completing-read
"Dired buffer to include (C-g when done): "
dirbufs nil t nil buffer-name-history
(and dirbufs (car (assoc (buffer-name) dirbufs)))))
(quit nil)))
(push buf bufs)
(setq dirbufs (delete (cons buf (with-current-buffer buf default-directory)) dirbufs)))
(setq bufs (nreverse bufs))
(cons (read-string "Dired-union buffer name: ") bufs))
(and current-prefix-arg (read-string "Dired listing switches: " dired-listing-switches))))
(defun diredp-fileset (flset-name)
"Open Dired on the files in fileset FLSET-NAME."
(interactive
(list (let ((fd (or (and (require 'filesets nil t) filesets-data)
(error "Feature `filesets' not provided"))))
(completing-read "Open Dired on fileset: " filesets-data))))
(let ((flset (filesets-get-fileset-from-name flset-name))
(files ())
(mode nil))
(unless (or (setq mode (filesets-entry-mode flset)) my-fs" (:files "a" "b"))
(setq flset (cons "dummy" flset) a" "b")
mode (filesets-entry-mode flset)))
(error "Bad fileset: %S" flset-name))
(message "Gathering file names...")
(dolist (file (filesets-get-filelist flset mode)) (push file files))
(dired (cons (generate-new-buffer-name flset-name)
(nreverse (mapcar (lambda (file)
(if (file-name-absolute-p file)
(expand-file-name file)
file))
files))))))
(defun diredp-dired-this-subdir (&optional tear-off-p msgp)
"Open Dired for the subdir at or above point.
If point is not on a subdir line, but is in an inserted subdir
listing, then use that subdir.
With a prefix arg:
If the subdir is inserted and point is in the inserted listing then
remove that listing and move to the ordinary subdir line. In other
words, when in an inserted listing, a prefix arg tears off the
inserted subdir to its own Dired buffer."
(interactive "P\np")
(diredp-ensure-mode)
(let* ((this-dir default-directory)
(this-subdir (diredp-this-subdir))
(on-dir-line-p (atom this-subdir)))
(unless on-dir-line-p
(setq this-subdir (car this-subdir)))
(unless (string= this-subdir this-dir)
(when tear-off-p
(unless on-dir-line-p
(dired-kill-subdir)
(dired-goto-file this-subdir)))
(dired-other-window this-subdir))))
(defun diredp-dired-inserted-subdirs (&optional no-show-p msgp)
"Open Dired for each of the subdirs inserted in this Dired buffer.
With a prefix arg, create the Dired buffers but do not display them.
Markings and current Dired switches are preserved."
(interactive "P\np")
(diredp-ensure-mode)
(let ((this-dir default-directory)
(this-buff (current-buffer))
(this-frame (selected-frame))
marked)
(unwind-protect
(save-selected-window
(dolist (entry dired-subdir-alist)
(unless (string= (car entry) this-dir)
(setq marked
(with-current-buffer this-buff
(dired-remember-marks (dired-get-subdir-min entry)
(dired-get-subdir-max entry))))
(if (not no-show-p)
(dired-other-window (car entry) dired-actual-switches)
(dired-noselect (car entry) dired-actual-switches)
(when msgp (message "Dired buffers created but not shown")))
(set-buffer this-buff)
(let ((inhibit-read-only t))
(dired-mark-remembered marked))
(set-buffer-modified-p nil))))
(select-frame-set-input-focus this-frame))))
(defun diredp-get-files (&optional ignore-marks-p predicate include-dirs-p dont-askp)
"Return file names from this Dired buffer and subdirectories, recursively.
The name are those that are marked in the current Dired buffer, or all
files in the directory if none are marked. Marked subdirectories are
handled recursively in the same way.
If there is some included subdirectory that has a Dired buffer with
marked files, then (unless DONT-ASKP is non-nil) ask the user whether
to use the marked files in Dired buffers, as opposed to using all of
the files in included directories. To this y-or-n question the user
can hit `l' to see the list of files that will be included (using
`diredp-list-files').
\(Directories in `icicle-ignored-directories' are skipped, if you use
Icicles. Otherwise, directories in `vc-directory-exclusion-list' are
skipped.)
Non-nil IGNORE-MARKS-P means ignore all Dired markings:
just get all of the files in the current directory.
Non-nil PREDICATE means include only file names for which the
PREDICATE returns non-nil.
Non-nil INCLUDE-DIRS-P means include marked subdirectory names (but
also handle those subdirs recursively, picking up their marked files
and subdirs).
Non-nil DONT-ASKP means do not ask the user whether to use marked
instead of all. Act as if the user was asked and replied `y'."
(let ((askp (list nil)))
(if ignore-marks-p
(diredp-files-within (directory-files default-directory 'FULL diredp-re-no-dot)
() nil nil predicate)
(let ((files (list 'DUMMY)))
(diredp-get-files-for-dir default-directory files askp include-dirs-p)
(setq files (cdr files))
(if (or dont-askp
(not (car askp))
(diredp-y-or-n-files-p "Use marked (instead of all) in subdir Dired buffers? "
files
predicate))
(if predicate (diredp-remove-if-not predicate files) files)
(setq files ())
(dolist (file (diredp-marked-here))
(if (not (file-directory-p file))
(when (or (not predicate) (funcall predicate file))
(add-to-list 'files file))
(when include-dirs-p (setq files (nconc files (list file))))
(setq files (nconc files (diredp-files-within
(directory-files file 'FULL diredp-re-no-dot)
() nil include-dirs-p predicate)))))
(nreverse files))))))
(defun diredp-get-files-for-dir (dir accum askp &optional include-dirs-p)
"Return file names for directory DIR and subdirectories, recursively.
Pick up names of all marked files in DIR if it has a Dired buffer, or
all files in DIR if not. Handle subdirs recursively (only marked
subdirs, if Dired).
ACCUM is an accumulator list: the files picked up in this call are
nconc'd to it.
ASKP is a one-element list, the element indicating whether to ask the
user about respecting Dired markings. It is set here to `t' if there
is a Dired buffer for DIR.
Non-nil optional arg INCLUDE-DIRS-P means include marked subdirectory
names (but also handle those subdirs recursively).
If there is more than one Dired buffer for DIR then raise an error."
(dolist (file (if (not (dired-buffers-for-dir (expand-file-name dir)))
(directory-files dir 'FULL diredp-re-no-dot)
(when (cadr (dired-buffers-for-dir (expand-file-name dir)))
(error "More than one Dired buffer for `%s'" dir))
(unless (equal dir default-directory) (setcar askp t))
(with-current-buffer (car (dired-buffers-for-dir (expand-file-name dir)))
(diredp-marked-here))))
(if (not (file-directory-p file))
(setcdr (last accum) (list file))
(when include-dirs-p (setcdr (last accum) (list file)))
(diredp-get-files-for-dir file accum askp include-dirs-p))))
(defun diredp-marked-here ()
"Marked files and subdirs in this Dired buffer, or all if none are marked.
Directories `.' and `..' are excluded."
(let ((ff (condition-case nil
(dired-get-marked-files nil nil nil 'DISTINGUISH-ONE-MARKED)
(error nil))))
(cond ((eq t (car ff)) (cdr ff))
((cadr ff) ff)
(t (directory-files
default-directory 'FULL diredp-re-no-dot 'NOSORT)))))
(defun diredp-y-or-n-files-p (prompt files &optional predicate)
"PROMPT user with a \"y or n\" question about a list of FILES.
Return t if answer is \"y\". Otherwise, return nil.
Like `y-or-n-p', but the user can also hit `l' to display the list of
files that the confirmation is for, in buffer `*Files'. When
finished, buffer `*Files*' is killed if it was never shown, or is
hidden and buried otherwise. Thus, if it was shown then it is still
available to revisit afterward (even if the user quit using `C-g').
PREDICATE is passed to `diredp-list-files', to list only file names
for which it returns non-nil."
(let ((answer 'recenter))
(cond (noninteractive
(setq prompt (concat prompt
(and (not (eq ?\ (aref prompt (1- (length prompt))))) " ")
"(y or ny" "Y")) (setq answer 'act))
((member str '("n" "N")) (setq answer 'skip))
(t (setq temp-prompt (concat "Please answer y or n. " prompt))))))))
((if (not (fboundp 'display-popup-menus-p))
(and window-system (listp last-nonmenu-event) use-dialog-box)
(and (display-popup-menus-p) (listp last-nonmenu-event) use-dialog-box))
(setq answer (x-popup-dialog t `(,prompt ("Yes" . act) ("No" . skip)))))
(t
(let ((list-buf (generate-new-buffer-name "*Files*"))
(list-was-shown nil))
(unwind-protect
(progn
(define-key query-replace-map "l" 'show)
(setq prompt (concat prompt
(and (eq ?\ (aref prompt (1- (length prompt))))
"" " ")
"(y or nPlease answer y or n. "
prompt))
'face 'minibuffer-prompt))
(read-char-exclusive
(if (memq answer '(recenter show))
prompt
(concat "Please answer y or n. " prompt)))))))
(setq answer (lookup-key query-replace-map (vector key) t))
(case answer
((skip act) nil)
(recenter (recenter) t)
(show (diredp-list-files files nil list-buf predicate)
(setq list-was-shown t))
(help (message "Use `l' to show file list") (sit-for 1))
((exit-prefix quit) (signal 'quit nil) t)
(t t)))
(ding)
(discard-input)))
(save-window-excursion (pop-to-buffer list-buf)
(condition-case nil
(if (one-window-p) (delete-frame) (delete-window))
(error nil))
(if list-was-shown
(bury-buffer list-buf)
(kill-buffer list-buf)))
(define-key query-replace-map "l" nil)))))
(let ((ret (eq answer 'act)))
(unless noninteractive (message "%s %s" prompt (if ret "y" "n")))
ret)))
(defun diredp-list-files (files &optional dir bufname predicate)
"Display FILES, a list of file names. Wildcard patterns are expanded.
The files are shown in a new buffer, `*Files*' by default.
Optional arg DIR serves as the default directory for expanding file
names that are not absolute. It defaults to `default-directory'.
Optional arg BUFNAME is the name of the buffer for the display.
It defaults to `*Files*' (or `*Files*<N>' if `*Files*' exists)."
(with-output-to-temp-buffer (or bufname (generate-new-buffer-name "*Files*"))
(princ "Files\n-----\n\n")
(let ((all-files-no-wildcards ())
file-alist file-dir)
(dolist (file files)
(unless (or (string= file "")
(and predicate (not (funcall predicate file))))
(if (not (string-match "[[?*]" file))
(add-to-list 'all-files-no-wildcards (expand-file-name file))
(setq file-dir (or (file-name-directory file) default-directory)
file-alist (directory-files-and-attributes file-dir 'FULL "[[?*]" 'NOSORT))
(dolist (ff file-alist)
(add-to-list 'all-files-no-wildcards (expand-file-name (car ff) file-dir))))))
(dolist (fff (nreverse all-files-no-wildcards))
(princ fff)
(terpri)))))
(defvar diredp-files-within-dirs-done ()
"Directories already processed by `diredp-files-within'.")
(defun diredp-directories-within (&optional directory no-symlinks-p predicate)
"List of accessible directories within DIRECTORY.
Directories in `icicle-ignored-directories' are skipped, if you use
Icicles. Otherwise, directories in `vc-directory-exclusion-list' are
skipped.
Optional arg DIRECTORY defaults to the value of `default-directory'.
Non-nil optional arg NO-SYMLINKS-P means do not follow symbolic links.
Non-nil optional arg PREDICATE must be a function that accepts a
file-name argument. Only directories that satisfy PREDICATE are
included in the result."
(unless directory (setq directory default-directory))
(let ((dirs (diredp-files-within (directory-files directory 'FULL diredp-re-no-dot)
() no-symlinks-p 'INCLUDE-DIRS-P
#'file-directory-p)))
(if predicate (diredp-remove-if-not predicate dirs) dirs)))
(defun diredp-files-within (file-list accum &optional no-symlinks-p include-dirs-p predicate)
"List of readable files in FILE-LIST, handling directories recursively.
FILE-LIST is a list of file names or a function that returns such.
If a function then invoke it with no args to get the list of files.
Accessible directories in the list of files are processed recursively
to include their files and the files in their subdirectories. The
directories themselves are not included, unless optional arg
INCLUDE-DIRS-P is non-nil. (Directories in
`icicle-ignored-directories' are skipped, if you use Icicles.
Otherwise, directories in `vc-directory-exclusion-list' are skipped.)
But if there is a Dired buffer for such a directory, and if FILE-LIST
is a function, then it is invoked in that Dired buffer to return the
list of files to use. E.g., if FILE-LIST is `dired-get-marked-files'
then only the marked files and subdirectories are included. If you
have more than one Dired buffer for a directory that is processed
here, then only the first one in `dired-buffers' is used.
The list of files is accumulated in ACCUM, which is used for recursive
calls.
Non-nil optional arg NO-SYMLINKS-P means do not follow symbolic links.
Non-nil optional arg INCLUDE-DIRS-P means include directory names
along with the names of non-directories.
Non-nil optional arg PREDICATE must be a function that accepts a
file-name argument. Only files (and possibly directories) that
satisfy PREDICATE are included in the result."
(let ((diredp-files-within-dirs-done ()))
(nreverse (diredp-files-within-1 file-list accum no-symlinks-p include-dirs-p predicate))))
(defun diredp-files-within-1 (file-list accum no-symlinks-p include-dirs-p predicate)
"Helper for `diredp-files-within'."
(let ((files (if (functionp file-list) (funcall file-list) file-list))
(res accum)
file)
(when (and files predicate) (setq files (diredp-remove-if-not predicate files)))
(while files
(setq file (car files))
(unless (and no-symlinks-p (file-symlink-p file))
(if (file-directory-p file)
(when (and (not (member (file-name-nondirectory file)
(if (boundp 'icicle-ignored-directories)
icicle-ignored-directories
(and (boundp 'vc-directory-exclusion-list)
vc-directory-exclusion-list))))
(not (member (file-truename file) diredp-files-within-dirs-done))
(file-accessible-directory-p file))
(setq res (diredp-files-within-1
(or (and (functionp file-list)
(dired-buffers-for-dir
(expand-file-name file))
(with-current-buffer
(cdr (assoc (file-name-as-directory file) dired-buffers))
(funcall file-list)))
(directory-files file 'FULL diredp-re-no-dot))
res
no-symlinks-p
include-dirs-p
predicate))
(when include-dirs-p (push file res))
(push (file-truename file) diredp-files-within-dirs-done))
(when (file-readable-p file) (push file res))))
(pop files))
res))
(defun diredp-remove-if-not (pred xs)
"A copy of list XS with only elements that satisfy predicate PRED."
(let ((result ()))
(dolist (x xs) (when (funcall pred x) (push x result)))
(nreverse result)))
(when (> emacs-major-version 21)
(defun diredp-insert-as-subdir (child ancestor &optional in-dired-now-p)
"Insert the current Dired dir into a Dired listing of an ancestor dir.
Ancestor means parent, grandparent, etc. at any level.
You are prompted for the ancestor directory.
The ancestor Dired buffer is selected.
Markings and switches in the current Dired buffer are preserved for
the subdir listing in the ancestor Dired buffer.
Note: If you use Icicles, then you can use
`icicle-dired-insert-as-subdir' instead: it is a multi-command. It
does the same thing, but it lets you insert any number of descendent
directories into a given ancestor-directory Dired buffer.
Non-interactively:
Insert CHILD dir into Dired listing for ANCESTOR dir.
Non-nil optional arg IN-DIRED-NOW-P means to use the current buffer
as the Dired buffer from which to pick up markings and switches.
Otherwise, pick them up from a Dired buffer for CHILD, if there is
exactly one such buffer."
(interactive (progn (diredp-ensure-mode)
(list default-directory
(completing-read
"Insert this dir into ancestor dir: "
(mapcar #'list (diredp-ancestor-dirs default-directory)))
t)))
(let ((child-dired-buf (if in-dired-now-p
(current-buffer)
(dired-buffers-for-dir (expand-file-name child))))
(switches ())
(marked ()))
(when (consp child-dired-buf)
(setq child-dired-buf (and (= 1 (length child-dired-buf)) (car child-dired-buf))))
(when child-dired-buf
(with-current-buffer child-dired-buf
(setq switches dired-actual-switches
marked (dired-remember-marks (point-min) (point-max)))))
(dired-other-window ancestor)
(dired-insert-subdir child switches)
(when marked (let ((inhibit-read-only t)) (dired-mark-remembered marked)))
(set-buffer-modified-p nil))))
(defun diredp-ancestor-dirs (dir)
"Return a list of the ancestor directories of directory DIR."
(mapcar #'file-name-as-directory
(diredp-maplist (lambda (dd) (mapconcat #'identity (reverse dd) "/"))
(cdr (nreverse (split-string dir "/" t))))))
(defun diredp-maplist (function list)
"Map FUNCTION over LIST and its cdrs.
A simple, recursive version of the classic `maplist'."
(and list (cons (funcall function list) (maplist function (cdr list)))))
(defun diredp-get-confirmation-recursive ()
"Get confirmation from user to act on all files here and below.
Raise an error if not confirmed.
Raise an error first if not in Dired mode."
(diredp-ensure-mode)
(unless (y-or-n-p "Act on ALL files (or all marked if any) in and UNDER this dir? ")
(error "OK, canceled")))
(defun diredp-insert-subdirs (&optional switches)
"Insert the marked subdirectories.
Like using \\<dired-mode-map>`\\[dired-maybe-insert-subdir]' at each marked directory line."
(interactive (list (and current-prefix-arg
(read-string "Switches for listing: "
(or (and (boundp 'dired-subdir-switches)
dired-subdir-switches)
dired-actual-switches)))))
(dolist (subdir (dired-get-marked-files nil nil #'file-directory-p))
(dired-maybe-insert-subdir subdir switches)))
(defun diredp-insert-subdirs-recursive (&optional ignore-marks-p)
"Insert the marked subdirs, including those in marked subdirs.
Like `diredp-insert-subdirs', but act recursively on subdirs.
The subdirs inserted are those that are marked in the current Dired
buffer, or all subdirs in the directory if none are marked. Marked
subdirectories are handled recursively in the same way (their marked
subdirs are inserted...).
With a prefix argument, ignore all marks - include all files in this
Dired buffer and all subdirs, recursively."
(interactive (progn (diredp-get-confirmation-recursive) (list current-prefix-arg)))
(dolist (subdir (diredp-get-files ignore-marks-p #'file-directory-p 'INCLUDE-SUBDIRS-P))
(dired-maybe-insert-subdir subdir)))
(defun diredp-do-shell-command-recursive (command &optional ignore-marks-p)
"Run shell COMMAND on the marked files, including those in marked subdirs.
Like `dired-do-shell-command', but act recursively on subdirs.
The files included are those that are marked in the current Dired
buffer, or all files in the directory if none are marked. Marked
subdirectories are handled recursively in the same way.
With a prefix argument, ignore all marks - include all files in this
Dired buffer and all subdirs, recursively."
(interactive
(progn (diredp-get-confirmation-recursive)
(let* ((prompt "! on *: ")
(cmd (minibuffer-with-setup-hook
(lambda ()
(set (make-local-variable 'minibuffer-default-add-function)
'minibuffer-default-add-dired-shell-commands))
(let ((dired-no-confirm t))
(if (functionp 'dired-guess-shell-command)
(dired-guess-shell-command prompt (dired-get-marked-files t))
(read-shell-command prompt nil nil))))))
(list cmd current-prefix-arg))))
(dired-do-shell-command command nil (diredp-get-files ignore-marks-p)))
(defun diredp-do-symlink-recursive (&optional ignore-marks-p)
"Make symbolic links to marked files, including those in marked subdirs.
Like `dired-do-symlink', but act recursively on subdirs to pick up the
files to link.
The files included are those that are marked in the current Dired
buffer, or all files in the directory if none are marked. Marked
subdirectories are handled recursively in the same way.
With a prefix argument, ignore all marks - include all files in this
Dired buffer and all subdirs, recursively."
(interactive (progn (diredp-get-confirmation-recursive) (list current-prefix-arg)))
(diredp-do-create-files-recursive #'make-symbolic-link "Symlink" ignore-marks-p))
(when (fboundp 'dired-do-relsymlink)
(defun diredp-do-relsymlink-recursive (&optional ignore-marks-p)
"Relative symlink all marked files, including those in marked subdirs into a dir.
Like `dired-do-relsymlink', but act recursively on subdirs to pick up the
files to link.
The files included are those that are marked in the current Dired
buffer, or all files in the directory if none are marked. Marked
subdirectories are handled recursively in the same way.
With a prefix argument, ignore all marks - include all files in this
Dired buffer and all subdirs, recursively.
For absolute symlinks, use \\[diredp-do-symlink-recursive]."
(interactive (progn (diredp-get-confirmation-recursive) (list current-prefix-arg)))
(diredp-do-create-files-recursive #'dired-make-relative-symlink "RelSymLink"
ignore-marks-p)))
(defun diredp-do-hardlink-recursive (&optional ignore-marks-p)
"Add hard links for marked files, including those in marked subdirs.
Like `dired-do-hardlink', but act recursively on subdirs to pick up the
files to link.
The files included are those that are marked in the current Dired
buffer, or all files in the directory if none are marked. Marked
subdirectories are handled recursively in the same way.
With a prefix argument, ignore all marks - include all files in this
Dired buffer and all subdirs, recursively."
(interactive (progn (diredp-get-confirmation-recursive) (list current-prefix-arg)))
(diredp-do-create-files-recursive #'dired-hardlink "Hardlink" ignore-marks-p))
(defun diredp-do-print-recursive (&optional ignore-marks-p)
"Print the marked files, including those in marked subdirs.
Like `dired-do-print', but act recursively on subdirs to pick up the
files to print.
The files included are those that are marked in the current Dired
buffer, or all files in the directory if none are marked. Marked
subdirectories are handled recursively in the same way.
With a prefix argument, ignore all marks - include all files in this
Dired buffer and all subdirs, recursively."
(interactive (progn (diredp-get-confirmation-recursive) (list current-prefix-arg)))
(let* ((file-list (diredp-get-files ignore-marks-p))
(command (dired-mark-read-string
"Print %s with: "
(mapconcat #'identity (cons lpr-command (if (stringp lpr-switches)
(list lpr-switches)
lpr-switches))
" ")
'print nil file-list)))
(dired-run-shell-command (dired-shell-stuff-it command file-list nil))))
(defun diredp-image-dired-display-thumbs-recursive (&optional ignore-marks-p append do-not-pop)
"Display thumbnails of marked files, including those in marked subdirs.
Like `image-dired-display-thumbs', but act recursively on subdirs.
Optional arguments APPEND and DO-NOT-POP are as for
`image-dired-display-thumbs'.
The files included are those that are marked in the current Dired
buffer, or all files in the directory if none are marked. Marked
subdirectories are handled recursively in the same way.
With a prefix argument, ignore all marks - include all files in this
Dired buffer and all subdirs, recursively."
(interactive (progn (unless (require 'image-dired nil t)
(error "This command requires library `image-dired.el' (Emacs 22+)"))
(diredp-get-confirmation-recursive)
(list current-prefix-arg)))
(let ((buf (image-dired-create-thumbnail-buffer))
thumb-name files dired-buf)
(setq files (diredp-get-files ignore-marks-p)
dired-buf (current-buffer))
(with-current-buffer buf
(let ((inhibit-read-only t))
(if append (goto-char (point-max)) (erase-buffer))
(mapc (lambda (curr-file)
(setq thumb-name (image-dired-thumb-name curr-file))
(if (and (not (file-exists-p thumb-name))
(not (= 0 (image-dired-create-thumb curr-file thumb-name))))
(message "Thumb could not be created for file %s" curr-file)
(image-dired-insert-thumbnail thumb-name curr-file dired-buf)))
files))
(case image-dired-line-up-method
(dynamic (image-dired-line-up-dynamic))
(fixed (image-dired-line-up))
(interactive (image-dired-line-up-interactive))
(none nil)
(t (image-dired-line-up-dynamic))))
(if do-not-pop
(display-buffer image-dired-thumbnail-buffer)
(pop-to-buffer image-dired-thumbnail-buffer))))
(defun diredp-image-dired-tag-files-recursive (&optional ignore-marks-p)
"Tag marked file(s) in dired, including those in marked subdirs
Like `image-dired-tag-files', but act recursively on subdirs.
The files included are those that are marked in the current Dired
buffer, or all files in the directory if none are marked. Marked
subdirectories are handled recursively in the same way.
With a prefix argument, ignore all marks - include all files in this
Dired buffer and all subdirs, recursively."
(interactive (progn (unless (require 'image-dired nil t)
(error "This command requires library `image-dired.el' (Emacs 22+)"))
(diredp-get-confirmation-recursive)
(list current-prefix-arg)))
(let ((tag (read-string "Tags to add (separate tags with a semicolon): ")))
(image-dired-write-tags (mapcar (lambda (x) (cons x tag))
(diredp-get-files ignore-marks-p)))))
(defun diredp-image-dired-delete-tag-recursive (&optional ignore-marks-p)
"Remove tag for selected file(s), including those in marked subdirs.
Like `image-dired-delete-tag', but act recursively on subdirs.
The files included are those that are marked in the current Dired
buffer, or all files in the directory if none are marked. Marked
subdirectories are handled recursively in the same way.
With a prefix argument, ignore all marks - include all files in this
Dired buffer and all subdirs, recursively."
(interactive (progn (unless (require 'image-dired nil t)
(error "This command requires library `image-dired.el' (Emacs 22+)"))
(diredp-get-confirmation-recursive)
(list current-prefix-arg)))
(image-dired-remove-tag (diredp-get-files ignore-marks-p) (read-string "Tag to remove: ")))
(defun diredp-image-dired-comment-files-recursive (&optional ignore-marks-p)
"Add comment to marked files in dired, including those in marked subdirs.
Like `image-dired-dired-comment-files' but act recursively on subdirs.
The files included are those that are marked in the current Dired
buffer, or all files in the directory if none are marked. Marked
subdirectories are handled recursively in the same way.
With a prefix argument, ignore all marks - include all files in this
Dired buffer and all subdirs, recursively."
(interactive (progn (unless (require 'image-dired nil t)
(error "This command requires library `image-dired.el' (Emacs 22+)"))
(diredp-get-confirmation-recursive)
(list current-prefix-arg)))
(let ((comment (image-dired-read-comment)))
(image-dired-write-comments (mapcar (lambda (curr-file) (cons curr-file comment))
(diredp-get-files ignore-marks-p)))))
(when (> emacs-major-version 22)
(defun diredp-do-decrypt-recursive (&optional ignore-marks-p)
"Decrypt marked files, including those in marked subdirs.
Like `epa-dired-do-decrypt', but act recursively on subdirs to pick up
the files to decrypt.
The files included are those that are marked in the current Dired
buffer, or all files in the directory if none are marked. Marked
subdirectories are handled recursively in the same way.
With a prefix argument, ignore all marks - include all files in this
Dired buffer and all subdirs, recursively."
(interactive (progn (diredp-get-confirmation-recursive) (list current-prefix-arg)))
(dolist (file (diredp-get-files ignore-marks-p))
(epa-decrypt-file (expand-file-name file)))
(revert-buffer))
(defun diredp-do-verify-recursive (&optional ignore-marks-p)
"Verify marked files, including those in marked subdirs.
Like `epa-dired-do-verify', but act recursively on subdirs to pick up
the files to verify.
The files included are those that are marked in the current Dired
buffer, or all files in the directory if none are marked. Marked
subdirectories are handled recursively in the same way.
With a prefix argument, ignore all marks - include all files in this
Dired buffer and all subdirs, recursively."
(interactive (progn (diredp-get-confirmation-recursive) (list current-prefix-arg)))
(dolist (file (diredp-get-files ignore-marks-p))
(epa-verify-file (expand-file-name file)))
(revert-buffer))
(defun diredp-do-sign-recursive (&optional ignore-marks-p)
"Sign marked files, including those in marked subdirs.
Like `epa-dired-do-sign', but act recursively on subdirs to pick up
the files to sign.
The files included are those that are marked in the current Dired
buffer, or all files in the directory if none are marked. Marked
subdirectories are handled recursively in the same way.
With a prefix argument, ignore all marks - include all files in this
Dired buffer and all subdirs, recursively."
(interactive (progn (diredp-get-confirmation-recursive) (list current-prefix-arg)))
(dolist (file (diredp-get-files ignore-marks-p))
(epa-sign-file (expand-file-name file)
(epa-select-keys (epg-make-context) "Select keys for signing.
If none are selected, the default secret key is used. ")
(y-or-n-p "Make a detached signature? ")))
(revert-buffer))
(defun diredp-do-encrypt-recursive (&optional ignore-marks-p)
"Encrypt marked files, including those in marked subdirs.
Like `epa-dired-do-encrypt', but act recursively on subdirs to pick up
the files to encrypt.
The files included are those that are marked in the current Dired
buffer, or all files in the directory if none are marked. Marked
subdirectories are handled recursively in the same way.
With a prefix argument, ignore all marks - include all files in this
Dired buffer and all subdirs, recursively."
(interactive (progn (diredp-get-confirmation-recursive) (list current-prefix-arg)))
(dolist (file (diredp-get-files ignore-marks-p))
(epa-encrypt-file (expand-file-name file)
(epa-select-keys (epg-make-context) "Select recipients for encryption.
If none are selected, symmetric encryption is performed. ")))
(revert-buffer)))
(defun diredp-do-bookmark-recursive (&optional ignore-marks-p prefix)
"Bookmark the marked files, including those in marked subdirs.
Like `diredp-do-bookmark', but act recursively on subdirs.
The files included are those that are marked in the current Dired
buffer, or all files in the directory if none are marked. Marked
subdirectories are handled recursively in the same way.
With a prefix argument, ignore all marks - include all files in this
Dired buffer and all subdirs, recursively."
(interactive (progn (diredp-get-confirmation-recursive)
(list current-prefix-arg
(and diredp-prompt-for-bookmark-prefix-flag
(read-string "Prefix for bookmark name: ")))))
(dolist (file (diredp-get-files ignore-marks-p))
(diredp-bookmark prefix file 'NO-MSG-P)))
(defun diredp-do-bookmark-in-bookmark-file-recursive (bookmark-file
&optional prefix ignore-marks-p
bfile-bookmarkp)
"Bookmark files here and below in BOOKMARK-FILE and save BOOKMARK-FILE.
Like `diredp-do-bookmark-in-bookmark-file', but act recursively on
subdirs. The files included are those that are marked in the current
Dired buffer, or all files in the directory if none are marked.
Marked subdirectories are handled recursively in the same way.
With a prefix argument, ignore all marks - include all files in this
Dired buffer and all subdirs, recursively."
(interactive
(progn (diredp-get-confirmation-recursive)
(let ((d-r-b-f-args (diredp-read-bookmark-file-args)))
(list (car d-r-b-f-args) (cadr d-r-b-f-args) (car (cddr d-r-b-f-args))))))
(diredp-do-bookmark-in-bookmark-file bookmark-file prefix nil bfile-bookmarkp
(diredp-get-files ignore-marks-p)))
(defun diredp-set-bookmark-file-bookmark-for-marked-recursive (bookmark-file
&optional prefix arg)
"Bookmark the marked files and create a bookmark-file bookmark for them.
Like `diredp-set-bookmark-file-bookmark-for-marked', but act
recursively on subdirs.
The files included are those that are marked in the current Dired
buffer, or all files in the directory if none are marked. Marked
subdirectories are handled recursively in the same way.
With a prefix argument, ignore all marks - include all files in this
Dired buffer and all subdirs, recursively."
(interactive (progn (diredp-get-confirmation-recursive)
(diredp-read-bookmark-file-args)))
(unless (require 'bookmark+ nil t) (error "This command requires library `bookmark+.el'"))
(diredp-do-bookmark-in-bookmark-file-recursive bookmark-file prefix arg
'CREATE-BOOKMARK-FILE-BOOKMARK))
(defun diredp-do-find-marked-files-recursive (&optional ignore-marks-p)
"Find marked files simultaneously, including those in marked subdirs.
Like `dired-do-find-marked-files', but act recursively on subdirs.
The files included are those that are marked in the current Dired
buffer, or all files in the directory if none are marked. Marked
subdirectories are handled recursively in the same way.
With a prefix argument, ignore all marks - include all files in this
Dired buffer and all subdirs, recursively."
(interactive (progn (diredp-get-confirmation-recursive) (list current-prefix-arg)))
(dired-simultaneous-find-file (diredp-get-files ignore-marks-p) nil))
(when (fboundp 'dired-do-isearch-regexp)
(defun diredp-do-isearch-recursive (&optional ignore-marks-p)
"Isearch the marked files, including those in marked subdirs."
(interactive (progn (diredp-get-confirmation-recursive) (list current-prefix-arg)))
(multi-isearch-files (diredp-get-files ignore-marks-p)))
(defun diredp-do-isearch-regexp-recursive (&optional ignore-marks-p)
"Regexp-Isearch the marked files, including those in marked subdirs."
(interactive (progn (diredp-get-confirmation-recursive) (list current-prefix-arg)))
(multi-isearch-files-regexp (diredp-get-files ignore-marks-p))))
(defun diredp-do-search-recursive (regexp &optional ignore-marks-p)
"Regexp-search the marked files, including those in marked subdirs.
Stops when a match is found.
To continue searching for the next match, use `\\[tags-loop-continue]'."
(interactive (progn (diredp-get-confirmation-recursive)
(list (read-string "Search marked files (regexp): ")
current-prefix-arg)))
(tags-search regexp '(diredp-get-files ignore-marks-p)))
(defun diredp-do-query-replace-regexp-recursive (from to &optional ignore-marks-p)
"Do `query-replace-regexp' of FROM with TO, on all marked files.
If you exit (\\[keyboard-quit], RET or q), you can resume the query replace
with the command \\[tags-loop-continue]."
(interactive
(let ((common (query-replace-read-args "Query replace regexp in marked files" t t)))
(list (nth 0 common) (nth 1 common) (nth 2 common))))
(dolist (file (dired-get-marked-files nil nil 'dired-nondirectory-p))
(let ((buffer (get-file-buffer file)))
(when (and buffer (with-current-buffer buffer buffer-read-only))
(error "File `%s' is visited read-only" file))))
(tags-query-replace from to nil '(diredp-get-files ignore-marks-p)))
(defun diredp-do-grep-recursive (command-args &optional ignore-marks-p)
"Run `grep' on marked files, including those in marked subdirs.
Like `diredp-do-grep', but act recursively on subdirs.
The files included are those that are marked in the current Dired
buffer, or all files in the directory if none are marked. Marked
subdirectories are handled recursively in the same way.
With a prefix argument, ignore all marks - include all files in this
Dired buffer and all subdirs, recursively."
(interactive (progn (diredp-get-confirmation-recursive)
(unless (if (< emacs-major-version 22)
grep-command
(and grep-command (or (not grep-use-null-device)
(eq grep-use-null-device t))))
(grep-compute-defaults))
(list (diredp-do-grep-1 (diredp-get-files current-prefix-arg))
current-prefix-arg)))
(grep command-args))
(defun diredp-marked-recursive (dirname &optional ignore-marked-p)
"Open Dired on marked files, including those in marked subdirs.
Like `diredp-marked', but act recursively on subdirs.
See `diredp-do-find-marked-files-recursive' for a description of the
files included. In particular, if no files are marked here or in a
marked subdir, then all files in the directory are included."
(interactive (progn (diredp-get-confirmation-recursive)
(list (cons (generate-new-buffer-name (buffer-name))
(diredp-get-files current-prefix-arg)))))
(dired dirname))
(defun diredp-marked-recursive-other-window (dirname &optional ignore-marked-p)
"Same as `diredp-marked-recursive', but uses a different window."
(interactive (progn (diredp-get-confirmation-recursive)
(list (cons (generate-new-buffer-name (buffer-name))
(diredp-get-files current-prefix-arg)))))
(dired-other-window dirname))
(defun diredp-list-marked-recursive (&optional ignore-marks-p predicate)
"List the files marked here and in marked subdirs, recursively.
See `diredp-do-find-marked-files-recursive' for a description of the
files included. In particular, if no files are marked here or in a
marked subdir, then all files in the directory are included.
Non-interactively, non-nil PREDICATE is a file-name predicate. List
only the files for which it returns non-nil."
(interactive
(progn (diredp-ensure-mode) (list current-prefix-arg)))
(let ((files (diredp-get-files ignore-marks-p predicate)))
(diredp-list-files files)))
(when (and (memq system-type '(windows-nt ms-dos)) (fboundp 'w32-browser))
(defun diredp-multiple-w32-browser-recursive (&optional ignore-marked-p)
"Run Windows apps for with marked files, including those in marked subdirs.
Like `dired-multiple-w32-browser', but act recursively on subdirs.
See `diredp-do-find-marked-files-recursive' for a description of the
files included. In particular, if no files are marked here or in a
marked subdir, then all files in the directory are included."
(interactive (progn (diredp-get-confirmation-recursive)
(list current-prefix-arg)))
(let ((files (diredp-get-files ignore-marked-p)))
(while files
(w32-browser (car files))
(sleep-for w32-browser-wait-time)
(setq files (cdr files))))))
(defun diredp-copy-filename-as-kill-recursive (&optional arg)
"Copy names of marked files here and in marked subdirs, to `kill-ring'.
The names are separated by a space.
Like `dired-copy-filename-as-kill', but act recursively on subdirs.
\(Do not copy subdir names themselves.)
With no prefix arg, use relative file names.
With a zero prefix arg, use absolute file names.
With a plain prefix arg (`C-u'), use names relative to the current
Dired directory. (This might contain slashes if in a subdirectory.)
If on a subdir headerline, use absolute subdir name instead - prefix
arg and marked files are ignored in this case.
The files included are those that are marked in the current Dired
buffer, or all files in the directory if none are marked. Marked
subdirectories are handled recursively in the same way."
(interactive
(progn (diredp-ensure-mode) (list current-prefix-arg)))
(let* ((files (mapcar (cond ((zerop (prefix-numeric-value arg)) #'identity)
((consp arg) (lambda (fn) (concat (dired-current-directory t)
(file-name-nondirectory fn))))
(t (lambda (fn) (file-name-nondirectory fn))))
(diredp-get-files)))
(string (mapconcat #'identity files " ")))
(if (eq last-command 'kill-region) (kill-append string nil) (kill-new string))
(message "%s" string)))
(defun diredp-capitalize-recursive (&optional ignore-marks-p)
"Rename marked files, including in marked subdirs, by capitalizing them.
Like `diredp-capitalize', but act recursively on subdirs.
The files included are those that are marked in the current Dired
buffer, or all files in the directory if none are marked. Marked
subdirectories are handled recursively in the same way.
With a prefix argument, ignore all marks - include all files in this
Dired buffer and all subdirs, recursively."
(interactive (progn (diredp-get-confirmation-recursive) (list current-prefix-arg)))
(diredp-create-files-non-directory-recursive
#'dired-rename-file #'capitalize "Rename by capitalizing:" ignore-marks-p))
(defun diredp-upcase-recursive (&optional ignore-marks-p)
"Rename marked files, including in marked subdirs, making them uppercase.
Like `dired-upcase', but act recursively on subdirs.
The files included are those that are marked in the current Dired
buffer, or all files in the directory if none are marked. Marked
subdirectories are handled recursively in the same way.
With a prefix argument, ignore all marks - include all files in this
Dired buffer and all subdirs, recursively."
(interactive (progn (diredp-get-confirmation-recursive) (list current-prefix-arg)))
(diredp-create-files-non-directory-recursive
#'dired-rename-file #'upcase "Rename to uppercase:" ignore-marks-p))
(defun diredp-downcase-recursive (&optional ignore-marks-p)
"Rename marked files, including in marked subdirs, making them lowercase.
Like `dired-downcase', but act recursively on subdirs.
The files included are those that are marked in the current Dired
buffer, or all files in the directory if none are marked. Marked
subdirectories are handled recursively in the same way.
With a prefix argument, ignore all marks - include all files in this
Dired buffer and all subdirs, recursively."
(interactive (progn (diredp-get-confirmation-recursive) (list current-prefix-arg)))
(diredp-create-files-non-directory-recursive
#'dired-rename-file #'downcase "Rename to lowercase:" ignore-marks-p))
(defun diredp-do-move-recursive (&optional ignore-marks-p)
"Move marked files, including in marked subdirs, to a given directory.
Like `dired-do-rename', but act recursively on subdirs to pick up the
files to move.
The files included are those that are marked in the current Dired
buffer, or all files in the directory if none are marked. Marked
subdirectories are handled recursively in the same way.
This means move the marked files of marked subdirs and their marked
subdirs, etc. It does not mean move or rename the subdirs themselves
recursively.
With a prefix argument, ignore all marks - include all files in this
Dired buffer and all subdirs, recursively.
Renames any buffers that are visiting the files.
The default suggested for the target directory depends on the value of
`dired-dwim-target', which see."
(interactive (progn (diredp-get-confirmation-recursive) (list current-prefix-arg)))
(diredp-do-create-files-recursive #'dired-rename-file "Move" ignore-marks-p))
(defun diredp-do-copy-recursive (&optional ignore-marks-p)
"Copy marked files, including in marked subdirs, to a given directory.
Like `dired-do-copy', but act recursively on subdirs to pick up the
files to copy.
The files included are those that are marked in the current Dired
buffer, or all files in the directory if none are marked. Marked
subdirectories are handled recursively in the same way.
This means copy the marked files of marked subdirs and their marked
subdirs, etc. It does not mean copy the subdirs themselves
recursively.
With a prefix argument, ignore all marks - include all files in this
Dired buffer and all subdirs, recursively.
Preserves the last-modified date when copying, unless
`dired-copy-preserve-time' is nil.
The default suggested for the target directory depends on the value of
`dired-dwim-target', which see.
This command copies symbolic links by creating new ones, like UNIX
command `cp -d'."
(interactive (progn (diredp-get-confirmation-recursive) (list current-prefix-arg)))
(let ((dired-recursive-copies nil))
(diredp-do-create-files-recursive #'dired-copy-file "Copy" ignore-marks-p)))
(defun diredp-do-create-files-recursive (file-creator operation ignore-marks-p)
"Create a new file for each marked file, including those in marked subdirs.
Like `dired-do-create-files', but act recursively on subdirs, and
always keep markings.
Prompts for the target directory, in which to create the files.
FILE-CREATOR OPERATION is as in `dired-create-files'.
Non-nil IGNORE-MARKS-P means ignore all marks - include all files in this
Dired buffer and all subdirs, recursively."
(lexical-let* ((fn-list (diredp-get-files ignore-marks-p))
(target-dir (dired-dwim-target-directory))
(defaults (and (fboundp 'dired-dwim-target-defaults)
(dired-dwim-target-defaults fn-list target-dir)))
(target (expand-file-name
(if (fboundp 'minibuffer-with-setup-hook)
(minibuffer-with-setup-hook
(lambda ()
(set (make-local-variable 'minibuffer-default-add-function)
nil)
(setq minibuffer-default defaults))
(funcall (if (fboundp 'read-directory-name)
#'read-directory-name
#'read-file-name)
(concat operation " files to: ")
default-directory default-directory))
(funcall (if (fboundp 'read-directory-name)
#'read-directory-name
#'read-file-name)
(concat operation "files to: ")
default-directory default-directory)))))
(unless (file-directory-p target) (error "Target is not a directory: `%s'" target))
(dired-create-files
file-creator operation fn-list
#'(lambda (from) (expand-file-name (file-name-nondirectory from) target))
?*)))
(defun diredp-create-files-non-directory-recursive (file-creator basename-constructor
operation &optional ignore-marks-p)
"Apply FILE-CREATOR + BASENAME-CONSTRUCTOR to non-dir part of marked names.
Like `dired-create-files-non-directory', but act recursively on subdirs.
The files acted on are those marked in the current Dired buffer, or
all files in the directory if none are marked. Marked subdirectories
are handled recursively in the same way.
With non-nil IGNORE-MARKS-P, ignore all marks - include all files in
this Dired buffer and all subdirs, recursively."
(let (rename-non-directory-query)
(dired-create-files
file-creator
operation
(diredp-get-files ignore-marks-p)
#'(lambda (from)
(let ((to (concat (file-name-directory from)
(funcall basename-constructor (file-name-nondirectory from)))))
(and (let ((help-form (format "\
Type SPC or `y' to %s one file, DEL or `n' to skip to next,
`!' to %s all remaining matches with no more questions."
(downcase operation)
(downcase operation))))
(dired-query 'rename-non-directory-query (concat operation " `%s' to `%s'")
(dired-make-relative from) (dired-make-relative to)))
to)))
?*)))
(defun diredp-do-chxxx-recursive (attribute-name program op-symbol
&optional ignore-marks-p default)
"Change attributes of the marked files, including those in marked subdirs.
Refresh their file lines.
Like `dired-do-chxxx', but act recursively on subdirs. The subdirs
acted on are those that are marked in the current Dired buffer, or all
subdirs in the directory if none are marked. Marked subdirectories
are handled recursively in the same way.
ATTRIBUTE-NAME is a string describing the attribute to the user.
PROGRAM is the program used to change the attribute.
OP-SYMBOL is the type of operation (for use in `dired-mark-pop-up').
Non-nil IGNORE-MARKS-P means ignore all marks - include all files in this
Dired buffer and all subdirs, recursively."
(let* ((this-buff (current-buffer))
(files (diredp-get-files ignore-marks-p))
(prompt (concat "Change " attribute-name " of %s to: "))
(new-attribute (if (> emacs-major-version 22)
(dired-mark-read-string prompt nil op-symbol
ignore-marks-p files default)
(dired-mark-read-string prompt nil op-symbol ignore-marks-p files)))
(operation (concat program " " new-attribute))
failures)
(setq failures (dired-bunch-files 10000 (function dired-check-process)
(append (list operation program)
(unless (string-equal new-attribute "")
(if (equal attribute-name "Timestamp")
(list "-t" new-attribute)
(list new-attribute)))
(and (string-match "gnu" system-configuration)
'("--")))
files))
(with-current-buffer this-buff
(diredp-do-redisplay-recursive 'MSGP))
(when failures (dired-log-summary (format "%s: error" operation) nil))))
(defun diredp-do-chmod-recursive (&optional ignore-marks-p)
"Change the mode of the marked files, including those in marked subdirs.
Symbolic modes like `g+w' are allowed.
Note that marked subdirs are not changed. Their markings are used only
to indicate that some of their files are to be changed."
(interactive (progn (diredp-get-confirmation-recursive) (list current-prefix-arg)))
(let* ((files (diredp-get-files ignore-marks-p))
(modestr (and (stringp (car files))
(nth 8 (file-attributes (car files)))))
(default (and (stringp modestr)
(string-match "^.\\(...\\)\\(...\\)\\(...\\)$" modestr)
(replace-regexp-in-string "-" "" (format "u=%s,g=%s,o=%s"
(match-string 1 modestr)
(match-string 2 modestr)
(match-string 3 modestr)))))
(modes (if (> emacs-major-version 22)
(dired-mark-read-string
"Change mode of marked files here and below to: " nil 'chmod
nil files default)
(dired-mark-read-string
"Change mode of marked files here and below to: " nil 'chmod
nil files))))
(when (equal modes "") (error "No file mode specified"))
(dolist (file files)
(set-file-modes file (or (and (string-match "^[0-7]+" modes)
(string-to-number modes 8))
(file-modes-symbolic-to-number modes (file-modes file)))))
(diredp-do-redisplay-recursive 'MSGP)))
(unless (memq system-type '(windows-nt ms-dos))
(defun diredp-do-chgrp-recursive (&optional ignore-marks-p)
"Change the group of the marked (or next ARG) files."
(interactive "P")
(diredp-do-chxxx-recursive "Group" "chgrp" 'chgrp ignore-marks-p)))
(unless (memq system-type '(windows-nt ms-dos))
(defun diredp-do-chown-recursive (&optional ignore-marks-p)
"Change the owner of the marked (or next ARG) files."
(interactive "P")
(diredp-do-chxxx-recursive "Owner" dired-chown-program 'chown ignore-marks-p)))
(defun diredp-do-touch-recursive (&optional ignore-marks-p)
"Change the timestamp of marked files, including those in marked subdirs.
This calls `touch'. Like `dired-do-touch', but act recursively on
subdirs. The subdirs inserted are those that are marked in the
current Dired buffer, or all subdirs in the directory if none are
marked. Marked subdirectories are handled recursively in the same
way.
With a prefix argument, ignore all marks - include all files in this
Dired buffer and all subdirs, recursively."
(interactive (progn (diredp-get-confirmation-recursive) (list current-prefix-arg)))
(diredp-do-chxxx-recursive "Timestamp" (if (boundp 'dired-touch-program)
dired-touch-program
"touch")
'touch
ignore-marks-p
(format-time-string "%Y%m%d%H%M.%S" (current-time))))
(defun diredp-do-redisplay-recursive (&optional msgp)
"Redisplay marked file lines, including those in marked subdirs.
Like `dired-do-redisplay' with no args, but act recursively on
subdirs."
(interactive (progn (diredp-ensure-mode)
(unless (y-or-n-p "Act on all marked file lines in and UNDER this dir? ")
(error "OK, canceled"))
(list t)))
(when msgp (message "Redisplaying..."))
(dolist (dir (cons default-directory
(diredp-get-files nil #'file-directory-p 'INCLUDE-SUBDIRS 'DONT-ASK)))
(with-current-buffer (dired-noselect dir)
(dired-uncache (if (consp dired-directory) (car dired-directory) dired-directory))
(dired-map-over-marks
(let ((fname (dired-get-filename))
(dired-after-readin-hook nil))
(message "Redisplaying... %s" fname)
(dired-update-file-line fname))
nil)
(run-hooks 'dired-after-readin-hook)
(dired-move-to-filename)))
(when msgp (message "Redisplaying...done")))
(defun diredp-marked (dirname &optional n switches)
"Open Dired on only the marked files or the next N files.
With a non-zero numeric prefix arg N, use the next abs(N) files.
A plain (`C-u'), zero, or negative prefix arg prompts for listing
switches as in command `dired'.
Note that the marked files can include files in inserted
subdirectories, so the Dired buffer that is opened can contain files
from multiple directories in the same tree."
(interactive
(progn
(diredp-ensure-mode)
(let ((num (and current-prefix-arg (atom current-prefix-arg)
(not (zerop (prefix-numeric-value current-prefix-arg)))
(abs (prefix-numeric-value current-prefix-arg)))))
(list (cons (generate-new-buffer-name (buffer-name)) (dired-get-marked-files t num))
num
(and current-prefix-arg
(or (consp current-prefix-arg)
(< (prefix-numeric-value current-prefix-arg) 0))
(read-string "Dired listing switches: " dired-listing-switches))))))
(unless (or n (save-excursion (goto-char (point-min))
(and (re-search-forward (dired-marker-regexp) nil t)
(re-search-forward (dired-marker-regexp) nil t))))
(error "No marked files"))
(dired dirname switches))
(defun diredp-marked-other-window (dirname &optional n switches)
"Same as `diredp-marked', but uses a different window."
(interactive
(progn
(diredp-ensure-mode)
(let ((num (and current-prefix-arg (atom current-prefix-arg)
(not (zerop (prefix-numeric-value current-prefix-arg)))
(abs (prefix-numeric-value current-prefix-arg)))))
(list (cons (generate-new-buffer-name (buffer-name)) (dired-get-marked-files t num))
num
(and current-prefix-arg
(or (consp current-prefix-arg)
(< (prefix-numeric-value current-prefix-arg) 0))
(read-string "Dired listing switches: " dired-listing-switches))))))
(unless (or n (save-excursion (goto-char (point-min))
(and (re-search-forward (dired-marker-regexp) nil t)
(re-search-forward (dired-marker-regexp) nil t))))
(error "No marked files"))
(dired-other-window dirname switches))
(defun diredp-mark/unmark-extension (extension &optional unmark-p)
"Mark all files with a certain EXTENSION for use in later commands.
A `.' is not automatically prepended to the string entered.
Non-nil prefix argument UNMARK-P means unmark instead of mark."
(interactive
(list (dired-read-regexp (concat (if current-prefix-arg "Unmark" "Mark")
"ing extension: "))
current-prefix-arg))
(or (listp extension) (setq extension (list extension)))
(dired-mark-files-regexp (concat "."
"\\("
(mapconcat 'regexp-quote extension "\\|")
"\\)$")
(and current-prefix-arg ?\040)))
(defun diredp-mark-files-tagged-all/none (tags &optional none-p unmarkp prefix)
"Mark or unmark files tagged with all or none of TAGS.
TAGS is a list of strings, the tag names.
NONEP non-nil means mark/unmark files that have none of the TAGS.
UNMARKP non-nil means unmark
PREFIX non-nil is the prefix of the autofile bookmarks to check.
As a special case, if TAGS is empty, then mark or unmark the files
that have any tags at all, or if NONEP is non-nil then mark or unmark
those that have no tags at all."
(let ((dired-marker-char (if unmarkp ?\040 dired-marker-char)))
(dired-mark-if (and (not (looking-at dired-re-dot)) (not (eolp))
(let* ((fname (dired-get-filename nil t))
(bmk (and fname
(bmkp-get-autofile-bookmark fname nil prefix)))
(btgs (and bmk (bmkp-get-tags bmk)))
(presentp nil)
(allp (and btgs
(catch 'diredp-m-f-t-an
(dolist (tag tags)
(setq presentp (assoc-default
tag btgs nil t))
(unless (if none-p (not presentp) presentp)
(throw 'diredp-m-f-t-an nil)))
t))))
(if (null tags)
(if none-p (not btgs) btgs)
allp)))
(if none-p "no-tags-matching file" "all-tags-matching file"))))
(defun diredp-mark-files-tagged-some/not-all (tags &optional notallp unmarkp prefix)
"Mark or unmark files tagged with any or not all of TAGS.
TAGS is a list of strings, the tag names.
NOTALLP non-nil means mark/unmark files that do not have all TAGS.
UNMARKP non-nil means unmark
PREFIX non-nil is the prefix of the autofile bookmarks to check.
As a special case, if TAGS is empty, then mark or unmark the files
that have any tags at all, or if NOTALLP is non-nil then mark or
unmark those that have no tags at all."
(let ((dired-marker-char (if unmarkp ?\040 dired-marker-char)))
(dired-mark-if (and (not (looking-at dired-re-dot)) (not (eolp))
(let* ((fname (dired-get-filename nil t))
(bmk (and fname
(bmkp-get-autofile-bookmark fname nil prefix)))
(btgs (and bmk (bmkp-get-tags bmk)))
(presentp nil)
(allp (and btgs
(catch 'diredp-m-f-t-sna
(dolist (tag tags)
(setq presentp (assoc-default
tag btgs nil t))
(when (if notallp (not presentp) presentp)
(throw 'diredp-m-f-t-sna t)))
nil))))
(if (null tags)
(if notallp (not btgs) btgs)
allp)))
(if notallp "some-tags-not-matching file" "some-tags-matching file"))))
(defun diredp-mark-files-tagged-all (tags &optional none-p prefix)
"Mark all files that are tagged with *each* tag in TAGS.
As a special case, if TAGS is empty, then mark the files that have
any tags at all (i.e., at least one tag).
With a prefix arg, mark all that are *not* tagged with *any* TAGS.
You need library `bookmark+.el' to use this command."
(interactive
(list (and (fboundp 'bmkp-read-tags-completing) (bmkp-read-tags-completing))
current-prefix-arg
(and diredp-prompt-for-bookmark-prefix-flag
(read-string "Prefix for autofile bookmark names: "))))
(unless (require 'bookmark+ nil t) (error "This command requires library `bookmark+.el'"))
(diredp-ensure-mode)
(diredp-mark-files-tagged-all/none tags none-p nil prefix))
(defun diredp-mark-files-tagged-none (tags &optional allp prefix)
"Mark all files that are not tagged with *any* tag in TAGS.
As a special case, if TAGS is empty, then mark the files that have
no tags at all.
With a prefix arg, mark all that are tagged with *each* tag in TAGS.
You need library `bookmark+.el' to use this command."
(interactive
(list (and (fboundp 'bmkp-read-tags-completing) (bmkp-read-tags-completing))
current-prefix-arg
(and diredp-prompt-for-bookmark-prefix-flag
(read-string "Prefix for autofile bookmark names: "))))
(unless (require 'bookmark+ nil t) (error "This command requires library `bookmark+.el'"))
(diredp-ensure-mode)
(diredp-mark-files-tagged-all/none tags (not allp) nil prefix))
(defun diredp-mark-files-tagged-some (tags &optional somenotp prefix)
"Mark all files that are tagged with *some* tag in TAGS.
As a special case, if TAGS is empty, then mark the files that have
any tags at all (i.e., at least one tag).
With a prefix arg, mark all that are *not* tagged with *all* TAGS.
You need library `bookmark+.el' to use this command."
(interactive
(list (and (fboundp 'bmkp-read-tags-completing) (bmkp-read-tags-completing))
current-prefix-arg
(and diredp-prompt-for-bookmark-prefix-flag
(read-string "Prefix for autofile bookmark names: "))))
(unless (require 'bookmark+ nil t) (error "This command requires library `bookmark+.el'"))
(diredp-ensure-mode)
(diredp-mark-files-tagged-some/not-all tags somenotp nil prefix))
(defun diredp-mark-files-tagged-not-all (tags &optional somep prefix)
"Mark all files that are not tagged with *all* TAGS.
As a special case, if TAGS is empty, then mark the files that have
no tags at all.
With a prefix arg, mark all that are tagged with *some* TAGS.
You need library `bookmark+.el' to use this command."
(interactive
(list (and (fboundp 'bmkp-read-tags-completing) (bmkp-read-tags-completing))
current-prefix-arg
(and diredp-prompt-for-bookmark-prefix-flag
(read-string "Prefix for autofile bookmark names: "))))
(unless (require 'bookmark+ nil t) (error "This command requires library `bookmark+.el'"))
(diredp-ensure-mode)
(diredp-mark-files-tagged-some/not-all tags (not somep) nil prefix))
(defun diredp-mark-files-tagged-regexp (regexp &optional notp prefix)
"Mark files that have at least one tag that matches REGEXP.
With a prefix arg, mark all that are tagged but have no matching tags.
You need library `bookmark+.el' to use this command."
(interactive
(list (read-string "Regexp: ")
current-prefix-arg
(and diredp-prompt-for-bookmark-prefix-flag
(read-string "Prefix for autofile bookmark names: "))))
(unless (require 'bookmark+ nil t) (error "This command requires library `bookmark+.el'"))
(diredp-ensure-mode)
(dired-mark-if (and (not (looking-at dired-re-dot)) (not (eolp))
(lexical-let* ((fname (dired-get-filename nil t))
(bmk (and fname
(bmkp-get-autofile-bookmark fname nil prefix)))
(btgs (and bmk (bmkp-get-tags bmk)))
(anyp (and btgs (bmkp-some
#'(lambda (tag)
(string-match regexp
(bmkp-tag-name tag)))
btgs))))
(and btgs (if notp (not anyp) anyp))))
"some-tag-matching-regexp file"))
(defun diredp-unmark-files-tagged-regexp (regexp &optional notp prefix)
"Unmark files that have at least one tag that matches REGEXP.
With a prefix arg, unmark all that are tagged but have no matching tags.
You need library `bookmark+.el' to use this command."
(interactive
(list (read-string "Regexp: ")
current-prefix-arg
(and diredp-prompt-for-bookmark-prefix-flag
(read-string "Prefix for autofile bookmark names: "))))
(unless (require 'bookmark+ nil t) (error "This command requires library `bookmark+.el'"))
(diredp-ensure-mode)
(let ((dired-marker-char ?\040))
(dired-mark-if (and (not (looking-at dired-re-dot)) (not (eolp))
(lexical-let* ((fname (dired-get-filename nil t))
(bmk (and fname
(bmkp-get-autofile-bookmark
fname nil prefix)))
(btgs (and bmk (bmkp-get-tags bmk)))
(anyp (and btgs (bmkp-some
#'(lambda (tag)
(string-match regexp
(bmkp-tag-name tag)))
btgs))))
(and btgs (if notp (not anyp) anyp))))
"some-tag-matching-regexp file")))
(defun diredp-unmark-files-tagged-all (tags &optional none-p prefix)
"Unmark all files that are tagged with *each* tag in TAGS.
As a special case, if TAGS is empty, then unmark the files that have
any tags at all (i.e., at least one tag).
With a prefix arg, unmark all that are *not* tagged with *any* TAGS.
You need library `bookmark+.el' to use this command."
(interactive
(list (and (fboundp 'bmkp-read-tags-completing) (bmkp-read-tags-completing))
current-prefix-arg
(and diredp-prompt-for-bookmark-prefix-flag
(read-string "Prefix for autofile bookmark names: "))))
(unless (require 'bookmark+ nil t) (error "This command requires library `bookmark+.el'"))
(diredp-ensure-mode)
(diredp-mark-files-tagged-all/none tags none-p 'UNMARK prefix))
(defun diredp-unmark-files-tagged-none (tags &optional allp prefix)
"Unmark all files that are *not* tagged with *any* tag in TAGS.
As a special case, if TAGS is empty, then unmark the files that have
no tags at all.
With a prefix arg, unmark all that are tagged with *each* tag in TAGS.
You need library `bookmark+.el' to use this command."
(interactive
(list (and (fboundp 'bmkp-read-tags-completing) (bmkp-read-tags-completing))
current-prefix-arg
(and diredp-prompt-for-bookmark-prefix-flag
(read-string "Prefix for autofile bookmark names: "))))
(unless (require 'bookmark+ nil t) (error "This command requires library `bookmark+.el'"))
(diredp-ensure-mode)
(diredp-mark-files-tagged-all/none tags (not allp) 'UNMARK prefix))
(defun diredp-unmark-files-tagged-some (tags &optional somenotp prefix)
"Unmark all files that are tagged with *some* tag in TAGS.
As a special case, if TAGS is empty, then unmark the files that have
any tags at all.
With a prefix arg, unmark all that are *not* tagged with *all* TAGS.
You need library `bookmark+.el' to use this command."
(interactive
(list (and (fboundp 'bmkp-read-tags-completing) (bmkp-read-tags-completing))
current-prefix-arg
(and diredp-prompt-for-bookmark-prefix-flag
(read-string "Prefix for autofile bookmark names: "))))
(unless (require 'bookmark+ nil t) (error "This command requires library `bookmark+.el'"))
(diredp-ensure-mode)
(diredp-mark-files-tagged-some/not-all tags somenotp 'UNMARK prefix))
(defun diredp-unmark-files-tagged-not-all (tags &optional somep prefix)
"Unmark all files that are *not* tagged with *all* TAGS.
As a special case, if TAGS is empty, then unmark the files that have
no tags at all.
With a prefix arg, unmark all that are tagged with *some* TAGS.
You need library `bookmark+.el' to use this command."
(interactive
(list (and (fboundp 'bmkp-read-tags-completing) (bmkp-read-tags-completing))
current-prefix-arg
(and diredp-prompt-for-bookmark-prefix-flag
(read-string "Prefix for autofile bookmark names: "))))
(unless (require 'bookmark+ nil t) (error "This command requires library `bookmark+.el'"))
(diredp-ensure-mode)
(diredp-mark-files-tagged-some/not-all tags (not somep) 'UNMARK prefix))
(defun diredp-do-tag (tags &optional prefix arg)
"Tag the marked (or the next prefix argument) files.
You need library `bookmark+.el' to use this command.
Hit `RET' to enter each tag, then hit `RET' again after the last tag.
You can use completion to enter each tag. Completion is lax: you are
not limited to existing tags.
TAGS is a list of strings. PREFIX is as for `diredp-do-bookmark'.
A prefix argument ARG specifies files to use instead of those marked.
An integer means use the next ARG files (previous -ARG, if < 0).
`C-u': Use the current file (whether or not any are marked).
`C-u C-u': Use all files in Dired, except directories.
`C-u C-u C-u': Use all files and directories, except `.' and `..'.
`C-u C-u C-u C-u': Use all files and all directories."
(interactive (progn (unless (require 'bookmark+ nil t)
(error "This command requires library `bookmark+.el'"))
(diredp-ensure-mode)
(list (bmkp-read-tags-completing)
(and diredp-prompt-for-bookmark-prefix-flag
(read-string "Prefix for autofile bookmark name: "))
current-prefix-arg)))
(dired-map-over-marks-check (lexical-let ((pref prefix)) #'(lambda () (diredp-tag tags pref)))
arg 'tag (diredp-fewer-than-2-files-p arg)))
(defun diredp-tag (tags &optional prefix)
"Add tags to the file or directory named on the current line.
You need library `bookmark+.el' to use this function.
The bookmark name is the non-directory portion of the file name,
prefixed by PREFIX if it is non-nil.
Return nil for success, file name otherwise."
(bookmark-maybe-load-default-file)
(let ((file (dired-get-file-for-visit))
failure)
(condition-case err
(bmkp-autofile-add-tags file tags nil prefix)
(error (setq failure (error-message-string err))))
(if (not failure)
nil
(dired-log failure)
(dired-make-relative file))))
(defun diredp-mouse-do-tag (event)
"In Dired, add some tags to this file.
You need library `bookmark+.el' to use this command."
(interactive "e")
(unless (require 'bookmark+ nil t) (error "This command requires library `bookmark+.el'"))
(diredp-ensure-mode)
(lexical-let ((mouse-pos (event-start event))
(dired-no-confirm t)
(prefix (and diredp-prompt-for-bookmark-prefix-flag
(read-string "Prefix for bookmark name: "))))
(select-window (posn-window mouse-pos))
(goto-char (posn-point mouse-pos))
(dired-map-over-marks-check #'(lambda () (diredp-tag (bmkp-read-tags-completing) prefix))
1 'tag t))
(dired-previous-line 1))
(defun diredp-do-untag (tags &optional prefix arg)
"Remove some tags from the marked (or the next prefix arg) files.
You need library `bookmark+.el' to use this command.
Hit `RET' to enter each tag, then hit `RET' again after the last tag.
You can use completion to enter each tag. Completion is lax: you are
not limited to existing tags.
TAGS is a list of strings. PREFIX is as for `diredp-do-bookmark'.
A prefix argument ARG specifies files to use instead of those marked.
An integer means use the next ARG files (previous -ARG, if < 0).
`C-u': Use the current file (whether or not any are marked).
`C-u C-u': Use all files in Dired, except directories.
`C-u C-u C-u': Use all files and directories, except `.' and `..'.
`C-u C-u C-u C-u': Use all files and all directories."
(interactive (progn (unless (require 'bookmark+ nil t)
(error "This command requires library `bookmark+.el'"))
(diredp-ensure-mode)
(list (bmkp-read-tags-completing)
(and diredp-prompt-for-bookmark-prefix-flag
(read-string "Prefix for bookmark name: "))
current-prefix-arg)))
(dired-map-over-marks-check (lexical-let ((pref prefix))
#'(lambda () (diredp-untag tags pref)))
arg 'untag (diredp-fewer-than-2-files-p arg)))
(defun diredp-untag (tags &optional prefix)
"Remove some tags from the file or directory named on the current line.
You need library `bookmark+.el' to use this function.
The bookmark name is the non-directory portion of the file name,
prefixed by PREFIX if it is non-nil.
Return nil for success, file name otherwise."
(bookmark-maybe-load-default-file)
(let ((file (dired-get-file-for-visit))
failure)
(condition-case err
(bmkp-autofile-remove-tags file tags nil prefix)
(error (setq failure (error-message-string err))))
(if (not failure)
nil
(dired-log failure)
(dired-make-relative file))))
(defun diredp-mouse-do-untag (event)
"In Dired, remove some tags from this file.
You need library `bookmark+.el' to use this command."
(interactive "e")
(unless (require 'bookmark+ nil t) (error "This command requires library `bookmark+.el'"))
(diredp-ensure-mode)
(lexical-let ((mouse-pos (event-start event))
(dired-no-confirm t)
(prefix (and diredp-prompt-for-bookmark-prefix-flag
(read-string "Prefix for bookmark name: "))))
(select-window (posn-window mouse-pos))
(goto-char (posn-point mouse-pos))
(lexical-let* ((bmk (bmkp-get-autofile-bookmark (dired-get-filename) nil prefix))
(btgs (and bmk (bmkp-get-tags bmk))))
(unless btgs (error "File has no tags to remove"))
(dired-map-over-marks-check
#'(lambda () (diredp-untag (bmkp-read-tags-completing btgs) prefix)) 1 'untag t)))
(dired-previous-line 1))
(defun diredp-do-remove-all-tags (&optional prefix arg)
"Remove all tags from the marked (or the next prefix arg) files.
You need library `bookmark+.el' to use this command.
PREFIX is as for `diredp-do-bookmark'.
A prefix argument ARG specifies files to use instead of those marked.
An integer means use the next ARG files (previous -ARG, if < 0).
`C-u': Use the current file (whether or not any are marked).
`C-u C-u': Use all files in Dired, except directories.
`C-u C-u C-u': Use all files and directories, except `.' and `..'.
`C-u C-u C-u C-u': Use all files and all directories."
(interactive (progn (unless (require 'bookmark+ nil t)
(error "This command requires library `bookmark+.el'"))
(diredp-ensure-mode)
(list (and diredp-prompt-for-bookmark-prefix-flag
(read-string "Prefix for bookmark name: "))
current-prefix-arg)))
(lexical-let ((pref prefix))
(dired-map-over-marks-check #'(lambda () (diredp-remove-all-tags pref)) arg 'remove-all-tags
(diredp-fewer-than-2-files-p arg))))
(defun diredp-remove-all-tags (&optional prefix)
"Remove all tags from the file or directory named on the current line.
You need library `bookmark+.el' to use this function.
The bookmark name is the non-directory portion of the file name,
prefixed by PREFIX if it is non-nil.
Return nil for success, file name otherwise."
(bookmark-maybe-load-default-file)
(let ((file (dired-get-file-for-visit))
failure)
(condition-case err
(bmkp-remove-all-tags (bmkp-autofile-set file nil prefix))
(error (setq failure (error-message-string err))))
(if (not failure)
nil
(dired-log failure)
(dired-make-relative file))))
(defun diredp-mouse-do-remove-all-tags (event)
"In Dired, remove all tags from the marked (or next prefix arg) files.
You need library `bookmark+.el' to use this command."
(interactive "e")
(unless (require 'bookmark+ nil t) (error "This command requires library `bookmark+.el'"))
(diredp-ensure-mode)
(lexical-let ((mouse-pos (event-start event))
(dired-no-confirm t)
(prefix (and diredp-prompt-for-bookmark-prefix-flag
(read-string "Prefix for bookmark name: "))))
(select-window (posn-window mouse-pos))
(goto-char (posn-point mouse-pos))
(dired-map-over-marks-check #'(lambda () (diredp-remove-all-tags prefix))
1 'remove-all-tags t))
(dired-previous-line 1))
(defun diredp-do-paste-add-tags (&optional prefix arg)
"Add previously copied tags to the marked (or next prefix arg) files.
The tags were previously copied from a file to `bmkp-copied-tags'.
You need library `bookmark+.el' to use this command.
A prefix argument ARG specifies files to use instead of those marked.
An integer means use the next ARG files (previous -ARG, if < 0).
`C-u': Use the current file (whether or not any are marked).
`C-u C-u': Use all files in Dired, except directories.
`C-u C-u C-u': Use all files and directories, except `.' and `..'.
`C-u C-u C-u C-u': Use all files and all directories."
(interactive (progn (unless (require 'bookmark+ nil t)
(error "This command requires library `bookmark+.el'"))
(diredp-ensure-mode)
(list (and diredp-prompt-for-bookmark-prefix-flag
(read-string "Prefix for autofile bookmark name: "))
current-prefix-arg)))
(dired-map-over-marks-check (lexical-let ((pref prefix))
#'(lambda () (diredp-paste-add-tags pref)))
arg 'paste-add-tags
(diredp-fewer-than-2-files-p arg)))
(defun diredp-paste-add-tags (&optional prefix)
"Add previously copied tags to the file or directory on the current line.
The tags were previously copied from a file to `bmkp-copied-tags'.
You need library `bookmark+.el' to use this function.
The bookmark name is the non-directory portion of the file name,
prefixed by PREFIX if it is non-nil.
Return nil for success, file name otherwise."
(bookmark-maybe-load-default-file)
(let ((file (dired-get-file-for-visit))
failure)
(condition-case err
(bmkp-autofile-add-tags file bmkp-copied-tags nil prefix)
(error (setq failure (error-message-string err))))
(if (not failure)
nil
(dired-log failure)
(dired-make-relative file))))
(defun diredp-mouse-do-paste-add-tags (event)
"In Dired, add previously copied tags to this file.
The tags were previously copied from a file to `bmkp-copied-tags'.
You need library `bookmark+.el' to use this command."
(interactive "e")
(unless (require 'bookmark+ nil t) (error "This command requires library `bookmark+.el'"))
(diredp-ensure-mode)
(lexical-let ((mouse-pos (event-start event))
(dired-no-confirm t)
(prefix (and diredp-prompt-for-bookmark-prefix-flag
(read-string "Prefix for bookmark name: "))))
(select-window (posn-window mouse-pos))
(goto-char (posn-point mouse-pos))
(dired-map-over-marks-check #'(lambda () (diredp-paste-add-tags prefix))
1 'paste-add-tags t))
(dired-previous-line 1))
(defun diredp-do-paste-replace-tags (&optional prefix arg)
"Replace tags for marked (or next prefix arg) files with copied tags.
The tags were previously copied from a file to `bmkp-copied-tags'.
You need library `bookmark+.el' to use this command.
A prefix argument ARG specifies files to use instead of those marked.
An integer means use the next ARG files (previous -ARG, if < 0).
`C-u': Use the current file (whether or not any are marked).
`C-u C-u': Use all files in Dired, except directories.
`C-u C-u C-u': Use all files and directories, except `.' and `..'.
`C-u C-u C-u C-u': Use all files and all directories."
(interactive (progn (unless (require 'bookmark+ nil t)
(error "This command requires library `bookmark+.el'"))
(diredp-ensure-mode)
(list (and diredp-prompt-for-bookmark-prefix-flag
(read-string "Prefix for autofile bookmark name: "))
current-prefix-arg)))
(dired-map-over-marks-check (lexical-let ((pref prefix))
#'(lambda () (diredp-paste-replace-tags pref)))
arg 'paste-replace-tags (diredp-fewer-than-2-files-p arg)))
(defun diredp-paste-replace-tags (&optional prefix)
"Replace tags for this file or dir with tags copied previously.
The tags were previously copied from a file to `bmkp-copied-tags'.
You need library `bookmark+.el' to use this function.
The bookmark name is the non-directory portion of the file name,
prefixed by PREFIX if it is non-nil.
Return nil for success, file name otherwise."
(bookmark-maybe-load-default-file)
(let ((file (dired-get-file-for-visit))
failure)
(condition-case err
(progn (bmkp-remove-all-tags (bmkp-autofile-set file nil prefix))
(bmkp-autofile-add-tags file bmkp-copied-tags nil prefix))
(error (setq failure (error-message-string err))))
(if (not failure)
nil
(dired-log failure)
(dired-make-relative file))))
(defun diredp-mouse-do-paste-replace-tags (event)
"In Dired, replace tags for this file with tags copied previously.
The tags were previously copied from a file to `bmkp-copied-tags'.
You need library `bookmark+.el' to use this command."
(interactive "e")
(unless (require 'bookmark+ nil t) (error "This command requires library `bookmark+.el'"))
(diredp-ensure-mode)
(lexical-let ((mouse-pos (event-start event))
(dired-no-confirm t)
(prefix (and diredp-prompt-for-bookmark-prefix-flag
(read-string "Prefix for bookmark name: "))))
(select-window (posn-window mouse-pos))
(goto-char (posn-point mouse-pos))
(dired-map-over-marks-check #'(lambda () (diredp-paste-replace-tags prefix))
1 'paste-replace-tags t))
(dired-previous-line 1))
(defun diredp-do-set-tag-value (tag value &optional prefix arg)
"Set TAG value to VALUE, for the marked (or next prefix arg) files.
This does not change the TAG name.
You need library `bookmark+.el' to use this command.
PREFIX is as for `diredp-do-bookmark'.
A prefix argument ARG specifies files to use instead of those marked.
An integer means use the next ARG files (previous -ARG, if < 0).
`C-u': Use the current file (whether or not any are marked).
`C-u C-u': Use all files in Dired, except directories.
`C-u C-u C-u': Use all files and directories, except `.' and `..'.
`C-u C-u C-u C-u': Use all files and all directories."
(interactive (progn (unless (require 'bookmark+ nil t)
(error "This command requires library `bookmark+.el'"))
(diredp-ensure-mode)
(list (bmkp-read-tag-completing)
(read (read-string "Value: "))
(and diredp-prompt-for-bookmark-prefix-flag
(read-string "Prefix for bookmark name: "))
current-prefix-arg)))
(dired-map-over-marks-check (lexical-let ((tg tag)
(val value)
(pref prefix))
#'(lambda () (diredp-set-tag-value tg val pref)))
arg 'set-tag-value (diredp-fewer-than-2-files-p arg)))
(defun diredp-set-tag-value (tag value &optional prefix)
"Set TAG value to VALUE for this file or directory.
This does not change the TAG name.
You need library `bookmark+.el' to use this function.
The bookmark name is the non-directory portion of the file name,
prefixed by PREFIX if it is non-nil.
Return nil for success, file name otherwise."
(bookmark-maybe-load-default-file)
(let ((file (dired-get-file-for-visit))
failure)
(condition-case err
(bmkp-set-tag-value (bmkp-autofile-set file nil prefix) tag value)
(error (setq failure (error-message-string err))))
(if (not failure)
nil
(dired-log failure)
(dired-make-relative file))))
(defun diredp-mouse-do-set-tag-value (event)
"In Dired, set the value of a tag for this file.
This does not change the tag name.
You need library `bookmark+.el' to use this command."
(interactive "e")
(unless (require 'bookmark+ nil t) (error "This command requires library `bookmark+.el'"))
(diredp-ensure-mode)
(lexical-let ((mouse-pos (event-start event))
(dired-no-confirm t)
(prefix (and diredp-prompt-for-bookmark-prefix-flag
(read-string "Prefix for bookmark name: "))))
(select-window (posn-window mouse-pos))
(goto-char (posn-point mouse-pos))
(dired-map-over-marks-check #'(lambda () (diredp-set-tag-value (bmkp-read-tag-completing)
(read (read-string "Value: "))
prefix))
1 'set-tag-value t))
(dired-previous-line 1))
(defun diredp-do-bookmark (&optional prefix arg)
"Bookmark the marked (or the next prefix argument) files.
Each bookmark name is the non-directory portion of the file name,
prefixed by PREFIX if it is non-nil.
Interactively, you are prompted for the PREFIX if
`diredp-prompt-for-bookmark-prefix-flag' is non-nil.
The bookmarked position is the beginning of the file.
If you use library `bookmark+.el' then the bookmark is an autofile.
A prefix argument ARG specifies files to use instead of those marked.
An integer means use the next ARG files (previous -ARG, if < 0).
`C-u': Use the current file (whether or not any are marked).
`C-u C-u': Use all files in Dired, except directories.
`C-u C-u C-u': Use all files and directories, except `.' and `..'.
`C-u C-u C-u C-u': Use all files and all directories."
(interactive (progn (diredp-ensure-mode)
(list (and diredp-prompt-for-bookmark-prefix-flag
(read-string "Prefix for bookmark name: "))
current-prefix-arg)))
(dired-map-over-marks-check (lexical-let ((pref prefix))
#'(lambda () (diredp-bookmark pref nil 'NO-MSG-P)))
arg 'bookmark (diredp-fewer-than-2-files-p arg)))
(defun diredp-mouse-do-bookmark (event)
"In Dired, bookmark this file. See `diredp-do-bookmark'."
(interactive "e")
(lexical-let ((mouse-pos (event-start event))
(dired-no-confirm t)
(prefix (and diredp-prompt-for-bookmark-prefix-flag
(read-string "Prefix for bookmark name: "))))
(select-window (posn-window mouse-pos))
(goto-char (posn-point mouse-pos))
(dired-map-over-marks-check #'(lambda () (diredp-bookmark prefix nil 'NO-MSG-P))
nil 'bookmark t))
(dired-previous-line 1))
(defun diredp-bookmark (&optional prefix file no-msg-p)
"Bookmark the file or directory FILE.
If you use library `bookmark+.el' then the bookmark is an autofile.
Return nil for success or the file name otherwise.
The bookmark name is the (non-directory) file name, prefixed by
optional arg PREFIX (a string) if non-nil.
FILE defaults to the file name on the current Dired line.
Non-nil optional arg NO-MSG-P means do not show progress messages."
(bookmark-maybe-load-default-file)
(let ((fil (or file (dired-get-file-for-visit)))
(failure nil))
(condition-case err
(if (fboundp 'bmkp-autofile-set)
(bmkp-autofile-set fil nil prefix)
(let ((bookmark-make-record-function
(cond ((and (require 'image nil t) (require 'image-mode nil t)
(condition-case nil (image-type fil) (error nil)))
(lambda ()
`((filename . ,fil)
(position . 0)
(image-type . ,(image-type fil))
(handler . image-bookmark-jump))))
(t
(lambda ()
`((filename . ,fil)
(position . 0)))))))
(bookmark-store (concat prefix (file-name-nondirectory fil))
(cdr (bookmark-make-record))
nil
no-msg-p)))
(error (setq failure (error-message-string err))))
(if (not failure)
nil
(if (fboundp 'bmkp-autofile-set)
(dired-log failure)
(dired-log "Failed to create bookmark for `%s':\n%s\n" fil failure))
(dired-make-relative fil))))
(defun diredp-set-bookmark-file-bookmark-for-marked (bookmark-file
&optional prefix arg)
"Bookmark the marked files and create a bookmark-file bookmark for them.
The bookmarked position is the beginning of the file.
Jumping to the bookmark-file bookmark loads the set of file bookmarks.
You need library `bookmark+.el' to use this command.
Each bookmark name is the non-directory portion of the file name,
prefixed by PREFIX if it is non-nil.
Interactively, you are prompted for PREFIX if
`diredp-prompt-for-bookmark-prefix-flag' is non-nil.
A prefix argument ARG specifies files to use instead of those marked.
An integer means use the next ARG files (previous -ARG, if < 0).
`C-u': Use the current file (whether or not any are marked).
`C-u C-u': Use all files in Dired, except directories.
`C-u C-u C-u': Use all files and directories, except `.' and `..'.
`C-u C-u C-u C-u': Use all files and all directories.
You are also prompted for the bookmark file, BOOKMARK-FILE. The
default is `.emacs.bmk' in the current directory, but you can enter
any file name, anywhere.
The marked-file bookmarks are added to file BOOKMARK-FILE, but this
command does not make BOOKMARK-FILE the current bookmark file. To
make it current, just jump to the bookmark-file bookmark created by
this command. That bookmark (which bookmarks BOOKMARK-FILE) is
defined in that current bookmark file.
Example:
Bookmark file `~/.emacs.bmk' is current before invoking this command.
The current (Dired) directory is `/foo/bar'.
The marked files are bookmarked in the (possibly new) bookmark file
`/foo/bar/.emacs.bmk'.
The bookmarks for the marked files have names prefixed by `FOOBAR '.
The name of the bookmark-file bookmark is `Foobar Files'.
Bookmark `Foobar Files' is itself in bookmark file `~/.emacs.bmk'.
Bookmark file `~/.emacs.bmk' is current after invoking this command.
You are prompted for the name of the bookmark-file bookmark, the
BOOKMARK-FILE for the marked-file bookmarks, and a PREFIX string for
each of the marked-file bookmarks.
See also command `diredp-do-bookmark-in-bookmark-file'."
(interactive (diredp-read-bookmark-file-args))
(unless (require 'bookmark+ nil t) (error "This command requires library `bookmark+.el'"))
(diredp-do-bookmark-in-bookmark-file bookmark-file prefix arg 'CREATE-BOOKMARK-FILE-BOOKMARK))
(defun diredp-do-bookmark-in-bookmark-file (bookmark-file
&optional prefix arg bfile-bookmarkp files)
"Bookmark files in BOOKMARK-FILE and save BOOKMARK-FILE.
The files bookmarked are the marked files, by default.
The bookmarked position is the beginning of the file.
You are prompted for BOOKMARK-FILE. The default is `.emacs.bmk' in
the current directory, but you can enter any file name, anywhere.
You need library `bookmark+.el' to use this command.
The marked files are bookmarked in file BOOKMARK-FILE, but this
command does not make BOOKMARK-FILE the current bookmark file. To
make it current, use `\\[bmkp-switch-bookmark-file]' (`bmkp-switch-bookmark-file').
Each bookmark name is the non-directory portion of the file name,
prefixed by PREFIX if it is non-nil.
Interactively, you are prompted for PREFIX if
`diredp-prompt-for-bookmark-prefix-flag' is non-nil.
Interactively, a prefix argument ARG specifies the files to use
instead of those marked.
An integer means use the next ARG files (previous -ARG, if < 0).
`C-u': Use the current file (whether or not any are marked).
`C-u C-u': Use all files in Dired, except directories.
`C-u C-u C-u': Use all files and directories, except `.' and `..'.
`C-u C-u C-u C-u': Use all files and all directories.
See also command `diredp-set-bookmark-file-bookmark-for-marked'.
Non-interactively:
* Non-nil BFILE-BOOKMARKP means create a bookmark-file bookmark for
BOOKMARK-FILE.
* Non-nil FILES is the list of files to bookmark."
(interactive (diredp-read-bookmark-file-args))
(unless (require 'bookmark+ nil t) (error "This command requires library `bookmark+.el'"))
(let ((bfile-exists-p (file-readable-p bookmark-file)))
(unless bfile-exists-p (bmkp-empty-file bookmark-file))
(unless bmkp-current-bookmark-file (setq bmkp-current-bookmark-file bookmark-default-file))
(let ((old-bmkp-current-bookmark-file bmkp-current-bookmark-file))
(unwind-protect
(progn (bmkp-switch-bookmark-file bookmark-file)
(if files
(dolist (file files) (diredp-bookmark prefix file 'NO-MSG-P))
(dired-map-over-marks-check
(lexical-let ((pref prefix))
#'(lambda () (diredp-bookmark pref nil 'NO-MSG-P)))
arg 'bookmark (diredp-fewer-than-2-files-p arg)))
(bookmark-save)
(unless bfile-exists-p (revert-buffer)))
(unless (bmkp-same-file-p old-bmkp-current-bookmark-file bmkp-current-bookmark-file)
(bmkp-switch-bookmark-file old-bmkp-current-bookmark-file 'NO-MSG))))
(when bfile-bookmarkp (bmkp-set-bookmark-file-bookmark bookmark-file))))
(defun diredp-read-bookmark-file-args ()
"Read args for `diredp-do-bookmark-in-bookmark-file' and similar."
(unless (require 'bookmark+ nil t) (error "This command requires library `bookmark+.el'"))
(diredp-ensure-mode)
(list (let* ((insert-default-directory t)
(bmk-file (expand-file-name
(read-file-name
"Use bookmark file (default is in CURRENT dir): " nil
(if (or (> emacs-major-version 23)
(and (= emacs-major-version 23)
(> emacs-minor-version 1)))
(list ".emacs.bmk"
bookmark-default-file)
".emacs.bmk")))))
bmk-file)
(and diredp-prompt-for-bookmark-prefix-flag
(read-string "Prefix for autofile bookmark names: "))
current-prefix-arg))
(defun dired-buffers-for-dir (dir &optional file)
"Return a list of buffers that dired DIR (top level or in-situ subdir).
If FILE is non-nil, include only those whose wildcard pattern (if any)
matches FILE.
The list is in reverse order of buffer creation, most recent last.
As a side effect, killed dired buffers for DIR are removed from
`dired-buffers'."
(setq dir (file-name-as-directory dir))
(let (result buf)
(dolist (elt dired-buffers)
(setq buf (cdr elt))
(cond ((null (buffer-name buf))
(setq dired-buffers (delq elt dired-buffers)))
((dired-in-this-tree dir (car elt))
(with-current-buffer buf
(and (assoc dir dired-subdir-alist)
(or (null file)
(if (stringp dired-directory)
(let ((wildcards (file-name-nondirectory
(if (consp dired-directory)
(car dired-directory)
dired-directory))))
(or (= 0 (length wildcards))
(string-match (dired-glob-regexp wildcards) file)))
(member (expand-file-name file dir) (cdr dired-directory))))
(setq result (cons buf result)))))))
result))
(when (fboundp 'dired-get-file-for-visit)
(defun diredp-find-a-file (filename &optional wildcards)
"`find-file', but use file on current line as default (`M-n')."
(interactive (diredp-find-a-file-read-args "Find file: " nil))
(find-file filename wildcards))
(defun diredp-find-a-file-other-frame (filename &optional wildcards)
"`find-file-other-frame', but use file under cursor as default (`M-n')."
(interactive (diredp-find-a-file-read-args "Find file: " nil))
(find-file-other-frame filename wildcards))
(defun diredp-find-a-file-other-window (filename &optional wildcards)
"`find-file-other-window', but use file under cursor as default (`M-n')."
(interactive (diredp-find-a-file-read-args "Find file: " nil))
(find-file-other-window filename wildcards))
(defun diredp-find-a-file-read-args (prompt mustmatch)
(list (lexical-let ((find-file-default (abbreviate-file-name (dired-get-file-for-visit))))
(minibuffer-with-setup-hook #'(lambda ()
(setq minibuffer-default find-file-default))
(read-file-name prompt nil default-directory mustmatch)))
t)))
(unless (fboundp 'dired-get-file-for-visit)
(defun dired-get-file-for-visit ()
"Get the current line's file name, with an error if file does not exist."
(interactive)
(let ((raw (dired-get-filename nil t))
file-name)
(unless raw (error "No file on this line"))
(setq file-name (file-name-sans-versions raw t))
(if (file-exists-p file-name)
file-name
(if (file-symlink-p file-name)
(error "File is a symlink to a nonexistent target")
(error "File no longer exists)))))
(defun dired-find-alternate-file ()
"In Dired, visit this file or directory instead of the dired buffer."
(interactive)
(set-buffer-modified-p nil)
(find-alternate-file (dired-get-file-for-visit))))
(defun diredp-find-file-reuse-dir-buffer ()
"Like `dired-find-file', but reuse Dired buffers.
Unlike `dired-find-alternate-file' this does not use
`find-alternate-file' if the target is not a directory."
(interactive)
(set-buffer-modified-p nil)
(let ((file (dired-get-file-for-visit)))
(if (file-directory-p file) (find-alternate-file file) (find-file file))))
(defun diredp-mouse-find-file-reuse-dir-buffer (event)
"Like `diredp-mouse-find-file', but reuse Dired buffers.
Unlike `dired-find-alternate-file' this does not use
`find-alternate-file' if the target is not a directory."
(interactive "e")
(let (file)
(with-current-buffer (window-buffer (posn-window (event-end event)))
(save-excursion (goto-char (posn-point (event-end event)))
(setq file (dired-get-file-for-visit))))
(select-window (posn-window (event-end event)))
(if (file-directory-p file)
(find-alternate-file (file-name-sans-versions file t))
(find-file (file-name-sans-versions file t)))))
(defalias 'toggle-diredp-find-file-reuse-dir 'diredp-toggle-find-file-reuse-dir)
(defun diredp-toggle-find-file-reuse-dir (force-p)
"Toggle whether Dired `find-file' commands reuse directories.
A prefix arg specifies directly whether or not to reuse.
If its numeric value is non-negative then reuse
To set the behavior as a preference (default behavior), put this in
your ~/.emacs, where VALUE is 1 to reuse or -1 to not reuse:
(diredp-toggle-find-file-reuse-dir VALUE)"
(interactive "P")
(if force-p
(if (natnump (prefix-numeric-value force-p))
(diredp-make-find-file-keys-reuse-dirs)
(diredp-make-find-file-keys-not-reuse-dirs))
(if (where-is-internal 'dired-find-file dired-mode-map 'ascii)
(diredp-make-find-file-keys-reuse-dirs)
(diredp-make-find-file-keys-not-reuse-dirs))))
(defun diredp-make-find-file-keys-reuse-dirs ()
"Make find-file keys reuse Dired buffers."
(substitute-key-definition 'dired-find-file 'diredp-find-file-reuse-dir-buffer dired-mode-map)
(substitute-key-definition 'diredp-mouse-find-file
'diredp-mouse-find-file-reuse-dir-buffer dired-mode-map)
(substitute-key-definition 'dired-w32-browser
'dired-w32-browser-reuse-dir-buffer dired-mode-map)
(substitute-key-definition 'dired-mouse-w32-browser
'dired-mouse-w32-browser-reuse-dir-buffer dired-mode-map)
(message "Reusing Dired buffers is now ON"))
(defun diredp-make-find-file-keys-not-reuse-dirs ()
"Make find-file keys not reuse Dired buffers (i.e. act normally)."
(substitute-key-definition 'diredp-find-file-reuse-dir-buffer 'dired-find-file dired-mode-map)
(substitute-key-definition 'diredp-mouse-find-file-reuse-dir-buffer
'diredp-mouse-find-file dired-mode-map)
(substitute-key-definition 'dired-w32-browser-reuse-dir-buffer
'dired-w32-browser dired-mode-map)
(substitute-key-definition 'dired-mouse-w32-browser-reuse-dir-buffer
'dired-mouse-w32-browser dired-mode-map)
(message "Reusing Dired buffers is now OFF"))
(defun diredp-omit-marked ()
"Omit lines of marked files. Return the number of lines omitted."
(interactive)
(let ((old-modified-p (buffer-modified-p))
count)
(when (interactive-p) (message "Omitting marked lines..."))
(setq count (dired-do-kill-lines nil "Omitted %d line%s."))
(set-buffer-modified-p old-modified-p)
count))
(defun diredp-omit-unmarked ()
"Omit lines of unmarked files. Return the number of lines omitted."
(interactive)
(let ((old-modified-p (buffer-modified-p))
count)
(dired-do-toggle)
(message "Omitting unmarked lines...")
(setq count (diredp-omit-marked))
(dired-do-toggle)
(set-buffer-modified-p old-modified-p)
count))
(defun diredp-ediff (file2)
"Compare file at cursor with file FILE2 using `ediff'.
FILE2 defaults to the file at the cursor as well. If you enter just a
directory name for FILE2, then the file at the cursor is compared with
a file of the same name in that directory. FILE2 is the second file
given to `ediff'
Try to guess a useful default value for FILE2, as follows:
* If the mark is active, use the file at mark.
* Else if the file at cursor is a autosave file or a backup file, use
the corresponding base file.
* Else if there is any backup file for the file at point, use the
newest backup file for it.
* Else use the file at point."
(interactive
(progn (require 'ediff)
(list (ediff-read-file-name
(format "Compare %s with" (dired-get-filename t))
(dired-current-directory)
(let* ((file (dired-get-filename))
(file-sans-dir (file-name-nondirectory file))
(file-dir (file-name-directory file))
(file-at-mark (and transient-mark-mode
mark-active
(save-excursion (goto-char (mark t))
(dired-get-filename t t))))
(last-backup (file-newest-backup file)))
(cond
(file-at-mark)
((auto-save-file-name-p file-sans-dir)
(expand-file-name (substring file-sans-dir 1 -1) file-dir))
((backup-file-name-p file-sans-dir)
(expand-file-name (file-name-sans-versions file-sans-dir) file-dir))
(last-backup)
(t file)))))))
(ediff-files (dired-get-filename) file2))
(defun diredp-fewer-than-2-files-p (arg)
"Return non-nil iff fewer than two files are to be treated by dired.
More precisely, return non-nil iff ARG is nil and fewer than two
files are marked, or ARG is -1, 0 or 1."
(if arg
(and (integerp arg) (< (abs arg) 2))
(not (save-excursion
(goto-char (point-min))
(re-search-forward (dired-marker-regexp) nil t 2)))))
(defun dired-do-compress (&optional arg)
"Compress or uncompress marked (or next prefix argument) files.
A prefix argument ARG specifies files to use instead of marked.
An integer means use the next ARG files (previous -ARG, if < 0).
`C-u': Use the current file (whether or not any are marked).
`C-u C-u': Use all files in Dired, except directories.
`C-u C-u C-u': Use all files and directories, except `.' and `..'.
`C-u C-u C-u C-u': Use all files and all directories."
(interactive "P")
(dired-map-over-marks-check #'dired-compress arg 'compress (diredp-fewer-than-2-files-p arg)))
(defun dired-do-byte-compile (&optional arg)
"Byte compile marked (or next prefix argument) Emacs Lisp files.
A prefix argument ARG specifies files to use instead of marked.
An integer means use the next ARG files (previous -ARG, if < 0).
`C-u': Use the current file (whether or not any are marked).
`C-u C-u': Use all files in Dired, except directories.
`C-u C-u C-u': Use all files and directories, except `.' and `..'.
`C-u C-u C-u C-u': Use all files and all directories."
(interactive "P")
(dired-map-over-marks-check #'dired-byte-compile arg 'byte-compile
(diredp-fewer-than-2-files-p arg)))
(defun dired-do-load (&optional arg)
"Load the marked (or next prefix argument) Emacs Lisp files.
A prefix argument ARG specifies files to use instead of marked.
An integer means use the next ARG files (previous -ARG, if < 0).
`C-u': Use the current file (whether or not any are marked).
`C-u C-u': Use all files in Dired, except directories.
`C-u C-u C-u': Use all files and directories, except `.' and `..'.
`C-u C-u C-u C-u': Use all files and all directories."
(interactive "P")
(dired-map-over-marks-check #'dired-load arg 'load (diredp-fewer-than-2-files-p arg)))
(defun diredp-do-grep (command-args)
"Run `grep' on marked (or next prefix arg) files.
A prefix argument behaves according to the ARG argument of
`dired-get-marked-files'. In particular, `C-u C-u' operates on all
files in the Dired buffer."
(interactive (progn (unless (if (< emacs-major-version 22)
grep-command
(and grep-command (or (not grep-use-null-device)
(eq grep-use-null-device t))))
(grep-compute-defaults))
(list (diredp-do-grep-1))))
(grep command-args))
(defun diredp-do-grep-1 (&optional files)
"Helper function for `diredp-do-grep'.
Non-nil optional arg FILES are the files to grep, overriding the files
choice described for `diredp-do-grep'."
(let ((default (and (fboundp 'grep-default-command) (grep-default-command))))
(read-from-minibuffer
"grep <pattern> <files> : "
(let ((up-to-files (concat grep-command " ")))
(cons (concat up-to-files
(mapconcat #'identity
(or files
(mapcar 'shell-quote-argument
(dired-get-marked-files nil current-prefix-arg)))
" "))
(- (length up-to-files) 2)))
nil nil 'grep-history default)))
(when (memq system-type '(windows-nt ms-dos))
(define-derived-mode diredp-w32-drives-mode fundamental-mode "Drives"
"Open Dired for an MS Windows drive (local or remote)."
(setq buffer-read-only t)))
(when (memq system-type '(windows-nt ms-dos))
(defun diredp-w32-list-mapped-drives ()
"List network connection information for shared MS Windows resources.
This just invokes the Windows `NET USE' command."
(interactive)
(shell-command "net use")
(display-buffer "*Shell Command Output*")))
(when (memq system-type '(windows-nt ms-dos))
(defun diredp-w32-drives (&optional other-window-p)
"Visit a list of MS Windows drives for use by Dired.
With a prefix argument use another window for the list.
In the list, use `mouse-2' or `RET' to open Dired for a given drive.
The drives listed are the remote drives currently available, as
determined by the Windows command `NET USE', plus the local drives
specified by option `diredp-w32-local-drives', which you can
customize.
Note: When you are in Dired at the root of a drive (e.g. directory
`c:/'), command `dired-up-directory' invokes this command.
So you can use `\\[dired-up-directory]' to go up to the list of drives."
(interactive "P")
(require 'widget)
(let ((drive (copy-sequence diredp-w32-local-drives))
(inhibit-read-only t))
(with-temp-buffer
(insert (shell-command-to-string "net use"))
(goto-char (point-min))
(while (re-search-forward "[A-Z]: +\\\\\\\\[^ ]+" nil t nil)
(setq drive (cons (split-string (match-string 0)) drive))))
(if other-window-p
(pop-to-buffer "*Windows Drives*")
(switch-to-buffer "*Windows Drives*"))
(erase-buffer)
(widget-minor-mode 1)
(dolist (drv (sort drive (lambda (a b) (string-lessp (car a) (car b)))))
(lexical-let ((drv drv))
(widget-create 'push-button
:notify (lambda (widget &rest ignore) (dired (car drv)))
(concat (car drv) " " (cadr drv))))
(widget-insert "\n"))
(goto-char (point-min))
(diredp-w32-drives-mode))))
(defun diredp-all-files ()
"List of all files shown in current Dired buffer.
Directories are not included."
(let ((pos (make-marker))
(files ())
file)
(save-excursion
(goto-char (point-min)) (beginning-of-line)
(while (not (eobp))
(beginning-of-line)
(while (and (not (eobp)) (dired-between-files)) (forward-line 1))
(save-excursion (forward-line 1) (move-marker pos (1+ (point))))
(setq file (dired-get-filename nil t))
(when file
(setq file (dired-get-filename (dired-in-this-tree file default-directory) t)))
(unless (or (not file) (file-directory-p file)) (push file files))
(goto-char pos))
(move-marker pos nil))
(setq files (sort files (if (and (featurep 'ls-lisp)
(not (symbol-value 'ls-lisp-use-insert-directory-program)))
'ls-lisp-string-lessp
(if case-fold-search
(lambda (s1 s2) (string-lessp (upcase s1) (upcase s2)))
'string-lessp))))))
(defun dired-maybe-insert-subdir (dirname &optional switches no-error-if-not-dir-p)
"Move to Dired subdirectory line or subdirectory listing.
This bounces you back and forth between a subdirectory line and its
inserted listing header line. Using it on a non-directory line in a
subdirectory listing acts the same as using it on the subdirectory
header line.
* If on a subdirectory line, then go to the subdirectory's listing,
creating it if not yet present.
* If on a subdirectory listing header line or a non-directory file in
a subdirectory listing, then go to the line for the subdirectory in
the parent directory listing.
* If on a non-directory file in the top Dired directory listing, do
nothing.
Subdirectories are listed in the same position as for `ls -lR' output.
With a prefix arg, you can edit the `ls' switches used for this
listing. Add `R' to the switches to expand the directory tree under a
subdirectory.
Dired remembers the switches you specify with a prefix arg, so
reverting the buffer does not reset them. However, you might
sometimes need to reset some subdirectory switches after a
`dired-undo'. You can reset all subdirectory switches to the
default value using \\<dired-mode-map>\\[dired-reset-subdir-switches]. See \
Info node
`(emacs)Subdir switches' for more details."
(interactive (list (diredp-this-subdir)
(and current-prefix-arg
(read-string "Switches for listing: "
(or (and (boundp 'dired-subdir-switches)
dired-subdir-switches)
dired-actual-switches)))))
(let ((opoint (point))
(filename dirname))
(cond ((consp filename)
(setq filename (car filename))
(if (assoc filename dired-subdir-alist)
(dired-goto-file filename)
(dired-insert-subdir (substring (file-name-directory filename) 0 -1))))
(t
(setq dirname (file-name-as-directory dirname))
(or (and (not switches) (dired-goto-subdir dirname))
(dired-insert-subdir dirname switches no-error-if-not-dir-p))
(push-mark opoint)
(when (and (get-buffer-window (current-buffer))
(fboundp 'fit-frame-if-one-window))
(fit-frame-if-one-window))))))
(defun diredp-this-subdir ()
"This line's filename, if directory, or `dired-current-directory' list.
If on a directory line, then return the directory name.
Else return a singleton list of a directory name, which is as follows:
If on a subdirectory header line (either of the two lines), then use
that subdirectory name. Else use the parent directory name."
(or (let ((file (dired-get-filename nil t)))
(and file
(file-directory-p file)
(not (member (file-relative-name file (file-name-directory
(directory-file-name file)))
'("." ".." "./" "../")))
file))
(list (dired-current-directory))))
(unless (> emacs-major-version 23)
(defun dired-mark-unmarked-files (regexp msg &optional unflag-p localp)
"Mark unmarked files matching REGEXP, displaying MSG.
REGEXP is matched against the entire file name. When called
interactively, prompt for REGEXP.
With prefix argument, unflag all those files.
Non-interactively:
Returns t if any work was done, nil otherwise.
Optional fourth argument LOCALP is as in `dired-get-filename'."
(interactive
(list (dired-read-regexp "Mark unmarked files matching regexp (default all): ")
nil
current-prefix-arg
nil))
(let ((dired-marker-char (if unflag-p ?\ dired-marker-char)))
(dired-mark-if (and (looking-at " ")
(let ((fn (dired-get-filename localp t)))
(and fn (string-match regexp fn))))
msg))))
(defun dired-do-find-marked-files (&optional arg)
"Find marked files, displaying all of them simultaneously.
With a prefix ARG >= 0, just find files but do not select them.
If no prefix ARG, and variable `pop-up-frames' is non-nil, or
if prefix ARG < 0, then each file is displayed in a separate frame.
Otherwise (no prefix ARG and nil `pop-up-frames'), the current window
is split across all marked files, as evenly as possible. Remaining
lines go to the bottom-most window. The number of files that can be
displayed this way is restricted by the height of the current window
and `window-min-height'.
A prefix argument also behaves according to the ARG argument of
`dired-get-marked-files'. In particular, `C-u C-u' operates on all
files in the Dired buffer.
To keep the Dired buffer displayed, type \\[split-window-vertically] first.
To display just the marked files, type \\[delete-other-windows] first."
(interactive "P")
(dired-simultaneous-find-file (dired-get-marked-files nil arg)
(and arg (prefix-numeric-value arg))))
(defun dired-simultaneous-find-file (file-list option)
"Visit all files in list FILE-LIST and display them simultaneously.
With non-nil OPTION >= 0, the files are found but not selected.
If `pop-up-frames' is non-nil or OPTION < 0, use a separate frame
for each file.
Otherwise, the current window is split across all files in
FILE-LIST, as evenly as possible. Remaining lines go to the
bottom-most window. The number of files that can be displayed
this way is restricted by the height of the current window and
the variable `window-min-height'."
(let (size)
(cond ((and option (natnump option))
(while file-list (find-file-noselect (car file-list)) (pop file-list)))
((or pop-up-frames option)
(while file-list (find-file-other-frame (car file-list)) (pop file-list)))
(t
(setq size (/ (window-height) (length file-list)))
(when (> window-min-height size)
(error "Too many files to visit simultaneously. Try C-u prefix."))
(find-file (car file-list))
(pop file-list)
(while file-list
(select-window (split-window nil size))
(find-file (car file-list))
(pop file-list))))))
(defun dired-do-run-mail ()
"If `dired-bind-vm' is non-nil, call `dired-vm', else call `dired-rmail'."
(interactive)
(unless (y-or-n-p "Read all marked mail folders? ") (error "OK, canceled"))
(if dired-bind-vm
(dired-vm)
(dired-rmail)))
(defun dired-insert-set-properties (beg end)
"Highlight entire dired line upon mouseover.
Add text property `dired-filename' to the file name."
(let ((inhibit-field-text-motion t))
(save-excursion
(goto-char beg)
(while (< (point) end)
(condition-case nil
(when (dired-move-to-filename)
(add-text-properties (line-beginning-position) (line-end-position)
'(mouse-face highlight
help-echo "mouse-2: visit this file in other window"))
(put-text-property (point) (save-excursion (dired-move-to-end-of-filename) (point))
'dired-filename t))
(error nil))
(forward-line 1)))))
(when (< emacs-major-version 21)
(or (fboundp 'old-dired-revert) (fset 'old-dired-revert (symbol-function 'dired-revert)))
(defun dired-revert (&optional arg noconfirm)
(setq mode-line-process nil)
(old-dired-revert arg noconfirm)))
(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.
On MS Windows, if you already at the root directory, invoke
`diredp-w32-drives' to visit a navigable list of Windows drives."
(interactive "P")
(let* ((dir (dired-current-directory))
(up (file-name-directory (directory-file-name dir))))
(or (dired-goto-file (directory-file-name dir))
(and (cdr dired-subdir-alist) (dired-goto-subdir up))
(progn (if other-window (dired-other-window up) (dired up))
(dired-goto-file dir))
(and (memq system-type '(windows-nt ms-dos)) (diredp-w32-drives)))))
(defun dired-get-filename (&optional localp no-error-if-not-filep)
"In Dired, return name of file mentioned on this line.
Value returned normally includes the directory name.
Optional arg LOCALP with value `no-dir' means don't include directory
name in result. A value of `verbatim' means to return the name exactly as
it occurs in the buffer, and a value of t means construct name relative to
`default-directory', which still may contain slashes if in a subdirectory.
Non-nil optional arg NO-ERROR-IF-NOT-FILEP means treat `.' and `..' as
regular filenames and return nil if no filename on this line.
Otherwise, an error occurs in these cases."
(let ((case-fold-search nil)
(already-absolute nil)
file p1 p2)
(save-excursion (when (setq p1 (dired-move-to-filename (not no-error-if-not-filep)))
(setq p2 (dired-move-to-end-of-filename no-error-if-not-filep))))
(when (setq file (and p1 p2 (buffer-substring p1 p2)))
(set-text-properties 0 (length file) nil file)
(while (string-match (if (> emacs-major-version 21)
"\\(?:[^\\]\\|\\`\\)\\(\"\\)"
"\\([^\\]\\|\\`\\)\\(\"\\)")
file)
(setq file (replace-match "\\\"" nil t file 1)))
(when (dired-switches-escape-p dired-actual-switches)
(let ((start 0)
(rep "")
(shift -1))
(when (eq localp 'verbatim) (setq rep "\\\\"
shift +1))
(while (string-match "\\(\\\\\\) " file start)
(setq file (replace-match rep nil t file 1)
start (+ shift (match-end 0))))))
(when (memq system-type '(windows-nt ms-dos))
(save-match-data
(let ((start 0))
(while (string-match "\\\\" file start)
(aset file (match-beginning 0) ?/)
(setq start (match-end 0))))))
(setq file (read (concat "\"" file "\"")))
(when (and (fboundp 'string-to-multibyte)
enable-multibyte-characters (not (multibyte-string-p file)))
(setq file (string-to-multibyte file))))
(and file
(file-name-absolute-p file)
(not (eq (aref file 0) ?~))
(setq already-absolute t))
(cond ((null file) nil)
((eq localp 'verbatim) file)
((and (not no-error-if-not-filep) (member file '("." ".." "./" "../")))
(error "Cannot operate on `.' or `..'"))
((and (eq localp 'no-dir) already-absolute)
(file-name-nondirectory file))
(already-absolute
(let ((handler (find-file-name-handler file nil)))
(if (and handler (not (get handler 'safe-magic)))
(concat "/:" file)
file)))
((eq localp 'no-dir) file)
((equal (dired-current-directory) "/")
(setq file (concat (dired-current-directory localp) file))
(let ((handler (find-file-name-handler file nil)))
(if (and handler (not (get handler 'safe-magic)))
(concat "/:" file)
file)))
(t
(concat (dired-current-directory localp) file)))))
(defun dired-goto-file (file)
"Go to line describing file FILE in this dired buffer."
(interactive
(prog1
(list (expand-file-name (read-file-name "Goto file: " (dired-current-directory))))
(push-mark)))
(setq file (directory-file-name file))
(let ((found nil)
(case-fold-search nil)
dir)
(setq dir (or (file-name-directory file) (error "File name `%s' is not absolute" file)))
(save-excursion
(goto-char (point-min))
(let ((search-string (replace-regexp-in-string "\^m" "\\^m" file nil t))
(here nil))
(setq search-string (replace-regexp-in-string "\\\\" "\\\\" search-string nil t))
(when (and (dired-switches-escape-p dired-actual-switches)
(string-match "[ \t\n]" search-string))
(setq search-string (replace-regexp-in-string " " "\\ " search-string nil t)
search-string (replace-regexp-in-string "\t" "\\t" search-string nil t)
search-string (replace-regexp-in-string "\n" "\\n" search-string nil t)))
(while (and (not (eobp)) (not found) (not (equal here (point))))
(setq here (point))
(if (search-forward (concat " " search-string) nil 'NO-ERROR)
(setq found (dired-move-to-filename))
(forward-line 1)))))
(unless found
(save-excursion
(when (if (string= dir (expand-file-name default-directory))
(goto-char (point-min))
(and (cdr dired-subdir-alist) (dired-goto-subdir dir)))
(let ((base (file-name-nondirectory file))
(boundary (dired-subdir-max))
search-string)
(setq search-string (replace-regexp-in-string "\^m" "\\^m" base nil t)
search-string (replace-regexp-in-string "\\\\" "\\\\" search-string nil t))
(when (and (dired-switches-escape-p dired-actual-switches)
(string-match "[ \t\n]" search-string))
(setq search-string (replace-regexp-in-string " " "\\ " search-string nil t)
search-string (replace-regexp-in-string "\t" "\\t" search-string nil t)
search-string (replace-regexp-in-string "\n" "\\n" search-string nil t)))
(while (and (not found)
(search-forward (concat " " search-string) boundary 'move))
(if (and (dired-get-filename 'no-dir t)
(equal base (directory-file-name (dired-get-filename 'no-dir t))))
(setq found (dired-move-to-filename))
(forward-line 1)))))))
(and found (goto-char found))))
(defun dired-do-flagged-delete (&optional no-msg)
"In Dired, delete the files flagged for deletion.
NOTE: This deletes flagged, not marked, files.
If arg NO-MSG is non-nil, no message is displayed.
User option `dired-recursive-deletes' controls whether deletion of
non-empty directories is allowed."
(interactive)
(unless no-msg
(ding)
(message "NOTE: Deletion of files flagged `%c' (not those marked `%c')"
dired-del-marker dired-marker-char)
)
(let* ((dired-marker-char dired-del-marker)
(regexp (dired-marker-regexp))
(case-fold-search nil))
(if (save-excursion (goto-char (point-min)) (re-search-forward regexp nil t))
(diredp-internal-do-deletions
(dired-map-over-marks (cons (dired-get-filename) (point)) nil)
nil
'USE-TRASH-CAN)
(unless no-msg (message "(No deletions requested.)")))))
(defun dired-do-delete (&optional arg)
"Delete all marked (or next ARG) files.
NOTE: This deletes marked, not flagged, files.
`dired-recursive-deletes' controls whether deletion of
non-empty directories is allowed."
(interactive "P")
(unless arg
(ding)
(message "NOTE: Deletion of files marked `%c' (not those flagged `%c')."
dired-marker-char dired-del-marker))
(diredp-internal-do-deletions
(dired-map-over-marks (cons (dired-get-filename) (point)) arg)
arg
'USE-TRASH-CAN))
(defun diredp-internal-do-deletions (l arg &optional trash)
"`dired-internal-do-deletions', but for any Emacs version."
(if (> emacs-major-version 23)
(dired-internal-do-deletions l arg trash)
(dired-internal-do-deletions l arg)))
(when (> emacs-major-version 22)
(defun dired-pop-to-buffer (buf)
"Pop up buffer BUF in a way suitable for Dired."
(let ((split-window-preferred-function
(lambda (window)
(or (and (let ((split-height-threshold 0)) (window-splittable-p (selected-window)))
(if (fboundp 'split-window-below)
(split-window-below)
(split-window-vertically)))
(split-window-sensibly window))))
pop-up-frames)
(pop-to-buffer (get-buffer-create buf)))
(set-window-start (selected-window) (point-min))
(when dired-shrink-to-fit
(fit-window-to-buffer (get-buffer-window buf) nil 1))))
(defun dired-mark-pop-up (bufname op-symbol files function &rest args)
"Return FUNCTION's result on ARGS after showing which files are marked.
Displays the file names in a buffer named BUFNAME
nil gives \" *Marked Files*\".
This uses function `dired-pop-to-buffer' to do that.
FUNCTION should not manipulate files, just read input
(an argument or confirmation).
The window is not shown if there is just one file or
OP-SYMBOL is a member of the list in `dired-no-confirm'.
FILES is the list of marked files. It can also be (t FILENAME)
in the case of one marked file, to distinguish that from using
just the current file."
(or bufname (setq bufname " *Marked Files*"))
(let (result)
(if (or (eq dired-no-confirm t)
(memq op-symbol dired-no-confirm)
(= (length files) 1))
(setq result (apply function args))
(with-current-buffer (get-buffer-create bufname)
(erase-buffer)
(dired-format-columns-of-files (if (eq (car files) t) (cdr files) files))
(remove-text-properties (point-min) (point-max)
'(mouse-face nil help-echo nil)))
(unwind-protect
(save-window-excursion
(let ((special-display-frame-alist (cons '(menu-bar-lines . 0)
special-display-frame-alist))
(default-frame-alist (cons '(menu-bar-lines . 0)
default-frame-alist)))
(dired-pop-to-buffer bufname)
(goto-char (point-min)))
(setq result (apply function args)))
(save-excursion
(condition-case nil
(progn
(select-window (get-buffer-window bufname 0))
(if (one-window-p) (delete-frame) (delete-window)))
(error nil)))
(bury-buffer bufname)))
result))
(defun dired-mark-files-regexp (regexp &optional marker-char)
"Mark all files matching REGEXP for use in later commands.
A prefix argument means to unmark them instead.
`.' and `..' are never marked.
REGEXP is an Emacs regexp, not a shell wildcard. Thus, use `\\.o$' for
object files--just `.o' will mark more than you might think.
REGEXP is added to `regexp-search-ring', for regexp search."
(interactive
(list (dired-read-regexp (concat (if current-prefix-arg "Unmark" "Mark")
" files (regexp): "))
(and current-prefix-arg ?\040)))
(add-to-list 'regexp-search-ring regexp)
(let ((dired-marker-char (or marker-char dired-marker-char)))
(dired-mark-if (and (not (looking-at dired-re-dot))
(not (eolp))
(let ((fn (dired-get-filename t t)))
(and fn (string-match regexp fn))))
"matching file")))
(defun diredp-capitalize (&optional arg)
"Rename all marked (or next ARG) files by capitalizing them.
Makes the first char of the name uppercase and the others lowercase."
(interactive "P")
(dired-rename-non-directory #'capitalize "Rename by capitalizing:" arg))
(defun diredp-delete-this-file ()
"In Dired, delete the file on the cursor line, upon confirmation."
(interactive) (dired-do-delete 1))
(defun diredp-capitalize-this-file ()
"In Dired, rename the file on the cursor line by capitalizing it.
Makes the first char of the name uppercase and the others lowercase."
(interactive) (diredp-capitalize 1))
(defun diredp-downcase-this-file ()
"In Dired, rename the file on the cursor line to lower case."
(interactive) (dired-downcase 1))
(defun diredp-upcase-this-file ()
"In Dired, rename the file on the cursor line to upper case."
(interactive) (dired-upcase 1))
(defun diredp-rename-this-file ()
"In Dired, rename the file on the cursor line."
(interactive)
(let ((use-file-dialog nil)) (dired-do-rename 1)))
(defun diredp-copy-this-file ()
"In Dired, copy the file on the cursor line."
(interactive)
(let ((use-file-dialog nil)) (dired-do-copy 1)))
(defun diredp-relsymlink-this-file ()
"In Dired, make a relative symbolic link to file on cursor line."
(interactive)
(let ((use-file-dialog nil)) (and (fboundp 'dired-do-relsymlink) (dired-do-relsymlink 1))))
(defun diredp-symlink-this-file ()
"In Dired, make a symbolic link to the file on the cursor line."
(interactive)
(let ((use-file-dialog nil)) (dired-do-symlink 1)))
(defun diredp-hardlink-this-file ()
"In Dired, add a name (hard link) to the file on the cursor line."
(interactive)
(let ((use-file-dialog nil)) (dired-do-hardlink 1)))
(defun diredp-print-this-file ()
"In Dired, print the file on the cursor line."
(interactive) (dired-do-print 1))
(defun diredp-grep-this-file ()
"In Dired, grep the file on the cursor line."
(interactive)
(unless (and grep-command (or (< emacs-major-version 22)
(not grep-use-null-device)
(eq grep-use-null-device t)))
(grep-compute-defaults))
(grep (diredp-do-grep-1 (list (dired-get-filename t)))))
(defun diredp-compress-this-file ()
"In Dired, compress or uncompress the file on the cursor line."
(interactive) (dired-do-compress 1))
(defun diredp-shell-command-this-file (command)
"In Dired, run a shell COMMAND on the file on the cursor line."
(interactive
(list (dired-read-shell-command (concat "! on " "%s: ") 1 (list (dired-get-filename t)))))
(dired-do-shell-command command 1))
(defun diredp-bookmark-this-file (&optional prefix)
"In Dired, bookmark the file on the cursor line.
See `diredp-do-bookmark'."
(interactive (progn (diredp-ensure-mode)
(list (and diredp-prompt-for-bookmark-prefix-flag
(read-string "Prefix for bookmark name: ")))))
(diredp-do-bookmark prefix 1))
(defun diredp-tag-this-file (tags &optional prefix)
"In Dired, add some tags to the file on the cursor line.
You need library `bookmark+.el' to use this command."
(interactive (progn (unless (require 'bookmark+ nil t)
(error "This command requires library `bookmark+.el'"))
(diredp-ensure-mode)
(list (bmkp-read-tags-completing)
(and diredp-prompt-for-bookmark-prefix-flag
(read-string "Prefix for bookmark name: ")))))
(diredp-do-tag tags prefix 1))
(defun diredp-untag-this-file (tags &optional prefix arg)
"In Dired, remove some tags from the file on the cursor line.
With a prefix arg, remove all tags from the file.
You need library `bookmark+.el' to use this command."
(interactive (progn (unless (require 'bookmark+ nil t)
(error "This command requires library `bookmark+.el'"))
(diredp-ensure-mode)
(let* ((pref (and diredp-prompt-for-bookmark-prefix-flag
(read-string "Prefix for bookmark name: ")))
(bmk (bmkp-get-autofile-bookmark (dired-get-filename) nil pref))
(btgs (and bmk (bmkp-get-tags bmk))))
(unless btgs (error "File has no tags to remove"))
(list (if current-prefix-arg btgs (bmkp-read-tags-completing btgs))
pref
current-prefix-arg))))
(diredp-do-untag tags prefix 1))
(defun diredp-remove-all-tags-this-file (&optional prefix msgp)
"In Dired, remove all tags from this file.
You need library `bookmark+.el' to use this command."
(interactive (progn (unless (require 'bookmark+ nil t)
(error "This command requires library `bookmark+.el'"))
(diredp-ensure-mode)
(list (and diredp-prompt-for-bookmark-prefix-flag
(read-string "Prefix for bookmark name: "))
'MSG)))
(bookmark-maybe-load-default-file)
(diredp-do-remove-all-tags prefix 1))
(defun diredp-paste-add-tags-this-file (&optional prefix msgp)
"In Dired, add previously copied tags to this file.
See `diredp-paste-add-tags'.
You need library `bookmark+.el' to use this command."
(interactive (progn (unless (require 'bookmark+ nil t)
(error "This command requires library `bookmark+.el'"))
(diredp-ensure-mode)
(list (and diredp-prompt-for-bookmark-prefix-flag
(read-string "Prefix for bookmark name: "))
'MSG)))
(bookmark-maybe-load-default-file)
(diredp-do-paste-add-tags prefix 1))
(defun diredp-paste-replace-tags-this-file (&optional prefix msgp)
"In Dired, replace tags for this file with previously copied tags.
See `diredp-paste-replace-tags'.
You need library `bookmark+.el' to use this command."
(interactive (progn (unless (require 'bookmark+ nil t)
(error "This command requires library `bookmark+.el'"))
(diredp-ensure-mode)
(list (and diredp-prompt-for-bookmark-prefix-flag
(read-string "Prefix for bookmark name: "))
'MSG)))
(bookmark-maybe-load-default-file)
(diredp-do-paste-add-tags prefix 1))
(defun diredp-set-tag-value-this-file (tag value &optional prefix msgp)
"In Dired, Set value of TAG to VALUE for this file.
See `diredp-set-tag-value'.
You need library `bookmark+.el' to use this command."
(interactive (progn (unless (require 'bookmark+ nil t)
(error "This command requires library `bookmark+.el'"))
(diredp-ensure-mode)
(list (bmkp-read-tag-completing)
(read (read-string "Value: "))
(and diredp-prompt-for-bookmark-prefix-flag
(read-string "Prefix for bookmark name: "))
'MSG)))
(bookmark-maybe-load-default-file)
(diredp-do-set-tag-value tag value prefix 1))
(defun diredp-copy-tags-this-file (&optional prefix msgp)
"In Dired, copy the tags from this file, so you can paste them to another.
See `diredp-copy-tags'.
You need library `bookmark+.el' to use this command."
(interactive (progn (unless (require 'bookmark+ nil t)
(error "This command requires library `bookmark+.el'"))
(diredp-ensure-mode)
(list (and diredp-prompt-for-bookmark-prefix-flag
(read-string "Prefix for bookmark name: "))
'MSG)))
(bookmark-maybe-load-default-file)
(let ((bmk (bmkp-get-autofile-bookmark (dired-get-filename) nil prefix)))
(and bmk (bmkp-copy-tags bmk msgp))))
(defun diredp-mouse-copy-tags (event)
"In Dired, copy the tags from this file, so you can paste them to another.
You need library `bookmark+.el' to use this command."
(interactive "e")
(let ((mouse-pos (event-start event))
(dired-no-confirm t)
(prefix (and diredp-prompt-for-bookmark-prefix-flag
(read-string "Prefix for bookmark name: "))))
(select-window (posn-window mouse-pos))
(goto-char (posn-point mouse-pos))
(diredp-copy-tags-this-file prefix 'MSG))
(dired-previous-line 1))
(defun diredp-describe-file (&optional internal-form-p)
"In Dired, describe this file or directory.
You need library `help-fns+.el' to use this command.
If the file has an autofile bookmark and you use library `Bookmark+',
then show also the bookmark information (tags etc.). In this case, a
prefix arg shows the internal form of the bookmark."
(interactive "P")
(unless (fboundp 'describe-file)
(error "This command needs `describe-file' from library `help-fns+.el'"))
(describe-file (dired-get-filename nil t) internal-form-p))
(defun diredp-mouse-describe-file (event &optional internal-form-p)
"Describe the clicked file.
You need library `help-fns+.el' to use this command.
If the file has an autofile bookmark and you use library `Bookmark+',
then show also the bookmark information (tags etc.). In this case, a
prefix arg shows the internal form of the bookmark."
(interactive "e\nP")
(unless (fboundp 'describe-file)
(error "This command needs `describe-file' from library `help-fns+.el'"))
(let (file)
(with-current-buffer (window-buffer (posn-window (event-end event)))
(save-excursion (goto-char (posn-point (event-end event)))
(setq file (dired-get-filename nil t))))
(describe-file file internal-form-p)))
(defun diredp-byte-compile-this-file ()
"In Dired, byte compile the (Lisp source) file on the cursor line."
(interactive) (dired-do-byte-compile 1))
(defun diredp-load-this-file ()
"In Dired, load the file on the cursor line."
(interactive) (dired-do-load 1))
(defun diredp-chmod-this-file ()
"In Dired, change the mode of the file on the cursor line."
(interactive) (dired-do-chmod 1))
(unless (memq system-type '(windows-nt ms-dos))
(defun diredp-chgrp-this-file ()
"In Dired, change the group of the file on the cursor line."
(interactive) (dired-do-chgrp 1)))
(unless (memq system-type '(windows-nt ms-dos))
(defun diredp-chown-this-file ()
"In Dired, change the owner of the file on the cursor line."
(interactive) (dired-do-chown 1)))
(when (fboundp 'dired-do-touch)
(defun diredp-touch-this-file ()
"In Dired, `touch' (change the timestamp of) the file on the cursor line."
(interactive) (dired-do-touch 1)))
(defun dired-mark-sexp (predicate &optional unmark-p)
"Mark files for which PREDICATE returns non-nil.
With non-nil prefix arg UNMARK-P, unmark those files instead.
PREDICATE is a lisp sexp that can refer to the following variables:
`mode' [string] file permission bits, e.g. \"-rw-r--r--\"
`nlink' [integer] number of links to file
`size' [integer] file size in bytes
`uid' [string] owner
`gid' [string] group (If the gid is not displayed by `ls',
this will still be set (to the same as uid))
`time' [string] the time that `ls' displays, e.g. \"Feb 12 14:17\"
`name' [string] the name of the file
`sym' [string] if file is a symbolic link, the linked-to name,
else \"\"
`inode' [integer] the inode of the file (only for `ls -i' output)
`blks' [integer] the size of the file for `ls -s' output
(ususally in blocks or, with `-k', in Kbytes)
Examples:
Mark zero-length files: `(equal 0 size)'
Mark files last modified on Feb 2: `(string-match \"Feb 2\" time)'
Mark uncompiled Emacs Lisp files (`.el' file without a `.elc' file):
First, dired just the source files: `dired *.el'.
Then, use \\[dired-mark-sexp] with this sexp:
(not (file-exists-p (concat name \"c\")))"
(interactive "xVars: inode,blks,mode,nlink,uid,gid,size,time,name,sym -> \nP")
(message "%s" predicate)
(let ((dired-marker-char (if unmark-p ?\040 dired-marker-char))
(inode nil)
(blks ())
mode nlink uid gid size time name sym)
(dired-mark-if
(save-excursion
(and
(dired-move-to-filename)
(let ((mode-len 10)
(dired-re-inode-size "\\s *\\([0-9]*\\)\\s *\\([0-9]*\\) ?")
pos)
(beginning-of-line)
(forward-char 2)
(when (looking-at dired-re-inode-size)
(goto-char (match-end 0))
(setq inode (string-to-number (buffer-substring (match-beginning 1) (match-end 1)))
blks (string-to-number (buffer-substring (match-beginning 2)
(match-end 2)))))
(setq mode (buffer-substring (point) (+ mode-len (point))))
(forward-char mode-len)
(setq nlink (read (current-buffer)))
(forward-char 1)
(setq uid (buffer-substring (+ (point) 1) (progn (forward-word 1) (point))))
(re-search-forward
(if (< emacs-major-version 20)
"\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct\\|Nov\\|Dec\\)"
dired-move-to-filename-regexp))
(goto-char (match-beginning 1))
(forward-char -1)
(setq size (string-to-number (buffer-substring (save-excursion (backward-word 1)
(setq pos (point)))
(point))))
(goto-char pos)
(backward-word 1)
(setq gid (buffer-substring (save-excursion (forward-word 1) (point)) (point))
time (buffer-substring (match-beginning 1) (1- (dired-move-to-filename)))
name (buffer-substring (point) (or (dired-move-to-end-of-filename t) (point)))
sym (if (looking-at " -> ")
(buffer-substring (progn (forward-char 4) (point))
(line-end-position))
"")))
(eval predicate)))
(format "'%s file" predicate))))
(defun diredp-this-file-marked-p (&optional mark-char)
"Return non-nil if the file on this line is marked.
Optional arg MARK-CHAR is the type of mark to check.
If nil, then if the file has any mark, including `D', it is marked."
(and (dired-get-filename t t)
(save-excursion (beginning-of-line)
(if mark-char
(looking-at (concat "^" (char-to-string mark-char)))
(not (looking-at "^ "))))))
(defun diredp-this-file-unmarked-p (&optional mark-char)
"Return non-nil if the file on this line is unmarked.
Optional arg MARK-CHAR is the type of mark to check.
If nil, then if the file has no mark, including `D', it is unmarked.
If non-nil, then it is unmarked for MARK-CHAR if it has no mark or
it has any mark except MARK-CHAR."
(and (dired-get-filename t t)
(save-excursion (beginning-of-line)
(if mark-char
(not (looking-at (concat "^" (char-to-string mark-char))))
(looking-at "^ ")))))
(defun diredp-mark-region-files (&optional unmark-p)
"Mark all of the files in the current region (if it is active).
With non-nil prefix arg, unmark them instead."
(interactive "P")
(let ((beg (min (point) (mark)))
(end (max (point) (mark)))
(inhibit-field-text-motion t))
(setq beg (save-excursion (goto-char beg) (line-beginning-position))
end (save-excursion (goto-char end) (line-end-position)))
(let ((dired-marker-char (if unmark-p ?\040 dired-marker-char)))
(dired-mark-if (and (<= (point) end) (>= (point) beg) (diredp-this-file-unmarked-p))
"region file"))))
(defun diredp-unmark-region-files (&optional mark-p)
"Unmark all of the files in the current region (if it is active).
With non-nil prefix arg, mark them instead."
(interactive "P")
(let ((beg (min (point) (mark)))
(end (max (point) (mark)))
(inhibit-field-text-motion t))
(setq beg (save-excursion (goto-char beg) (line-beginning-position))
end (save-excursion (goto-char end) (line-end-position)))
(let ((dired-marker-char (if mark-p dired-marker-char ?\040)))
(dired-mark-if (and (<= (point) end) (>= (point) beg) (diredp-this-file-marked-p))
"region file"))))
(defun diredp-flag-region-files-for-deletion ()
"Flag all of the files in the current region (if it is active) for deletion."
(interactive)
(let ((beg (min (point) (mark)))
(end (max (point) (mark)))
(inhibit-field-text-motion t))
(setq beg (save-excursion (goto-char beg) (line-beginning-position))
end (save-excursion (goto-char end) (line-end-position)))
(let ((dired-marker-char dired-del-marker))
(dired-mark-if (and (<= (point) end) (>= (point) beg) (diredp-this-file-unmarked-p ?\D))
"region file"))))
(defun diredp-toggle-marks-in-region (start end)
"Toggle marks in the region."
(interactive "r")
(save-excursion
(save-restriction
(if (not (fboundp 'dired-toggle-marks))
(let ((details-hidden-p (and (boundp 'dired-details-state)
(eq 'hidden dired-details-state))))
(widen)
(when details-hidden-p (dired-details-show))
(goto-char start)
(setq start (line-beginning-position))
(goto-char end)
(setq end (line-end-position))
(narrow-to-region start end)
(dired-do-toggle)
(when details-hidden-p (dired-details-hide)))
(narrow-to-region start end)
(dired-toggle-marks))))
(when (and (get-buffer-window (current-buffer)) (fboundp 'fit-frame-if-one-window))
(fit-frame-if-one-window)))
(defvar diredp-file-line-overlay nil)
(defun diredp-mouse-3-menu (event)
"Dired pop-up `mouse-3' menu, for files in selection or current line."
(interactive "e")
(if (not (and (fboundp 'mouse3-dired-use-menu)
transient-mark-mode mark-active (not (eq (mark) (point)))))
(if (and transient-mark-mode mark-active (not (eq (mark) (point))))
(let ((reg-choice (x-popup-menu
event
(list "Files in Region"
(list ""
'("Mark" . diredp-mark-region-files)
'("Unmark" . diredp-unmark-region-files)
'("Toggle Marked/Unmarked" .
diredp-toggle-marks-in-region)
'("Flag for Deletion" .
diredp-flag-region-files-for-deletion))))))
(when reg-choice (call-interactively reg-choice)))
(let ((mouse-pos (event-start event))
(opoint (point))
(movep nil)
(inhibit-field-text-motion t)
choice bol eol file/dir-name)
(with-current-buffer (window-buffer (posn-window mouse-pos))
(goto-char (posn-point mouse-pos))
(setq bol (line-beginning-position)
eol (line-end-position))
(unwind-protect
(progn
(if diredp-file-line-overlay
(move-overlay diredp-file-line-overlay bol eol (current-buffer))
(setq diredp-file-line-overlay (make-overlay bol eol))
(overlay-put diredp-file-line-overlay 'face 'region))
(setq file/dir-name (and (not (eobp)) (dired-get-filename nil t)))
(when file/dir-name
(sit-for 0)
(let ((map
(easy-menu-create-menu
"This File"
`(
("Bookmark" :visible (featurep 'bookmark+)
["Bookmark..." diredp-bookmark-this-file]
["Tag..." diredp-tag-this-file
:visible (featurep 'bookmark+)]
["Untag..." diredp-untag-this-file
:visible (featurep 'bookmark+)]
["Remove All Tags" diredp-remove-all-tags-this-file
:visible (featurep 'bookmark+)]
["Copy Tags" diredp-copy-tags-this-file
:visible (featurep 'bookmark+)]
["Paste Tags (Add)" diredp-paste-add-tags-this-file
:visible (featurep 'bookmark+)]
["Paste Tags (Replace)" diredp-paste-replace-tags-this-file
:visible (featurep 'bookmark+)]
["Set Tag Value..." diredp-set-tag-value-this-file
:visible (featurep 'bookmark+)]
)
["Describe" diredp-describe-file]
["Mark" dired-mark
:visible (not (eql (dired-file-marker file/dir-name)
dired-marker-char))]
["Unmark" dired-unmark
:visible (dired-file-marker file/dir-name)]
["Flag for Deletion" dired-flag-file-deletion
:visible (not (eql (dired-file-marker file/dir-name)
dired-del-marker))]
["Delete..." diredp-delete-this-file]
"--"
["Open" dired-find-file]
["Open in Other Window" dired-find-file-other-window]
["Open in Other Frame" diredp-find-file-other-frame]
["Open Associated Windows App" dired-w32-browser
:visible (featurep 'w32-browser)]
["Open in Windows Explorer" dired-w32explore
:visible (featurep 'w32-browser)]
["View (Read Only)" dired-view-file]
["--" 'ignore
:visible (or (atom (diredp-this-subdir))
(not (equal (dired-current-directory)
default-directory)))]
["Insert This Subdir"
(lambda () (interactive)
(call-interactively #'dired-maybe-insert-subdir)
(setq movep t))
:visible (and (atom (diredp-this-subdir))
(not (assoc (file-name-as-directory
(diredp-this-subdir))
dired-subdir-alist)))
:enable (atom (diredp-this-subdir))]
["Go To Inserted Subdir"
(lambda () (interactive)
(call-interactively #'dired-maybe-insert-subdir)
(setq movep t))
:visible (and (atom (diredp-this-subdir))
(assoc (file-name-as-directory (diredp-this-subdir))
dired-subdir-alist))
:enable (atom (diredp-this-subdir))
:keys "i"]
["Remove This Inserted Subdir" dired-kill-subdir
:visible (not (equal (dired-current-directory)
default-directory))]
["Dired This Inserted Subdir (Tear Off)"
(lambda () (interactive) (diredp-dired-this-subdir t))
:visible (not (equal (dired-current-directory)
default-directory))]
"--"
["Compare..." diredp-ediff]
["Diff..." dired-diff]
["Diff with Backup" dired-backup-diff]
["Bookmark..." diredp-bookmark-this-file
:visible (not (featurep 'bookmark+))]
"--"
["Copy to..." diredp-copy-this-file]
["Rename to..." diredp-rename-this-file]
["Capitalize" diredp-capitalize-this-file]
["Upcase" diredp-upcase-this-file]
["Downcase" diredp-downcase-this-file]
"--"
["Symlink to (Relative)..." diredp-relsymlink-this-file
:visible (fboundp 'dired-do-relsymlink)]
["Symlink to..." diredp-symlink-this-file]
["Hardlink to..." diredp-hardlink-this-file]
"--"
["Shell Command..." diredp-shell-command-this-file]
["Print..." diredp-print-this-file]
["Grep" diredp-grep-this-file]
["Compress/Uncompress" diredp-compress-this-file]
["Byte-Compile" diredp-byte-compile-this-file]
["Load" diredp-load-this-file]
"--"
["Change Timestamp..." diredp-touch-this-file]
["Change Mode..." diredp-chmod-this-file]
["Change Group..." diredp-chgrp-this-file
:visible (fboundp 'diredp-chgrp-this-file)]
["Change Owner..." diredp-chown-this-file
:visible (fboundp 'diredp-chown-this-file)]))))
(when diredp-file-line-overlay
(delete-overlay diredp-file-line-overlay))
(setq choice (x-popup-menu event map))
(when choice
(call-interactively (lookup-key map (apply 'vector choice)))))))
(unless movep (goto-char opoint))))))
(unless (eq mouse3-dired-function 'mouse3-dired-use-menu)
(funcall #'mouse3-dired-use-menu)
(revert-buffer))
(let ((last-command 'mouse-save-then-kill)) (mouse-save-then-kill event 'IGNORE))))
(when (< emacs-major-version 21)
(defun dired-find-file ()
"In Dired, visit the file or directory named on this line."
(interactive)
(let* ((dgf-result (or (dired-get-filename nil t) (error "No file on this line")))
(file-name (file-name-sans-versions dgf-result t)))
(if (file-exists-p file-name)
(find-file file-name)
(if (file-symlink-p file-name)
(error "File is a symlink to a nonexistent target")
(error "File no longer exists))))))
(defun diredp-find-file-other-frame ()
"In Dired, visit this file or directory in another frame."
(interactive)
(find-file-other-frame (file-name-sans-versions (dired-get-filename nil t) t)))
(defun diredp-mouse-find-file-other-frame (event)
"In Dired, visit file or directory clicked on in another frame."
(interactive "e")
(let ((pop-up-frames t)) (dired-mouse-find-file-other-window event)))
(defun dired-mouse-find-file-other-window (event)
"In Dired, visit the file or directory name you click on."
(interactive "e")
(let (file)
(with-current-buffer (window-buffer (posn-window (event-end event)))
(save-excursion (goto-char (posn-point (event-end event)))
(setq file (dired-get-filename nil t))))
(select-window (posn-window (event-end event)))
(find-file-other-window (file-name-sans-versions file t))))
(defun diredp-mouse-find-file (event)
"Replace dired in its window by this file or directory."
(interactive "e")
(let (file)
(with-current-buffer (window-buffer (posn-window (event-end event)))
(save-excursion (goto-char (posn-point (event-end event)))
(setq file (dired-get-filename nil t))))
(select-window (posn-window (event-end event)))
(find-file (file-name-sans-versions file t))))
(defun diredp-mouse-view-file (event)
"Examine this file in view mode, returning to dired when done.
When file is a directory, show it in this buffer if it is inserted
otherwise, display it in another buffer."
(interactive "e")
(let (file)
(with-current-buffer (window-buffer (posn-window (event-end event)))
(save-excursion (goto-char (posn-point (event-end event)))
(setq file (dired-get-filename nil t))))
(select-window (posn-window (event-end event)))
(if (file-directory-p file)
(or (and (cdr dired-subdir-alist) (dired-goto-subdir file)) (dired file))
(view-file file))))
(defun diredp-mouse-ediff (event)
"Compare this file (pointed by mouse) with file FILE2 using `ediff'.
FILE2 defaults to this file as well. If you enter just a directory
name for FILE2, then this file is compared with a file of the same
name in that directory. FILE2 is the second file given to `ediff'
this file is the first given to it."
(interactive "e")
(require 'ediff)
(let ((mouse-pos (event-start event)))
(select-window (posn-window mouse-pos))
(goto-char (posn-point mouse-pos))
(call-interactively 'diredp-ediff)))
(defun diredp-mouse-diff (event &optional switches)
"Compare this file (pointed by mouse) with file FILE2 using `diff'.
FILE2 defaults to the file at the mark. This file is the first file
given to `diff'. With prefix arg, prompt for second arg SWITCHES,
which are options for `diff'."
(interactive "e")
(let ((default (and (mark t) (save-excursion (goto-char (mark t))
(dired-get-filename t t))))
(mouse-pos (event-start event)))
(require 'diff)
(select-window (posn-window mouse-pos))
(goto-char (posn-point mouse-pos))
(let ((file2 (read-file-name (format "Diff %s with: %s"
(dired-get-filename t)
(if default (concat "(default " default ") ") ""))
(dired-current-directory) default t)))
(setq switches (and current-prefix-arg
(if (fboundp 'icicle-read-string-completing)
(icicle-read-string-completing
"Options for diff: "
(if (stringp diff-switches)
diff-switches
(mapconcat 'identity diff-switches " "))
(lambda (c) (string-match "switches" (symbol-name c))))
(read-string "Options for diff: "
(if (stringp diff-switches)
diff-switches
(mapconcat 'identity diff-switches " "))))))
(diff file2 (dired-get-filename t) switches))))
(defun diredp-mouse-backup-diff (event)
"Diff this file with its backup file or vice versa.
Use the latest backup, if there are several numerical backups.
If this file is a backup, diff it with its original.
The backup file is the first file given to `diff'.
With prefix arg, prompt for SWITCHES which are the options for `diff'."
(interactive "e")
(let ((switches (and current-prefix-arg
(if (fboundp 'icicle-read-string-completing)
(icicle-read-string-completing
"Options for diff: "
(if (stringp diff-switches)
diff-switches
(mapconcat 'identity diff-switches " "))
(lambda (c) (string-match "switches" (symbol-name c))))
(read-string "Options for diff: "
(if (stringp diff-switches)
diff-switches
(mapconcat #'identity diff-switches " "))))))
(mouse-pos (event-start event)))
(select-window (posn-window mouse-pos))
(goto-char (posn-point mouse-pos))
(diff-backup (dired-get-filename) switches)))
(defun diredp-mouse-mark (event)
"In Dired, mark this file.
If on a subdir headerline, mark all its files except `.' and `..'.
Use \\[dired-unmark-all-files] to remove all marks,
and \\[dired-unmark] on a subdir to remove the marks in this subdir."
(interactive "e")
(let ((mouse-pos (event-start event)))
(select-window (posn-window mouse-pos))
(goto-char (posn-point mouse-pos)))
(if (and (cdr dired-subdir-alist) (dired-get-subdir))
(save-excursion (dired-mark-subdir-files))
(let ((buffer-read-only nil))
(dired-repeat-over-lines 1 #'(lambda () (delete-char 1) (insert dired-marker-char)))
(dired-previous-line 1))))
(defun diredp-mouse-unmark (event)
"In Dired, unmark this file.
If looking at a subdir, unmark all its files except `.' and `..'."
(interactive "e")
(let ((mouse-pos (event-start event)))
(select-window (posn-window mouse-pos))
(goto-char (posn-point mouse-pos)))
(let ((dired-marker-char ?\040)) (dired-mark nil))
(dired-previous-line 1))
(defun diredp-mouse-mark/unmark (event)
"Mark/unmark file or directory at mouse EVENT."
(interactive "e")
(let* ((mouse-pos (event-start event))
(inhibit-field-text-motion t)
(file/dir-name (with-current-buffer (window-buffer (posn-window mouse-pos))
(save-excursion
(goto-char (posn-point mouse-pos))
(and (not (eobp)) (dired-get-filename nil t))))))
(and file/dir-name (cond ((dired-file-marker file/dir-name)
(diredp-mouse-unmark event)
(message "Unmarked: %s" file/dir-name))
(t
(diredp-mouse-mark event)
(message "Marked: %s" file/dir-name))))))
(defun diredp-mouse-mark-region-files (event)
"Mark files between point and the mouse."
(interactive "e")
(call-interactively 'mouse-save-then-kill)
(diredp-mark-region-files))
(defun diredp-mouse-mark/unmark-mark-region-files (event)
"Mark/unmark file or mark files in region.
If the file the cursor is on is marked, then mark all files between it
and the line clicked (included).
Otherwise (cursor's file is unmarked):
If the file clicked is marked, then unmark it.
If it is unmarked, then mark it."
(interactive "e")
(let ((mouse-pos (event-start event)))
(if (or (eq (count-lines (point-min) (posn-point mouse-pos))
(count-lines (point-min) (point)))
(equal dired-marker-char (dired-file-marker (dired-get-filename nil t))))
(diredp-mouse-mark/unmark event)
(call-interactively 'mouse-save-then-kill)
(diredp-mark-region-files))))
(defun diredp-mouse-flag-file-deletion (event)
"In Dired, flag this file for deletion.
If on a subdir headerline, mark all its files except `.' and `..'."
(interactive "e")
(let ((mouse-pos (event-start event)))
(select-window (posn-window mouse-pos))
(goto-char (posn-point mouse-pos)))
(let ((dired-marker-char dired-del-marker)) (dired-mark 1))
(dired-previous-line 1))
(defun diredp-mouse-do-copy (event)
"In Dired, copy this file.
This normally preserves the last-modified date when copying."
(interactive "e")
(let ((mouse-pos (event-start event)))
(select-window (posn-window mouse-pos))
(goto-char (posn-point mouse-pos)))
(dired-do-create-files 'copy #'dired-copy-file (if dired-copy-preserve-time "Copy [-p]" "Copy")
1 dired-keep-marker-copy))
(defun diredp-mouse-do-rename (event)
"In Dired, rename this file."
(interactive "e")
(let ((mouse-pos (event-start event)))
(select-window (posn-window mouse-pos))
(goto-char (posn-point mouse-pos)))
(dired-do-create-files 'move #'dired-rename-file "Move" 1 dired-keep-marker-rename "Rename"))
(defun diredp-mouse-upcase (event)
"In Dired, rename this file to upper case."
(interactive "e")
(let ((mouse-pos (event-start event)))
(select-window (posn-window mouse-pos))
(goto-char (posn-point mouse-pos)))
(dired-rename-non-directory #'upcase "Rename to uppercase:" nil))
(defun diredp-mouse-downcase (event)
"In Dired, rename this file to lower case."
(interactive "e")
(let ((mouse-pos (event-start event)))
(select-window (posn-window mouse-pos))
(goto-char (posn-point mouse-pos)))
(dired-rename-non-directory #'downcase "Rename to lowercase:" nil))
(defun diredp-mouse-do-delete (event)
"In Dired, delete this file, upon confirmation."
(interactive "e")
(let ((mouse-pos (event-start event)))
(select-window (posn-window mouse-pos))
(goto-char (posn-point mouse-pos)))
(diredp-internal-do-deletions (dired-map-over-marks (cons (dired-get-filename)
(point)) 1)
1
'USE-TRASH-CAN)
(dired-previous-line 1))
(defun diredp-mouse-do-shell-command (event)
"Run a shell COMMAND on this file.
If there is output, it goes to a separate buffer.
No automatic redisplay of dired buffers is attempted, as there's no
telling what files the command may have changed. Type
\\[dired-do-redisplay] to redisplay.
The shell command has the top level directory as working directory, so
output files usually are created there instead of in a subdir."
(interactive "e")
(lexical-let ((mouse-pos (event-start event))
(command (dired-read-shell-command "! on %s: " nil
(dired-get-marked-files t nil))))
(select-window (posn-window mouse-pos))
(goto-char (posn-point mouse-pos))
(dired-bunch-files (- 10000 (length command))
#'(lambda (&rest files)
(dired-run-shell-command (dired-shell-stuff-it command files t 1)))
nil
(dired-get-marked-files t 1))))
(defun diredp-mouse-do-symlink (event)
"Make symbolic link to this file."
(interactive "e")
(let ((mouse-pos (event-start event)))
(select-window (posn-window mouse-pos))
(goto-char (posn-point mouse-pos)))
(dired-do-create-files 'symlink #'make-symbolic-link "Symlink" 1 dired-keep-marker-symlink))
(defun diredp-mouse-do-hardlink (event)
"Make hard link (alias) to this file."
(interactive "e")
(let ((mouse-pos (event-start event)))
(select-window (posn-window mouse-pos))
(goto-char (posn-point mouse-pos)))
(dired-do-create-files 'hardlink #'add-name-to-file "Hardlink" 1 dired-keep-marker-hardlink))
(defun diredp-mouse-do-print (event)
"Print this file.
Uses the shell command coming from variables `lpr-command' and
`lpr-switches' as default."
(interactive "e")
(let ((mouse-pos (event-start event)))
(select-window (posn-window mouse-pos))
(goto-char (posn-point mouse-pos)))
(let* ((file (dired-get-filename))
(command (dired-mark-read-string "Print %s with: "
(apply 'concat lpr-command " " lpr-switches)
'print 1 (list file))))
(dired-run-shell-command (dired-shell-stuff-it command (list file) nil))))
(defun diredp-mouse-do-grep (event)
"Run grep against this file."
(interactive "e")
(let ((mouse-pos (event-start event)))
(select-window (posn-window mouse-pos))
(goto-char (posn-point mouse-pos)))
(unless grep-command (grep-compute-defaults))
(grep (diredp-do-grep-1 (list (dired-get-filename t)))))
(defun diredp-mouse-do-compress (event)
"Compress or uncompress this file."
(interactive "e")
(let ((mouse-pos (event-start event))
(dired-no-confirm t))
(select-window (posn-window mouse-pos))
(goto-char (posn-point mouse-pos))
(dired-map-over-marks-check #'dired-compress 1 'compress t))
(dired-previous-line 1))
(defun diredp-mouse-do-byte-compile (event)
"Byte compile this file."
(interactive "e")
(let ((mouse-pos (event-start event))
(dired-no-confirm t))
(select-window (posn-window mouse-pos))
(goto-char (posn-point mouse-pos))
(dired-map-over-marks-check #'dired-byte-compile 1 'byte-compile t))
(dired-previous-line 1))
(defun diredp-mouse-do-load (event)
"Load this Emacs Lisp file."
(interactive "e")
(let ((mouse-pos (event-start event))
(dired-no-confirm t))
(select-window (posn-window mouse-pos))
(goto-char (posn-point mouse-pos))
(dired-map-over-marks-check #'dired-load 1 'load t))
(dired-previous-line 1))
(defun diredp-mouse-do-chmod (event)
"Change the mode of this file.
This calls chmod, so symbolic modes like `g+w' are allowed."
(interactive "e")
(let ((mouse-pos (event-start event)))
(select-window (posn-window mouse-pos))
(goto-char (posn-point mouse-pos)))
(dired-do-chxxx "Mode" "chmod" 'chmod 1)
(dired-previous-line 1))
(unless (memq system-type '(windows-nt ms-dos))
(defun diredp-mouse-do-chgrp (event)
"Change the group of this file."
(interactive "e")
(let ((mouse-pos (event-start event)))
(select-window (posn-window mouse-pos))
(goto-char (posn-point mouse-pos)))
(dired-do-chxxx "Group" "chgrp" 'chgrp 1)
(dired-previous-line 1)))
(unless (memq system-type '(windows-nt ms-dos))
(defun diredp-mouse-do-chown (event)
"Change the owner of this file."
(interactive "e")
(let ((mouse-pos (event-start event)))
(select-window (posn-window mouse-pos))
(goto-char (posn-point mouse-pos)))
(dired-do-chxxx "Owner" dired-chown-program 'chown 1)
(dired-previous-line 1)))
(defun diredp-describe-mode (&optional buffer)
"Describe Dired mode, including Dired+ features.
This is `describe-mode' plus a description of Dired+ features.
For just the latter, use \\<dired-mode-map>`\\[diredp-dired-plus-help]'."
(interactive "@")
(unless (derived-mode-p 'dired-mode)
(error "Use `diredp-dired-plus-help' if you want information about Dired+"))
(with-current-buffer (or buffer (current-buffer)) (describe-mode))
(with-current-buffer (get-buffer-create "*Help*")
(save-excursion
(goto-char (point-min))
(diredp-dired-plus-help-link)
(let ((buffer-read-only nil)) (insert "\n"))
(when (re-search-forward "Keybindings:\nkey\\s-+binding\n---\\s-+-------" nil t)
(goto-char (match-beginning 0))
(let ((buffer-read-only nil))
(insert "\f\n")
(diredp-dired-plus-description+links)
(insert "\f\n"))))))
(defun diredp-dired-plus-help ()
"Describe Dired+."
(interactive "@")
(with-output-to-temp-buffer "*Help*" (diredp-dired-plus-description+links)))
(defun diredp-dired-plus-description+links ()
"Insert Dired+ help text in `*Help*'."
(with-current-buffer (get-buffer-create "*Help*")
(let ((buffer-read-only nil))
(save-restriction
(narrow-to-region (point) (point))
(diredp-dired-plus-help-link)
(insert (diredp-dired-plus-description))
(goto-char (point-max))
(insert "\n")
(diredp-dired-plus-help-link)))))
(when (and (> emacs-major-version 21)
(require 'help-mode nil t) (get 'help-xref 'button-category-symbol))
(define-button-type 'diredp-help-button
:supertype 'help-xref
'help-function #'(lambda () (browse-url "http://www.emacswiki.org/cgi-bin/wiki/DiredPlus"))
'help-echo
(purecopy "mouse-2, RET: Dired+ documentation on the Emacs Wiki (requires \
Internet access)")))
(defun diredp-dired-plus-help-link ()
"Add Web link for Dired+ help, and reminder about sending bug report."
(when (and (> emacs-major-version 21)
(require 'help-mode nil t) (fboundp 'help-insert-xref-button))
(let ((buffer-read-only nil))
(help-insert-xref-button "[Dired+ Help on the Web]" 'diredp-help-button)
(insert (substitute-command-keys
"\t\tSend a Dired+ bug report:\n\t\t\t\t\t`\\[diredp-send-bug-report]'\n")))))
(defun diredp-dired-plus-description ()
"Dired+ description."
(substitute-command-keys
(concat
"\\<dired-mode-map>\
Dired+ Features
---------------
Most keys listed here are in addition to those for vanilla Dired.
Menus
-----
Many Dired+ actions are available from the menu-bar menus and the
`mouse-3' context menu. This may include commands shown here as not
being bound to keys (i.e., listed as `M-x ...').
General
-------
* \\[diredp-toggle-find-file-reuse-dir]\t- Toggle reuse of directories
"
(and (fboundp 'diredp-w32-drives)
"* \\[diredp-w32-drives]\t\t- Go up to a list of MS Windows drives
")
"
* \\[diredp-marked-other-window]\t\t\t\t- Open Dired on marked
* \\[diredp-fileset]\t\t- Open Dired on files in a fileset
* \\[diredp-dired-for-files]\t- Open Dired on specific files
* \\[diredp-dired-union]\t- Create union of some Dired buffers
* \\[diredp-dired-inserted-subdirs]\t- Dired each inserted subdir
Mouse
-----
* \\[diredp-mouse-3-menu]\t- Context-sensitive menu
"
(and (where-is-internal 'diredp-mouse-describe-file dired-mode-map)
"* \\[diredp-mouse-describe-file]\t- Describe this
")
"* \\[diredp-mouse-mark-region-files]\t\t- Mark all in region
"
(and (where-is-internal 'diredp-mouse-find-file dired-mode-map)
"* \\[diredp-mouse-find-file]\t- Open in this window
")
(and (where-is-internal 'diredp-mouse-find-file-reuse-dir-buffer dired-mode-map)
"* \\[diredp-mouse-find-file-reuse-dir-buffer]\t- Open in this window
")
(and (where-is-internal 'dired-mouse-find-file-other-window dired-mode-map)
"* \\[dired-mouse-find-file-other-window]\t\t- Open in another window
")
"* \\[diredp-mouse-find-file-other-frame]\t\t- Open in another frame
"
(and (fboundp 'dired-mouse-w32-browser)
(where-is-internal 'dired-mouse-w32-browser dired-mode-map)
"* \\[dired-mouse-w32-browser]\t- MS Windows `Open' action
")
(and (fboundp 'dired-mouse-w32-browser-reuse-dir-buffer)
(where-is-internal 'dired-mouse-w32-browser-reuse-dir-buffer dired-mode-map)
"* \\[dired-mouse-w32-browser-reuse-dir-buffer]\t- MS Windows `Open' action
")
"
Marking
-------
* \\[dired-mark]\t\t- Mark this
* \\[dired-unmark]\t\t- Unmark this
* \\[dired-do-toggle]\t- Toggle marked/unmarked
* \\[dired-mark-sexp]\t\t- Mark all satisfying a predicate
* \\[dired-unmark-all-marks]\t\t- Unmark all
* \\[diredp-mark/unmark-extension]\t\t- Mark/unmark all that have a given extension
* \\[diredp-mark-files-tagged-regexp]\t\t- Mark those with a tag that matches a regexp
* \\[diredp-unmark-files-tagged-regexp]\t\t- Unmark those with a tag that matches a regexp
* \\[diredp-mark-files-tagged-all]\t\t- Mark those with all of the given tags
* \\[diredp-unmark-files-tagged-all]\t\t- Unmark those with all of the given tags
* \\[diredp-mark-files-tagged-some]\t\t- Mark those with some of the given tags
* \\[diredp-unmark-files-tagged-some]\t\t- Unmark those with some of the given tags
* \\[diredp-mark-files-tagged-not-all]\t- Mark those without some of the given tags
* \\[diredp-unmark-files-tagged-not-all]\t- Unmark those without some of the given tags
* \\[diredp-mark-files-tagged-none]\t- Mark those with none of the given tags
* \\[diredp-unmark-files-tagged-none]\t- Unmark those with none of the given tags
"
"
Current file/subdir (current line)
----------------------------------
* \\[diredp-describe-file]\t- Describe
* \\[diredp-byte-compile-this-file]\t\t- Byte-compile
* \\[diredp-compress-this-file]\t\t- Compress/uncompress
* \\[diredp-print-this-file]\t\t- Print
* \\[diredp-relsymlink-this-file]\t\t- Create relative symlink
* \\[diredp-delete-this-file]\t\t- Delete (with confirmation)
* \\[diredp-rename-this-file]\t\t- Rename
* \\[diredp-capitalize-this-file]\t\t- Capitalize (rename)
* \\[diredp-upcase-this-file]\t\t- Rename to uppercase
* \\[diredp-downcase-this-file]\t\t- Rename to lowercase
* \\[diredp-ediff]\t\t- Ediff
"
(and (fboundp 'diredp-tag-this-file)
"* \\[diredp-tag-this-file]\t\t- Add some tags to this
* \\[diredp-untag-this-file]\t\t- Remove some tags from this
* \\[diredp-remove-all-tags-this-file]\t\t- Remove all tags from this
* \\[diredp-copy-tags-this-file]\t\t- Copy the tags from this
* \\[diredp-paste-add-tags-this-file]\t\t- Paste (add) copied tags to this
* \\[diredp-paste-replace-tags-this-file]\t\t- Paste (replace) tags for this
* \\[diredp-set-tag-value-this-file]\t\t- Set a tag value for this
")
(and (fboundp 'diredp-bookmark-this-file)
"* \\[diredp-bookmark-this-file]\t\t- Bookmark
")
(and (fboundp 'dired-mouse-w32-browser)
(where-is-internal 'dired-mouse-w32-browser dired-mode-map)
"* \\[dired-mouse-w32-browser]\t- MS Windows `Open' action
* \\[dired-w32explore]\t- MS Windows Explorer
")
(and (fboundp 'dired-mouse-w32-browser-reuse-dir-buffer)
(where-is-internal 'dired-mouse-w32-browser-reuse-dir-buffer dired-mode-map)
"* \\[dired-mouse-w32-browser-reuse-dir-buffer]\t- MS Windows `Open' action
* \\[dired-w32explore]\t- MS Windows Explorer
")
"
Marked (or next prefix arg) files & subdirs here
------------------------------------------------
* \\[diredp-insert-subdirs]\t\t- Insert marked subdirectories
* \\[dired-copy-filename-as-kill]\t\t- Copy names for pasting
* \\[dired-do-find-marked-files]\t\t- Visit
* \\[dired-do-copy]\t\t- Copy
* \\[dired-do-rename]\t\t- Rename/move
* \\[diredp-do-grep]\t\t- Run `grep'
* \\[dired-do-search]\t\t- Search
"
(if (fboundp 'dired-do-query-replace-regexp)
"* \\[dired-do-query-replace-regexp]\t\t- Query-replace
"
"* \\[dired-do-query-replace]\t\t- Query-replace
")
(and (fboundp 'dired-do-isearch)
"* \\[dired-do-isearch]\t- Isearch
* \\[dired-do-isearch-regexp]\t- Regexp isearch
")
"* \\[dired-do-shell-command]\t\t- Run shell command
* \\[diredp-marked-other-window]\t\t- Dired
* \\[dired-do-compress]\t\t- Compress
* \\[dired-do-byte-compile]\t\t- Byte-compile
* \\[dired-do-load]\t\t- Load (Emacs Lisp)
* \\[diredp-omit-marked]\t- Omit
* \\[diredp-omit-unmarked]\t- Omit unmarked
"
(and (fboundp 'diredp-do-tag)
"
* \\[diredp-do-tag]\t\t- Add some tags to marked
* \\[diredp-do-untag]\t\t- Remove some tags from marked
* \\[diredp-do-remove-all-tags]\t\t- Remove all tags from marked
* \\[diredp-do-paste-add-tags]\t- Paste (add) copied tags to marked
* \\[diredp-do-paste-replace-tags]\t\t- Paste (replace) tags for marked
* \\[diredp-do-set-tag-value]\t\t- Set a tag value for marked
* \\[diredp-mark-files-tagged-regexp]\t\t- Mark those with a tag that matches a regexp
* \\[diredp-mark-files-tagged-all]\t\t- Mark those with all of the given tags
* \\[diredp-mark-files-tagged-some]\t\t- Mark those with some of the given tags
* \\[diredp-mark-files-tagged-not-all]\t- Mark those without some of the given tags
* \\[diredp-mark-files-tagged-none]\t- Mark those with none of the given tags
* \\[diredp-unmark-files-tagged-regexp]\t\t- Unmark those with a tag that matches a regexp
* \\[diredp-unmark-files-tagged-all]\t\t- Unmark those with all of the given tags
* \\[diredp-unmark-files-tagged-some]\t\t- Unmark those with some of the given tags
* \\[diredp-unmark-files-tagged-not-all]\t- Unmark those without some of the given tags
* \\[diredp-unmark-files-tagged-none]\t- Unmark those with none of the given tags
")
(and (fboundp 'diredp-do-bookmark)
"
* \\[diredp-do-bookmark]\t\t- Bookmark
* \\[diredp-set-bookmark-file-bookmark-for-marked]\t\t- \
Bookmark and create bookmark-file bookmark
* \\[diredp-do-bookmark-in-bookmark-file]\t- Bookmark in specific bookmark file
")
(and (fboundp 'dired-multiple-w32-browser)
"
* \\[dired-multiple-w32-browser]\t- MS Windows `Open' action
")
"
Marked files here and below (in marked subdirs)
-----------------------------------------------
* \\[diredp-insert-subdirs-recursive]\t\t- Insert marked subdirectories
* \\[diredp-copy-filename-as-kill-recursive]\t\t- Copy names for pasting
* \\[diredp-do-find-marked-files-recursive]\t\t\t- Visit
* \\[diredp-do-copy-recursive]\t\t\t- Copy
* \\[diredp-do-move-recursive]\t\t\t- Move
* \\[diredp-do-grep-recursive]\t\t- `grep'
* \\[diredp-do-search-recursive]\t\t\t- Search
* \\[diredp-do-query-replace-regexp-recursive]\t\t\t- Query-replace
* \\[diredp-do-isearch-recursive]\t\t- Isearch
* \\[diredp-do-isearch-regexp-recursive]\t- Regexp isearch
* \\[diredp-do-shell-command-recursive]\t\t\t- Run shell command
* \\[diredp-marked-recursive-other-window]\t\t- Dired
* \\[diredp-list-marked-recursive]\t\t\t- List
* \\[diredp-do-bookmark-recursive]\t\t- Bookmark
* \\[diredp-do-bookmark-in-bookmark-file-recursive]\t\t- Bookmark in bookmark file
* \\[diredp-set-bookmark-file-bookmark-for-marked-recursive]\t\t- Create bookmark-file bookmark
"
(and (fboundp 'dired-multiple-w32-browser)
"
* \\[diredp-multiple-w32-browser-recursive]\t- MS Windows `Open'
")
(and (fboundp 'diredp-tag-this-file)
"
Tagging
-------
* \\[diredp-tag-this-file]\t\t- Add some tags to this
* \\[diredp-untag-this-file]\t\t- Remove some tags from this
* \\[diredp-remove-all-tags-this-file]\t\t- Remove all tags from this
* \\[diredp-copy-tags-this-file]\t\t- Copy the tags from this
* \\[diredp-paste-add-tags-this-file]\t\t- Paste (add) copied tags to this
* \\[diredp-paste-replace-tags-this-file]\t\t- Paste (replace) tags for this
* \\[diredp-set-tag-value-this-file]\t\t- Set a tag value for this
* \\[diredp-do-tag]\t\t- Add some tags to marked
* \\[diredp-do-untag]\t\t- Remove some tags from marked
* \\[diredp-do-remove-all-tags]\t\t- Remove all tags from marked
* \\[diredp-do-paste-add-tags]\t- Paste (add) copied tags to marked
* \\[diredp-do-paste-replace-tags]\t\t- Paste (replace) tags for marked
* \\[diredp-do-set-tag-value]\t\t- Set a tag value for marked
* \\[diredp-mark-files-tagged-regexp]\t\t- Mark those with a tag that matches a regexp
* \\[diredp-mark-files-tagged-all]\t\t- Mark those with all of the given tags
* \\[diredp-mark-files-tagged-some]\t\t- Mark those with some of the given tags
* \\[diredp-mark-files-tagged-not-all]\t- Mark those without some of the given tags
* \\[diredp-mark-files-tagged-none]\t- Mark those with none of the given tags
* \\[diredp-unmark-files-tagged-regexp]\t\t- Unmark those with a tag that matches a regexp
* \\[diredp-unmark-files-tagged-all]\t\t- Unmark those with all of the given tags
* \\[diredp-unmark-files-tagged-some]\t\t- Unmark those with some of the given tags
* \\[diredp-unmark-files-tagged-not-all]\t- Unmark those without some of the given tags
* \\[diredp-unmark-files-tagged-none]\t- Unmark those with none of the given tags
")
(and (fboundp 'diredp-bookmark-this-file)
"
Bookmarking
-----------
* \\[diredp-bookmark-this-file]\t\t- Bookmark this
* \\[diredp-do-bookmark]\t\t- Bookmark marked
* \\[diredp-set-bookmark-file-bookmark-for-marked]\t\t- \
Bookmark marked and create bookmark-file bookmark
* \\[diredp-do-bookmark-in-bookmark-file]\t- Bookmark marked, in specific bookmark file
")
)))
(when (> emacs-major-version 21)
(defun diredp-nb-marked-in-mode-name ()
"Add number of marked and flagged lines to mode name in the mode line.
\(Flagged means flagged for deletion.)
If the current line is marked/flagged and there are others
marked/flagged after it then show `N/M', where N is the number
marked/flagged through the current line and M is the total number
marked/flagged.
Also abbreviate `mode-name', using \"Dired/\" instead of \"Dired by\"."
(let ((mname (format-mode-line mode-name)))
(unless (get-text-property 0 'dired+-mode-name mname)
(save-match-data
(setq mode-name
`(,(propertize (if (string-match "^[dD]ired \\(by \\)?\\(.*\\)" mname)
(format "Dired/%s" (match-string 2 mname))
mname)
'dired+-mode-name t)
(:eval (let* ((dired-marker-char (if (eq ?D dired-marker-char)
?*
dired-marker-char))
(marked-regexp (dired-marker-regexp))
(nb-marked (count-matches marked-regexp
(point-min) (point-max))))
(if (not (> nb-marked 0))
""
(propertize
(format " %s%d%c"
(save-excursion
(forward-line 0)
(if (looking-at (concat marked-regexp ".*"))
(format "%d/" (1+ (count-matches
marked-regexp
(point-min) (point))))
""))
nb-marked dired-marker-char)
'face 'diredp-mode-line-marked 'dired+-mode-name t))))
(:eval (let* ((flagged-regexp (let ((dired-marker-char dired-del-marker))
(dired-marker-regexp)))
(nb-flagged (count-matches flagged-regexp
(point-min) (point-max))))
(if (not (> nb-flagged 0))
""
(propertize
(format " %s%dD"
(save-excursion
(forward-line 0)
(if (looking-at (concat flagged-regexp ".*"))
(format "%d/" (1+ (count-matches
flagged-regexp
(point-min) (point))))
""))
nb-flagged)
'face 'diredp-mode-line-flagged))))))))))
(defface diredp-mode-line-marked
'((((background dark))
(:foreground "#6B6BFFFF2C2C"))
(t (:foreground "DarkViolet")))
"*Face for marked number in mode line `mode-name' for Dired buffers."
:group 'Dired-Plus :group 'font-lock-highlighting-faces)
(defface diredp-mode-line-flagged
'((t (:foreground "Red")))
"*Face for flagged number in mode line `mode-name' for Dired buffers."
:group 'Dired-Plus :group 'font-lock-highlighting-faces)
(add-hook 'dired-after-readin-hook 'diredp-nb-marked-in-mode-name)
(add-hook 'dired-mode-hook 'diredp-nb-marked-in-mode-name))
(defun diredp-send-bug-report ()
"Send a bug report about a Dired+ problem."
(interactive)
(browse-url (format (concat "mailto:" "drew.adams" "@" "oracle" ".com?subject=\
Dired+ bug: \
&body=Describe bug below, using a precise recipe that starts with `emacs -Q' or `emacs -q'. \
File `dired+.el' has a header `Update #' that you can use to identify it.\
%%0A%%0AEmacs version: %s.")
(emacs-version))))
(setq diredp-loaded-p t)