annotate lisp/dired/dired.el @ 76:c0c698873ce1 r20-0b33

Import from CVS: tag r20-0b33
author cvs
date Mon, 13 Aug 2007 09:05:10 +0200
parents 131b0175ea99
children 6a378aca36af
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
70
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1 ;;; dired.el --- directory-browsing commands
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2 ;; Keywords: dired extensions
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
4 ;; Copyright (C) 1985, 1986, 1991, 1992 Free Software Foundation, Inc.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
5
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
6 ;; This file is part of XEmacs.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
7
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
8 ;; XEmacs is free software; you can redistribute it and/or modify it
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
9 ;; under the terms of the GNU General Public License as published by
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
10 ;; the Free Software Foundation; either version 2, or (at your option)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
11 ;; any later version.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
12
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
13 ;; XEmacs is distributed in the hope that it will be useful, but
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
14 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
16 ;; General Public License for more details.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
17
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
18 ;; You should have received a copy of the GNU General Public License
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
19 ;; along with XEmacs; see the file COPYING. If not, write to the
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
20 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
21 ;; Boston, MA 02111-1307, USA.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
22
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
23 ;; Rewritten in 1990/1991 to add tree features, file marking and
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
24 ;; sorting by Sebastian Kremer <sk@thp.uni-koeln.de>.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
25
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
26 (provide 'dired)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
27
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
28 (defconst dired-version (substring "!Revision: 6.0 !" 11 -2)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
29 "The revision number of Tree Dired (as string). The complete RCS id is:
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
30
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
31 !Id: dired.el,v 6.0 1992/05/15 14:25:45 sk RelBeta !
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
32
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
33 Don't forget to mention this when reporting bugs to:
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
34
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
35 Sebastian Kremer <sk@thp.uni-koeln.de>
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
36
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
37 Tree dired is available for anonymous ftp in USA in:
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
38
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
39 ftp.cs.buffalo.edu:pub/Emacs/diredall.tar.Z
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
40
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
41 and in Europe at my own site in Germany:
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
42
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
43 ftp.uni-koeln.de:/pub/gnu/emacs/diredall.tar.Z")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
44 ;; Should perhaps later give bug-gnu-emacs@prep.gnu.ai.mit.edu instead.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
45
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
46 ;; compatibility package when using Emacs 18.55
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
47 ;; XEmacs fix:
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
48 (defvar dired-emacs-19-p (not (equal (substring emacs-version 0 2) "18")))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
49 ;;;#### install (is there a better way to test for Emacs 19?)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
50 (or dired-emacs-19-p
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
51 (require 'emacs-19))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
52
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
53 ;;; Customizable variables
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
54
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
55 ;;; The funny comments are for autoload.el, to automagically update
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
56 ;;; loaddefs.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
57
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
58 (defvar dired-use-gzip-instead-of-compress t
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
59 "*If non-nil, use gzip instead of compress as the standard compress
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
60 program")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
61
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
62 (defvar dired-make-gzip-quiet t
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
63 "*If non-nil, pass -q to shell commands involving gzip this will override
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
64 GZIP environment variable.")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
65
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
66 (defvar dired-znew-switches nil
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
67 "*If non-nil, a string of switches that will be passed to `znew'
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
68 example: \"-K\"")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
69
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
70 (defvar dired-gzip-file-extension ".gz"
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
71 "*A string representing the suffix created by gzip. This should probably
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
72 match the value of --suffix or -S in the GZIP environment variable if it
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
73 exists and \".gz\" if it does not.")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
74
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
75 ;;;###autoload
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
76 (defvar dired-listing-switches (purecopy "-al")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
77 "*Switches passed to ls for dired. MUST contain the `l' option.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
78 Can contain even `F', `b', `i' and `s'.")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
79
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
80 ; Don't use absolute paths as /bin should be in any PATH and people
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
81 ; may prefer /usr/local/gnu/bin or whatever. However, chown is
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
82 ; usually not in PATH.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
83
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
84 ;;;###autoload
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
85 (defvar dired-chown-program
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
86 (purecopy
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
87 (if (memq system-type '(dgux-unix hpux usg-unix-v silicon-graphics-unix irix))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
88 "chown" "/etc/chown"))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
89 "*Name of chown command (usully `chown' or `/etc/chown').")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
90
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
91 ;;;###autoload
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
92 (defvar dired-ls-program (purecopy "ls")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
93 "*Absolute or relative name of the ls program used by dired.")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
94
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
95 ;;;###autoload
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
96 (defvar dired-ls-F-marks-symlinks t
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
97 "*Informs dired about how ls -lF marks symbolic links.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
98 Set this to t if `dired-ls-program' with -lF marks the symbolic link
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
99 itself with a trailing @ (usually the case under Ultrix).
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
100
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
101 Example: if `ln -s foo bar; ls -F bar' gives `bar -> foo', set it to
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
102 nil, if it gives `bar@ -> foo', set it to t.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
103
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
104 Dired checks if there is really a @ appended. Thus, if you have a
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
105 marking ls program on one host and a non-marking on another host, and
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
106 don't care about symbolic links which really end in a @, you can
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
107 always set this variable to t.")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
108
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
109 ;;;###autoload
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
110 (defvar dired-trivial-filenames (purecopy "^\\.\\.?$\\|^#")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
111 "*Regexp of files to skip when moving point to the first file of a new directory listing.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
112 Nil means move to the subdir line, t means move to first file.")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
113
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
114 ;;;###autoload
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
115 (defvar dired-keep-marker-move t
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
116 ;; Use t as default so that moved files `take their markers with them'
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
117 "If t, moved marked files are marked if their originals were.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
118 If a character, those files (marked or not) are marked with that character.")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
119
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
120 ;;;###autoload
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
121 (defvar dired-keep-marker-copy ?C
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
122 "If t, copied files are marked if their source files were.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
123 If a character, those files are always marked with that character.")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
124
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
125 ;;;###autoload
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
126 (defvar dired-keep-marker-hardlink ?H
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
127 "If t, hard-linked files are marked if the linked-to files were.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
128 If a character, those files are always marked with that character.")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
129
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
130 ;;;###autoload
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
131 (defvar dired-keep-marker-symlink ?Y
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
132 "If t, symlinked marked files are marked if the linked-to files were.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
133 If a character, those files are always marked with that character.")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
134
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
135 ;;;###autoload
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
136 (defvar dired-dwim-target nil
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
137 "*If non-nil, dired tries to guess a default target directory:
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
138 If there is a dired buffer displayed in the next window, use
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
139 its current subdir, instead of the current subdir of this dired
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
140 buffer.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
141
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
142 The target is used in the prompt for file copy, move etc.")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
143
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
144 ;;;###autoload
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
145 (defvar dired-copy-preserve-time nil
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
146 "*If non-nil, Dired preserves the last-modified time in a file copy.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
147 \(This works on only some systems.)\\<dired-mode-map>
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
148 Use `\\[dired-do-copy]' with a zero prefix argument to toggle its value.")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
149
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
150 ;;; Hook variables
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
151
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
152 (defvar dired-load-hook nil
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
153 "Run after loading dired.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
154 You can customize key bindings or load extensions with this.")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
155
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
156 (defvar dired-mode-hook nil
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
157 "Run at the very end of dired-mode.")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
158
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
159 (defvar dired-before-readin-hook nil
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
160 "This hook is run before a dired buffer is newly read in (created or reverted).")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
161
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
162 (defvar dired-after-readin-hook nil
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
163 "After each listing of a file or directory, this hook is run
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
164 with the buffer narrowed to the listing.")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
165 ;; Note this can't simply be run inside function dired-ls as the hook
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
166 ;; functions probably depend on the dired-subdir-alist to be OK.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
167
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
168 ;;; Internal variables
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
169
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
170 (defvar dired-marker-char ?* ; the answer is 42
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
171 ;; so that you can write things like
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
172 ;; (let ((dired-marker-char ?X))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
173 ;; ;; great code using X markers ...
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
174 ;; )
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
175 ;; For example, commands operating on two sets of files, A and B.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
176 ;; Or marking files with digits 0-9. This could implicate
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
177 ;; concentric sets or an order for the marked files.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
178 ;; The code depends on dynamic scoping on the marker char.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
179 "In dired, character used to mark files for later commands.")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
180
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
181 (defvar dired-del-marker ?D
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
182 "Character used to flag files for deletion.")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
183
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
184 (defvar dired-shrink-to-fit
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
185 (if (fboundp 'baud-rate) (> (baud-rate) search-slow-speed) t)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
186 "Whether dired shrinks the display buffer to fit the marked files.")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
187
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
188 (defvar dired-flagging-regexp nil);; Last regexp used to flag files.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
189
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
190 (defvar dired-directory nil
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
191 "The directory name or shell wildcard passed as argument to ls.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
192 Local to each dired buffer.")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
193
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
194 (defvar dired-actual-switches nil
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
195 "The actual (buffer-local) value of `dired-listing-switches'.")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
196
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
197 (defvar dired-re-inode-size "[0-9 \t]*"
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
198 "Regexp for optional initial inode and file size as produced by ls' -i and -s flags.")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
199
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
200 ;; These regexps must be tested at beginning-of-line, but are also
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
201 ;; used to search for next matches, so neither omitting "^" nor
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
202 ;; replacing "^" by "\n" (to make it slightly faster) will work.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
203
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
204 (defvar dired-re-mark "^[^ \n]")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
205 ;; "Regexp matching a marked line.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
206 ;; Important: the match ends just after the marker."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
207 (defvar dired-re-maybe-mark "^. ")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
208 ;; Note that dired-re-inode-size allows for an arbitray amount of
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
209 ;; whitespace, making nested indentation in dired-nstd.el work.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
210 (defvar dired-re-dir (concat dired-re-maybe-mark dired-re-inode-size "d"))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
211 (defvar dired-re-sym (concat dired-re-maybe-mark dired-re-inode-size "l"))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
212 (defvar dired-re-exe;; match ls permission string of an executable file
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
213 (mapconcat (function
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
214 (lambda (x)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
215 (concat dired-re-maybe-mark dired-re-inode-size x)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
216 '("-[-r][-w][xs][-r][-w].[-r][-w]."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
217 "-[-r][-w].[-r][-w][xs][-r][-w]."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
218 "-[-r][-w].[-r][-w].[-r][-w][xst]")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
219 "\\|"))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
220 (defvar dired-re-dot "^.* \\.\\.?/?$") ; with -F, might end in `/'
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
221
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
222 (defvar dired-subdir-alist nil
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
223 "Association list of subdirectories and their buffer positions:
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
224
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
225 \((LASTDIR . LASTMARKER) ... (DEFAULT-DIRECTORY . FIRSTMARKER)).")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
226
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
227 (defvar dired-subdir-regexp "^. \\([^ \n\r]+\\)\\(:\\)[\n\r]"
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
228 "Regexp matching a maybe hidden subdirectory line in ls -lR output.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
229 Subexpression 1 is the subdirectory proper, no trailing colon.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
230 The match starts at the beginning of the line and ends after the end
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
231 of the line (\\n or \\r).
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
232 Subexpression 2 must end right before the \\n or \\r.")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
233
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
234
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
235 ;;; Macros must be defined before they are used - for the byte compiler.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
236
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
237 ;; Returns the count if any work was done, nil otherwise.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
238 (defmacro dired-mark-if (predicate msg)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
239 (` (let (buffer-read-only count)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
240 (save-excursion
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
241 (setq count 0)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
242 (if (, msg) (message "Marking %ss..." (, msg)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
243 (goto-char (point-min))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
244 (while (not (eobp))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
245 (if (, predicate)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
246 (progn
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
247 (delete-char 1)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
248 (insert dired-marker-char)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
249 (setq count (1+ count))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
250 (forward-line 1))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
251 (if (, msg) (message "%s %s%s %s%s."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
252 count
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
253 (, msg)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
254 (dired-plural-s count)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
255 (if (eq dired-marker-char ?\040) "un" "")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
256 (if (eq dired-marker-char dired-del-marker)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
257 "flagged" "marked"))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
258 (and (> count 0) count))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
259
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
260 (defmacro dired-mark-map (body arg &optional show-progress)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
261 ;; "Macro: Perform BODY with point somewhere on each marked line
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
262 ;;and return a list of BODY's results.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
263 ;;If no marked file could be found, execute BODY on the current line.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
264 ;; If ARG is an integer, use the next ARG (or previous -ARG, if ARG<0)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
265 ;; files instead of the marked files.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
266 ;; In that case point is dragged along. This is so that commands on
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
267 ;; the next ARG (instead of the marked) files can be chained easily.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
268 ;; If ARG is otherwise non-nil, use current file instead.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
269 ;;If optional third arg SHOW-PROGRESS evaluates to non-nil,
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
270 ;; redisplay the dired buffer after each file is processed.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
271 ;;No guarantee is made about the position on the marked line.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
272 ;; BODY must ensure this itself if it depends on this.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
273 ;;Search starts at the beginning of the buffer, thus the car of the list
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
274 ;; corresponds to the line nearest to the buffer's bottom. This
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
275 ;; is also true for (positive and negative) integer values of ARG.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
276 ;;BODY should not be too long as it is expanded four times."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
277 ;;
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
278 ;;Warning: BODY must not add new lines before point - this may cause an
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
279 ;;endless loop.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
280 ;;This warning should not apply any longer, sk 2-Sep-1991 14:10.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
281 (` (prog1
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
282 (let (buffer-read-only case-fold-search found results)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
283 (if (, arg)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
284 (if (integerp (, arg))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
285 (progn;; no save-excursion, want to move point.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
286 (dired-repeat-over-lines
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
287 (, arg)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
288 (function (lambda ()
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
289 (if (, show-progress) (sit-for 0))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
290 (setq results (cons (, body) results)))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
291 (if (< (, arg) 0)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
292 (nreverse results)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
293 results))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
294 ;; non-nil, non-integer ARG means use current file:
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
295 (list (, body)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
296 (let ((regexp (dired-marker-regexp)) next-position)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
297 (save-excursion
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
298 (goto-char (point-min))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
299 ;; remember position of next marked file before BODY
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
300 ;; can insert lines before the just found file,
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
301 ;; confusing us by finding the same marked file again
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
302 ;; and again and...
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
303 (setq next-position (and (re-search-forward regexp nil t)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
304 (point-marker))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
305 found (not (null next-position)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
306 (while next-position
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
307 (goto-char next-position)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
308 (if (, show-progress) (sit-for 0))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
309 (setq results (cons (, body) results))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
310 ;; move after last match
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
311 (goto-char next-position)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
312 (forward-line 1)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
313 (set-marker next-position nil)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
314 (setq next-position (and (re-search-forward regexp nil t)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
315 (point-marker)))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
316 (if found
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
317 results
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
318 (list (, body))))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
319 ;; save-excursion loses, again
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
320 (dired-move-to-filename))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
321
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
322 (defun dired-mark-get-files (&optional localp arg)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
323 "Return the marked files as list of strings.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
324 The list is in the same order as the buffer, that is, the car is the
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
325 first marked file.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
326 Values returned are normally absolute pathnames.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
327 Optional arg LOCALP as in `dired-get-filename'.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
328 Optional second argument ARG forces to use other files. If ARG is an
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
329 integer, use the next ARG files. If ARG is otherwise non-nil, use
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
330 current file. Usually ARG comes from the current prefix arg."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
331 (nreverse (save-excursion (dired-mark-map (dired-get-filename localp) arg))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
332
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
333
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
334 ;; Function dired-ls is redefinable for VMS, ange-ftp, Prospero or
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
335 ;; other special applications.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
336
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
337 ;; dired-ls
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
338 ;; - must insert _exactly_one_line_ describing FILE if WILDCARD and
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
339 ;; FULL-DIRECTORY-P is nil.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
340 ;; The single line of output must display FILE's name as it was
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
341 ;; given, namely, an absolute path name.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
342 ;; - must insert exactly one line for each file if WILDCARD or
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
343 ;; FULL-DIRECTORY-P is t, plus one optional "total" line
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
344 ;; before the file lines, plus optional text after the file lines.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
345 ;; Lines are delimited by "\n", so filenames containing "\n" are not
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
346 ;; allowed.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
347 ;; File lines should display the basename, not a path name.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
348 ;; - must drag point after inserted text
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
349 ;; - must be consistent with
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
350 ;; - functions dired-move-to-filename, (these two define what a file line is)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
351 ;; dired-move-to-end-of-filename,
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
352 ;; dired-between-files, (shortcut for (not (dired-move-to-filename)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
353 ;; dired-insert-headerline
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
354 ;; dired-after-subdir-garbage (defines what a "total" line is)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
355 ;; - variables dired-subdir-regexp
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
356 (defun dired-ls (file switches &optional wildcard full-directory-p)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
357 ; "Insert ls output of FILE, formatted according to SWITCHES.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
358 ;Optional third arg WILDCARD means treat FILE as shell wildcard.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
359 ;Optional fourth arg FULL-DIRECTORY-P means file is a directory and
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
360 ;switches do not contain `d', so that a full listing is expected.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
361 ;
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
362 ;Uses dired-ls-program (and shell-file-name if WILDCARD) to do the work."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
363 (if wildcard
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
364 (let ((default-directory (file-name-directory file)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
365 (call-process shell-file-name nil t nil
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
366 "-c" (concat dired-ls-program " -d " switches " "
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
367 (file-name-nondirectory file))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
368 (call-process dired-ls-program nil t nil switches file)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
369
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
370 ;; The dired command
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
371
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
372 (defun dired-read-dir-and-switches (str)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
373 ;; For use in interactive.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
374 (reverse (list
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
375 (if current-prefix-arg
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
376 (read-string "Dired listing switches: "
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
377 dired-listing-switches))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
378 (read-file-name (format "Dired %s(directory): " str)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
379 nil default-directory nil))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
380
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
381 ;;;###autoload (define-key ctl-x-map "d" 'dired)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
382 ;;;###autoload
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
383 (defun dired (dirname &optional switches)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
384 "\"Edit\" directory DIRNAME--delete, rename, print, etc. some files in it.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
385 With an optional prefix argument you can specify the ls SWITCHES that are used.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
386 Dired displays a list of files in DIRNAME (which may also have
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
387 shell wildcards appended to select certain files).
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
388 You can move around in it with the usual commands.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
389 You can flag files for deletion with \\<dired-mode-map>\\[dired-flag-file-deleted] and then delete them by
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
390 typing \\[dired-do-deletions].
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
391 Type \\[describe-mode] after entering dired for more info.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
392
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
393 If DIRNAME is already in a dired buffer, that buffer is used without refresh."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
394 ;; Cannot use (interactive "D") because of wildcards.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
395 (interactive (dired-read-dir-and-switches ""))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
396 (switch-to-buffer (dired-noselect dirname switches)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
397
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
398 ;;;###autoload (define-key ctl-x-4-map "d" 'dired-other-window)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
399 ;;;###autoload
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
400 (defun dired-other-window (dirname &optional switches)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
401 "\"Edit\" directory DIRNAME. Like `dired' but selects in another window."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
402 (interactive (dired-read-dir-and-switches "in other window "))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
403 (switch-to-buffer-other-window (dired-noselect dirname switches)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
404
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
405 ;;;###autoload (define-key ctl-x-5-map "d" 'dired-other-frame)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
406 ;;;###autoload
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
407 (defun dired-other-frame (dirname &optional switches)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
408 "\"Edit\" directory DIRNAME. Like `dired' but makes a new frame."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
409 (interactive (dired-read-dir-and-switches "in other frame "))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
410 (switch-to-buffer-other-frame (dired-noselect dirname switches)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
411
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
412 ;;;###autoload
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
413 (defun dired-noselect (dirname &optional switches)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
414 "Like `dired' but returns the dired buffer as value, does not select it."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
415 (or dirname (setq dirname default-directory))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
416 ;; This loses the distinction between "/foo/*/" and "/foo/*" that
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
417 ;; some shells make:
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
418 (setq dirname (expand-file-name (directory-file-name dirname)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
419 (if (file-directory-p dirname)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
420 (setq dirname (file-name-as-directory dirname)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
421 (dired-internal-noselect dirname switches))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
422
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
423 ;; Separate function from dired-noselect for the sake of dired-vms.el.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
424 (defun dired-internal-noselect (dirname &optional switches)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
425 ;; If there is an existing dired buffer for DIRNAME, just leave
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
426 ;; buffer as it is (don't even call dired-revert).
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
427 ;; This saves time especially for deep trees or with ange-ftp.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
428 ;; The user can type `g'easily, and it is more consistent with find-file.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
429 ;; But if SWITCHES are given they are probably different from the
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
430 ;; buffer's old value, so call dired-sort-other, which does
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
431 ;; revert the buffer.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
432 ;; A pity we can't possibly do "Directory has changed - refresh? "
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
433 ;; like find-file does...maybe in the GNU OS.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
434 (let* ((buffer (dired-find-buffer-nocreate dirname))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
435 ;; note that buffer already is in dired-mode, if found
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
436 (new-buffer-p (not buffer))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
437 (old-buf (current-buffer)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
438 (or buffer
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
439 (let ((default-major-mode 'fundamental-mode))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
440 ;; We don't want default-major-mode to run hooks and set auto-fill
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
441 ;; or whatever, now that dired-mode does not
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
442 ;; kill-all-local-variables any longer.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
443 (setq buffer (create-file-buffer (directory-file-name dirname)))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
444 (set-buffer buffer)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
445 (if (not new-buffer-p) ; existing buffer ...
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
446 (if switches ; ... but new switches
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
447 (dired-sort-other switches)) ; this calls dired-revert
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
448 ;; Else a new buffer
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
449 (setq default-directory (if (file-directory-p dirname)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
450 dirname
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
451 (file-name-directory dirname)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
452 (or switches (setq switches dired-listing-switches))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
453 (dired-mode dirname switches)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
454 ;; default-directory and dired-actual-switches are set now
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
455 ;; (buffer-local), so we can call dired-readin:
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
456 (let ((failed t))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
457 (unwind-protect
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
458 (progn (dired-readin dirname buffer)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
459 (setq failed nil))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
460 ;; dired-readin can fail if parent directories are inaccessible.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
461 ;; Don't leave an empty buffer around in that case.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
462 (if failed (kill-buffer buffer))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
463 ;; No need to narrow since the whole buffer contains just
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
464 ;; dired-readin's output, nothing else. The hook can
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
465 ;; successfully use dired functions (e.g. dired-get-filename)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
466 ;; as the subdir-alist has been built in dired-readin.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
467 (let ((buffer-read-only nil))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
468 (run-hooks 'dired-after-readin-hook))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
469 (goto-char (point-min))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
470 (dired-initial-position dirname))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
471 (set-buffer old-buf)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
472 buffer))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
473
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
474 ;; This differs from dired-buffers-for-dir in that it does not consider
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
475 ;; subdirs of default-directory and searches for the first match only
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
476 (defun dired-find-buffer-nocreate (dirname)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
477 (let (found (blist (buffer-list)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
478 (while blist
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
479 (save-excursion
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
480 (set-buffer (car blist))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
481 (if (and (eq major-mode 'dired-mode)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
482 (equal dired-directory dirname))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
483 (setq found (car blist)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
484 blist nil)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
485 (setq blist (cdr blist)))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
486 found))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
487
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
488
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
489 ;; Read in a new dired buffer
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
490
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
491 ;; dired-readin differs from dired-insert-subdir in that it accepts
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
492 ;; wildcards, erases the buffer, and builds the subdir-alist anew
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
493 ;; (including making it buffer-local and clearing it first).
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
494 (defun dired-readin (dirname buffer)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
495 ;; default-directory and dired-actual-switches must be buffer-local
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
496 ;; and initialized by now.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
497 ;; Thus we can test (equal default-directory dirname) instead of
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
498 ;; (file-directory-p dirname) and save a filesystem transaction.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
499 ;; Also, we can run this hook which may want to modify the switches
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
500 ;; based on default-directory, e.g. with ange-ftp to a SysV host
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
501 ;; where ls won't understand -Al switches.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
502 (setq dirname (expand-file-name dirname))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
503 (run-hooks 'dired-before-readin-hook)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
504 (save-excursion
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
505 (message "Reading directory %s..." dirname)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
506 (set-buffer buffer)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
507 (let (buffer-read-only)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
508 (widen)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
509 (erase-buffer)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
510 (dired-readin-insert dirname)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
511 (dired-indent-rigidly (point-min) (point-max) 2)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
512 ;; We need this to make the root dir have a header line as all
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
513 ;; other subdirs have:
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
514 (goto-char (point-min))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
515 (dired-insert-headerline default-directory)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
516 ;; can't run dired-after-readin-hook here, it may depend on the subdir
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
517 ;; alist to be OK.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
518 )
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
519 (message "Reading directory %s...done" dirname)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
520 (set-buffer-modified-p nil)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
521 ;; Must first make alist buffer local and set it to nil because
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
522 ;; dired-build-subdir-alist will call dired-clear-alist first
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
523 (set (make-local-variable 'dired-subdir-alist) nil)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
524 (let (case-fold-search)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
525 (if (string-match "R" dired-actual-switches)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
526 (dired-build-subdir-alist)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
527 ;; no need to parse the buffer if listing is not recursive
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
528 (dired-simple-subdir-alist)))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
529
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
530 ;; Subroutines of dired-readin
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
531
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
532 (defun dired-readin-insert (dirname)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
533 ;; Just insert listing for DIRNAME, assuming a clean buffer.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
534 (let ((font-lock-mode nil))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
535 (if (equal default-directory dirname);; i.e., (file-directory-p dirname)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
536 (dired-ls (if (or (let (case-fold-search)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
537 (string-match "R" dired-actual-switches))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
538 (eq system-type 'vax-vms))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
539 dirname
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
540 ;; On SysV derived system, symbolic links to
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
541 ;; directories are not resolved, while on BSD
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
542 ;; derived it suffices to let DIRNAME end in slash.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
543 ;; We always let it end in "/." since it does no
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
544 ;; harm on BSD and makes Dired work on such links on
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
545 ;; SysV.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
546 ;; Cannot do this with -R since "dir/./subdir"
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
547 ;; headerlines would result, utterly confusing dired.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
548 (concat dirname "."))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
549 dired-actual-switches nil t)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
550 (if (not (file-readable-p
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
551 (directory-file-name (file-name-directory dirname))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
552 (error "Directory %s inaccessible or nonexistent" dirname)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
553 ;; else assume it contains wildcards:
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
554 (dired-ls dirname dired-actual-switches t)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
555 (save-excursion;; insert wildcard instead of total line:
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
556 (goto-char (point-min))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
557 (insert "wildcard " (file-name-nondirectory dirname) "\n"))))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
558
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
559 (defun dired-insert-headerline (dir);; also used by dired-insert-subdir
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
560 ;; Insert DIR's headerline with no trailing slash, exactly like ls
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
561 ;; would, and put cursor where dired-build-subdir-alist puts subdir
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
562 ;; boundaries.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
563 (save-excursion (insert " " (directory-file-name dir) ":\n")))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
564
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
565 ;; Make the file names highlight when the mouse is on them.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
566 ;; from FSF 19.30.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
567 (defun dired-insert-set-properties (beg end)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
568 (save-excursion
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
569 (goto-char beg)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
570 (while (< (point) end)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
571 (condition-case nil
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
572 (if (dired-move-to-filename)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
573 (put-text-property (point)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
574 (save-excursion
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
575 (dired-move-to-end-of-filename)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
576 (point))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
577 'highlight t))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
578 (error nil))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
579 (forward-line 1))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
580
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
581
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
582 ;; Reverting a dired buffer
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
583
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
584 (defun dired-revert (&optional arg noconfirm)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
585 ;; Reread the dired buffer. Must also be called after
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
586 ;; dired-actual-switches have changed.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
587 ;; Should not fail even on completely garbaged buffers.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
588 ;; Preserves old cursor, marks/flags, hidden-p.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
589 (widen) ; just in case user narrowed
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
590 (let ((opoint (point))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
591 (ofile (dired-get-filename nil t))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
592 (mark-alist nil) ; save marked files
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
593 (hidden-subdirs (dired-remember-hidden))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
594 (old-subdir-alist (cdr (reverse dired-subdir-alist))) ; except pwd
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
595 case-fold-search ; we check for upper case ls flags
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
596 buffer-read-only)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
597 (goto-char (point-min))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
598 (setq mark-alist;; only after dired-remember-hidden since this unhides:
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
599 (dired-remember-marks (point-min) (point-max)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
600 ;; treat top level dir extra (it may contain wildcards)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
601 (dired-readin dired-directory (current-buffer))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
602 (let ((dired-after-readin-hook nil))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
603 ;; don't run that hook for each subdir...
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
604 (dired-insert-old-subdirs old-subdir-alist))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
605 (dired-mark-remembered mark-alist) ; mark files that were marked
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
606 ;; ... run the hook for the whole buffer, and only after markers
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
607 ;; have been reinserted (else omitting in dired-x would omit marked files)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
608 (run-hooks 'dired-after-readin-hook) ; no need to narrow
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
609 (or (and ofile (dired-goto-file ofile)) ; move cursor to where it
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
610 (goto-char opoint)) ; was before
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
611 (dired-move-to-filename)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
612 (save-excursion ; hide subdirs that were hidden
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
613 (mapcar (function (lambda (dir)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
614 (if (dired-goto-subdir dir)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
615 (dired-hide-subdir 1))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
616 hidden-subdirs)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
617 ;; outside of the let scope
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
618 (setq buffer-read-only t))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
619
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
620 ;; Subroutines of dired-revert
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
621 ;; Some of these are also used when inserting subdirs.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
622
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
623 (defun dired-remember-marks (beg end)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
624 ;; Return alist of files and their marks, from BEG to END.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
625 (if selective-display ; must unhide to make this work.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
626 (let (buffer-read-only)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
627 (subst-char-in-region beg end ?\r ?\n)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
628 (let (fil chr alist)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
629 (save-excursion
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
630 (goto-char beg)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
631 (while (re-search-forward dired-re-mark end t)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
632 (if (setq fil (dired-get-filename nil t))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
633 (setq chr (preceding-char)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
634 alist (cons (cons fil chr) alist)))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
635 alist))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
636
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
637 (defun dired-mark-remembered (alist)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
638 ;; Mark all files remembered in ALIST.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
639 (let (elt fil chr)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
640 (while alist
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
641 (setq elt (car alist)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
642 alist (cdr alist)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
643 fil (car elt)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
644 chr (cdr elt))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
645 (if (dired-goto-file fil)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
646 (save-excursion
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
647 (beginning-of-line)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
648 (delete-char 1)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
649 (insert chr))))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
650
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
651 (defun dired-remember-hidden ()
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
652 (let ((l dired-subdir-alist) dir result)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
653 (while l
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
654 (setq dir (car (car l))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
655 l (cdr l))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
656 (if (dired-subdir-hidden-p dir)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
657 (setq result (cons dir result))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
658 result))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
659
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
660 (defun dired-insert-old-subdirs (old-subdir-alist)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
661 ;; Try to insert all subdirs that were displayed before
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
662 (or (string-match "R" dired-actual-switches)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
663 (let (elt dir)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
664 (while old-subdir-alist
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
665 (setq elt (car old-subdir-alist)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
666 old-subdir-alist (cdr old-subdir-alist)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
667 dir (car elt))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
668 (condition-case ()
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
669 (dired-insert-subdir dir)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
670 (error nil))))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
671
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
672
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
673 ;; dired mode key bindings and initialization
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
674
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
675 (defvar dired-mode-map nil "Local keymap for dired-mode buffers.")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
676 (if dired-mode-map
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
677 nil
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
678 ;; Force `f' rather than `e' in the mode doc:
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
679 (fset 'dired-advertised-find-file 'dired-find-file)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
680 ;; This looks ugly when substitute-command-keys uses C-d instead d:
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
681 ;; (define-key dired-mode-map "\C-d" 'dired-flag-file-deleted)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
682
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
683 (setq dired-mode-map (make-keymap))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
684 (suppress-keymap dired-mode-map)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
685 ;; Commands to mark certain categories of files
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
686 (define-key dired-mode-map "#" 'dired-flag-auto-save-files)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
687 (define-key dired-mode-map "*" 'dired-mark-executables)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
688 (define-key dired-mode-map "." 'dired-clean-directory)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
689 (define-key dired-mode-map "/" 'dired-mark-directories)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
690 (define-key dired-mode-map "@" 'dired-mark-symlinks)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
691 ;; Upper case keys (except !, c, r) for operating on the marked files
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
692 (define-key dired-mode-map "c" 'dired-do-copy)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
693 (define-key dired-mode-map "r" 'dired-do-move)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
694 (define-key dired-mode-map "!" 'dired-do-shell-command)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
695 (define-key dired-mode-map "B" 'dired-do-byte-compile)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
696 (define-key dired-mode-map "C" 'dired-do-compress)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
697 (define-key dired-mode-map "G" 'dired-do-chgrp)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
698 (define-key dired-mode-map "H" 'dired-do-hardlink)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
699 (define-key dired-mode-map "L" 'dired-do-load)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
700 (define-key dired-mode-map "M" 'dired-do-chmod)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
701 (define-key dired-mode-map "O" 'dired-do-chown)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
702 (define-key dired-mode-map "P" 'dired-do-print)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
703 (define-key dired-mode-map "U" 'dired-do-uncompress)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
704 (define-key dired-mode-map "X" 'dired-do-delete)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
705 (define-key dired-mode-map "Y" 'dired-do-symlink)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
706 ;; exceptions to the upper key rule
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
707 (define-key dired-mode-map "D" 'dired-diff)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
708 (define-key dired-mode-map "W" 'dired-why)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
709 ;; Tree Dired commands
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
710 (define-key dired-mode-map "\M-\C-?" 'dired-unflag-all-files)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
711 (define-key dired-mode-map "\M-\C-d" 'dired-tree-down)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
712 (define-key dired-mode-map "\M-\C-u" 'dired-tree-up)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
713 (define-key dired-mode-map "\M-\C-n" 'dired-next-subdir)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
714 (define-key dired-mode-map "\M-\C-p" 'dired-prev-subdir)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
715 ;; move to marked files
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
716 (define-key dired-mode-map "\M-{" 'dired-prev-marked-file)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
717 (define-key dired-mode-map "\M-}" 'dired-next-marked-file)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
718 ;; kill marked files
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
719 (define-key dired-mode-map "\M-k" 'dired-do-kill)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
720 ;; Make all regexp commands share a `%' prefix:
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
721 (fset 'dired-regexp-prefix (make-sparse-keymap))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
722 (define-key dired-mode-map "%" 'dired-regexp-prefix)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
723 (define-key dired-mode-map "%u" 'dired-upcase)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
724 (define-key dired-mode-map "%l" 'dired-downcase)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
725 (define-key dired-mode-map "%d" 'dired-flag-regexp-files)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
726 (define-key dired-mode-map "%m" 'dired-mark-files-regexp)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
727 (define-key dired-mode-map "%r" 'dired-do-rename-regexp)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
728 (define-key dired-mode-map "%c" 'dired-do-copy-regexp)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
729 (define-key dired-mode-map "%H" 'dired-do-hardlink-regexp)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
730 (define-key dired-mode-map "%Y" 'dired-do-symlink-regexp)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
731 ;; Lower keys for commands not operating on all the marked files
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
732 (define-key dired-mode-map "d" 'dired-flag-file-deleted)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
733 (define-key dired-mode-map "e" 'dired-find-file)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
734 (define-key dired-mode-map "f" 'dired-advertised-find-file)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
735 (define-key dired-mode-map "g" 'revert-buffer)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
736 (define-key dired-mode-map "h" 'describe-mode)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
737 (define-key dired-mode-map "i" 'dired-maybe-insert-subdir)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
738 (define-key dired-mode-map "k" 'dired-kill-line-or-subdir)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
739 (define-key dired-mode-map "l" 'dired-do-redisplay)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
740 (define-key dired-mode-map "m" 'dired-mark-subdir-or-file)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
741 (define-key dired-mode-map "n" 'dired-next-line)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
742 (define-key dired-mode-map "o" 'dired-find-file-other-window)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
743 (define-key dired-mode-map "p" 'dired-previous-line)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
744 (define-key dired-mode-map "q" 'dired-quit)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
745 (define-key dired-mode-map "s" 'dired-sort-toggle-or-edit)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
746 (define-key dired-mode-map "u" 'dired-unmark-subdir-or-file)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
747 (define-key dired-mode-map "v" 'dired-view-file)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
748 (define-key dired-mode-map "x" 'dired-do-deletions)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
749 (define-key dired-mode-map "~" 'dired-flag-backup-files)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
750 (define-key dired-mode-map "\M-~" 'dired-backup-diff)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
751 (define-key dired-mode-map "+" 'dired-create-directory)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
752 ;; moving
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
753 (define-key dired-mode-map "<" 'dired-prev-dirline)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
754 (define-key dired-mode-map ">" 'dired-next-dirline)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
755 (define-key dired-mode-map "^" 'dired-up-directory)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
756 (define-key dired-mode-map " " 'dired-next-line)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
757 (define-key dired-mode-map "\C-n" 'dired-next-line)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
758 (define-key dired-mode-map "\C-p" 'dired-previous-line)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
759 ;; hiding
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
760 (define-key dired-mode-map "$" 'dired-hide-subdir)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
761 (define-key dired-mode-map "=" 'dired-hide-all)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
762 ;; misc
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
763 (define-key dired-mode-map "?" 'dired-summary)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
764 (define-key dired-mode-map "\177" 'dired-backup-unflag)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
765 (define-key dired-mode-map "\C-_" 'dired-undo)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
766 (define-key dired-mode-map "\C-xu" 'dired-undo)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
767 )
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
768
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
769 (or (equal (assq 'dired-sort-mode minor-mode-alist)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
770 '(dired-sort-mode dired-sort-mode))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
771 ;; Test whether this has already been done in case dired is reloaded
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
772 ;; There may be several elements with dired-sort-mode as car.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
773 (setq minor-mode-alist
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
774 (cons '(dired-sort-mode dired-sort-mode)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
775 ;; dired-sort-mode is nil outside dired
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
776 minor-mode-alist)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
777
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
778 ;; Dired mode is suitable only for specially formatted data.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
779 (put 'dired-mode 'mode-class 'special)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
780
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
781 (defun dired-mode (&optional dirname switches)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
782 "\
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
783 Mode for \"editing\" directory listings.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
784 In dired, you are \"editing\" a list of the files in a directory and
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
785 \(optionally) its subdirectories, in the format of `ls -lR'.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
786 Each directory is a page: use \\[backward-page] and \\[forward-page] to move pagewise.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
787 \"Editing\" means that you can run shell commands on files, visit,
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
788 compress, load or byte-compile them, change their file attributes
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
789 and insert subdirectories into the same buffer. You can \"mark\"
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
790 files for later commands or \"flag\" them for deletion, either file
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
791 by file or all files matching certain criteria.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
792 You can move using the usual cursor motion commands.\\<dired-mode-map>
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
793 Letters no longer insert themselves. Digits are prefix arguments.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
794 Instead, type \\[dired-flag-file-deleted] to flag a file for Deletion.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
795 Type \\[dired-mark-subdir-or-file] to Mark a file or subdirectory for later commands.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
796 Most commands operate on the marked files and use the current file
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
797 if no files are marked. Use a numeric prefix argument to operate on
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
798 the next ARG (or previous -ARG if ARG<0) files, or just `1'
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
799 to operate on the current file only. Prefix arguments override marks.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
800 Mark-using commands display a list of failures afterwards. Type \\[dired-why] to see
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
801 why something went wrong.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
802 Type \\[dired-unmark-subdir-or-file] to Unmark a file or all files of a subdirectory.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
803 Type \\[dired-backup-unflag] to back up one line and unflag.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
804 Type \\[dired-do-deletions] to eXecute the deletions requested.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
805 Type \\[dired-advertised-find-file] to Find the current line's file
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
806 (or dired it in another buffer, if it is a directory).
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
807 Type \\[dired-find-file-other-window] to find file or dired directory in Other window.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
808 Type \\[dired-maybe-insert-subdir] to Insert a subdirectory in this buffer.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
809 Type \\[dired-do-move] to Rename a file or move the marked files to another directory.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
810 Type \\[dired-do-copy] to Copy files.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
811 Type \\[dired-sort-toggle-or-edit] to toggle sorting by name/date or change the ls switches.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
812 Type \\[revert-buffer] to read all currently expanded directories again.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
813 This retains all marks and hides subdirs again that were hidden before.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
814 SPC and DEL can be used to move down and up by lines.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
815
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
816 If dired ever gets confused, you can either type \\[revert-buffer] \
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
817 to read the
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
818 directories again, type \\[dired-do-redisplay] \
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
819 to relist a single or the marked files or a
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
820 subdirectory, or type \\[dired-build-subdir-alist] to parse the buffer
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
821 again for the directory tree.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
822
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
823 Customization variables (rename this buffer and type \\[describe-variable] on each line
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
824 for more info):
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
825
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
826 dired-listing-switches
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
827 dired-trivial-filenames
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
828 dired-shrink-to-fit
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
829 dired-marker-char
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
830 dired-del-marker
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
831 dired-keep-marker-move
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
832 dired-keep-marker-copy
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
833 dired-keep-marker-hardlink
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
834 dired-keep-marker-symlink
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
835
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
836 Hooks (use \\[describe-variable] to see their documentation):
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
837
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
838 dired-before-readin-hook
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
839 dired-after-readin-hook
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
840 dired-mode-hook
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
841 dired-load-hook
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
842
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
843 Keybindings:
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
844 \\{dired-mode-map}"
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
845 ;; Not to be called interactively (e.g. dired-directory will be set
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
846 ;; to default-directory, which is wrong with wildcards).
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
847 (kill-all-local-variables)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
848 (use-local-map dired-mode-map)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
849 (dired-advertise) ; default-directory is already set
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
850 (setq major-mode 'dired-mode
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
851 mode-name "Dired"
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
852 case-fold-search nil
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
853 buffer-read-only t
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
854 selective-display t ; for subdirectory hiding
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
855 modeline-buffer-identification '("Dired: %17b"))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
856 (set (make-local-variable 'revert-buffer-function)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
857 (function dired-revert))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
858 (set (make-local-variable 'page-delimiter)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
859 "\n\n")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
860 (set (make-local-variable 'dired-directory)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
861 (or dirname default-directory))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
862 (set (make-local-variable 'list-buffers-directory)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
863 dired-directory)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
864 (set (make-local-variable 'dired-actual-switches)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
865 (or switches dired-listing-switches))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
866 (make-local-variable 'dired-sort-mode)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
867 (dired-sort-other dired-actual-switches t)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
868 (run-hooks 'dired-mode-hook))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
869
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
870
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
871 (defun dired-check-ls-l ()
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
872 (let (case-fold-search)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
873 (or (string-match "l" dired-actual-switches)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
874 (error "Dired needs -l in ls switches"))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
875
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
876 (defun dired-repeat-over-lines (arg function)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
877 ;; This version skips non-file lines.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
878 (beginning-of-line)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
879 (while (and (> arg 0) (not (eobp)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
880 (setq arg (1- arg))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
881 (beginning-of-line)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
882 (while (and (not (eobp)) (dired-between-files)) (forward-line 1))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
883 (save-excursion (funcall function))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
884 (forward-line 1))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
885 (while (and (< arg 0) (not (bobp)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
886 (setq arg (1+ arg))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
887 (forward-line -1)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
888 (while (and (not (bobp)) (dired-between-files)) (forward-line -1))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
889 (beginning-of-line)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
890 (save-excursion (funcall function))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
891 (dired-move-to-filename))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
892 (dired-move-to-filename))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
893
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
894 (defun dired-flag-file-deleted (arg)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
895 "In dired, flag the current line's file for deletion.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
896 With prefix arg, repeat over several lines.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
897
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
898 If on a subdir headerline, mark all its files except `.' and `..'."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
899 (interactive "P")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
900 (let ((dired-marker-char dired-del-marker))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
901 (dired-mark-subdir-or-file arg)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
902
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
903 (defun dired-quit ()
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
904 "Bury the current dired buffer."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
905 (interactive)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
906 (bury-buffer))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
907
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
908 (defun dired-summary ()
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
909 (interactive)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
910 ;>> this should check the key-bindings and use substitute-command-keys if non-standard
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
911 (message
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
912 "d-elete, u-ndelete, x-punge, f-ind, o-ther window, r-ename, c-opy, h-elp"))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
913
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
914 (defun dired-create-directory (directory)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
915 "Create a directory called DIRECTORY."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
916 (interactive
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
917 (list (read-file-name "Create directory: " (dired-current-directory))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
918 (let ((expanded (directory-file-name (expand-file-name directory))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
919 (make-directory expanded)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
920 (dired-add-file expanded)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
921 (dired-move-to-filename)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
922
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
923 (defun dired-undo ()
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
924 "Undo in a dired buffer.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
925 This doesn't recover lost files, it is just normal undo with temporarily
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
926 writeable buffer. You can use it to recover marks, killed lines or subdirs.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
927 In the latter case, you have to do \\[dired-build-subdir-alist] to
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
928 parse the buffer again."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
929 (interactive)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
930 (let (buffer-read-only)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
931 (undo)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
932
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
933 (defun dired-unflag (arg)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
934 "In dired, remove the current line's delete flag then move to next line.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
935 Optional prefix ARG says how many lines to unflag."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
936 (interactive "p")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
937 (dired-repeat-over-lines arg
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
938 '(lambda ()
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
939 (let (buffer-read-only)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
940 (delete-char 1)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
941 (insert " ")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
942 (forward-char -1)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
943 nil))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
944
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
945 (defun dired-backup-unflag (arg)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
946 "In dired, move up lines and remove deletion flag there.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
947 Optional prefix ARG says how many lines to unflag; default is one line."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
948 (interactive "p")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
949 (dired-unflag (- arg)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
950
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
951 (defun dired-next-line (arg)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
952 "Move down lines then position at filename.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
953 Optional prefix ARG says how many lines to move; default is one line."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
954 (interactive "_p")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
955 (next-line arg)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
956 (dired-move-to-filename))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
957
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
958 (defun dired-previous-line (arg)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
959 "Move up lines then position at filename.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
960 Optional prefix ARG says how many lines to move; default is one line."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
961 (interactive "_p")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
962 (previous-line arg)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
963 (dired-move-to-filename))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
964
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
965 (defun dired-up-directory ()
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
966 "Run dired on parent directory of current directory.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
967 Find the parent directory either in this buffer or another buffer.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
968 Creates a buffer if necessary."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
969 (interactive)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
970 (let* ((dir (dired-current-directory))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
971 (up (file-name-directory (directory-file-name dir))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
972 (or (dired-goto-file (directory-file-name dir))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
973 (dired-goto-subdir up)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
974 (progn
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
975 (dired up)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
976 (dired-goto-file dir)))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
977
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
978 (defun dired-find-file ()
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
979 "In dired, visit the file or directory named on this line."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
980 (interactive)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
981 (let ((find-file-run-dired t))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
982 (find-file (dired-get-filename))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
983
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
984 (defun dired-view-file ()
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
985 "In dired, examine a file in view mode, returning to dired when done.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
986 When file is a directory, show it in this buffer if it is inserted;
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
987 otherwise, display it in another buffer."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
988 (interactive)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
989 (if (file-directory-p (dired-get-filename))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
990 (or (dired-goto-subdir (dired-get-filename))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
991 (dired (dired-get-filename)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
992 (view-file (dired-get-filename))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
993
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
994 (defun dired-find-file-other-window ()
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
995 "In dired, visit this file or directory in another window."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
996 (interactive)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
997 (let ((find-file-run-dired t)) ;; XEmacs
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
998 (find-file-other-window (dired-get-filename))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
999
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1000 (defun dired-get-filename (&optional localp no-error-if-not-filep)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1001 "In dired, return name of file mentioned on this line.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1002 Value returned normally includes the directory name.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1003 Optional arg LOCALP with value `no-dir' means don't include directory
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1004 name in result. A value of t means use path name relative to
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1005 `default-directory', which still may contain slashes if in a subdirectory.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1006 Optional arg NO-ERROR-IF-NOT-FILEP means return nil if no filename on
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1007 this line, otherwise an error occurs."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1008 (let (case-fold-search file p1 p2)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1009 (save-excursion
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1010 (if (setq p1 (dired-move-to-filename (not no-error-if-not-filep)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1011 (setq p2 (dired-move-to-end-of-filename no-error-if-not-filep))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1012 ;; nil if no file on this line, but no-error-if-not-filep is t:
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1013 (if (setq file (and p1 p2 (buffer-substring p1 p2)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1014 ;; Check if ls quoted the names, and unquote them.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1015 ;; Using read to unquote is much faster than substituting
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1016 ;; \007 (4 chars) -> ^G (1 char) etc. in a lisp loop.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1017 (cond ((string-match "b" dired-actual-switches) ; System V ls
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1018 ;; This case is about 20% slower than without -b.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1019 (setq file
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1020 (read
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1021 (concat "\""
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1022 ;; some ls -b don't escape quotes, argh!
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1023 ;; This is not needed for GNU ls, though.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1024 (or (dired-string-replace-match
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1025 "\\([^\\]\\)\"" file "\\1\\\\\"")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1026 file)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1027 "\""))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1028 ;; If you do this, update dired-insert-subdir-validate too
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1029 ;; ((string-match "Q" dired-actual-switches) ; GNU ls
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1030 ;; (setq file (read file)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1031 ))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1032 (if (eq localp 'no-dir)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1033 file
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1034 (and file (concat (dired-current-directory localp) file)))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1035
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1036 (defun dired-move-to-filename (&optional raise-error eol)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1037 "In dired, move to first char of filename on this line.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1038 Returns position (point) or nil if no filename on this line."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1039 ;; This is the UNIX version.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1040 (or eol (setq eol (progn (end-of-line) (point))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1041 (beginning-of-line)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1042 (if (string-match "l" dired-actual-switches)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1043 (if (re-search-forward
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1044 "\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct\\|Nov\\|Dec\\)[ ]+[0-9]+"
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1045 eol t)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1046 (progn
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1047 (skip-chars-forward " ") ; there is one SPC after day of month
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1048 (skip-chars-forward "^ " eol) ; move after time of day (or year)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1049 (skip-chars-forward " " eol) ; there is space before the file name
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1050 ;; Actually, if the year instead of clock time is displayed,
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1051 ;; there are (only for some ls programs?) two spaces instead
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1052 ;; of one before the name.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1053 ;; If we could depend on ls inserting exactly one SPC we
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1054 ;; would not bomb on names _starting_ with SPC.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1055 (point))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1056 (if raise-error
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1057 (error "No file on this line")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1058 nil))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1059 ;; else ls switches don't contain -l.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1060 ;; Note that even if we make dired-move-to-filename and
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1061 ;; dired-move-to-end-of-filename (and thus dired-get-filename)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1062 ;; work, all commands that gleaned information from the permission
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1063 ;; bits (like dired-mark-directories) will cease to work properly.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1064 (if (eolp)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1065 (if raise-error
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1066 (error "No file on this line")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1067 nil)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1068 ;; skip marker, if any
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1069 (forward-char))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1070 (skip-chars-forward " ")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1071 (point)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1072
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1073 (defun dired-move-to-end-of-filename (&optional no-error)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1074 ;; Assumes point is at beginning of filename,
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1075 ;; thus the rwx bit re-search-backward below will succeed in *this*
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1076 ;; line if at all. So, it should be called only after
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1077 ;; (dired-move-to-filename t).
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1078 ;; On failure, signals an error (with non-nil NO-ERROR just returns nil).
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1079 ;; This is the UNIX version.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1080 (let (opoint file-type executable symlink hidden case-fold-search used-F eol)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1081 ;; case-fold-search is nil now, so we can test for capital F:
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1082 (setq used-F (string-match "F" dired-actual-switches)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1083 opoint (point)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1084 eol (save-excursion (end-of-line) (point))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1085 hidden (and selective-display
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1086 (save-excursion (search-forward "\r" eol t))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1087 (if hidden
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1088 nil
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1089 (save-excursion;; Find out what kind of file this is:
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1090 ;; Restrict perm bits to be non-blank,
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1091 ;; otherwise this matches one char to early (looking backward):
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1092 ;; "l---------" (some systems make symlinks that way)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1093 ;; "----------" (plain file with zero perms)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1094 (if (re-search-backward
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1095 "\\([^ ]\\)[-r][-w]\\([^ ]\\)[-r][-w]\\([^ ]\\)[-r][-w]\\([^ ]\\)"
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1096 nil t)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1097 (setq file-type (char-after (match-beginning 1))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1098 symlink (eq file-type ?l)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1099 ;; Only with -F we need to know whether it's an executable
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1100 executable (and
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1101 used-F
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1102 (string-match
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1103 "[xst]";; execute bit set anywhere?
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1104 (concat
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1105 (buffer-substring (match-beginning 2)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1106 (match-end 2))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1107 (buffer-substring (match-beginning 3)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1108 (match-end 3))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1109 (buffer-substring (match-beginning 4)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1110 (match-end 4))))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1111 (or no-error
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1112 (not (string-match "l" dired-actual-switches))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1113 (error "No file on this line"))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1114 ;; Move point to end of name:
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1115 (if symlink
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1116 (if (search-forward " ->" eol t)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1117 (progn
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1118 (forward-char -3)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1119 (and used-F
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1120 dired-ls-F-marks-symlinks
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1121 (eq (preceding-char) ?@);; did ls really mark the link?
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1122 (forward-char -1))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1123 (goto-char eol);; else not a symbolic link
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1124 ;; ls -lF marks dirs, sockets and executables with exactly one
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1125 ;; trailing character. (Executable bits on symlinks ain't mean
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1126 ;; a thing, even to ls, but we know it's not a symlink.)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1127 (and used-F
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1128 ;; -F may not actually be honored, e.g. by an FTP ls in ange-ftp
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1129 (let ((char (preceding-char)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1130 (or (and (eq file-type ?d) (eq char ?/))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1131 (and executable (eq char ?*))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1132 (and (eq file-type ?s) (eq char ?=))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1133 (forward-char -1))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1134 (or no-error
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1135 (not (eq opoint (point)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1136 (error (if hidden
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1137 (substitute-command-keys
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1138 "File line is hidden, type \\[dired-hide-subdir] to unhide")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1139 "No file on this line")))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1140 (if (eq opoint (point))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1141 nil
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1142 (point))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1143
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1144
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1145 ;; Perhaps something could be done to handle VMS' own backups.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1146
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1147 (defun dired-clean-directory (keep)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1148 "Flag numerical backups for deletion.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1149 Spares `dired-kept-versions' latest versions, and `kept-old-versions' oldest.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1150 Positive prefix arg KEEP overrides `dired-kept-versions';
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1151 Negative prefix arg KEEP overrides `kept-old-versions' with KEEP made positive.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1152
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1153 To clear the flags on these files, you can use \\[dired-flag-backup-files]
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1154 with a prefix argument."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1155 (interactive "P")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1156 (setq keep (if keep (prefix-numeric-value keep) dired-kept-versions))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1157 (let ((early-retention (if (< keep 0) (- keep) kept-old-versions))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1158 (late-retention (if (<= keep 0) dired-kept-versions keep))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1159 (file-version-assoc-list ()))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1160 (message "Cleaning numerical backups (keeping %d late, %d old)..."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1161 late-retention early-retention)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1162 ;; Look at each file.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1163 ;; If the file has numeric backup versions,
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1164 ;; put on file-version-assoc-list an element of the form
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1165 ;; (FILENAME . VERSION-NUMBER-LIST)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1166 (dired-map-dired-file-lines (function dired-collect-file-versions))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1167 ;; Sort each VERSION-NUMBER-LIST,
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1168 ;; and remove the versions not to be deleted.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1169 (let ((fval file-version-assoc-list))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1170 (while fval
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1171 (let* ((sorted-v-list (cons 'q (sort (cdr (car fval)) '<)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1172 (v-count (length sorted-v-list)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1173 (if (> v-count (+ early-retention late-retention))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1174 (rplacd (nthcdr early-retention sorted-v-list)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1175 (nthcdr (- v-count late-retention)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1176 sorted-v-list)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1177 (rplacd (car fval)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1178 (cdr sorted-v-list)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1179 (setq fval (cdr fval))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1180 ;; Look at each file. If it is a numeric backup file,
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1181 ;; find it in a VERSION-NUMBER-LIST and maybe flag it for deletion.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1182 (dired-map-dired-file-lines (function dired-trample-file-versions))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1183 (message "Cleaning numerical backups...done")))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1184
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1185 ;;; Subroutines of dired-clean-directory.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1186
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1187 (defun dired-map-dired-file-lines (fun)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1188 ;; Perform FUN with point at the end of each non-directory line.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1189 ;; FUN takes one argument, the filename (complete pathname).
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1190 (dired-check-ls-l)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1191 (save-excursion
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1192 (let (file buffer-read-only)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1193 (goto-char (point-min))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1194 (while (not (eobp))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1195 (save-excursion
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1196 (and (not (looking-at dired-re-dir))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1197 (not (eolp))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1198 (setq file (dired-get-filename nil t)) ; nil on non-file
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1199 (progn (end-of-line)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1200 (funcall fun file))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1201 (forward-line 1)))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1202
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1203 (defun dired-collect-file-versions (fn)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1204 ;; "If it looks like file FN has versions, return a list of the versions.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1205 ;;That is a list of strings which are file names.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1206 ;;The caller may want to flag some of these files for deletion."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1207 (let* ((base-versions
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1208 (concat (file-name-nondirectory fn) ".~"))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1209 (bv-length (length base-versions))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1210 (possibilities (file-name-all-completions
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1211 base-versions
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1212 (file-name-directory fn)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1213 (versions (mapcar 'backup-extract-version possibilities)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1214 (if versions
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1215 (setq file-version-assoc-list (cons (cons fn versions)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1216 file-version-assoc-list)))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1217
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1218 (defun dired-trample-file-versions (fn)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1219 (let* ((start-vn (string-match "\\.~[0-9]+~$" fn))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1220 base-version-list)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1221 (and start-vn
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1222 (setq base-version-list ; there was a base version to which
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1223 (assoc (substring fn 0 start-vn) ; this looks like a
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1224 file-version-assoc-list)) ; subversion
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1225 (not (memq (string-to-int (substring fn (+ 2 start-vn)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1226 base-version-list)) ; this one doesn't make the cut
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1227 (progn (beginning-of-line)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1228 (delete-char 1)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1229 (insert dired-del-marker)))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1230
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1231
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1232 ;; Keeping Dired buffers in sync with the filesystem and with each other
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1233
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1234 (defvar dired-buffers nil
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1235 ;; Enlarged by dired-advertise
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1236 ;; Queried by function dired-buffers-for-dir. When this detects a
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1237 ;; killed buffer, it is removed from this list.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1238 "Alist of directories and their associated dired buffers.")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1239
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1240 (defun dired-buffers-for-dir (dir)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1241 ;; Return a list of buffers that dired DIR (top level or in-situ subdir).
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1242 ;; The list is in reverse order of buffer creation, most recent last.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1243 ;; As a side effect, killed dired buffers for DIR are removed from
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1244 ;; dired-buffers.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1245 (setq dir (file-name-as-directory dir))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1246 (let ((alist dired-buffers) result elt)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1247 (while alist
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1248 (setq elt (car alist))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1249 (if (dired-in-this-tree dir (car elt))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1250 (let ((buf (cdr elt)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1251 (if (buffer-name buf)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1252 (if (assoc dir (save-excursion
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1253 (set-buffer buf)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1254 dired-subdir-alist))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1255 (setq result (cons buf result)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1256 ;; else buffer is killed - clean up:
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1257 (setq dired-buffers (delq elt dired-buffers)))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1258 (setq alist (cdr alist)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1259 result))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1260
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1261 (defun dired-advertise ()
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1262 ;;"Advertise in variable `dired-buffers' that we dired `default-directory'."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1263 ;; With wildcards we actually advertise too much.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1264 (if (memq (current-buffer) (dired-buffers-for-dir default-directory))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1265 t ; we have already advertised ourselves
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1266 (setq dired-buffers
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1267 (cons (cons default-directory (current-buffer))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1268 dired-buffers))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1269
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1270 (defun dired-unadvertise (dir)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1271 ;; Remove DIR from the buffer alist in variable dired-buffers.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1272 ;; This has the effect of removing any buffer whose main directory is DIR.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1273 ;; It does not affect buffers in which DIR is a subdir.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1274 ;; Removing is also done as a side-effect in dired-buffer-for-dir.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1275 (setq dired-buffers
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1276 (delq (assoc dir dired-buffers) dired-buffers)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1277
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1278 (defun dired-fun-in-all-buffers (directory fun &rest args)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1279 ;; In all buffers dired'ing DIRECTORY, run FUN with ARGS.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1280 ;; Return list of buffers where FUN succeeded (i.e., returned non-nil).
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1281 (let ((buf-list (dired-buffers-for-dir directory))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1282 (obuf (current-buffer))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1283 buf success-list)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1284 (while buf-list
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1285 (setq buf (car buf-list)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1286 buf-list (cdr buf-list))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1287 (unwind-protect
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1288 (progn
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1289 (set-buffer buf)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1290 (if (apply fun args)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1291 (setq success-list (cons (buffer-name buf) success-list))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1292 (set-buffer obuf)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1293 success-list))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1294
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1295 (defun dired-add-file (filename &optional marker-char)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1296 (dired-fun-in-all-buffers
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1297 (file-name-directory filename)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1298 (function dired-add-entry) filename marker-char))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1299
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1300 (defun dired-add-entry (filename &optional marker-char)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1301 ;; Add a new entry for FILENAME, optionally marking it
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1302 ;; with MARKER-CHAR (a character, else dired-marker-char is used).
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1303 ;; Note that this adds the entry `out of order' if files sorted by
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1304 ;; time, etc.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1305 ;; At least this version inserts in the right subdirectory (if present).
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1306 ;; And it skips "." or ".." (see `dired-trivial-filenames').
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1307 ;; Hidden subdirs are exposed if a file is added there.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1308 (setq filename (directory-file-name filename))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1309 ;; Entry is always for files, even if they happen to also be directories
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1310 (let ((opoint (point))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1311 (cur-dir (dired-current-directory))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1312 (directory (file-name-directory filename))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1313 reason)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1314 (setq filename (file-name-nondirectory filename)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1315 reason
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1316 (catch 'not-found
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1317 (if (string= directory cur-dir)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1318 (progn
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1319 (if (dired-subdir-hidden-p cur-dir)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1320 (dired-unhide-subdir))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1321 ;; We are already where we should be, except when
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1322 ;; point is before the subdir line or its total line.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1323 (let ((p (dired-after-subdir-garbage cur-dir)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1324 (if (< (point) p)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1325 (goto-char p))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1326 ;; else try to find correct place to insert
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1327 (if (dired-goto-subdir directory)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1328 (progn;; unhide if necessary
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1329 (if (looking-at "\r");; point is at end of subdir line
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1330 (dired-unhide-subdir))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1331 ;; found - skip subdir and `total' line
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1332 ;; and uninteresting files like . and ..
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1333 ;; This better not moves into the next subdir!
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1334 (dired-goto-next-nontrivial-file))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1335 ;; not found
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1336 (throw 'not-found "Subdir not found")))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1337 ;; found and point is at The Right Place:
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1338 (let (buffer-read-only)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1339 (beginning-of-line)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1340 (dired-add-entry-do-indentation marker-char)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1341 (dired-ls (dired-make-absolute filename directory);; don't expand `.' !
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1342 (concat dired-actual-switches "d"))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1343 (forward-line -1)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1344 ;; We want to have the non-directory part, only:
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1345 (let* ((beg (dired-move-to-filename t)) ; error for strange output
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1346 (end (dired-move-to-end-of-filename)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1347 (setq filename (buffer-substring beg end))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1348 (delete-region beg end)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1349 (insert (file-name-nondirectory filename)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1350 (if dired-after-readin-hook;; the subdir-alist is not affected...
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1351 (save-excursion;; ...so we can run it right now:
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1352 (save-restriction
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1353 (beginning-of-line)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1354 (narrow-to-region (point) (save-excursion
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1355 (forward-line 1) (point)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1356 (run-hooks 'dired-after-readin-hook))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1357 (dired-move-to-filename))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1358 ;; return nil if all went well
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1359 nil))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1360 (if reason ; don't move away on failure
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1361 (goto-char opoint))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1362 (not reason))) ; return t on succes, nil else
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1363
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1364 ;; This is a separate function for the sake of nested dired format.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1365 (defun dired-add-entry-do-indentation (marker-char)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1366 ;; two spaces or a marker plus a space:
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1367 (insert (if marker-char
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1368 (if (integerp marker-char) marker-char dired-marker-char)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1369 ?\040)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1370 ?\040))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1371
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1372 (defun dired-after-subdir-garbage (dir)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1373 ;; Return pos of first file line of DIR, skipping header and total
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1374 ;; or wildcard lines.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1375 ;; Important: never moves into the next subdir.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1376 ;; DIR is assumed to be unhidden.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1377 ;; Will probably be redefined for VMS etc.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1378 (save-excursion
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1379 (or (dired-goto-subdir dir) (error "This cannot happen"))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1380 (forward-line 1)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1381 (while (and (not (eolp)) ; don't cross subdir boundary
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1382 (not (dired-move-to-filename)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1383 (forward-line 1))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1384 (point)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1385
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1386 (defun dired-remove-file (file)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1387 (dired-fun-in-all-buffers
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1388 (file-name-directory file) (function dired-remove-entry) file))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1389
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1390 (defun dired-remove-entry (file)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1391 (save-excursion
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1392 (and (dired-goto-file file)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1393 (let (buffer-read-only)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1394 (delete-region (progn (beginning-of-line) (point))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1395 (save-excursion (forward-line 1) (point)))))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1396
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1397 (defun dired-relist-file (file)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1398 (dired-fun-in-all-buffers (file-name-directory file)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1399 (function dired-relist-entry) file))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1400
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1401 (defun dired-relist-entry (file)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1402 ;; Relist the line for FILE, or just add it if it did not exist.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1403 ;; FILE must be an absolute pathname.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1404 (let (buffer-read-only marker)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1405 ;; If cursor is already on FILE's line delete-region will cause
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1406 ;; save-excursion to fail because of floating makers,
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1407 ;; moving point to beginning of line. Sigh.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1408 (save-excursion
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1409 (and (dired-goto-file file)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1410 (delete-region (progn (beginning-of-line)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1411 (setq marker (following-char))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1412 (point))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1413 (save-excursion (forward-line 1) (point))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1414 (setq file (directory-file-name file))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1415 (dired-add-entry file (if (eq ?\040 marker) nil marker)))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1416
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1417 (defun dired-update-file-line (file)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1418 ;; Delete the current line, and insert an entry for FILE.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1419 ;; If FILE is nil, then just delete the current line.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1420 ;; Keeps any marks that may be present in column one (doing this
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1421 ;; here is faster than with dired-add-entry's optional arg).
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1422 ;; Does not update other dired buffers. Use dired-relist-entry for that.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1423 (beginning-of-line)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1424 (let ((char (following-char)) (opoint (point)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1425 (delete-region (point) (progn (forward-line 1) (point)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1426 (if file
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1427 (progn
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1428 (dired-add-entry file)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1429 ;; Replace space by old marker without moving point.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1430 ;; Faster than goto+insdel inside a save-excursion?
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1431 (subst-char-in-region opoint (1+ opoint) ?\040 char))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1432 (dired-move-to-filename))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1433
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1434
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1435 ;; Running subprocesses, checking and logging of their errors.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1436
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1437 (defvar dired-log-buf "*Dired log*")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1438
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1439 (defun dired-why ()
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1440 "Pop up a buffer with error log output from Dired.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1441 A group of errors from a single command ends with a formfeed.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1442 Thus, use \\[backward-page] to find the beginning of a group of errors."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1443 (interactive)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1444 (let ((obuf (current-buffer)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1445 (pop-to-buffer dired-log-buf)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1446 (goto-char (point-max))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1447 (recenter -1)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1448 (switch-to-buffer-other-window obuf)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1449
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1450 (defun dired-log (log &rest args)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1451 ;; Log a message or the contents of a buffer.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1452 ;; If LOG is a string and there are more args, it is formatted with
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1453 ;; those ARGS. Usually the LOG string ends with a \n.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1454 ;; End each bunch of errors with (dired-log t): this inserts
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1455 ;; current time and buffer, and a \f (formfeed).
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1456 (let ((obuf (current-buffer)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1457 (unwind-protect ; want to move point
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1458 (progn
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1459 (set-buffer (get-buffer-create dired-log-buf))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1460 (goto-char (point-max))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1461 (let (buffer-read-only)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1462 (cond ((stringp log)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1463 (insert (if args
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1464 (apply (function format) log args)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1465 log)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1466 ((bufferp log)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1467 (insert-buffer log))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1468 ((eq t log)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1469 (insert "\n\t" (current-time-string)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1470 "\tBuffer `" (buffer-name obuf) "'\n\f\n")))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1471 (set-buffer obuf))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1472
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1473 (defun dired-log-summary (log &rest args)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1474 ;; Log a summary describing a bunch of errors.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1475 (apply (function dired-log) (concat "\n" log) args)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1476 (dired-log t))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1477
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1478 ;; In Emacs 19 this will return program's exit status.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1479 ;; This is a separate function so that ange-ftp can redefine it.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1480 (defun dired-call-process (program discard &rest arguments)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1481 ; "Run PROGRAM with output to current buffer unless DISCARD is t.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1482 ;Remaining arguments are strings passed as command arguments to PROGRAM."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1483 (apply 'call-process program nil (not discard) nil arguments))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1484
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1485 (defun dired-check-process-checker (exit-status)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1486 ;; In Emacs 19, EXIT-STATUS comes from (dired-)call-process
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1487 ;; Then this function should return (/= 0 exit-status)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1488 ;; In Emacs 18 the exit status is not accessible, so we
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1489 ;; do the following which is not always correct as some compress
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1490 ;; programs are verbose by default or otherwise braindamaged
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1491 (if (and dired-emacs-19-p exit-status)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1492 (/= 0 exit-status);; #### install (does it work in Emacs 19?)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1493 (/= 0 (buffer-size))) ; run in program's output buffer
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1494 ;; If have you one of those compress programs, you might
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1495 ;; want to redefine this function to look closer at compress' output.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1496 ;; This is why it is a separate function.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1497 )
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1498
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1499 (defun dired-check-process (msg program &rest arguments)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1500 ; "Display MSG while running PROGRAM, and check for output.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1501 ;Remaining arguments are strings passed as command arguments to PROGRAM.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1502 ; On error as determined by dired-check-process-checker, insert output
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1503 ; in a log buffer and return the offending ARGUMENTS or PROGRAM.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1504 ; Caller can cons up a list of failed args.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1505 ;Else returns nil for success."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1506 (let (err-buffer err (dir default-directory))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1507 (message "%s..." msg)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1508 (save-excursion
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1509 ;; Get a clean buffer for error output:
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1510 (setq err-buffer (get-buffer-create " *dired-check-process output*"))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1511 (set-buffer err-buffer)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1512 (erase-buffer)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1513 (setq default-directory dir ; caller's default-directory
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1514 err (dired-check-process-checker
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1515 (apply (function dired-call-process) program nil arguments)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1516 (if err
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1517 (progn
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1518 (dired-log (concat program " " (prin1-to-string arguments) "\n"))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1519 (dired-log err-buffer)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1520 (or arguments program t))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1521 (kill-buffer err-buffer)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1522 (message "%s...done" msg)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1523 nil))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1524
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1525 ;;; 7K
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1526 ;;;###begin dired-cmd.el
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1527 ;; Diffing and compressing
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1528
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1529 (defun dired-diff (file &optional switches)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1530 "Compare file at point with file FILE using `diff'.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1531 FILE defaults to the file at the mark.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1532 The prompted-for file is the first file given to `diff'.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1533 Prefix arg lets you edit the diff switches. See the command `diff'."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1534 (interactive
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1535 (let ((default (if (mark)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1536 (save-excursion (goto-char (mark))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1537 (dired-get-filename t t)))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1538 (list (read-file-name (format "Diff %s with: %s"
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1539 (dired-get-filename t)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1540 (if default
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1541 (concat "(default " default ") ")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1542 ""))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1543 (dired-current-directory) default t)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1544 (if (fboundp 'diff-read-switches)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1545 (diff-read-switches "Options for diff: ")))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1546 (if switches ; Emacs 19's diff has but two
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1547 (diff file (dired-get-filename t) switches) ; args (yet ;-)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1548 (diff file (dired-get-filename t))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1549
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1550 (defun dired-backup-diff (&optional switches)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1551 "Diff this file with its backup file or vice versa.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1552 Uses the latest backup, if there are several numerical backups.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1553 If this file is a backup, diff it with its original.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1554 The backup file is the first file given to `diff'.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1555 Prefix arg lets you edit the diff switches. See the command `diff'."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1556 (interactive (list (if (fboundp 'diff-read-switches)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1557 (diff-read-switches "Diff with switches: "))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1558 (let (bak ori (file (dired-get-filename)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1559 (if (backup-file-name-p file)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1560 (setq bak file
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1561 ori (file-name-sans-versions file))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1562 (setq bak (or (latest-backup-file file)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1563 (error "No backup found for %s" file))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1564 ori file))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1565 (if switches
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1566 (diff bak ori switches)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1567 (diff bak ori))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1568
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1569 ;;#### install (move this function into files.el)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1570 (defun latest-backup-file (fn) ; actually belongs into files.el
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1571 "Return the latest existing backup of FILE, or nil."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1572 ;; First try simple backup, then the highest numbered of the
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1573 ;; numbered backups.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1574 ;; Ignore the value of version-control because we look for existing
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1575 ;; backups, which maybe were made earlier or by another user with
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1576 ;; a different value of version-control.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1577 (setq fn (expand-file-name fn))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1578 (or
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1579 (let ((bak (make-backup-file-name fn)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1580 (if (file-exists-p bak) bak))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1581 (let* ((dir (file-name-directory fn))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1582 (base-versions (concat (file-name-nondirectory fn) ".~"))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1583 (bv-length (length base-versions)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1584 (concat dir
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1585 (car (sort
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1586 (file-name-all-completions base-versions dir)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1587 ;; bv-length is a fluid var for backup-extract-version:
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1588 (function
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1589 (lambda (fn1 fn2)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1590 (> (backup-extract-version fn1)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1591 (backup-extract-version fn2))))))))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1592
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1593 ;; This is a separate function for the sake of ange-ftp.el
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1594 (defun dired-compress-make-compressed-filename (from-file &optional reverse)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1595 ;; "Converts a filename FROM-FILE to the filename of the associated
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1596 ;; compressed file. With an optional argument REVERSE, the reverse
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1597 ;; conversion is done."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1598
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1599 (if reverse
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1600
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1601 ;; uncompress...
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1602 ;; return `nil' if no match found -- better than nothing
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1603 (let (case-fold-search ; case-sensitive search
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1604 (string
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1605 (concat "\\.\\(g?z\\|" (regexp-quote dired-gzip-file-extension)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1606 "$\\|Z\\)$")))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1607
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1608 (and (string-match string from-file)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1609 (substring from-file 0 (match-beginning 0))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1610
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1611 ;; compress...
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1612 ;; note: it could be that `gz' is not the proper extension for gzip
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1613 (concat from-file
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1614 (if dired-use-gzip-instead-of-compress
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1615 dired-gzip-file-extension ".Z"))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1616
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1617
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1618 (defun dired-compress ()
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1619 ;; Compress current file. Return nil for success, offending filename else.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1620 (dired-check-ls-l)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1621 (let* (buffer-read-only
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1622 (from-file (dired-get-filename))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1623 (to-file (dired-compress-make-compressed-filename from-file)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1624 (cond ((save-excursion (beginning-of-line)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1625 (looking-at dired-re-sym))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1626 (dired-log (concat "Attempt to compress a symbolic link:\n"
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1627 from-file))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1628 (dired-make-relative from-file))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1629 (
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1630
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1631 (if dired-use-gzip-instead-of-compress
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1632 ;; gzip (GNU zip)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1633 ;; use `-q' (quiet) switch for gzip in case GZIP environment
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1634 ;; variable contains `--verbose' - lrd - Feb 18, 1993
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1635 (dired-check-process (concat "Gzip'ing " from-file)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1636 "gzip" "--quiet" "--force" "--suffix"
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1637 dired-gzip-file-extension from-file)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1638
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1639 (dired-check-process (concat "Compressing " from-file)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1640 "compress" "-f" from-file))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1641 ;; errors from the process are already logged by dired-check-process
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1642 (dired-make-relative from-file))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1643 (t
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1644 (dired-update-file-line to-file)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1645 nil))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1646
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1647 (defun dired-uncompress ()
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1648 ;; Uncompress current file. Return nil for success, offending filename else.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1649 (let* (buffer-read-only
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1650 (from-file (dired-get-filename))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1651 (to-file (dired-compress-make-compressed-filename from-file t)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1652 (if
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1653 (if dired-use-gzip-instead-of-compress
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1654 ;; gzip (GNU zip)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1655 ;; use `-q' (quiet) switch for gzip in case GZIP environment
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1656 ;; variable contains `--verbose' - lrd - Feb 18, 1993
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1657 (dired-check-process (concat "Gunzip'ing " from-file)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1658 "gzip" "--decompress" "--quiet" "--suffix"
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1659 dired-gzip-file-extension from-file)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1660
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1661 (dired-check-process (concat "Uncompressing " from-file)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1662 "uncompress" from-file))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1663
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1664 (dired-make-relative from-file)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1665 (dired-update-file-line to-file)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1666 nil)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1667
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1668 (defun dired-mark-map-check (fun arg op-symbol &optional show-progress)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1669 ; "Map FUN over marked files (with second ARG like in dired-mark-map)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1670 ; and display failures.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1671
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1672 ; FUN takes zero args. It returns non-nil (the offending object, e.g.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1673 ; the short form of the filename) for a failure and probably logs a
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1674 ; detailed error explanation using function `dired-log'.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1675
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1676 ; OP-SYMBOL is a symbol describing the operation performed (e.g.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1677 ; `compress'). It is used with `dired-mark-pop-up' to prompt the user
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1678 ; (e.g. with `Compress * [2 files]? ') and to display errors (e.g.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1679 ; `Failed to compress 1 of 2 files - type W to see why ("foo")')
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1680
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1681 ; SHOW-PROGRESS if non-nil means redisplay dired after each file."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1682 (if (dired-mark-confirm op-symbol arg)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1683 (let* ((total-list;; all of FUN's return values
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1684 (dired-mark-map (funcall fun) arg show-progress))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1685 (total (length total-list))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1686 (failures (delq nil total-list))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1687 (count (length failures)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1688 (if (not failures)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1689 (message "%s: %d file%s."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1690 (capitalize (symbol-name op-symbol))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1691 total (dired-plural-s total))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1692 (message "Failed to %s %d of %d file%s - type W to see why %s"
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1693 (symbol-name op-symbol) count total (dired-plural-s total)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1694 ;; this gives a short list of failed files in parens
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1695 ;; which may be sufficient for the user even
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1696 ;; without typing `W' for the process' diagnostics
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1697 failures)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1698 ;; end this bunch of errors:
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1699 (dired-log-summary
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1700 "Failed to %s %d of %d file%s"
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1701 (symbol-name op-symbol) count total (dired-plural-s total))))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1702
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1703 (defun dired-do-compress (&optional arg)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1704 "Compress marked (or next ARG) files.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1705 Type \\[dired-do-uncompress] to uncompress again."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1706 (interactive "P")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1707 (dired-mark-map-check (function dired-compress) arg 'compress t))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1708
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1709 (defun dired-do-uncompress (&optional arg)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1710 "Uncompress marked (or next ARG) files."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1711 (interactive "P")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1712 (dired-mark-map-check (function dired-uncompress) arg 'uncompress t))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1713
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1714 ;; Commands for Emacs Lisp files - load and byte compile
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1715
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1716 (defun dired-byte-compile ()
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1717 ;; Return nil for success, offending file name else.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1718 (let* ((filename (dired-get-filename))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1719 (elc-file
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1720 (if (eq system-type 'vax-vms)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1721 (concat (substring filename 0 (string-match ";" filename)) "c")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1722 (concat filename "c")))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1723 buffer-read-only failure)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1724 (condition-case err
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1725 (save-excursion (byte-compile-file filename))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1726 (error
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1727 (setq failure err)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1728 (if failure
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1729 (progn
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1730 (dired-log "Byte compile error for %s:\n%s\n" filename failure)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1731 (dired-make-relative filename))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1732 (dired-remove-file elc-file)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1733 (forward-line) ; insert .elc after its .el file
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1734 (dired-add-file elc-file)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1735 nil)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1736
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1737 (defun dired-do-byte-compile (&optional arg)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1738 "Byte compile marked (or next ARG) Emacs lisp files."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1739 (interactive "P")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1740 (dired-mark-map-check (function dired-byte-compile) arg 'byte-compile t))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1741
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1742 (defun dired-load ()
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1743 ;; Return nil for success, offending file name else.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1744 (let ((file (dired-get-filename)) failure)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1745 (condition-case err
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1746 (load file nil nil t)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1747 (error (setq failure err)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1748 (if (not failure)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1749 nil
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1750 (dired-log "Load error for %s:\n%s\n" file failure)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1751 (dired-make-relative file))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1752
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1753 (defun dired-do-load (&optional arg)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1754 "Load the marked (or next ARG) Emacs lisp files."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1755 (interactive "P")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1756 (dired-mark-map-check (function dired-load) arg 'load t))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1757
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1758 (defun dired-do-chxxx (attribute-name program op-symbol arg)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1759 ;; Change file attributes (mode, group, owner) of marked files and
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1760 ;; refresh their file lines.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1761 ;; ATTRIBUTE-NAME is a string describing the attribute to the user.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1762 ;; PROGRAM is the program used to change the attribute.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1763 ;; OP-SYMBOL is the type of operation (for use in dired-mark-pop-up).
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1764 ;; ARG describes which files to use, like in dired-mark-get-files.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1765 (let* ((files (dired-mark-get-files t arg))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1766 (new-attribute
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1767 (dired-mark-read-string
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1768 (concat "Change " attribute-name " of %s to: ")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1769 nil op-symbol arg files))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1770 (operation (concat program " " new-attribute))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1771 (failure (apply (function dired-check-process)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1772 operation program new-attribute
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1773 files)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1774 (dired-do-redisplay arg);; moves point if ARG is an integer
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1775 (if failure
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1776 (dired-log-summary
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1777 (message "%s: error - type W to see why." operation)))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1778
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1779 (defun dired-do-chmod (&optional arg)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1780 "Change the mode of the marked (or next ARG) files.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1781 This calls chmod, thus symbolic modes like `g+w' are allowed."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1782 (interactive "P")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1783 (dired-do-chxxx "Mode" "chmod" 'chmod arg))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1784
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1785 (defun dired-do-chgrp (&optional arg)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1786 "Change the group of the marked (or next ARG) files."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1787 (interactive "P")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1788 (dired-do-chxxx "Group" "chgrp" 'chgrp arg))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1789
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1790 (defun dired-do-chown (&optional arg)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1791 "Change the owner of the marked (or next ARG) files."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1792 (interactive "P")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1793 (dired-do-chxxx "Owner" dired-chown-program 'chown arg))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1794
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1795 ;;;###end dired-cmd.el
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1796
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1797
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1798 ;; Deleting files
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1799
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1800 ;; #### called dired-do-flagged-delete in FSF
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1801 (defun dired-do-deletions (&optional nomessage)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1802 "In dired, delete the files flagged for deletion.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1803 If NOMESSAGE is non-nil, we don't display any message
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1804 if there are no flagged files."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1805 (interactive)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1806 (let* ((dired-marker-char dired-del-marker)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1807 (regexp (dired-marker-regexp))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1808 case-fold-search)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1809 (if (save-excursion (goto-char (point-min))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1810 (re-search-forward regexp nil t))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1811 (dired-internal-do-deletions
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1812 ;; this can't move point since ARG is nil
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1813 (dired-mark-map (cons (dired-get-filename) (point))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1814 nil)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1815 nil)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1816 (or nomessage
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1817 (message "(No deletions requested)")))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1818
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1819 (defun dired-do-delete (&optional arg)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1820 "Delete all marked (or next ARG) files."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1821 ;; This is more consistent with the file marking feature than
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1822 ;; dired-do-deletions.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1823 (interactive "P")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1824 (dired-internal-do-deletions
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1825 ;; this may move point if ARG is an integer
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1826 (dired-mark-map (cons (dired-get-filename) (point))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1827 arg)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1828 arg))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1829
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1830 (defvar dired-deletion-confirmer 'yes-or-no-p) ; or y-or-n-p?
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1831
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1832 (defun dired-internal-do-deletions (l arg)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1833 ;; L is an alist of files to delete, with their buffer positions.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1834 ;; ARG is the prefix arg.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1835 ;; Filenames are absolute (VMS needs this for logical search paths).
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1836 ;; (car L) *must* be the *last* (bottommost) file in the dired buffer.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1837 ;; That way as changes are made in the buffer they do not shift the
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1838 ;; lines still to be changed, so the (point) values in L stay valid.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1839 ;; Also, for subdirs in natural order, a subdir's files are deleted
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1840 ;; before the subdir itself - the other way around would not work.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1841 (let ((files (mapcar (function car) l))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1842 (count (length l))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1843 (succ 0))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1844 ;; canonicalize file list for pop up
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1845 (setq files (nreverse (mapcar (function dired-make-relative) files)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1846 (if (dired-mark-pop-up
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1847 " *Deletions*" 'delete files dired-deletion-confirmer
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1848 (format "Delete %s " (dired-mark-prompt arg files)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1849 (save-excursion
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1850 (let (failures);; files better be in reverse order for this loop!
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1851 (while l
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1852 (goto-char (cdr (car l)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1853 (let (buffer-read-only)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1854 (condition-case err
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1855 (let ((fn (car (car l))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1856 ;; This test is equivalent to
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1857 ;; (and (file-directory-p fn) (not (file-symlink-p fn)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1858 ;; but more efficient
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1859 (if (eq t (car (file-attributes fn)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1860 (remove-directory fn)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1861 (delete-file fn))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1862 ;; if we get here, removing worked
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1863 (setq succ (1+ succ))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1864 (message "%s of %s deletions" succ count)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1865 (delete-region (progn (beginning-of-line) (point))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1866 (progn (forward-line 1) (point)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1867 (dired-clean-up-after-deletion fn))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1868 (error;; catch errors from failed deletions
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1869 (dired-log "%s\n" err)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1870 (setq failures (cons (car (car l)) failures)))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1871 (setq l (cdr l)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1872 (if (not failures)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1873 (message "%d deletion%s done" count (dired-plural-s count))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1874 (dired-log-summary
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1875 (message "%d of %d deletion%s failed: %s"
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1876 (length failures) count
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1877 (dired-plural-s count)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1878 (prin1-to-string failures))))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1879 (message "(No deletions performed)")))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1880 (dired-move-to-filename))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1881
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1882 ;; This is a separate function for the sake of dired-x.el.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1883 (defun dired-clean-up-after-deletion (fn)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1884 ;; Clean up after a deleted file or directory FN.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1885 (save-excursion (and (dired-goto-subdir fn)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1886 (dired-kill-subdir))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1887
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1888
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1889 (defun dired-replace-in-string (regexp newtext string)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1890 ;; Replace REGEXP with NEWTEXT everywhere in STRING and return result.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1891 ;; NEWTEXT is taken literally---no \\DIGIT escapes will be recognized.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1892 (let ((result "") (start 0) mb me)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1893 (while (string-match regexp string start)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1894 (setq mb (match-beginning 0)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1895 me (match-end 0)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1896 result (concat result (substring string start mb) newtext)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1897 start me))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1898 (concat result (substring string start))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1899
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1900 (defun dired-next-dirline (arg &optional opoint)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1901 "Goto ARG'th next directory file line."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1902 (interactive "_p")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1903 (dired-check-ls-l)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1904 (or opoint (setq opoint (point)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1905 (if (if (> arg 0)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1906 (re-search-forward dired-re-dir nil t arg)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1907 (beginning-of-line)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1908 (re-search-backward dired-re-dir nil t (- arg)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1909 (dired-move-to-filename) ; user may type `i' or `f'
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1910 (goto-char opoint)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1911 (error "No more subdirectories")))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1912
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1913 (defun dired-prev-dirline (arg)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1914 "Goto ARG'th previous directory file line."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1915 (interactive "_p")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1916 (dired-next-dirline (- arg)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1917
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1918 (defun dired-unflag-all-files (flag &optional arg)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1919 "Remove a specific or all flags from every file.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1920 With an arg, queries for each marked file.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1921 Type \\[help-command] at that time for help."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1922 (interactive "sRemove flag: (default: all flags) \nP")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1923 (let ((count 0)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1924 (re (if (zerop (length flag)) dired-re-mark
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1925 (concat "^" (regexp-quote flag)))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1926 (save-excursion
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1927 (let (buffer-read-only case-fold-search query
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1928 (help-form "\
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1929 Type SPC or `y' to unflag one file, DEL or `n' to skip to next,
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1930 `!' to unflag all remaining files with no more questions."))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1931 (goto-char (point-min))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1932 (while (re-search-forward re nil t)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1933 (if (or (not arg)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1934 (dired-query 'query "Unflag file `%s' ? "
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1935 (dired-get-filename t)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1936 (progn (delete-char -1) (insert " ") (setq count (1+ count))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1937 (forward-line 1))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1938 (message "%s" (format "Flags removed: %d %s" count flag) )))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1939
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1940 ;; pop ups and user input for file marking
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1941
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1942 (defun dired-marker-regexp ()
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1943 (concat "^" (regexp-quote (char-to-string dired-marker-char))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1944
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1945 (defun dired-plural-s (count)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1946 (if (= 1 count) "" "s"))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1947
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1948 (defun dired-mark-prompt (arg files)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1949 ;; Return a string for use in a prompt, either the current file
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1950 ;; name, or the marker and a count of marked files.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1951 (let ((count (length files)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1952 (if (= count 1)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1953 (car files)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1954 ;; more than 1 file:
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1955 (if (integerp arg)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1956 ;; abs(arg) = count
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1957 ;; Perhaps this is nicer, but it also takes more screen space:
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1958 ;;(format "[%s %d files]" (if (> arg 0) "next" "previous")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1959 ;; count)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1960 (format "[next %d files]" arg)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1961 (format "%c [%d files]" dired-marker-char count)))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1962
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1963 (defvar dired-query-alist
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1964 '((?\y . y) (?\040 . y) ; `y' or SPC means accept once
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1965 (?n . n) (?\177 . n) ; `n' or DEL skips once
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1966 (?! . yes) ; `!' accepts rest
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1967 (?q. no) (?\e . no) ; `q' or ESC skips rest
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1968 ;; None of these keys quit - use C-g for that.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1969 ))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1970
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1971 (defun dired-query (qs-var qs-prompt &rest qs-args)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1972 ;; Query user and return nil or t.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1973 ;; Store answer in symbol VAR (which must initially be bound to nil).
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1974 ;; Format PROMPT with ARGS.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1975 ;; Binding variable help-form will help the user who types C-h.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1976 (let* ((char (symbol-value qs-var))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1977 (action (cdr (assoc char dired-query-alist))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1978 (cond ((eq 'yes action)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1979 t) ; accept, and don't ask again
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1980 ((eq 'no action)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1981 nil) ; skip, and don't ask again
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1982 (t;; no lasting effects from last time we asked - ask now
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1983 (let ((qprompt (concat qs-prompt
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1984 (if help-form
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1985 (format " [Type yn!q or %s] "
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1986 (key-description
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1987 (char-to-string help-char)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1988 " [Type y, n, q or !] ")))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1989 result elt)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1990 ;; Actually it looks nicer without cursor-in-echo-area - you can
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1991 ;; look at the dired buffer instead of at the prompt to decide.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1992 (apply 'message qprompt qs-args)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1993 (setq char (set qs-var (read-char)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1994 (while (not (setq elt (assoc char dired-query-alist)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1995 (message "Invalid char - type %c for help." help-char)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1996 (ding)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1997 (sit-for 1)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1998 (apply 'message qprompt qs-args)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1999 (setq char (set qs-var (read-char))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2000 (memq (cdr elt) '(t y yes)))))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2001
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2002 (defun dired-pop-to-buffer (buf)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2003 ;; Pop up buffer BUF.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2004 ;; If dired-shrink-to-fit is t, make its window fit its contents.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2005 (if (not dired-shrink-to-fit)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2006 (pop-to-buffer (get-buffer-create buf))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2007 ;; let window shrink to fit:
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2008 (let ((window (selected-window))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2009 target-lines w2)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2010 (cond ;; if split-window-threshold is enabled, use the largest window
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2011 ((and (> (window-height (setq w2 (get-largest-window)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2012 split-height-threshold)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2013 (= (screen-width) (window-width w2)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2014 (setq window w2))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2015 ;; if the least-recently-used window is big enough, use it
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2016 ((and (> (window-height (setq w2 (get-lru-window)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2017 (* 2 window-min-height))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2018 (= (screen-width) (window-width w2)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2019 (setq window w2)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2020 (save-excursion
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2021 (set-buffer buf)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2022 (goto-char (point-max))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2023 (skip-chars-backward "\n\r\t ")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2024 (setq target-lines (count-lines (point-min) (point))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2025 (if (<= (window-height window) (* 2 window-min-height))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2026 ;; At this point, every window on the screen is too small to split.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2027 (setq w2 (display-buffer buf))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2028 (setq w2 (split-window window
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2029 (max window-min-height
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2030 (- (window-height window)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2031 (1+ (max window-min-height target-lines)))))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2032 (set-window-buffer w2 buf)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2033 (if (< (1- (window-height w2)) target-lines)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2034 (progn
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2035 (select-window w2)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2036 (enlarge-window (- target-lines (1- (window-height w2))))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2037 (set-window-start w2 1)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2038 )))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2039
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2040 (defvar dired-no-confirm nil
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2041 ;; "If non-nil, list of symbols for commands dired should not confirm.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2042 ;;It can be a sublist of
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2043 ;;
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2044 ;; '(byte-compile chgrp chmod chown compress copy delete hardlink load
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2045 ;; move print shell symlink uncompress)"
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2046 )
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2047
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2048 (defun dired-mark-confirm (op-symbol arg)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2049 ;; Request confirmation from the user that the operation described
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2050 ;; by OP-SYMBOL is to be performed on the marked files.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2051 ;; Confirmation consists in a y-or-n question with a file list
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2052 ;; pop-up unless OP-SYMBOL is a member of `dired-no-confirm'.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2053 ;; The files used are determined by ARG (like in dired-mark-get-files).
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2054 (or (memq op-symbol dired-no-confirm)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2055 (let ((files (dired-mark-get-files t arg)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2056 (dired-mark-pop-up nil op-symbol files (function y-or-n-p)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2057 (concat (capitalize (symbol-name op-symbol)) " "
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2058 (dired-mark-prompt arg files) "? ")))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2059
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2060 (defun dired-mark-pop-up (bufname op-symbol files function &rest args)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2061 ;;"Args BUFNAME OP-SYMBOL FILES FUNCTION &rest ARGS.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2062 ;;Return FUNCTION's result on ARGS after popping up a window (in a buffer
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2063 ;;named BUFNAME, nil gives \" *Marked Files*\") showing the marked
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2064 ;;files. Uses function `dired-pop-to-buffer' to do that.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2065 ;; FUNCTION should not manipulate files.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2066 ;; It should only read input (an argument or confirmation).
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2067 ;;The window is not shown if there is just one file or
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2068 ;; OP-SYMBOL is a member of the list in `dired-no-confirm'.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2069 ;;FILES is the list of marked files."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2070 (or bufname (setq bufname " *Marked Files*"))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2071 (if (or (memq op-symbol dired-no-confirm)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2072 (= (length files) 1))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2073 (apply function args)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2074 (save-excursion
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2075 (set-buffer (get-buffer-create bufname))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2076 (erase-buffer)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2077 (dired-format-columns-of-files files))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2078 (save-window-excursion
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2079 (dired-pop-to-buffer bufname)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2080 (apply function args))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2081
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2082 (defun dired-format-columns-of-files (files)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2083 ;; Files should be in forward order for this loop.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2084 ;; i.e., (car files) = first file in buffer.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2085 ;; Returns the number of lines used.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2086 (let* ((maxlen (+ 2 (apply 'max (mapcar 'length files))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2087 (width (- (window-width (selected-window)) 2))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2088 (columns (max 1 (/ width maxlen)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2089 (nfiles (length files))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2090 (rows (+ (/ nfiles columns)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2091 (if (zerop (% nfiles columns)) 0 1)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2092 (i 0)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2093 (j 0))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2094 (setq files (nconc (copy-sequence files) ; fill up with empty fns
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2095 (make-list (- (* columns rows) nfiles) "")))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2096 (setcdr (nthcdr (1- (length files)) files) files) ; make circular
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2097 (while (< j rows)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2098 (while (< i columns)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2099 (indent-to (* i maxlen))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2100 (insert (car files))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2101 (setq files (nthcdr rows files)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2102 i (1+ i)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2103 (insert "\n")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2104 (setq i 0
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2105 j (1+ j)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2106 files (cdr files)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2107 rows))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2108
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2109 ;; Read arguments for a mark command of type OP-SYMBOL,
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2110 ;; perhaps popping up the list of marked files.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2111 ;; ARG is the prefix arg and indicates whether the files came from
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2112 ;; marks (ARG=nil) or a repeat factor (integerp ARG).
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2113 ;; If the current file was used, the list has but one element and ARG
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2114 ;; does not matter. (It is non-nil, non-integer in that case, namely '(4)).
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2115
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2116 (defun dired-mark-read-string (prompt initial op-symbol arg files)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2117 ;; PROMPT for a string, with INITIAL input.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2118 ;; Other args are used to give user feedback and pop-up:
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2119 ;; OP-SYMBOL of command, prefix ARG, marked FILES.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2120 (dired-mark-pop-up
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2121 nil op-symbol files
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2122 (function read-string)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2123 (format prompt (dired-mark-prompt arg files)) initial))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2124
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2125 (defun dired-mark-read-file-name (prompt dir op-symbol arg files)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2126 (dired-mark-pop-up
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2127 nil op-symbol files
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2128 (function read-file-name)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2129 (format prompt (dired-mark-prompt arg files)) dir))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2130
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2131 (defun dired-mark-file (arg)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2132 "In dired, mark the current line's file for later commands.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2133 With arg, repeat over several lines.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2134 Use \\[dired-unflag-all-files] to remove all flags."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2135 (interactive "p")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2136 (let (buffer-read-only)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2137 (dired-repeat-over-lines
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2138 arg
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2139 (function (lambda () (delete-char 1) (insert dired-marker-char))))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2140
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2141 (defun dired-next-marked-file (arg &optional wrap opoint)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2142 "Move to the next marked file, wrapping around the end of the buffer."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2143 (interactive "_p\np")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2144 (or opoint (setq opoint (point)));; return to where interactively started
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2145 (if (if (> arg 0)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2146 (re-search-forward dired-re-mark nil t arg)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2147 (beginning-of-line)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2148 (re-search-backward dired-re-mark nil t (- arg)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2149 (dired-move-to-filename)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2150 (if (null wrap)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2151 (progn
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2152 (goto-char opoint)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2153 (error "No next marked file"))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2154 (message "(Wraparound for next marked file)")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2155 (goto-char (if (> arg 0) (point-min) (point-max)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2156 (dired-next-marked-file arg nil opoint))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2157
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2158 (defun dired-prev-marked-file (arg &optional wrap)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2159 "Move to the previous marked file, wrapping around the end of the buffer."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2160 (interactive "_p\np")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2161 (dired-next-marked-file (- arg) wrap))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2162
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2163 (defun dired-file-marker (file)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2164 ;; Return FILE's marker, or nil if unmarked.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2165 (save-excursion
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2166 (and (dired-goto-file file)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2167 (progn
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2168 (beginning-of-line)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2169 (if (not (equal ?\040 (following-char)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2170 (following-char))))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2171
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2172 (defun dired-read-regexp (prompt &optional initial)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2173 ;; This is an extra function so that gmhist can redefine it.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2174 (setq dired-flagging-regexp
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2175 (read-string prompt (or initial dired-flagging-regexp))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2176
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2177 (defun dired-mark-files-regexp (regexp &optional marker-char)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2178 "Mark all files matching REGEXP for use in later commands.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2179 A prefix argument means to unmark them instead.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2180 `.' and `..' are never marked.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2181
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2182 REGEXP is an Emacs regexp, not a shell wildcard. Thus, use `\\.o$' for
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2183 object files--just `.o' will mark more than you might think."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2184 (interactive
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2185 (list (dired-read-regexp (concat (if current-prefix-arg "Unmark" "Mark")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2186 " files (regexp): "))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2187 (if current-prefix-arg ?\040)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2188 (let ((dired-marker-char (or marker-char dired-marker-char)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2189 (dired-mark-if
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2190 (and (not (looking-at dired-re-dot))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2191 (not (eolp)) ; empty line
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2192 (let ((fn (dired-get-filename nil t)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2193 (and fn (string-match regexp (file-name-nondirectory fn)))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2194 "matching file")))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2195
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2196 (defun dired-flag-regexp-files (regexp)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2197 "In dired, flag all files containing the specified REGEXP for deletion.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2198 The match is against the non-directory part of the filename. Use `^'
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2199 and `$' to anchor matches. Exclude subdirs by hiding them.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2200 `.' and `..' are never flagged."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2201 (interactive (list (dired-read-regexp "Flag for deletion (regexp): ")))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2202 (dired-mark-files-regexp regexp dired-del-marker))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2203
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2204 (defun dired-mark-symlinks (unflag-p)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2205 "Mark all symbolic links.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2206 With prefix argument, unflag all those files."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2207 (interactive "P")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2208 (dired-check-ls-l)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2209 (let ((dired-marker-char (if unflag-p ?\040 dired-marker-char)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2210 (dired-mark-if (looking-at dired-re-sym) "symbolic link")))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2211
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2212 (defun dired-mark-directories (unflag-p)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2213 "Mark all directory file lines except `.' and `..'.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2214 With prefix argument, unflag all those files."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2215 (interactive "P")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2216 (dired-check-ls-l)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2217 (let ((dired-marker-char (if unflag-p ?\040 dired-marker-char)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2218 (dired-mark-if (and (looking-at dired-re-dir)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2219 (not (looking-at dired-re-dot)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2220 "directory file")))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2221
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2222 (defun dired-mark-executables (unflag-p)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2223 "Mark all executable files.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2224 With prefix argument, unflag all those files."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2225 (interactive "P")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2226 (dired-check-ls-l)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2227 (let ((dired-marker-char (if unflag-p ?\040 dired-marker-char)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2228 (dired-mark-if (looking-at dired-re-exe) "executable file")))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2229
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2230 ;; dired-x.el has a dired-mark-sexp interactive command: mark
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2231 ;; files for which PREDICATE returns non-nil.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2232
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2233 (defun dired-flag-auto-save-files (&optional unflag-p)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2234 "Flag for deletion files whose names suggest they are auto save files.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2235 A prefix argument says to unflag those files instead."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2236 (interactive "P")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2237 (dired-check-ls-l)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2238 (let ((dired-marker-char (if unflag-p ?\040 dired-del-marker)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2239 (dired-mark-if
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2240 (and (not (looking-at dired-re-dir))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2241 (let ((fn (dired-get-filename t t)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2242 (if fn (auto-save-file-name-p
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2243 (file-name-nondirectory fn)))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2244 "auto save file")))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2245
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2246 (defun dired-flag-backup-files (&optional unflag-p)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2247 "Flag all backup files (names ending with `~') for deletion.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2248 With prefix argument, unflag these files."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2249 (interactive "P")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2250 (dired-check-ls-l)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2251 (let ((dired-marker-char (if unflag-p ?\040 dired-del-marker)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2252 (dired-mark-if
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2253 (and (not (looking-at dired-re-dir))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2254 (let ((fn (dired-get-filename t t)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2255 (if fn (backup-file-name-p fn))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2256 "backup file")))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2257
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2258
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2259 ;;; Shell commands
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2260 ;;#### install (move this function into simple.el)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2261 (defun shell-quote (filename) ; actually belongs into simple.el
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2262 "Quote a file name for inferior shell (see variable shell-file-name)."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2263 ;; Quote everything except POSIX filename characters.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2264 ;; This should be safe enough even for really wierd shells.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2265 (let ((result "") (start 0) end)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2266 (while (string-match "[^---0-9a-zA-Z_./]" filename start)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2267 (setq end (match-beginning 0)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2268 result (concat result (substring filename start end)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2269 "\\" (substring filename end (1+ end)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2270 start (1+ end)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2271 (concat result (substring filename start))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2272
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2273 (defun dired-read-shell-command (prompt arg files)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2274 ;; "Read a dired shell command prompting with PROMPT (using read-string).
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2275 ;;ARG is the prefix arg and may be used to indicate in the prompt which
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2276 ;; files are affected.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2277 ;;This is an extra function so that you can redefine it, e.g., to use gmhist."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2278 (dired-mark-pop-up
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2279 nil 'shell files
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2280 (function read-string) (format prompt (dired-mark-prompt arg files))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2281
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2282 ;; The in-background argument is only needed in Emacs 18 where
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2283 ;; shell-command doesn't understand an appended ampersand `&'.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2284 (defun dired-do-shell-command (&optional arg in-background)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2285 "Run a shell command on the marked files.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2286 If there is output, it goes to a separate buffer.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2287 The list of marked files is appended to the command string unless asterisks
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2288 `*' indicate the place(s) where the list should go.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2289 If no files are marked or a specific numeric prefix arg is given, uses
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2290 next ARG files. As always, a raw arg (\\[universal-argument]) means the current file.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2291 The prompt mentions the file(s) or the marker, as appropriate.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2292 With a zero argument, run command on each marked file separately: `cmd *
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2293 foo' results in `cmd F1 foo; ...; cmd Fn foo'.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2294 No automatic redisplay is attempted, as the file names may have
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2295 changed. Type \\[dired-do-redisplay] to redisplay the marked files.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2296 The shell command has the top level directory as working directory, so
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2297 output files usually are created there instead of in a subdir."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2298 ;;Functions dired-run-shell-command and dired-shell-stuff-it do the
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2299 ;;actual work and can be redefined for customization.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2300 (interactive "P")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2301 (let* ((on-each (equal arg 0))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2302 (prompt (concat (if in-background "& on " "! on ")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2303 (if on-each "each " "")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2304 "%s: "))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2305 (file-list (dired-mark-get-files t (if on-each nil arg)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2306 ;; Want to give feedback whether this file or marked files are used:
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2307 (command (dired-read-shell-command
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2308 prompt (if on-each nil arg) file-list))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2309 (result
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2310 (dired-shell-stuff-it command file-list on-each arg)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2311 ;; execute the shell command
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2312 (dired-run-shell-command result in-background)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2313
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2314 ;; Might use {,} for bash or csh:
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2315 (defvar dired-mark-prefix ""
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2316 "Prepended to marked files in dired shell commands.")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2317 (defvar dired-mark-postfix ""
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2318 "Appended to marked files in dired shell commands.")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2319 (defvar dired-mark-separator " "
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2320 "Separates marked files in dired shell commands.")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2321
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2322 (defun dired-shell-stuff-it (command file-list on-each &optional raw-arg)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2323 ;; "Make up a shell command line from COMMAND and FILE-LIST.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2324 ;; If ON-EACH is t, COMMAND should be applied to each file, else
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2325 ;; simply concat all files and apply COMMAND to this.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2326 ;; FILE-LIST's elements will be quoted for the shell."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2327 ;; Might be redefined for smarter things and could then use RAW-ARG
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2328 ;; (coming from interactive P and currently ignored) to decide what to do.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2329 ;; Smart would be a way to access basename or extension of file names.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2330 ;; See dired-trns.el for an approach to this.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2331 ;; Bug: There is no way to quote a *
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2332 ;; On the other hand, you can never accidentally get a * into your cmd.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2333 (let ((stuff-it
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2334 (if (string-match "\\*" command)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2335 (function (lambda (x)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2336 (dired-replace-in-string "\\*" x command)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2337 (function (lambda (x) (concat command " " x))))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2338 (if on-each
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2339 (mapconcat stuff-it (mapcar (function shell-quote) file-list) ";")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2340 (let ((fns (mapconcat (function shell-quote)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2341 file-list dired-mark-separator)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2342 (if (> (length file-list) 1)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2343 (setq fns (concat dired-mark-prefix fns dired-mark-postfix)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2344 (funcall stuff-it fns)))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2345
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2346 ;; This is an extra function so that it can be redefined by ange-ftp.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2347 (defun dired-run-shell-command (command &optional in-background)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2348 (if (and in-background (not (string-match "&[ \t]*$" command)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2349 (setq command (concat command " &")))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2350 (shell-command command))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2351
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2352 (defun dired-do-print (&optional arg)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2353 "Print the marked (or next ARG) files.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2354 Uses the shell command coming from variables `lpr-command' and
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2355 `lpr-switches' as default."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2356 (interactive "P")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2357 (or (listp lpr-switches)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2358 (error "lpr-switches must be a *list* of strings"))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2359 (let* ((file-list (dired-mark-get-files t arg))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2360 (switches (mapconcat (function identity) lpr-switches " "))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2361 (command (dired-mark-read-string
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2362 "Print %s with: "
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2363 (concat lpr-command " " switches)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2364 'print arg file-list)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2365 (dired-run-shell-command (dired-shell-stuff-it command file-list nil))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2366
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2367
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2368 ;;; 10K
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2369 ;;;###begin dired-cp.el
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2370 ;;; Copy, move/rename, making hard and symbolic links
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2371
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2372 (defvar dired-backup-if-overwrite nil
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2373 "*Non-nil if Dired should ask about making backups before overwriting files.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2374 Special value 'always suppresses confirmation.")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2375
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2376 (defun dired-handle-overwrite (to)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2377 ;; Save old version of a to be overwritten file TO.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2378 ;; `overwrite-confirmed' and `overwrite-backup-query' are fluid vars
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2379 ;; from dired-create-files.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2380 (if (and dired-backup-if-overwrite
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2381 overwrite-confirmed
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2382 (or (eq 'always dired-backup-if-overwrite)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2383 (dired-query 'overwrite-backup-query
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2384 (format "Make backup for existing file `%s'? " to))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2385 (let ((backup (car (find-backup-file-name to))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2386 (rename-file to backup 0) ; confirm overwrite of old backup
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2387 (dired-relist-entry backup))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2388
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2389 (defun dired-copy-file (from to ok-flag)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2390 (dired-handle-overwrite to)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2391 (copy-file from to ok-flag dired-copy-preserve-time))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2392
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2393 (defun dired-rename-file (from to ok-flag)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2394 (dired-handle-overwrite to)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2395 (rename-file from to ok-flag) ; error is caught in -create-files
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2396 ;; Silently rename the visited file of any buffer visiting this file.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2397 (and (get-file-buffer from)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2398 (save-excursion
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2399 (set-buffer (get-file-buffer from))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2400 (let ((modflag (buffer-modified-p)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2401 (set-visited-file-name to) ; kills write-file-hooks
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2402 (set-buffer-modified-p modflag))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2403 (dired-remove-file from)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2404 ;; See if it's an inserted subdir, and rename that, too.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2405 (dired-rename-subdir from to))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2406
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2407 (defun dired-rename-subdir (from-dir to-dir)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2408 (setq from-dir (file-name-as-directory from-dir)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2409 to-dir (file-name-as-directory to-dir))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2410 (dired-fun-in-all-buffers from-dir
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2411 (function dired-rename-subdir-1) from-dir to-dir)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2412 ;; Update visited file name of all affected buffers
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2413 (let ((blist (buffer-list)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2414 (while blist
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2415 (save-excursion
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2416 (set-buffer (car blist))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2417 (if (and buffer-file-name
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2418 (dired-in-this-tree buffer-file-name from-dir))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2419 (let ((modflag (buffer-modified-p))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2420 (to-file (dired-replace-in-string
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2421 (concat "^" (regexp-quote from-dir))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2422 to-dir
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2423 buffer-file-name)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2424 (set-visited-file-name to-file)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2425 (set-buffer-modified-p modflag))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2426 (setq blist (cdr blist)))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2427
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2428 (defun dired-rename-subdir-1 (dir to)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2429 ;; Rename DIR to TO in headerlines and dired-subdir-alist, if DIR or
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2430 ;; one of its subdirectories is expanded in this buffer.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2431 (let ((alist dired-subdir-alist)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2432 (elt nil))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2433 (while alist
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2434 (setq elt (car alist)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2435 alist (cdr alist))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2436 (if (dired-in-this-tree (car elt) dir)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2437 ;; ELT's subdir is affected by the rename
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2438 (dired-rename-subdir-2 elt dir to)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2439 (if (equal dir default-directory)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2440 ;; if top level directory was renamed, lots of things have to be
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2441 ;; updated:
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2442 (progn
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2443 (dired-unadvertise dir) ; we no longer dired DIR...
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2444 (setq default-directory to
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2445 dired-directory (expand-file-name;; this is correct
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2446 ;; with and without wildcards
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2447 (file-name-nondirectory dired-directory)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2448 to))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2449 (let ((new-name (file-name-nondirectory
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2450 (directory-file-name dired-directory))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2451 ;; try to rename buffer, but just leave old name if new
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2452 ;; name would already exist (don't try appending "<%d>")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2453 (or (get-buffer new-name)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2454 (rename-buffer new-name)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2455 ;; ... we dired TO now:
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2456 (dired-advertise)))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2457
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2458 (defun dired-rename-subdir-2 (elt dir to)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2459 ;; Update the headerline and dired-subdir-alist element of directory
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2460 ;; described by alist-element ELT to reflect the moving of DIR to TO.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2461 ;; Thus, ELT describes either DIR itself or a subdir of DIR.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2462
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2463 ;; Bug: If TO is not longer part of the same dired tree as DIR was,
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2464 ;; updating the headerline is actually not the right thing---it
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2465 ;; should be removed in that case and a completely new entry be
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2466 ;; added for TO. Actually, removing and adding anew would always be
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2467 ;; the right (but slow) way of doing it.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2468
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2469 ;; The consequences are pretty harmless though (no updates since
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2470 ;; dired-buffers-for-dir will not suspect it to be in this dired
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2471 ;; buffer).
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2472
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2473 (save-excursion
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2474 (let ((regexp (regexp-quote (directory-file-name dir)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2475 (newtext (directory-file-name to))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2476 buffer-read-only)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2477 (goto-char (dired-get-subdir-min elt))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2478 ;; Update subdir headerline in buffer
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2479 (if (not (looking-at dired-subdir-regexp))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2480 (error "%s not found where expected - dired-subdir-alist broken?"
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2481 dir)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2482 (goto-char (match-beginning 1))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2483 (if (re-search-forward regexp (match-end 1) t)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2484 (replace-match newtext t t)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2485 (error "Expected to find `%s' in headerline of %s" dir (car elt))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2486 ;; Update buffer-local dired-subdir-alist
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2487 (setcar elt
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2488 (dired-normalize-subdir
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2489 (dired-replace-in-string regexp newtext (car elt)))))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2490
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2491 ;; Cloning replace-match to work on strings instead of in buffer:
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2492 ;; The FIXEDCASE parameter of replace-match is not implemented.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2493 (defun dired-string-replace-match (regexp string newtext
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2494 &optional literal global)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2495 "Replace first match of REGEXP in STRING with NEWTEXT.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2496 If it does not match, nil is returned instead of the new string.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2497 Optional arg LITERAL means to take NEWTEXT literally.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2498 Optional arg GLOBAL means to replace all matches."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2499 (if global
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2500 (let ((result "") (start 0) mb me)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2501 (while (string-match regexp string start)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2502 (setq mb (match-beginning 0)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2503 me (match-end 0)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2504 result (concat result
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2505 (substring string start mb)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2506 (if literal
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2507 newtext
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2508 (dired-expand-newtext string newtext)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2509 start me))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2510 (if mb ; matched at least once
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2511 (concat result (substring string start))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2512 nil))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2513 ;; not GLOBAL
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2514 (if (not (string-match regexp string 0))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2515 nil
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2516 (concat (substring string 0 (match-beginning 0))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2517 (if literal newtext (dired-expand-newtext string newtext))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2518 (substring string (match-end 0))))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2519
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2520 (defun dired-expand-newtext (string newtext)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2521 ;; Expand \& and \1..\9 (referring to STRING) in NEWTEXT, using match data.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2522 ;; Note that in Emacs 18 match data are clipped to current buffer
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2523 ;; size...so the buffer should better not be smaller than STRING.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2524 (let ((pos 0)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2525 (len (length newtext))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2526 (expanded-newtext ""))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2527 (while (< pos len)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2528 (setq expanded-newtext
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2529 (concat expanded-newtext
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2530 (let ((c (aref newtext pos)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2531 (if (= ?\\ c)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2532 (cond ((= ?\& (setq c
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2533 (aref newtext
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2534 (setq pos (1+ pos)))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2535 (substring string
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2536 (match-beginning 0)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2537 (match-end 0)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2538 ((and (>= c ?1) (<= c ?9))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2539 ;; return empty string if N'th
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2540 ;; sub-regexp did not match:
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2541 (let ((n (- c ?0)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2542 (if (match-beginning n)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2543 (substring string
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2544 (match-beginning n)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2545 (match-end n))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2546 "")))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2547 (t
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2548 (char-to-string c)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2549 (char-to-string c)))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2550 (setq pos (1+ pos)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2551 expanded-newtext))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2552
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2553 ;; The basic function for half a dozen variations on cp/mv/ln/ln -s.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2554 (defun dired-create-files (file-creator operation fn-list name-constructor
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2555 &optional marker-char)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2556
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2557 ;; Create a new file for each from a list of existing files. The user
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2558 ;; is queried, dired buffers are updated, and at the end a success or
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2559 ;; failure message is displayed
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2560
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2561 ;; FILE-CREATOR must accept three args: oldfile newfile ok-if-already-exists
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2562
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2563 ;; It is called for each file and must create newfile, the entry of
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2564 ;; which will be added. The user will be queried if the file already
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2565 ;; exists. If oldfile is removed by FILE-CREATOR (i.e, it is a
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2566 ;; rename), it is FILE-CREATOR's responsibility to update dired
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2567 ;; buffers. FILE-CREATOR must abort by signalling a file-error if it
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2568 ;; could not create newfile. The error is caught and logged.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2569
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2570 ;; OPERATION (a capitalized string, e.g. `Copy') describes the
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2571 ;; operation performed. It is used for error logging.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2572
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2573 ;; FN-LIST is the list of files to copy (full absolute pathnames).
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2574
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2575 ;; NAME-CONSTRUCTOR returns a newfile for every oldfile, or nil to
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2576 ;; skip. If it skips files for other reasons than a direct user
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2577 ;; query, it is supposed to tell why (using dired-log).
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2578
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2579 ;; Optional MARKER-CHAR is a character with which to mark every
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2580 ;; newfile's entry, or t to use the current marker character if the
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2581 ;; oldfile was marked.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2582
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2583 (let (failures skipped (success-count 0) (total (length fn-list)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2584 (let (to overwrite-query
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2585 overwrite-backup-query) ; for dired-handle-overwrite
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2586 (mapcar
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2587 (function
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2588 (lambda (from)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2589 (setq to (funcall name-constructor from))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2590 (if (equal to from)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2591 (progn
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2592 (setq to nil)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2593 (dired-log "Cannot %s to same file: %s\n"
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2594 (downcase operation) from)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2595 (if (not to)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2596 (setq skipped (cons (dired-make-relative from) skipped))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2597 (let* ((overwrite (file-exists-p to))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2598 (overwrite-confirmed ; for dired-handle-overwrite
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2599 (and overwrite
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2600 (let ((help-form '(format "\
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2601 Type SPC or `y' to overwrite file `%s',
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2602 DEL or `n' to skip to next,
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2603 ESC or `q' to not overwrite any of the remaining files,
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2604 `!' to overwrite all remaining files with no more questions." to)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2605 (dired-query 'overwrite-query
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2606 "Overwrite `%s'?" to))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2607 ;; must determine if FROM is marked before file-creator
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2608 ;; gets a chance to delete it (in case of a move).
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2609 (actual-marker-char
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2610 (cond ((integerp marker-char) marker-char)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2611 (marker-char (dired-file-marker from)) ; slow
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2612 (t nil))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2613 (condition-case err
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2614 (progn
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2615 (funcall file-creator from to overwrite-confirmed)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2616 (if overwrite
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2617 ;; If we get here, file-creator hasn't been aborted
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2618 ;; and the old entry (if any) has to be deleted
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2619 ;; before adding the new entry.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2620 (dired-remove-file to))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2621 (setq success-count (1+ success-count))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2622 (message "%s: %d of %d" operation success-count total)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2623 (dired-add-file to actual-marker-char))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2624 (file-error ; FILE-CREATOR aborted
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2625 (progn
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2626 (setq failures (cons (dired-make-relative from) failures))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2627 (dired-log "%s `%s' to `%s' failed:\n%s\n"
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2628 operation from to err))))))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2629 fn-list))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2630 (cond
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2631 (failures
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2632 (dired-log-summary
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2633 (message "%s failed for %d of %d file%s %s"
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2634 operation (length failures) total
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2635 (dired-plural-s total) failures)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2636 (skipped
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2637 (dired-log-summary
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2638 (message "%s: %d of %d file%s skipped %s"
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2639 operation (length skipped) total
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2640 (dired-plural-s total) skipped)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2641 (t
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2642 (message "%s: %s file%s."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2643 operation success-count (dired-plural-s success-count)))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2644 (dired-move-to-filename))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2645
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2646 (defun dired-do-create-files (op-symbol file-creator operation arg
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2647 &optional marker-char op1
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2648 how-to)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2649 ;; Create a new file for each marked file.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2650 ;; Prompts user for target, which is a directory in which to create
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2651 ;; the new files. Target may be a plain file if only one marked
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2652 ;; file exists.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2653 ;; OP-SYMBOL is the symbol for the operation. Function `dired-mark-pop-up'
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2654 ;; will determine wether pop-ups are appropriate for this OP-SYMBOL.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2655 ;; FILE-CREATOR and OPERATION as in dired-create-files.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2656 ;; ARG as in dired-mark-get-files.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2657 ;; Optional arg OP1 is an alternate form for OPERATION if there is
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2658 ;; only one file.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2659 ;; Optional arg MARKER-CHAR as in dired-create-files.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2660 ;; Optional arg HOW-TO determines how to treat target:
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2661 ;; If HOW-TO is not given (or nil), and target is a directory, the
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2662 ;; file(s) are created inside the target directory. If target
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2663 ;; is not a directory, there must be exactly one marked file,
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2664 ;; else error.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2665 ;; If HOW-TO is t, then target is not modified. There must be
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2666 ;; exactly one marked file, else error.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2667 ;; Else HOW-TO is assumed to be a function of one argument, target,
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2668 ;; that looks at target and returns a value for the into-dir
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2669 ;; variable. The function dired-into-dir-with-symlinks is provided
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2670 ;; for the case (common when creating symlinks) that symbolic
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2671 ;; links to directories are not to be considered as directories
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2672 ;; (as file-directory-p would if HOW-TO had been nil).
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2673 (or op1 (setq op1 operation))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2674 (let* ((fn-list (dired-mark-get-files nil arg))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2675 (fn-count (length fn-list))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2676 (target (expand-file-name
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2677 (dired-mark-read-file-name
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2678 (concat (if (= 1 fn-count) op1 operation) " %s to: ")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2679 (dired-dwim-target-directory)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2680 op-symbol arg (mapcar (function dired-make-relative) fn-list))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2681 (into-dir (cond ((null how-to) (file-directory-p target))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2682 ((eq how-to t) nil)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2683 (t (funcall how-to target)))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2684 (if (and (> fn-count 1)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2685 (not into-dir))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2686 (error "Marked %s: target must be a directory: %s" operation target))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2687 ;; rename-file bombs when moving directories unless we do this:
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2688 (or into-dir (setq target (directory-file-name target)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2689 (dired-create-files
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2690 file-creator operation fn-list
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2691 (if into-dir ; target is a directory
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2692 ;; This function uses fluid vars into-dir and target when called
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2693 ;; inside dired-create-files:
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2694 (function (lambda (from)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2695 (expand-file-name (file-name-nondirectory from) target)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2696 (function (lambda (from) target)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2697 marker-char)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2698
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2699 (defun dired-dwim-target-directory ()
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2700 ;; Try to guess which target directory the user may want.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2701 ;; If there is a dired buffer displayed in the next window, use
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2702 ;; its current subdir, else use current subdir of this dired buffer.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2703 (let ((this-dir (and (eq major-mode 'dired-mode)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2704 (dired-current-directory))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2705 ;; non-dired buffer may want to profit from this function, e.g. vm-uudecode
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2706 (if dired-dwim-target
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2707 (let* ((other-buf (window-buffer (next-window)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2708 (other-dir (save-excursion
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2709 (set-buffer other-buf)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2710 (and (eq major-mode 'dired-mode)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2711 (dired-current-directory)))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2712 (or other-dir this-dir))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2713 this-dir)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2714
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2715 (defun dired-into-dir-with-symlinks (target)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2716 (and (file-directory-p target)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2717 (not (file-symlink-p target))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2718 ;; This may not always be what you want, especially if target is your
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2719 ;; home directory and it happens to be a symbolic link, as is often the
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2720 ;; case with NFS and automounters. Or if you want to make symlinks
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2721 ;; into directories that themselves are only symlinks, also quite
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2722 ;; common.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2723
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2724 ;; So we don't use this function as value for HOW-TO in
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2725 ;; dired-do-symlink, which has the minor disadvantage of
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2726 ;; making links *into* a symlinked-dir, when you really wanted to
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2727 ;; *overwrite* that symlink. In that (rare, I guess) case, you'll
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2728 ;; just have to remove that symlink by hand before making your marked
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2729 ;; symlinks.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2730
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2731 (defun dired-do-copy (&optional arg)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2732 "Copy all marked (or next ARG) files, or copy the current file.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2733 Thus, a zero prefix argument copies nothing. But it toggles the
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2734 variable `dired-copy-preserve-time' (which see)."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2735 (interactive "P")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2736 (if (not (zerop (prefix-numeric-value arg)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2737 (dired-do-create-files 'copy (function dired-copy-file)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2738 (if dired-copy-preserve-time "Copy [-p]" "Copy")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2739 arg dired-keep-marker-copy)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2740 (setq dired-copy-preserve-time (not dired-copy-preserve-time))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2741 (if dired-copy-preserve-time
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2742 (message "Copy will preserve time.")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2743 (message "Copied files will get current date."))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2744
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2745 (defun dired-do-symlink (&optional arg)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2746 "Symlink all marked (or next ARG) files into a directory,
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2747 or make a symbolic link to the current file."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2748 (interactive "P")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2749 (dired-do-create-files 'symlink (function make-symbolic-link)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2750 "SymLink" arg dired-keep-marker-symlink))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2751
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2752 (defun dired-do-hardlink (&optional arg)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2753 "Hard-link all marked (or next ARG) files into a directory,
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2754 or make a hard link to the current file."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2755 (interactive "P")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2756 (dired-do-create-files 'hardlink (function add-name-to-file)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2757 "HardLink" arg dired-keep-marker-hardlink))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2758
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2759 (defun dired-do-move (&optional arg)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2760 "Move all marked (or next ARG) files into a directory,
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2761 or rename the current file.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2762 A zero ARG moves no files but toggles `dired-dwim-target' (which see)."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2763 (interactive "P")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2764 (if (not (zerop (prefix-numeric-value arg)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2765 (dired-do-create-files 'move (function dired-rename-file)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2766 "Move" arg dired-keep-marker-move "Rename")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2767 (setq dired-dwim-target (not dired-dwim-target))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2768 (message "dired-dwim-target is %s." (if dired-dwim-target "ON" "OFF"))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2769
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2770 ;;;###end dired-cp.el
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2771
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2772 ;;; 5K
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2773 ;;;###begin dired-re.el
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2774 (defun dired-do-create-files-regexp
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2775 (file-creator operation arg regexp newname &optional whole-path marker-char)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2776 ;; Create a new file for each marked file using regexps.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2777 ;; FILE-CREATOR and OPERATION as in dired-create-files.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2778 ;; ARG as in dired-mark-get-files.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2779 ;; Matches each marked file against REGEXP and constructs the new
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2780 ;; filename from NEWNAME (like in function replace-match).
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2781 ;; Optional arg WHOLE-PATH means match/replace the whole pathname
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2782 ;; instead of only the non-directory part of the file.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2783 ;; Optional arg MARKER-CHAR as in dired-create-files.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2784 (let* ((fn-list (dired-mark-get-files nil arg))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2785 (fn-count (length fn-list))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2786 (operation-prompt (concat operation " `%s' to `%s'?"))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2787 (rename-regexp-help-form (format "\
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2788 Type SPC or `y' to %s one match, DEL or `n' to skip to next,
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2789 `!' to %s all remaining matches with no more questions."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2790 (downcase operation)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2791 (downcase operation)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2792 (regexp-name-constructor
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2793 ;; Function to construct new filename using REGEXP and NEWNAME:
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2794 (if whole-path ; easy (but rare) case
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2795 (function
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2796 (lambda (from)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2797 (let ((to (dired-string-replace-match regexp from newname))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2798 ;; must bind help-form directly around call to
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2799 ;; dired-query
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2800 (help-form rename-regexp-help-form))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2801 (if to
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2802 (and (dired-query 'rename-regexp-query
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2803 operation-prompt
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2804 from
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2805 to)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2806 to)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2807 (dired-log "%s: %s did not match regexp %s\n"
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2808 operation from regexp)))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2809 ;; not whole-path, replace non-directory part only
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2810 (function
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2811 (lambda (from)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2812 (let* ((new (dired-string-replace-match
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2813 regexp (file-name-nondirectory from) newname))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2814 (to (and new ; nil means there was no match
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2815 (expand-file-name new
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2816 (file-name-directory from))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2817 (help-form rename-regexp-help-form))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2818 (if to
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2819 (and (dired-query 'rename-regexp-query
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2820 operation-prompt
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2821 (dired-make-relative from)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2822 (dired-make-relative to))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2823 to)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2824 (dired-log "%s: %s did not match regexp %s\n"
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2825 operation (file-name-nondirectory from) regexp)))))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2826 rename-regexp-query)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2827 (dired-create-files
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2828 file-creator operation fn-list regexp-name-constructor marker-char)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2829
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2830 (defun dired-mark-read-regexp (operation)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2831 ;; Prompt user about performing OPERATION.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2832 ;; Read and return list of: regexp newname arg whole-path.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2833 (let* ((whole-path
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2834 (equal 0 (prefix-numeric-value current-prefix-arg)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2835 (arg
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2836 (if whole-path nil current-prefix-arg))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2837 (regexp
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2838 (dired-read-regexp
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2839 (concat (if whole-path "Path " "") operation " from (regexp): ")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2840 dired-flagging-regexp))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2841 (newname
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2842 (read-string
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2843 (concat (if whole-path "Path " "") operation " " regexp " to: "))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2844 (list regexp newname arg whole-path)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2845
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2846 (defun dired-do-rename-regexp (regexp newname &optional arg whole-path)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2847 "Rename marked files containing REGEXP to NEWNAME.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2848 As each match is found, the user must type a character saying
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2849 what to do with it. For directions, type \\[help-command] at that time.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2850 NEWNAME may contain \\=\\<n> or \\& as in `query-replace-regexp'.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2851 REGEXP defaults to the last regexp used.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2852 With a zero prefix arg, renaming by regexp affects the complete
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2853 pathname - usually only the non-directory part of file names is used
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2854 and changed."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2855 (interactive (dired-mark-read-regexp "Rename"))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2856 (dired-do-create-files-regexp
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2857 (function dired-rename-file)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2858 "Rename" arg regexp newname whole-path dired-keep-marker-move))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2859
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2860 (defun dired-do-copy-regexp (regexp newname &optional arg whole-path)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2861 "Copy all marked files containing REGEXP to NEWNAME.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2862 See function `dired-rename-regexp' for more info."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2863 (interactive (dired-mark-read-regexp "Copy"))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2864 (dired-do-create-files-regexp
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2865 (function dired-copy-file)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2866 (if dired-copy-preserve-time "Copy [-p]" "Copy")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2867 arg regexp newname whole-path dired-keep-marker-copy))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2868
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2869 (defun dired-do-hardlink-regexp (regexp newname &optional arg whole-path)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2870 "Hardlink all marked files containing REGEXP to NEWNAME.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2871 See function `dired-rename-regexp' for more info."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2872 (interactive (dired-mark-read-regexp "HardLink"))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2873 (dired-do-create-files-regexp
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2874 (function add-name-to-file)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2875 "HardLink" arg regexp newname whole-path dired-keep-marker-hardlink))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2876
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2877 (defun dired-do-symlink-regexp (regexp newname &optional arg whole-path)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2878 "Symlink all marked files containing REGEXP to NEWNAME.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2879 See function `dired-rename-regexp' for more info."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2880 (interactive (dired-mark-read-regexp "SymLink"))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2881 (dired-do-create-files-regexp
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2882 (function make-symbolic-link)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2883 "SymLink" arg regexp newname whole-path dired-keep-marker-symlink))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2884
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2885 (defun dired-create-files-non-directory
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2886 (file-creator basename-constructor operation arg)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2887 ;; Perform FILE-CREATOR on the non-directory part of marked files
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2888 ;; using function BASENAME-CONSTRUCTOR, with query for each file.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2889 ;; OPERATION like in dired-create-files, ARG like in dired-mark-get-files.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2890 (let (rename-non-directory-query)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2891 (dired-create-files
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2892 file-creator
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2893 operation
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2894 (dired-mark-get-files nil arg)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2895 (function
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2896 (lambda (from)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2897 (let ((to (concat (file-name-directory from)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2898 (funcall basename-constructor
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2899 (file-name-nondirectory from)))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2900 (and (let ((help-form (format "\
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2901 Type SPC or `y' to %s one file, DEL or `n' to skip to next,
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2902 `!' to %s all remaining matches with no more questions."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2903 (downcase operation)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2904 (downcase operation))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2905 (dired-query 'rename-non-directory-query
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2906 (concat operation " `%s' to `%s'")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2907 (dired-make-relative from)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2908 (dired-make-relative to)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2909 to))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2910 dired-keep-marker-move)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2911
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2912 (defun dired-rename-non-directory (basename-constructor operation arg)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2913 (dired-create-files-non-directory
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2914 (function dired-rename-file)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2915 basename-constructor operation arg))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2916
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2917 (defun dired-upcase (&optional arg)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2918 "Rename all marked (or next ARG) files to upper case."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2919 (interactive "P")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2920 (dired-rename-non-directory (function upcase) "Rename upcase" arg))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2921
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2922 (defun dired-downcase (&optional arg)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2923 "Rename all marked (or next ARG) files to lower case."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2924 (interactive "P")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2925 (dired-rename-non-directory (function downcase) "Rename downcase" arg))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2926
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2927 ;;;###end dired-re.el
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2928
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2929
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2930 ;; Tree Dired
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2931
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2932 ;;; utility functions
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2933
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2934 (defun dired-in-this-tree (file dir)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2935 ;;"Is FILE part of the directory tree starting at DIR?"
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2936 (let (case-fold-search)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2937 (string-match (concat "^" (regexp-quote dir)) file)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2938
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2939 (defun dired-make-absolute (file &optional dir)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2940 ;;"Convert FILE (a pathname relative to DIR) to an absolute pathname."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2941 ;; We can't always use expand-file-name as this would get rid of `.'
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2942 ;; or expand in / instead default-directory if DIR=="".
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2943 ;; This should be good enough for ange-ftp, but might easily be
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2944 ;; redefined (for VMS?).
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2945 ;; It should be reasonably fast, though, as it is called in
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2946 ;; dired-get-filename.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2947 (concat (or dir default-directory) file))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2948
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2949 (defun dired-make-relative (file &optional dir no-error)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2950 ;;"Convert FILE (an absolute pathname) to a pathname relative to DIR.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2951 ;; Else error (unless NO-ERROR is non-nil, then FILE is returned unchanged)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2952 ;;DIR defaults to default-directory."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2953 ;; DIR must be file-name-as-directory, as with all directory args in
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2954 ;; elisp code.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2955 (or dir (setq dir default-directory))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2956 (if (string-match (concat "^" (regexp-quote dir)) file)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2957 (substring file (match-end 0))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2958 (if no-error
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2959 file
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2960 (error "%s: not in directory tree growing at %s" file dir))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2961
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2962 (defun dired-normalize-subdir (dir)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2963 ;; Prepend default-directory to DIR if relative path name.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2964 ;; dired-get-filename must be able to make a valid filename from a
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2965 ;; file and its directory DIR.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2966 (file-name-as-directory
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2967 (if (file-name-absolute-p dir)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2968 dir
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2969 (expand-file-name dir default-directory))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2970
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2971 (defun dired-between-files ()
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2972 ;; Point must be at beginning of line
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2973 ;; Should be equivalent to (save-excursion (not (dired-move-to-filename)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2974 ;; but is about 1.5..2.0 times as fast. (Actually that's not worth it)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2975 (or (looking-at "^$\\|^. *$\\|^. total\\|^. wildcard")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2976 (looking-at dired-subdir-regexp)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2977
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2978 (defun dired-get-subdir ()
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2979 ;;"Return the subdir name on this line, or nil if not on a headerline."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2980 ;; Look up in the alist whether this is a headerline.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2981 (save-excursion
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2982 (let ((cur-dir (dired-current-directory)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2983 (beginning-of-line) ; alist stores b-o-l positions
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2984 (and (zerop (- (point)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2985 (dired-get-subdir-min (assoc cur-dir
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2986 dired-subdir-alist))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2987 cur-dir))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2988
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2989 ;(defun dired-get-subdir-min (elt)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2990 ; (cdr elt))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2991 ;; can't use macro, must be redefinable for other alist format in dired-nstd.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2992 (fset 'dired-get-subdir-min 'cdr)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2993
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2994 (defun dired-get-subdir-max (elt)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2995 (save-excursion
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2996 (goto-char (dired-get-subdir-min elt))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2997 (dired-subdir-max)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2998
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2999 (defun dired-clear-alist ()
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3000 (while dired-subdir-alist
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3001 (set-marker (dired-get-subdir-min (car dired-subdir-alist)) nil)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3002 (setq dired-subdir-alist (cdr dired-subdir-alist))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3003
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3004 (defun dired-simple-subdir-alist ()
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3005 ;; Build and return `dired-subdir-alist' assuming just the top level
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3006 ;; directory to be inserted. Don't parse the buffer.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3007 (set (make-local-variable 'dired-subdir-alist)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3008 (list (cons default-directory (point-min-marker)))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3009
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3010 (defun dired-build-subdir-alist ()
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3011 "Build `dired-subdir-alist' by parsing the buffer and return it's new value."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3012 (interactive)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3013 (dired-clear-alist)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3014 (save-excursion
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3015 (let ((count 0))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3016 (goto-char (point-min))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3017 (setq dired-subdir-alist nil)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3018 (while (re-search-forward dired-subdir-regexp nil t)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3019 (setq count (1+ count))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3020 (dired-alist-add-1 (buffer-substring (match-beginning 1)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3021 (match-end 1))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3022 ;; Put subdir boundary between lines:
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3023 (save-excursion
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3024 (goto-char (match-beginning 0))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3025 (beginning-of-line)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3026 (point-marker)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3027 (message "%d" count))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3028 (message "%d director%s." count (if (= 1 count) "y" "ies"))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3029 ;; We don't need to sort it because it is in buffer order per
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3030 ;; constructionem. Return new alist:
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3031 dired-subdir-alist)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3032
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3033 (defun dired-alist-add (dir new-marker)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3034 ;; Add new DIR at NEW-MARKER. Sort alist.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3035 (dired-alist-add-1 dir new-marker)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3036 (dired-alist-sort))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3037
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3038 (defun dired-alist-add-1 (dir new-marker)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3039 ;; Add new DIR at NEW-MARKER. Don't sort.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3040 (setq dired-subdir-alist
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3041 (cons (cons (dired-normalize-subdir dir) new-marker)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3042 dired-subdir-alist)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3043
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3044 (defun dired-alist-sort ()
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3045 ;; Keep the alist sorted on buffer position.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3046 (setq dired-subdir-alist
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3047 (sort dired-subdir-alist
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3048 (function (lambda (elt1 elt2)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3049 (> (dired-get-subdir-min elt1)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3050 (dired-get-subdir-min elt2)))))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3051
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3052 (defun dired-unsubdir (dir)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3053 ;; Remove DIR from the alist
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3054 (setq dired-subdir-alist
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3055 (delq (assoc dir dired-subdir-alist) dired-subdir-alist)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3056
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3057 (defun dired-goto-next-nontrivial-file ()
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3058 ;; Position point on first nontrivial file after point.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3059 (dired-goto-next-file);; so there is a file to compare with
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3060 (if (stringp dired-trivial-filenames)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3061 (while (and (not (eobp))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3062 (string-match dired-trivial-filenames
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3063 (file-name-nondirectory
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3064 (or (dired-get-filename nil t) ""))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3065 (forward-line 1)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3066 (dired-move-to-filename))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3067
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3068 (defun dired-goto-next-file ()
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3069 (let ((max (1- (dired-subdir-max))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3070 (while (and (not (dired-move-to-filename)) (< (point) max))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3071 (forward-line 1))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3072
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3073 (defun dired-goto-subdir (dir)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3074 "Goto end of header line of DIR in this dired buffer.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3075 Return value of point on success, otherwise return nil.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3076 The next char is either \\n, or \\r if DIR is hidden."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3077 (interactive
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3078 (prog1 ; let push-mark display its message
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3079 (list (expand-file-name
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3080 (completing-read "Goto in situ directory: " ; prompt
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3081 dired-subdir-alist ; table
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3082 nil ; predicate
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3083 t ; require-match
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3084 (dired-current-directory))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3085 (push-mark)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3086 (setq dir (file-name-as-directory dir))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3087 (let ((elt (assoc dir dired-subdir-alist)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3088 (and elt
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3089 (goto-char (dired-get-subdir-min elt))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3090 ;; dired-subdir-hidden-p and dired-add-entry depend on point being
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3091 ;; at either \r or \n after this function succeeds.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3092 (progn (skip-chars-forward "^\r\n")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3093 (point)))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3094
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3095 (defun dired-goto-file (file)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3096 "Goto file line of FILE in this dired buffer."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3097 ;; Return value of point on success, else nil.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3098 ;; FILE must be an absolute pathname.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3099 ;; Loses if FILE contains control chars like "\007" for which ls
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3100 ;; either inserts "?" or "\\007" into the buffer, so we won't find
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3101 ;; it in the buffer.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3102 (interactive
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3103 (prog1 ; let push-mark display its message
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3104 (list (expand-file-name
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3105 (read-file-name "Goto file: "
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3106 (dired-current-directory))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3107 (push-mark)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3108 (setq file (directory-file-name file)) ; does no harm if no directory
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3109 (let (found case-fold-search)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3110 (save-excursion
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3111 (if (dired-goto-subdir (or (file-name-directory file)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3112 (error "Need absolute pathname for %s" file)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3113 (let ((base (file-name-nondirectory file))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3114 (boundary (dired-subdir-max)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3115 (while (and (not found)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3116 ;; filenames are preceded by SPC, this makes
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3117 ;; the search faster (e.g. for the filename "-"!).
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3118 (search-forward (concat " " base) boundary 'move))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3119 ;; Match could have BASE just as initial substring
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3120 ;; or in permission bits or date or
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3121 ;; not be a proper filename at all:
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3122 (if (equal base (dired-get-filename 'no-dir t))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3123 ;; Must move to filename since an (actually
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3124 ;; correct) match could have been elsewhere on the
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3125 ;; ;; line (e.g. "-" would match somewhere in the
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3126 ;; permission bits).
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3127 (setq found (dired-move-to-filename)))))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3128 (and found
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3129 ;; return value of point (i.e., FOUND):
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3130 (goto-char found))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3131
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3132 (defun dired-initial-position (dirname)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3133 ;; Where point should go in a new listing of DIRNAME.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3134 ;; Point assumed at beginning of new subdir line.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3135 ;; You may redefine this function as you wish, e.g. like in dired-x.el.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3136 (end-of-line)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3137 (if dired-trivial-filenames (dired-goto-next-nontrivial-file)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3138
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3139 ;;; moving by subdirectories
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3140
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3141 (defun dired-subdir-index (dir)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3142 ;; Return an index into alist for use with nth
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3143 ;; for the sake of subdir moving commands.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3144 (let (found (index 0) (alist dired-subdir-alist))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3145 (while alist
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3146 (if (string= dir (car (car alist)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3147 (setq alist nil found t)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3148 (setq alist (cdr alist) index (1+ index))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3149 (if found index nil)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3150
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3151 (defun dired-next-subdir (arg &optional no-error-if-not-found no-skip)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3152 "Go to next subdirectory, regardless of level."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3153 ;; Use 0 arg to go to this directory's header line.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3154 ;; NO-SKIP prevents moving to end of header line, returning whatever
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3155 ;; position was found in dired-subdir-alist.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3156 (interactive "_p")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3157 (let ((this-dir (dired-current-directory))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3158 pos index)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3159 ;; nth with negative arg does not return nil but the first element
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3160 (setq index (- (dired-subdir-index this-dir) arg))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3161 (setq pos (if (>= index 0)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3162 (dired-get-subdir-min (nth index dired-subdir-alist))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3163 (if pos
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3164 (progn
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3165 (goto-char pos)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3166 (or no-skip (skip-chars-forward "^\n\r"))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3167 (point))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3168 (if no-error-if-not-found
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3169 nil ; return nil if not found
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3170 (error "%s directory" (if (> arg 0) "Last" "First"))))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3171
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3172 (defun dired-prev-subdir (arg &optional no-error-if-not-found no-skip)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3173 "Go to previous subdirectory, regardless of level.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3174 When called interactively and not on a subdir line, go to this subdir's line."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3175 ;;(interactive "_p")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3176 (interactive
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3177 (list (if current-prefix-arg
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3178 (prefix-numeric-value current-prefix-arg)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3179 ;; if on subdir start already, don't stay there!
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3180 (if (dired-get-subdir) 1 0))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3181 (dired-next-subdir (- arg) no-error-if-not-found no-skip))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3182
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3183 (defun dired-tree-up (arg)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3184 "Go up ARG levels in the dired tree."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3185 (interactive "_p")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3186 (let ((dir (dired-current-directory)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3187 (while (>= arg 1)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3188 (setq arg (1- arg)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3189 dir (file-name-directory (directory-file-name dir))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3190 ;;(setq dir (expand-file-name dir))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3191 (or (dired-goto-subdir dir)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3192 (error "Cannot go up to %s - not in this tree." dir))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3193
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3194 (defun dired-tree-down ()
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3195 "Go down in the dired tree."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3196 (interactive "_")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3197 (let ((dir (dired-current-directory)) ; has slash
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3198 pos case-fold-search) ; filenames are case sensitive
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3199 (let ((rest (reverse dired-subdir-alist)) elt)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3200 (while rest
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3201 (setq elt (car rest)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3202 rest (cdr rest))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3203 (if (dired-in-this-tree (directory-file-name (car elt)) dir)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3204 (setq rest nil
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3205 pos (dired-goto-subdir (car elt))))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3206 (if pos
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3207 (goto-char pos)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3208 (error "At the bottom"))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3209
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3210 ;;; hiding
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3211
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3212 (defun dired-subdir-hidden-p (dir)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3213 (and selective-display
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3214 (save-excursion
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3215 (dired-goto-subdir dir)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3216 (looking-at "\r"))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3217
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3218 (defun dired-unhide-subdir ()
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3219 (let (buffer-read-only)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3220 (subst-char-in-region (dired-subdir-min) (dired-subdir-max) ?\r ?\n)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3221
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3222 (defun dired-hide-check ()
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3223 (or selective-display
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3224 (error "selective-display must be t for subdir hiding to work!")))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3225
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3226 (defun dired-hide-subdir (arg)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3227 "Hide or unhide the current subdirectory and move to next directory.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3228 Optional prefix arg is a repeat factor.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3229 Use \\[dired-hide-all] to (un)hide all directories."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3230 (interactive "p")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3231 (dired-hide-check)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3232 (while (>= (setq arg (1- arg)) 0)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3233 (let* ((cur-dir (dired-current-directory))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3234 (hidden-p (dired-subdir-hidden-p cur-dir))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3235 (elt (assoc cur-dir dired-subdir-alist))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3236 (end-pos (1- (dired-get-subdir-max elt)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3237 buffer-read-only)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3238 ;; keep header line visible, hide rest
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3239 (goto-char (dired-get-subdir-min elt))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3240 (skip-chars-forward "^\n\r")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3241 (if hidden-p
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3242 (subst-char-in-region (point) end-pos ?\r ?\n)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3243 (subst-char-in-region (point) end-pos ?\n ?\r)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3244 (dired-next-subdir 1 t)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3245
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3246 (defun dired-hide-all (arg)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3247 "Hide all subdirectories, leaving only their header lines.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3248 If there is already something hidden, make everything visible again.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3249 Use \\[dired-hide-subdir] to (un)hide a particular subdirectory."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3250 (interactive "P")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3251 (dired-hide-check)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3252 (let (buffer-read-only)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3253 (if (save-excursion
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3254 (goto-char (point-min))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3255 (search-forward "\r" nil t))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3256 ;; unhide - bombs on \r in filenames
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3257 (subst-char-in-region (point-min) (point-max) ?\r ?\n)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3258 ;; hide
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3259 (let ((pos (point-max)) ; pos of end of last directory
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3260 (alist dired-subdir-alist))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3261 (while alist ; while there are dirs before pos
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3262 (subst-char-in-region (dired-get-subdir-min (car alist)) ; pos of prev dir
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3263 (save-excursion
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3264 (goto-char pos) ; current dir
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3265 ;; we're somewhere on current dir's line
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3266 (forward-line -1)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3267 (point))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3268 ?\n ?\r)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3269 (setq pos (dired-get-subdir-min (car alist))) ; prev dir gets current dir
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3270 (setq alist (cdr alist)))))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3271
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3272
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3273 ;; This function is the heart of tree dired.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3274 ;; It is called for each retrieved filename.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3275 ;; It could stand to be faster, though it's mostly function call
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3276 ;; overhead. Avoiding to funcall seems to save about 10% in
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3277 ;; dired-get-filename. Make it a defsubst?
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3278 (defun dired-current-directory (&optional localp)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3279 "Return the name of the subdirectory to which this line belongs.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3280 This returns a string with trailing slash, like `default-directory'.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3281 Optional argument means return a file name relative to `default-directory'."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3282 (let ((here (point))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3283 (alist (or dired-subdir-alist
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3284 ;; probably because called in a non-dired buffer
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3285 (error "No subdir-alist in %s" (current-buffer))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3286 elt dir)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3287 (while alist
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3288 (setq elt (car alist)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3289 dir (car elt)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3290 ;; use `<=' (not `<') as subdir line is part of subdir
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3291 alist (if (<= (dired-get-subdir-min elt) here)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3292 nil ; found
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3293 (cdr alist))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3294 (if localp
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3295 (dired-make-relative dir default-directory)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3296 dir)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3297
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3298 ;; Subdirs start at the beginning of their header lines and end just
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3299 ;; before the beginning of the next header line (or end of buffer).
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3300
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3301 (defun dired-subdir-min ()
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3302 (save-excursion
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3303 (if (not (dired-prev-subdir 0 t t))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3304 (error "Not in a subdir!")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3305 (point))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3306
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3307 (defun dired-subdir-max ()
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3308 (save-excursion
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3309 (if (not (dired-next-subdir 1 t t))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3310 (point-max)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3311 (point))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3312
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3313 (defun dired-kill-line-or-subdir (&optional arg)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3314 "Kill this line (but not this file).
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3315 Optional prefix argument is a repeat factor.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3316 If file is displayed as in situ subdir, kill that as well.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3317 If on a subdir headerline, kill whole subdir."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3318 (interactive "p")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3319 (if (dired-get-subdir)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3320 (dired-kill-subdir)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3321 (dired-kill-line arg)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3322
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3323 (defun dired-kill-line (&optional arg)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3324 (interactive "P")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3325 (setq arg (prefix-numeric-value arg))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3326 (let (buffer-read-only file)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3327 (while (/= 0 arg)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3328 (setq file (dired-get-filename nil t))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3329 (if (not file)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3330 (error "Can only kill file lines.")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3331 (save-excursion (and file
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3332 (dired-goto-subdir file)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3333 (dired-kill-subdir)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3334 (delete-region (progn (beginning-of-line) (point))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3335 (progn (forward-line 1) (point)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3336 (if (> arg 0)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3337 (setq arg (1- arg))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3338 (setq arg (1+ arg))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3339 (forward-line -1))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3340 (dired-move-to-filename)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3341
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3342 (defun dired-kill-subdir (&optional remember-marks)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3343 "Remove all lines of current subdirectory.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3344 Lower levels are unaffected."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3345 ;; With optional REMEMBER-MARKS, return a mark-alist.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3346 (interactive)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3347 (let ((beg (dired-subdir-min))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3348 (end (dired-subdir-max))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3349 buffer-read-only cur-dir)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3350 (setq cur-dir (dired-current-directory))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3351 (if (equal cur-dir default-directory)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3352 (error "Attempt to kill top level directory"))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3353 (prog1
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3354 (if remember-marks (dired-remember-marks beg end))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3355 (delete-region beg end)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3356 (if (eobp) ; don't leave final blank line
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3357 (delete-char -1))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3358 (dired-unsubdir cur-dir))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3359
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3360 (defun dired-do-kill (&optional arg fmt)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3361 "Kill all marked lines (not files).
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3362 With a prefix arg, kill all lines not marked or flagged."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3363 ;; Returns count of killed lines. FMT="" suppresses message.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3364 (interactive "P")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3365 (save-excursion
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3366 (goto-char (point-min))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3367 (let (buffer-read-only (count 0))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3368 (if (not arg) ; kill marked lines
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3369 (let ((regexp (dired-marker-regexp)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3370 (while (and (not (eobp))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3371 (re-search-forward regexp nil t))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3372 (setq count (1+ count))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3373 (delete-region (progn (beginning-of-line) (point))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3374 (progn (forward-line 1) (point)))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3375 ;; else kill unmarked lines
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3376 (while (not (eobp))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3377 (if (or (dired-between-files)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3378 (not (looking-at "^ ")))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3379 (forward-line 1)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3380 (setq count (1+ count))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3381 (delete-region (point) (save-excursion
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3382 (forward-line 1)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3383 (point))))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3384 (or (equal "" fmt)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3385 (message (or fmt "Killed %d line%s.") count (dired-plural-s count)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3386 count)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3387
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3388 (defun dired-do-redisplay (&optional arg test-for-subdir)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3389 "Redisplay all marked (or next ARG) files.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3390
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3391 If on a subdir line, redisplay that subdirectory. In that case,
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3392 a prefix arg lets you edit the ls switches used for the new listing."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3393 ;; Moves point if the next ARG files are redisplayed.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3394 (interactive "P\np")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3395 (if (and test-for-subdir (dired-get-subdir))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3396 (dired-insert-subdir
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3397 (dired-get-subdir)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3398 (if arg (read-string "Switches for listing: " dired-actual-switches)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3399 (message "Redisplaying...")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3400 ;; message instead of making dired-mark-map show-progress is much faster
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3401 (dired-mark-map (let ((fname (dired-get-filename)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3402 (message "Redisplaying... %s" fname)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3403 (dired-update-file-line fname))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3404 arg)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3405 (dired-move-to-filename)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3406 (message "Redisplaying...done")))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3407
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3408 (defun dired-mark-files-in-region (start end)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3409 (let (buffer-read-only)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3410 (if (> start end)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3411 (error "start > end"))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3412 (goto-char start) ; assumed at beginning of line
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3413 (while (< (point) end)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3414 ;; Skip subdir line and following garbage like the `total' line:
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3415 (while (and (< (point) end) (dired-between-files))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3416 (forward-line 1))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3417 (if (and (not (looking-at dired-re-dot))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3418 (dired-get-filename nil t))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3419 (progn
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3420 (delete-char 1)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3421 (insert dired-marker-char)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3422 (forward-line 1))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3423
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3424 (defun dired-mark-subdir-files ()
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3425 "Mark all files except `.' and `..'."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3426 (interactive "P")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3427 (let ((p-min (dired-subdir-min)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3428 (dired-mark-files-in-region p-min (dired-subdir-max))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3429
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3430 (defun dired-mark-subdir-or-file (arg)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3431 "Mark the current (or next ARG) files.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3432 If on a subdir headerline, mark all its files except `.' and `..'.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3433
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3434 Use \\[dired-unflag-all-files] to remove all marks
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3435 and \\[dired-unmark-subdir-or-file] on a subdir to remove the marks in
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3436 this subdir."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3437 (interactive "P")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3438 (if (dired-get-subdir)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3439 (save-excursion (dired-mark-subdir-files))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3440 (dired-mark-file (prefix-numeric-value arg))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3441
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3442 (defun dired-unmark-subdir-or-file (arg)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3443 "Unmark the current (or next ARG) files.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3444 If looking at a subdir, unmark all its files except `.' and `..'."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3445 (interactive "P")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3446 (let ((dired-marker-char ?\040))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3447 (dired-mark-subdir-or-file arg)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3448
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3449 ;;; 5K
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3450 ;;;###begin dired-ins.el
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3451
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3452 (defun dired-maybe-insert-subdir (dirname &optional
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3453 switches no-error-if-not-dir-p)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3454 "Insert this subdirectory into the same dired buffer.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3455 If it is already present, just move to it (type \\[dired-do-redisplay] to refresh),
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3456 else inserts it at its natural place (as ls -lR would have done).
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3457 With a prefix arg, you may edit the ls switches used for this listing.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3458 You can add `R' to the switches to expand the whole tree starting at
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3459 this subdirectory.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3460 This function takes some pains to conform to ls -lR output."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3461 (interactive
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3462 (list (dired-get-filename)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3463 (if current-prefix-arg
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3464 (read-string "Switches for listing: " dired-actual-switches))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3465 (let ((opoint (point)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3466 ;; We don't need a marker for opoint as the subdir is always
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3467 ;; inserted *after* opoint.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3468 (setq dirname (file-name-as-directory dirname))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3469 (or (and (not switches)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3470 (dired-goto-subdir dirname))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3471 (dired-insert-subdir dirname switches no-error-if-not-dir-p))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3472 ;; Push mark so that it's easy to find back. Do this after the
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3473 ;; insert message so that the user sees the `Mark set' message.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3474 (push-mark opoint)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3475
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3476 (defun dired-insert-subdir (dirname &optional switches no-error-if-not-dir-p)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3477 "Insert this subdirectory into the same dired buffer.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3478 If it is already present, overwrites previous entry,
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3479 else inserts it at its natural place (as ls -lR would have done).
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3480 With a prefix arg, you may edit the ls switches used for this listing.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3481 You can add `R' to the switches to expand the whole tree starting at
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3482 this subdirectory.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3483 This function takes some pains to conform to ls -lR output."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3484 ;; NO-ERROR-IF-NOT-DIR-P needed for special filesystems like
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3485 ;; Prospero where dired-ls does the right thing, but
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3486 ;; file-directory-p has not been redefined.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3487 (interactive
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3488 (list (dired-get-filename)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3489 (if current-prefix-arg
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3490 (read-string "Switches for listing: " dired-actual-switches))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3491 (setq dirname (file-name-as-directory (expand-file-name dirname)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3492 (dired-insert-subdir-validate dirname switches)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3493 (or no-error-if-not-dir-p
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3494 (file-directory-p dirname)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3495 (error "Attempt to insert a non-directory: %s" dirname))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3496 (let ((elt (assoc dirname dired-subdir-alist))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3497 switches-have-R mark-alist case-fold-search buffer-read-only)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3498 ;; case-fold-search is nil now, so we can test for capital `R':
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3499 (if (setq switches-have-R (and switches (string-match "R" switches)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3500 ;; avoid duplicated subdirs
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3501 (setq mark-alist (dired-kill-tree dirname t)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3502 (if elt
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3503 ;; If subdir is already present, remove it and remember its marks
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3504 (setq mark-alist (nconc (dired-insert-subdir-del elt) mark-alist))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3505 (dired-insert-subdir-newpos dirname)) ; else compute new position
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3506 (dired-insert-subdir-doupdate
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3507 dirname elt (dired-insert-subdir-doinsert dirname switches))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3508 (if switches-have-R (dired-build-subdir-alist))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3509 (dired-initial-position dirname)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3510 (save-excursion (dired-mark-remembered mark-alist))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3511
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3512 ;; This is a separate function for dired-vms.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3513 (defun dired-insert-subdir-validate (dirname &optional switches)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3514 ;; Check that it is valid to insert DIRNAME with SWITCHES.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3515 ;; Signal an error if invalid (e.g. user typed `i' on `..').
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3516 (or (dired-in-this-tree dirname default-directory)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3517 (error "%s: not in this directory tree" dirname))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3518 (if switches
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3519 (let (case-fold-search)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3520 (mapcar
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3521 (function
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3522 (lambda (x)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3523 (or (eq (null (string-match x switches))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3524 (null (string-match x dired-actual-switches)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3525 (error "Can't have dirs with and without -%s switches together"
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3526 x))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3527 ;; all switches that make a difference to dired-get-filename:
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3528 '("F" "b")))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3529
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3530 (defun dired-kill-tree (dirname &optional remember-marks)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3531 ;;"Kill all proper subdirs of DIRNAME, excluding DIRNAME itself.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3532 ;; With optional arg REMEMBER-MARKS, return an alist of marked files."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3533 (interactive "DKill tree below directory: ")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3534 (let ((s-alist dired-subdir-alist) dir m-alist)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3535 (while s-alist
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3536 (setq dir (car (car s-alist))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3537 s-alist (cdr s-alist))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3538 (if (and (not (string-equal dir dirname))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3539 (dired-in-this-tree dir dirname)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3540 (dired-goto-subdir dir))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3541 (setq m-alist (nconc (dired-kill-subdir remember-marks) m-alist))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3542 m-alist))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3543
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3544 (defun dired-insert-subdir-newpos (new-dir)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3545 ;; Find pos for new subdir, according to tree order.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3546 (let ((alist dired-subdir-alist) elt dir pos new-pos)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3547 (while alist
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3548 (setq elt (car alist)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3549 alist (cdr alist)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3550 dir (car elt)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3551 pos (dired-get-subdir-min elt))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3552 (if (dired-tree-lessp dir new-dir)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3553 ;; Insert NEW-DIR after DIR
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3554 (setq new-pos (dired-get-subdir-max elt)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3555 alist nil)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3556 (goto-char new-pos))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3557 ;; want a separating newline between subdirs
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3558 (or (eobp)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3559 (forward-line -1))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3560 (insert "\n")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3561 (point))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3562
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3563 (defun dired-insert-subdir-del (element)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3564 ;; Erase an already present subdir (given by ELEMENT) from buffer.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3565 ;; Move to that buffer position. Return a mark-alist.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3566 (let ((begin-marker (dired-get-subdir-min element)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3567 (goto-char begin-marker)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3568 ;; Are at beginning of subdir (and inside it!). Now determine its end:
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3569 (goto-char (dired-subdir-max))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3570 (or (eobp);; want a separating newline _between_ subdirs:
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3571 (forward-char -1))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3572 (prog1
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3573 (dired-remember-marks begin-marker (point))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3574 (delete-region begin-marker (point)))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3575
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3576 (defun dired-insert-subdir-doinsert (dirname switches)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3577 ;; Insert ls output after point and put point on the correct
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3578 ;; position for the subdir alist.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3579 ;; Return the boundary of the inserted text (as list of BEG and END).
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3580 (let ((begin (point)) end)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3581 (message "Reading directory %s..." dirname)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3582 (let ((dired-actual-switches
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3583 (or switches
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3584 (dired-replace-in-string "R" "" dired-actual-switches))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3585 (if (equal dirname (car (car (reverse dired-subdir-alist))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3586 ;; top level directory may contain wildcards:
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3587 (dired-readin-insert dired-directory)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3588 (dired-ls dirname dired-actual-switches nil t)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3589 (message "Reading directory %s...done" dirname)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3590 (setq end (point-marker))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3591 (dired-indent-rigidly begin end 2)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3592 ;; call dired-insert-headerline afterwards, as under VMS dired-ls
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3593 ;; does insert the headerline itself and the insert function just
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3594 ;; moves point.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3595 ;; Need a marker for END as this inserts text.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3596 (goto-char begin)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3597 (dired-insert-headerline dirname)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3598 ;; point is now like in dired-build-subdir-alist
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3599 (prog1
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3600 (list begin (marker-position end))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3601 (set-marker end nil))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3602
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3603 (defun dired-insert-subdir-doupdate (dirname elt beg-end)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3604 ;; Point is at the correct subdir alist position for ELT,
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3605 ;; BEG-END is the subdir-region (as list of begin and end).
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3606 (if elt ; subdir was already present
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3607 ;; update its position (should actually be unchanged)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3608 (set-marker (dired-get-subdir-min elt) (point-marker))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3609 (dired-alist-add dirname (point-marker)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3610 ;; The hook may depend on the subdir-alist containing the just
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3611 ;; inserted subdir, so run it after dired-alist-add:
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3612 (if dired-after-readin-hook
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3613 (save-excursion
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3614 (let ((begin (nth 0 beg-end))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3615 (end (nth 1 beg-end)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3616 (goto-char begin)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3617 (save-restriction
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3618 (narrow-to-region begin end)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3619 ;; hook may add or delete lines, but the subdir boundary
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3620 ;; marker floats
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3621 (run-hooks 'dired-after-readin-hook))))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3622
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3623 (defun dired-tree-lessp (dir1 dir2)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3624 ;; Lexicographic order on pathname components, like `ls -lR':
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3625 ;; DIR1 < DIR2 iff DIR1 comes *before* DIR2 in an `ls -lR' listing,
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3626 ;; i.e., iff DIR1 is a (grand)parent dir of DIR2,
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3627 ;; or DIR1 and DIR2 are in the same parentdir and their last
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3628 ;; components are string-lessp.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3629 ;; Thus ("/usr/" "/usr/bin") and ("/usr/a/" "/usr/b/") are tree-lessp.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3630 ;; string-lessp could arguably be replaced by file-newer-than-file-p
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3631 ;; if dired-actual-switches contained `t'.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3632 (setq dir1 (file-name-as-directory dir1)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3633 dir2 (file-name-as-directory dir2))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3634 (let ((components-1 (dired-split "/" dir1))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3635 (components-2 (dired-split "/" dir2)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3636 (while (and components-1
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3637 components-2
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3638 (equal (car components-1) (car components-2)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3639 (setq components-1 (cdr components-1)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3640 components-2 (cdr components-2)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3641 (let ((c1 (car components-1))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3642 (c2 (car components-2)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3643
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3644 (cond ((and c1 c2)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3645 (string-lessp c1 c2))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3646 ((and (null c1) (null c2))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3647 nil) ; they are equal, not lessp
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3648 ((null c1) ; c2 is a subdir of c1: c1<c2
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3649 t)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3650 ((null c2) ; c1 is a subdir of c2: c1>c2
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3651 nil)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3652 (t (error "This can't happen"))))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3653
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3654 ;; There should be a builtin split function - inverse to mapconcat.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3655 (defun dired-split (pat str &optional limit)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3656 "Splitting on regexp PAT, turn string STR into a list of substrings.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3657 Optional third arg LIMIT (>= 1) is a limit to the length of the
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3658 resulting list.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3659 Thus, if SEP is a regexp that only matches itself,
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3660
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3661 (mapconcat 'identity (dired-split SEP STRING) SEP)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3662
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3663 is always equal to STRING."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3664 (let* ((start (string-match pat str))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3665 (result (list (substring str 0 start)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3666 (count 1)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3667 (end (if start (match-end 0))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3668 (if end ; else nothing left
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3669 (while (and (or (not (integerp limit))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3670 (< count limit))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3671 (string-match pat str end))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3672 (setq start (match-beginning 0)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3673 count (1+ count)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3674 result (cons (substring str end start) result)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3675 end (match-end 0)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3676 start end)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3677 ))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3678 (if (and (or (not (integerp limit))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3679 (< count limit))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3680 end) ; else nothing left
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3681 (setq result
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3682 (cons (substring str end) result)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3683 (nreverse result)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3684
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3685 (defun dired-indent-rigidly (start end arg)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3686 ;; like indent-rigidly but has more efficient behavior w.r.t. the
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3687 ;; after-change-functions (i.e., font-lock-mode.)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3688 (save-excursion
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3689 (let ((after-change-functions nil)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3690 (after-change-function nil))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3691 (goto-char end)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3692 (indent-rigidly start end arg))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3693 ;; deletion
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3694 (run-hook-with-args 'after-change-functions start start (- end start))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3695 (run-hook-with-args 'after-change-function start start (- end start))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3696 ;; insertion
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3697 (run-hook-with-args 'after-change-functions start (point) 0)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3698 (run-hook-with-args 'after-change-function start (point) 0)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3699 ))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3700
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3701 (if (string-lessp emacs-version "19")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3702 (fset 'dired-indent-rigidly (symbol-function 'indent-rigidly)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3703
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3704 ;;;###end dired-ins.el
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3705
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3706
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3707 ;;; Sorting
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3708
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3709 ;; Most ls can only sort by name or by date (with -t), nothing else.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3710 ;; GNU ls sorts on size with -S, on extension with -X, and unsorted with -U.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3711 ;; So anything that does not contain these is sort "by name".
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3712
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3713 (defvar dired-ls-sorting-switches "SXU"
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3714 "String of ls switches (single letters) except `t' that influence sorting.")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3715
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3716 (defvar dired-sort-by-date-regexp
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3717 (concat "^-[^" dired-ls-sorting-switches
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3718 "]*t[^" dired-ls-sorting-switches "]*$")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3719 "Regexp recognized by dired to set `by date' mode.")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3720
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3721 (defvar dired-sort-by-name-regexp
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3722 (concat "^-[^t" dired-ls-sorting-switches "]+$")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3723 "Regexp recognized by dired to set `by name' mode.")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3724
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3725 (defvar dired-sort-mode nil
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3726 "Whether Dired sorts by name, date etc. (buffer-local).")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3727 ;; This is nil outside dired buffers so it can be used in the modeline
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3728
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3729 (defun dired-sort-set-modeline ()
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3730 ;; Set modeline display according to dired-actual-switches.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3731 ;; Modeline display of "by name" or "by date" guarantees the user a
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3732 ;; match with the corresponding regexps. Non-matching switches are
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3733 ;; shown literally.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3734 (setq dired-sort-mode
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3735 (let (case-fold-search)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3736 (cond ((string-match dired-sort-by-name-regexp dired-actual-switches)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3737 " by name")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3738 ((string-match dired-sort-by-date-regexp dired-actual-switches)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3739 " by date")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3740 (t
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3741 (concat " " dired-actual-switches)))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3742 ;; update mode line:
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3743 (set-buffer-modified-p (buffer-modified-p)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3744
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3745 (defun dired-sort-toggle-or-edit (&optional arg)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3746 "Toggle between sort by date/name and refresh the dired buffer.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3747 With a prefix argument you can edit the current listing switches instead."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3748 (interactive "P")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3749 (if arg
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3750 (dired-sort-other
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3751 (read-string "ls switches (must contain -l): " dired-actual-switches))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3752 (dired-sort-toggle)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3753
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3754 (defun dired-sort-toggle ()
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3755 ;; Toggle between sort by date/name. Reverts the buffer.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3756 (setq dired-actual-switches
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3757 (let (case-fold-search)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3758 (concat
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3759 "-l"
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3760 (dired-replace-in-string (concat "[---lt"
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3761 dired-ls-sorting-switches "]")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3762 ""
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3763 dired-actual-switches)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3764 (if (string-match (concat "[t" dired-ls-sorting-switches "]")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3765 dired-actual-switches)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3766 ""
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3767 "t"))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3768 (dired-sort-set-modeline)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3769 (revert-buffer))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3770
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3771 (defun dired-sort-other (switches &optional no-revert)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3772 ;; Specify new ls SWITCHES for current dired buffer. Values matching
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3773 ;; `dired-sort-by-date-regexp' or `dired-sort-by-name-regexp' set the
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3774 ;; minor mode accordingly, others appear literally in the mode line.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3775 ;; With optional second arg NO-REVERT, don't refresh the listing afterwards.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3776 (setq dired-actual-switches switches)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3777 (dired-sort-set-modeline)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3778 (or no-revert (revert-buffer)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3779
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3780 (if (eq system-type 'vax-vms)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3781 (load "dired-vms"))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3782
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3783 (if (string-match "XEmacs" emacs-version)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3784 (load "dired-xemacs-menu"))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3785
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3786 (run-hooks 'dired-load-hook) ; for your customizations