![[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 [CSRG BSD Unix] / 43BSD / contrib / emacs / lisp|
Return to dired.el CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / 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 Richard M. Stallman.
7:
8: ;; This file is part of GNU Emacs.
9:
10: ;; GNU Emacs is distributed in the hope that it will be useful,
11: ;; but WITHOUT ANY WARRANTY. No author or distributor
12: ;; accepts responsibility to anyone for the consequences of using it
13: ;; or for whether it serves any particular purpose or works at all,
14: ;; unless he says so in writing. Refer to the GNU Emacs General Public
15: ;; License for full details.
16:
17: ;; Everyone is granted permission to copy, modify and redistribute
18: ;; GNU Emacs, but only under the conditions described in the
19: ;; GNU Emacs General Public License. A copy of this license is
20: ;; supposed to have been given to you along with GNU Emacs so you
21: ;; can know your rights and responsibilities. It should be in a
22: ;; file named COPYING. Among other things, the copyright notice
23: ;; and this notice must be preserved on all copies.
24:
25:
26: ;Will be in loaddefs.el for versions 16.2 and up.
27: ;(defvar dired-listing-switches "-al"
28: ; "Switches passed to ls for dired. MUST contain the 'l' option.
29: ;CANNOT contain the 'F' option.")
30:
31: (defun dired-readin (dirname buffer)
32: (save-excursion
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:
51: (defun dired-find-buffer (dirname)
52: (let ((blist (buffer-list))
53: found)
54: (while blist
55: (save-excursion
56: (set-buffer (car blist))
57: (if (and (eq major-mode 'dired-mode)
58: (equal dired-directory dirname))
59: (setq found (car blist)
60: blist nil)
61: (setq blist (cdr blist)))))
62: (or found
63: (progn (if (string-match "/$" dirname)
64: (setq dirname (substring dirname 0 -1)))
65: (create-file-buffer (file-name-nondirectory dirname))))))
66:
67: (defun dired (dirname)
68: "\"Edit\" directory DIRNAME. Delete 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: (if (string-match "./$" dirname)
88: (setq dirname (substring dirname 0 -1)))
89: (setq dirname (expand-file-name dirname))
90: (and (not (string-match "/$" dirname))
91: (file-directory-p dirname)
92: (setq dirname (concat dirname "/")))
93: (let ((buffer (dired-find-buffer dirname)))
94: (save-excursion
95: (set-buffer buffer)
96: (dired-readin dirname buffer)
97: (dired-move-to-filename)
98: (dired-mode dirname))
99: buffer))
100:
101: (defun dired-revert (&optional arg)
102: (let ((opoint (point))
103: (ofile (dired-get-filename t t))
104: (buffer-read-only nil))
105: (erase-buffer)
106: (dired-readin dired-directory (current-buffer))
107: (or (and ofile (re-search-forward (concat " " (regexp-quote ofile) "$") nil t))
108: (goto-char opoint))
109: (beginning-of-line)))
110:
111: (defvar dired-mode-map nil "Local keymap for dired-mode buffers.")
112: (if dired-mode-map
113: nil
114: (setq dired-mode-map (make-keymap))
115: (suppress-keymap dired-mode-map)
116: (define-key dired-mode-map "r" 'dired-rename-file)
117: (define-key dired-mode-map "\C-d" 'dired-flag-file-deleted)
118: (define-key dired-mode-map "d" 'dired-flag-file-deleted)
119: (define-key dired-mode-map "v" 'dired-view-file)
120: (define-key dired-mode-map "e" 'dired-find-file)
121: (define-key dired-mode-map "f" 'dired-find-file)
122: (define-key dired-mode-map "o" 'dired-find-file-other-window)
123: (define-key dired-mode-map "u" 'dired-unflag)
124: (define-key dired-mode-map "x" 'dired-do-deletions)
125: (define-key dired-mode-map "\177" 'dired-backup-unflag)
126: (define-key dired-mode-map "?" 'dired-summary)
127: (define-key dired-mode-map "c" 'dired-copy-file)
128: (define-key dired-mode-map "#" 'dired-flag-auto-save-files)
129: (define-key dired-mode-map "~" 'dired-flag-backup-files)
130: (define-key dired-mode-map "." 'dired-clean-directory)
131: (define-key dired-mode-map "h" 'describe-mode)
132: (define-key dired-mode-map " " 'dired-next-line)
133: (define-key dired-mode-map "\C-n" 'dired-next-line)
134: (define-key dired-mode-map "\C-p" 'dired-previous-line)
135: (define-key dired-mode-map "n" 'dired-next-line)
136: (define-key dired-mode-map "p" 'dired-previous-line))
137:
138: (defun dired-mode (dirname)
139: "Mode for \"editing\" directory listings.
140: In dired, you are \"editing\" a list of the files in a directory.
141: You can move using the usual cursor motion commands.
142: Letters no longer insert themselves.
143: Instead, type d to flag a file for Deletion.
144: Type u to Unflag a file (remove its D flag).
145: Type Rubout to back up one line and unflag.
146: Type x to eXecute the deletions requested.
147: Type f to Find the current line's file
148: (or Dired it, if it is a directory).
149: Type o to find file or dired directory in Other window.
150: Type # to flag temporary files (names beginning with #) for Deletion.
151: Type ~ to flag backup files (names ending with ~) for Deletion.
152: Type . to flag numerical backups for Deletion.
153: (Spares dired-kept-versions or its numeric argument.)
154: Type r to rename a file.
155: Type c to copy a file.
156: Type v to view a file in View mode, returning to Dired when done.
157: Space can be used to move down and up by lines.
158: \\{dired-mode-map}"
159: (kill-all-local-variables)
160: (make-local-variable 'revert-buffer-function)
161: (setq revert-buffer-function 'dired-revert)
162: (setq major-mode 'dired-mode)
163: (setq mode-name "Dired")
164: (make-local-variable 'dired-directory)
165: (setq dired-directory dirname)
166: (setq default-directory
167: (if (file-directory-p dirname)
168: dirname (file-name-directory dirname)))
169: (setq case-fold-search nil)
170: (setq mode-line-format
171: (concat "--Directory " dirname
172: " %M %[(%m)%]----%p--%-"))
173: (setq buffer-read-only t)
174: (use-local-map dired-mode-map))
175:
176: (defun dired-repeat-over-lines (arg function)
177: (beginning-of-line)
178: (while (and (> arg 0) (not (eobp)))
179: (setq arg (1- arg))
180: (save-excursion
181: (beginning-of-line)
182: (and (bobp) (looking-at " total")
183: (error "No file on this line"))
184: (funcall function))
185: (forward-line 1)
186: (dired-move-to-filename))
187: (while (and (< arg 0) (not (bobp)))
188: (setq arg (1+ arg))
189: (forward-line -1)
190: (dired-move-to-filename)
191: (save-excursion
192: (beginning-of-line)
193: (funcall function))))
194:
195: (defun dired-flag-file-deleted (arg)
196: "In dired, flag the current line's file for deletion.
197: With arg, repeat over several lines."
198: (interactive "p")
199: (dired-repeat-over-lines arg
200: '(lambda ()
201: (let ((buffer-read-only nil))
202: (if (looking-at " d")
203: nil
204: (delete-char 1)
205: (insert "D"))))))
206:
207: (defun dired-summary ()
208: (interactive)
209: ;>> this should check the key-bindings and use substitute-command-keys if non-standard
210: (message
211: "d-elete, u-ndelete, x-ecute, f-ind, o-ther window, r-ename, c-opy, v-iew"))
212:
213: (defun dired-unflag (arg)
214: "In dired, flag the current line's file for deletion."
215: (interactive "p")
216: (dired-repeat-over-lines arg
217: '(lambda ()
218: (let ((buffer-read-only nil))
219: (delete-char 1)
220: (insert " ")
221: (forward-char -1)))))
222:
223: (defun dired-backup-unflag (arg)
224: "In dired, move up a line and remove deletion flag there."
225: (interactive "p")
226: (dired-unflag (- arg)))
227:
228: (defun dired-next-line (arg)
229: "Move down ARG lines then position at filename."
230: (interactive "p")
231: (next-line arg)
232: (dired-move-to-filename))
233:
234: (defun dired-previous-line (arg)
235: "Move up ARG lines then position at filename."
236: (interactive "p")
237: (previous-line arg)
238: (dired-move-to-filename))
239:
240: (defun dired-find-file ()
241: "In dired, visit the file named on this line."
242: (interactive)
243: (if (save-excursion
244: (beginning-of-line)
245: (looking-at " d"))
246: (dired (dired-get-filename))
247: (find-file (dired-get-filename))))
248:
249: (defun dired-view-file ()
250: "In dired, examine a file in view mode, returning to dired when done."
251: (interactive)
252: (if (save-excursion
253: (beginning-of-line)
254: (looking-at " d"))
255: (dired (dired-get-filename))
256: (view-file (dired-get-filename))))
257:
258: (defun dired-find-file-other-window ()
259: "In dired, visit this file in another window."
260: (interactive)
261: (if (save-excursion
262: (beginning-of-line)
263: (looking-at " d"))
264: (dired-other-window (dired-get-filename))
265: (find-file-other-window (dired-get-filename))))
266:
267: (defun dired-get-filename (&optional localp no-error-if-not-filep)
268: "In dired, return name of file mentioned on this line.
269: Value returned normally includes the directory name.
270: A non-nil 1st argument means do not include it. A non-nil 2nd argument
271: says return nil if no filename on this line, otherwise an error occurs."
272: (let (eol)
273: (save-excursion
274: (end-of-line)
275: (setq eol (point))
276: (beginning-of-line)
277: (if (re-search-forward
278: "\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct\\|Nov\\|Dec\\)[ ]+[0-9]+"
279: eol t)
280: (progn (skip-chars-forward " ")
281: (skip-chars-forward "^ " eol)
282: (skip-chars-forward " " eol)
283: (let ((beg (point)))
284: (skip-chars-forward "^ \n")
285: (if localp
286: (buffer-substring beg (point))
287: ;; >> uses default-directory, could lose on cd, multiple.
288: (concat default-directory (buffer-substring beg (point))))))
289: (if no-error-if-not-filep nil
290: (error "No file on this line"))))))
291:
292: (defun dired-move-to-filename ()
293: "In dired, move to first char of filename on this line.
294: Returns position (point) or nil if no filename on this line."
295: (let ((eol (progn (end-of-line) (point))))
296: (beginning-of-line)
297: (if (re-search-forward
298: "\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct\\|Nov\\|Dec\\)[ ]+[0-9]+"
299: eol t)
300: (progn
301: (skip-chars-forward " ")
302: (skip-chars-forward "^ " eol)
303: (skip-chars-forward " " eol)
304: (point)))))
305:
306: (defun dired-map-dired-file-lines (fn)
307: "perform fn with point at the end of each non-directory line:
308: arguments are the short and long filename"
309: (save-excursion
310: (let (filename longfilename (buffer-read-only nil))
311: (goto-char (point-min))
312: (while (not (eobp))
313: (save-excursion
314: (and (not (looking-at " d"))
315: (not (eolp))
316: (setq filename (dired-get-filename t t)
317: longfilename (dired-get-filename nil t))
318: (progn (end-of-line)
319: (funcall fn filename longfilename))))
320: (forward-line 1)))))
321:
322: (defun dired-flag-auto-save-files ()
323: "Flag for deletion files whose names suggest they are auto save files."
324: (interactive)
325: (save-excursion
326: (let ((buffer-read-only nil))
327: (goto-char (point-min))
328: (while (not (eobp))
329: (and (not (looking-at " d"))
330: (not (eolp))
331: (if (fboundp 'auto-save-file-name-p)
332: (let ((fn (dired-get-filename t t)))
333: (if fn (auto-save-file-name-p fn)))
334: (if (dired-move-to-filename)
335: (looking-at "#")))
336: (progn (beginning-of-line)
337: (delete-char 1)
338: (insert "D")))
339: (forward-line 1)))))
340:
341: (defun dired-clean-directory (keep)
342: "Flag numerical backups for Deletion.
343: Spares dired-kept-versions latest versions, and kept-old-versions oldest.
344: Positive numeric arg overrides dired-kept-versions;
345: negative numeric arg overrides kept-old-versions with minus the arg."
346: (interactive "P")
347: (setq keep (if keep (prefix-numeric-value keep) dired-kept-versions))
348: (let ((early-retention (if (< keep 0) (- keep) kept-old-versions))
349: (late-retention (if (<= keep 0) dired-kept-versions keep))
350: (file-version-assoc-list ()))
351: ;; Look at each file.
352: ;; If the file has numeric backup versions,
353: ;; put on file-version-assoc-list an element of the form
354: ;; (FILENAME . VERSION-NUMBER-LIST)
355: (dired-map-dired-file-lines 'dired-collect-file-versions)
356: ;; Sort each VERSION-NUMBER-LIST,
357: ;; and remove the versions not to be deleted.
358: (let ((fval file-version-assoc-list))
359: (while fval
360: (let* ((sorted-v-list (cons 'q (sort (cdr (car fval)) '<)))
361: (v-count (length sorted-v-list)))
362: (if (> v-count (+ early-retention late-retention))
363: (rplacd (nthcdr early-retention sorted-v-list)
364: (nthcdr (- v-count late-retention)
365: sorted-v-list)))
366: (rplacd (car fval)
367: (cdr sorted-v-list)))
368: (setq fval (cdr fval))))
369: ;; Look at each file. If it is a numeric backup file,
370: ;; find it in a VERSION-NUMBER-LIST and maybe flag it for deletion.
371: (dired-map-dired-file-lines 'dired-trample-file-versions)))
372:
373: (defun dired-collect-file-versions (ignore fn)
374: "If it looks like fn has versions, we make a list of the versions.
375: We may want to flag some for deletion."
376: (let* ((base-versions
377: (concat (file-name-nondirectory fn) ".~"))
378: (bv-length (length base-versions))
379: (possibilities (file-name-all-completions
380: base-versions
381: (file-name-directory fn)))
382: (versions (mapcar 'backup-extract-version possibilities)))
383: (if versions
384: (setq file-version-assoc-list (cons (cons fn versions)
385: file-version-assoc-list)))))
386:
387: (defun dired-trample-file-versions (ignore fn)
388: (let* ((start-vn (string-match "\\.~[0-9]+~$" fn))
389: base-version-list)
390: (and start-vn
391: (setq base-version-list ; there was a base version to which
392: (assoc (substring fn 0 start-vn) ; this looks like a
393: file-version-assoc-list)) ; subversion
394: (not (memq (string-to-int (substring fn (+ 2 start-vn)))
395: base-version-list)) ; this one doesn't make the cut
396: (dired-flag-this-line-for-DEATH))))
397:
398: (defun dired-flag-this-line-for-DEATH ()
399: (beginning-of-line)
400: (delete-char 1)
401: (insert "D"))
402:
403: (defun dired-flag-backup-files ()
404: "Flag all backup files (names ending with ~) for deletion."
405: (interactive)
406: (save-excursion
407: (let ((buffer-read-only nil))
408: (goto-char (point-min))
409: (while (not (eobp))
410: (and (not (looking-at " d"))
411: (not (eolp))
412: (progn (end-of-line) (forward-char -1) (looking-at "~"))
413: (progn (beginning-of-line)
414: (delete-char 1)
415: (insert "D")))
416: (forward-line 1)))))
417:
418: (defun dired-flag-backup-and-auto-save-files ()
419: "Flag all backup and temporary files for deletion.
420: Backup files have names ending in ~. Auto save file names usually
421: start with #."
422: (interactive)
423: (dired-flag-backup-files)
424: (dired-flag-auto-save-files))
425:
426: (defun dired-rename-file (to-file)
427: "Rename this file to TO-FILE."
428: (interactive "FRename to: ")
429: (setq to-file (expand-file-name to-file))
430: (rename-file (dired-get-filename) to-file)
431: (let ((buffer-read-only nil))
432: (beginning-of-line)
433: (delete-region (point) (progn (forward-line 1) (point)))
434: (setq to-file (expand-file-name to-file))
435: (dired-add-entry (file-name-directory to-file)
436: (file-name-nondirectory to-file))))
437:
438: (defun dired-copy-file (to-file)
439: "Copy this file to TO-FILE."
440: (interactive "FCopy to: ")
441: (copy-file (dired-get-filename) to-file)
442: (setq to-file (expand-file-name to-file))
443: (dired-add-entry (file-name-directory to-file)
444: (file-name-nondirectory to-file)))
445:
446: (defun dired-add-entry (directory filename)
447: ;; If tree dired is implemented, this function will have to do
448: ;; something smarter with the directory. Currently, just check
449: ;; default directory, if same, add the new entry at point. With tree
450: ;; dired, should call 'dired-current-directory' or similar. Note
451: ;; that this adds the entry 'out of order' if files sorted by time,
452: ;; etc.
453: (if (string-equal directory default-directory)
454: (let ((buffer-read-only nil))
455: (call-process "ls" nil t nil
456: "-d" dired-listing-switches (concat directory filename))
457: (forward-line -1)
458: (insert " ")
459: (dired-move-to-filename)
460: (let* ((beg (point))
461: (end (progn (end-of-line) (point))))
462: (setq filename (buffer-substring beg end))
463: (delete-region beg end)
464: (insert (file-name-nondirectory filename)))
465: (beginning-of-line))))
466:
467: (defun dired-do-deletions ()
468: "In dired, delete the files flagged for deletion."
469: (interactive)
470: (let (delete-list answer)
471: (save-excursion
472: (goto-char 1)
473: (while (re-search-forward "^D" nil t)
474: (setq delete-list
475: (cons (cons (dired-get-filename t) (1- (point)))
476: delete-list))))
477: (if (null delete-list)
478: (message "(No deletions requested)")
479: (save-window-excursion
480: (switch-to-buffer " *Deletions*")
481: (erase-buffer)
482: (setq fill-column 70)
483: (let ((l (reverse delete-list)))
484: ;; Files should be in forward order for this loop.
485: (while l
486: (if (> (current-column) 59)
487: (insert ?\n)
488: (or (bobp)
489: (indent-to (* (/ (+ (current-column) 19) 20) 20) 1)))
490: (insert (car (car l)))
491: (setq l (cdr l))))
492: (goto-char (point-min))
493: (setq answer (yes-or-no-p "Delete these files? ")))
494: (if answer
495: (let ((l delete-list)
496: failures)
497: ;; Files better be in reverse order for this loop!
498: ;; That way as changes are made in the buffer
499: ;; they do not shift the lines still to be changed.
500: (while l
501: (goto-char (cdr (car l)))
502: (let ((buffer-read-only nil))
503: (condition-case ()
504: (progn (delete-file (concat default-directory
505: (car (car l))))
506: (delete-region (point)
507: (progn (forward-line 1) (point))))
508: (error (delete-char 1)
509: (insert " ")
510: (setq failures (cons (car (car l)) failures)))))
511: (setq l (cdr l)))
512: (if failures
513: (message "Deletions failed: %s"
514: (prin1-to-string failures))))))))
515:
516:
517:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.