![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to dired.el CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Apple XNU] / GNUtools / emacs / lisp|
Return to dired.el CVS log | Up to [Apple XNU] / GNUtools / emacs / lisp |
1.1 root 1: ;;; Missing: P command, sorting, setting file modes.
2: ;;; Dired buffer containing multiple directories gets totally confused
3: ;;; Implement insertion of subdirectories in situ --- tree dired
4:
5: ;; DIRED commands for Emacs
6: ;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.
7:
8: ;; This file is part of GNU Emacs.
9:
10: ;; GNU Emacs is free software; you can redistribute it and/or modify
11: ;; it under the terms of the GNU General Public License as published by
12: ;; the Free Software Foundation; either version 1, or (at your option)
13: ;; any later version.
14:
15: ;; GNU Emacs is distributed in the hope that it will be useful,
16: ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17: ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18: ;; GNU General Public License for more details.
19:
20: ;; You should have received a copy of the GNU General Public License
21: ;; along with GNU Emacs; see the file COPYING. If not, write to
22: ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
23:
24:
25: ;In loaddefs.el
26: ;(defvar dired-listing-switches "-al"
27: ; "Switches passed to ls for dired. MUST contain the 'l' option.
28: ;CANNOT contain the 'F' option.")
29:
30: (defun dired-readin (dirname buffer)
31: (save-excursion
32: (message "Reading directory %s..." dirname)
33: (set-buffer buffer)
34: (let ((buffer-read-only nil))
35: (widen)
36: (erase-buffer)
37: (setq dirname (expand-file-name dirname))
38: (if (file-directory-p dirname)
39: (call-process "ls" nil buffer nil
40: dired-listing-switches dirname)
41: (let ((default-directory (file-name-directory dirname)))
42: (call-process shell-file-name nil buffer nil
43: "-c" (concat "ls " dired-listing-switches " "
44: (file-name-nondirectory dirname)))))
45: (goto-char (point-min))
46: (while (not (eobp))
47: (insert " ")
48: (forward-line 1))
49: (goto-char (point-min)))
50: (set-buffer-modified-p nil)
51: (message "Reading directory %s...done" dirname)))
52:
53: (defun dired-find-buffer (dirname)
54: (let ((blist (buffer-list))
55: found)
56: (while blist
57: (save-excursion
58: (set-buffer (car blist))
59: (if (and (eq major-mode 'dired-mode)
60: (equal dired-directory dirname))
61: (setq found (car blist)
62: blist nil)
63: (setq blist (cdr blist)))))
64: (or found
65: (create-file-buffer (directory-file-name dirname)))))
66:
67: (defun dired (dirname)
68: "\"Edit\" directory DIRNAME--delete, rename, print, etc. some files in it.
69: Dired displays a list of files in DIRNAME.
70: You can move around in it with the usual commands.
71: You can flag files for deletion with C-d
72: and then delete them by typing `x'.
73: Type `h' after entering dired for more info."
74: (interactive (list (read-file-name "Dired (directory): "
75: nil default-directory nil)))
76: (switch-to-buffer (dired-noselect dirname)))
77:
78: (defun dired-other-window (dirname)
79: "\"Edit\" directory DIRNAME. Like M-x dired but selects in another window."
80: (interactive (list (read-file-name "Dired in other window (directory): "
81: nil default-directory nil)))
82: (switch-to-buffer-other-window (dired-noselect dirname)))
83:
84: (defun dired-noselect (dirname)
85: "Like M-x dired but returns the dired buffer as value, does not select it."
86: (or dirname (setq dirname default-directory))
87: (setq dirname (expand-file-name (directory-file-name dirname)))
88: (if (file-directory-p dirname)
89: (setq dirname (file-name-as-directory dirname)))
90: (let ((buffer (dired-find-buffer dirname)))
91: (save-excursion
92: (set-buffer buffer)
93: (dired-readin dirname buffer)
94: (dired-move-to-filename)
95: (dired-mode dirname))
96: buffer))
97:
98: (defun dired-revert (&optional arg noconfirm)
99: (let ((opoint (point))
100: (ofile (dired-get-filename t t))
101: (buffer-read-only nil))
102: (erase-buffer)
103: (dired-readin dired-directory (current-buffer))
104: (or (and ofile (re-search-forward (concat " " (regexp-quote ofile) "$")
105: nil t))
106: (goto-char opoint))
107: (beginning-of-line)))
108:
109: (defvar dired-mode-map nil "Local keymap for dired-mode buffers.")
110: (if dired-mode-map
111: nil
112: (setq dired-mode-map (make-keymap))
113: (suppress-keymap dired-mode-map)
114: (define-key dired-mode-map "r" 'dired-rename-file)
115: (define-key dired-mode-map "\C-d" 'dired-flag-file-deleted)
116: (define-key dired-mode-map "d" 'dired-flag-file-deleted)
117: (define-key dired-mode-map "v" 'dired-view-file)
118: (define-key dired-mode-map "e" 'dired-find-file)
119: (define-key dired-mode-map "f" 'dired-find-file)
120: (define-key dired-mode-map "o" 'dired-find-file-other-window)
121: (define-key dired-mode-map "u" 'dired-unflag)
122: (define-key dired-mode-map "x" 'dired-do-deletions)
123: (define-key dired-mode-map "\177" 'dired-backup-unflag)
124: (define-key dired-mode-map "?" 'dired-summary)
125: (define-key dired-mode-map "c" 'dired-copy-file)
126: (define-key dired-mode-map "#" 'dired-flag-auto-save-files)
127: (define-key dired-mode-map "~" 'dired-flag-backup-files)
128: (define-key dired-mode-map "." 'dired-clean-directory)
129: (define-key dired-mode-map "h" 'describe-mode)
130: (define-key dired-mode-map " " 'dired-next-line)
131: (define-key dired-mode-map "\C-n" 'dired-next-line)
132: (define-key dired-mode-map "\C-p" 'dired-previous-line)
133: (define-key dired-mode-map "n" 'dired-next-line)
134: (define-key dired-mode-map "p" 'dired-previous-line)
135: (define-key dired-mode-map "g" 'revert-buffer)
136: (define-key dired-mode-map "C" 'dired-compress)
137: (define-key dired-mode-map "U" 'dired-uncompress)
138: (define-key dired-mode-map "B" 'dired-byte-recompile)
139: (define-key dired-mode-map "M" 'dired-chmod)
140: (define-key dired-mode-map "G" 'dired-chgrp)
141: (define-key dired-mode-map "O" 'dired-chown))
142:
143:
144: ;; Dired mode is suitable only for specially formatted data.
145: (put 'dired-mode 'mode-class 'special)
146:
147: (defun dired-mode (&optional dirname)
148: "Mode for \"editing\" directory listings.
149: In dired, you are \"editing\" a list of the files in a directory.
150: You can move using the usual cursor motion commands.
151: Letters no longer insert themselves.
152: Instead, type d to flag a file for Deletion.
153: Type u to Unflag a file (remove its D flag).
154: Type Rubout to back up one line and unflag.
155: Type x to eXecute the deletions requested.
156: Type f to Find the current line's file
157: (or Dired it, if it is a directory).
158: Type o to find file or dired directory in Other window.
159: Type # to flag temporary files (names beginning with #) for Deletion.
160: Type ~ to flag backup files (names ending with ~) for Deletion.
161: Type . to flag numerical backups for Deletion.
162: (Spares dired-kept-versions or its numeric argument.)
163: Type r to rename a file.
164: Type c to copy a file.
165: Type v to view a file in View mode, returning to Dired when done.
166: Type g to read the directory again. This discards all deletion-flags.
167: Space and Rubout can be used to move down and up by lines.
168: Also: C -- compress this file. U -- uncompress this file.
169: B -- byte compile this file.
170: M, G, O -- change file's mode, group or owner.
171: \\{dired-mode-map}"
172: (interactive)
173: (kill-all-local-variables)
174: (make-local-variable 'revert-buffer-function)
175: (setq revert-buffer-function 'dired-revert)
176: (setq major-mode 'dired-mode)
177: (setq mode-name "Dired")
178: (make-local-variable 'dired-directory)
179: (setq dired-directory (or dirname default-directory))
180: (if dirname
181: (setq default-directory
182: (if (file-directory-p dirname)
183: dirname (file-name-directory dirname))))
184: (setq mode-line-buffer-identification '("Dired: %17b"))
185: (setq case-fold-search nil)
186: (setq buffer-read-only t)
187: (use-local-map dired-mode-map)
188: (run-hooks 'dired-mode-hook))
189:
190: (defun dired-repeat-over-lines (arg function)
191: (beginning-of-line)
192: (while (and (> arg 0) (not (eobp)))
193: (setq arg (1- arg))
194: (save-excursion
195: (beginning-of-line)
196: (and (bobp) (looking-at " total")
197: (error "No file on this line"))
198: (funcall function))
199: (forward-line 1)
200: (dired-move-to-filename))
201: (while (and (< arg 0) (not (bobp)))
202: (setq arg (1+ arg))
203: (forward-line -1)
204: (dired-move-to-filename)
205: (save-excursion
206: (beginning-of-line)
207: (funcall function))))
208:
209: (defun dired-flag-file-deleted (arg)
210: "In dired, flag the current line's file for deletion.
211: With arg, repeat over several lines."
212: (interactive "p")
213: (dired-repeat-over-lines arg
214: '(lambda ()
215: (let ((buffer-read-only nil))
216: (delete-char 1)
217: (insert "D")))))
218:
219: (defun dired-summary ()
220: (interactive)
221: ;>> this should check the key-bindings and use substitute-command-keys if non-standard
222: (message
223: "d-elete, u-ndelete, x-ecute, f-ind, o-ther window, r-ename, c-opy, v-iew"))
224:
225: (defun dired-unflag (arg)
226: "In dired, remove the current line's delete flag then move to next line."
227: (interactive "p")
228: (dired-repeat-over-lines arg
229: '(lambda ()
230: (let ((buffer-read-only nil))
231: (delete-char 1)
232: (insert " ")
233: (forward-char -1)))))
234:
235: (defun dired-backup-unflag (arg)
236: "In dired, move up a line and remove deletion flag there."
237: (interactive "p")
238: (dired-unflag (- arg)))
239:
240: (defun dired-next-line (arg)
241: "Move down ARG lines then position at filename."
242: (interactive "p")
243: (next-line arg)
244: (dired-move-to-filename))
245:
246: (defun dired-previous-line (arg)
247: "Move up ARG lines then position at filename."
248: (interactive "p")
249: (previous-line arg)
250: (dired-move-to-filename))
251:
252: (defun dired-find-file ()
253: "In dired, visit the file or directory named on this line."
254: (interactive)
255: (find-file (dired-get-filename)))
256:
257: (defun dired-view-file ()
258: "In dired, examine a file in view mode, returning to dired when done."
259: (interactive)
260: (if (file-directory-p (dired-get-filename))
261: (dired (dired-get-filename))
262: (view-file (dired-get-filename))))
263:
264: (defun dired-find-file-other-window ()
265: "In dired, visit this file or directory in another window."
266: (interactive)
267: (find-file-other-window (dired-get-filename)))
268:
269: (defun dired-get-filename (&optional localp no-error-if-not-filep)
270: "In dired, return name of file mentioned on this line.
271: Value returned normally includes the directory name.
272: A non-nil 1st argument means do not include it. A non-nil 2nd argument
273: says return nil if no filename on this line, otherwise an error occurs."
274: (let (eol)
275: (save-excursion
276: (end-of-line)
277: (setq eol (point))
278: (beginning-of-line)
279: (if (re-search-forward
280: "\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct\\|Nov\\|Dec\\)[ ]+[0-9]+"
281: eol t)
282: (progn (skip-chars-forward " ")
283: (skip-chars-forward "^ " eol)
284: (skip-chars-forward " " eol)
285: (let ((beg (point)))
286: (skip-chars-forward "^ \n")
287: (if localp
288: (buffer-substring beg (point))
289: ;; >> uses default-directory, could lose on cd, multiple.
290: (concat default-directory (buffer-substring beg (point))))))
291: (if no-error-if-not-filep nil
292: (error "No file on this line"))))))
293:
294: (defun dired-move-to-filename ()
295: "In dired, move to first char of filename on this line.
296: Returns position (point) or nil if no filename on this line."
297: (let ((eol (progn (end-of-line) (point))))
298: (beginning-of-line)
299: (if (re-search-forward
300: "\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct\\|Nov\\|Dec\\)[ ]+[0-9]+"
301: eol t)
302: (progn
303: (skip-chars-forward " ")
304: (skip-chars-forward "^ " eol)
305: (skip-chars-forward " " eol)
306: (point)))))
307:
308: (defun dired-map-dired-file-lines (fn)
309: "perform fn with point at the end of each non-directory line:
310: arguments are the short and long filename"
311: (save-excursion
312: (let (filename longfilename (buffer-read-only nil))
313: (goto-char (point-min))
314: (while (not (eobp))
315: (save-excursion
316: (and (not (looking-at " d"))
317: (not (eolp))
318: (setq filename (dired-get-filename t t)
319: longfilename (dired-get-filename nil t))
320: (progn (end-of-line)
321: (funcall fn filename longfilename))))
322: (forward-line 1)))))
323:
324: (defun dired-flag-auto-save-files ()
325: "Flag for deletion files whose names suggest they are auto save files."
326: (interactive)
327: (save-excursion
328: (let ((buffer-read-only nil))
329: (goto-char (point-min))
330: (while (not (eobp))
331: (and (not (looking-at " d"))
332: (not (eolp))
333: (if (fboundp 'auto-save-file-name-p)
334: (let ((fn (dired-get-filename t t)))
335: (if fn (auto-save-file-name-p fn)))
336: (if (dired-move-to-filename)
337: (looking-at "#")))
338: (progn (beginning-of-line)
339: (delete-char 1)
340: (insert "D")))
341: (forward-line 1)))))
342:
343: (defun dired-clean-directory (keep)
344: "Flag numerical backups for Deletion.
345: Spares dired-kept-versions latest versions, and kept-old-versions oldest.
346: Positive numeric arg overrides dired-kept-versions;
347: negative numeric arg overrides kept-old-versions with minus the arg."
348: (interactive "P")
349: (setq keep (if keep (prefix-numeric-value keep) dired-kept-versions))
350: (let ((early-retention (if (< keep 0) (- keep) kept-old-versions))
351: (late-retention (if (<= keep 0) dired-kept-versions keep))
352: (file-version-assoc-list ()))
353: ;; Look at each file.
354: ;; If the file has numeric backup versions,
355: ;; put on file-version-assoc-list an element of the form
356: ;; (FILENAME . VERSION-NUMBER-LIST)
357: (dired-map-dired-file-lines 'dired-collect-file-versions)
358: ;; Sort each VERSION-NUMBER-LIST,
359: ;; and remove the versions not to be deleted.
360: (let ((fval file-version-assoc-list))
361: (while fval
362: (let* ((sorted-v-list (cons 'q (sort (cdr (car fval)) '<)))
363: (v-count (length sorted-v-list)))
364: (if (> v-count (+ early-retention late-retention))
365: (rplacd (nthcdr early-retention sorted-v-list)
366: (nthcdr (- v-count late-retention)
367: sorted-v-list)))
368: (rplacd (car fval)
369: (cdr sorted-v-list)))
370: (setq fval (cdr fval))))
371: ;; Look at each file. If it is a numeric backup file,
372: ;; find it in a VERSION-NUMBER-LIST and maybe flag it for deletion.
373: (dired-map-dired-file-lines 'dired-trample-file-versions)))
374:
375: (defun dired-collect-file-versions (ignore fn)
376: "If it looks like fn has versions, we make a list of the versions.
377: We may want to flag some for deletion."
378: (let* ((base-versions
379: (concat (file-name-nondirectory fn) ".~"))
380: (bv-length (length base-versions))
381: (possibilities (file-name-all-completions
382: base-versions
383: (file-name-directory fn)))
384: (versions (mapcar 'backup-extract-version possibilities)))
385: (if versions
386: (setq file-version-assoc-list (cons (cons fn versions)
387: file-version-assoc-list)))))
388:
389: (defun dired-trample-file-versions (ignore fn)
390: (let* ((start-vn (string-match "\\.~[0-9]+~$" fn))
391: base-version-list)
392: (and start-vn
393: (setq base-version-list ; there was a base version to which
394: (assoc (substring fn 0 start-vn) ; this looks like a
395: file-version-assoc-list)) ; subversion
396: (not (memq (string-to-int (substring fn (+ 2 start-vn)))
397: base-version-list)) ; this one doesn't make the cut
398: (dired-flag-this-line-for-DEATH))))
399:
400: (defun dired-flag-this-line-for-DEATH ()
401: (beginning-of-line)
402: (delete-char 1)
403: (insert "D"))
404:
405: (defun dired-flag-backup-files ()
406: "Flag all backup files (names ending with ~) for deletion."
407: (interactive)
408: (save-excursion
409: (let ((buffer-read-only nil))
410: (goto-char (point-min))
411: (while (not (eobp))
412: (and (not (looking-at " d"))
413: (not (eolp))
414: (if (fboundp 'backup-file-name-p)
415: (let ((fn (dired-get-filename t t)))
416: (if fn (backup-file-name-p fn)))
417: (end-of-line)
418: (forward-char -1)
419: (looking-at "~"))
420: (progn (beginning-of-line)
421: (delete-char 1)
422: (insert "D")))
423: (forward-line 1)))))
424:
425: (defun dired-flag-backup-and-auto-save-files ()
426: "Flag all backup and temporary files for deletion.
427: Backup files have names ending in ~. Auto save file names usually
428: start with #."
429: (interactive)
430: (dired-flag-backup-files)
431: (dired-flag-auto-save-files))
432:
433: (defun dired-rename-file (to-file)
434: "Rename this file to TO-FILE."
435: (interactive
436: (list (read-file-name (format "Rename %s to: "
437: (file-name-nondirectory (dired-get-filename)))
438: nil (dired-get-filename))))
439: (setq to-file (expand-file-name to-file))
440: (rename-file (dired-get-filename) to-file)
441: (let ((buffer-read-only nil))
442: (beginning-of-line)
443: (delete-region (point) (progn (forward-line 1) (point)))
444: (setq to-file (expand-file-name to-file))
445: (dired-add-entry (file-name-directory to-file)
446: (file-name-nondirectory to-file))))
447:
448: (defun dired-copy-file (to-file)
449: "Copy this file to TO-FILE."
450: (interactive "FCopy to: ")
451: (copy-file (dired-get-filename) to-file)
452: (setq to-file (expand-file-name to-file))
453: (dired-add-entry (file-name-directory to-file)
454: (file-name-nondirectory to-file)))
455:
456: (defun dired-add-entry (directory filename)
457: ;; If tree dired is implemented, this function will have to do
458: ;; something smarter with the directory. Currently, just check
459: ;; default directory, if same, add the new entry at point. With tree
460: ;; dired, should call 'dired-current-directory' or similar. Note
461: ;; that this adds the entry 'out of order' if files sorted by time,
462: ;; etc.
463: (if (string-equal directory default-directory)
464: (let ((buffer-read-only nil))
465: (beginning-of-line)
466: (call-process "ls" nil t nil
467: "-d" dired-listing-switches (concat directory filename))
468: (forward-line -1)
469: (insert " ")
470: (dired-move-to-filename)
471: (let* ((beg (point))
472: (end (progn (end-of-line) (point))))
473: (setq filename (buffer-substring beg end))
474: (delete-region beg end)
475: (insert (file-name-nondirectory filename)))
476: (beginning-of-line))))
477:
478: (defun dired-compress ()
479: "Compress this file."
480: (interactive)
481: (let* ((buffer-read-only nil)
482: (error-buffer (get-buffer-create " *Dired compress output*"))
483: (from-file (dired-get-filename))
484: (to-file (concat from-file ".Z")))
485: (if (string-match "\\.Z$" from-file)
486: (error "%s is already compressed!" from-file))
487: (message "Compressing %s..." from-file)
488: (unwind-protect
489: (progn
490: (save-excursion
491: (set-buffer error-buffer)
492: (erase-buffer))
493: ;; Must have default-directory of dired buffer in call-process
494: (call-process "compress" nil error-buffer nil "-f" from-file)
495: (if (save-excursion
496: (set-buffer error-buffer)
497: (= 0 (buffer-size)))
498: (progn
499: (message "Compressing %s... done" from-file)
500: (kill-buffer error-buffer))
501: (display-buffer error-buffer)
502: (setq error-buffer nil)
503: (error "Compress error on %s." from-file)))
504: (if error-buffer (kill-buffer error-buffer)))
505: (dired-redisplay to-file)))
506:
507: (defun dired-uncompress ()
508: "Uncompress this file."
509: (interactive)
510: (let* ((buffer-read-only nil)
511: (error-buffer (get-buffer-create " *Dired compress output*"))
512: (from-file (dired-get-filename))
513: (to-file (substring from-file 0 -2)))
514: (if (string-match "\\.Z$" from-file) nil
515: (error "%s is not compressed!" from-file))
516: (message "Uncompressing %s..." from-file)
517: (unwind-protect
518: (progn
519: (save-excursion
520: (set-buffer error-buffer)
521: (erase-buffer))
522: ;; Must have default-directory of dired buffer in call-process
523: (call-process "uncompress" nil error-buffer nil "-f" from-file)
524: (if (save-excursion
525: (set-buffer error-buffer)
526: (= 0 (buffer-size)))
527: (progn
528: (message "Uncompressing %s... done" from-file)
529: (kill-buffer error-buffer))
530: (display-buffer error-buffer)
531: (setq error-buffer nil)
532: (error "Uncompress error on %s." from-file)))
533: (if error-buffer (kill-buffer error-buffer)))
534: (dired-redisplay to-file)))
535:
536: (defun dired-byte-recompile ()
537: "Byte recompile this file."
538: (interactive)
539: (let* ((buffer-read-only nil)
540: (from-file (dired-get-filename))
541: (to-file (substring from-file 0 -3)))
542: (if (string-match "\\.el$" from-file) nil
543: (error "%s is uncompilable!" from-file))
544: (byte-compile-file from-file)))
545:
546: (defun dired-chmod (mode)
547: "Change mode of this file."
548: (interactive "sChange to Mode: ")
549: (let ((buffer-read-only nil)
550: (file (dired-get-filename)))
551: (call-process "/bin/chmod" nil nil nil mode file)
552: (dired-redisplay file)))
553:
554: (defun dired-chgrp (group)
555: "Change group of this file."
556: (interactive "sChange to Group: ")
557: (let ((buffer-read-only nil)
558: (file (dired-get-filename)))
559: (call-process "/bin/chgrp" nil nil nil group file)
560: (dired-redisplay file)))
561:
562: (defun dired-chown (owner)
563: "Change Owner of this file."
564: (interactive "sChange to Owner: ")
565: (let ((buffer-read-only nil)
566: (file (dired-get-filename)))
567: (call-process (if (memq system-type '(hpux usg-unix-v silicon-graphics-unix))
568: "/bin/chown" "/etc/chown")
569: nil nil nil owner file)
570: (dired-redisplay file)))
571:
572: (defun dired-redisplay (file) "Redisplay this line."
573: (beginning-of-line)
574: (delete-region (point) (progn (forward-line 1) (point)))
575: (if file (dired-add-entry (file-name-directory file)
576: (file-name-nondirectory file)))
577: (dired-move-to-filename))
578:
579: (defun dired-do-deletions ()
580: "In dired, delete the files flagged for deletion."
581: (interactive)
582: (let (delete-list answer)
583: (save-excursion
584: (goto-char 1)
585: (while (re-search-forward "^D" nil t)
586: (setq delete-list
587: (cons (cons (dired-get-filename t) (1- (point)))
588: delete-list))))
589: (if (null delete-list)
590: (message "(No deletions requested)")
591: (save-window-excursion
592: (switch-to-buffer " *Deletions*")
593: (erase-buffer)
594: (setq fill-column 70)
595: (let ((l (reverse delete-list)))
596: ;; Files should be in forward order for this loop.
597: (while l
598: (if (> (current-column) 59)
599: (insert ?\n)
600: (or (bobp)
601: (indent-to (* (/ (+ (current-column) 19) 20) 20) 1)))
602: (insert (car (car l)))
603: (setq l (cdr l))))
604: (goto-char (point-min))
605: (setq answer (yes-or-no-p "Delete these files? ")))
606: (if answer
607: (let ((l delete-list)
608: failures)
609: ;; Files better be in reverse order for this loop!
610: ;; That way as changes are made in the buffer
611: ;; they do not shift the lines still to be changed.
612: (while l
613: (goto-char (cdr (car l)))
614: (let ((buffer-read-only nil))
615: (condition-case ()
616: (let ((fn (concat default-directory (car (car l)))))
617: (if (file-directory-p fn)
618: ;; This used to call delete-file if rmdir
619: ;; did not delete the file,
620: ;; but that made it too easy for root to spaz.
621: (call-process "rmdir" nil nil nil fn)
622: (delete-file fn))
623: (delete-region (point)
624: (progn (forward-line 1) (point))))
625: (error (delete-char 1)
626: (insert " ")
627: (setq failures (cons (car (car l)) failures)))))
628: (setq l (cdr l)))
629: (if failures
630: (message "Deletions failed: %s"
631: (prin1-to-string failures))))))))
632:
633: (provide 'dired)
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.