1;;; dired+.el --- Extensions to Dired.
4;; Description: Extensions to Dired.
6;; Maintainer: Drew Adams
7;; Copyright (C) 1999-2008, Drew Adams, all rights reserved.
8;; Created: Fri Mar 19 15:58:58 1999
10;; Last-Updated: Sat Mar 8 09:39:51 2008 (Pacific Standard Time)
13;; URL: http://www.emacswiki.org/cgi-bin/wiki/dired+.el
14;; Keywords: unix, mouse, directories, diredp, dired
15;; Compatibility: GNU Emacs 20.x, GNU Emacs 21.x, GNU Emacs 22.x
17;; Features that might be required by this library:
19;; `cl', `custom', `dired', `dired+', `dired-aux', `dired-x',
20;; `easymenu', `ediff-diff', `ediff-help', `ediff-init',
21;; `ediff-merg', `ediff-mult', `ediff-util', `ediff-wind',
22;; `fit-frame', `info', `info+', `misc-fns', `mkhtml',
23;; `mkhtml-htmlize', `strings', `thingatpt', `thingatpt+',
26;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
32;; This file extends functionalities provided by standard GNU Emacs
33;; files `dired.el', `dired-aux.el', and `dired-x.el'.
35;; Key bindings changed. Menus redefined. `dired-mouse-3-menu'
36;; popup menu added. New commands. Some commands enhanced.
38;; All new functions, variables, and faces defined here have the
39;; prefix `diredp-' (for Dired Plus) in their names.
43;; `diredp-compressed-file-suffix', `diredp-date-time',
44;; `diredp-deletion', `diredp-deletion-file-name',
45;; `diredp-dir-heading', `diredp-dir-priv', `diredp-display-msg',
46;; `diredp-exec-priv', `diredp-executable-tag', `diredp-file-name',
47;; `diredp-file-suffix', `diredp-flag-mark',
48;; `diredp-flag-mark-line', `diredp-ignored-file-name',
49;; `diredp-link-priv', `diredp-no-priv', `diredp-other-priv',
50;; `diredp-rare-priv', `diredp-read-priv', `diredp-symlink',
51;; `diredp-write-priv'.
53;; Commands defined here:
55;; `diredp-byte-compile-this-file', `diredp-capitalize',
56;; `diredp-capitalize-this-file', `diredp-chgrp-this-file',
57;; `diredp-chmod-this-file', `diredp-chown-this-file',
58;; `diredp-compress-this-file', `diredp-copy-this-file',
59;; `diredp-delete-this-file', `diredp-downcase-this-file',
60;; `diredp-ediff', `diredp-find-a-file',
61;; `diredp-find-a-file-other-frame',
62;; `diredp-find-a-file-other-window',
63;; `diredp-find-file-other-frame',
64;; `diredp-find-file-reuse-dir-buffer',
65;; `diredp-flag-region-files-for-deletion',
66;; `diredp-hardlink-this-file', `diredp-load-this-file',
67;; `diredp-mark-region-files', `diredp-mark/unmark-extension',
68;; `diredp-mouse-3-menu', `diredp-mouse-backup-diff',
69;; `diredp-mouse-diff', `diredp-mouse-do-byte-compile',
70;; `diredp-mouse-do-chgrp', `diredp-mouse-do-chmod',
71;; `diredp-mouse-do-chown', `diredp-mouse-do-compress',
72;; `diredp-mouse-do-copy', `diredp-mouse-do-delete',
73;; `diredp-mouse-do-hardlink', `diredp-mouse-do-load',
74;; `diredp-mouse-do-print', `diredp-mouse-do-rename',
75;; `diredp-mouse-do-shell-command', `diredp-mouse-do-symlink',
76;; `diredp-mouse-downcase', `diredp-mouse-ediff',
77;; `diredp-mouse-find-file', `diredp-mouse-find-file-other-frame',
78;; `diredp-mouse-find-file-reuse-dir-buffer',
79;; `diredp-mouse-flag-file-deletion', `diredp-mouse-mark',
80;; `diredp-mouse-mark-region-files', `diredp-mouse-mark/unmark',
81;; `diredp-mouse-unmark', `diredp-mouse-upcase',
82;; `diredp-mouse-view-file', `diredp-omit-marked',
83;; `diredp-omit-unmarked', `diredp-print-this-file',
84;; `diredp-relsymlink-this-file', `diredp-rename-this-file',
85;; `diredp-shell-command-this-file', `diredp-symlink-this-file',
86;; `diredp-toggle-find-file-reuse-dir',
87;; `diredp-unmark-region-files', `diredp-upcase-this-file',
88;; `toggle-dired-find-file-reuse-dir'.
90;; Non-interactive functions defined here:
92;; `diredp-fewer-than-2-files-p', `diredp-find-a-file-read-args',
93;; `diredp-subst-find-alternate-for-find',
94;; `diredp-subst-find-for-find-alternate', `diredp-this-subdir'.
96;; Variables defined here:
98;; `diredp-file-line-overlay', `diredp-font-lock-keywords-1',
99;; `diredp-menu-bar-immediate-menu', `diredp-menu-bar-mark-menu',
100;; `diredp-menu-bar-operate-menu', `diredp-menu-bar-regexp-menu',
101;; `diredp-menu-bar-subdir-menu'.
104;; ***** NOTE: The following functions defined in `dired.el' have
105;; been REDEFINED HERE:
107;; `dired-do-delete' - Display message to warn that marked, not
108;; flagged, files will be deleted.
109;; `dired-do-flagged-delete' - Display message to warn that flagged,
110;; not marked, files will be deleted.
111;; `dired-get-filename' - Test ./ and ../, in addition to . and ...
112;; `dired-goto-file' - Remove / from dir before compare with BASE.
113;; `dired-insert-set-properties' - `mouse-face' on whole line.
114;; `dired-revert' - Resets `mode-line-process' to nil.
117;; ***** NOTE: The following functions defined in `dired-aux.el' have
118;; been REDEFINED HERE:
120;; `dired-do-byte-compile', `dired-do-compress', `dired-do-load' -
121;; Redisplay only if at most one file is being treated.
122;; `dired-maybe-insert-subdir' - Go back to subdir line if in listing.
125;; ***** NOTE: The following functions defined in `dired-x.el' have
126;; been REDEFINED HERE:
128;; `dired-do-find-marked-files' - Doc string reflects the change (see
130;; `dired-simultaneous-find-file'.
132;; `dired-mark-sexp' - 1. Variable `s' -> `blks'.
133;; 2. Fixes to `uid' and `gid'.
134;; `dired-simultaneous-find-file' - Uses separate frames instead of
135;; windows if `pop-up-frames' is non-nil, or if prefix arg < 0.
137;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
142;; dired-maybe-insert-subdir: Fit one-window frame after inserting subdir.
144;; Added: redefinitions of dired-maybe-insert-subdir, dired-goto-file, dired-get-filename.
145;; Added: diredp-this-subdir.
147;; diredp-mouse(-backup)-diff: If available, use icicle-read-string-completing.
149;; Removed second arg to undefine-killer-commands.
151;; diredp-font-lock-keywords-1: Allow also for bz2 compressed files - Thx to Andreas Eder.
153;; diredp-font-lock-keywords-1: Corrected file size and inode number. Thx to Peter Barabas.
155;; Added: diredp-find-a-file*.
157;; diredp-font-lock-keywords-1: Highlight file name (also) of flagged files.
158;; Use dired-del-marker instead of literal D.
159;; Added: diredp-deletion-file-name.
161;; No longer use display-in-minibuffer.
163;; Added: link for sending bug report.
165;; Added defgroup Dired-Plus and used it. Added :link.
167;; Added defvar of directory-listing-before-filename-regexp, for Emacs 22 compatibility.
169;; Added: diredp-mouse-mark/unmark-mark-region-files.
173;; diredp-ignored-file-name: Made it slightly darker.
175;; Renamed all stuff defined here to have diredp- prefix.
176;; diredp-relsymlink-this-file: Protected with fboundp.
177;; Changed to soft require: dired-x.el.
178;; Removed comment to require this inside eval-after-load.
180;; Added: dired-display-msg. Replace blue-foreground-face with it.
181;; Alias dired-do-toggle to dired-toggle-marks, if defined.
183;; Added: dired-get-file-for-visit, dired(-mouse)-find-alternate-file*,
184;; toggle-dired-find-file-reuse-dir, dired+-subst-find-*.
185;; Use defface for all faces. Renamed without "-face". No longer require def-face-const.
186;; dired-simultaneous-find-file: Minor bug fix (typo).
188;; dired-unmark-all-files-no-query -> dired-unmark-all-marks
189;; (thanks to Sivaram Neelakantan for bug report).
191;; string-to-int -> string-to-number everywhere.
193;; Updated to work with Emacs 22.x.
195;; Added dired-mark/unmark-extension. Replaced dired-mark-extension with it everywhere.
197;; Bind [S-mouse-1], instead of [S-down-mouse-1], to dired-mouse-mark-region-files.
199;; dired-mark-sexp: Search for literal month names only for versions before Emacs 20.
200;; Refined to deal with Emacs 21 < 21.3.50 (soon to be 22.x)
202;; Bound dired-no-confirm to non-nil for dired-mouse-*.
203;; Updated for Emacs 21 and improved highlighting:
204;; Spaces OK in file and directory names. Highlight date/time and size.
206;; Require cl only for Emacs 20, and only when compile.
208;; Updated to work with Emacs 21 also.
210;; dired-font-lock-keywords-1: Prefer using dired-omit-extensions
211;; to completion-ignored-extensions, if available.
213;; Added dired-mouse-mark-region-files and dired-mouse-mark/unmark.
215;; 1. dired-font-lock-keywords-1: fixed for spaces in dir names.
216;; 2. Added: dired-buffers-for-dir.
218;; Added S-*-mouse-2 bindings (same as C-*-mouse-2).
220;; 1. Added *-face vars and dired-font-lock-keywords-1.
221;; 2. Added possibility to use dired-font-lock-keywords-1 via hook.
223;; Changed key binding of dired-mouse-find-file from down-mouse-2 to mouse-2.
225;; Changed (C-)(M-)mouse-2 bindings.
227;; 1. Added cmds & menu bar and key bindings: (dired-)find-file-other-frame.
228;; 2. Changed binding for dired-display-file.
230;; 1. Get rid of Edit menu-bar menu.
231;; 2. dired-mouse-3-menu: Changed popup titles and item names.
233;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
235;; This program is free software; you can redistribute it and/or modify
236;; it under the terms of the GNU General Public License as published by
237;; the Free Software Foundation; either version 2, or (at your option)
240;; This program is distributed in the hope that it will be useful,
241;; but WITHOUT ANY WARRANTY; without even the implied warranty of
242;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
243;; GNU General Public License for more details.
245;; You should have received a copy of the GNU General Public License
246;; along with this program; see the file COPYING. If not, write to
247;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
248;; Floor, Boston, MA 02110-1301, USA.
250;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
254(and (< emacs-major-version 21)
255 (eval-when-compile (require 'cl))) ;; pop (plus, for Emacs <20: when, unless)
257(require 'dired) ;; dired-revert
258(require 'dired-aux) ;; dired-bunch-files, dired-do-chxxx, dired-do-create-files,
259 ;; dired-map-over-marks-check, dired-mark-read-string,
260 ;; dired-read-shell-command, dired-run-shell-command, dired-shell-stuff-it
261(require 'ediff-util) ;; ediff-read-file-name
263(require 'dired-x nil t) ;; (no error if not found) dired-do-relsymlink
264(require 'misc-fns nil t) ;; (no error if not found): undefine-killer-commands
265(when (< emacs-major-version 21)
266 (require 'mkhtml nil t)) ;; (no error if not found): mkhtml-dired-files
268;; Don't require Icicles, else get recursive requires.
269;; (require 'icicles nil t) ;; (no error if not found): icicle-read-string-completing
271;;;;;;;;;;;;;;;;;;;;;;;
274(require 'dired+) ; Ensure loaded before compile this.
276;;;;;;;;;;;;;;;;;;;;;;;
280;; `dired-do-toggle' was renamed to `dired-toggle-marks' after Emacs 20.
281(when (fboundp 'dired-toggle-marks) (defalias 'dired-do-toggle 'dired-toggle-marks))
283;;; This is duplicated in `diff.el' and `vc.el'.
284(defcustom diff-switches "-c"
285 "*A string or list of strings specifying switches to be passed to diff."
286 :type '(choice string (repeat string))
287 :group 'dired :group 'diff)
290;; This is also defined in `menu-bar+.el'.
291;; Note: COMMAND must be a command (commandp); it cannot be an expression.
292(defmacro menu-item-any-version (item-string command &rest keywords)
293 "Return valid menu-item spec, whether Emacs 20 or more recent.
294ITEM-STRING and COMMAND are as for `menu-item'.
295KEYWORDS are used only for versions more recent than Emacs 20."
296 (if (or (< emacs-major-version 21) (null keywords))
297 `(cons ,item-string ',command)
298 `'(menu-item ,item-string ,command ,@keywords)))
300;;; This is needed in Emacs versions before Emacs 22
301(defvar directory-listing-before-filename-regexp dired-move-to-filename-regexp
304;;;-----------------------------------------------------------------
309;;; New order is (left -> right):
311;;; Dir Regexp Mark Multiple Single
313;; Get rid of menu bar predefined in `dired.el'.
314(define-key dired-mode-map [menu-bar] nil)
315;; Get rid of Edit menu bar menu to save space.
316(define-key dired-mode-map [menu-bar edit] 'undefined)
321;; REPLACES ORIGINAL "Immediate" menu in `dired.el'.
323(defvar diredp-menu-bar-immediate-menu (make-sparse-keymap "Single"))
324(define-key dired-mode-map [menu-bar immediate]
325 (cons "Single" diredp-menu-bar-immediate-menu))
326(define-key diredp-menu-bar-immediate-menu [chown]
327 (menu-item-any-version "Change Owner..." diredp-chown-this-file
328 :visible (not (memq system-type '(ms-dos windows-nt)))
329 :help "Change the owner of file at cursor"))
330(define-key diredp-menu-bar-immediate-menu [chgrp]
331 (menu-item-any-version "Change Group..." diredp-chgrp-this-file
332 :visible (not (memq system-type '(ms-dos windows-nt)))
333 :help "Change the group of file at cursor"))
334(define-key diredp-menu-bar-immediate-menu [chmod]
335 (menu-item-any-version "Change Mode..." diredp-chmod-this-file
336 :help "Change mode (attributes) of file at cursor"))
337(define-key diredp-menu-bar-immediate-menu [separator-ch] '("--"))
338(define-key diredp-menu-bar-immediate-menu [load]
339 (menu-item-any-version "Load" diredp-load-this-file
340 :help "Load this Emacs Lisp file"))
341(define-key diredp-menu-bar-immediate-menu [compile]
342 (menu-item-any-version "Byte Compile" diredp-byte-compile-this-file
343 :help "Byte-compile this Emacs Lisp file"))
344(define-key diredp-menu-bar-immediate-menu [command]
345 (menu-item-any-version "Shell Command..." diredp-shell-command-this-file
346 :help "Run a shell command on file at cursor"))
347(define-key diredp-menu-bar-immediate-menu [compress]
348 (menu-item-any-version "Compress/Decompress" diredp-compress-this-file
349 :help "Compress/uncompress file at cursor"))
350(define-key diredp-menu-bar-immediate-menu [print]
351 (menu-item-any-version "Print..." diredp-print-this-file
352 :help "Print file at cursor, supplying print command"))
353(when (fboundp 'mkhtml-dired-files)
354 (define-key diredp-menu-bar-immediate-menu [mkhtml-dired-files]
355 (menu-item-any-version "Create HTML" mkhtml-dired-files
356 :help "Create an HTML file corresponding to file at cursor")))
357(define-key diredp-menu-bar-immediate-menu [separator-misc] '("--"))
358(define-key diredp-menu-bar-immediate-menu [hardlink]
359 (menu-item-any-version "Hardlink to..." diredp-hardlink-this-file
360 :help "Make hard links for current or marked files"))
361(if (not (fboundp 'diredp-relsymlink-this-file))
362 (define-key diredp-menu-bar-immediate-menu [symlink]
363 (menu-item-any-version "Symlink to..." diredp-symlink-this-file
364 :visible (fboundp 'make-symbolic-link)
365 :help "Make symbolic link for file at cursor"))
366 (define-key diredp-menu-bar-immediate-menu [symlink]
367 (menu-item-any-version
368 "Symlink to (Absolute)..." diredp-symlink-this-file
369 :help "Make absolute symbolic link for file at cursor"))
370 (define-key diredp-menu-bar-immediate-menu [relsymlink]
371 (menu-item-any-version
372 "Symlink to (Relative)..." diredp-relsymlink-this-file ; In `dired-x.el'.
373 :help "Make relative symbolic link for file at cursor")))
374(define-key diredp-menu-bar-immediate-menu [separator-link] '("--"))
375(define-key diredp-menu-bar-immediate-menu [delete]
376 (menu-item-any-version "Delete" diredp-delete-this-file :help "Delete file at cursor"))
377(define-key diredp-menu-bar-immediate-menu [capitalize]
378 (menu-item-any-version "Capitalize" diredp-capitalize-this-file
379 :help "Capitalize (initial caps) name of file at cursor"))
380(define-key diredp-menu-bar-immediate-menu [downcase]
381 (menu-item-any-version "Downcase" diredp-downcase-this-file
382 ;; When running on plain MS-DOS, there's only one
383 ;; letter-case for file names.
384 :enable (or (not (fboundp 'msdos-long-file-names))
385 (msdos-long-file-names))
386 :help "Rename file at cursor to a lower-case name"))
387(define-key diredp-menu-bar-immediate-menu [upcase]
388 (menu-item-any-version "Upcase" diredp-upcase-this-file
389 :enable (or (not (fboundp 'msdos-long-file-names))
390 (msdos-long-file-names))
391 :help "Rename file at cursor to an upper-case name"))
392(define-key diredp-menu-bar-immediate-menu [rename]
393 (menu-item-any-version "Rename to..." diredp-rename-this-file
394 :help "Rename file at cursor"))
395(define-key diredp-menu-bar-immediate-menu [copy]
396 (menu-item-any-version "Copy to..." diredp-copy-this-file :help "Copy file at cursor"))
397(define-key diredp-menu-bar-immediate-menu [separator-chg] '("--"))
398(define-key diredp-menu-bar-immediate-menu [backup-diff]
399 (menu-item-any-version "Diff with Backup" dired-backup-diff
400 :help "Diff file at cursor with its latest backup"))
401(define-key diredp-menu-bar-immediate-menu [diff]
402 (menu-item-any-version "Diff..." dired-diff
403 :help "Compare file at cursor with another file using `diff'"))
404(define-key diredp-menu-bar-immediate-menu [ediff]
405 (menu-item-any-version "Compare..." diredp-ediff
406 :help "Compare file at cursor with another file"))
407(define-key diredp-menu-bar-immediate-menu [separator-diff] '("--"))
408(define-key diredp-menu-bar-immediate-menu [view]
409 (menu-item-any-version "View (Read Only)" dired-view-file
410 :help "Examine file at cursor in read-only mode"))
411(define-key diredp-menu-bar-immediate-menu [display]
412 (menu-item-any-version "Display in Other Window" dired-display-file
413 :help "Display file at cursor in a different window"))
414(define-key diredp-menu-bar-immediate-menu [find-file-other-frame]
415 (menu-item-any-version "Open in Other Frame" diredp-find-file-other-frame
416 :help "Edit file at cursor in a different frame"))
417(define-key diredp-menu-bar-immediate-menu [find-file-other-window]
418 (menu-item-any-version "Open in Other Window" dired-find-file-other-window
419 :help "Edit file at cursor in a different window"))
420(define-key diredp-menu-bar-immediate-menu [find-file]
421 (menu-item-any-version "Open" dired-find-file :help "Edit file at cursor"))
426;; REPLACES ORIGINAL "Operate" menu in `dired.el'.
428(defvar diredp-menu-bar-operate-menu (make-sparse-keymap "Multiple"))
429(define-key dired-mode-map [menu-bar operate]
430 (cons "Multiple" diredp-menu-bar-operate-menu))
431(define-key diredp-menu-bar-operate-menu [chown]
432 (menu-item-any-version "Change Owner..." dired-do-chown
433 :visible (not (memq system-type '(ms-dos windows-nt)))
434 :help "Change the owner of marked files"))
435(define-key diredp-menu-bar-operate-menu [chgrp]
436 (menu-item-any-version "Change Group..." dired-do-chgrp
437 :visible (not (memq system-type '(ms-dos windows-nt)))
438 :help "Change the owner of marked files"))
439(define-key diredp-menu-bar-operate-menu [chmod]
440 (menu-item-any-version "Change Mode..." dired-do-chmod
441 :help "Change mode (attributes) of marked files"))
442(when (> emacs-major-version 21)
443 (define-key diredp-menu-bar-operate-menu [touch]
444 '(menu-item "Change Timestamp..." dired-do-touch
445 :help "Change timestamp of marked files")))
446(define-key diredp-menu-bar-operate-menu [separator-ch] '("--"))
447(define-key diredp-menu-bar-operate-menu [load]
448 (menu-item-any-version "Load" dired-do-load :help "Load marked Emacs Lisp files"))
449(define-key diredp-menu-bar-operate-menu [compile]
450 (menu-item-any-version "Byte Compile" dired-do-byte-compile
451 :help "Byte-compile marked Emacs Lisp files"))
452(define-key diredp-menu-bar-operate-menu [command]
453 (menu-item-any-version "Shell Command..." dired-do-shell-command
454 :help "Run a shell command on each of marked files"))
455(define-key diredp-menu-bar-operate-menu [compress]
456 (menu-item-any-version "Compress/Uncompress" dired-do-compress
457 :help "Compress/uncompress marked files"))
458(define-key diredp-menu-bar-operate-menu [query-replace]
459 (if (< emacs-major-version 21)
460 (menu-item-any-version "Query Replace..." dired-do-query-replace)
461 (menu-item-any-version "Query Replace..." dired-do-query-replace-regexp
462 :help "Replace regexp in marked files")))
463(define-key diredp-menu-bar-operate-menu [search]
464 (menu-item-any-version "Search Files..." dired-do-search
465 :help "Search marked files for regexp"))
466(define-key diredp-menu-bar-operate-menu [print]
467 (menu-item-any-version "Print..." dired-do-print
468 :help "Print marked files, supplying print command"))
469(when (fboundp 'mkhtml-dired-files)
470 (define-key diredp-menu-bar-operate-menu [mkhtml-dired-files]
471 (menu-item-any-version "Create HTML" mkhtml-dired-files
472 :help "Create HTML files corresponding to marked files")))
473(define-key diredp-menu-bar-operate-menu [separator-link] '("--"))
474(define-key diredp-menu-bar-operate-menu [hardlink]
475 (menu-item-any-version "Hardlink to..." dired-do-hardlink
476 :help "Make hard links for current or marked files"))
477(if (not (fboundp 'dired-do-relsymlink))
478 (define-key diredp-menu-bar-operate-menu [symlink]
479 (menu-item-any-version "Symlink to..." dired-do-symlink
480 :visible (fboundp 'make-symbolic-link)
481 :help "Make symbolic links for current or marked files"))
482 (define-key diredp-menu-bar-operate-menu [symlink]
483 (menu-item-any-version
484 "Symlink to (Absolute)..." dired-do-symlink
485 :help "Make absolute symbolic links for current or marked files"))
486 (define-key diredp-menu-bar-operate-menu [relsymlink] ; In `dired-x.el'.
487 (menu-item-any-version
488 "Symlink to (Relative)..." dired-do-relsymlink
489 :help "Make relative symbolic links for current or marked files")))
490(define-key diredp-menu-bar-operate-menu [separator-move] '("--"))
491(define-key diredp-menu-bar-operate-menu [delete-flagged]
492 (menu-item-any-version "Delete Flagged" dired-do-flagged-delete
493 :help "Delete all files flagged for deletion (D)"))
494(define-key diredp-menu-bar-operate-menu [delete]
495 (menu-item-any-version
496 "Delete Marked (not Flagged)" dired-do-delete
497 :help "Delete current file or all marked files (not flagged files)"))
498(define-key diredp-menu-bar-operate-menu [capitalize]
499 (menu-item-any-version "Capitalize" diredp-capitalize
500 :help "Capitalize (initial caps) the names of all marked files"))
501(define-key diredp-menu-bar-operate-menu [downcase]
502 (menu-item-any-version "Downcase" dired-downcase
503 :enable (or (not (fboundp 'msdos-long-file-names))
504 (msdos-long-file-names))
505 :help "Rename marked files to lowercase names"))
506(define-key diredp-menu-bar-operate-menu [upcase]
507 (menu-item-any-version "Upcase" dired-upcase
508 :enable (or (not (fboundp 'msdos-long-file-names))
509 (msdos-long-file-names))
510 :help "Rename marked files to uppercase names"))
511(define-key diredp-menu-bar-operate-menu [rename]
512 (menu-item-any-version "Rename to..." dired-do-rename
513 :help "Rename current file or move marked files"))
514(define-key diredp-menu-bar-operate-menu [copy]
515 (menu-item-any-version "Copy to..." dired-do-copy
516 :help "Copy current file or all marked files"))
517(define-key diredp-menu-bar-operate-menu [separator-misc] '("--"))
518(when (fboundp 'dired-copy-filename-as-kill)
519 (define-key diredp-menu-bar-operate-menu [kill-ring]
520 (menu-item-any-version
521 "Copy File Names (to Paste)" dired-copy-filename-as-kill
522 :help "Copy names of marked files onto kill ring, for pasting")))
523(when (fboundp 'dired-do-find-marked-files)
524 (define-key diredp-menu-bar-operate-menu [find-files]
525 (menu-item-any-version "Open" dired-do-find-marked-files ; In `dired-x.el'.
526 :help "Open each marked file for editing")))
531;; REPLACES ORIGINAL "Regexp" menu in `dired.el'.
533(defvar diredp-menu-bar-regexp-menu (make-sparse-keymap "Regexp"))
534(define-key dired-mode-map [menu-bar regexp]
535 (cons "Regexp" diredp-menu-bar-regexp-menu))
536(define-key diredp-menu-bar-regexp-menu [hardlink]
537 (menu-item-any-version "Hardlink to..." dired-do-hardlink-regexp
538 :help "Make hard links for files matching regexp"))
539(if (not (fboundp 'dired-do-relsymlink-regexp))
540 (define-key diredp-menu-bar-regexp-menu [symlink]
541 (menu-item-any-version "Symlink to..." dired-do-symlink-regexp
542 :visible (fboundp 'make-symbolic-link)
543 :help "Make symbolic links for files matching regexp"))
544 (define-key diredp-menu-bar-regexp-menu [symlink]
545 (menu-item-any-version
546 "Symlink to (Absolute)..." dired-do-symlink-regexp
547 :visible (fboundp 'make-symbolic-link)
548 :help "Make absolute symbolic links for files matching regexp"))
549 (define-key diredp-menu-bar-regexp-menu [relsymlink] ; In `dired-x.el'.
550 (menu-item-any-version
551 "Symlink to (Relative)..." dired-do-relsymlink-regexp
552 :visible (fboundp 'make-symbolic-link)
553 :help "Make relative symbolic links for files matching regexp")))
554(define-key diredp-menu-bar-regexp-menu [rename]
555 (menu-item-any-version "Rename to..." dired-do-rename-regexp
556 :help "Rename marked files matching regexp"))
557(define-key diredp-menu-bar-regexp-menu [copy]
558 (menu-item-any-version "Copy to..." dired-do-copy-regexp
559 :help "Copy marked files matching regexp"))
560(define-key diredp-menu-bar-regexp-menu [flag]
561 (menu-item-any-version "Flag..." dired-flag-files-regexp
562 :help "Flag files matching regexp for deletion"))
563(define-key diredp-menu-bar-regexp-menu [mark]
564 (menu-item-any-version "Mark..." dired-mark-files-regexp
565 :help "Mark files matching regexp for future operations"))
566(define-key diredp-menu-bar-regexp-menu [mark-cont]
567 (menu-item-any-version "Mark Containing..." dired-mark-files-containing-regexp
568 :help "Mark files whose contents matches regexp"))
573;; REPLACES ORIGINAL "Mark" menu in `dired.el'.
575(defvar diredp-menu-bar-mark-menu (make-sparse-keymap "Mark"))
576(define-key dired-mode-map [menu-bar mark] (cons "Mark" diredp-menu-bar-mark-menu))
578(when (fboundp 'dired-flag-extension)
579 (define-key diredp-menu-bar-mark-menu [flag-extension] ; In `dired-x.el'
580 (menu-item-any-version
581 "Flag Extension..." dired-flag-extension
582 :help "Flag all files that have a certain extension, for deletion")))
583(define-key diredp-menu-bar-mark-menu [garbage-files]
584 (menu-item-any-version "Flag Garbage Files" dired-flag-garbage-files
585 :help "Flag unneeded files for deletion"))
586(define-key diredp-menu-bar-mark-menu [backup-files]
587 (menu-item-any-version "Flag Backup Files" dired-flag-backup-files
588 :help "Flag all backup files for deletion"))
589(define-key diredp-menu-bar-mark-menu [auto-save-files]
590 (menu-item-any-version "Flag Auto-save Files" dired-flag-auto-save-files
591 :help "Flag auto-save files for deletion"))
592(define-key diredp-menu-bar-mark-menu [flag-region]
593 (menu-item-any-version "Flag Region" diredp-flag-region-files-for-deletion
595 :help "Flag all files in the region (selection) for deletion"))
596(when (< emacs-major-version 21)
597 (put 'diredp-flag-region-files-for-deletion 'menu-enable 'mark-active))
598(define-key diredp-menu-bar-mark-menu [deletion]
599 (menu-item-any-version "Flag" dired-flag-file-deletion
600 :help "Flag current line's file for deletion"))
601(define-key diredp-menu-bar-mark-menu [separator-flag] '("--"))
602(define-key diredp-menu-bar-mark-menu [prev]
603 (menu-item-any-version "Previous Marked" dired-prev-marked-file
604 :help "Move to previous marked file"))
605(define-key diredp-menu-bar-mark-menu [next]
606 (menu-item-any-version "Next Marked" dired-next-marked-file
607 :help "Move to next marked file"))
608(define-key diredp-menu-bar-mark-menu [marks]
609 (menu-item-any-version "Change Marks..." dired-change-marks
610 :help "Replace marker with another character"))
611(define-key diredp-menu-bar-mark-menu [revert]
612 (menu-item-any-version "Refresh (Show All)" revert-buffer
613 :help "Update contents of shown directories"))
614(define-key diredp-menu-bar-mark-menu [omit-unmarked]
615 (menu-item-any-version "Omit Unmarked" diredp-omit-unmarked
616 :help "Hide lines of unmarked files"))
617(define-key diredp-menu-bar-mark-menu [omit-marked]
618 (menu-item-any-version "Omit Marked" diredp-omit-marked
619 :help "Hide lines of marked files"))
620(define-key diredp-menu-bar-mark-menu [toggle-marks]
621 (if (> emacs-major-version 21)
622 '(menu-item "Toggle Marked/Unmarked" dired-toggle-marks
623 :help "Mark unmarked files, unmark marked ones")
624 '("Toggle Marked/Unmarked" . dired-do-toggle)))
625(define-key diredp-menu-bar-mark-menu [separator-mark] '("--"))
626(when (fboundp 'dired-mark-sexp)
627 (define-key diredp-menu-bar-mark-menu [mark-sexp] ; In `dired-x.el'.
628 (menu-item-any-version "Mark If..." dired-mark-sexp
629 :help "Mark files for which specified condition is true")))
630(define-key diredp-menu-bar-mark-menu [mark-extension]
631 (menu-item-any-version "Mark Extension..." diredp-mark/unmark-extension
632 :help "Mark all files with specified extension"))
633(define-key diredp-menu-bar-mark-menu [symlinks]
634 (menu-item-any-version "Mark Symlinks" dired-mark-symlinks
635 :visible (fboundp 'make-symbolic-link)
636 :help "Mark all symbolic links"))
637(define-key diredp-menu-bar-mark-menu [directories]
638 (menu-item-any-version "Mark Directories" dired-mark-directories
639 :help "Mark all directories except `.' and `..'"))
640(define-key diredp-menu-bar-mark-menu [directory]
641 (menu-item-any-version "Mark Old Backups" dired-clean-directory
642 :help "Flag old numbered backups for deletion"))
643(define-key diredp-menu-bar-mark-menu [executables]
644 (menu-item-any-version "Mark Executables" dired-mark-executables
645 :help "Mark all executable files"))
646(define-key diredp-menu-bar-mark-menu [mark-region]
647 (menu-item-any-version "Mark Region" diredp-mark-region-files
649 :help "Mark all of the files in the region (selection)"))
650(when (< emacs-major-version 21)
651 (put 'diredp-mark-region-files 'menu-enable 'mark-active))
652(define-key diredp-menu-bar-mark-menu [mark]
653 (menu-item-any-version "Mark" dired-mark
654 :help "Mark current line's file for future operations"))
655(define-key diredp-menu-bar-mark-menu [separator-unmark] '("--"))
656(define-key diredp-menu-bar-mark-menu [unmark-all]
657 (menu-item-any-version "Unmark All" dired-unmark-all-marks
658 :help "Remove all marks from all files"))
659(define-key diredp-menu-bar-mark-menu [unmark-with]
660 (menu-item-any-version "Unmark Marked-With..." dired-unmark-all-files
661 :help "Remove a specific mark (or all marks) from every file"))
662(define-key diredp-menu-bar-mark-menu [unmark-region]
663 (menu-item-any-version "Unmark Region" diredp-unmark-region-files
665 :help "Unmark all files in the region (selection)"))
666(when (< emacs-major-version 21)
667 (put 'diredp-unmark-region-files 'menu-enable 'mark-active))
668(define-key diredp-menu-bar-mark-menu [unmark]
669 (menu-item-any-version "Unmark" dired-unmark
670 :help "Unmark or unflag current line's file"))
675;; REPLACES ORIGINAL "Subdir" menu in `dired.el'.
677(defvar diredp-menu-bar-subdir-menu (make-sparse-keymap "Dir"))
678(define-key dired-mode-map [menu-bar subdir]
679 (cons "Dir" diredp-menu-bar-subdir-menu))
680(define-key diredp-menu-bar-subdir-menu [hide-all]
681 (menu-item-any-version "Hide/Show All" dired-hide-all
682 :help "Hide all subdirectories, leave only header lines"))
683(define-key diredp-menu-bar-subdir-menu [hide-subdir]
684 (menu-item-any-version "Hide/Show Subdir" dired-hide-subdir
685 :help "Hide or unhide current directory listing"))
686(define-key diredp-menu-bar-subdir-menu [tree-down]
687 (menu-item-any-version "Tree Down" dired-tree-down
688 :help "Go to first subdirectory header down the tree"))
689(define-key diredp-menu-bar-subdir-menu [tree-up]
690 (menu-item-any-version "Tree Up" dired-tree-up
691 :help "Go to first subdirectory header up the tree"))
692(define-key diredp-menu-bar-subdir-menu [prev-subdir]
693 (menu-item-any-version "Prev Subdir" dired-prev-subdir
694 :help "Go to previous subdirectory header line"))
695(define-key diredp-menu-bar-subdir-menu [next-subdir]
696 (menu-item-any-version "Next Subdir" dired-next-subdir
697 :help "Go to next subdirectory header line"))
698(define-key diredp-menu-bar-subdir-menu [prev-dirline]
699 (menu-item-any-version "Prev Dirline" dired-prev-dirline
700 :help "Move to previous directory-file line"))
701(define-key diredp-menu-bar-subdir-menu [next-dirline]
702 (menu-item-any-version "Next Dirline" dired-next-dirline
703 :help "Move to next directory-file line"))
704(define-key diredp-menu-bar-subdir-menu [insert]
705 (menu-item-any-version "Subdir Listing" dired-maybe-insert-subdir
706 :help "Move to subdirectory line or listing"))
707(define-key diredp-menu-bar-subdir-menu [separator-subdir] '("--"))
708(define-key diredp-menu-bar-subdir-menu [create-directory]
709 '("Create Directory..." . dired-create-directory)) ; Moved from "Immediate".
710(define-key diredp-menu-bar-subdir-menu [up]
711 (menu-item-any-version "Up Directory" dired-up-directory
712 :help "Edit the parent directory"))
713(when (> emacs-major-version 21)
714 (define-key diredp-menu-bar-subdir-menu [wdired-mode]
715 '(menu-item "Edit File Names" wdired-change-to-wdired-mode)))
716(define-key diredp-menu-bar-subdir-menu [dired]
717 (menu-item-any-version "Dired (Filter via Wildcards)..." dired
718 :help "Explore a directory (you can provide wildcards)"))
721;;; Mouse-3 menu binding.
722(define-key dired-mode-map [mouse-3] 'diredp-mouse-3-menu)
723;;;;;;;;(define-key dired-mode-map [mouse-3] 'ignore)
726;;; Non-menu Dired bindings.
728;; `diredp-mouse-mark-region-files' provides Windows-Explorer behavior
729;; for selecting (marking) files.
730(define-key dired-mode-map [S-down-mouse-1] 'ignore) ; (normally `mouse-set-font')
731(define-key dired-mode-map [S-mouse-1] 'diredp-mouse-mark-region-files)
732(define-key dired-mode-map [mouse-2] 'dired-mouse-find-file-other-window)
733(define-key dired-mode-map [S-down-mouse-2] 'diredp-mouse-find-file)
734(define-key dired-mode-map [S-mouse-2] 'ignore)
735(define-key dired-mode-map [M-mouse-2] 'diredp-mouse-find-file-other-frame)
736(define-key dired-mode-map "\C-\M-o" 'dired-display-file) ; Was C-o.
737(define-key dired-mode-map "\C-o" 'diredp-find-file-other-frame)
738(define-key dired-mode-map "U" 'dired-unmark-all-marks)
739(define-key dired-mode-map "=" 'diredp-ediff)
740(substitute-key-definition 'next-line 'dired-next-line
741 dired-mode-map (current-global-map))
742(substitute-key-definition 'previous-line 'dired-previous-line
743 dired-mode-map (current-global-map))
744;; Commands for operating on the current line's file. When possible,
745;; these are lower-case versions of the upper-case commands for operating on
746;; the marked files. (The other corresponding lower-case letters are already
747;; defined and cannot be used here.)
748(define-key dired-mode-map "b" 'diredp-byte-compile-this-file)
749(define-key dired-mode-map "r" 'diredp-rename-this-file)
750(define-key dired-mode-map "y" 'diredp-relsymlink-this-file)
751(define-key dired-mode-map "z" 'diredp-compress-this-file)
752(define-key dired-mode-map "\r" 'dired-find-file)
753(when (fboundp 'mkhtml-dired-files)
754 (define-key dired-mode-map [?\M-h] 'mkhtml-dired-files))
755(define-key dired-mode-map [?\M-u] 'diredp-upcase-this-file)
756(define-key dired-mode-map [?\M-l] 'diredp-downcase-this-file)
757(define-key dired-mode-map [?\M-c] 'diredp-capitalize-this-file)
758(define-key dired-mode-map [?\M-m] 'diredp-chmod-this-file)
759(define-key dired-mode-map [?\M-p] 'diredp-print-this-file)
760(substitute-key-definition 'kill-line 'diredp-delete-this-file
761 dired-mode-map (current-global-map))
762;; This replaces the `dired-x.el' binding of `dired-mark-extension'.
763(define-key dired-mode-map "*." 'diredp-mark/unmark-extension)
766;; Undefine some bindings that would try to modify a Dired buffer. Their key sequences will
767;; then appear to the user as available for local (Dired) definition.
768(when (fboundp 'undefine-killer-commands) (undefine-killer-commands dired-mode-map))
771(defgroup Dired-Plus nil
772 "Various enhancements to Dired."
773 :prefix "diredp-" :group 'dired
774 :link `(url-link :tag "Send Bug Report"
775 ,(concat "mailto:" "drew.adams" "@" "oracle" ".com?subject=\
777&body=Describe bug here, starting with `emacs -q'. \
778Don't forget to mention your Emacs and library versions."))
779 :link '(url-link :tag "Other Libraries by Drew"
780 "http://www.emacswiki.org/cgi-bin/wiki/DrewsElispLibraries")
781 :link '(url-link :tag "Download"
782 "http://www.emacswiki.org/cgi-bin/wiki/dired+.el")
783 :link '(url-link :tag "Description"
784 "http://www.emacswiki.org/cgi-bin/wiki/DiredPlus")
785 :link '(emacs-commentary-link :tag "Commentary" "dired+")
788;;;-----------------------------------------------------------------
791;;; Miscellaneous faces.
792(defface diredp-display-msg
793'((t (:foreground "Blue")))
794 "*Face used for message display."
796(defvar diredp-display-msg 'diredp-display-msg)
798;;; Faces used to fontify buffer when using second level of fontifying.
799(defface diredp-dir-heading
800 '((t (:foreground "Blue" :background "Pink")))
801 "*Face used for directory headings in dired buffers."
802 :group 'Dired-Plus :group 'font-lock-highlighting-faces)
803(defvar diredp-dir-heading 'diredp-dir-heading)
805(defface diredp-deletion
806 '((t (:foreground "Yellow" :background "Red")))
807 "*Face used for deletion flags (D) in dired buffers."
808 :group 'Dired-Plus :group 'font-lock-highlighting-faces)
809(defvar diredp-deletion 'diredp-deletion)
811(defface diredp-deletion-file-name
812 '((t (:foreground "Red")))
813 "*Face used for names of deleted files in dired buffers."
814 :group 'Dired-Plus :group 'font-lock-highlighting-faces)
815(defvar diredp-deletion-file-name 'diredp-deletion-file-name)
817(defface diredp-flag-mark
818 '((t (:foreground "Yellow" :background "Blueviolet")))
819 "*Face used for flags and marks (except D) in dired buffers."
820 :group 'Dired-Plus :group 'font-lock-highlighting-faces)
821(defvar diredp-flag-mark 'diredp-flag-mark)
823(defface diredp-flag-mark-line
824 '((t (:background "Skyblue")))
825 "*Face used for flagged and marked lines in dired buffers."
826 :group 'Dired-Plus :group 'font-lock-highlighting-faces)
827(defvar diredp-flag-mark-line 'diredp-flag-mark-line)
829(defface diredp-file-suffix
830 '((t (:foreground "DarkMagenta")))
831 "*Face used for file suffixes in dired buffers."
832 :group 'Dired-Plus :group 'font-lock-highlighting-faces)
833(defvar diredp-file-suffix 'diredp-file-suffix)
835(defface diredp-symlink
836 '((t (:foreground "DarkOrange")))
837 "*Face used for symbolic links in dired buffers."
838 :group 'Dired-Plus :group 'font-lock-highlighting-faces)
839(defvar diredp-symlink 'diredp-symlink)
841(defface diredp-date-time
842 '((t (:foreground "DarkGoldenrod4")))
843 "*Face used for date and time in dired buffers."
844 :group 'Dired-Plus :group 'font-lock-highlighting-faces)
845(defvar diredp-date-time 'diredp-date-time)
847(defface diredp-file-name
848 '((t (:foreground "Blue")))
849 "*Face used for file names (without suffixes) in dired buffers."
850 :group 'Dired-Plus :group 'font-lock-highlighting-faces)
851(defvar diredp-file-name 'diredp-file-name)
853(defface diredp-ignored-file-name
854 '((t (:foreground "#00006DE06DE0")))
855 "*Face used for ignored file names in dired buffers."
856 :group 'Dired-Plus :group 'font-lock-highlighting-faces)
857(defvar diredp-ignored-file-name 'diredp-ignored-file-name)
859(defface diredp-compressed-file-suffix
860 '((t (:foreground "Yellow")))
861 "*Face used for compressed file suffixes in dired buffers."
862 :group 'Dired-Plus :group 'font-lock-highlighting-faces)
863(defvar diredp-compressed-file-suffix 'diredp-compressed-file-suffix)
865;; For this to show up, you need `F' among the options in `dired-listing-switches'.
866;; For example, I use "-alF" for `dired-listing-switches'.
867(defface diredp-executable-tag
868 '((t (:foreground "Red")))
869 "*Face used for executable tag (*) on file names in dired buffers."
870 :group 'Dired-Plus :group 'font-lock-highlighting-faces)
871(defvar diredp-executable-tag 'diredp-executable-tag)
873(defface diredp-dir-priv
874 '((t (:foreground "DarkRed" :background "LightGray")))
875 "*Face used for directory privilege indicator (d) in dired buffers."
876 :group 'Dired-Plus :group 'font-lock-highlighting-faces)
877(defvar diredp-dir-priv 'diredp-dir-priv)
879(defface diredp-exec-priv
880 '((t (:background "LightSteelBlue")))
881 "*Face used for execute privilege indicator (x) in dired buffers."
882 :group 'Dired-Plus :group 'font-lock-highlighting-faces)
883(defvar diredp-exec-priv 'diredp-exec-priv)
885(defface diredp-other-priv
886 '((t (:background "PaleGoldenrod")))
887 "*Face used for l,s,S,t,T privilege indicators in dired buffers."
888 :group 'Dired-Plus :group 'font-lock-highlighting-faces)
889(defvar diredp-other-priv 'diredp-other-priv)
891(defface diredp-write-priv
892 '((t (:background "Orchid")))
893 "*Face used for write privilege indicator (w) in dired buffers."
894 :group 'Dired-Plus :group 'font-lock-highlighting-faces)
895(defvar diredp-write-priv 'diredp-write-priv)
897(defface diredp-read-priv
898 '((t (:background "MediumAquamarine")))
899 "*Face used for read privilege indicator (w) in dired buffers."
900 :group 'Dired-Plus :group 'font-lock-highlighting-faces)
901(defvar diredp-read-priv 'diredp-read-priv)
903(defface diredp-no-priv
904 '((t (:background "LightGray")))
905 "*Face used for no privilege indicator (-) in dired buffers."
906 :group 'Dired-Plus :group 'font-lock-highlighting-faces)
907(defvar diredp-no-priv 'diredp-no-priv)
909(defface diredp-rare-priv
910 '((t (:foreground "Magenta" :background "SpringGreen")))
911 "*Face used for rare privilege indicators (b,c,s,m,p,S) in dired buffers."
912 :group 'Dired-Plus :group 'font-lock-highlighting-faces)
913(defvar diredp-rare-priv 'diredp-rare-priv)
915(defface diredp-link-priv
916 '((t (:foreground "DarkOrange")))
917 "*Face used for link privilege indicator (l) in dired buffers."
918 :group 'Dired-Plus :group 'font-lock-highlighting-faces)
919(defvar diredp-link-priv 'diredp-link-priv)
922;;; Define second level of fontifying.
923(defvar diredp-font-lock-keywords-1
925 '("^ \\(.+:\\)$" 1 diredp-dir-heading) ; Directory headers
926 '("[^ .]\\.\\([^. /]+\\)$" 1 diredp-file-suffix) ; Suffix
927 '("\\([^ ]+\\) -> [^ ]+$" 1 diredp-symlink) ; Symbolic links
928 ;; 1) Date/time and 2) filename w/o suffix:
929 (list dired-move-to-filename-regexp '(1 diredp-date-time t t) ; Date/time
930 (list "\\(.+\\)$" nil nil (list 0 diredp-file-name 'keep t))) ; Filename
932 (list (concat "^ \\(.*\\("
933 (concat (mapconcat 'regexp-quote
934 (or (and (boundp 'dired-omit-extensions)
935 dired-omit-extensions)
936 completion-ignored-extensions)
938 "[*]?") ; Allow for executable flag (*).
939 "\\|\\.\\(g?z\\|Z\\)[*]?\\)\\)$") ; Compressed.
940 1 diredp-ignored-file-name t)
941 '("[^ .]\\.\\([bg]?[zZ]2?\\)[*]?$" 1 diredp-compressed-file-suffix t) ; Compressed (*.z)
942 '("\\([*]\\)$" 1 diredp-executable-tag t) ; Executable (*)
943 '(" \\([0-9]+[kKMGTPEZY]?\\)" 1 diredp-file-suffix) ; File size and inode number
945 (list "^..\\([0-9]* \\)*d"
946 (list dired-move-to-filename-regexp nil nil)
947 (list "\\(.+\\)" nil nil '(0 diredp-dir-priv t t)))
948 '("^..\\([0-9]* \\)*.........\\(x\\)" 2 diredp-exec-priv) ;o x
949 '("^..\\([0-9]* \\)*.........\\([lsStT]\\)" 2 diredp-other-priv) ; o misc
950 '("^..\\([0-9]* \\)*........\\(w\\)" 2 diredp-write-priv) ; o w
951 '("^..\\([0-9]* \\)*.......\\(r\\)" 2 diredp-read-priv) ; o r
952 '("^..\\([0-9]* \\)*......\\(x\\)" 2 diredp-exec-priv) ; g x
953 '("^..\\([0-9]* \\)*....[^0-9].\\([lsStT]\\)" 2 diredp-other-priv) ; g misc
954 '("^..\\([0-9]* \\)*.....\\(w\\)" 2 diredp-write-priv) ; g w
955 '("^..\\([0-9]* \\)*....\\(r\\)" 2 diredp-read-priv) ; g r
956 '("^..\\([0-9]* \\)*...\\(x\\)" 2 diredp-exec-priv) ; u x
957 '("^..\\([0-9]* \\)*...\\([lsStT]\\)" 2 diredp-other-priv) ; u misc
958 '("^..\\([0-9]* \\)*..\\(w\\)" 2 diredp-write-priv) ; u w
959 '("^..\\([0-9]* \\)*.\\(r\\)" 2 diredp-read-priv) ; u r
960 '("^..\\([0-9]* \\)*.\\([-rwxlsStT]+\\)" 2 diredp-no-priv keep) ;-
961 '("^..\\([0-9]* \\)*\\([bcsmpS]\\)[-rwxlsStT]" 2 diredp-rare-priv) ; (rare)
962 '("^..\\([0-9]* \\)*\\(l\\)[-rwxlsStT]" 2 diredp-link-priv) ; l
963 (list (concat "^\\([^ " (char-to-string dired-del-marker) "].*$\\)")
964 1 diredp-flag-mark-line t) ; Flag/mark lines
965 (list (concat "^\\([" (char-to-string dired-del-marker) "]\\)") ; Deletion flags (D)
966 '(1 diredp-deletion t)
967 '(".+" (dired-move-to-filename) nil (0 diredp-deletion-file-name t)))
968 (list (concat "^\\([^ " (char-to-string dired-del-marker) "]\\)") ; Flags & marks (except D)
969 1 diredp-flag-mark t)
970 ) "Expressions to highlight in Dired mode.")
973;;; Provide for the second level of fontifying.
974(add-hook 'dired-mode-hook
975 '(lambda () (if (and (boundp 'font-lock-maximum-decoration)
976 font-lock-maximum-decoration)
977 (set (make-local-variable 'font-lock-defaults)
978 '(diredp-font-lock-keywords-1 t)))))
981;;;-----------------------------------------------------------------
982;;; Function Definitions
985;; Similar to `dired-mark-extension' in `dired-x.el'.
986;; The difference is that this uses prefix arg to unmark, not to determine the mark character.
987(defun diredp-mark/unmark-extension (extension &optional unmark-p)
988 "Mark all files with a certain EXTENSION for use in later commands.
989A `.' is not automatically prepended to the string entered.
990Non-nil prefix argument UNMARK-P means unmark instead of mark."
991 ;; EXTENSION may also be a list of extensions instead of a single one.
992 ;; Optional MARKER-CHAR is marker to use.
994 (list (dired-read-regexp (concat (if current-prefix-arg "Unmark" "Mark")
997 (or (listp extension) (setq extension (list extension)))
998 (dired-mark-files-regexp (concat ".";; don't match names with nothing but an extension
1000 (mapconcat 'regexp-quote extension "\\|")
1002 (and current-prefix-arg ?\040)))
1005;; REPLACES ORIGINAL in `dired.el'.
1006;; Allows for consp `dired-directory' too.
1008(defun dired-buffers-for-dir (dir &optional file)
1009 "Return a list of buffers that dired DIR (top level or in-situ subdir).
1010If FILE is non-nil, include only those whose wildcard pattern (if any)
1012The list is in reverse order of buffer creation, most recent last.
1013As a side effect, killed dired buffers for DIR are removed from
1015 (setq dir (file-name-as-directory dir))
1016 (let ((alist dired-buffers) result elt buf pattern)
1018 (setq elt (car alist)
1020 (if (buffer-name buf)
1021 (if (dired-in-this-tree dir (car elt))
1022 (with-current-buffer buf
1023 (and (assoc dir dired-subdir-alist)
1026 ;; Allow for consp `dired-directory' too.
1027 (file-name-nondirectory (if (consp dired-directory)
1028 (car dired-directory)
1030 (or (= 0 (length wildcards))
1031 (string-match (dired-glob-regexp wildcards) file))))
1032 (setq result (cons buf result)))))
1033 ;; else buffer is killed - clean up:
1034 (setq dired-buffers (delq elt dired-buffers)))
1035 (setq alist (cdr alist)))
1039(defun diredp-find-file-other-frame ()
1040 "In dired, visit this file or directory in another frame."
1042 (find-file-other-frame (file-name-sans-versions (dired-get-filename) t)))
1045(defun diredp-mouse-find-file-other-frame (event)
1046 "In dired, visit file or directory clicked on in another frame."
1048 (let ((pop-up-frames t))
1049 (dired-mouse-find-file-other-window event)))
1052;; These functions let you use the file on the current line as the default.
1053;; They are useful only in Emacs 22 or later.
1055;; However, if you use library `files+.el', you need not use these commands explicitly,
1056;; because that library redefines `find-file-read-args' to do the same thing, in Dired mode.
1057;; These are provided here in case you want to bind them directly - for example, in case your
1058;; code does not use `find-file-read-args'. That is the case, for instance, for Icicles
1062(when (fboundp 'dired-get-file-for-visit) ; Defined in Emacs 22.
1063 (defun diredp-find-a-file (filename &optional wildcards)
1064 "`find-file', but use file on current line as default (`M-n')."
1065 (interactive (diredp-find-a-file-read-args "Find file: " nil))
1066 (find-file filename wildcards))
1068 (defun diredp-find-a-file-other-frame (filename &optional wildcards)
1069 "`find-file-other-frame', but use file under cursor as default (`M-n')."
1070 (interactive (diredp-find-a-file-read-args "Find file: " nil))
1071 (find-file-other-frame filename wildcards))
1073 (defun diredp-find-a-file-other-window (filename &optional wildcards)
1074 "`find-file-other-window', but use file under cursor as default (`M-n')."
1075 (interactive (diredp-find-a-file-read-args "Find file: " nil))
1076 (find-file-other-window filename wildcards))
1078 (defun diredp-find-a-file-read-args (prompt mustmatch)
1079 (list (let ((find-file-default (abbreviate-file-name (dired-get-file-for-visit))))
1080 (minibuffer-with-setup-hook
1081 (lambda () (setq minibuffer-default find-file-default))
1082 (read-file-name prompt nil default-directory mustmatch)))
1085;; Define these for Emacs 20 and 21.
1086(unless (fboundp 'dired-get-file-for-visit) ; Defined in Emacs 22.
1087 (defun dired-get-file-for-visit ()
1088 "Get the current line's file name, with an error if file does not exist."
1090 ;; We pass t for second arg so that we don't get error for `.' and `..'.
1091 (let ((raw (dired-get-filename nil t))
1094 (error "No file on this line"))
1095 (setq file-name (file-name-sans-versions raw t))
1096 (if (file-exists-p file-name)
1098 (if (file-symlink-p file-name)
1099 (error "File is a symlink to a nonexistent target")
1100 (error "File no longer exists; type `g' to update Dired buffer")))))
1102 (defun dired-find-alternate-file ()
1103 "In Dired, visit this file or directory instead of the dired buffer."
1105 (set-buffer-modified-p nil)
1106 (find-alternate-file (dired-get-file-for-visit))))
1108(defun diredp-find-file-reuse-dir-buffer ()
1109 "Like `dired-find-file', but reuse buffer if target is a directory."
1111 (set-buffer-modified-p nil)
1112 (let ((file (dired-get-file-for-visit)))
1113 (if (file-directory-p file)
1114 (find-alternate-file file)
1118(defun diredp-mouse-find-file-reuse-dir-buffer (event)
1119 "Like `diredp-mouse-find-file', but reuse buffer for a directory."
1123 (set-buffer (window-buffer (posn-window (event-end event))))
1125 (goto-char (posn-point (event-end event)))
1126 (setq file (dired-get-file-for-visit))))
1127 (select-window (posn-window (event-end event)))
1128 (if (file-directory-p file)
1129 (find-alternate-file (file-name-sans-versions file t))
1130 (find-file (file-name-sans-versions file t)))))
1133(defun toggle-dired-find-file-reuse-dir (force-p)
1134 "Toggle whether Dired `find-file' commands use alternate file.
1135Non-nil prefix arg FORCE-P => Use alternate file iff FORCE-P >= 0."
1137 (if force-p ; Force.
1138 (if (natnump (prefix-numeric-value force-p))
1139 (diredp-subst-find-alternate-for-find)
1140 (diredp-subst-find-for-find-alternate))
1141 (if (where-is-internal 'dired-find-file dired-mode-map 'ascii)
1142 (diredp-subst-find-alternate-for-find)
1143 (diredp-subst-find-for-find-alternate))))
1146(defalias 'diredp-toggle-find-file-reuse-dir 'toggle-dired-find-file-reuse-dir)
1148(defun diredp-subst-find-alternate-for-find ()
1149 "Use find-alternate-file commands in place of find-file commands."
1150 (substitute-key-definition 'dired-find-file 'diredp-find-file-reuse-dir-buffer dired-mode-map)
1151 (substitute-key-definition 'diredp-mouse-find-file 'diredp-mouse-find-file-reuse-dir-buffer
1153 (message "Accessing directories in Dired will REUSE the buffer"))
1155(defun diredp-subst-find-for-find-alternate ()
1156 "Don't use find-alternate-file commands in place of find-file commands."
1157 (substitute-key-definition 'diredp-find-file-reuse-dir-buffer 'dired-find-file dired-mode-map)
1158 (substitute-key-definition 'diredp-mouse-find-file-reuse-dir-buffer 'diredp-mouse-find-file
1160 (message "Accessing directories in Dired will NOT reuse the buffer"))
1164(defun diredp-omit-marked ()
1165 "Omit lines of marked files. Return the number of lines omitted."
1167 (let ((old-modified-p (buffer-modified-p))
1169 (when (interactive-p) (message "Omitting marked lines..."))
1170 (setq count (dired-do-kill-lines nil "Omitted %d line%s."))
1171 (set-buffer-modified-p old-modified-p) ; So no `%*' appear in mode-line.
1174;; `dired-do-toggle' was renamed to `dired-toggle-marks' after Emacs 20.
1175;; That's why we aliased it to `dired-toggle-marks' at the top of the file.
1178(defun diredp-omit-unmarked ()
1179 "Omit lines of unmarked files. Return the number of lines omitted."
1181 (let ((old-modified-p (buffer-modified-p))
1184 (message "Omitting unmarked lines...")
1185 (setq count (diredp-omit-marked))
1186 (dired-do-toggle) ; Marks all except `.', `..'
1187 (set-buffer-modified-p old-modified-p) ; So no `%*' appear in mode-line.
1191(defun diredp-ediff (file2)
1192 "Compare file at cursor with file FILE2 using `ediff'.
1193FILE2 defaults to the file at the cursor as well. If you enter just a
1194directory name for FILE2, then the file at the cursor is compared with
1195a file of the same name in that directory. FILE2 is the second file
1196given to `ediff'; the file at the cursor is the first."
1200 (list (ediff-read-file-name ; In `ediff.el'.
1201 (format "Compare %s with" (dired-get-filename t))
1202 (dired-current-directory) (dired-get-filename)))))
1203 (ediff-files (dired-get-filename) file2)) ; In `ediff.el'.
1206(defsubst diredp-fewer-than-2-files-p (arg)
1207 "Return non-nil iff fewer than two files are to be treated by dired.
1208More precisely, return non-nil iff ARG is nil and fewer than two
1209files are marked, or ARG is -1, 0 or 1."
1211 (and (integerp arg) (< (abs arg) 2)) ; Next or previous file (or none).
1212 (not (save-excursion ; Fewer than two marked files.
1213 (goto-char (point-min))
1214 (re-search-forward (dired-marker-regexp) nil t 2)))))
1217;; REPLACES ORIGINAL version in `dired-aux.el':
1218;; Redisplay only if at most one file is being treated.
1220(defun dired-do-compress (&optional arg)
1221 "Compress or uncompress marked (or next prefix ARG) files."
1223 (dired-map-over-marks-check (function dired-compress) arg 'compress
1224 (diredp-fewer-than-2-files-p arg)))
1227;; REPLACES ORIGINAL version in `dired-aux.el':
1228;; Redisplay only if at most one file is being treated.
1230(defun dired-do-byte-compile (&optional arg)
1231 "Byte compile marked (or next prefix ARG) Emacs Lisp files."
1233 (dired-map-over-marks-check (function dired-byte-compile) arg 'byte-compile
1234 (diredp-fewer-than-2-files-p arg)))
1237;; REPLACES ORIGINAL version in `dired-aux.el':
1238;; Redisplay only if at most one file is being treated.
1240(defun dired-do-load (&optional arg)
1241 "Load the marked (or next prefix ARG) Emacs Lisp files."
1243 (dired-map-over-marks-check (function dired-load) arg 'load
1244 (diredp-fewer-than-2-files-p arg)))
1247;; REPLACES ORIGINAL in `dired-aux.el.'
1248;; Use `diredp-this-subdir' instead of `dired-get-filename'.
1249;; If on a subdir listing header line or a non-dir file in a subdir listing, go to
1250;; the line for the subdirectory in the parent directory listing.
1251;; Fit one-window frame after inserting subdir.
1254(defun dired-maybe-insert-subdir (dirname &optional switches no-error-if-not-dir-p)
1255 "Move to Dired subdirectory line or subdirectory listing.
1256This bounces you back and forth between a subdirectory line and its
1257inserted listing header line. Using it on a non-directory line in a
1258subdirectory listing acts the same as using it on the subdirectory
1261* If on a subdirectory line, then go to the subdirectory's listing,
1262 creating it if not yet present.
1264* If on a subdirectory listing header line or a non-directory file in
1265 a subdirectory listing, then go to the line for the subdirectory in
1266 the parent directory listing.
1268* If on a non-directory file in the top Dired directory listing, do
1271Subdirectories are listed in the same position as for `ls -lR' output.
1273With a prefix arg, you can edit the `ls' switches used for this
1274listing. Add `R' to the switches to expand the directory tree under a
1277Dired remembers the switches you specify with a prefix arg, so
1278reverting the buffer does not reset them. However, you might
1279sometimes need to reset some subdirectory switches after a
1280`dired-undo'. You can reset all subdirectory switches to the
1281default value using \\<dired-mode-map>\\[dired-reset-subdir-switches]. See \
1283`(emacs)Subdir switches' for more details."
1284 (interactive (list (diredp-this-subdir)
1285 (and current-prefix-arg
1286 (read-string "Switches for listing: "
1287 (or (and (boundp 'dired-subdir-switches)
1288 dired-subdir-switches)
1289 dired-actual-switches)))))
1290 (let ((opoint (point))
1292 (cond ((consp filename) ; Subdir header line or non-directory file.
1293 (setq filename (car filename))
1294 (if (assoc filename dired-subdir-alist)
1295 (dired-goto-file filename) ; Subdir header line.
1296 (dired-insert-subdir (substring (file-name-directory filename) 0 -1))))
1298 ;; We don't need a marker for opoint as the subdir is always
1299 ;; inserted *after* opoint.
1300 (setq dirname (file-name-as-directory dirname))
1301 (or (and (not switches) (dired-goto-subdir dirname))
1302 (dired-insert-subdir dirname switches no-error-if-not-dir-p))
1303 ;; Push mark so that it's easy to go back. Do this after the
1304 ;; insertion message so that the user sees the `Mark set' message.
1306 (when (and (get-buffer-window (current-buffer)) ; Fit one-window frame.
1307 (fboundp 'fit-frame-if-one-window))
1308 (fit-frame-if-one-window))))))
1310(defun diredp-this-subdir ()
1311 "This line's filename, if directory, or `dired-current-directory' list.
1312If on a directory line, then return the directory name.
1313Else return a singleton list of a directory name, which is as follows:
1314 If on a subdirectory header line (either of the two lines), then use
1315 that subdirectory name. Else use the parent directory name."
1316 (or (let ((file (dired-get-filename nil t)))
1317 (and file (file-directory-p file)
1318 (not (member (file-relative-name file (file-name-directory
1319 (directory-file-name file)))
1320 '("." ".." "./" "../")))
1322 (list (dired-current-directory))))
1326;;; VISIT ALL MARKED FILES SIMULTANEOUSLY.
1328;;; Brief Description:
1330;;; `dired-do-find-marked-files' is bound to `F' by dired-x.el.
1332;;; * Use `dired-get-marked-files' to collect the marked files in the current
1333;;; Dired Buffer into a list of filenames `FILE-LIST'.
1335;;; * Pass FILE-LIST to `dired-simultaneous-find-file' all with
1336;;; `dired-do-find-marked-files''s prefix argument OPTION.
1338;;; * `dired-simultaneous-find-file' runs through FILE-LIST decrementing the
1341;;; * If OPTION and `pop-up-frames' are both nil, then calculate the
1342;;; `size' of the window for each file by dividing the `window-height'
1343;;; by length of FILE-LIST. Thus, `size' is cognizant of the
1344;;; window-configuration.
1346;;; * If `size' is too small abort, otherwise run `find-file' on each element
1347;;; of FILE-LIST giving each a window of height `size'.
1349;; REPLACES ORIGINAL version in `dired-x.el':
1350;; Doc string updated to reflect change to `dired-simultaneous-find-file'.
1352(defun dired-do-find-marked-files (&optional arg)
1353 "Find marked files, displaying all of them simultaneously.
1354With a prefix ARG >= 0, just find files but do not select them.
1356If no prefix ARG, and variable `pop-up-frames' is non-nil, or
1357if prefix ARG < 0, then each file is displayed in a separate frame.
1359Otherwise (no prefix ARG and nil `pop-up-frames'), the current window
1360is split across all marked files, as evenly as possible. Remaining
1361lines go to the bottom-most window. The number of files that can be
1362displayed this way is restricted by the height of the current window
1363and `window-min-height'.
1365To keep the Dired buffer displayed, type \\[split-window-vertically] first.
1366To display just the marked files, type \\[delete-other-windows] first."
1368 (setq arg (and arg (prefix-numeric-value arg)))
1369 (dired-simultaneous-find-file (dired-get-marked-files) arg))
1372;; REPLACES ORIGINAL version in `dired-x.el':
1373;; Use separate frames instead of windows if `pop-up-frames' is non-nil,
1374;; or if prefix arg is negative.
1376(defun dired-simultaneous-find-file (file-list option)
1377 "Visit all files in list FILE-LIST and display them simultaneously.
1379With non-nil OPTION >= 0, the files are found but not selected.
1381If `pop-up-frames' is non-nil or OPTION < 0, use a separate frame
1384Otherwise, the current window is split across all files in
1385FILE-LIST, as evenly as possible. Remaining lines go to the
1386bottom-most window. The number of files that can be displayed
1387this way is restricted by the height of the current window and
1388the variable `window-min-height'."
1390 ;; This is not interactive because it is usually too clumsy to
1391 ;; specify FILE-LIST interactively unless via dired.
1394 (cond ((and option (natnump option))
1395 (while file-list (find-file-noselect (car file-list)) (pop file-list)))
1396 ((or pop-up-frames option)
1397 (while file-list (find-file-other-frame (car file-list)) (pop file-list)))
1399 (setq size (/ (window-height) (length file-list)))
1400 (when (> window-min-height size)
1401 (error "Too many files to visit simultaneously. Try C-u prefix."))
1402 (find-file (car file-list))
1405 ;; Vertically split off a window of desired size.
1406 ;; Upper window will have SIZE lines.
1407 ;; Select lower (larger) window. We split it again.
1408 (select-window (split-window nil size))
1409 (find-file (car file-list))
1410 (pop file-list))))))
1413;;;;;; REPLACES ORIGINAL versions in both `dired.el' and `dired-x.el':
1415;;;;;; 1. This incorporates the `dired-x.el' change to the `dired.el'
1416;;;;;; definition. This version works with or without using dired-x.
1417;;;;;; The `dired-x.el' version respects the var `dired-find-subdir'.
1418;;;;;; When `dired-find-subdir' is non-nil, this version is the same
1419;;;;;; as the `dired-x.el' version, except that a bug is corrected:
1420;;;;;; Whenever the argument to `dired-find-buffer-nocreate' is a cons,
1421;;;;;; the call to `dired-buffers-for-dir' gave a wrong type error.
1422;;;;;; This has been avoided by not respecting `dired-find-subdir'
1423;;;;;; whenever `dired-find-buffer-nocreate' is a cons.
1424;;;;;; For the case when `dired-find-subdir' is nil, see #2, below.
1426;;;;;; 2. Unless `dired-find-subdir' is bound and non-nil:
1427;;;;;; If both DIRNAME and `dired-directory' are conses, then only
1428;;;;;; compare their cars (directories), not their explicit file lists
1429;;;;;; too. If equal, then update `dired-directory's file list to that
1432;;;;;; This prevents `dired-internal-noselect' (which is currently
1433;;;;;; `dired-find-buffer-nocreate's only caller) from creating a new
1434;;;;;; buffer in this case whenever a different set of files is present
1435;;;;;; in the cdr of DIRNAME and DIRNAME represents the same buffer as
1436;;;;;; `dired-directory'.
1438;;;;;; If only one of DIRNAME and `dired-directory' is a cons, then
1439;;;;;; this returns nil.
1441;;;;(defun dired-find-buffer-nocreate (dirname &optional mode)
1442;;;; (let ((atomic-dirname-p (atom dirname)))
1443;;;; (if (and (boundp 'dired-find-subdir) dired-find-subdir atomic-dirname-p)
1444;;;; ;; This is the `dired-x.el' change:
1445;;;; (let* ((cur-buf (current-buffer))
1446;;;; (buffers (nreverse (dired-buffers-for-dir dirname)))
1447;;;; (cur-buf-matches (and (memq cur-buf buffers)
1448;;;; ;; Files list (wildcards) must match, too:
1449;;;; (equal dired-directory dirname))))
1450;;;; (setq buffers (delq cur-buf buffers)) ; Avoid using same buffer---
1451;;;; (or (car (sort buffers (function dired-buffer-more-recently-used-p)))
1452;;;; (and cur-buf-matches cur-buf))) ; ---unless no other possibility.
1453;;;; ;; Comment from `dired.el':
1454;;;; ;; This differs from `dired-buffers-for-dir' in that it doesn't consider
1455;;;; ;; subdirs of `default-directory' and searches for the first match only.
1456;;;; (let ((blist dired-buffers) ; was (buffer-list)
1458;;;; (or mode (setq mode 'dired-mode))
1460;;;; (if (null (buffer-name (cdr (car blist))))
1461;;;; (setq blist (cdr blist))
1463;;;; (set-buffer (cdr (car blist)))
1464;;;; (if (not (and (eq major-mode mode)
1465;;;; ;; DIRNAME and `dired-directory' have the same dir,
1466;;;; ;; and if either of them has an explicit file list,
1467;;;; ;; then both of them do. In that case, update
1468;;;; ;; `dired-directory's file list from DIRNAME.
1469;;;; (if atomic-dirname-p
1470;;;; (and (atom dired-directory) ; Both are atoms.
1471;;;; (string= (file-truename dirname)
1472;;;; (file-truename dired-directory)))
1473;;;; (and (consp dired-directory) ; Both are conses.
1475;;;; (file-truename (car dirname))
1476;;;; (file-truename (car dired-directory)))
1477;;;; ;; Update `dired-directory's file list.
1478;;;; (setq dired-directory dirname)))))
1479;;;; (setq blist (cdr blist))
1480;;;; (setq found (cdr (car blist)))
1481;;;; (setq blist nil)))))
1485;; REPLACES ORIGINAL in `dired.el':
1486;; Resets `mode-line-process' to nil.
1488(when (< emacs-major-version 21)
1489 (or (fboundp 'old-dired-revert) (fset 'old-dired-revert (symbol-function 'dired-revert)))
1490 (defun dired-revert (&optional arg noconfirm)
1491 (setq mode-line-process nil) ; Set by, e.g., `find-dired'.
1492 (old-dired-revert arg noconfirm)))
1495;; REPLACES ORIGINAL in `dired.el':
1496;; `mouse-face' on whole line, not just file name.
1498(defun dired-insert-set-properties (beg end)
1499 "Highlight entire dired line upon mouseover."
1502 (while (< (point) end)
1504 (when (dired-move-to-filename)
1505 (add-text-properties
1506 (save-excursion (beginning-of-line) (point))
1507 (save-excursion (end-of-line) (point))
1508 '(mouse-face highlight help-echo "mouse-2: visit this file in other window")))
1513;; REPLACES ORIGINAL in `dired.el'.
1514;; Remove `/' from directory name before comparing with BASE.
1516(defun dired-goto-file (file)
1517 "Go to line describing file FILE in this dired buffer."
1518 ;; Return value of point on success, else nil.
1519 ;; FILE must be an absolute file name.
1520 ;; Loses if FILE contains control chars like "\007" for which ls
1521 ;; either inserts "?" or "\\007" into the buffer, so we won't find
1522 ;; it in the buffer.
1524 (prog1 ; let push-mark display its message
1525 (list (expand-file-name
1526 (read-file-name "Goto file: "
1527 (dired-current-directory))))
1529 (setq file (directory-file-name file)) ; does no harm if no directory
1530 (let (found case-fold-search dir)
1531 (setq dir (or (file-name-directory file)
1532 (error "File name `%s' is not absolute" file)))
1534 ;; The hair here is to get the result of dired-goto-subdir
1535 ;; without really calling it if we don't have any subdirs.
1536 (if (if (string= dir (expand-file-name default-directory))
1537 (goto-char (point-min))
1538 (and (cdr dired-subdir-alist)
1539 (dired-goto-subdir dir)))
1540 (let ((base (file-name-nondirectory file))
1542 (boundary (dired-subdir-max)))
1544 (replace-regexp-in-string "\^m" "\\^m" base nil t))
1546 (replace-regexp-in-string "\\\\" "\\\\" search-string nil t))
1547 (while (and (not found)
1548 ;; filenames are preceded by SPC, this makes
1549 ;; the search faster (e.g. for the filename "-"!).
1550 (search-forward (concat " " search-string)
1552 ;; Remove / from filename, then compare with BASE.
1553 ;; Match could have BASE just as initial substring or
1554 ;; or in permission bits or date or not be a proper filename at all.
1555 (if (equal base (directory-file-name (dired-get-filename 'no-dir t)))
1556 ;; Must move to filename since an (actually
1557 ;; correct) match could have been elsewhere on the
1558 ;; ;; line (e.g. "-" would match somewhere in the
1559 ;; permission bits).
1560 (setq found (dired-move-to-filename))
1561 ;; If this isn't the right line, move forward to avoid
1562 ;; trying this line again.
1563 (forward-line 1))))))
1565 ;; return value of point (i.e., FOUND):
1566 (goto-char found))))
1569;; REPLACES ORIGINAL in `dired.el':
1570;; Test also ./ and ../, in addition to . and .., for error "Cannot operate on `.' or `..'".
1572(defun dired-get-filename (&optional localp no-error-if-not-filep)
1573 "In Dired, return name of file mentioned on this line.
1574Value returned normally includes the directory name.
1575Optional arg LOCALP with value `no-dir' means don't include directory
1576name in result. A value of `verbatim' means to return the name exactly as
1577it occurs in the buffer, and a value of t means construct name relative to
1578`default-directory', which still may contain slashes if in a subdirectory.
1579Optional arg NO-ERROR-IF-NOT-FILEP means treat `.' and `..' as
1580regular filenames and return nil if no filename on this line.
1581Otherwise, an error occurs in these cases."
1582 (let (case-fold-search file p1 p2 already-absolute)
1584 (if (setq p1 (dired-move-to-filename (not no-error-if-not-filep)))
1585 (setq p2 (dired-move-to-end-of-filename no-error-if-not-filep))))
1586 ;; nil if no file on this line, but no-error-if-not-filep is t:
1587 (when (setq file (and p1 p2 (buffer-substring p1 p2)))
1588 ;; Get rid of the mouse-face property that file names have.
1589 (set-text-properties 0 (length file) nil file)
1590 ;; Unquote names quoted by ls or by dired-insert-directory.
1591 ;; Using read to unquote is much faster than substituting
1592 ;; \007 (4 chars) -> ^G (1 char) etc. in a lisp loop.
1595 ;; Some ls -b don't escape quotes, argh!
1596 ;; This is not needed for GNU ls, though.
1597 (or (dired-string-replace-match
1598 "\\([^\\]\\|\\`\\)\"" file "\\1\\\\\"" nil t)
1601 ;; The above `read' will return a unibyte string if FILE
1602 ;; contains eight-bit-control/graphic characters.
1603 (when (and (fboundp 'string-to-multibyte) ; Emacs 22
1604 enable-multibyte-characters
1605 (not (multibyte-string-p file)))
1606 (setq file (string-to-multibyte file))))
1607 (and file (file-name-absolute-p file)
1608 ;; A relative file name can start with ~.
1609 ;; Don't treat it as absolute in this context.
1610 (not (eq (aref file 0) ?~))
1611 (setq already-absolute t))
1612 (cond ((null file) nil)
1613 ((eq localp 'verbatim) file)
1614 ((and (not no-error-if-not-filep) (member file '("." ".." "./" "../")))
1615 (error "Cannot operate on `.' or `..'"))
1616 ((and (eq localp 'no-dir) already-absolute)
1617 (file-name-nondirectory file))
1619 (let ((handler (find-file-name-handler file nil)))
1620 ;; check for safe-magic property so that we won't
1621 ;; put /: for names that don't really need them.
1622 ;; For instance, .gz files when auto-compression-mode is on.
1623 (if (and handler (not (get handler 'safe-magic)))
1626 ((eq localp 'no-dir) file)
1627 ((equal (dired-current-directory) "/")
1628 (setq file (concat (dired-current-directory localp) file))
1629 (let ((handler (find-file-name-handler file nil)))
1630 ;; check for safe-magic property so that we won't
1631 ;; put /: for names that don't really need them.
1632 ;; For instance, .gz files when auto-compression-mode is on.
1633 (if (and handler (not (get handler 'safe-magic)))
1636 (t (concat (dired-current-directory localp) file)))))
1639;; REPLACES ORIGINAL in `dired.el':
1640;; Display a message to warn that flagged, not marked, files will be deleted.
1642(defun dired-do-flagged-delete (&optional no-msg)
1643 "In dired, delete the files flagged for deletion.
1644NOTE: This deletes flagged, not marked, files.
1645If arg NO-MSG is non-nil, no messages are displayed."
1649 (message "NOTE: Deletion of files flagged `%c' (not those marked `%c')."
1650 dired-del-marker dired-marker-char))
1651 (let* ((dired-marker-char dired-del-marker)
1652 (regexp (dired-marker-regexp))
1654 (if (save-excursion (goto-char (point-min))
1655 (re-search-forward regexp nil t))
1656 (dired-internal-do-deletions
1657 ;; This can't move point since last arg is nil.
1658 (dired-map-over-marks (cons (dired-get-filename) (point)) nil)
1660 (unless no-msg (message "(No deletions requested.)")))))
1663;; REPLACES ORIGINAL in `dired.el':
1664;; Display a message to warn that marked, not flagged, files will be deleted.
1666(defun dired-do-delete (&optional arg)
1667 "Delete all marked (or next ARG) files.
1668NOTE: This deletes marked, not flagged, files."
1670 ;; This is more consistent with the file-marking feature than
1671 ;; `dired-do-flagged-delete'. But it can be confusing to the user,
1672 ;; especially since this is usually bound to `D', which is also the
1673 ;; `dired-del-marker'. So offer this warning message:
1676 (message "NOTE: Deletion of files marked `%c' (not those flagged `%c')."
1677 dired-marker-char dired-del-marker))
1678 (dired-internal-do-deletions
1679 ;; This may move point if ARG is an integer.
1680 (dired-map-over-marks (cons (dired-get-filename) (point)) arg)
1684(defun diredp-capitalize (&optional arg)
1685 "Rename all marked (or next ARG) files by capitilizing them.
1686This gives the file name(s) a first character in upper case and the
1689 (dired-rename-non-directory (function capitalize) "Rename by capitalizing:" arg))
1692;;; Versions of `dired-do-*' commands for just this line's file.
1693(defsubst diredp-delete-this-file ()
1694 "In dired, delete the file on the cursor line, upon confirmation."
1695 (interactive) (dired-do-delete 1))
1696(defsubst diredp-capitalize-this-file ()
1697 "In dired, rename the file on the cursor line by capitilizing it.
1698This gives the file name a first character in upper case and the rest
1700 (interactive) (diredp-capitalize 1))
1701(defsubst diredp-downcase-this-file ()
1702 "In dired, rename the file on the cursor line to lower case."
1703 (interactive) (dired-downcase 1))
1704(defsubst diredp-upcase-this-file ()
1705 "In dired, rename the file on the cursor line to upper case."
1706 (interactive) (dired-upcase 1))
1707(defsubst diredp-rename-this-file ()
1708 "In dired, rename the file on the cursor line."
1709 (interactive) (dired-do-rename 1))
1710(defsubst diredp-copy-this-file ()
1711 "In dired, copy the file on the cursor line."
1712 (interactive) (dired-do-copy 1))
1713(defsubst diredp-relsymlink-this-file ()
1714 "In dired, make a relative symbolic link to file on cursor line."
1715 (interactive) (and (fboundp 'dired-do-relsymlink) (dired-do-relsymlink 1)))
1716(defsubst diredp-symlink-this-file ()
1717 "In dired, make a symbolic link to the file on the cursor line."
1718 (interactive) (dired-do-symlink 1))
1719(defsubst diredp-hardlink-this-file ()
1720 "In dired, add a name (hard link) to the file on the cursor line."
1721 (interactive) (dired-do-hardlink 1))
1722(defsubst diredp-print-this-file ()
1723 "In dired, print the file on the cursor line."
1724 (interactive) (dired-do-print 1))
1725(defsubst diredp-compress-this-file ()
1726 "In dired, compress or uncompress the file on the cursor line."
1727 (interactive) (dired-do-compress 1))
1728(defsubst diredp-shell-command-this-file (command)
1729 "In dired, run a shell COMMAND on the file on the cursor line."
1731 (list (dired-read-shell-command (concat "! on " "%s: ") 1
1732 (list (dired-get-filename t)))))
1733 (dired-do-shell-command command 1))
1734(defsubst diredp-byte-compile-this-file ()
1735 "In dired, byte compile the (Lisp source) file on the cursor line."
1736 (interactive) (dired-do-byte-compile 1))
1737(defsubst diredp-load-this-file ()
1738 "In dired, load the file on the cursor line."
1739 (interactive) (dired-do-load 1))
1740(defsubst diredp-chmod-this-file ()
1741 "In dired, change the mode of the file on the cursor line."
1742 (interactive) (dired-do-chmod 1))
1743(defsubst diredp-chgrp-this-file ()
1744 "In dired, change the group of the file on the cursor line."
1745 (interactive) (dired-do-chgrp 1))
1746(defsubst diredp-chown-this-file ()
1747 "In dired, change the owner of the file on the cursor line."
1748 (interactive) (dired-do-chown 1))
1751;; REPLACES ORIGINAL in `dired-x.el':
1752;; 1. Variable (symbol) `s' -> `blks'.
1753;; 2. Fixes to remove leading space from `uid' and allow `.' in `gid'.
1754;; 3. Cleaned up doc string and code a bit.
1756(defun dired-mark-sexp (predicate &optional unmark-p)
1757 "Mark files for which PREDICATE returns non-nil.
1758With non-nil prefix arg UNMARK-P, unmark those files instead.
1760PREDICATE is a lisp sexp that can refer to the following variables:
1762 `mode' [string] file permission bits, e.g. \"-rw-r--r--\"
1763 `nlink' [integer] number of links to file
1764 `size' [integer] file size in bytes
1765 `uid' [string] owner
1766 `gid' [string] group (If the gid is not displayed by `ls',
1767 this will still be set (to the same as uid))
1768 `time' [string] the time that `ls' displays, e.g. \"Feb 12 14:17\"
1769 `name' [string] the name of the file
1770 `sym' [string] if file is a symbolic link, the linked-to name,
1772 `inode' [integer] the inode of the file (only for `ls -i' output)
1773 `blks' [integer] the size of the file for `ls -s' output
1774 (ususally in blocks or, with `-k', in Kbytes)
1776 Mark zero-length files: `(equal 0 size)'
1777 Mark files last modified on Feb 2: `(string-match \"Feb 2\" time)'
1778 Mark uncompiled Emacs Lisp files (`.el' file without a `.elc' file):
1779 First, dired just the source files: `dired *.el'.
1780 Then, use \\[dired-mark-sexp] with this sexp:
1781 (not (file-exists-p (concat name \"c\")))"
1783 ;; Using `sym' = "", instead of nil, for non-linked files avoids the trap of
1784 ;; (string-match "foo" sym) into which a user would soon fall.
1785 ;; Use `equal' instead of `=' in the example, as it works on integers and strings.
1786 (interactive "xVars: inode,blks,mode,nlink,uid,gid,size,time,name,sym -> \nP")
1787 (message "%s" predicate)
1788 (let ((dired-marker-char (if unmark-p ?\040 dired-marker-char))
1791 mode nlink uid gid size time name sym)
1795 ;; Sets vars INODE BLKS MODE NLINK UID GID SIZE TIME NAME and SYM
1796 ;; according to current file line. Returns `t' for success, nil if
1797 ;; there is no file line. Upon success, these vars are set, to either
1798 ;; nil or the appropriate value, so they need not be initialized.
1799 ;; Moves point within the current line.
1800 (dired-move-to-filename)
1801 (let ((mode-len 10) ; Length of mode string.
1802 ;; As in `dired.el', but with subexpressions \1=inode, \2=blks:
1803 (dired-re-inode-size "\\s *\\([0-9]*\\)\\s *\\([0-9]*\\) ?")
1807 (when (looking-at dired-re-inode-size)
1808 (goto-char (match-end 0))
1809 (setq inode (string-to-number (buffer-substring (match-beginning 1)
1811 (setq blks (string-to-number (buffer-substring (match-beginning 2)
1813 (setq mode (buffer-substring (point) (+ mode-len (point))))
1814 (forward-char mode-len)
1815 (setq nlink (read (current-buffer)))
1816 (forward-char 1) ; Fix: skip space.
1817 ;; Karsten Wenger <kw@cis.uni-muenchen.de> fixed uid.
1818 (setq uid (buffer-substring (+ (point) 1) (progn (forward-word 1) (point))))
1820 (if (< emacs-major-version 20)
1821 "\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct\\|Nov\\|Dec\\)"
1822 dired-move-to-filename-regexp))
1823 (goto-char (match-beginning 1))
1825 (setq size (string-to-number (buffer-substring (save-excursion
1831 ;; if no gid is displayed, gid will be set to uid
1832 ;; but user will then not reference it anyway in PREDICATE.
1833 (setq gid (buffer-substring (save-excursion (forward-word 1) (point))
1835 (setq time (buffer-substring (match-beginning 1)
1836 (1- (dired-move-to-filename))))
1837 (setq name (buffer-substring (point)
1838 (or (dired-move-to-end-of-filename t)
1840 (setq sym (if (looking-at " -> ")
1841 (buffer-substring (progn (forward-char 4) (point))
1842 (progn (end-of-line) (point)))
1845 (format "'%s file" predicate))))
1848(defun diredp-mark-region-files (&optional unmark-p)
1849 "Mark all of the files in the current region (if it is active).
1850With non-nil prefix arg UNMARK-P, unmark them instead."
1852 (let ((beg (min (point) (mark)))
1853 (end (max (point) (mark))))
1854 (setq beg (save-excursion (goto-char beg) (beginning-of-line) (point)))
1855 (setq end (save-excursion (goto-char end) (end-of-line) (point)))
1856 (let ((dired-marker-char (if unmark-p ?\040 dired-marker-char)))
1857 (dired-mark-if (and (<= (point) end) (>= (point) beg)) "in region"))))
1860(defun diredp-unmark-region-files (&optional mark-p)
1861 "Unmark all of the files in the current region (if it is active).
1862With non-nil prefix arg UNMARK-P, mark them instead."
1864 (let ((beg (min (point) (mark)))
1865 (end (max (point) (mark))))
1866 (setq beg (save-excursion (goto-char beg) (beginning-of-line) (point)))
1867 (setq end (save-excursion (goto-char end) (end-of-line) (point)))
1868 (let ((dired-marker-char (if mark-p dired-marker-char ?\040)))
1869 (dired-mark-if (and (<= (point) end) (>= (point) beg)) "in region"))))
1872(defun diredp-flag-region-files-for-deletion ()
1873 "Flag all of the files in the current region (if it is active) for deletion."
1875 (let ((beg (min (point) (mark)))
1876 (end (max (point) (mark))))
1877 (setq beg (save-excursion (goto-char beg) (beginning-of-line) (point)))
1878 (setq end (save-excursion (goto-char end) (end-of-line) (point)))
1879 (let ((dired-marker-char dired-del-marker))
1880 (dired-mark-if (and (<= (point) end) (>= (point) beg)) "in region"))))
1888(defvar diredp-file-line-overlay nil)
1891(defun diredp-mouse-3-menu (event)
1892 "Pop-up menu on Mouse-3 for a file or directory listed in dired buffer."
1903 '("Mark" . diredp-mark-region-files)
1904 '("Unmark" . diredp-unmark-region-files)
1905 '("Flag for Deletion" .
1906 diredp-flag-region-files-for-deletion)))))
1907 (let* ((mouse-pos (event-start event))
1911 (set-buffer (window-buffer (posn-window mouse-pos)))
1913 (goto-char (posn-point mouse-pos))
1915 (setq bol (progn (beginning-of-line) (point)))
1916 (setq eol (progn (end-of-line) (point))))
1917 (if diredp-file-line-overlay ; Don't recreate if exists.
1918 (move-overlay diredp-file-line-overlay bol eol
1920 (setq diredp-file-line-overlay (make-overlay bol eol))
1921 (overlay-put diredp-file-line-overlay 'face 'region))
1922 (and (not (eobp)) (dired-get-filename nil t))))))
1926 (and file/dir-name event)
1933 ;; Stuff from `Mark' menu.
1934 (if (dired-file-marker file/dir-name)
1935 '("Unmark" . diredp-mouse-unmark) ; It's now marked.
1936 '("Mark" . diredp-mouse-mark)) ; It's now unmarked.
1937 '("Flag for Deletion" . diredp-mouse-flag-file-deletion)
1938 '("--") ; Separator.
1940 ;; Stuff from `Single' / `Multiple' menus.
1941 '("Open" . diredp-mouse-find-file)
1942 '("Open in Other Window" .
1943 dired-mouse-find-file-other-window)
1944 '("Open in Other Frame" .
1945 diredp-mouse-find-file-other-frame)
1946 '("View (Read Only)" . diredp-mouse-view-file)
1947 '("Compare..." . diredp-mouse-ediff)
1948 '("Diff..." . diredp-mouse-diff)
1949 '("Diff with Backup" . diredp-mouse-backup-diff)
1950 '("Copy to..." . diredp-mouse-do-copy)
1951 '("Rename to..." . diredp-mouse-do-rename)
1952 '("Upcase" . diredp-mouse-upcase)
1953 '("Downcase" . diredp-mouse-downcase)
1954 '("Delete" . diredp-mouse-do-delete)
1955 '("Shell Command..." . diredp-mouse-do-shell-command)
1956 (and (fboundp 'dired-do-relsymlink)
1957 '("Symlink to (Relative)..."
1958 . dired-do-relsymlink))
1959 '("Symlink to..." . diredp-mouse-do-symlink)
1960 '("Hardlink to..." . diredp-mouse-do-hardlink)
1961 '("Print" . diredp-mouse-do-print)
1962 '("Compress/Decompress" . diredp-mouse-do-compress)
1963 '("Byte Compile" . diredp-mouse-do-byte-compile)
1964 '("Load" . diredp-mouse-do-load)
1965 '("Change Mode..." . diredp-mouse-do-chmod)
1966 '("Change Group..." . diredp-mouse-do-chgrp)
1967 '("Change Owner..." . diredp-mouse-do-chown)
1969 '("" ("")))))) ; No menu: not on a file line.
1970 (when diredp-file-line-overlay
1971 (delete-overlay diredp-file-line-overlay))))
1972 (and selection (call-interactively selection))))
1975(defun diredp-mouse-find-file (event)
1976 "Replace dired in its window by this file or directory."
1980 (set-buffer (window-buffer (posn-window (event-end event))))
1982 (goto-char (posn-point (event-end event)))
1983 (setq file (dired-get-filename))))
1984 (select-window (posn-window (event-end event)))
1985 (find-file (file-name-sans-versions file t))))
1988(defun diredp-mouse-view-file (event)
1989 "Examine this file in view mode, returning to dired when done.
1990When file is a directory, show it in this buffer if it is inserted;
1991otherwise, display it in another buffer."
1995 (set-buffer (window-buffer (posn-window (event-end event))))
1997 (goto-char (posn-point (event-end event)))
1998 (setq file (dired-get-filename))))
1999 (select-window (posn-window (event-end event)))
2000 (if (file-directory-p file)
2001 (or (and (cdr dired-subdir-alist) (dired-goto-subdir file))
2003 (view-file file)))) ; In `view.el'.
2006(defun diredp-mouse-ediff (event)
2007 "Compare this file (pointed by mouse) with file FILE2 using `ediff'.
2008FILE2 defaults to this file as well. If you enter just a directory
2009name for FILE2, then this file is compared with a file of the same
2010name in that directory. FILE2 is the second file given to `ediff';
2011this file is the first given to it."
2014 (let ((mouse-pos (event-start event)))
2015 (select-window (posn-window mouse-pos))
2016 (goto-char (posn-point mouse-pos))
2017 (call-interactively 'diredp-ediff)))
2020(defun diredp-mouse-diff (event &optional switches)
2021 "Compare this file (pointed by mouse) with file FILE2 using `diff'.
2022FILE2 defaults to the file at the mark. This file is the first file
2023given to `diff'. With prefix arg, prompt for second arg SWITCHES,
2024which are options for `diff'."
2026 (let ((default (if (mark t)
2027 (save-excursion (goto-char (mark t))
2028 (dired-get-filename t t))))
2029 (mouse-pos (event-start event)))
2031 (select-window (posn-window mouse-pos))
2032 (goto-char (posn-point mouse-pos))
2033 (let ((file2 (read-file-name (format "Diff %s with: %s"
2034 (dired-get-filename t)
2035 (if default (concat "(default " default ") ") ""))
2036 (dired-current-directory) default t)))
2038 (and current-prefix-arg
2039 (if (fboundp 'icicle-read-string-completing)
2040 (icicle-read-string-completing
2041 "Options for diff: "
2042 (if (stringp diff-switches)
2044 (mapconcat 'identity diff-switches " "))
2045 (lambda (c) (string-match "switches" (symbol-name c))))
2046 (read-string "Options for diff: "
2047 (if (stringp diff-switches)
2049 (mapconcat 'identity diff-switches " "))))))
2050 (diff file2 (dired-get-filename t) switches))))
2053(defun diredp-mouse-backup-diff (event)
2054 "Diff this file with its backup file or vice versa.
2055Use the latest backup, if there are several numerical backups.
2056If this file is a backup, diff it with its original.
2057The backup file is the first file given to `diff'.
2058With prefix arg, prompt for SWITCHES which are the options for `diff'."
2060 (let ((switches (and current-prefix-arg
2061 (if (fboundp 'icicle-read-string-completing)
2062 (icicle-read-string-completing
2063 "Options for diff: "
2064 (if (stringp diff-switches)
2066 (mapconcat 'identity diff-switches " "))
2067 (lambda (c) (string-match "switches" (symbol-name c))))
2068 (read-string "Options for diff: "
2069 (if (stringp diff-switches)
2071 (mapconcat 'identity diff-switches " "))))))
2072 (mouse-pos (event-start event)))
2073 (select-window (posn-window mouse-pos))
2074 (goto-char (posn-point mouse-pos))
2075 (diff-backup (dired-get-filename) switches)))
2078(defun diredp-mouse-mark (event)
2079 "In dired, mark this file.
2080If on a subdir headerline, mark all its files except `.' and `..'.
2082Use \\[dired-unmark-all-files] to remove all marks,
2083and \\[dired-unmark] on a subdir to remove the marks in this subdir."
2085 (let ((mouse-pos (event-start event)))
2086 (select-window (posn-window mouse-pos))
2087 (goto-char (posn-point mouse-pos)))
2088 (if (and (cdr dired-subdir-alist) (dired-get-subdir))
2089 (save-excursion (dired-mark-subdir-files))
2090 (let (buffer-read-only)
2091 (dired-repeat-over-lines 1 (function (lambda ()
2093 (insert dired-marker-char))))
2094 (dired-previous-line 1))))
2097(defun diredp-mouse-unmark (event)
2098 "In dired, unmark this file.
2099If looking at a subdir, unmark all its files except `.' and `..'."
2101 (let ((mouse-pos (event-start event)))
2102 (select-window (posn-window mouse-pos))
2103 (goto-char (posn-point mouse-pos)))
2104 (let ((dired-marker-char ?\040)) (dired-mark nil))
2105 (dired-previous-line 1))
2107;;; This can be bound to [C-down-mouse-1] to give behavior similar to Windows Explorer.
2108;;; However, Emacs generally uses [C-down-mouse-1] for `mouse-buffer-menu'.
2110(defun diredp-mouse-mark/unmark (event)
2111 "Mark/unmark file or directory at mouse EVENT."
2113 (let* ((mouse-pos (event-start event))
2117 (set-buffer (window-buffer (posn-window mouse-pos)))
2119 (goto-char (posn-point mouse-pos))
2121 (setq bol (progn (beginning-of-line) (point)))
2122 (setq eol (progn (end-of-line) (point))))
2123 (and (not (eobp)) (dired-get-filename nil t))))))
2124 ;; Return nil iff not on a file or directory name.
2125 (and file/dir-name (cond ((dired-file-marker file/dir-name)
2126 (diredp-mouse-unmark event)
2127 (message "Unmarked: %s" file/dir-name))
2129 (diredp-mouse-mark event)
2130 (message "Marked: %s" file/dir-name))))))
2132;; This can be bound to [S-mouse-1] to give behavior similar to Windows Explorer.
2133;; If you do that, consider binding `diredp-mouse-mark/unmark' to `C-mouse-1'.
2134;; Alternatively, just bind `diredp-mouse-mark/unmark-mark-region-files' to [S-mouse-1].
2136(defun diredp-mouse-mark-region-files (event)
2137 "Mark files between point and the mouse."
2139 (call-interactively 'mouse-save-then-kill)
2140 (diredp-mark-region-files))
2142;; This can be bound to [S-mouse-1] to give behavior similar to Windows Explorer.
2143;; If you don't bind `diredp-mouse-mark/unmark' to, for instance, `C-mouse-1', then
2144;; Consider binding this to [S-mouse-1].
2146(defun diredp-mouse-mark/unmark-mark-region-files (event)
2147 "Mark/unmark file or mark files in region.
2148If the file the cursor is on is marked, then mark all files between it
2149 and the line clicked (included).
2150Otherwise (cursor's file is unmarked):
2151 If the file clicked is marked, then unmark it.
2152 If it is unmarked, then mark it."
2154 (let ((mouse-pos (event-start event)))
2155 ;; If same click same line as cursor, or cursor's line is marked,
2156 ;; Then toggle the clicked line's mark.
2157 ;; Else mark all files in region between point and clicked line (included).
2158 (if (or (eq (count-lines (point-min) (posn-point mouse-pos))
2159 (count-lines (point-min) (point)))
2160 (equal dired-marker-char (dired-file-marker (dired-get-filename nil t))))
2161 (diredp-mouse-mark/unmark event)
2162 (call-interactively 'mouse-save-then-kill)
2163 (diredp-mark-region-files))))
2166(defun diredp-mouse-flag-file-deletion (event)
2167 "In dired, flag this file for deletion.
2168If on a subdir headerline, mark all its files except `.' and `..'."
2170 (let ((mouse-pos (event-start event)))
2171 (select-window (posn-window mouse-pos))
2172 (goto-char (posn-point mouse-pos)))
2173 (let ((dired-marker-char dired-del-marker)) (dired-mark 1))
2174 (dired-previous-line 1))
2177(defun diredp-mouse-do-copy (event)
2178 "In dired, copy this file.
2179This normally preserves the last-modified date when copying."
2181 (let ((mouse-pos (event-start event)))
2182 (select-window (posn-window mouse-pos))
2183 (goto-char (posn-point mouse-pos)))
2184 (dired-do-create-files 'copy (function dired-copy-file)
2185 (if dired-copy-preserve-time "Copy [-p]" "Copy")
2186 1 dired-keep-marker-copy))
2189(defun diredp-mouse-do-rename (event)
2190 "In dired, rename this file."
2192 (let ((mouse-pos (event-start event)))
2193 (select-window (posn-window mouse-pos))
2194 (goto-char (posn-point mouse-pos)))
2195 (dired-do-create-files 'move (function dired-rename-file)
2196 "Move" 1 dired-keep-marker-rename "Rename"))
2199(defun diredp-mouse-upcase (event)
2200 "In dired, rename this file to upper case."
2202 (let ((mouse-pos (event-start event)))
2203 (select-window (posn-window mouse-pos))
2204 (goto-char (posn-point mouse-pos)))
2205 (dired-rename-non-directory (function upcase) "Rename to uppercase:" nil))
2208(defun diredp-mouse-downcase (event)
2209 "In dired, rename this file to lower case."
2211 (let ((mouse-pos (event-start event)))
2212 (select-window (posn-window mouse-pos))
2213 (goto-char (posn-point mouse-pos)))
2214 (dired-rename-non-directory (function downcase) "Rename to lowercase:" nil))
2217(defun diredp-mouse-do-delete (event)
2218 "In dired, delete this file, upon confirmation."
2220 (let ((mouse-pos (event-start event)))
2221 (select-window (posn-window mouse-pos))
2222 (goto-char (posn-point mouse-pos)))
2223 (dired-internal-do-deletions (dired-map-over-marks (cons (dired-get-filename)
2226 (dired-previous-line 1))
2229(defun diredp-mouse-do-shell-command (event)
2230 "Run a shell COMMAND on this file.
2231If there is output, it goes to a separate buffer.
2233No automatic redisplay of dired buffers is attempted, as there's no
2234telling what files the command may have changed. Type
2235\\[dired-do-redisplay] to redisplay.
2237The shell command has the top level directory as working directory, so
2238output files usually are created there instead of in a subdir."
2239;;Functions dired-run-shell-command and dired-shell-stuff-it do the
2240;;actual work and can be redefined for customization.
2242 (let ((mouse-pos (event-start event))
2243 (command (dired-read-shell-command "! on %s: " nil
2244 (dired-get-marked-files t nil))))
2245 (select-window (posn-window mouse-pos))
2246 (goto-char (posn-point mouse-pos))
2247 (dired-bunch-files (- 10000 (length command))
2248 (function (lambda (&rest files)
2249 (dired-run-shell-command
2250 (dired-shell-stuff-it command files t 1))))
2252 (dired-get-marked-files t 1))))
2255(defun diredp-mouse-do-symlink (event)
2256 "Make symbolic link to this file."
2258 (let ((mouse-pos (event-start event)))
2259 (select-window (posn-window mouse-pos))
2260 (goto-char (posn-point mouse-pos)))
2261 (dired-do-create-files 'symlink (function make-symbolic-link)
2262 "Symlink" 1 dired-keep-marker-symlink))
2265(defun diredp-mouse-do-hardlink (event)
2266 "Make hard link (alias) to this file."
2268 (let ((mouse-pos (event-start event)))
2269 (select-window (posn-window mouse-pos))
2270 (goto-char (posn-point mouse-pos)))
2271 (dired-do-create-files 'hardlink (function add-name-to-file)
2272 "Hardlink" 1 dired-keep-marker-hardlink))
2275(defun diredp-mouse-do-print (event)
2277Uses the shell command coming from variables `lpr-command' and
2278`lpr-switches' as default."
2280 (let ((mouse-pos (event-start event)))
2281 (select-window (posn-window mouse-pos))
2282 (goto-char (posn-point mouse-pos)))
2283 (let* ((file (dired-get-filename))
2284 (command (dired-mark-read-string "Print %s with: "
2285 (apply 'concat lpr-command " " lpr-switches)
2286 'print 1 (list file))))
2287 (dired-run-shell-command (dired-shell-stuff-it command (list file) nil))))
2290(defun diredp-mouse-do-compress (event)
2291 "Compress or uncompress this file."
2293 (let ((mouse-pos (event-start event))
2294 (dired-no-confirm t))
2295 (select-window (posn-window mouse-pos))
2296 (goto-char (posn-point mouse-pos))
2297 (dired-map-over-marks-check (function dired-compress) 1 'compress t))
2298 (dired-previous-line 1))
2301(defun diredp-mouse-do-byte-compile (event)
2302 "Byte compile this file."
2304 (let ((mouse-pos (event-start event))
2305 (dired-no-confirm t))
2306 (select-window (posn-window mouse-pos))
2307 (goto-char (posn-point mouse-pos))
2308 (dired-map-over-marks-check (function dired-byte-compile) 1 'byte-compile t))
2309 (dired-previous-line 1))
2312(defun diredp-mouse-do-load (event)
2313 "Load this Emacs Lisp file."
2315 (let ((mouse-pos (event-start event))
2316 (dired-no-confirm t))
2317 (select-window (posn-window mouse-pos))
2318 (goto-char (posn-point mouse-pos))
2319 (dired-map-over-marks-check (function dired-load) 1 'load t))
2320 (dired-previous-line 1))
2323(defun diredp-mouse-do-chmod (event)
2324 "Change the mode of this file.
2325This calls chmod, so symbolic modes like `g+w' are allowed."
2327 (let ((mouse-pos (event-start event)))
2328 (select-window (posn-window mouse-pos))
2329 (goto-char (posn-point mouse-pos)))
2330 (dired-do-chxxx "Mode" "chmod" 'chmod 1)
2331 (dired-previous-line 1))
2334(defun diredp-mouse-do-chgrp (event)
2335 "Change the group of this file."
2337 (let ((mouse-pos (event-start event)))
2338 (select-window (posn-window mouse-pos))
2339 (goto-char (posn-point mouse-pos)))
2340 (dired-do-chxxx "Group" "chgrp" 'chgrp 1)
2341 (dired-previous-line 1))
2344(defun diredp-mouse-do-chown (event)
2345 "Change the owner of this file."
2347 (let ((mouse-pos (event-start event)))
2348 (select-window (posn-window mouse-pos))
2349 (goto-char (posn-point mouse-pos)))
2350 (dired-do-chxxx "Owner" dired-chown-program 'chown 1)
2351 (dired-previous-line 1))
2353;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2354;;; dired+.el ends here
