1994-12-22 04:16:36 +00:00
|
|
|
|
;;; dired-aux.el --- less commonly used parts of dired -*-byte-compile-dynamic: t;-*-
|
1992-06-24 02:14:18 +00:00
|
|
|
|
|
2005-08-06 22:13:43 +00:00
|
|
|
|
;; Copyright (C) 1985, 1986, 1992, 1994, 1998, 2000, 2001, 2002, 2003,
|
2008-01-07 02:45:14 +00:00
|
|
|
|
;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
|
1992-07-22 04:22:42 +00:00
|
|
|
|
|
1992-07-16 17:20:42 +00:00
|
|
|
|
;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>.
|
1997-05-27 19:51:23 +00:00
|
|
|
|
;; Maintainer: FSF
|
2001-08-29 15:02:01 +00:00
|
|
|
|
;; Keywords: files
|
1992-07-16 21:47:34 +00:00
|
|
|
|
|
1992-06-24 02:14:18 +00:00
|
|
|
|
;; This file is part of GNU Emacs.
|
|
|
|
|
|
2008-05-06 08:06:51 +00:00
|
|
|
|
;; GNU Emacs is free software: you can redistribute it and/or modify
|
1992-06-24 02:14:18 +00:00
|
|
|
|
;; it under the terms of the GNU General Public License as published by
|
2008-05-06 08:06:51 +00:00
|
|
|
|
;; the Free Software Foundation, either version 3 of the License, or
|
|
|
|
|
;; (at your option) any later version.
|
1992-06-24 02:14:18 +00:00
|
|
|
|
|
|
|
|
|
;; GNU Emacs is distributed in the hope that it will be useful,
|
|
|
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
|
|
;; GNU General Public License for more details.
|
|
|
|
|
|
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
2008-05-06 08:06:51 +00:00
|
|
|
|
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
1992-06-24 02:14:18 +00:00
|
|
|
|
|
1992-07-16 17:20:42 +00:00
|
|
|
|
;;; Commentary:
|
|
|
|
|
|
1993-03-22 03:27:18 +00:00
|
|
|
|
;; The parts of dired mode not normally used. This is a space-saving hack
|
|
|
|
|
;; to avoid having to load a large mode when all that's wanted are a few
|
|
|
|
|
;; functions.
|
|
|
|
|
|
1992-06-24 02:14:18 +00:00
|
|
|
|
;; Rewritten in 1990/1991 to add tree features, file marking and
|
|
|
|
|
;; sorting by Sebastian Kremer <sk@thp.uni-koeln.de>.
|
|
|
|
|
;; Finished up by rms in 1992.
|
|
|
|
|
|
1992-07-16 17:20:42 +00:00
|
|
|
|
;;; Code:
|
|
|
|
|
|
2007-12-23 19:14:55 +00:00
|
|
|
|
;; We need macros in dired.el to compile properly,
|
|
|
|
|
;; and we call subroutines in it too.
|
|
|
|
|
(require 'dired)
|
1992-08-03 03:44:51 +00:00
|
|
|
|
|
2006-09-11 02:25:00 +00:00
|
|
|
|
(defvar dired-create-files-failures nil
|
|
|
|
|
"Variable where `dired-create-files' records failing file names.
|
|
|
|
|
Functions that operate recursively can store additional names
|
|
|
|
|
into this list; they also should call `dired-log' to log the errors.")
|
|
|
|
|
|
1992-06-24 02:14:18 +00:00
|
|
|
|
;;; 15K
|
|
|
|
|
;;;###begin dired-cmd.el
|
|
|
|
|
;; Diffing and compressing
|
|
|
|
|
|
2002-04-17 09:54:47 +00:00
|
|
|
|
(defconst dired-star-subst-regexp "\\(^\\|[ \t]\\)\\*\\([ \t]\\|$\\)")
|
|
|
|
|
(defconst dired-quark-subst-regexp "\\(^\\|[ \t]\\)\\?\\([ \t]\\|$\\)")
|
|
|
|
|
|
1992-06-24 02:14:18 +00:00
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun dired-diff (file &optional switches)
|
|
|
|
|
"Compare file at point with file FILE using `diff'.
|
2001-05-03 07:51:23 +00:00
|
|
|
|
FILE defaults to the file at the mark. (That's the mark set by
|
|
|
|
|
\\[set-mark-command], not by Dired's \\[dired-mark] command.)
|
1993-08-07 19:25:43 +00:00
|
|
|
|
The prompted-for file is the first file given to `diff'.
|
|
|
|
|
With prefix arg, prompt for second argument SWITCHES,
|
2006-01-17 01:43:00 +00:00
|
|
|
|
which is options for `diff'."
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(interactive
|
2006-01-17 01:43:00 +00:00
|
|
|
|
(let ((current (dired-get-filename t))
|
|
|
|
|
(default (if (mark t)
|
1993-07-02 00:15:07 +00:00
|
|
|
|
(save-excursion (goto-char (mark t))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(dired-get-filename t t)))))
|
2006-01-17 01:43:00 +00:00
|
|
|
|
(if (or (equal default current)
|
|
|
|
|
(and (not (equal (dired-dwim-target-directory)
|
|
|
|
|
(dired-current-directory)))
|
|
|
|
|
(not mark-active)))
|
|
|
|
|
(setq default nil))
|
1993-11-23 22:43:52 +00:00
|
|
|
|
(require 'diff)
|
2005-09-24 Emilio C. Lopes <eclig@gmx.net>
* woman.el (woman-file-name):
* wid-edit.el (widget-file-prompt-value)
(widget-coding-system-prompt-value):
* w32-fns.el (set-w32-system-coding-system):
* vc.el (vc-version-diff, vc-annotate):
* textmodes/reftex-auc.el (reftex-arg-cite)
(reftex-arg-index-tag):
* textmodes/refer.el (refer-get-bib-files):
* textmodes/artist.el (artist-figlet-choose-font):
* terminal.el (terminal-emulator):
* replace.el (occur-read-primary-args):
* rect.el (string-rectangle, string-insert-rectangle):
* ps-print.el (ps-print-preprint):
* progmodes/pascal.el (pascal-goto-defun):
* progmodes/etags.el (visit-tags-table, visit-tags-table-buffer):
* progmodes/compile.el (compilation-find-file):
* printing.el (pr-interactive-n-up):
* play/animate.el (animate-birthday-present):
* net/rcompile.el (remote-compile):
* man.el (man, Man-goto-section, Man-follow-manual-reference):
* mail/rmailsum.el (rmail-summary-search-backward)
(rmail-summary-search):
* mail/rmailout.el (rmail-output-read-rmail-file-name)
(rmail-output-read-file-name):
* mail/rmail.el (rmail-search, rmail-search-backwards):
* mail/mailabbrev.el (merge-mail-abbrevs, rebuild-mail-abbrevs):
* locate.el (locate):
* international/quail.el (quail-show-keyboard-layout):
* international/mule.el (set-buffer-file-coding-system)
(revert-buffer-with-coding-system, set-file-name-coding-system)
(set-terminal-coding-system, set-keyboard-coding-system)
(set-next-selection-coding-system):
* international/mule-diag.el (describe-coding-system)
(describe-font, describe-fontset):
* international/mule-cmds.el (universal-coding-system-argument)
(search-unencodable-char, describe-input-method)
(set-language-environment, describe-language-environment):
* international/codepage.el (codepage-setup):
* international/code-pages.el (codepage-setup):
* info.el (Info-search, Info-follow-reference)
(Info-search-backward):
* emacs-lisp/advice.el (ad-read-advised-function)
(ad-read-advice-class, ad-clear-cache, ad-activate)
(ad-deactivate, ad-update, ad-unadvise, ad-read-advice-name)
(ad-enable-advice, ad-disable-advice, ad-remove-advice)
(ad-read-regexp):
* ediff-util.el (ediff-toggle-regexp-match):
* ediff-ptch.el (ediff-prompt-for-patch-file):
* dired-aux.el (dired-diff):
* diff.el (diff):
* cus-edit.el (custom-variable-prompt):
* calendar/timeclock.el (timeclock-ask-for-project):
* calc/calcalg3.el (calc-get-fit-variables):
* calc/calc-store.el (calc-edit-variable)
(calc-permanent-variable):
* vc-mcvs.el (vc-mcvs-register):
* shadowfile.el (shadow-define-literal-group):
* woman.el (woman-file-name):
* vc.el (vc-version-diff, vc-merge):
* textmodes/reftex-index.el (reftex-index-complete-tag):
* format.el (format-decode-buffer, format-decode-region):
* emulation/viper-cmd.el (viper-read-string-with-history):
* emacs-lisp/debug.el (cancel-debug-on-entry):
* emacs-lisp/checkdoc.el (checkdoc-this-string-valid-engine):
* ediff.el (ediff-merge-revisions)
(ediff-merge-revisions-with-ancestor, ediff-revision):
* completion.el (interactive-completion-string-reader):
* calc/calc-prog.el (calc-user-define-formula):
Follow convention for reading with the minibuffer.
2005-09-24 13:44:02 +00:00
|
|
|
|
(list (read-file-name (format "Diff %s with%s: "
|
2006-01-17 01:43:00 +00:00
|
|
|
|
current
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(if default
|
2005-09-24 Emilio C. Lopes <eclig@gmx.net>
* woman.el (woman-file-name):
* wid-edit.el (widget-file-prompt-value)
(widget-coding-system-prompt-value):
* w32-fns.el (set-w32-system-coding-system):
* vc.el (vc-version-diff, vc-annotate):
* textmodes/reftex-auc.el (reftex-arg-cite)
(reftex-arg-index-tag):
* textmodes/refer.el (refer-get-bib-files):
* textmodes/artist.el (artist-figlet-choose-font):
* terminal.el (terminal-emulator):
* replace.el (occur-read-primary-args):
* rect.el (string-rectangle, string-insert-rectangle):
* ps-print.el (ps-print-preprint):
* progmodes/pascal.el (pascal-goto-defun):
* progmodes/etags.el (visit-tags-table, visit-tags-table-buffer):
* progmodes/compile.el (compilation-find-file):
* printing.el (pr-interactive-n-up):
* play/animate.el (animate-birthday-present):
* net/rcompile.el (remote-compile):
* man.el (man, Man-goto-section, Man-follow-manual-reference):
* mail/rmailsum.el (rmail-summary-search-backward)
(rmail-summary-search):
* mail/rmailout.el (rmail-output-read-rmail-file-name)
(rmail-output-read-file-name):
* mail/rmail.el (rmail-search, rmail-search-backwards):
* mail/mailabbrev.el (merge-mail-abbrevs, rebuild-mail-abbrevs):
* locate.el (locate):
* international/quail.el (quail-show-keyboard-layout):
* international/mule.el (set-buffer-file-coding-system)
(revert-buffer-with-coding-system, set-file-name-coding-system)
(set-terminal-coding-system, set-keyboard-coding-system)
(set-next-selection-coding-system):
* international/mule-diag.el (describe-coding-system)
(describe-font, describe-fontset):
* international/mule-cmds.el (universal-coding-system-argument)
(search-unencodable-char, describe-input-method)
(set-language-environment, describe-language-environment):
* international/codepage.el (codepage-setup):
* international/code-pages.el (codepage-setup):
* info.el (Info-search, Info-follow-reference)
(Info-search-backward):
* emacs-lisp/advice.el (ad-read-advised-function)
(ad-read-advice-class, ad-clear-cache, ad-activate)
(ad-deactivate, ad-update, ad-unadvise, ad-read-advice-name)
(ad-enable-advice, ad-disable-advice, ad-remove-advice)
(ad-read-regexp):
* ediff-util.el (ediff-toggle-regexp-match):
* ediff-ptch.el (ediff-prompt-for-patch-file):
* dired-aux.el (dired-diff):
* diff.el (diff):
* cus-edit.el (custom-variable-prompt):
* calendar/timeclock.el (timeclock-ask-for-project):
* calc/calcalg3.el (calc-get-fit-variables):
* calc/calc-store.el (calc-edit-variable)
(calc-permanent-variable):
* vc-mcvs.el (vc-mcvs-register):
* shadowfile.el (shadow-define-literal-group):
* woman.el (woman-file-name):
* vc.el (vc-version-diff, vc-merge):
* textmodes/reftex-index.el (reftex-index-complete-tag):
* format.el (format-decode-buffer, format-decode-region):
* emulation/viper-cmd.el (viper-read-string-with-history):
* emacs-lisp/debug.el (cancel-debug-on-entry):
* emacs-lisp/checkdoc.el (checkdoc-this-string-valid-engine):
* ediff.el (ediff-merge-revisions)
(ediff-merge-revisions-with-ancestor, ediff-revision):
* completion.el (interactive-completion-string-reader):
* calc/calc-prog.el (calc-user-define-formula):
Follow convention for reading with the minibuffer.
2005-09-24 13:44:02 +00:00
|
|
|
|
(concat " (default " default ")")
|
1992-06-24 02:14:18 +00:00
|
|
|
|
""))
|
2004-05-01 05:38:07 +00:00
|
|
|
|
(if default
|
|
|
|
|
(dired-current-directory)
|
|
|
|
|
(dired-dwim-target-directory))
|
|
|
|
|
default t)
|
1993-08-07 19:25:43 +00:00
|
|
|
|
(if current-prefix-arg
|
|
|
|
|
(read-string "Options for diff: "
|
|
|
|
|
(if (stringp diff-switches)
|
|
|
|
|
diff-switches
|
|
|
|
|
(mapconcat 'identity diff-switches " ")))))))
|
|
|
|
|
(diff file (dired-get-filename t) switches))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun dired-backup-diff (&optional switches)
|
|
|
|
|
"Diff this file with its backup file or vice versa.
|
|
|
|
|
Uses the latest backup, if there are several numerical backups.
|
|
|
|
|
If this file is a backup, diff it with its original.
|
1993-08-07 19:25:43 +00:00
|
|
|
|
The backup file is the first file given to `diff'.
|
|
|
|
|
With prefix arg, prompt for argument SWITCHES which is options for `diff'."
|
|
|
|
|
(interactive
|
|
|
|
|
(if current-prefix-arg
|
|
|
|
|
(list (read-string "Options for diff: "
|
|
|
|
|
(if (stringp diff-switches)
|
|
|
|
|
diff-switches
|
|
|
|
|
(mapconcat 'identity diff-switches " "))))
|
|
|
|
|
nil))
|
|
|
|
|
(diff-backup (dired-get-filename) switches))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
|
2005-03-24 19:48:09 +00:00
|
|
|
|
;;;###autoload
|
2003-12-01 01:56:19 +00:00
|
|
|
|
(defun dired-compare-directories (dir2 predicate)
|
|
|
|
|
"Mark files with different file attributes in two dired buffers.
|
|
|
|
|
Compare file attributes of files in the current directory
|
|
|
|
|
with file attributes in directory DIR2 using PREDICATE on pairs of files
|
|
|
|
|
with the same name. Mark files for which PREDICATE returns non-nil.
|
2004-03-23 07:39:35 +00:00
|
|
|
|
Mark files with different names if PREDICATE is nil (or interactively
|
2005-03-24 19:48:09 +00:00
|
|
|
|
with empty input at the predicate prompt).
|
2003-12-01 01:56:19 +00:00
|
|
|
|
|
|
|
|
|
PREDICATE is a Lisp expression that can refer to the following variables:
|
|
|
|
|
|
|
|
|
|
size1, size2 - file size in bytes
|
|
|
|
|
mtime1, mtime2 - last modification time in seconds, as a float
|
|
|
|
|
fa1, fa2 - list of file attributes
|
|
|
|
|
returned by function `file-attributes'
|
|
|
|
|
|
|
|
|
|
where 1 refers to attribute of file in the current dired buffer
|
|
|
|
|
and 2 to attribute of file in second dired buffer.
|
|
|
|
|
|
|
|
|
|
Examples of PREDICATE:
|
|
|
|
|
|
|
|
|
|
(> mtime1 mtime2) - mark newer files
|
|
|
|
|
(not (= size1 size2)) - mark files with different sizes
|
|
|
|
|
(not (string= (nth 8 fa1) (nth 8 fa2))) - mark files with different modes
|
|
|
|
|
(not (and (= (nth 2 fa1) (nth 2 fa2)) - mark files with different UID
|
|
|
|
|
(= (nth 3 fa1) (nth 3 fa2)))) and GID."
|
|
|
|
|
(interactive
|
2005-03-24 19:48:09 +00:00
|
|
|
|
(list (read-directory-name (format "Compare %s with: "
|
|
|
|
|
(dired-current-directory))
|
|
|
|
|
(dired-dwim-target-directory)
|
|
|
|
|
(dired-dwim-target-directory))
|
2004-03-23 07:39:35 +00:00
|
|
|
|
(read-from-minibuffer "Mark if (lisp expr or RET): " nil nil t nil "nil")))
|
2003-12-01 01:56:19 +00:00
|
|
|
|
(let* ((dir1 (dired-current-directory))
|
|
|
|
|
(file-alist1 (dired-files-attributes dir1))
|
|
|
|
|
(file-alist2 (dired-files-attributes dir2))
|
2005-07-11 04:25:01 +00:00
|
|
|
|
file-list1 file-list2)
|
|
|
|
|
(setq file-alist1 (delq (assoc "." file-alist1) file-alist1))
|
|
|
|
|
(setq file-alist1 (delq (assoc ".." file-alist1) file-alist1))
|
|
|
|
|
(setq file-alist2 (delq (assoc "." file-alist2) file-alist2))
|
|
|
|
|
(setq file-alist2 (delq (assoc ".." file-alist2) file-alist2))
|
|
|
|
|
(setq file-list1 (mapcar
|
2003-12-01 01:56:19 +00:00
|
|
|
|
'cadr
|
|
|
|
|
(dired-file-set-difference
|
|
|
|
|
file-alist1 file-alist2
|
2005-07-11 04:25:01 +00:00
|
|
|
|
predicate))
|
|
|
|
|
file-list2 (mapcar
|
2003-12-01 01:56:19 +00:00
|
|
|
|
'cadr
|
|
|
|
|
(dired-file-set-difference
|
|
|
|
|
file-alist2 file-alist1
|
2005-07-11 04:25:01 +00:00
|
|
|
|
predicate)))
|
2003-12-01 01:56:19 +00:00
|
|
|
|
(dired-fun-in-all-buffers
|
|
|
|
|
dir1 nil
|
|
|
|
|
(lambda ()
|
|
|
|
|
(dired-mark-if
|
|
|
|
|
(member (dired-get-filename nil t) file-list1) nil)))
|
|
|
|
|
(dired-fun-in-all-buffers
|
|
|
|
|
dir2 nil
|
|
|
|
|
(lambda ()
|
|
|
|
|
(dired-mark-if
|
|
|
|
|
(member (dired-get-filename nil t) file-list2) nil)))
|
|
|
|
|
(message "Marked in dir1: %s files, in dir2: %s files"
|
|
|
|
|
(length file-list1)
|
|
|
|
|
(length file-list2))))
|
|
|
|
|
|
|
|
|
|
(defun dired-file-set-difference (list1 list2 predicate)
|
|
|
|
|
"Combine LIST1 and LIST2 using a set-difference operation.
|
|
|
|
|
The result list contains all file items that appear in LIST1 but not LIST2.
|
|
|
|
|
This is a non-destructive function; it makes a copy of the data if necessary
|
|
|
|
|
to avoid corrupting the original LIST1 and LIST2.
|
|
|
|
|
PREDICATE (see `dired-compare-directories') is an additional match
|
|
|
|
|
condition. Two file items are considered to match if they are equal
|
|
|
|
|
*and* PREDICATE evaluates to t."
|
|
|
|
|
(if (or (null list1) (null list2))
|
|
|
|
|
list1
|
|
|
|
|
(let (res)
|
|
|
|
|
(dolist (file1 list1)
|
|
|
|
|
(unless (let ((list list2))
|
|
|
|
|
(while (and list
|
|
|
|
|
(not (let* ((file2 (car list))
|
2004-07-19 12:34:02 +00:00
|
|
|
|
(fa1 (car (cddr file1)))
|
|
|
|
|
(fa2 (car (cddr file2)))
|
2003-12-01 01:56:19 +00:00
|
|
|
|
(size1 (nth 7 fa1))
|
|
|
|
|
(size2 (nth 7 fa2))
|
|
|
|
|
(mtime1 (float-time (nth 5 fa1)))
|
|
|
|
|
(mtime2 (float-time (nth 5 fa2))))
|
|
|
|
|
(and
|
|
|
|
|
(equal (car file1) (car file2))
|
|
|
|
|
(not (eval predicate))))))
|
|
|
|
|
(setq list (cdr list)))
|
|
|
|
|
list)
|
|
|
|
|
(setq res (cons file1 res))))
|
|
|
|
|
(nreverse res))))
|
|
|
|
|
|
|
|
|
|
(defun dired-files-attributes (dir)
|
|
|
|
|
"Return a list of all file names and attributes from DIR.
|
|
|
|
|
List has a form of (file-name full-file-name (attribute-list))"
|
|
|
|
|
(mapcar
|
|
|
|
|
(lambda (file-name)
|
|
|
|
|
(let ((full-file-name (expand-file-name file-name dir)))
|
|
|
|
|
(list file-name
|
|
|
|
|
full-file-name
|
|
|
|
|
(file-attributes full-file-name))))
|
|
|
|
|
(directory-files dir)))
|
|
|
|
|
|
2004-05-01 03:47:42 +00:00
|
|
|
|
|
|
|
|
|
(defun dired-touch-initial (files)
|
|
|
|
|
"Create initial input value for `touch' command."
|
|
|
|
|
(let (initial)
|
|
|
|
|
(while files
|
|
|
|
|
(let ((current (nth 5 (file-attributes (car files)))))
|
|
|
|
|
(if (and initial (not (equal initial current)))
|
|
|
|
|
(setq initial (current-time) files nil)
|
|
|
|
|
(setq initial current))
|
|
|
|
|
(setq files (cdr files))))
|
|
|
|
|
(format-time-string "%Y%m%d%H%M.%S" initial)))
|
|
|
|
|
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(defun dired-do-chxxx (attribute-name program op-symbol arg)
|
2004-03-31 16:33:00 +00:00
|
|
|
|
;; Change file attributes (mode, group, owner, timestamp) of marked files and
|
1992-06-24 02:14:18 +00:00
|
|
|
|
;; refresh their file lines.
|
|
|
|
|
;; ATTRIBUTE-NAME is a string describing the attribute to the user.
|
|
|
|
|
;; PROGRAM is the program used to change the attribute.
|
|
|
|
|
;; OP-SYMBOL is the type of operation (for use in dired-mark-pop-up).
|
|
|
|
|
;; ARG describes which files to use, as in dired-get-marked-files.
|
|
|
|
|
(let* ((files (dired-get-marked-files t arg))
|
|
|
|
|
(new-attribute
|
|
|
|
|
(dired-mark-read-string
|
|
|
|
|
(concat "Change " attribute-name " of %s to: ")
|
2004-05-01 03:47:42 +00:00
|
|
|
|
(if (eq op-symbol 'touch) (dired-touch-initial files))
|
|
|
|
|
op-symbol arg files))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(operation (concat program " " new-attribute))
|
|
|
|
|
failures)
|
|
|
|
|
(setq failures
|
|
|
|
|
(dired-bunch-files 10000
|
|
|
|
|
(function dired-check-process)
|
2002-04-17 09:54:47 +00:00
|
|
|
|
(append
|
2004-03-31 16:33:00 +00:00
|
|
|
|
(list operation program)
|
|
|
|
|
(if (eq op-symbol 'touch)
|
|
|
|
|
'("-t") nil)
|
|
|
|
|
(list new-attribute)
|
1997-01-02 02:30:23 +00:00
|
|
|
|
(if (string-match "gnu" system-configuration)
|
|
|
|
|
'("--") nil))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
files))
|
|
|
|
|
(dired-do-redisplay arg);; moves point if ARG is an integer
|
|
|
|
|
(if failures
|
|
|
|
|
(dired-log-summary
|
|
|
|
|
(format "%s: error" operation)
|
|
|
|
|
nil))))
|
|
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun dired-do-chmod (&optional arg)
|
|
|
|
|
"Change the mode of the marked (or next ARG) files.
|
2007-09-10 09:58:29 +00:00
|
|
|
|
Symbolic modes like `g+w' are allowed."
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(interactive "P")
|
2007-09-10 09:58:29 +00:00
|
|
|
|
(let* ((files (dired-get-marked-files t arg))
|
|
|
|
|
(modes (dired-mark-read-string
|
|
|
|
|
"Change mode of %s to: " nil
|
|
|
|
|
'chmod arg files))
|
|
|
|
|
(num-modes (if (string-match "^[0-7]+" modes)
|
|
|
|
|
(string-to-number modes 8))))
|
|
|
|
|
(dolist (file files)
|
|
|
|
|
(set-file-modes
|
|
|
|
|
file
|
|
|
|
|
(if num-modes num-modes
|
|
|
|
|
(file-modes-symbolic-to-number modes (file-modes file)))))
|
|
|
|
|
(dired-do-redisplay arg)))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun dired-do-chgrp (&optional arg)
|
|
|
|
|
"Change the group of the marked (or next ARG) files."
|
|
|
|
|
(interactive "P")
|
1995-04-12 03:08:59 +00:00
|
|
|
|
(if (memq system-type '(ms-dos windows-nt))
|
2001-07-15 16:15:35 +00:00
|
|
|
|
(error "chgrp not supported on this system"))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(dired-do-chxxx "Group" "chgrp" 'chgrp arg))
|
|
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun dired-do-chown (&optional arg)
|
|
|
|
|
"Change the owner of the marked (or next ARG) files."
|
|
|
|
|
(interactive "P")
|
1995-04-12 03:08:59 +00:00
|
|
|
|
(if (memq system-type '(ms-dos windows-nt))
|
2001-07-15 16:15:35 +00:00
|
|
|
|
(error "chown not supported on this system"))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(dired-do-chxxx "Owner" dired-chown-program 'chown arg))
|
|
|
|
|
|
2004-06-09 01:04:28 +00:00
|
|
|
|
;;;###autoload
|
2004-03-31 16:33:00 +00:00
|
|
|
|
(defun dired-do-touch (&optional arg)
|
|
|
|
|
"Change the timestamp of the marked (or next ARG) files.
|
|
|
|
|
This calls touch."
|
|
|
|
|
(interactive "P")
|
|
|
|
|
(dired-do-chxxx "Timestamp" dired-touch-program 'touch arg))
|
|
|
|
|
|
1992-06-24 02:14:18 +00:00
|
|
|
|
;; Process all the files in FILES in batches of a convenient size,
|
|
|
|
|
;; by means of (FUNCALL FUNCTION ARGS... SOME-FILES...).
|
|
|
|
|
;; Batches are chosen to need less than MAX chars for the file names,
|
|
|
|
|
;; allowing 3 extra characters of separator per file name.
|
|
|
|
|
(defun dired-bunch-files (max function args files)
|
|
|
|
|
(let (pending
|
2002-09-15 01:52:08 +00:00
|
|
|
|
past
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(pending-length 0)
|
|
|
|
|
failures)
|
|
|
|
|
;; Accumulate files as long as they fit in MAX chars,
|
|
|
|
|
;; then process the ones accumulated so far.
|
|
|
|
|
(while files
|
|
|
|
|
(let* ((thisfile (car files))
|
|
|
|
|
(thislength (+ (length thisfile) 3))
|
|
|
|
|
(rest (cdr files)))
|
|
|
|
|
;; If we have at least 1 pending file
|
|
|
|
|
;; and this file won't fit in the length limit, process now.
|
|
|
|
|
(if (and pending (> (+ thislength pending-length) max))
|
2002-09-15 01:52:08 +00:00
|
|
|
|
(setq pending (nreverse pending)
|
|
|
|
|
;; The elements of PENDING are now in forward order.
|
|
|
|
|
;; Do the operation and record failures.
|
|
|
|
|
failures (nconc (apply function (append args pending))
|
|
|
|
|
failures)
|
|
|
|
|
;; Transfer the elemens of PENDING onto PAST
|
|
|
|
|
;; and clear it out. Now PAST contains the first N files
|
|
|
|
|
;; specified (for some N), and FILES contains the rest.
|
|
|
|
|
past (nconc past pending)
|
1992-06-24 02:14:18 +00:00
|
|
|
|
pending nil
|
|
|
|
|
pending-length 0))
|
|
|
|
|
;; Do (setq pending (cons thisfile pending))
|
|
|
|
|
;; but reuse the cons that was in `files'.
|
|
|
|
|
(setcdr files pending)
|
|
|
|
|
(setq pending files)
|
|
|
|
|
(setq pending-length (+ thislength pending-length))
|
|
|
|
|
(setq files rest)))
|
2002-09-15 01:52:08 +00:00
|
|
|
|
(setq pending (nreverse pending))
|
|
|
|
|
(prog1
|
|
|
|
|
(nconc (apply function (append args pending))
|
|
|
|
|
failures)
|
|
|
|
|
;; Now the original list FILES has been put back as it was.
|
|
|
|
|
(nconc past pending))))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun dired-do-print (&optional arg)
|
|
|
|
|
"Print the marked (or next ARG) files.
|
|
|
|
|
Uses the shell command coming from variables `lpr-command' and
|
|
|
|
|
`lpr-switches' as default."
|
|
|
|
|
(interactive "P")
|
|
|
|
|
(let* ((file-list (dired-get-marked-files t arg))
|
|
|
|
|
(command (dired-mark-read-string
|
|
|
|
|
"Print %s with: "
|
1995-03-12 18:38:20 +00:00
|
|
|
|
(mapconcat 'identity
|
|
|
|
|
(cons lpr-command
|
|
|
|
|
(if (stringp lpr-switches)
|
|
|
|
|
(list lpr-switches)
|
|
|
|
|
lpr-switches))
|
|
|
|
|
" ")
|
1992-06-24 02:14:18 +00:00
|
|
|
|
'print arg file-list)))
|
|
|
|
|
(dired-run-shell-command (dired-shell-stuff-it command file-list nil))))
|
|
|
|
|
|
|
|
|
|
;; Read arguments for a marked-files command that wants a string
|
|
|
|
|
;; that is not a file name,
|
|
|
|
|
;; perhaps popping up the list of marked files.
|
|
|
|
|
;; ARG is the prefix arg and indicates whether the files came from
|
|
|
|
|
;; marks (ARG=nil) or a repeat factor (integerp ARG).
|
|
|
|
|
;; If the current file was used, the list has but one element and ARG
|
|
|
|
|
;; does not matter. (It is non-nil, non-integer in that case, namely '(4)).
|
|
|
|
|
|
|
|
|
|
(defun dired-mark-read-string (prompt initial op-symbol arg files)
|
|
|
|
|
;; PROMPT for a string, with INITIAL input.
|
|
|
|
|
;; Other args are used to give user feedback and pop-up:
|
|
|
|
|
;; OP-SYMBOL of command, prefix ARG, marked FILES.
|
|
|
|
|
(dired-mark-pop-up
|
|
|
|
|
nil op-symbol files
|
|
|
|
|
(function read-string)
|
|
|
|
|
(format prompt (dired-mark-prompt arg files)) initial))
|
2001-01-26 13:14:11 +00:00
|
|
|
|
|
1992-07-28 19:38:08 +00:00
|
|
|
|
;;; Cleaning a directory: flagging some backups for deletion.
|
|
|
|
|
|
1992-08-03 03:44:51 +00:00
|
|
|
|
(defvar dired-file-version-alist)
|
|
|
|
|
|
2004-06-09 01:04:28 +00:00
|
|
|
|
;;;###autoload
|
1992-07-28 19:38:08 +00:00
|
|
|
|
(defun dired-clean-directory (keep)
|
|
|
|
|
"Flag numerical backups for deletion.
|
|
|
|
|
Spares `dired-kept-versions' latest versions, and `kept-old-versions' oldest.
|
|
|
|
|
Positive prefix arg KEEP overrides `dired-kept-versions';
|
|
|
|
|
Negative prefix arg KEEP overrides `kept-old-versions' with KEEP made positive.
|
|
|
|
|
|
|
|
|
|
To clear the flags on these files, you can use \\[dired-flag-backup-files]
|
|
|
|
|
with a prefix argument."
|
|
|
|
|
(interactive "P")
|
|
|
|
|
(setq keep (if keep (prefix-numeric-value keep) dired-kept-versions))
|
|
|
|
|
(let ((early-retention (if (< keep 0) (- keep) kept-old-versions))
|
|
|
|
|
(late-retention (if (<= keep 0) dired-kept-versions keep))
|
|
|
|
|
(dired-file-version-alist ()))
|
|
|
|
|
(message "Cleaning numerical backups (keeping %d late, %d old)..."
|
|
|
|
|
late-retention early-retention)
|
|
|
|
|
;; Look at each file.
|
|
|
|
|
;; If the file has numeric backup versions,
|
|
|
|
|
;; put on dired-file-version-alist an element of the form
|
|
|
|
|
;; (FILENAME . VERSION-NUMBER-LIST)
|
|
|
|
|
(dired-map-dired-file-lines (function dired-collect-file-versions))
|
|
|
|
|
;; Sort each VERSION-NUMBER-LIST,
|
|
|
|
|
;; and remove the versions not to be deleted.
|
|
|
|
|
(let ((fval dired-file-version-alist))
|
|
|
|
|
(while fval
|
|
|
|
|
(let* ((sorted-v-list (cons 'q (sort (cdr (car fval)) '<)))
|
|
|
|
|
(v-count (length sorted-v-list)))
|
|
|
|
|
(if (> v-count (+ early-retention late-retention))
|
|
|
|
|
(rplacd (nthcdr early-retention sorted-v-list)
|
|
|
|
|
(nthcdr (- v-count late-retention)
|
|
|
|
|
sorted-v-list)))
|
|
|
|
|
(rplacd (car fval)
|
|
|
|
|
(cdr sorted-v-list)))
|
|
|
|
|
(setq fval (cdr fval))))
|
|
|
|
|
;; Look at each file. If it is a numeric backup file,
|
|
|
|
|
;; find it in a VERSION-NUMBER-LIST and maybe flag it for deletion.
|
|
|
|
|
(dired-map-dired-file-lines (function dired-trample-file-versions))
|
|
|
|
|
(message "Cleaning numerical backups...done")))
|
|
|
|
|
|
|
|
|
|
;;; Subroutines of dired-clean-directory.
|
|
|
|
|
|
|
|
|
|
(defun dired-map-dired-file-lines (fun)
|
|
|
|
|
;; Perform FUN with point at the end of each non-directory line.
|
1998-08-13 23:01:05 +00:00
|
|
|
|
;; FUN takes one argument, the absolute filename.
|
1992-07-28 19:38:08 +00:00
|
|
|
|
(save-excursion
|
|
|
|
|
(let (file buffer-read-only)
|
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
(while (not (eobp))
|
|
|
|
|
(save-excursion
|
|
|
|
|
(and (not (looking-at dired-re-dir))
|
|
|
|
|
(not (eolp))
|
|
|
|
|
(setq file (dired-get-filename nil t)) ; nil on non-file
|
|
|
|
|
(progn (end-of-line)
|
|
|
|
|
(funcall fun file))))
|
|
|
|
|
(forward-line 1)))))
|
|
|
|
|
|
|
|
|
|
(defun dired-collect-file-versions (fn)
|
1994-11-16 14:26:42 +00:00
|
|
|
|
(let ((fn (file-name-sans-versions fn)))
|
|
|
|
|
;; Only do work if this file is not already in the alist.
|
|
|
|
|
(if (assoc fn dired-file-version-alist)
|
|
|
|
|
nil
|
|
|
|
|
;; If it looks like file FN has versions, return a list of the versions.
|
|
|
|
|
;;That is a list of strings which are file names.
|
1994-12-22 04:16:36 +00:00
|
|
|
|
;;The caller may want to flag some of these files for deletion.
|
1994-11-16 14:26:42 +00:00
|
|
|
|
(let* ((base-versions
|
|
|
|
|
(concat (file-name-nondirectory fn) ".~"))
|
1997-05-10 05:43:58 +00:00
|
|
|
|
(backup-extract-version-start (length base-versions))
|
1994-11-16 14:26:42 +00:00
|
|
|
|
(possibilities (file-name-all-completions
|
|
|
|
|
base-versions
|
|
|
|
|
(file-name-directory fn)))
|
|
|
|
|
(versions (mapcar 'backup-extract-version possibilities)))
|
|
|
|
|
(if versions
|
|
|
|
|
(setq dired-file-version-alist
|
|
|
|
|
(cons (cons fn versions)
|
|
|
|
|
dired-file-version-alist)))))))
|
1992-07-28 19:38:08 +00:00
|
|
|
|
|
|
|
|
|
(defun dired-trample-file-versions (fn)
|
|
|
|
|
(let* ((start-vn (string-match "\\.~[0-9]+~$" fn))
|
|
|
|
|
base-version-list)
|
|
|
|
|
(and start-vn
|
|
|
|
|
(setq base-version-list ; there was a base version to which
|
|
|
|
|
(assoc (substring fn 0 start-vn) ; this looks like a
|
|
|
|
|
dired-file-version-alist)) ; subversion
|
2005-05-16 11:34:49 +00:00
|
|
|
|
(not (memq (string-to-number (substring fn (+ 2 start-vn)))
|
1992-07-28 19:38:08 +00:00
|
|
|
|
base-version-list)) ; this one doesn't make the cut
|
|
|
|
|
(progn (beginning-of-line)
|
|
|
|
|
(delete-char 1)
|
|
|
|
|
(insert dired-del-marker)))))
|
2001-01-26 13:14:11 +00:00
|
|
|
|
|
1992-06-24 02:14:18 +00:00
|
|
|
|
;;; Shell commands
|
|
|
|
|
|
2008-04-22 19:51:57 +00:00
|
|
|
|
(declare-function mailcap-file-default-commands "mailcap" (files))
|
|
|
|
|
|
|
|
|
|
(defun minibuffer-default-add-dired-shell-commands ()
|
|
|
|
|
"Return a list of all commands associted with current dired files.
|
|
|
|
|
This function is used to add all related commands retieved by `mailcap'
|
|
|
|
|
to the end of the list of defaults just after the default value."
|
|
|
|
|
(interactive)
|
|
|
|
|
(let ((commands (and (boundp 'files) (require 'mailcap nil t)
|
|
|
|
|
(mailcap-file-default-commands files))))
|
|
|
|
|
(if (listp minibuffer-default)
|
|
|
|
|
(append minibuffer-default commands)
|
|
|
|
|
(cons minibuffer-default commands))))
|
2007-11-16 01:19:13 +00:00
|
|
|
|
|
2008-04-07 18:57:28 +00:00
|
|
|
|
;; This is an extra function so that you can redefine it, e.g., to use gmhist.
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(defun dired-read-shell-command (prompt arg files)
|
2008-04-22 19:51:57 +00:00
|
|
|
|
"Read a dired shell command prompting with PROMPT (using read-shell-command).
|
2008-04-07 18:57:28 +00:00
|
|
|
|
ARG is the prefix arg and may be used to indicate in the prompt which
|
|
|
|
|
FILES are affected."
|
2008-04-22 19:51:57 +00:00
|
|
|
|
(minibuffer-with-setup-hook
|
|
|
|
|
(lambda ()
|
|
|
|
|
(set (make-local-variable 'minibuffer-default-add-function)
|
|
|
|
|
'minibuffer-default-add-dired-shell-commands))
|
|
|
|
|
(dired-mark-pop-up
|
|
|
|
|
nil 'shell files
|
|
|
|
|
#'read-shell-command
|
|
|
|
|
(format prompt (dired-mark-prompt arg files))
|
|
|
|
|
nil nil)))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
|
|
|
|
|
;; The in-background argument is only needed in Emacs 18 where
|
|
|
|
|
;; shell-command doesn't understand an appended ampersand `&'.
|
|
|
|
|
;;;###autoload
|
1997-06-30 06:13:58 +00:00
|
|
|
|
(defun dired-do-shell-command (command &optional arg file-list)
|
1992-08-03 03:44:51 +00:00
|
|
|
|
"Run a shell command COMMAND on the marked files.
|
|
|
|
|
If no files are marked or a specific numeric prefix arg is given,
|
|
|
|
|
the next ARG files are used. Just \\[universal-argument] means the current file.
|
|
|
|
|
The prompt mentions the file(s) or the marker, as appropriate.
|
|
|
|
|
|
2002-01-12 20:14:25 +00:00
|
|
|
|
If there is a `*' in COMMAND, surrounded by whitespace, this runs
|
|
|
|
|
COMMAND just once with the entire file list substituted there.
|
1992-08-03 03:44:51 +00:00
|
|
|
|
|
2002-01-12 20:14:25 +00:00
|
|
|
|
If there is no `*', but there is a `?' in COMMAND, surrounded by
|
|
|
|
|
whitespace, this runs COMMAND on each file individually with the
|
|
|
|
|
file name substituted for `?'.
|
1992-06-24 02:14:18 +00:00
|
|
|
|
|
2002-01-12 20:14:25 +00:00
|
|
|
|
Otherwise, this runs COMMAND on each file individually with the
|
|
|
|
|
file name added at the end of COMMAND (separated by a space).
|
1999-12-06 16:44:28 +00:00
|
|
|
|
|
2002-01-12 20:14:25 +00:00
|
|
|
|
`*' and `?' when not surrounded by whitespace have no special
|
|
|
|
|
significance for `dired-do-shell-command', and are passed through
|
|
|
|
|
normally to the shell, but you must confirm first. To pass `*' by
|
2002-01-13 16:56:20 +00:00
|
|
|
|
itself to the shell as a wildcard, type `*\"\"'.
|
1992-06-24 02:14:18 +00:00
|
|
|
|
|
2002-01-12 20:14:25 +00:00
|
|
|
|
If COMMAND produces output, it goes to a separate buffer.
|
|
|
|
|
|
|
|
|
|
This feature does not try to redisplay Dired buffers afterward, as
|
|
|
|
|
there's no telling what files COMMAND may have changed.
|
|
|
|
|
Type \\[dired-do-redisplay] to redisplay the marked files.
|
|
|
|
|
|
|
|
|
|
When COMMAND runs, its working directory is the top-level directory of
|
|
|
|
|
the Dired buffer, so output files usually are created there instead of
|
|
|
|
|
in a subdir.
|
1999-07-20 01:24:47 +00:00
|
|
|
|
|
|
|
|
|
In a noninteractive call (from Lisp code), you must specify
|
2006-05-20 18:19:36 +00:00
|
|
|
|
the list of file names explicitly with the FILE-LIST argument, which
|
|
|
|
|
can be produced by `dired-get-marked-files', for example."
|
1992-06-24 02:14:18 +00:00
|
|
|
|
;;Functions dired-run-shell-command and dired-shell-stuff-it do the
|
|
|
|
|
;;actual work and can be redefined for customization.
|
1997-06-30 06:13:58 +00:00
|
|
|
|
(interactive
|
|
|
|
|
(let ((files (dired-get-marked-files t current-prefix-arg)))
|
|
|
|
|
(list
|
|
|
|
|
;; Want to give feedback whether this file or marked files are used:
|
|
|
|
|
(dired-read-shell-command (concat "! on "
|
|
|
|
|
"%s: ")
|
|
|
|
|
current-prefix-arg
|
|
|
|
|
files)
|
|
|
|
|
current-prefix-arg
|
|
|
|
|
files)))
|
2002-04-17 09:54:47 +00:00
|
|
|
|
(let* ((on-each (not (string-match dired-star-subst-regexp command)))
|
|
|
|
|
(subst (not (string-match dired-quark-subst-regexp command)))
|
2002-01-12 20:14:25 +00:00
|
|
|
|
(star (not (string-match "\\*" command)))
|
|
|
|
|
(qmark (not (string-match "\\?" command))))
|
|
|
|
|
;; Get confirmation for wildcards that may have been meant
|
|
|
|
|
;; to control substitution of a file name or the file name list.
|
2002-04-17 09:54:47 +00:00
|
|
|
|
(if (cond ((not (or on-each subst))
|
|
|
|
|
(error "You can not combine `*' and `?' substitution marks"))
|
|
|
|
|
((and star (not on-each))
|
2002-01-12 20:14:25 +00:00
|
|
|
|
(y-or-n-p "Confirm--do you mean to use `*' as a wildcard? "))
|
|
|
|
|
((and qmark (not subst))
|
|
|
|
|
(y-or-n-p "Confirm--do you mean to use `?' as a wildcard? "))
|
|
|
|
|
(t))
|
|
|
|
|
(if on-each
|
|
|
|
|
(dired-bunch-files
|
|
|
|
|
(- 10000 (length command))
|
|
|
|
|
(function (lambda (&rest files)
|
|
|
|
|
(dired-run-shell-command
|
|
|
|
|
(dired-shell-stuff-it command files t arg))))
|
|
|
|
|
nil
|
|
|
|
|
file-list)
|
|
|
|
|
;; execute the shell command
|
|
|
|
|
(dired-run-shell-command
|
|
|
|
|
(dired-shell-stuff-it command file-list nil arg))))))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
|
|
|
|
|
;; Might use {,} for bash or csh:
|
|
|
|
|
(defvar dired-mark-prefix ""
|
|
|
|
|
"Prepended to marked files in dired shell commands.")
|
|
|
|
|
(defvar dired-mark-postfix ""
|
|
|
|
|
"Appended to marked files in dired shell commands.")
|
|
|
|
|
(defvar dired-mark-separator " "
|
|
|
|
|
"Separates marked files in dired shell commands.")
|
|
|
|
|
|
|
|
|
|
(defun dired-shell-stuff-it (command file-list on-each &optional raw-arg)
|
|
|
|
|
;; "Make up a shell command line from COMMAND and FILE-LIST.
|
|
|
|
|
;; If ON-EACH is t, COMMAND should be applied to each file, else
|
|
|
|
|
;; simply concat all files and apply COMMAND to this.
|
|
|
|
|
;; FILE-LIST's elements will be quoted for the shell."
|
|
|
|
|
;; Might be redefined for smarter things and could then use RAW-ARG
|
|
|
|
|
;; (coming from interactive P and currently ignored) to decide what to do.
|
|
|
|
|
;; Smart would be a way to access basename or extension of file names.
|
|
|
|
|
(let ((stuff-it
|
2002-04-17 09:54:47 +00:00
|
|
|
|
(if (or (string-match dired-star-subst-regexp command)
|
|
|
|
|
(string-match dired-quark-subst-regexp command))
|
|
|
|
|
(lambda (x)
|
|
|
|
|
(let ((retval command))
|
|
|
|
|
(while (string-match
|
|
|
|
|
"\\(^\\|[ \t]\\)\\([*?]\\)\\([ \t]\\|$\\)" retval)
|
|
|
|
|
(setq retval (replace-match x t t retval 2)))
|
|
|
|
|
retval))
|
|
|
|
|
(lambda (x) (concat command dired-mark-separator x)))))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(if on-each
|
1998-03-16 01:35:04 +00:00
|
|
|
|
(mapconcat stuff-it (mapcar 'shell-quote-argument file-list) ";")
|
2002-01-12 20:14:25 +00:00
|
|
|
|
(let ((files (mapconcat 'shell-quote-argument
|
|
|
|
|
file-list dired-mark-separator)))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(if (> (length file-list) 1)
|
2002-01-12 20:14:25 +00:00
|
|
|
|
(setq files (concat dired-mark-prefix files dired-mark-postfix)))
|
|
|
|
|
(funcall stuff-it files)))))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
|
|
|
|
|
;; This is an extra function so that it can be redefined by ange-ftp.
|
2004-06-09 01:04:28 +00:00
|
|
|
|
;;;###autoload
|
1992-08-03 03:44:51 +00:00
|
|
|
|
(defun dired-run-shell-command (command)
|
1998-03-24 17:08:34 +00:00
|
|
|
|
(let ((handler
|
|
|
|
|
(find-file-name-handler (directory-file-name default-directory)
|
|
|
|
|
'shell-command)))
|
|
|
|
|
(if handler (apply handler 'shell-command (list command))
|
|
|
|
|
(shell-command command)))
|
1992-08-03 03:44:51 +00:00
|
|
|
|
;; Return nil for sake of nconc in dired-bunch-files.
|
|
|
|
|
nil)
|
2001-01-26 13:14:11 +00:00
|
|
|
|
|
1992-06-24 02:14:18 +00:00
|
|
|
|
|
|
|
|
|
(defun dired-check-process (msg program &rest arguments)
|
|
|
|
|
; "Display MSG while running PROGRAM, and check for output.
|
|
|
|
|
;Remaining arguments are strings passed as command arguments to PROGRAM.
|
|
|
|
|
; On error, insert output
|
|
|
|
|
; in a log buffer and return the offending ARGUMENTS or PROGRAM.
|
|
|
|
|
; Caller can cons up a list of failed args.
|
|
|
|
|
;Else returns nil for success."
|
|
|
|
|
(let (err-buffer err (dir default-directory))
|
|
|
|
|
(message "%s..." msg)
|
|
|
|
|
(save-excursion
|
|
|
|
|
;; Get a clean buffer for error output:
|
|
|
|
|
(setq err-buffer (get-buffer-create " *dired-check-process output*"))
|
|
|
|
|
(set-buffer err-buffer)
|
|
|
|
|
(erase-buffer)
|
|
|
|
|
(setq default-directory dir ; caller's default-directory
|
2007-06-27 21:11:04 +00:00
|
|
|
|
err (not (eq 0 (apply 'process-file program nil t nil arguments))))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(if err
|
|
|
|
|
(progn
|
|
|
|
|
(dired-log (concat program " " (prin1-to-string arguments) "\n"))
|
|
|
|
|
(dired-log err-buffer)
|
|
|
|
|
(or arguments program t))
|
|
|
|
|
(kill-buffer err-buffer)
|
|
|
|
|
(message "%s...done" msg)
|
|
|
|
|
nil))))
|
2001-01-26 13:14:11 +00:00
|
|
|
|
|
1992-06-24 02:14:18 +00:00
|
|
|
|
;; Commands that delete or redisplay part of the dired buffer.
|
|
|
|
|
|
|
|
|
|
(defun dired-kill-line (&optional arg)
|
|
|
|
|
(interactive "P")
|
|
|
|
|
(setq arg (prefix-numeric-value arg))
|
|
|
|
|
(let (buffer-read-only file)
|
|
|
|
|
(while (/= 0 arg)
|
|
|
|
|
(setq file (dired-get-filename nil t))
|
|
|
|
|
(if (not file)
|
2001-07-15 16:15:35 +00:00
|
|
|
|
(error "Can only kill file lines")
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(save-excursion (and file
|
|
|
|
|
(dired-goto-subdir file)
|
|
|
|
|
(dired-kill-subdir)))
|
|
|
|
|
(delete-region (progn (beginning-of-line) (point))
|
|
|
|
|
(progn (forward-line 1) (point)))
|
|
|
|
|
(if (> arg 0)
|
|
|
|
|
(setq arg (1- arg))
|
|
|
|
|
(setq arg (1+ arg))
|
|
|
|
|
(forward-line -1))))
|
|
|
|
|
(dired-move-to-filename)))
|
|
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun dired-do-kill-lines (&optional arg fmt)
|
|
|
|
|
"Kill all marked lines (not the files).
|
1992-08-03 03:44:51 +00:00
|
|
|
|
With a prefix argument, kill that many lines starting with the current line.
|
2004-07-18 13:48:06 +00:00
|
|
|
|
\(A negative argument kills backward.)
|
|
|
|
|
If you use this command with a prefix argument to kill the line
|
|
|
|
|
for a file that is a directory, which you have inserted in the
|
|
|
|
|
Dired buffer as a subdirectory, then it deletes that subdirectory
|
|
|
|
|
from the buffer as well.
|
|
|
|
|
To kill an entire subdirectory \(without killing its line in the
|
|
|
|
|
parent directory), go to its directory header line and use this
|
|
|
|
|
command with a prefix argument (the value does not matter)."
|
1992-06-24 02:14:18 +00:00
|
|
|
|
;; Returns count of killed lines. FMT="" suppresses message.
|
|
|
|
|
(interactive "P")
|
1992-08-03 03:44:51 +00:00
|
|
|
|
(if arg
|
|
|
|
|
(if (dired-get-subdir)
|
|
|
|
|
(dired-kill-subdir)
|
|
|
|
|
(dired-kill-line arg))
|
|
|
|
|
(save-excursion
|
|
|
|
|
(goto-char (point-min))
|
2004-07-18 13:48:06 +00:00
|
|
|
|
(let (buffer-read-only
|
|
|
|
|
(count 0)
|
|
|
|
|
(regexp (dired-marker-regexp)))
|
|
|
|
|
(while (and (not (eobp))
|
|
|
|
|
(re-search-forward regexp nil t))
|
|
|
|
|
(setq count (1+ count))
|
|
|
|
|
(delete-region (progn (beginning-of-line) (point))
|
|
|
|
|
(progn (forward-line 1) (point))))
|
1992-08-03 03:44:51 +00:00
|
|
|
|
(or (equal "" fmt)
|
|
|
|
|
(message (or fmt "Killed %d line%s.") count (dired-plural-s count)))
|
|
|
|
|
count))))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
|
|
|
|
|
;;;###end dired-cmd.el
|
2001-01-26 13:14:11 +00:00
|
|
|
|
|
1992-06-24 02:14:18 +00:00
|
|
|
|
;;; 30K
|
|
|
|
|
;;;###begin dired-cp.el
|
|
|
|
|
|
|
|
|
|
(defun dired-compress ()
|
|
|
|
|
;; Compress or uncompress the current file.
|
|
|
|
|
;; Return nil for success, offending filename else.
|
|
|
|
|
(let* (buffer-read-only
|
1992-09-13 06:01:19 +00:00
|
|
|
|
(from-file (dired-get-filename))
|
|
|
|
|
(new-file (dired-compress-file from-file)))
|
|
|
|
|
(if new-file
|
1993-08-08 05:00:25 +00:00
|
|
|
|
(let ((start (point)))
|
|
|
|
|
;; Remove any preexisting entry for the name NEW-FILE.
|
|
|
|
|
(condition-case nil
|
|
|
|
|
(dired-remove-entry new-file)
|
|
|
|
|
(error nil))
|
|
|
|
|
(goto-char start)
|
|
|
|
|
;; Now replace the current line with an entry for NEW-FILE.
|
|
|
|
|
(dired-update-file-line new-file) nil)
|
1992-09-13 06:01:19 +00:00
|
|
|
|
(dired-log (concat "Failed to compress" from-file))
|
|
|
|
|
from-file)))
|
|
|
|
|
|
1996-03-03 06:10:06 +00:00
|
|
|
|
(defvar dired-compress-file-suffixes
|
|
|
|
|
'(("\\.gz\\'" "" "gunzip")
|
|
|
|
|
("\\.tgz\\'" ".tar" "gunzip")
|
|
|
|
|
("\\.Z\\'" "" "uncompress")
|
|
|
|
|
;; For .z, try gunzip. It might be an old gzip file,
|
|
|
|
|
;; or it might be from compact? pack? (which?) but gunzip handles both.
|
|
|
|
|
("\\.z\\'" "" "gunzip")
|
2004-03-23 07:39:35 +00:00
|
|
|
|
("\\.dz\\'" "" "dictunzip")
|
|
|
|
|
("\\.tbz\\'" ".tar" "bunzip2")
|
1998-08-27 15:21:25 +00:00
|
|
|
|
("\\.bz2\\'" "" "bunzip2")
|
1996-03-03 06:10:06 +00:00
|
|
|
|
;; This item controls naming for compression.
|
|
|
|
|
("\\.tar\\'" ".tgz" nil))
|
|
|
|
|
"Control changes in file name suffixes for compression and uncompression.
|
|
|
|
|
Each element specifies one transformation rule, and has the form:
|
|
|
|
|
(REGEXP NEW-SUFFIX PROGRAM)
|
|
|
|
|
The rule applies when the old file name matches REGEXP.
|
|
|
|
|
The new file name is computed by deleting the part that matches REGEXP
|
|
|
|
|
(as well as anything after that), then adding NEW-SUFFIX in its place.
|
|
|
|
|
If PROGRAM is non-nil, the rule is an uncompression rule,
|
|
|
|
|
and uncompression is done by running PROGRAM.
|
|
|
|
|
Otherwise, the rule is a compression rule, and compression is done with gzip.")
|
|
|
|
|
|
1993-12-23 03:34:57 +00:00
|
|
|
|
;;;###autoload
|
1992-09-13 06:01:19 +00:00
|
|
|
|
(defun dired-compress-file (file)
|
|
|
|
|
;; Compress or uncompress FILE.
|
|
|
|
|
;; Return the name of the compressed or uncompressed file.
|
1993-06-09 11:59:12 +00:00
|
|
|
|
;; Return nil if no change in files.
|
1996-03-03 06:10:06 +00:00
|
|
|
|
(let ((handler (find-file-name-handler file 'dired-compress-file))
|
|
|
|
|
suffix newname
|
|
|
|
|
(suffixes dired-compress-file-suffixes))
|
|
|
|
|
;; See if any suffix rule matches this file name.
|
|
|
|
|
(while suffixes
|
|
|
|
|
(let (case-fold-search)
|
|
|
|
|
(if (string-match (car (car suffixes)) file)
|
|
|
|
|
(setq suffix (car suffixes) suffixes nil))
|
|
|
|
|
(setq suffixes (cdr suffixes))))
|
|
|
|
|
;; If so, compute desired new name.
|
2002-04-17 09:54:47 +00:00
|
|
|
|
(if suffix
|
1996-03-03 06:10:06 +00:00
|
|
|
|
(setq newname (concat (substring file 0 (match-beginning 0))
|
|
|
|
|
(nth 1 suffix))))
|
1992-09-13 06:01:19 +00:00
|
|
|
|
(cond (handler
|
|
|
|
|
(funcall handler 'dired-compress-file file))
|
|
|
|
|
((file-symlink-p file)
|
|
|
|
|
nil)
|
1996-03-03 06:10:06 +00:00
|
|
|
|
((and suffix (nth 2 suffix))
|
|
|
|
|
;; We found an uncompression rule.
|
1993-08-08 05:00:25 +00:00
|
|
|
|
(if (not (dired-check-process (concat "Uncompressing " file)
|
1996-03-03 06:10:06 +00:00
|
|
|
|
(nth 2 suffix) file))
|
|
|
|
|
newname))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(t
|
1996-03-03 06:10:06 +00:00
|
|
|
|
;;; We don't recognize the file as compressed, so compress it.
|
1993-06-01 18:02:02 +00:00
|
|
|
|
;;; Try gzip; if we don't have that, use compress.
|
|
|
|
|
(condition-case nil
|
2006-07-17 04:00:54 +00:00
|
|
|
|
(let ((out-name (concat file ".gz")))
|
|
|
|
|
(and (or (not (file-exists-p out-name))
|
|
|
|
|
(y-or-n-p
|
|
|
|
|
(format "File %s already exists. Really compress? "
|
|
|
|
|
out-name)))
|
|
|
|
|
(not (dired-check-process (concat "Compressing " file)
|
|
|
|
|
"gzip" "-f" file))
|
|
|
|
|
(or (file-exists-p out-name)
|
|
|
|
|
(setq out-name (concat file ".z")))
|
|
|
|
|
;; Rename the compressed file to NEWNAME
|
|
|
|
|
;; if it hasn't got that name already.
|
|
|
|
|
(if (and newname (not (equal newname out-name)))
|
|
|
|
|
(progn
|
|
|
|
|
(rename-file out-name newname t)
|
|
|
|
|
newname)
|
|
|
|
|
out-name)))
|
1993-06-01 18:02:02 +00:00
|
|
|
|
(file-error
|
|
|
|
|
(if (not (dired-check-process (concat "Compressing " file)
|
|
|
|
|
"compress" "-f" file))
|
1996-03-03 06:10:06 +00:00
|
|
|
|
;; Don't use NEWNAME with `compress'.
|
1993-06-01 18:02:02 +00:00
|
|
|
|
(concat file ".Z"))))))))
|
2001-01-26 13:14:11 +00:00
|
|
|
|
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(defun dired-mark-confirm (op-symbol arg)
|
|
|
|
|
;; Request confirmation from the user that the operation described
|
|
|
|
|
;; by OP-SYMBOL is to be performed on the marked files.
|
|
|
|
|
;; Confirmation consists in a y-or-n question with a file list
|
|
|
|
|
;; pop-up unless OP-SYMBOL is a member of `dired-no-confirm'.
|
|
|
|
|
;; The files used are determined by ARG (as in dired-get-marked-files).
|
1997-03-20 12:39:57 +00:00
|
|
|
|
(or (eq dired-no-confirm t)
|
|
|
|
|
(memq op-symbol dired-no-confirm)
|
2005-05-15 21:34:47 +00:00
|
|
|
|
;; Pass t for DISTINGUISH-ONE-MARKED so that a single file which
|
|
|
|
|
;; is marked pops up a window. That will help the user see
|
|
|
|
|
;; it isn't the current line file.
|
|
|
|
|
(let ((files (dired-get-marked-files t arg nil t))
|
1992-11-03 09:25:26 +00:00
|
|
|
|
(string (if (eq op-symbol 'compress) "Compress or uncompress"
|
|
|
|
|
(capitalize (symbol-name op-symbol)))))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(dired-mark-pop-up nil op-symbol files (function y-or-n-p)
|
1992-11-03 09:25:26 +00:00
|
|
|
|
(concat string " "
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(dired-mark-prompt arg files) "? ")))))
|
|
|
|
|
|
|
|
|
|
(defun dired-map-over-marks-check (fun arg op-symbol &optional show-progress)
|
|
|
|
|
; "Map FUN over marked files (with second ARG like in dired-map-over-marks)
|
|
|
|
|
; and display failures.
|
|
|
|
|
|
|
|
|
|
; FUN takes zero args. It returns non-nil (the offending object, e.g.
|
|
|
|
|
; the short form of the filename) for a failure and probably logs a
|
|
|
|
|
; detailed error explanation using function `dired-log'.
|
|
|
|
|
|
|
|
|
|
; OP-SYMBOL is a symbol describing the operation performed (e.g.
|
|
|
|
|
; `compress'). It is used with `dired-mark-pop-up' to prompt the user
|
|
|
|
|
; (e.g. with `Compress * [2 files]? ') and to display errors (e.g.
|
|
|
|
|
; `Failed to compress 1 of 2 files - type W to see why ("foo")')
|
|
|
|
|
|
|
|
|
|
; SHOW-PROGRESS if non-nil means redisplay dired after each file."
|
|
|
|
|
(if (dired-mark-confirm op-symbol arg)
|
|
|
|
|
(let* ((total-list;; all of FUN's return values
|
|
|
|
|
(dired-map-over-marks (funcall fun) arg show-progress))
|
|
|
|
|
(total (length total-list))
|
|
|
|
|
(failures (delq nil total-list))
|
1992-11-03 09:25:26 +00:00
|
|
|
|
(count (length failures))
|
|
|
|
|
(string (if (eq op-symbol 'compress) "Compress or uncompress"
|
|
|
|
|
(capitalize (symbol-name op-symbol)))))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(if (not failures)
|
|
|
|
|
(message "%s: %d file%s."
|
1992-11-03 09:25:26 +00:00
|
|
|
|
string total (dired-plural-s total))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
;; end this bunch of errors:
|
|
|
|
|
(dired-log-summary
|
|
|
|
|
(format "Failed to %s %d of %d file%s"
|
1992-11-03 09:25:26 +00:00
|
|
|
|
(downcase string) count total (dired-plural-s total))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
failures)))))
|
|
|
|
|
|
|
|
|
|
(defvar dired-query-alist
|
|
|
|
|
'((?\y . y) (?\040 . y) ; `y' or SPC means accept once
|
|
|
|
|
(?n . n) (?\177 . n) ; `n' or DEL skips once
|
|
|
|
|
(?! . yes) ; `!' accepts rest
|
2003-02-14 09:56:30 +00:00
|
|
|
|
(?q . no) (?\e . no) ; `q' or ESC skips rest
|
1992-06-24 02:14:18 +00:00
|
|
|
|
;; None of these keys quit - use C-g for that.
|
|
|
|
|
))
|
|
|
|
|
|
2004-06-09 01:04:28 +00:00
|
|
|
|
;;;###autoload
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(defun dired-query (qs-var qs-prompt &rest qs-args)
|
|
|
|
|
;; Query user and return nil or t.
|
|
|
|
|
;; Store answer in symbol VAR (which must initially be bound to nil).
|
|
|
|
|
;; Format PROMPT with ARGS.
|
1992-08-03 21:49:55 +00:00
|
|
|
|
;; Binding variable help-form will help the user who types the help key.
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(let* ((char (symbol-value qs-var))
|
|
|
|
|
(action (cdr (assoc char dired-query-alist))))
|
|
|
|
|
(cond ((eq 'yes action)
|
|
|
|
|
t) ; accept, and don't ask again
|
|
|
|
|
((eq 'no action)
|
|
|
|
|
nil) ; skip, and don't ask again
|
|
|
|
|
(t;; no lasting effects from last time we asked - ask now
|
|
|
|
|
(let ((qprompt (concat qs-prompt
|
|
|
|
|
(if help-form
|
|
|
|
|
(format " [Type yn!q or %s] "
|
|
|
|
|
(key-description
|
|
|
|
|
(char-to-string help-char)))
|
|
|
|
|
" [Type y, n, q or !] ")))
|
|
|
|
|
result elt)
|
|
|
|
|
;; Actually it looks nicer without cursor-in-echo-area - you can
|
|
|
|
|
;; look at the dired buffer instead of at the prompt to decide.
|
|
|
|
|
(apply 'message qprompt qs-args)
|
|
|
|
|
(setq char (set qs-var (read-char)))
|
|
|
|
|
(while (not (setq elt (assoc char dired-query-alist)))
|
|
|
|
|
(message "Invalid char - type %c for help." help-char)
|
|
|
|
|
(ding)
|
|
|
|
|
(sit-for 1)
|
|
|
|
|
(apply 'message qprompt qs-args)
|
|
|
|
|
(setq char (set qs-var (read-char))))
|
2005-07-03 16:10:07 +00:00
|
|
|
|
;; Display the question with the answer.
|
2005-09-18 12:25:02 +00:00
|
|
|
|
(message "%s" (concat (apply 'format qprompt qs-args)
|
2005-07-03 16:10:07 +00:00
|
|
|
|
(char-to-string char)))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(memq (cdr elt) '(t y yes)))))))
|
2001-01-26 13:14:11 +00:00
|
|
|
|
|
1992-06-24 02:14:18 +00:00
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun dired-do-compress (&optional arg)
|
|
|
|
|
"Compress or uncompress marked (or next ARG) files."
|
|
|
|
|
(interactive "P")
|
|
|
|
|
(dired-map-over-marks-check (function dired-compress) arg 'compress t))
|
|
|
|
|
|
|
|
|
|
;; Commands for Emacs Lisp files - load and byte compile
|
|
|
|
|
|
|
|
|
|
(defun dired-byte-compile ()
|
|
|
|
|
;; Return nil for success, offending file name else.
|
|
|
|
|
(let* ((filename (dired-get-filename))
|
1994-07-13 05:10:06 +00:00
|
|
|
|
elc-file buffer-read-only failure)
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(condition-case err
|
|
|
|
|
(save-excursion (byte-compile-file filename))
|
|
|
|
|
(error
|
|
|
|
|
(setq failure err)))
|
1994-07-13 05:10:06 +00:00
|
|
|
|
(setq elc-file (byte-compile-dest-file filename))
|
1995-08-29 16:22:25 +00:00
|
|
|
|
(or (file-exists-p elc-file)
|
|
|
|
|
(setq failure t))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(if failure
|
|
|
|
|
(progn
|
|
|
|
|
(dired-log "Byte compile error for %s:\n%s\n" filename failure)
|
|
|
|
|
(dired-make-relative filename))
|
|
|
|
|
(dired-remove-file elc-file)
|
|
|
|
|
(forward-line) ; insert .elc after its .el file
|
|
|
|
|
(dired-add-file elc-file)
|
|
|
|
|
nil)))
|
|
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun dired-do-byte-compile (&optional arg)
|
|
|
|
|
"Byte compile marked (or next ARG) Emacs Lisp files."
|
|
|
|
|
(interactive "P")
|
|
|
|
|
(dired-map-over-marks-check (function dired-byte-compile) arg 'byte-compile t))
|
|
|
|
|
|
|
|
|
|
(defun dired-load ()
|
|
|
|
|
;; Return nil for success, offending file name else.
|
|
|
|
|
(let ((file (dired-get-filename)) failure)
|
|
|
|
|
(condition-case err
|
|
|
|
|
(load file nil nil t)
|
|
|
|
|
(error (setq failure err)))
|
|
|
|
|
(if (not failure)
|
|
|
|
|
nil
|
|
|
|
|
(dired-log "Load error for %s:\n%s\n" file failure)
|
|
|
|
|
(dired-make-relative file))))
|
|
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun dired-do-load (&optional arg)
|
|
|
|
|
"Load the marked (or next ARG) Emacs Lisp files."
|
|
|
|
|
(interactive "P")
|
|
|
|
|
(dired-map-over-marks-check (function dired-load) arg 'load t))
|
|
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun dired-do-redisplay (&optional arg test-for-subdir)
|
|
|
|
|
"Redisplay all marked (or next ARG) files.
|
|
|
|
|
If on a subdir line, redisplay that subdirectory. In that case,
|
2004-06-07 21:24:31 +00:00
|
|
|
|
a prefix arg lets you edit the `ls' switches used for the new listing.
|
|
|
|
|
|
|
|
|
|
Dired remembers switches specified with a prefix arg, so that reverting
|
|
|
|
|
the buffer will not reset them. However, using `dired-undo' to re-insert
|
|
|
|
|
or delete subdirectories can bypass this machinery. Hence, you sometimes
|
|
|
|
|
may have to reset some subdirectory switches after a `dired-undo'.
|
|
|
|
|
You can reset all subdirectory switches to the default using
|
2004-06-15 22:09:18 +00:00
|
|
|
|
\\<dired-mode-map>\\[dired-reset-subdir-switches].
|
2006-05-06 14:37:40 +00:00
|
|
|
|
See Info node `(emacs)Subdir switches' for more details."
|
1992-06-24 02:14:18 +00:00
|
|
|
|
;; Moves point if the next ARG files are redisplayed.
|
|
|
|
|
(interactive "P\np")
|
|
|
|
|
(if (and test-for-subdir (dired-get-subdir))
|
2004-06-06 02:26:46 +00:00
|
|
|
|
(let* ((dir (dired-get-subdir))
|
|
|
|
|
(switches (cdr (assoc-string dir dired-switches-alist))))
|
|
|
|
|
(dired-insert-subdir
|
|
|
|
|
dir
|
|
|
|
|
(when arg
|
|
|
|
|
(read-string "Switches for listing: "
|
|
|
|
|
(or switches
|
|
|
|
|
dired-subdir-switches
|
|
|
|
|
dired-actual-switches)))))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(message "Redisplaying...")
|
|
|
|
|
;; message much faster than making dired-map-over-marks show progress
|
1995-06-20 15:31:30 +00:00
|
|
|
|
(dired-uncache
|
|
|
|
|
(if (consp dired-directory) (car dired-directory) dired-directory))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(dired-map-over-marks (let ((fname (dired-get-filename)))
|
|
|
|
|
(message "Redisplaying... %s" fname)
|
|
|
|
|
(dired-update-file-line fname))
|
|
|
|
|
arg)
|
|
|
|
|
(dired-move-to-filename)
|
|
|
|
|
(message "Redisplaying...done")))
|
2004-06-07 21:24:31 +00:00
|
|
|
|
|
|
|
|
|
(defun dired-reset-subdir-switches ()
|
|
|
|
|
"Set `dired-switches-alist' to nil and revert dired buffer."
|
|
|
|
|
(interactive)
|
|
|
|
|
(setq dired-switches-alist nil)
|
|
|
|
|
(revert-buffer))
|
2001-01-26 13:14:11 +00:00
|
|
|
|
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(defun dired-update-file-line (file)
|
|
|
|
|
;; Delete the current line, and insert an entry for FILE.
|
|
|
|
|
;; If FILE is nil, then just delete the current line.
|
|
|
|
|
;; Keeps any marks that may be present in column one (doing this
|
|
|
|
|
;; here is faster than with dired-add-entry's optional arg).
|
|
|
|
|
;; Does not update other dired buffers. Use dired-relist-entry for that.
|
|
|
|
|
(beginning-of-line)
|
1992-08-03 03:44:51 +00:00
|
|
|
|
(let ((char (following-char)) (opoint (point))
|
|
|
|
|
(buffer-read-only))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(delete-region (point) (progn (forward-line 1) (point)))
|
|
|
|
|
(if file
|
|
|
|
|
(progn
|
1997-06-23 06:34:29 +00:00
|
|
|
|
(dired-add-entry file nil t)
|
1992-06-24 02:14:18 +00:00
|
|
|
|
;; Replace space by old marker without moving point.
|
|
|
|
|
;; Faster than goto+insdel inside a save-excursion?
|
|
|
|
|
(subst-char-in-region opoint (1+ opoint) ?\040 char))))
|
|
|
|
|
(dired-move-to-filename))
|
|
|
|
|
|
1993-12-23 03:34:57 +00:00
|
|
|
|
;;;###autoload
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(defun dired-add-file (filename &optional marker-char)
|
|
|
|
|
(dired-fun-in-all-buffers
|
1997-03-22 03:39:39 +00:00
|
|
|
|
(file-name-directory filename) (file-name-nondirectory filename)
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(function dired-add-entry) filename marker-char))
|
|
|
|
|
|
1997-06-23 06:34:29 +00:00
|
|
|
|
(defun dired-add-entry (filename &optional marker-char relative)
|
1992-06-24 02:14:18 +00:00
|
|
|
|
;; Add a new entry for FILENAME, optionally marking it
|
|
|
|
|
;; with MARKER-CHAR (a character, else dired-marker-char is used).
|
|
|
|
|
;; Note that this adds the entry `out of order' if files sorted by
|
|
|
|
|
;; time, etc.
|
|
|
|
|
;; At least this version inserts in the right subdirectory (if present).
|
|
|
|
|
;; And it skips "." or ".." (see `dired-trivial-filenames').
|
|
|
|
|
;; Hidden subdirs are exposed if a file is added there.
|
|
|
|
|
(setq filename (directory-file-name filename))
|
|
|
|
|
;; Entry is always for files, even if they happen to also be directories
|
1997-06-23 06:34:29 +00:00
|
|
|
|
(let* ((opoint (point))
|
2000-11-23 13:53:12 +00:00
|
|
|
|
(cur-dir (dired-current-directory))
|
|
|
|
|
(orig-file-name filename)
|
|
|
|
|
(directory (if relative cur-dir (file-name-directory filename)))
|
|
|
|
|
reason)
|
1997-06-23 06:34:29 +00:00
|
|
|
|
(setq filename
|
|
|
|
|
(if relative
|
|
|
|
|
(file-relative-name filename directory)
|
|
|
|
|
(file-name-nondirectory filename))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
reason
|
|
|
|
|
(catch 'not-found
|
|
|
|
|
(if (string= directory cur-dir)
|
|
|
|
|
(progn
|
|
|
|
|
(skip-chars-forward "^\r\n")
|
|
|
|
|
(if (eq (following-char) ?\r)
|
|
|
|
|
(dired-unhide-subdir))
|
|
|
|
|
;; We are already where we should be, except when
|
2002-09-15 01:52:08 +00:00
|
|
|
|
;; point is before the subdir line or its total line.
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(let ((p (dired-after-subdir-garbage cur-dir)))
|
|
|
|
|
(if (< (point) p)
|
|
|
|
|
(goto-char p))))
|
|
|
|
|
;; else try to find correct place to insert
|
|
|
|
|
(if (dired-goto-subdir directory)
|
2000-11-23 13:53:12 +00:00
|
|
|
|
(progn ;; unhide if necessary
|
|
|
|
|
(if (looking-at "\r") ;; point is at end of subdir line
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(dired-unhide-subdir))
|
|
|
|
|
;; found - skip subdir and `total' line
|
|
|
|
|
;; and uninteresting files like . and ..
|
|
|
|
|
;; This better not moves into the next subdir!
|
|
|
|
|
(dired-goto-next-nontrivial-file))
|
|
|
|
|
;; not found
|
|
|
|
|
(throw 'not-found "Subdir not found")))
|
1994-04-12 05:12:33 +00:00
|
|
|
|
(let (buffer-read-only opoint)
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(beginning-of-line)
|
1994-04-12 05:12:33 +00:00
|
|
|
|
(setq opoint (point))
|
2002-09-15 01:52:08 +00:00
|
|
|
|
;; Don't expand `.'. Show just the file name within directory.
|
1994-04-01 18:51:17 +00:00
|
|
|
|
(let ((default-directory directory))
|
2002-09-15 01:52:08 +00:00
|
|
|
|
(dired-insert-directory directory
|
|
|
|
|
(concat dired-actual-switches "d")
|
|
|
|
|
(list filename)))
|
2002-10-17 07:25:35 +00:00
|
|
|
|
(goto-char opoint)
|
2002-09-15 01:52:08 +00:00
|
|
|
|
;; Put in desired marker char.
|
|
|
|
|
(when marker-char
|
|
|
|
|
(let ((dired-marker-char
|
|
|
|
|
(if (integerp marker-char) marker-char dired-marker-char)))
|
2002-09-16 06:31:43 +00:00
|
|
|
|
(dired-mark nil)))
|
1995-03-31 00:18:38 +00:00
|
|
|
|
;; Compensate for a bug in ange-ftp.
|
|
|
|
|
;; It inserts the file's absolute name, rather than
|
|
|
|
|
;; the relative one. That may be hard to fix since it
|
|
|
|
|
;; is probably controlled by something in ftp.
|
2002-04-17 09:54:47 +00:00
|
|
|
|
(goto-char opoint)
|
2000-11-27 12:11:33 +00:00
|
|
|
|
(let ((inserted-name (dired-get-filename 'verbatim)))
|
1995-03-31 00:18:38 +00:00
|
|
|
|
(if (file-name-directory inserted-name)
|
2002-09-15 01:52:08 +00:00
|
|
|
|
(let (props)
|
1995-03-31 00:18:38 +00:00
|
|
|
|
(end-of-line)
|
2002-09-15 01:52:08 +00:00
|
|
|
|
(forward-char (- (length inserted-name)))
|
|
|
|
|
(setq props (text-properties-at (point)))
|
|
|
|
|
(delete-char (length inserted-name))
|
|
|
|
|
(let ((pt (point)))
|
|
|
|
|
(insert filename)
|
|
|
|
|
(set-text-properties pt (point) props))
|
1995-03-31 00:18:38 +00:00
|
|
|
|
(forward-char 1))
|
|
|
|
|
(forward-line 1)))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(forward-line -1)
|
2000-11-23 13:53:12 +00:00
|
|
|
|
(if dired-after-readin-hook ;; the subdir-alist is not affected...
|
|
|
|
|
(save-excursion ;; ...so we can run it right now:
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(save-restriction
|
|
|
|
|
(beginning-of-line)
|
|
|
|
|
(narrow-to-region (point) (save-excursion
|
|
|
|
|
(forward-line 1) (point)))
|
|
|
|
|
(run-hooks 'dired-after-readin-hook))))
|
|
|
|
|
(dired-move-to-filename))
|
|
|
|
|
;; return nil if all went well
|
|
|
|
|
nil))
|
2000-11-23 13:53:12 +00:00
|
|
|
|
(if reason ; don't move away on failure
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(goto-char opoint))
|
2000-11-23 13:53:12 +00:00
|
|
|
|
(not reason))) ; return t on success, nil else
|
1992-06-24 02:14:18 +00:00
|
|
|
|
|
|
|
|
|
(defun dired-after-subdir-garbage (dir)
|
|
|
|
|
;; Return pos of first file line of DIR, skipping header and total
|
|
|
|
|
;; or wildcard lines.
|
|
|
|
|
;; Important: never moves into the next subdir.
|
|
|
|
|
;; DIR is assumed to be unhidden.
|
|
|
|
|
;; Will probably be redefined for VMS etc.
|
|
|
|
|
(save-excursion
|
|
|
|
|
(or (dired-goto-subdir dir) (error "This cannot happen"))
|
|
|
|
|
(forward-line 1)
|
|
|
|
|
(while (and (not (eolp)) ; don't cross subdir boundary
|
|
|
|
|
(not (dired-move-to-filename)))
|
|
|
|
|
(forward-line 1))
|
|
|
|
|
(point)))
|
|
|
|
|
|
1993-12-23 03:34:57 +00:00
|
|
|
|
;;;###autoload
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(defun dired-remove-file (file)
|
|
|
|
|
(dired-fun-in-all-buffers
|
1997-03-22 03:39:39 +00:00
|
|
|
|
(file-name-directory file) (file-name-nondirectory file)
|
|
|
|
|
(function dired-remove-entry) file))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
|
|
|
|
|
(defun dired-remove-entry (file)
|
|
|
|
|
(save-excursion
|
|
|
|
|
(and (dired-goto-file file)
|
|
|
|
|
(let (buffer-read-only)
|
|
|
|
|
(delete-region (progn (beginning-of-line) (point))
|
|
|
|
|
(save-excursion (forward-line 1) (point)))))))
|
|
|
|
|
|
1993-12-23 03:34:57 +00:00
|
|
|
|
;;;###autoload
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(defun dired-relist-file (file)
|
2002-09-15 01:52:08 +00:00
|
|
|
|
"Create or update the line for FILE in all Dired buffers it would belong in."
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(dired-fun-in-all-buffers (file-name-directory file)
|
1997-03-22 03:39:39 +00:00
|
|
|
|
(file-name-nondirectory file)
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(function dired-relist-entry) file))
|
|
|
|
|
|
|
|
|
|
(defun dired-relist-entry (file)
|
|
|
|
|
;; Relist the line for FILE, or just add it if it did not exist.
|
1998-08-13 23:01:05 +00:00
|
|
|
|
;; FILE must be an absolute file name.
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(let (buffer-read-only marker)
|
|
|
|
|
;; If cursor is already on FILE's line delete-region will cause
|
|
|
|
|
;; save-excursion to fail because of floating makers,
|
|
|
|
|
;; moving point to beginning of line. Sigh.
|
|
|
|
|
(save-excursion
|
|
|
|
|
(and (dired-goto-file file)
|
|
|
|
|
(delete-region (progn (beginning-of-line)
|
|
|
|
|
(setq marker (following-char))
|
|
|
|
|
(point))
|
|
|
|
|
(save-excursion (forward-line 1) (point))))
|
|
|
|
|
(setq file (directory-file-name file))
|
|
|
|
|
(dired-add-entry file (if (eq ?\040 marker) nil marker)))))
|
2001-01-26 13:14:11 +00:00
|
|
|
|
|
1992-06-24 02:14:18 +00:00
|
|
|
|
;;; Copy, move/rename, making hard and symbolic links
|
|
|
|
|
|
1997-05-28 04:22:11 +00:00
|
|
|
|
(defcustom dired-backup-overwrite nil
|
1992-06-24 02:14:18 +00:00
|
|
|
|
"*Non-nil if Dired should ask about making backups before overwriting files.
|
1997-05-28 04:22:11 +00:00
|
|
|
|
Special value `always' suppresses confirmation."
|
|
|
|
|
:type '(choice (const :tag "off" nil)
|
|
|
|
|
(const :tag "suppress" always)
|
1998-06-24 08:55:53 +00:00
|
|
|
|
(other :tag "ask" t))
|
1997-05-28 04:22:11 +00:00
|
|
|
|
:group 'dired)
|
1992-06-24 02:14:18 +00:00
|
|
|
|
|
2008-04-06 20:11:37 +00:00
|
|
|
|
;; This is a fluid var used in dired-handle-overwrite. It should be
|
|
|
|
|
;; let-bound whenever dired-copy-file etc are called. See
|
|
|
|
|
;; dired-create-files for an example.
|
|
|
|
|
(defvar dired-overwrite-confirmed)
|
1992-08-03 03:44:51 +00:00
|
|
|
|
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(defun dired-handle-overwrite (to)
|
2002-09-15 01:52:08 +00:00
|
|
|
|
;; Save old version of file TO that is to be overwritten.
|
1992-08-03 03:44:51 +00:00
|
|
|
|
;; `dired-overwrite-confirmed' and `overwrite-backup-query' are fluid vars
|
1992-06-24 02:14:18 +00:00
|
|
|
|
;; from dired-create-files.
|
1996-05-04 05:30:37 +00:00
|
|
|
|
(let (backup)
|
2008-04-06 00:03:38 +00:00
|
|
|
|
(when (and dired-backup-overwrite
|
|
|
|
|
dired-overwrite-confirmed
|
|
|
|
|
(setq backup (car (find-backup-file-name to)))
|
|
|
|
|
(or (eq 'always dired-backup-overwrite)
|
|
|
|
|
(dired-query 'overwrite-backup-query
|
|
|
|
|
"Make backup for existing file `%s'? "
|
|
|
|
|
to)))
|
|
|
|
|
(rename-file to backup 0) ; confirm overwrite of old backup
|
|
|
|
|
(dired-relist-entry backup))))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
|
1993-12-23 03:34:57 +00:00
|
|
|
|
;;;###autoload
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(defun dired-copy-file (from to ok-flag)
|
|
|
|
|
(dired-handle-overwrite to)
|
2006-09-11 02:25:00 +00:00
|
|
|
|
(dired-copy-file-recursive from to ok-flag dired-copy-preserve-time t
|
|
|
|
|
dired-recursive-copies))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
|
2007-11-22 13:49:34 +00:00
|
|
|
|
(declare-function make-symbolic-link "fileio.c")
|
|
|
|
|
|
1999-09-16 19:29:30 +00:00
|
|
|
|
(defun dired-copy-file-recursive (from to ok-flag &optional
|
|
|
|
|
preserve-time top recursive)
|
2006-09-11 02:25:00 +00:00
|
|
|
|
(let ((attrs (file-attributes from))
|
|
|
|
|
dirfailed)
|
2005-05-19 15:42:01 +00:00
|
|
|
|
(if (and recursive
|
|
|
|
|
(eq t (car attrs))
|
|
|
|
|
(or (eq recursive 'always)
|
2005-09-25 Romain Francoise <romain@orebokech.com>
* dired-aux.el (dired-copy-file-recursive):
* dired.el (dired-delete-file):
* ediff-mult.el (ediff-dir-diff-copy-file):
* ediff-util.el (ediff-test-save-region):
* forms.el (forms-mode):
* ido.el (ido-file-internal, ido-delete-file-at-head):
* log-edit.el (log-edit-done):
* ses.el (ses-yank-resize):
* play/gomoku.el (gomoku-human-plays, gomoku)
(gomoku-human-resigns, gomoku-prompt-for-other-game)
(gomoku-offer-a-draw):
* play/landmark.el (lm-human-resigns, lm):
* net/eudcb-ldap.el (eudc-ldap-check-base):
* play/mpuz.el (mpuz-offer-abort, mpuz-try-letter, mpuz-close-game):
* progmodes/ebrowse.el (ebrowse-find-pattern):
* progmodes/idlw-shell.el (idlwave-shell-set-bp-check):
* textmodes/reftex-index.el (reftex-index-initialize-phrases-buffer):
End `yes-or-no-p' and `y-or-n-p' prompts with question mark and
space.
* vc.el (vc-delete-file):
* play/gomoku.el (gomoku-terminate-game, gomoku)
(gomoku-prompt-for-move, gomoku-human-takes-back):
* play/landmark.el (lm-human-takes-back, lm-prompt-for-move)
(lm-start-robot, lm-human-plays): Remove extraneous spaces in
messages.
2005-09-24 23:26:28 +00:00
|
|
|
|
(yes-or-no-p (format "Recursive copies of %s? " from))))
|
2005-05-19 15:42:01 +00:00
|
|
|
|
;; This is a directory.
|
2007-10-31 18:14:41 +00:00
|
|
|
|
(let ((mode (file-modes from))
|
|
|
|
|
(files
|
2006-09-11 02:25:00 +00:00
|
|
|
|
(condition-case err
|
|
|
|
|
(directory-files from nil dired-re-no-dot)
|
|
|
|
|
(file-error
|
|
|
|
|
(push (dired-make-relative from)
|
|
|
|
|
dired-create-files-failures)
|
|
|
|
|
(dired-log "Copying error for %s:\n%s\n" from err)
|
|
|
|
|
(setq dirfailed t)
|
|
|
|
|
nil))))
|
2005-05-19 15:42:01 +00:00
|
|
|
|
(if (eq recursive 'top) (setq recursive 'always)) ; Don't ask any more.
|
2006-09-11 02:25:00 +00:00
|
|
|
|
(unless dirfailed
|
|
|
|
|
(if (file-exists-p to)
|
|
|
|
|
(or top (dired-handle-overwrite to))
|
|
|
|
|
(condition-case err
|
2007-10-31 18:14:41 +00:00
|
|
|
|
(progn
|
|
|
|
|
(make-directory to)
|
|
|
|
|
(set-file-modes to #o700))
|
2006-09-11 02:25:00 +00:00
|
|
|
|
(file-error
|
|
|
|
|
(push (dired-make-relative from)
|
|
|
|
|
dired-create-files-failures)
|
|
|
|
|
(setq files nil)
|
|
|
|
|
(dired-log "Copying error for %s:\n%s\n" from err)))))
|
2006-11-05 15:00:31 +00:00
|
|
|
|
(dolist (file files)
|
|
|
|
|
(let ((thisfrom (expand-file-name file from))
|
|
|
|
|
(thisto (expand-file-name file to)))
|
|
|
|
|
;; Catch errors copying within a directory,
|
|
|
|
|
;; and report them through the dired log mechanism
|
|
|
|
|
;; just as our caller will do for the top level files.
|
|
|
|
|
(condition-case err
|
|
|
|
|
(dired-copy-file-recursive
|
|
|
|
|
thisfrom thisto
|
|
|
|
|
ok-flag preserve-time nil recursive)
|
|
|
|
|
(file-error
|
|
|
|
|
(push (dired-make-relative thisfrom)
|
|
|
|
|
dired-create-files-failures)
|
2007-10-31 18:14:41 +00:00
|
|
|
|
(dired-log "Copying error for %s:\n%s\n" thisfrom err)))))
|
|
|
|
|
(when (file-directory-p to)
|
|
|
|
|
(set-file-modes to mode)))
|
2005-05-19 15:42:01 +00:00
|
|
|
|
;; Not a directory.
|
|
|
|
|
(or top (dired-handle-overwrite to))
|
2006-09-11 02:25:00 +00:00
|
|
|
|
(condition-case err
|
|
|
|
|
(if (stringp (car attrs))
|
|
|
|
|
;; It is a symlink
|
|
|
|
|
(make-symbolic-link (car attrs) to ok-flag)
|
|
|
|
|
(copy-file from to ok-flag dired-copy-preserve-time))
|
2007-06-27 21:11:04 +00:00
|
|
|
|
(file-date-error
|
2006-09-11 02:25:00 +00:00
|
|
|
|
(push (dired-make-relative from)
|
|
|
|
|
dired-create-files-failures)
|
2006-11-05 15:00:31 +00:00
|
|
|
|
(dired-log "Can't set date on %s:\n%s\n" from err))))))
|
1999-09-16 19:29:30 +00:00
|
|
|
|
|
1993-12-23 03:34:57 +00:00
|
|
|
|
;;;###autoload
|
2002-09-15 01:52:08 +00:00
|
|
|
|
(defun dired-rename-file (file newname ok-if-already-exists)
|
|
|
|
|
(dired-handle-overwrite newname)
|
|
|
|
|
(rename-file file newname ok-if-already-exists) ; error is caught in -create-files
|
1992-06-24 02:14:18 +00:00
|
|
|
|
;; Silently rename the visited file of any buffer visiting this file.
|
2002-09-15 01:52:08 +00:00
|
|
|
|
(and (get-file-buffer file)
|
|
|
|
|
(with-current-buffer (get-file-buffer file)
|
|
|
|
|
(set-visited-file-name newname nil t)))
|
|
|
|
|
(dired-remove-file file)
|
1992-06-24 02:14:18 +00:00
|
|
|
|
;; See if it's an inserted subdir, and rename that, too.
|
2002-09-15 01:52:08 +00:00
|
|
|
|
(dired-rename-subdir file newname))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
|
|
|
|
|
(defun dired-rename-subdir (from-dir to-dir)
|
|
|
|
|
(setq from-dir (file-name-as-directory from-dir)
|
|
|
|
|
to-dir (file-name-as-directory to-dir))
|
1997-03-22 03:39:39 +00:00
|
|
|
|
(dired-fun-in-all-buffers from-dir nil
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(function dired-rename-subdir-1) from-dir to-dir)
|
|
|
|
|
;; Update visited file name of all affected buffers
|
1994-09-16 21:35:29 +00:00
|
|
|
|
(let ((expanded-from-dir (expand-file-name from-dir))
|
|
|
|
|
(blist (buffer-list)))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(while blist
|
|
|
|
|
(save-excursion
|
1994-09-16 21:35:29 +00:00
|
|
|
|
(set-buffer (car blist))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(if (and buffer-file-name
|
1994-09-16 21:35:29 +00:00
|
|
|
|
(dired-in-this-tree buffer-file-name expanded-from-dir))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(let ((modflag (buffer-modified-p))
|
2001-01-26 13:14:11 +00:00
|
|
|
|
(to-file (dired-replace-in-string
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(concat "^" (regexp-quote from-dir))
|
|
|
|
|
to-dir
|
|
|
|
|
buffer-file-name)))
|
|
|
|
|
(set-visited-file-name to-file)
|
|
|
|
|
(set-buffer-modified-p modflag))))
|
|
|
|
|
(setq blist (cdr blist)))))
|
|
|
|
|
|
|
|
|
|
(defun dired-rename-subdir-1 (dir to)
|
|
|
|
|
;; Rename DIR to TO in headerlines and dired-subdir-alist, if DIR or
|
|
|
|
|
;; one of its subdirectories is expanded in this buffer.
|
1994-09-16 21:35:29 +00:00
|
|
|
|
(let ((expanded-dir (expand-file-name dir))
|
|
|
|
|
(alist dired-subdir-alist)
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(elt nil))
|
|
|
|
|
(while alist
|
|
|
|
|
(setq elt (car alist)
|
|
|
|
|
alist (cdr alist))
|
1994-09-16 21:35:29 +00:00
|
|
|
|
(if (dired-in-this-tree (car elt) expanded-dir)
|
1992-06-24 02:14:18 +00:00
|
|
|
|
;; ELT's subdir is affected by the rename
|
|
|
|
|
(dired-rename-subdir-2 elt dir to)))
|
|
|
|
|
(if (equal dir default-directory)
|
|
|
|
|
;; if top level directory was renamed, lots of things have to be
|
|
|
|
|
;; updated:
|
|
|
|
|
(progn
|
|
|
|
|
(dired-unadvertise dir) ; we no longer dired DIR...
|
|
|
|
|
(setq default-directory to
|
|
|
|
|
dired-directory (expand-file-name;; this is correct
|
|
|
|
|
;; with and without wildcards
|
|
|
|
|
(file-name-nondirectory dired-directory)
|
|
|
|
|
to))
|
|
|
|
|
(let ((new-name (file-name-nondirectory
|
|
|
|
|
(directory-file-name dired-directory))))
|
|
|
|
|
;; try to rename buffer, but just leave old name if new
|
|
|
|
|
;; name would already exist (don't try appending "<%d>")
|
|
|
|
|
(or (get-buffer new-name)
|
|
|
|
|
(rename-buffer new-name)))
|
|
|
|
|
;; ... we dired TO now:
|
|
|
|
|
(dired-advertise)))))
|
|
|
|
|
|
|
|
|
|
(defun dired-rename-subdir-2 (elt dir to)
|
2004-06-06 02:26:46 +00:00
|
|
|
|
;; Update the headerline and dired-subdir-alist element, as well as
|
|
|
|
|
;; dired-switches-alist element, of directory described by
|
|
|
|
|
;; alist-element ELT to reflect the moving of DIR to TO. Thus, ELT
|
|
|
|
|
;; describes either DIR itself or a subdir of DIR.
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(save-excursion
|
|
|
|
|
(let ((regexp (regexp-quote (directory-file-name dir)))
|
|
|
|
|
(newtext (directory-file-name to))
|
|
|
|
|
buffer-read-only)
|
|
|
|
|
(goto-char (dired-get-subdir-min elt))
|
|
|
|
|
;; Update subdir headerline in buffer
|
|
|
|
|
(if (not (looking-at dired-subdir-regexp))
|
|
|
|
|
(error "%s not found where expected - dired-subdir-alist broken?"
|
|
|
|
|
dir)
|
|
|
|
|
(goto-char (match-beginning 1))
|
|
|
|
|
(if (re-search-forward regexp (match-end 1) t)
|
|
|
|
|
(replace-match newtext t t)
|
|
|
|
|
(error "Expected to find `%s' in headerline of %s" dir (car elt))))
|
2004-06-06 02:26:46 +00:00
|
|
|
|
;; Update buffer-local dired-subdir-alist and dired-switches-alist
|
|
|
|
|
(let ((cons (assoc-string (car elt) dired-switches-alist))
|
|
|
|
|
(cur-dir (dired-normalize-subdir
|
|
|
|
|
(dired-replace-in-string regexp newtext (car elt)))))
|
|
|
|
|
(setcar elt cur-dir)
|
|
|
|
|
(when cons (setcar cons cur-dir))))))
|
2001-01-26 13:14:11 +00:00
|
|
|
|
|
1992-06-24 02:14:18 +00:00
|
|
|
|
;; The basic function for half a dozen variations on cp/mv/ln/ln -s.
|
|
|
|
|
(defun dired-create-files (file-creator operation fn-list name-constructor
|
|
|
|
|
&optional marker-char)
|
|
|
|
|
|
|
|
|
|
;; Create a new file for each from a list of existing files. The user
|
|
|
|
|
;; is queried, dired buffers are updated, and at the end a success or
|
|
|
|
|
;; failure message is displayed
|
|
|
|
|
|
|
|
|
|
;; FILE-CREATOR must accept three args: oldfile newfile ok-if-already-exists
|
|
|
|
|
|
|
|
|
|
;; It is called for each file and must create newfile, the entry of
|
|
|
|
|
;; which will be added. The user will be queried if the file already
|
|
|
|
|
;; exists. If oldfile is removed by FILE-CREATOR (i.e, it is a
|
|
|
|
|
;; rename), it is FILE-CREATOR's responsibility to update dired
|
1996-01-05 22:21:28 +00:00
|
|
|
|
;; buffers. FILE-CREATOR must abort by signaling a file-error if it
|
1992-06-24 02:14:18 +00:00
|
|
|
|
;; could not create newfile. The error is caught and logged.
|
|
|
|
|
|
|
|
|
|
;; OPERATION (a capitalized string, e.g. `Copy') describes the
|
|
|
|
|
;; operation performed. It is used for error logging.
|
|
|
|
|
|
1998-08-13 23:01:05 +00:00
|
|
|
|
;; FN-LIST is the list of files to copy (full absolute file names).
|
1992-06-24 02:14:18 +00:00
|
|
|
|
|
|
|
|
|
;; NAME-CONSTRUCTOR returns a newfile for every oldfile, or nil to
|
|
|
|
|
;; skip. If it skips files for other reasons than a direct user
|
|
|
|
|
;; query, it is supposed to tell why (using dired-log).
|
|
|
|
|
|
|
|
|
|
;; Optional MARKER-CHAR is a character with which to mark every
|
|
|
|
|
;; newfile's entry, or t to use the current marker character if the
|
|
|
|
|
;; oldfile was marked.
|
|
|
|
|
|
2006-09-11 02:25:00 +00:00
|
|
|
|
(let (dired-create-files-failures failures
|
|
|
|
|
skipped (success-count 0) (total (length fn-list)))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(let (to overwrite-query
|
|
|
|
|
overwrite-backup-query) ; for dired-handle-overwrite
|
2008-03-26 03:34:07 +00:00
|
|
|
|
(dolist (from fn-list)
|
|
|
|
|
(setq to (funcall name-constructor from))
|
|
|
|
|
(if (equal to from)
|
|
|
|
|
(progn
|
|
|
|
|
(setq to nil)
|
|
|
|
|
(dired-log "Cannot %s to same file: %s\n"
|
|
|
|
|
(downcase operation) from)))
|
|
|
|
|
(if (not to)
|
|
|
|
|
(setq skipped (cons (dired-make-relative from) skipped))
|
|
|
|
|
(let* ((overwrite (file-exists-p to))
|
|
|
|
|
(dired-overwrite-confirmed ; for dired-handle-overwrite
|
|
|
|
|
(and overwrite
|
|
|
|
|
(let ((help-form '(format "\
|
1992-06-24 02:14:18 +00:00
|
|
|
|
Type SPC or `y' to overwrite file `%s',
|
|
|
|
|
DEL or `n' to skip to next,
|
|
|
|
|
ESC or `q' to not overwrite any of the remaining files,
|
|
|
|
|
`!' to overwrite all remaining files with no more questions." to)))
|
2008-03-26 03:34:07 +00:00
|
|
|
|
(dired-query 'overwrite-query
|
|
|
|
|
"Overwrite `%s'?" to))))
|
|
|
|
|
;; must determine if FROM is marked before file-creator
|
|
|
|
|
;; gets a chance to delete it (in case of a move).
|
|
|
|
|
(actual-marker-char
|
|
|
|
|
(cond ((integerp marker-char) marker-char)
|
|
|
|
|
(marker-char (dired-file-marker from)) ; slow
|
|
|
|
|
(t nil))))
|
|
|
|
|
(condition-case err
|
|
|
|
|
(progn
|
|
|
|
|
(funcall file-creator from to dired-overwrite-confirmed)
|
|
|
|
|
(if overwrite
|
|
|
|
|
;; If we get here, file-creator hasn't been aborted
|
|
|
|
|
;; and the old entry (if any) has to be deleted
|
|
|
|
|
;; before adding the new entry.
|
|
|
|
|
(dired-remove-file to))
|
|
|
|
|
(setq success-count (1+ success-count))
|
|
|
|
|
(message "%s: %d of %d" operation success-count total)
|
|
|
|
|
(dired-add-file to actual-marker-char))
|
|
|
|
|
(file-error ; FILE-CREATOR aborted
|
|
|
|
|
(progn
|
|
|
|
|
(push (dired-make-relative from)
|
|
|
|
|
failures)
|
|
|
|
|
(dired-log "%s `%s' to `%s' failed:\n%s\n"
|
|
|
|
|
operation from to err))))))))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(cond
|
2006-09-11 02:25:00 +00:00
|
|
|
|
(dired-create-files-failures
|
|
|
|
|
(setq failures (nconc failures dired-create-files-failures))
|
|
|
|
|
(dired-log-summary
|
|
|
|
|
(format "%s failed for %d file%s in %d requests"
|
|
|
|
|
operation (length failures)
|
|
|
|
|
(dired-plural-s (length failures))
|
|
|
|
|
total)
|
|
|
|
|
failures))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(failures
|
|
|
|
|
(dired-log-summary
|
|
|
|
|
(format "%s failed for %d of %d file%s"
|
2006-09-11 02:25:00 +00:00
|
|
|
|
operation (length failures)
|
|
|
|
|
total (dired-plural-s total))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
failures))
|
|
|
|
|
(skipped
|
|
|
|
|
(dired-log-summary
|
|
|
|
|
(format "%s: %d of %d file%s skipped"
|
|
|
|
|
operation (length skipped) total
|
|
|
|
|
(dired-plural-s total))
|
|
|
|
|
skipped))
|
|
|
|
|
(t
|
|
|
|
|
(message "%s: %s file%s"
|
|
|
|
|
operation success-count (dired-plural-s success-count)))))
|
|
|
|
|
(dired-move-to-filename))
|
2001-01-26 13:14:11 +00:00
|
|
|
|
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(defun dired-do-create-files (op-symbol file-creator operation arg
|
2000-10-04 23:35:52 +00:00
|
|
|
|
&optional marker-char op1
|
|
|
|
|
how-to)
|
|
|
|
|
"Create a new file for each marked file.
|
|
|
|
|
Prompts user for target, which is a directory in which to create
|
|
|
|
|
the new files. Target may be a plain file if only one marked
|
2001-04-27 15:40:29 +00:00
|
|
|
|
file exists. The way the default for the target directory is
|
|
|
|
|
computed depends on the value of `dired-dwim-target-directory'.
|
2000-10-04 23:35:52 +00:00
|
|
|
|
OP-SYMBOL is the symbol for the operation. Function `dired-mark-pop-up'
|
|
|
|
|
will determine whether pop-ups are appropriate for this OP-SYMBOL.
|
|
|
|
|
FILE-CREATOR and OPERATION as in `dired-create-files'.
|
|
|
|
|
ARG as in `dired-get-marked-files'.
|
|
|
|
|
Optional arg MARKER-CHAR as in `dired-create-files'.
|
|
|
|
|
Optional arg OP1 is an alternate form for OPERATION if there is
|
|
|
|
|
only one file.
|
|
|
|
|
Optional arg HOW-TO is used to set the value of the into-dir variable
|
|
|
|
|
which determines how to treat target.
|
|
|
|
|
If into-dir is set to nil then target is not regarded as a directory,
|
|
|
|
|
there must be exactly one marked file, else error.
|
|
|
|
|
Else if into-dir is set to a list, then target is a generalized
|
|
|
|
|
directory (e.g. some sort of archive). The first element of into-dir
|
|
|
|
|
must be a function with at least four arguments:
|
|
|
|
|
operation as OPERATION above.
|
|
|
|
|
rfn-list a list of the relative names for the marked files.
|
|
|
|
|
fn-list a list of the absolute names for the marked files.
|
|
|
|
|
target.
|
|
|
|
|
The rest of into-dir are optional arguments.
|
|
|
|
|
Else into-dir is not a list. Target is a directory.
|
|
|
|
|
The marked file(s) are created inside the target directory.
|
|
|
|
|
|
|
|
|
|
If HOW-TO is not given (or nil), then into-dir is set to true if
|
|
|
|
|
target is a directory and otherwise to nil.
|
|
|
|
|
Else if HOW-TO is t, then into-dir is set to nil.
|
|
|
|
|
Else HOW-TO is assumed to be a function of one argument, target,
|
|
|
|
|
that looks at target and returns a value for the into-dir
|
|
|
|
|
variable. The function `dired-into-dir-with-symlinks' is provided
|
|
|
|
|
for the case (common when creating symlinks) that symbolic
|
|
|
|
|
links to directories are not to be considered as directories
|
|
|
|
|
(as `file-directory-p' would if HOW-TO had been nil)."
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(or op1 (setq op1 operation))
|
|
|
|
|
(let* ((fn-list (dired-get-marked-files nil arg))
|
1999-09-16 19:29:30 +00:00
|
|
|
|
(rfn-list (mapcar (function dired-make-relative) fn-list))
|
|
|
|
|
(dired-one-file ; fluid variable inside dired-create-files
|
|
|
|
|
(and (consp fn-list) (null (cdr fn-list)) (car fn-list)))
|
2000-11-28 16:43:45 +00:00
|
|
|
|
(target-dir (dired-dwim-target-directory))
|
|
|
|
|
(default (and dired-one-file
|
|
|
|
|
(expand-file-name (file-name-nondirectory (car fn-list))
|
|
|
|
|
target-dir)))
|
1999-09-16 19:29:30 +00:00
|
|
|
|
(target (expand-file-name ; fluid variable inside dired-create-files
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(dired-mark-read-file-name
|
1999-09-16 19:29:30 +00:00
|
|
|
|
(concat (if dired-one-file op1 operation) " %s to: ")
|
2000-11-28 16:43:45 +00:00
|
|
|
|
target-dir op-symbol arg rfn-list default)))
|
2000-08-08 10:51:51 +00:00
|
|
|
|
(into-dir (cond ((null how-to)
|
|
|
|
|
;; Allow DOS/Windows users to change the letter
|
|
|
|
|
;; case of a directory. If we don't test these
|
|
|
|
|
;; conditions up front, file-directory-p below
|
|
|
|
|
;; will return t because the filesystem is
|
|
|
|
|
;; case-insensitive, and Emacs will try to move
|
|
|
|
|
;; foo -> foo/foo, which fails.
|
2003-01-31 15:24:20 +00:00
|
|
|
|
(if (and (memq system-type '(ms-dos windows-nt cygwin))
|
2000-08-08 10:51:51 +00:00
|
|
|
|
(eq op-symbol 'move)
|
|
|
|
|
dired-one-file
|
|
|
|
|
(string= (downcase
|
|
|
|
|
(expand-file-name (car fn-list)))
|
|
|
|
|
(downcase
|
|
|
|
|
(expand-file-name target)))
|
|
|
|
|
(not (string=
|
|
|
|
|
(file-name-nondirectory (car fn-list))
|
|
|
|
|
(file-name-nondirectory target))))
|
|
|
|
|
nil
|
|
|
|
|
(file-directory-p target)))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
((eq how-to t) nil)
|
|
|
|
|
(t (funcall how-to target)))))
|
1999-09-16 19:29:30 +00:00
|
|
|
|
(if (and (consp into-dir) (functionp (car into-dir)))
|
|
|
|
|
(apply (car into-dir) operation rfn-list fn-list target (cdr into-dir))
|
|
|
|
|
(if (not (or dired-one-file into-dir))
|
|
|
|
|
(error "Marked %s: target must be a directory: %s" operation target))
|
|
|
|
|
;; rename-file bombs when moving directories unless we do this:
|
|
|
|
|
(or into-dir (setq target (directory-file-name target)))
|
|
|
|
|
(dired-create-files
|
|
|
|
|
file-creator operation fn-list
|
|
|
|
|
(if into-dir ; target is a directory
|
|
|
|
|
;; This function uses fluid variable target when called
|
|
|
|
|
;; inside dired-create-files:
|
|
|
|
|
(function
|
|
|
|
|
(lambda (from)
|
|
|
|
|
(expand-file-name (file-name-nondirectory from) target)))
|
|
|
|
|
(function (lambda (from) target)))
|
|
|
|
|
marker-char))))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
|
|
|
|
|
;; Read arguments for a marked-files command that wants a file name,
|
|
|
|
|
;; perhaps popping up the list of marked files.
|
|
|
|
|
;; ARG is the prefix arg and indicates whether the files came from
|
|
|
|
|
;; marks (ARG=nil) or a repeat factor (integerp ARG).
|
|
|
|
|
;; If the current file was used, the list has but one element and ARG
|
|
|
|
|
;; does not matter. (It is non-nil, non-integer in that case, namely '(4)).
|
2000-10-03 17:35:47 +00:00
|
|
|
|
;; DEFAULT is the default value to return if the user just hits RET;
|
|
|
|
|
;; if it is omitted or nil, then the name of the directory is used.
|
1992-06-24 02:14:18 +00:00
|
|
|
|
|
2000-10-03 17:35:47 +00:00
|
|
|
|
(defun dired-mark-read-file-name (prompt dir op-symbol arg files
|
|
|
|
|
&optional default)
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(dired-mark-pop-up
|
|
|
|
|
nil op-symbol files
|
|
|
|
|
(function read-file-name)
|
2000-10-03 17:35:47 +00:00
|
|
|
|
(format prompt (dired-mark-prompt arg files)) dir default))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
|
|
|
|
|
(defun dired-dwim-target-directory ()
|
|
|
|
|
;; Try to guess which target directory the user may want.
|
|
|
|
|
;; If there is a dired buffer displayed in the next window, use
|
|
|
|
|
;; its current subdir, else use current subdir of this dired buffer.
|
|
|
|
|
(let ((this-dir (and (eq major-mode 'dired-mode)
|
|
|
|
|
(dired-current-directory))))
|
|
|
|
|
;; non-dired buffer may want to profit from this function, e.g. vm-uudecode
|
|
|
|
|
(if dired-dwim-target
|
|
|
|
|
(let* ((other-buf (window-buffer (next-window)))
|
|
|
|
|
(other-dir (save-excursion
|
|
|
|
|
(set-buffer other-buf)
|
|
|
|
|
(and (eq major-mode 'dired-mode)
|
|
|
|
|
(dired-current-directory)))))
|
|
|
|
|
(or other-dir this-dir))
|
|
|
|
|
this-dir)))
|
2001-01-26 13:14:11 +00:00
|
|
|
|
|
1992-06-24 02:14:18 +00:00
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun dired-create-directory (directory)
|
|
|
|
|
"Create a directory called DIRECTORY."
|
|
|
|
|
(interactive
|
|
|
|
|
(list (read-file-name "Create directory: " (dired-current-directory))))
|
2007-11-17 01:27:52 +00:00
|
|
|
|
(let* ((expanded (directory-file-name (expand-file-name directory)))
|
|
|
|
|
(try expanded) new)
|
|
|
|
|
;; Find the topmost nonexistent parent dir (variable `new')
|
|
|
|
|
(while (and try (not (file-exists-p try)) (not (equal new try)))
|
|
|
|
|
(setq new try
|
|
|
|
|
try (directory-file-name (file-name-directory try))))
|
|
|
|
|
(make-directory expanded t)
|
|
|
|
|
(when new
|
|
|
|
|
(dired-add-file new)
|
|
|
|
|
(dired-move-to-filename))))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
|
|
|
|
|
(defun dired-into-dir-with-symlinks (target)
|
|
|
|
|
(and (file-directory-p target)
|
|
|
|
|
(not (file-symlink-p target))))
|
|
|
|
|
;; This may not always be what you want, especially if target is your
|
|
|
|
|
;; home directory and it happens to be a symbolic link, as is often the
|
|
|
|
|
;; case with NFS and automounters. Or if you want to make symlinks
|
|
|
|
|
;; into directories that themselves are only symlinks, also quite
|
|
|
|
|
;; common.
|
|
|
|
|
|
|
|
|
|
;; So we don't use this function as value for HOW-TO in
|
|
|
|
|
;; dired-do-symlink, which has the minor disadvantage of
|
|
|
|
|
;; making links *into* a symlinked-dir, when you really wanted to
|
|
|
|
|
;; *overwrite* that symlink. In that (rare, I guess) case, you'll
|
|
|
|
|
;; just have to remove that symlink by hand before making your marked
|
|
|
|
|
;; symlinks.
|
|
|
|
|
|
1999-09-16 19:29:30 +00:00
|
|
|
|
(defvar dired-copy-how-to-fn nil
|
2001-12-20 18:59:32 +00:00
|
|
|
|
"nil or a function used by `dired-do-copy' to determine target.
|
1999-09-16 19:29:30 +00:00
|
|
|
|
See HOW-TO argument for `dired-do-create-files'.")
|
|
|
|
|
|
1992-06-24 02:14:18 +00:00
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun dired-do-copy (&optional arg)
|
|
|
|
|
"Copy all marked (or next ARG) files, or copy the current file.
|
|
|
|
|
This normally preserves the last-modified date when copying.
|
|
|
|
|
When operating on just the current file, you specify the new name.
|
1995-08-02 19:20:38 +00:00
|
|
|
|
When operating on multiple or marked files, you specify a directory,
|
|
|
|
|
and new copies of these files are made in that directory
|
2001-04-27 15:40:29 +00:00
|
|
|
|
with the same names that the files currently have. The default
|
|
|
|
|
suggested for the target directory depends on the value of
|
2006-10-18 10:50:28 +00:00
|
|
|
|
`dired-dwim-target', which see.
|
|
|
|
|
|
|
|
|
|
This command copies symbolic links by creating new ones,
|
|
|
|
|
like `cp -d'."
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(interactive "P")
|
2000-02-17 09:13:39 +00:00
|
|
|
|
(let ((dired-recursive-copies dired-recursive-copies))
|
1999-09-16 19:29:30 +00:00
|
|
|
|
(dired-do-create-files 'copy (function dired-copy-file)
|
2005-06-23 21:23:17 +00:00
|
|
|
|
"Copy"
|
2000-02-17 09:13:39 +00:00
|
|
|
|
arg dired-keep-marker-copy
|
|
|
|
|
nil dired-copy-how-to-fn)))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun dired-do-symlink (&optional arg)
|
|
|
|
|
"Make symbolic links to current file or all marked (or next ARG) files.
|
|
|
|
|
When operating on just the current file, you specify the new name.
|
|
|
|
|
When operating on multiple or marked files, you specify a directory
|
|
|
|
|
and new symbolic links are made in that directory
|
2001-04-27 15:40:29 +00:00
|
|
|
|
with the same names that the files currently have. The default
|
|
|
|
|
suggested for the target directory depends on the value of
|
2007-02-02 14:51:08 +00:00
|
|
|
|
`dired-dwim-target', which see.
|
|
|
|
|
|
|
|
|
|
For relative symlinks, use \\[dired-do-relsymlink]."
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(interactive "P")
|
|
|
|
|
(dired-do-create-files 'symlink (function make-symbolic-link)
|
|
|
|
|
"Symlink" arg dired-keep-marker-symlink))
|
|
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun dired-do-hardlink (&optional arg)
|
|
|
|
|
"Add names (hard links) current file or all marked (or next ARG) files.
|
|
|
|
|
When operating on just the current file, you specify the new name.
|
|
|
|
|
When operating on multiple or marked files, you specify a directory
|
|
|
|
|
and new hard links are made in that directory
|
2001-04-27 15:40:29 +00:00
|
|
|
|
with the same names that the files currently have. The default
|
|
|
|
|
suggested for the target directory depends on the value of
|
|
|
|
|
`dired-dwim-target', which see."
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(interactive "P")
|
2002-09-15 01:52:08 +00:00
|
|
|
|
(dired-do-create-files 'hardlink (function dired-hardlink)
|
1992-06-24 02:14:18 +00:00
|
|
|
|
"Hardlink" arg dired-keep-marker-hardlink))
|
|
|
|
|
|
2002-09-15 01:52:08 +00:00
|
|
|
|
(defun dired-hardlink (file newname &optional ok-if-already-exists)
|
|
|
|
|
(dired-handle-overwrite newname)
|
|
|
|
|
;; error is caught in -create-files
|
|
|
|
|
(add-name-to-file file newname ok-if-already-exists)
|
|
|
|
|
;; Update the link count
|
|
|
|
|
(dired-relist-file file))
|
|
|
|
|
|
1992-06-24 02:14:18 +00:00
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun dired-do-rename (&optional arg)
|
|
|
|
|
"Rename current file or all marked (or next ARG) files.
|
|
|
|
|
When renaming just the current file, you specify the new name.
|
2001-04-27 15:40:29 +00:00
|
|
|
|
When renaming multiple or marked files, you specify a directory.
|
2002-09-15 01:52:08 +00:00
|
|
|
|
This command also renames any buffers that are visiting the files.
|
2001-04-27 15:40:29 +00:00
|
|
|
|
The default suggested for the target directory depends on the value
|
|
|
|
|
of `dired-dwim-target', which see."
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(interactive "P")
|
|
|
|
|
(dired-do-create-files 'move (function dired-rename-file)
|
|
|
|
|
"Move" arg dired-keep-marker-rename "Rename"))
|
|
|
|
|
;;;###end dired-cp.el
|
2001-01-26 13:14:11 +00:00
|
|
|
|
|
1992-06-24 02:14:18 +00:00
|
|
|
|
;;; 5K
|
|
|
|
|
;;;###begin dired-re.el
|
|
|
|
|
(defun dired-do-create-files-regexp
|
2003-01-14 23:11:42 +00:00
|
|
|
|
(file-creator operation arg regexp newname &optional whole-name marker-char)
|
1992-06-24 02:14:18 +00:00
|
|
|
|
;; Create a new file for each marked file using regexps.
|
|
|
|
|
;; FILE-CREATOR and OPERATION as in dired-create-files.
|
|
|
|
|
;; ARG as in dired-get-marked-files.
|
|
|
|
|
;; Matches each marked file against REGEXP and constructs the new
|
|
|
|
|
;; filename from NEWNAME (like in function replace-match).
|
2003-01-14 23:11:42 +00:00
|
|
|
|
;; Optional arg WHOLE-NAME means match/replace the whole file name
|
1992-06-24 02:14:18 +00:00
|
|
|
|
;; instead of only the non-directory part of the file.
|
|
|
|
|
;; Optional arg MARKER-CHAR as in dired-create-files.
|
|
|
|
|
(let* ((fn-list (dired-get-marked-files nil arg))
|
|
|
|
|
(fn-count (length fn-list))
|
|
|
|
|
(operation-prompt (concat operation " `%s' to `%s'?"))
|
|
|
|
|
(rename-regexp-help-form (format "\
|
|
|
|
|
Type SPC or `y' to %s one match, DEL or `n' to skip to next,
|
|
|
|
|
`!' to %s all remaining matches with no more questions."
|
|
|
|
|
(downcase operation)
|
|
|
|
|
(downcase operation)))
|
|
|
|
|
(regexp-name-constructor
|
|
|
|
|
;; Function to construct new filename using REGEXP and NEWNAME:
|
2003-01-14 23:11:42 +00:00
|
|
|
|
(if whole-name ; easy (but rare) case
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(function
|
|
|
|
|
(lambda (from)
|
|
|
|
|
(let ((to (dired-string-replace-match regexp from newname))
|
|
|
|
|
;; must bind help-form directly around call to
|
|
|
|
|
;; dired-query
|
|
|
|
|
(help-form rename-regexp-help-form))
|
|
|
|
|
(if to
|
|
|
|
|
(and (dired-query 'rename-regexp-query
|
|
|
|
|
operation-prompt
|
|
|
|
|
from
|
|
|
|
|
to)
|
|
|
|
|
to)
|
|
|
|
|
(dired-log "%s: %s did not match regexp %s\n"
|
|
|
|
|
operation from regexp)))))
|
2003-01-14 23:11:42 +00:00
|
|
|
|
;; not whole-name, replace non-directory part only
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(function
|
|
|
|
|
(lambda (from)
|
|
|
|
|
(let* ((new (dired-string-replace-match
|
|
|
|
|
regexp (file-name-nondirectory from) newname))
|
|
|
|
|
(to (and new ; nil means there was no match
|
|
|
|
|
(expand-file-name new
|
|
|
|
|
(file-name-directory from))))
|
|
|
|
|
(help-form rename-regexp-help-form))
|
|
|
|
|
(if to
|
|
|
|
|
(and (dired-query 'rename-regexp-query
|
|
|
|
|
operation-prompt
|
|
|
|
|
(dired-make-relative from)
|
|
|
|
|
(dired-make-relative to))
|
|
|
|
|
to)
|
|
|
|
|
(dired-log "%s: %s did not match regexp %s\n"
|
|
|
|
|
operation (file-name-nondirectory from) regexp)))))))
|
|
|
|
|
rename-regexp-query)
|
|
|
|
|
(dired-create-files
|
|
|
|
|
file-creator operation fn-list regexp-name-constructor marker-char)))
|
|
|
|
|
|
|
|
|
|
(defun dired-mark-read-regexp (operation)
|
|
|
|
|
;; Prompt user about performing OPERATION.
|
2003-01-14 23:11:42 +00:00
|
|
|
|
;; Read and return list of: regexp newname arg whole-name.
|
|
|
|
|
(let* ((whole-name
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(equal 0 (prefix-numeric-value current-prefix-arg)))
|
|
|
|
|
(arg
|
2003-01-14 23:11:42 +00:00
|
|
|
|
(if whole-name nil current-prefix-arg))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(regexp
|
|
|
|
|
(dired-read-regexp
|
2003-01-14 23:11:42 +00:00
|
|
|
|
(concat (if whole-name "Abs. " "") operation " from (regexp): ")))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(newname
|
|
|
|
|
(read-string
|
2003-01-14 23:11:42 +00:00
|
|
|
|
(concat (if whole-name "Abs. " "") operation " " regexp " to: "))))
|
|
|
|
|
(list regexp newname arg whole-name)))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
|
|
|
|
|
;;;###autoload
|
2003-01-14 23:11:42 +00:00
|
|
|
|
(defun dired-do-rename-regexp (regexp newname &optional arg whole-name)
|
2001-04-30 13:37:00 +00:00
|
|
|
|
"Rename selected files whose names match REGEXP to NEWNAME.
|
|
|
|
|
|
|
|
|
|
With non-zero prefix argument ARG, the command operates on the next ARG
|
|
|
|
|
files. Otherwise, it operates on all the marked files, or the current
|
|
|
|
|
file if none are marked.
|
|
|
|
|
|
1992-06-24 02:14:18 +00:00
|
|
|
|
As each match is found, the user must type a character saying
|
|
|
|
|
what to do with it. For directions, type \\[help-command] at that time.
|
|
|
|
|
NEWNAME may contain \\=\\<n> or \\& as in `query-replace-regexp'.
|
|
|
|
|
REGEXP defaults to the last regexp used.
|
1998-08-13 23:01:05 +00:00
|
|
|
|
|
|
|
|
|
With a zero prefix arg, renaming by regexp affects the absolute file name.
|
|
|
|
|
Normally, only the non-directory part of the file name is used and changed."
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(interactive (dired-mark-read-regexp "Rename"))
|
|
|
|
|
(dired-do-create-files-regexp
|
|
|
|
|
(function dired-rename-file)
|
2003-01-14 23:11:42 +00:00
|
|
|
|
"Rename" arg regexp newname whole-name dired-keep-marker-rename))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
|
|
|
|
|
;;;###autoload
|
2003-01-14 23:11:42 +00:00
|
|
|
|
(defun dired-do-copy-regexp (regexp newname &optional arg whole-name)
|
2001-04-30 13:37:00 +00:00
|
|
|
|
"Copy selected files whose names match REGEXP to NEWNAME.
|
1999-03-09 03:09:39 +00:00
|
|
|
|
See function `dired-do-rename-regexp' for more info."
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(interactive (dired-mark-read-regexp "Copy"))
|
1999-09-16 19:29:30 +00:00
|
|
|
|
(let ((dired-recursive-copies nil)) ; No recursive copies.
|
|
|
|
|
(dired-do-create-files-regexp
|
|
|
|
|
(function dired-copy-file)
|
|
|
|
|
(if dired-copy-preserve-time "Copy [-p]" "Copy")
|
2003-01-14 23:11:42 +00:00
|
|
|
|
arg regexp newname whole-name dired-keep-marker-copy)))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
|
|
|
|
|
;;;###autoload
|
2003-01-14 23:11:42 +00:00
|
|
|
|
(defun dired-do-hardlink-regexp (regexp newname &optional arg whole-name)
|
2001-04-30 13:37:00 +00:00
|
|
|
|
"Hardlink selected files whose names match REGEXP to NEWNAME.
|
1999-03-09 03:09:39 +00:00
|
|
|
|
See function `dired-do-rename-regexp' for more info."
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(interactive (dired-mark-read-regexp "HardLink"))
|
|
|
|
|
(dired-do-create-files-regexp
|
|
|
|
|
(function add-name-to-file)
|
2003-01-14 23:11:42 +00:00
|
|
|
|
"HardLink" arg regexp newname whole-name dired-keep-marker-hardlink))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
|
|
|
|
|
;;;###autoload
|
2003-01-14 23:11:42 +00:00
|
|
|
|
(defun dired-do-symlink-regexp (regexp newname &optional arg whole-name)
|
2001-04-30 13:37:00 +00:00
|
|
|
|
"Symlink selected files whose names match REGEXP to NEWNAME.
|
1999-03-09 03:09:39 +00:00
|
|
|
|
See function `dired-do-rename-regexp' for more info."
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(interactive (dired-mark-read-regexp "SymLink"))
|
|
|
|
|
(dired-do-create-files-regexp
|
|
|
|
|
(function make-symbolic-link)
|
2003-01-14 23:11:42 +00:00
|
|
|
|
"SymLink" arg regexp newname whole-name dired-keep-marker-symlink))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
|
|
|
|
|
(defun dired-create-files-non-directory
|
|
|
|
|
(file-creator basename-constructor operation arg)
|
|
|
|
|
;; Perform FILE-CREATOR on the non-directory part of marked files
|
|
|
|
|
;; using function BASENAME-CONSTRUCTOR, with query for each file.
|
|
|
|
|
;; OPERATION like in dired-create-files, ARG as in dired-get-marked-files.
|
|
|
|
|
(let (rename-non-directory-query)
|
|
|
|
|
(dired-create-files
|
|
|
|
|
file-creator
|
|
|
|
|
operation
|
|
|
|
|
(dired-get-marked-files nil arg)
|
|
|
|
|
(function
|
|
|
|
|
(lambda (from)
|
|
|
|
|
(let ((to (concat (file-name-directory from)
|
|
|
|
|
(funcall basename-constructor
|
|
|
|
|
(file-name-nondirectory from)))))
|
|
|
|
|
(and (let ((help-form (format "\
|
|
|
|
|
Type SPC or `y' to %s one file, DEL or `n' to skip to next,
|
|
|
|
|
`!' to %s all remaining matches with no more questions."
|
|
|
|
|
(downcase operation)
|
|
|
|
|
(downcase operation))))
|
|
|
|
|
(dired-query 'rename-non-directory-query
|
|
|
|
|
(concat operation " `%s' to `%s'")
|
|
|
|
|
(dired-make-relative from)
|
|
|
|
|
(dired-make-relative to)))
|
|
|
|
|
to))))
|
|
|
|
|
dired-keep-marker-rename)))
|
|
|
|
|
|
|
|
|
|
(defun dired-rename-non-directory (basename-constructor operation arg)
|
|
|
|
|
(dired-create-files-non-directory
|
|
|
|
|
(function dired-rename-file)
|
|
|
|
|
basename-constructor operation arg))
|
|
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun dired-upcase (&optional arg)
|
|
|
|
|
"Rename all marked (or next ARG) files to upper case."
|
|
|
|
|
(interactive "P")
|
|
|
|
|
(dired-rename-non-directory (function upcase) "Rename upcase" arg))
|
|
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun dired-downcase (&optional arg)
|
|
|
|
|
"Rename all marked (or next ARG) files to lower case."
|
|
|
|
|
(interactive "P")
|
|
|
|
|
(dired-rename-non-directory (function downcase) "Rename downcase" arg))
|
|
|
|
|
|
|
|
|
|
;;;###end dired-re.el
|
2001-01-26 13:14:11 +00:00
|
|
|
|
|
1992-06-24 02:14:18 +00:00
|
|
|
|
;;; 13K
|
|
|
|
|
;;;###begin dired-ins.el
|
|
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun dired-maybe-insert-subdir (dirname &optional
|
|
|
|
|
switches no-error-if-not-dir-p)
|
|
|
|
|
"Insert this subdirectory into the same dired buffer.
|
|
|
|
|
If it is already present, just move to it (type \\[dired-do-redisplay] to refresh),
|
|
|
|
|
else inserts it at its natural place (as `ls -lR' would have done).
|
|
|
|
|
With a prefix arg, you may edit the ls switches used for this listing.
|
|
|
|
|
You can add `R' to the switches to expand the whole tree starting at
|
|
|
|
|
this subdirectory.
|
2004-06-07 21:24:31 +00:00
|
|
|
|
This function takes some pains to conform to `ls -lR' output.
|
|
|
|
|
|
|
|
|
|
Dired remembers switches specified with a prefix arg, so that reverting
|
|
|
|
|
the buffer will not reset them. However, using `dired-undo' to re-insert
|
|
|
|
|
or delete subdirectories can bypass this machinery. Hence, you sometimes
|
|
|
|
|
may have to reset some subdirectory switches after a `dired-undo'.
|
|
|
|
|
You can reset all subdirectory switches to the default using
|
2004-06-15 22:09:18 +00:00
|
|
|
|
\\<dired-mode-map>\\[dired-reset-subdir-switches].
|
2006-05-06 14:37:40 +00:00
|
|
|
|
See Info node `(emacs)Subdir switches' for more details."
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(interactive
|
|
|
|
|
(list (dired-get-filename)
|
|
|
|
|
(if current-prefix-arg
|
2004-06-06 02:26:46 +00:00
|
|
|
|
(read-string "Switches for listing: "
|
|
|
|
|
(or dired-subdir-switches dired-actual-switches)))))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(let ((opoint (point)))
|
|
|
|
|
;; We don't need a marker for opoint as the subdir is always
|
|
|
|
|
;; inserted *after* opoint.
|
|
|
|
|
(setq dirname (file-name-as-directory dirname))
|
|
|
|
|
(or (and (not switches)
|
|
|
|
|
(dired-goto-subdir dirname))
|
|
|
|
|
(dired-insert-subdir dirname switches no-error-if-not-dir-p))
|
|
|
|
|
;; Push mark so that it's easy to find back. Do this after the
|
|
|
|
|
;; insert message so that the user sees the `Mark set' message.
|
|
|
|
|
(push-mark opoint)))
|
|
|
|
|
|
1999-12-09 02:01:26 +00:00
|
|
|
|
;;;###autoload
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(defun dired-insert-subdir (dirname &optional switches no-error-if-not-dir-p)
|
|
|
|
|
"Insert this subdirectory into the same dired buffer.
|
|
|
|
|
If it is already present, overwrites previous entry,
|
|
|
|
|
else inserts it at its natural place (as `ls -lR' would have done).
|
|
|
|
|
With a prefix arg, you may edit the `ls' switches used for this listing.
|
|
|
|
|
You can add `R' to the switches to expand the whole tree starting at
|
|
|
|
|
this subdirectory.
|
|
|
|
|
This function takes some pains to conform to `ls -lR' output."
|
|
|
|
|
;; NO-ERROR-IF-NOT-DIR-P needed for special filesystems like
|
|
|
|
|
;; Prospero where dired-ls does the right thing, but
|
|
|
|
|
;; file-directory-p has not been redefined.
|
|
|
|
|
(interactive
|
|
|
|
|
(list (dired-get-filename)
|
|
|
|
|
(if current-prefix-arg
|
2004-06-06 02:26:46 +00:00
|
|
|
|
(read-string "Switches for listing: "
|
|
|
|
|
(or dired-subdir-switches dired-actual-switches)))))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(setq dirname (file-name-as-directory (expand-file-name dirname)))
|
|
|
|
|
(or no-error-if-not-dir-p
|
|
|
|
|
(file-directory-p dirname)
|
|
|
|
|
(error "Attempt to insert a non-directory: %s" dirname))
|
|
|
|
|
(let ((elt (assoc dirname dired-subdir-alist))
|
2004-06-06 02:26:46 +00:00
|
|
|
|
(cons (assoc-string dirname dired-switches-alist))
|
|
|
|
|
(modflag (buffer-modified-p))
|
|
|
|
|
(old-switches switches)
|
|
|
|
|
switches-have-R mark-alist case-fold-search buffer-read-only)
|
|
|
|
|
(and (not switches) cons (setq switches (cdr cons)))
|
|
|
|
|
(dired-insert-subdir-validate dirname switches)
|
1992-06-24 02:14:18 +00:00
|
|
|
|
;; case-fold-search is nil now, so we can test for capital `R':
|
|
|
|
|
(if (setq switches-have-R (and switches (string-match "R" switches)))
|
|
|
|
|
;; avoid duplicated subdirs
|
|
|
|
|
(setq mark-alist (dired-kill-tree dirname t)))
|
|
|
|
|
(if elt
|
|
|
|
|
;; If subdir is already present, remove it and remember its marks
|
|
|
|
|
(setq mark-alist (nconc (dired-insert-subdir-del elt) mark-alist))
|
|
|
|
|
(dired-insert-subdir-newpos dirname)) ; else compute new position
|
|
|
|
|
(dired-insert-subdir-doupdate
|
|
|
|
|
dirname elt (dired-insert-subdir-doinsert dirname switches))
|
2004-06-06 02:26:46 +00:00
|
|
|
|
(when old-switches
|
|
|
|
|
(if cons
|
|
|
|
|
(setcdr cons switches)
|
|
|
|
|
(push (cons dirname switches) dired-switches-alist)))
|
|
|
|
|
(when switches-have-R
|
|
|
|
|
(dired-build-subdir-alist switches)
|
2004-06-10 19:06:14 +00:00
|
|
|
|
(setq switches (dired-replace-in-string "R" "" switches))
|
2004-06-06 02:26:46 +00:00
|
|
|
|
(dolist (cur-ass dired-subdir-alist)
|
|
|
|
|
(let ((cur-dir (car cur-ass)))
|
|
|
|
|
(and (dired-in-this-tree cur-dir dirname)
|
|
|
|
|
(let ((cur-cons (assoc-string cur-dir dired-switches-alist)))
|
|
|
|
|
(if cur-cons
|
|
|
|
|
(setcdr cur-cons switches)
|
|
|
|
|
(push (cons cur-dir switches) dired-switches-alist)))))))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(dired-initial-position dirname)
|
2004-06-06 02:26:46 +00:00
|
|
|
|
(save-excursion (dired-mark-remembered mark-alist))
|
|
|
|
|
(restore-buffer-modified-p modflag)))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
|
|
|
|
|
;; This is a separate function for dired-vms.
|
|
|
|
|
(defun dired-insert-subdir-validate (dirname &optional switches)
|
|
|
|
|
;; Check that it is valid to insert DIRNAME with SWITCHES.
|
|
|
|
|
;; Signal an error if invalid (e.g. user typed `i' on `..').
|
1993-12-23 03:34:57 +00:00
|
|
|
|
(or (dired-in-this-tree dirname (expand-file-name default-directory))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(error "%s: not in this directory tree" dirname))
|
2004-06-06 02:26:46 +00:00
|
|
|
|
(let ((real-switches (or switches dired-subdir-switches)))
|
|
|
|
|
(when real-switches
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(let (case-fold-search)
|
|
|
|
|
(mapcar
|
|
|
|
|
(function
|
|
|
|
|
(lambda (x)
|
2004-06-06 02:26:46 +00:00
|
|
|
|
(or (eq (null (string-match x real-switches))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(null (string-match x dired-actual-switches)))
|
2004-06-06 02:26:46 +00:00
|
|
|
|
(error
|
|
|
|
|
"Can't have dirs with and without -%s switches together" x))))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
;; all switches that make a difference to dired-get-filename:
|
2004-06-06 02:26:46 +00:00
|
|
|
|
'("F" "b"))))))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
|
|
|
|
|
(defun dired-alist-add (dir new-marker)
|
|
|
|
|
;; Add new DIR at NEW-MARKER. Sort alist.
|
|
|
|
|
(dired-alist-add-1 dir new-marker)
|
|
|
|
|
(dired-alist-sort))
|
|
|
|
|
|
|
|
|
|
(defun dired-alist-sort ()
|
|
|
|
|
;; Keep the alist sorted on buffer position.
|
|
|
|
|
(setq dired-subdir-alist
|
|
|
|
|
(sort dired-subdir-alist
|
|
|
|
|
(function (lambda (elt1 elt2)
|
|
|
|
|
(> (dired-get-subdir-min elt1)
|
|
|
|
|
(dired-get-subdir-min elt2)))))))
|
|
|
|
|
|
2004-06-09 00:25:30 +00:00
|
|
|
|
(defun dired-kill-tree (dirname &optional remember-marks kill-root)
|
2000-10-04 23:35:52 +00:00
|
|
|
|
"Kill all proper subdirs of DIRNAME, excluding DIRNAME itself.
|
2004-06-09 00:25:30 +00:00
|
|
|
|
Interactively, you can kill DIRNAME as well by using a prefix argument.
|
|
|
|
|
In interactive use, the command prompts for DIRNAME.
|
|
|
|
|
|
|
|
|
|
When called from Lisp, if REMEMBER-MARKS is non-nil, return an alist
|
|
|
|
|
of marked files. If KILL-ROOT is non-nil, kill DIRNAME as well."
|
|
|
|
|
(interactive "DKill tree below directory: \ni\nP")
|
|
|
|
|
(setq dirname (file-name-as-directory (expand-file-name dirname)))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(let ((s-alist dired-subdir-alist) dir m-alist)
|
|
|
|
|
(while s-alist
|
|
|
|
|
(setq dir (car (car s-alist))
|
|
|
|
|
s-alist (cdr s-alist))
|
2004-06-09 00:25:30 +00:00
|
|
|
|
(and (or kill-root (not (string-equal dir dirname)))
|
|
|
|
|
(dired-in-this-tree dir dirname)
|
|
|
|
|
(dired-goto-subdir dir)
|
|
|
|
|
(setq m-alist (nconc (dired-kill-subdir remember-marks) m-alist))))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
m-alist))
|
|
|
|
|
|
|
|
|
|
(defun dired-insert-subdir-newpos (new-dir)
|
|
|
|
|
;; Find pos for new subdir, according to tree order.
|
|
|
|
|
;;(goto-char (point-max))
|
|
|
|
|
(let ((alist dired-subdir-alist) elt dir pos new-pos)
|
|
|
|
|
(while alist
|
|
|
|
|
(setq elt (car alist)
|
|
|
|
|
alist (cdr alist)
|
|
|
|
|
dir (car elt)
|
|
|
|
|
pos (dired-get-subdir-min elt))
|
|
|
|
|
(if (dired-tree-lessp dir new-dir)
|
|
|
|
|
;; Insert NEW-DIR after DIR
|
|
|
|
|
(setq new-pos (dired-get-subdir-max elt)
|
|
|
|
|
alist nil)))
|
|
|
|
|
(goto-char new-pos))
|
|
|
|
|
;; want a separating newline between subdirs
|
|
|
|
|
(or (eobp)
|
|
|
|
|
(forward-line -1))
|
|
|
|
|
(insert "\n")
|
|
|
|
|
(point))
|
|
|
|
|
|
|
|
|
|
(defun dired-insert-subdir-del (element)
|
|
|
|
|
;; Erase an already present subdir (given by ELEMENT) from buffer.
|
|
|
|
|
;; Move to that buffer position. Return a mark-alist.
|
|
|
|
|
(let ((begin-marker (dired-get-subdir-min element)))
|
|
|
|
|
(goto-char begin-marker)
|
|
|
|
|
;; Are at beginning of subdir (and inside it!). Now determine its end:
|
|
|
|
|
(goto-char (dired-subdir-max))
|
|
|
|
|
(or (eobp);; want a separating newline _between_ subdirs:
|
|
|
|
|
(forward-char -1))
|
|
|
|
|
(prog1
|
|
|
|
|
(dired-remember-marks begin-marker (point))
|
|
|
|
|
(delete-region begin-marker (point)))))
|
|
|
|
|
|
|
|
|
|
(defun dired-insert-subdir-doinsert (dirname switches)
|
2002-09-15 01:52:08 +00:00
|
|
|
|
;; Insert ls output after point.
|
1992-06-24 02:14:18 +00:00
|
|
|
|
;; Return the boundary of the inserted text (as list of BEG and END).
|
2002-10-16 21:32:41 +00:00
|
|
|
|
(save-excursion
|
|
|
|
|
(let ((begin (point)))
|
|
|
|
|
(let ((dired-actual-switches
|
|
|
|
|
(or switches
|
2004-06-06 02:26:46 +00:00
|
|
|
|
dired-subdir-switches
|
2002-10-16 21:32:41 +00:00
|
|
|
|
(dired-replace-in-string "R" "" dired-actual-switches))))
|
|
|
|
|
(if (equal dirname (car (car (last dired-subdir-alist))))
|
|
|
|
|
;; If doing the top level directory of the buffer,
|
|
|
|
|
;; redo it as specified in dired-directory.
|
|
|
|
|
(dired-readin-insert)
|
|
|
|
|
(dired-insert-directory dirname dired-actual-switches nil nil t)))
|
|
|
|
|
(list begin (point)))))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
|
|
|
|
|
(defun dired-insert-subdir-doupdate (dirname elt beg-end)
|
|
|
|
|
;; Point is at the correct subdir alist position for ELT,
|
|
|
|
|
;; BEG-END is the subdir-region (as list of begin and end).
|
|
|
|
|
(if elt ; subdir was already present
|
|
|
|
|
;; update its position (should actually be unchanged)
|
|
|
|
|
(set-marker (dired-get-subdir-min elt) (point-marker))
|
|
|
|
|
(dired-alist-add dirname (point-marker)))
|
|
|
|
|
;; The hook may depend on the subdir-alist containing the just
|
|
|
|
|
;; inserted subdir, so run it after dired-alist-add:
|
|
|
|
|
(if dired-after-readin-hook
|
|
|
|
|
(save-excursion
|
|
|
|
|
(let ((begin (nth 0 beg-end))
|
|
|
|
|
(end (nth 1 beg-end)))
|
|
|
|
|
(goto-char begin)
|
|
|
|
|
(save-restriction
|
|
|
|
|
(narrow-to-region begin end)
|
|
|
|
|
;; hook may add or delete lines, but the subdir boundary
|
|
|
|
|
;; marker floats
|
|
|
|
|
(run-hooks 'dired-after-readin-hook))))))
|
|
|
|
|
|
|
|
|
|
(defun dired-tree-lessp (dir1 dir2)
|
1998-08-13 23:01:05 +00:00
|
|
|
|
;; Lexicographic order on file name components, like `ls -lR':
|
2007-08-08 07:40:09 +00:00
|
|
|
|
;; DIR1 < DIR2 if DIR1 comes *before* DIR2 in an `ls -lR' listing,
|
|
|
|
|
;; i.e., if DIR1 is a (grand)parent dir of DIR2,
|
1992-06-24 02:14:18 +00:00
|
|
|
|
;; or DIR1 and DIR2 are in the same parentdir and their last
|
|
|
|
|
;; components are string-lessp.
|
|
|
|
|
;; Thus ("/usr/" "/usr/bin") and ("/usr/a/" "/usr/b/") are tree-lessp.
|
|
|
|
|
;; string-lessp could arguably be replaced by file-newer-than-file-p
|
|
|
|
|
;; if dired-actual-switches contained `t'.
|
|
|
|
|
(setq dir1 (file-name-as-directory dir1)
|
|
|
|
|
dir2 (file-name-as-directory dir2))
|
|
|
|
|
(let ((components-1 (dired-split "/" dir1))
|
|
|
|
|
(components-2 (dired-split "/" dir2)))
|
|
|
|
|
(while (and components-1
|
|
|
|
|
components-2
|
|
|
|
|
(equal (car components-1) (car components-2)))
|
|
|
|
|
(setq components-1 (cdr components-1)
|
|
|
|
|
components-2 (cdr components-2)))
|
|
|
|
|
(let ((c1 (car components-1))
|
|
|
|
|
(c2 (car components-2)))
|
|
|
|
|
|
|
|
|
|
(cond ((and c1 c2)
|
|
|
|
|
(string-lessp c1 c2))
|
|
|
|
|
((and (null c1) (null c2))
|
|
|
|
|
nil) ; they are equal, not lessp
|
|
|
|
|
((null c1) ; c2 is a subdir of c1: c1<c2
|
|
|
|
|
t)
|
|
|
|
|
((null c2) ; c1 is a subdir of c2: c1>c2
|
|
|
|
|
nil)
|
|
|
|
|
(t (error "This can't happen"))))))
|
|
|
|
|
|
|
|
|
|
;; There should be a builtin split function - inverse to mapconcat.
|
|
|
|
|
(defun dired-split (pat str &optional limit)
|
|
|
|
|
"Splitting on regexp PAT, turn string STR into a list of substrings.
|
|
|
|
|
Optional third arg LIMIT (>= 1) is a limit to the length of the
|
|
|
|
|
resulting list.
|
|
|
|
|
Thus, if SEP is a regexp that only matches itself,
|
|
|
|
|
|
|
|
|
|
(mapconcat 'identity (dired-split SEP STRING) SEP)
|
|
|
|
|
|
|
|
|
|
is always equal to STRING."
|
|
|
|
|
(let* ((start (string-match pat str))
|
|
|
|
|
(result (list (substring str 0 start)))
|
|
|
|
|
(count 1)
|
|
|
|
|
(end (if start (match-end 0))))
|
|
|
|
|
(if end ; else nothing left
|
|
|
|
|
(while (and (or (not (integerp limit))
|
|
|
|
|
(< count limit))
|
|
|
|
|
(string-match pat str end))
|
|
|
|
|
(setq start (match-beginning 0)
|
|
|
|
|
count (1+ count)
|
|
|
|
|
result (cons (substring str end start) result)
|
|
|
|
|
end (match-end 0)
|
|
|
|
|
start end)
|
|
|
|
|
))
|
|
|
|
|
(if (and (or (not (integerp limit))
|
|
|
|
|
(< count limit))
|
|
|
|
|
end) ; else nothing left
|
|
|
|
|
(setq result
|
|
|
|
|
(cons (substring str end) result)))
|
|
|
|
|
(nreverse result)))
|
2001-01-26 13:14:11 +00:00
|
|
|
|
|
1992-06-24 02:14:18 +00:00
|
|
|
|
;;; moving by subdirectories
|
|
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun dired-prev-subdir (arg &optional no-error-if-not-found no-skip)
|
|
|
|
|
"Go to previous subdirectory, regardless of level.
|
|
|
|
|
When called interactively and not on a subdir line, go to this subdir's line."
|
|
|
|
|
;;(interactive "p")
|
|
|
|
|
(interactive
|
|
|
|
|
(list (if current-prefix-arg
|
|
|
|
|
(prefix-numeric-value current-prefix-arg)
|
|
|
|
|
;; if on subdir start already, don't stay there!
|
|
|
|
|
(if (dired-get-subdir) 1 0))))
|
|
|
|
|
(dired-next-subdir (- arg) no-error-if-not-found no-skip))
|
|
|
|
|
|
|
|
|
|
(defun dired-subdir-min ()
|
|
|
|
|
(save-excursion
|
|
|
|
|
(if (not (dired-prev-subdir 0 t t))
|
|
|
|
|
(error "Not in a subdir!")
|
|
|
|
|
(point))))
|
|
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun dired-goto-subdir (dir)
|
|
|
|
|
"Go to end of header line of DIR in this dired buffer.
|
|
|
|
|
Return value of point on success, otherwise return nil.
|
|
|
|
|
The next char is either \\n, or \\r if DIR is hidden."
|
|
|
|
|
(interactive
|
|
|
|
|
(prog1 ; let push-mark display its message
|
|
|
|
|
(list (expand-file-name
|
|
|
|
|
(completing-read "Goto in situ directory: " ; prompt
|
|
|
|
|
dired-subdir-alist ; table
|
|
|
|
|
nil ; predicate
|
|
|
|
|
t ; require-match
|
|
|
|
|
(dired-current-directory))))
|
|
|
|
|
(push-mark)))
|
|
|
|
|
(setq dir (file-name-as-directory dir))
|
|
|
|
|
(let ((elt (assoc dir dired-subdir-alist)))
|
|
|
|
|
(and elt
|
|
|
|
|
(goto-char (dired-get-subdir-min elt))
|
|
|
|
|
;; dired-subdir-hidden-p and dired-add-entry depend on point being
|
|
|
|
|
;; at either \r or \n after this function succeeds.
|
|
|
|
|
(progn (skip-chars-forward "^\r\n")
|
|
|
|
|
(point)))))
|
2001-01-26 13:14:11 +00:00
|
|
|
|
|
1992-06-24 02:14:18 +00:00
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun dired-mark-subdir-files ()
|
1998-05-16 04:14:04 +00:00
|
|
|
|
"Mark all files except `.' and `..' in current subdirectory.
|
|
|
|
|
If the Dired buffer shows multiple directories, this command
|
|
|
|
|
marks the files listed in the subdirectory that point is in."
|
1994-05-07 01:56:19 +00:00
|
|
|
|
(interactive)
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(let ((p-min (dired-subdir-min)))
|
|
|
|
|
(dired-mark-files-in-region p-min (dired-subdir-max))))
|
|
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun dired-kill-subdir (&optional remember-marks)
|
|
|
|
|
"Remove all lines of current subdirectory.
|
|
|
|
|
Lower levels are unaffected."
|
|
|
|
|
;; With optional REMEMBER-MARKS, return a mark-alist.
|
|
|
|
|
(interactive)
|
2004-06-06 02:26:46 +00:00
|
|
|
|
(let* ((beg (dired-subdir-min))
|
|
|
|
|
(end (dired-subdir-max))
|
|
|
|
|
(modflag (buffer-modified-p))
|
|
|
|
|
(cur-dir (dired-current-directory))
|
|
|
|
|
(cons (assoc-string cur-dir dired-switches-alist))
|
|
|
|
|
buffer-read-only)
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(if (equal cur-dir default-directory)
|
|
|
|
|
(error "Attempt to kill top level directory"))
|
|
|
|
|
(prog1
|
|
|
|
|
(if remember-marks (dired-remember-marks beg end))
|
|
|
|
|
(delete-region beg end)
|
|
|
|
|
(if (eobp) ; don't leave final blank line
|
|
|
|
|
(delete-char -1))
|
2004-06-06 02:26:46 +00:00
|
|
|
|
(dired-unsubdir cur-dir)
|
|
|
|
|
(when cons
|
|
|
|
|
(setq dired-switches-alist (delete cons dired-switches-alist)))
|
|
|
|
|
(restore-buffer-modified-p modflag))))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
|
|
|
|
|
(defun dired-unsubdir (dir)
|
|
|
|
|
;; Remove DIR from the alist
|
|
|
|
|
(setq dired-subdir-alist
|
|
|
|
|
(delq (assoc dir dired-subdir-alist) dired-subdir-alist)))
|
|
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun dired-tree-up (arg)
|
|
|
|
|
"Go up ARG levels in the dired tree."
|
|
|
|
|
(interactive "p")
|
|
|
|
|
(let ((dir (dired-current-directory)))
|
|
|
|
|
(while (>= arg 1)
|
|
|
|
|
(setq arg (1- arg)
|
|
|
|
|
dir (file-name-directory (directory-file-name dir))))
|
|
|
|
|
;;(setq dir (expand-file-name dir))
|
|
|
|
|
(or (dired-goto-subdir dir)
|
2001-07-15 16:15:35 +00:00
|
|
|
|
(error "Cannot go up to %s - not in this tree" dir))))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun dired-tree-down ()
|
|
|
|
|
"Go down in the dired tree."
|
|
|
|
|
(interactive)
|
|
|
|
|
(let ((dir (dired-current-directory)) ; has slash
|
|
|
|
|
pos case-fold-search) ; filenames are case sensitive
|
|
|
|
|
(let ((rest (reverse dired-subdir-alist)) elt)
|
|
|
|
|
(while rest
|
|
|
|
|
(setq elt (car rest)
|
|
|
|
|
rest (cdr rest))
|
|
|
|
|
(if (dired-in-this-tree (directory-file-name (car elt)) dir)
|
|
|
|
|
(setq rest nil
|
|
|
|
|
pos (dired-goto-subdir (car elt))))))
|
|
|
|
|
(if pos
|
|
|
|
|
(goto-char pos)
|
|
|
|
|
(error "At the bottom"))))
|
2001-01-26 13:14:11 +00:00
|
|
|
|
|
1992-06-24 02:14:18 +00:00
|
|
|
|
;;; hiding
|
|
|
|
|
|
|
|
|
|
(defun dired-unhide-subdir ()
|
|
|
|
|
(let (buffer-read-only)
|
|
|
|
|
(subst-char-in-region (dired-subdir-min) (dired-subdir-max) ?\r ?\n)))
|
|
|
|
|
|
|
|
|
|
(defun dired-hide-check ()
|
|
|
|
|
(or selective-display
|
|
|
|
|
(error "selective-display must be t for subdir hiding to work!")))
|
|
|
|
|
|
|
|
|
|
(defun dired-subdir-hidden-p (dir)
|
|
|
|
|
(and selective-display
|
|
|
|
|
(save-excursion
|
|
|
|
|
(dired-goto-subdir dir)
|
|
|
|
|
(looking-at "\r"))))
|
|
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun dired-hide-subdir (arg)
|
|
|
|
|
"Hide or unhide the current subdirectory and move to next directory.
|
|
|
|
|
Optional prefix arg is a repeat factor.
|
|
|
|
|
Use \\[dired-hide-all] to (un)hide all directories."
|
|
|
|
|
(interactive "p")
|
|
|
|
|
(dired-hide-check)
|
2004-06-06 02:26:46 +00:00
|
|
|
|
(let ((modflag (buffer-modified-p)))
|
|
|
|
|
(while (>= (setq arg (1- arg)) 0)
|
|
|
|
|
(let* ((cur-dir (dired-current-directory))
|
|
|
|
|
(hidden-p (dired-subdir-hidden-p cur-dir))
|
|
|
|
|
(elt (assoc cur-dir dired-subdir-alist))
|
|
|
|
|
(end-pos (1- (dired-get-subdir-max elt)))
|
|
|
|
|
buffer-read-only)
|
|
|
|
|
;; keep header line visible, hide rest
|
|
|
|
|
(goto-char (dired-get-subdir-min elt))
|
|
|
|
|
(skip-chars-forward "^\n\r")
|
|
|
|
|
(if hidden-p
|
|
|
|
|
(subst-char-in-region (point) end-pos ?\r ?\n)
|
|
|
|
|
(subst-char-in-region (point) end-pos ?\n ?\r)))
|
|
|
|
|
(dired-next-subdir 1 t))
|
|
|
|
|
(restore-buffer-modified-p modflag)))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun dired-hide-all (arg)
|
|
|
|
|
"Hide all subdirectories, leaving only their header lines.
|
|
|
|
|
If there is already something hidden, make everything visible again.
|
|
|
|
|
Use \\[dired-hide-subdir] to (un)hide a particular subdirectory."
|
|
|
|
|
(interactive "P")
|
|
|
|
|
(dired-hide-check)
|
2004-06-06 02:26:46 +00:00
|
|
|
|
(let ((modflag (buffer-modified-p))
|
|
|
|
|
buffer-read-only)
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(if (save-excursion
|
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
(search-forward "\r" nil t))
|
|
|
|
|
;; unhide - bombs on \r in filenames
|
|
|
|
|
(subst-char-in-region (point-min) (point-max) ?\r ?\n)
|
|
|
|
|
;; hide
|
|
|
|
|
(let ((pos (point-max)) ; pos of end of last directory
|
|
|
|
|
(alist dired-subdir-alist))
|
2004-06-06 02:26:46 +00:00
|
|
|
|
(while alist ; while there are dirs before pos
|
1992-06-24 02:14:18 +00:00
|
|
|
|
(subst-char-in-region (dired-get-subdir-min (car alist)) ; pos of prev dir
|
|
|
|
|
(save-excursion
|
|
|
|
|
(goto-char pos) ; current dir
|
|
|
|
|
;; we're somewhere on current dir's line
|
|
|
|
|
(forward-line -1)
|
|
|
|
|
(point))
|
|
|
|
|
?\n ?\r)
|
|
|
|
|
(setq pos (dired-get-subdir-min (car alist))) ; prev dir gets current dir
|
2004-06-06 02:26:46 +00:00
|
|
|
|
(setq alist (cdr alist)))))
|
|
|
|
|
(restore-buffer-modified-p modflag)))
|
1992-06-24 02:14:18 +00:00
|
|
|
|
|
|
|
|
|
;;;###end dired-ins.el
|
1992-07-16 17:20:42 +00:00
|
|
|
|
|
2001-01-26 13:14:11 +00:00
|
|
|
|
|
1994-10-22 16:00:31 +00:00
|
|
|
|
;; Functions for searching in tags style among marked files.
|
|
|
|
|
|
|
|
|
|
;;;###autoload
|
1995-04-15 05:42:25 +00:00
|
|
|
|
(defun dired-do-search (regexp)
|
1994-10-22 16:00:31 +00:00
|
|
|
|
"Search through all marked files for a match for REGEXP.
|
|
|
|
|
Stops when a match is found.
|
|
|
|
|
To continue searching for next match, use command \\[tags-loop-continue]."
|
|
|
|
|
(interactive "sSearch marked files (regexp): ")
|
2002-03-29 14:45:05 +00:00
|
|
|
|
(tags-search regexp '(dired-get-marked-files nil nil 'dired-nondirectory-p)))
|
1994-10-22 16:00:31 +00:00
|
|
|
|
|
|
|
|
|
;;;###autoload
|
2000-05-16 14:32:59 +00:00
|
|
|
|
(defun dired-do-query-replace-regexp (from to &optional delimited)
|
1995-04-15 05:42:25 +00:00
|
|
|
|
"Do `query-replace-regexp' of FROM with TO, on all marked files.
|
1994-10-22 16:00:31 +00:00
|
|
|
|
Third arg DELIMITED (prefix arg) means replace only word-delimited matches.
|
2001-12-30 00:53:22 +00:00
|
|
|
|
If you exit (\\[keyboard-quit], RET or q), you can resume the query replace
|
1994-10-22 16:00:31 +00:00
|
|
|
|
with the command \\[tags-loop-continue]."
|
|
|
|
|
(interactive
|
2005-08-09 21:38:24 +00:00
|
|
|
|
(let ((common
|
|
|
|
|
(query-replace-read-args
|
|
|
|
|
"Query replace regexp in marked files" t t)))
|
|
|
|
|
(list (nth 0 common) (nth 1 common) (nth 2 common))))
|
2003-12-01 01:56:19 +00:00
|
|
|
|
(dolist (file (dired-get-marked-files nil nil 'dired-nondirectory-p))
|
|
|
|
|
(let ((buffer (get-file-buffer file)))
|
|
|
|
|
(if (and buffer (with-current-buffer buffer
|
|
|
|
|
buffer-read-only))
|
2004-02-08 22:38:51 +00:00
|
|
|
|
(error "File `%s' is visited read-only" file))))
|
2002-03-29 14:45:05 +00:00
|
|
|
|
(tags-query-replace from to delimited
|
|
|
|
|
'(dired-get-marked-files nil nil 'dired-nondirectory-p)))
|
|
|
|
|
|
|
|
|
|
(defun dired-nondirectory-p (file)
|
|
|
|
|
(not (file-directory-p file)))
|
2001-01-26 13:14:11 +00:00
|
|
|
|
|
2000-07-10 07:02:03 +00:00
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun dired-show-file-type (file &optional deref-symlinks)
|
|
|
|
|
"Print the type of FILE, according to the `file' command.
|
|
|
|
|
If FILE is a symbolic link and the optional argument DEREF-SYMLINKS is
|
2002-04-17 09:54:47 +00:00
|
|
|
|
true then the type of the file linked to by FILE is printed instead."
|
2000-07-10 07:02:03 +00:00
|
|
|
|
(interactive (list (dired-get-filename t) current-prefix-arg))
|
2002-04-17 09:54:47 +00:00
|
|
|
|
(with-temp-buffer
|
2000-07-10 07:02:03 +00:00
|
|
|
|
(if deref-symlinks
|
2002-05-12 16:42:26 +00:00
|
|
|
|
(call-process "file" nil t t "-L" "--" file)
|
|
|
|
|
(call-process "file" nil t t "--" file))
|
2000-07-10 07:02:03 +00:00
|
|
|
|
(when (bolp)
|
|
|
|
|
(backward-delete-char 1))
|
2002-11-11 11:44:24 +00:00
|
|
|
|
(message "%s" (buffer-string))))
|
1994-10-22 16:00:31 +00:00
|
|
|
|
|
1994-06-10 21:09:40 +00:00
|
|
|
|
(provide 'dired-aux)
|
|
|
|
|
|
2008-04-10 14:10:46 +00:00
|
|
|
|
;; arch-tag: 4b508de9-a153-423d-8d3f-a1bbd86f4f60
|
1992-07-16 21:47:34 +00:00
|
|
|
|
;;; dired-aux.el ends here
|