![[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.